* anything-config.el declare some variables to shut up byte compiler, fix also long...
[anything-config.git] / anything-config.el
blob94d620dc8b5f1d980d97ddd99e7dce23e74c3892
1 ;;; anything-config.el --- Predefined configurations for `anything.el'
3 ;; Filename: anything-config.el
5 ;; Description: Predefined configurations for `anything.el'
6 ;; Author: Tassilo Horn <tassilo@member.fsf.org>
7 ;; Maintainer: Tassilo Horn <tassilo@member.fsf.org>
8 ;; rubikitch <rubikitch@ruby-lang.org>
9 ;; Thierry Volpiatto <thierry.volpiatto@gmail.com>
10 ;; Copyright (C) 2007 ~ 2011, Tassilo Horn, all rights reserved.
11 ;; Copyright (C) 2009, Andy Stewart, all rights reserved.
12 ;; Copyright (C) 2009 ~ 2011, rubikitch, all rights reserved.
13 ;; Copyright (C) 2009 ~ 2011, Thierry Volpiatto, all rights reserved.
14 ;; Created: 2009-02-16 21:38:23
15 ;; Version: 0.4.1
16 ;; X-URL: http://repo.or.cz/w/anything-config.git
17 ;; Keywords: anything, anything-config
18 ;; Compatibility: GNU Emacs 22 ~ 24
20 ;; Features that might be required by this library:
22 ;; `anything'
25 ;;; This file is NOT part of GNU Emacs
27 ;;; License
29 ;; This program is free software; you can redistribute it and/or modify
30 ;; it under the terms of the GNU General Public License as published by
31 ;; the Free Software Foundation; either version 3, or (at your option)
32 ;; any later version.
34 ;; This program is distributed in the hope that it will be useful,
35 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
36 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
37 ;; GNU General Public License for more details.
39 ;; You should have received a copy of the GNU General Public License
40 ;; along with this program; see the file COPYING. If not, write to
41 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
42 ;; Floor, Boston, MA 02110-1301, USA.
44 ;;; !NOTICE!
46 ;; If this file does not work, upgrade anything.el!
47 ;; http://www.emacswiki.org/cgi-bin/wiki/download/anything.el
49 ;;; Commentary:
51 ;; Predefined configurations for `anything.el'
53 ;; For quick start, try `anything-for-files' to open files.
55 ;; To configure anything you should define anything command
56 ;; with your favorite sources, like below:
58 ;; (defun my-anything ()
59 ;; (interactive)
60 ;; (anything-other-buffer
61 ;; '(anything-c-source-buffers
62 ;; anything-c-source-file-name-history
63 ;; anything-c-source-info-pages
64 ;; anything-c-source-info-elisp
65 ;; anything-c-source-man-pages
66 ;; anything-c-source-locate
67 ;; anything-c-source-emacs-commands)
68 ;; " *my-anything*"))
70 ;; Then type M-x my-anything to use sources.
72 ;; Defining own command is better than setup `anything-sources'
73 ;; directly, because you can define multiple anything commands with
74 ;; different sources. Each anything command should have own anything
75 ;; buffer, because M-x anything-resume revives anything command.
77 ;;; Autodoc documentation:
78 ;; ---------------------
80 ;; * Commands defined here are:
81 ;; [EVAL] (autodoc-document-lisp-buffer :type 'command :prefix "anything-" :docstring t)
82 ;; `anything-configuration'
83 ;; Customize `anything'.
84 ;; `anything-mini'
85 ;; Preconfigured `anything' lightweight version (buffer -> recentf).
86 ;; `anything-for-files'
87 ;; Preconfigured `anything' for opening files.
88 ;; `anything-recentf'
89 ;; Preconfigured `anything' for `recentf'.
90 ;; `anything-info-at-point'
91 ;; Preconfigured `anything' for searching info at point.
92 ;; `anything-info-emacs'
93 ;; Preconfigured anything for Emacs manual index.
94 ;; `anything-show-kill-ring'
95 ;; Preconfigured `anything' for `kill-ring'.
96 ;; `anything-minibuffer-history'
97 ;; Preconfigured `anything' for `minibuffer-history'.
98 ;; `anything-gentoo'
99 ;; Preconfigured `anything' for gentoo linux.
100 ;; `anything-imenu'
101 ;; Preconfigured `anything' for `imenu'.
102 ;; `anything-google-suggest'
103 ;; Preconfigured `anything' for google search with google suggest.
104 ;; `anything-yahoo-suggest'
105 ;; Preconfigured `anything' for Yahoo searching with Yahoo suggest.
106 ;; `anything-for-buffers'
107 ;; Preconfigured `anything' for buffer.
108 ;; `anything-buffers-list'
109 ;; Enhanced preconfigured `anything' for buffer.
110 ;; `anything-bbdb'
111 ;; Preconfigured `anything' for BBDB.
112 ;; `anything-locate'
113 ;; Preconfigured `anything' for Locate.
114 ;; `anything-w3m-bookmarks'
115 ;; Preconfigured `anything' for w3m bookmark.
116 ;; `anything-firefox-bookmarks'
117 ;; Preconfigured `anything' for firefox bookmark.
118 ;; `anything-colors'
119 ;; Preconfigured `anything' for color.
120 ;; `anything-bookmarks'
121 ;; Preconfigured `anything' for bookmarks.
122 ;; `anything-c-pp-bookmarks'
123 ;; Preconfigured `anything' for bookmarks (pretty-printed).
124 ;; `anything-c-insert-latex-math'
125 ;; Preconfigured anything for latex math symbols completion.
126 ;; `anything-register'
127 ;; Preconfigured `anything' for Emacs registers.
128 ;; `anything-man-woman'
129 ;; Preconfigured `anything' for Man and Woman pages.
130 ;; `anything-org-keywords'
131 ;; Preconfigured `anything' for org keywords.
132 ;; `anything-emms'
133 ;; Preconfigured `anything' for emms sources.
134 ;; `anything-eev-anchors'
135 ;; Preconfigured `anything' for eev anchors.
136 ;; `anything-bm-list'
137 ;; Preconfigured `anything' for visible bookmarks.
138 ;; `anything-timers'
139 ;; Preconfigured `anything' for timers.
140 ;; `anything-list-emacs-process'
141 ;; Preconfigured `anything' for emacs process.
142 ;; `anything-occur'
143 ;; Preconfigured Anything for Occur source.
144 ;; `anything-browse-code'
145 ;; Preconfigured anything to browse code.
146 ;; `anything-org-headlines'
147 ;; Preconfigured anything to show org headlines.
148 ;; `anything-info-gnus'
149 ;; Preconfigured anything to browse Gnus Manual.
150 ;; `anything-regexp'
151 ;; Preconfigured anything to build regexps and run query-replace-regexp against.
152 ;; `anything-test-sources'
153 ;; List all anything sources for test.
154 ;; `anything-select-source'
155 ;; Select source.
156 ;; `anything-mark-all'
157 ;; Mark all visible unmarked candidates in current source.
158 ;; `anything-unmark-all'
159 ;; Unmark all candidates in all sources of current anything session.
160 ;; `anything-toggle-all-marks'
161 ;; Toggle all marks.
162 ;; `anything-c-buffer-help'
163 ;; Help command for anything buffers.
164 ;; `anything-buffer-diff-persistent'
165 ;; Toggle diff buffer without quitting anything.
166 ;; `anything-buffer-revert-persistent'
167 ;; Revert buffer without quitting anything.
168 ;; `anything-buffer-save-persistent'
169 ;; Save buffer without quitting anything.
170 ;; `anything-buffer-run-kill-buffers'
171 ;; Run kill buffer action from `anything-c-source-buffers-list'.
172 ;; `anything-buffer-run-grep'
173 ;; Run Grep action from `anything-c-source-buffers-list'.
174 ;; `anything-buffer-run-zgrep'
175 ;; Run Grep action from `anything-c-source-buffers-list'.
176 ;; `anything-buffer-run-query-replace-regexp'
177 ;; Run Query replace regexp action from `anything-c-source-buffers-list'.
178 ;; `anything-buffer-run-query-replace'
179 ;; Run Query replace action from `anything-c-source-buffers-list'.
180 ;; `anything-buffer-switch-other-window'
181 ;; Run switch to other window action from `anything-c-source-buffers-list'.
182 ;; `anything-buffer-switch-other-frame'
183 ;; Run switch to other frame action from `anything-c-source-buffers-list'.
184 ;; `anything-buffer-switch-to-elscreen'
185 ;; Run switch to elscreen action from `anything-c-source-buffers-list'.
186 ;; `anything-c-copy-files-async'
187 ;; Preconfigured anything to copy file list FLIST to DEST asynchronously.
188 ;; `anything-ff-help'
189 ;; Help command for `anything-find-files'.
190 ;; `anything-ff-run-toggle-auto-update'
191 ;; Not documented.
192 ;; `anything-ff-run-switch-to-history'
193 ;; Run Switch to history action from `anything-c-source-find-files'.
194 ;; `anything-ff-run-grep'
195 ;; Run Grep action from `anything-c-source-find-files'.
196 ;; `anything-ff-run-pdfgrep'
197 ;; Run Pdfgrep action from `anything-c-source-find-files'.
198 ;; `anything-ff-run-zgrep'
199 ;; Run Grep action from `anything-c-source-find-files'.
200 ;; `anything-ff-run-copy-file'
201 ;; Run Copy file action from `anything-c-source-find-files'.
202 ;; `anything-ff-run-rename-file'
203 ;; Run Rename file action from `anything-c-source-find-files'.
204 ;; `anything-ff-run-byte-compile-file'
205 ;; Run Byte compile file action from `anything-c-source-find-files'.
206 ;; `anything-ff-run-load-file'
207 ;; Run Load file action from `anything-c-source-find-files'.
208 ;; `anything-ff-run-eshell-command-on-file'
209 ;; Run eshell command on file action from `anything-c-source-find-files'.
210 ;; `anything-ff-run-ediff-file'
211 ;; Run Ediff file action from `anything-c-source-find-files'.
212 ;; `anything-ff-run-ediff-merge-file'
213 ;; Run Ediff merge file action from `anything-c-source-find-files'.
214 ;; `anything-ff-run-symlink-file'
215 ;; Run Symlink file action from `anything-c-source-find-files'.
216 ;; `anything-ff-run-delete-file'
217 ;; Run Delete file action from `anything-c-source-find-files'.
218 ;; `anything-ff-run-complete-fn-at-point'
219 ;; Run complete file name action from `anything-c-source-find-files'.
220 ;; `anything-ff-run-switch-to-eshell'
221 ;; Run switch to eshell action from `anything-c-source-find-files'.
222 ;; `anything-ff-run-switch-other-window'
223 ;; Run switch to other window action from `anything-c-source-find-files'.
224 ;; `anything-ff-run-switch-other-frame'
225 ;; Run switch to other frame action from `anything-c-source-find-files'.
226 ;; `anything-ff-run-open-file-externally'
227 ;; Run open file externally command action from `anything-c-source-find-files'.
228 ;; `anything-ff-run-gnus-attach-files'
229 ;; Run gnus attach files command action from `anything-c-source-find-files'.
230 ;; `anything-ff-run-etags'
231 ;; Run Etags command action from `anything-c-source-find-files'.
232 ;; `anything-ff-run-print-file'
233 ;; Run Print file action from `anything-c-source-find-files'.
234 ;; `anything-find-files-down-one-level'
235 ;; Go down one level like unix command `cd ..'.
236 ;; `anything-ff-properties-persistent'
237 ;; Show properties without quitting anything.
238 ;; `anything-ff-run-kill-buffer-persistent'
239 ;; Execute `anything-ff-kill-buffer-fname' whitout quitting.
240 ;; `anything-ff-rotate-left-persistent'
241 ;; Rotate image left without quitting anything.
242 ;; `anything-ff-rotate-right-persistent'
243 ;; Rotate image right without quitting anything.
244 ;; `anything-find-files'
245 ;; Preconfigured `anything' for anything implementation of `find-file'.
246 ;; `anything-write-file'
247 ;; Preconfigured `anything' providing completion for `write-file'.
248 ;; `anything-insert-file'
249 ;; Preconfigured `anything' providing completion for `insert-file'.
250 ;; `anything-dired-rename-file'
251 ;; Preconfigured `anything' to rename files from dired.
252 ;; `anything-dired-copy-file'
253 ;; Preconfigured `anything' to copy files from dired.
254 ;; `anything-dired-symlink-file'
255 ;; Preconfigured `anything' to symlink files from dired.
256 ;; `anything-dired-hardlink-file'
257 ;; Preconfigured `anything' to hardlink files from dired.
258 ;; `anything-generic-file-help'
259 ;; Not documented.
260 ;; `anything-do-grep'
261 ;; Preconfigured anything for grep.
262 ;; `anything-c-goto-precedent-file'
263 ;; Go to precedent file in anything grep/etags buffers.
264 ;; `anything-c-goto-next-file'
265 ;; Go to precedent file in anything grep/etags buffers.
266 ;; `anything-grep-help'
267 ;; Not documented.
268 ;; `anything-c-grep-run-persistent-action'
269 ;; Run grep persistent action from `anything-do-grep-1'.
270 ;; `anything-c-grep-run-default-action'
271 ;; Run grep default action from `anything-do-grep-1'.
272 ;; `anything-c-grep-run-other-window-action'
273 ;; Run grep goto other window action from `anything-do-grep-1'.
274 ;; `anything-c-grep-run-save-buffer'
275 ;; Run grep save results action from `anything-do-grep-1'.
276 ;; `anything-pdfgrep-help'
277 ;; Not documented.
278 ;; `anything-do-pdfgrep'
279 ;; Not documented.
280 ;; `anything-yank-text-at-point'
281 ;; Yank text at point in minibuffer.
282 ;; `anything-etags-help'
283 ;; The help function for etags.
284 ;; `anything-c-etags-select'
285 ;; Preconfigured anything for etags.
286 ;; `anything-filelist'
287 ;; Preconfigured `anything' to open files instantly.
288 ;; `anything-filelist+'
289 ;; Preconfigured `anything' to open files/buffers/bookmarks instantly.
290 ;; `anything-c-describe-attributes'
291 ;; Display the full documentation of ANYTHING-ATTRIBUTE (a symbol).
292 ;; `anything-M-x'
293 ;; Preconfigured `anything' for Emacs commands.
294 ;; `anything-manage-advice'
295 ;; Preconfigured `anything' to disable/enable function advices.
296 ;; `anything-bookmark-ext'
297 ;; Preconfigured `anything' for bookmark-extensions sources.
298 ;; `anything-simple-call-tree'
299 ;; Preconfigured `anything' for simple-call-tree. List function relationships.
300 ;; `anything-mark-ring'
301 ;; Preconfigured `anything' for `anything-c-source-mark-ring'.
302 ;; `anything-global-mark-ring'
303 ;; Preconfigured `anything' for `anything-c-source-global-mark-ring'.
304 ;; `anything-all-mark-rings'
305 ;; Preconfigured `anything' for `anything-c-source-global-mark-ring' and `anything-c-source-mark-ring'.
306 ;; `anything-yaoddmuse-cache-pages'
307 ;; Fetch the list of files on emacswiki and create cache file.
308 ;; `anything-yaoddmuse-emacswiki-edit-or-view'
309 ;; Preconfigured `anything' to edit or view EmacsWiki page.
310 ;; `anything-yaoddmuse-emacswiki-post-library'
311 ;; Preconfigured `anything' to post library to EmacsWiki.
312 ;; `anything-eval-expression'
313 ;; Preconfigured anything for `anything-c-source-evaluation-result'.
314 ;; `anything-eval-new-line-and-indent'
315 ;; Not documented.
316 ;; `anything-eval-expression-with-eldoc'
317 ;; Preconfigured anything for `anything-c-source-evaluation-result' with `eldoc' support.
318 ;; `anything-calcul-expression'
319 ;; Preconfigured anything for `anything-c-source-calculation-result'.
320 ;; `anything-surfraw'
321 ;; Preconfigured `anything' to search PATTERN with search ENGINE.
322 ;; `anything-call-source'
323 ;; Preconfigured `anything' to call anything source.
324 ;; `anything-call-source-from-anything'
325 ;; Call anything source within `anything' session.
326 ;; `anything-execute-anything-command'
327 ;; Preconfigured `anything' to execute preconfigured `anything'.
328 ;; `anything-create-from-anything'
329 ;; Run `anything-create' from `anything' as a fallback.
330 ;; `anything-create'
331 ;; Preconfigured `anything' to do many create actions from STRING.
332 ;; `anything-top'
333 ;; Preconfigured `anything' for top command.
334 ;; `anything-select-xfont'
335 ;; Preconfigured `anything' to select Xfont.
336 ;; `anything-world-time'
337 ;; Preconfigured `anything' to show world time.
338 ;; `anything-apt'
339 ;; Preconfigured `anything' : frontend of APT package manager.
340 ;; `anything-esh-pcomplete'
341 ;; Preconfigured anything to provide anything completion in eshell.
342 ;; `anything-eshell-history'
343 ;; Preconfigured anything for eshell history.
344 ;; `anything-lisp-completion-at-point'
345 ;; Anything lisp symbol completion at point.
346 ;; `anything-lisp-completion-at-point-or-indent'
347 ;; First call indent and second call complete lisp symbol.
348 ;; `anything-c-complete-file-name-at-point'
349 ;; Complete file name at point.
350 ;; `anything-c-run-external-command'
351 ;; Preconfigured `anything' to run External PROGRAM asyncronously from Emacs.
352 ;; `anything-ratpoison-commands'
353 ;; Preconfigured `anything' to execute ratpoison commands.
354 ;; `anything-c-set-variable'
355 ;; Set value to VAR interactively.
356 ;; `anything-c-adaptive-save-history'
357 ;; Save history information to file given by `anything-c-adaptive-history-file'.
358 ;; `anything-c-reset-adaptative-history'
359 ;; Delete all `anything-c-adaptive-history' and his file.
360 ;; `anything-c-toggle-match-plugin'
361 ;; Toggle anything-match-plugin.
363 ;; * User variables defined here:
364 ;; [EVAL] (autodoc-document-lisp-buffer :type 'user-variable :prefix "anything-" :var-value t)
365 ;; `anything-c-use-standard-keys'
366 ;; Default Value: nil
367 ;; `anything-c-adaptive-history-file'
368 ;; Default Value: "~/.emacs.d/anything-c-adaptive-history"
369 ;; `anything-c-adaptive-history-length'
370 ;; Default Value: 50
371 ;; `anything-c-google-suggest-url'
372 ;; Default Value: "http://google.com/complete/search?output=toolbar&q="
373 ;; `anything-c-google-suggest-search-url'
374 ;; Default Value: "http://www.google.com/search?ie=utf-8&oe=utf-8&q="
375 ;; `anything-google-suggest-use-curl-p'
376 ;; Default Value: nil
377 ;; `anything-c-yahoo-suggest-url'
378 ;; Default Value: "http://search.yahooapis.com/WebSearchService/V1/relatedSuggestion?appid=G [...]
379 ;; `anything-c-yahoo-suggest-search-url'
380 ;; Default Value: "http://search.yahoo.com/search?&ei=UTF-8&fr&h=c&p="
381 ;; `anything-c-boring-buffer-regexp'
382 ;; Default Value: "\\ (\\` \\)\\|\\*anything\\| \\*Echo Area\\| \\*Minibuf"
383 ;; `anything-c-boring-file-regexp'
384 ;; Default Value: "/\\ (?:\\(?:\\.\\(?:git\\|hg\\|svn\\)\\|CVS\\|_darcs\\)\\)\\(?:/\\|$\\)\\| [...]
385 ;; `anything-kill-ring-threshold'
386 ;; Default Value: 10
387 ;; `anything-su-or-sudo'
388 ;; Default Value: "su"
389 ;; `anything-for-files-prefered-list'
390 ;; Default Value: (anything-c-source-ffap-line anything-c-source-ffap-guesser anything-c-sou [...]
391 ;; `anything-create--actions-private'
392 ;; Default Value: nil
393 ;; `anything-allow-skipping-current-buffer'
394 ;; Default Value: t
395 ;; `anything-c-enable-eval-defun-hack'
396 ;; Default Value: t
397 ;; `anything-tramp-verbose'
398 ;; Default Value: 0
399 ;; `anything-raise-command'
400 ;; Default Value: nil
401 ;; `anything-command-map-prefix-key'
402 ;; Default Value: "<f5> a"
403 ;; `anything-c-find-files-show-icons'
404 ;; Default Value: nil
405 ;; `anything-c-find-files-icons-directory'
406 ;; Default Value: "/usr/local/share/emacs/24.0.50/etc/images/tree-widget/default"
407 ;; `anything-c-browse-code-regexp-lisp'
408 ;; Default Value: "^ * (def\\(un\\|subst\\|macro\\|face\\|alias\\|advice\\|struct\\|type\\|th [...]
409 ;; `anything-c-browse-code-regexp-python'
410 ;; Default Value: "\\<def\\>\\|\\<class\\>"
411 ;; `anything-c-browse-code-regexp-alist'
412 ;; Default Value: ((lisp-interaction-mode . "^ *(def\\(un\\|subst\\|macro\\|face\\|alias\\|a [...]
413 ;; `anything-c-external-programs-associations'
414 ;; Default Value: nil
415 ;; `anything-ff-auto-update-initial-value'
416 ;; Default Value: t
417 ;; `anything-c-copy-async-prefered-emacs'
418 ;; Default Value: "emacs"
419 ;; `anything-ff-lynx-style-map'
420 ;; Default Value: t
421 ;; `anything-ff-history-max-length'
422 ;; Default Value: 100
423 ;; `anything-ff-smart-completion'
424 ;; Default Value: t
425 ;; `anything-ff-default-kbsize'
426 ;; Default Value: 1024.0
427 ;; `anything-ff-tramp-not-fancy'
428 ;; Default Value: t
429 ;; `anything-ff-exif-data-program'
430 ;; Default Value: "exiftran"
431 ;; `anything-ff-exif-data-program-args'
432 ;; Default Value: "-d"
433 ;; `anything-c-grep-use-ioccur-style-keys'
434 ;; Default Value: t
435 ;; `anything-c-pdfgrep-default-read-command'
436 ;; Default Value: "xpdf '%f' %p"
437 ;; `anything-c-etags-tag-file-name'
438 ;; Default Value: "TAGS"
439 ;; `anything-c-etags-tag-file-search-limit'
440 ;; Default Value: 10
441 ;; `anything-c-filelist-file-name'
442 ;; Default Value: nil
443 ;; `anything-c-eldoc-in-minibuffer-show-fn'
444 ;; Default Value: anything-c-eldoc-show-in-mode-line
445 ;; `anything-c-turn-on-show-completion'
446 ;; Default Value: t
447 ;; `anything-lisp-completion-or-indent-delay'
448 ;; Default Value: 0.6
449 ;; `anything-c-default-external-file-browser'
450 ;; Default Value: "nautilus"
451 ;; `anything-c-use-adaptative-sorting'
452 ;; Default Value: nil
453 ;; `anything-ff-newfile-prompt-p'
454 ;; Default Value: t
456 ;; * Anything sources defined here:
457 ;; [EVAL] (autodoc-document-lisp-buffer :type 'anything-source :prefix "anything-" :any-sname t)
458 ;; `anything-c-source-regexp' (Regexp Builder)
459 ;; `anything-c-source-buffers' (Buffers)
460 ;; `anything-c-source-buffer-not-found' (Create buffer)
461 ;; `anything-c-source-buffers-list' (Buffers)
462 ;; `anything-c-source-file-name-history' (File Name History)
463 ;; `anything-c-source-files-in-current-dir' (Files from Current Directory)
464 ;; `anything-c-source-files-in-current-dir+' (Files from Current Directory)
465 ;; `anything-c-source-find-files' (Find Files (`C-.':Go to precedent level))
466 ;; `anything-c-source-write-file' (Write File (`C-.':Go to precedent level))
467 ;; `anything-c-source-insert-file' (Insert File (`C-.':Go to precedent level))
468 ;; `anything-c-source-copy-files' (Copy Files (`C-.':Go to precedent level))
469 ;; `anything-c-source-symlink-files' (Symlink Files (`C-.':Go to precedent level))
470 ;; `anything-c-source-hardlink-files' (Hardlink Files (`C-.':Go to precedent level))
471 ;; `anything-c-source-file-cache' (File Cache)
472 ;; `anything-c-source-locate' (Locate)
473 ;; `anything-c-source-etags-select' (Etags)
474 ;; `anything-c-source-recentf' (Recentf)
475 ;; `anything-c-source-ffap-guesser' (File at point)
476 ;; `anything-c-source-ffap-line' (File/Lineno at point)
477 ;; `anything-c-source-files-in-all-dired' (Files in all dired buffer.)
478 ;; `anything-c-source-filelist' (FileList)
479 ;; `anything-c-source-info-pages' (Info Pages)
480 ;; `anything-c-source-info-elisp' (Info index: elisp)
481 ;; `anything-c-source-info-cl' (Info index: cl)
482 ;; `anything-c-source-info-org' (Info index: org)
483 ;; `anything-c-source-info-ratpoison' (Info index: ratpoison)
484 ;; `anything-c-source-info-zsh' (Info index: zsh)
485 ;; `anything-c-source-info-bash' (Info index: bash)
486 ;; `anything-c-source-info-coreutils' (Info index: coreutils)
487 ;; `anything-c-source-info-fileutils' (Info index: fileutils)
488 ;; `anything-c-source-info-find' (Info index: find)
489 ;; `anything-c-source-info-sh-utils' (Info index: sh-utils)
490 ;; `anything-c-source-info-textutils' (Info index: textutils)
491 ;; `anything-c-source-info-libc' (Info index: libc)
492 ;; `anything-c-source-info-make' (Info index: make)
493 ;; `anything-c-source-info-automake' (Info index: automake)
494 ;; `anything-c-source-info-autoconf' (Info index: autoconf)
495 ;; `anything-c-source-info-emacs-lisp-intro' (Info index: emacs-lisp-intro)
496 ;; `anything-c-source-info-emacs' (Info index: emacs)
497 ;; `anything-c-source-info-elib' (Info index: elib)
498 ;; `anything-c-source-info-eieio' (Info index: eieio)
499 ;; `anything-c-source-info-gauche-refe' (Info index: gauche)
500 ;; `anything-c-source-info-guile' (Info index: guile)
501 ;; `anything-c-source-info-guile-tut' (Info index: guile-tut)
502 ;; `anything-c-source-info-goops' (Info index: goops)
503 ;; `anything-c-source-info-screen' (Info index: screen)
504 ;; `anything-c-source-info-latex' (Info index: latex)
505 ;; `anything-c-source-info-gawk' (Info index: gawk)
506 ;; `anything-c-source-info-sed' (Info index: sed)
507 ;; `anything-c-source-info-m4' (Info index: m4)
508 ;; `anything-c-source-info-wget' (Info index: wget)
509 ;; `anything-c-source-info-binutils' (Info index: binutils)
510 ;; `anything-c-source-info-as' (Info index: as)
511 ;; `anything-c-source-info-bfd' (Info index: bfd)
512 ;; `anything-c-source-info-gprof' (Info index: gprof)
513 ;; `anything-c-source-info-ld' (Info index: ld)
514 ;; `anything-c-source-info-diff' (Info index: diff)
515 ;; `anything-c-source-info-flex' (Info index: flex)
516 ;; `anything-c-source-info-grep' (Info index: grep)
517 ;; `anything-c-source-info-gzip' (Info index: gzip)
518 ;; `anything-c-source-info-libtool' (Info index: libtool)
519 ;; `anything-c-source-info-texinfo' (Info index: texinfo)
520 ;; `anything-c-source-info-info' (Info index: info)
521 ;; `anything-c-source-info-gdb' (Info index: gdb)
522 ;; `anything-c-source-info-stabs' (Info index: stabs)
523 ;; `anything-c-source-info-cvsbook' (Info index: cvsbook)
524 ;; `anything-c-source-info-cvs' (Info index: cvs)
525 ;; `anything-c-source-info-bison' (Info index: bison)
526 ;; `anything-c-source-info-id-utils' (Info index: id-utils)
527 ;; `anything-c-source-info-global' (Info index: global)
528 ;; `anything-c-source-man-pages' (Manual Pages)
529 ;; `anything-c-source-complex-command-history' (Complex Command History)
530 ;; `anything-c-source-extended-command-history' (Emacs Commands History)
531 ;; `anything-c-source-emacs-commands' (Emacs Commands)
532 ;; `anything-c-source-lacarte' (Lacarte)
533 ;; `anything-c-source-emacs-functions' (Emacs Functions)
534 ;; `anything-c-source-emacs-functions-with-abbrevs' (Emacs Functions)
535 ;; `anything-c-source-advice' (Function Advice)
536 ;; `anything-c-source-emacs-variables' (Emacs Variables)
537 ;; `anything-c-source-bookmarks' (Bookmarks)
538 ;; `anything-c-source-bookmark-set' (Set Bookmark)
539 ;; `anything-c-source-bm' (Visible Bookmarks)
540 ;; `anything-c-source-bookmarks-ssh' (Bookmarks-ssh)
541 ;; `anything-c-source-bookmarks-su' (Bookmarks-root)
542 ;; `anything-c-source-bookmarks-local' (Bookmarks-Local)
543 ;; `anything-c-source-bmkext-addressbook' (Bookmark Addressbook)
544 ;; `anything-c-source-bookmark-w3m' (Bookmark W3m)
545 ;; `anything-c-source-bookmark-images' (Bookmark Images)
546 ;; `anything-c-source-bookmark-man' (Bookmark Woman&Man)
547 ;; `anything-c-source-bookmark-gnus' (Bookmark Gnus)
548 ;; `anything-c-source-bookmark-info' (Bookmark Info)
549 ;; `anything-c-source-bookmark-files&dirs' (Bookmark Files&Directories)
550 ;; `anything-c-source-bookmark-su-files&dirs' (Bookmark Root-Files&Directories)
551 ;; `anything-c-source-bookmark-ssh-files&dirs' (Bookmark Ssh-Files&Directories)
552 ;; `anything-c-source-firefox-bookmarks' (Firefox Bookmarks)
553 ;; `anything-c-source-w3m-bookmarks' (W3m Bookmarks)
554 ;; `anything-c-source-elisp-library-scan' (Elisp libraries (Scan))
555 ;; `anything-c-source-imenu' (Imenu)
556 ;; `anything-c-source-ctags' (Exuberant ctags)
557 ;; `anything-c-source-semantic' (Semantic Tags)
558 ;; `anything-c-source-simple-call-tree-functions-callers' (Function is called by)
559 ;; `anything-c-source-simple-call-tree-callers-functions' (Function calls)
560 ;; `anything-c-source-commands-and-options-in-file' (Commands/Options in file)
561 ;; `anything-c-source-customize-face' (Customize Face)
562 ;; `anything-c-source-colors' (Colors)
563 ;; `anything-c-source-tracker-search' (Tracker Search)
564 ;; `anything-c-source-mac-spotlight' (mdfind)
565 ;; `anything-c-source-kill-ring' (Kill Ring)
566 ;; `anything-c-source-mark-ring' (mark-ring)
567 ;; `anything-c-source-global-mark-ring' (global-mark-ring)
568 ;; `anything-c-source-register' (Registers)
569 ;; `anything-c-source-latex-math' (Latex Math Menu)
570 ;; `anything-c-source-fixme' (TODO/FIXME/DRY comments)
571 ;; `anything-c-source-rd-headline' (RD HeadLine)
572 ;; `anything-c-source-oddmuse-headline' (Oddmuse HeadLine)
573 ;; `anything-c-source-emacs-source-defun' (Emacs Source DEFUN)
574 ;; `anything-c-source-emacs-lisp-expectations' (Emacs Lisp Expectations)
575 ;; `anything-c-source-emacs-lisp-toplevels' (Emacs Lisp Toplevel / Level 4 Comment / Linkd Star)
576 ;; `anything-c-source-org-headline' (Org HeadLine)
577 ;; `anything-c-source-yaoddmuse-emacswiki-edit-or-view' (Yaoddmuse Edit or View (EmacsWiki))
578 ;; `anything-c-source-yaoddmuse-emacswiki-post-library' (Yaoddmuse Post library (EmacsWiki))
579 ;; `anything-c-source-eev-anchor' (Anchors)
580 ;; `anything-c-source-org-keywords' (Org Keywords)
581 ;; `anything-c-source-picklist' (Picklist)
582 ;; `anything-c-source-bbdb' (BBDB)
583 ;; `anything-c-source-evaluation-result' (Evaluation Result)
584 ;; `anything-c-source-calculation-result' (Calculation Result)
585 ;; `anything-c-source-google-suggest' (Google Suggest)
586 ;; `anything-c-source-yahoo-suggest' (Yahoo Suggest)
587 ;; `anything-c-source-emms-streams' (Emms Streams)
588 ;; `anything-c-source-emms-dired' (Music Directory)
589 ;; `anything-c-source-emms-files' (Emms files)
590 ;; `anything-c-source-jabber-contacts' (Jabber Contacts)
591 ;; `anything-c-source-call-source' (Call anything source)
592 ;; `anything-c-source-anything-commands' (Preconfigured Anything)
593 ;; `anything-c-source-occur' (Occur)
594 ;; `anything-c-source-browse-code' (Browse code)
595 ;; `anything-c-source-create' (Create)
596 ;; `anything-c-source-minibuffer-history' (Minibuffer History)
597 ;; `anything-c-source-elscreen' (Elscreen)
598 ;; `anything-c-source-top' (Top (Press C-c C-u to refresh))
599 ;; `anything-c-source-absolute-time-timers' (Absolute Time Timers)
600 ;; `anything-c-source-idle-time-timers' (Idle Time Timers)
601 ;; `anything-c-source-xrandr-change-resolution' (Change Resolution)
602 ;; `anything-c-source-xfonts' (X Fonts)
603 ;; `anything-c-source-time-world' (Time World List)
604 ;; `anything-c-source-apt' (APT)
605 ;; `anything-c-source-gentoo' (Portage sources)
606 ;; `anything-c-source-use-flags' (Use Flags)
607 ;; `anything-c-source-emacs-process' (Emacs Process)
608 ;; `anything-c-source-esh' (Eshell completions)
609 ;; `anything-c-source-eshell-history' (Eshell history)
610 ;; `anything-c-source-ratpoison-commands' (Ratpoison Commands)
612 ;; *** END auto-documentation
615 ;;; Change log:
617 ;; Change log of this file is found at
618 ;; http://repo.or.cz/w/anything-config.git/history/master:/anything-config.el
620 ;; Change log of this project is found at
621 ;; http://repo.or.cz/w/anything-config.git?a=shortlog
623 ;;; Contributors:
625 ;; Tamas Patrovics
626 ;; Tassilo Horn <tassilo@member.fsf.org>
627 ;; Vagn Johansen <gonz808@hotmail.com>
628 ;; Mathias Dahl <mathias.dahl@gmail.com>
629 ;; Bill Clementson <billclem@gmail.com>
630 ;; Stefan Kamphausen (see http://www.skamphausen.de for more informations)
631 ;; Drew Adams <drew.adams@oracle.com>
632 ;; Jason McBrayer <jmcbray@carcosa.net>
633 ;; Andy Stewart <lazycat.manatee@gmail.com>
634 ;; Thierry Volpiatto <thierry.volpiatto@gmail.com>
635 ;; rubikitch <rubikitch@ruby-lang.org>
636 ;; Scott Vokes <vokes.s@gmail.com>
637 ;; Kenichirou Oyama <k1lowxb@gmail.com>
639 ;;; For Maintainers:
641 ;; Evaluate (autodoc-update-all) before commit. This function
642 ;; generates anything-c-source-* / functions / options list.
644 ;; Install also developer-tools/autodoc.el
645 ;; And eval it or run interactively.
647 ;; [EVAL IT] (autodoc-update-all)
649 ;; Please write details documentation about function, then others will
650 ;; read code more easier. -- Andy Stewart
654 ;;; TODO
656 ;; - Fix documentation, now many functions haven't documentations.
659 ;;; Code:
662 ;;; Require
665 (require 'anything)
666 (require 'thingatpt)
667 (require 'ffap)
668 (require 'cl)
669 (require 'dired-aux)
670 (require 'dired-x)
671 (require 'tramp)
672 (require 'grep)
673 (require 'url)
674 (require 'xml)
675 (eval-when-compile (require 'org)) ; Shut up byte compiler about org-directory.
676 (eval-when-compile (require 'semantic nil t))
677 (require 'anything-match-plugin)
681 ;;; Declare external functions
684 (declare-function gnus-dired-attach "ext:gnus-dired.el" (files-to-attach))
685 (declare-function image-dired-display-image "image-dired.el" (file &optional original-size))
686 (declare-function image-dired-update-property "image-dired.el" (prop value))
687 (declare-function woman-file-name-all-completions "woman.el" (topic))
688 (declare-function Man-getpage-in-background "man.el" (topic))
689 (declare-function simple-call-tree-analyze "ext:simple-call-tree.el" (&optional test))
690 (declare-function yaoddmuse-update-pagename "ext:yaoddmuse.el" (&optional unforced))
691 (declare-function yaoddmuse-get-library-list "ext:yaoddmuse.el" (&optional dirs string))
692 (declare-function org-get-current-options "ext:org-exp.el")
693 (declare-function emms-streams "ext:emms-streams")
694 (declare-function emms-stream-delete-bookmark "ext:emms-streams")
695 (declare-function emms-stream-add-bookmark "ext:emms-streams" (name url fd type))
696 (declare-function emms-stream-save-bookmarks-file "ext:emms-streams")
697 (declare-function emms-stream-quit "ext:emms-streams")
698 (declare-function with-current-emms-playlist "ext:emms" (&rest body))
699 (declare-function emms-playlist-tracks-in-region "ext:emms" (beg end))
700 (declare-function emms-playlist-first "ext:emms")
701 (declare-function emms-playlist-mode-play-smart "ext:emms-playlist-mode")
702 (declare-function term-line-mode "term")
703 (declare-function term-char-mode "term")
704 (declare-function term-send-input "term")
705 (declare-function term-send-eof "term")
706 (declare-function Info-index-nodes "info" (&optional file))
707 (declare-function Info-goto-node "info" (&optional fork))
708 (declare-function elscreen-find-screen-by-buffer "ext:elscreen.el" (buffer &optional create))
709 (declare-function elscreen-find-file "ext:elscreen.el" (filename))
710 (declare-function elscreen-goto "ext:elscreen.el" (screen))
711 (declare-function semantic-format-tag-summarize "ext:format.el" (tag &optional parent color) t)
712 (declare-function semantic-tag-components "ext:tag.el" (tag) t)
713 (declare-function semantic-go-to-tag "ext:tag-file.el" (tag) t)
714 (declare-function semantic-tag-type "ext:tag-file.el" (tag) t)
715 (declare-function semantic-tag-class "ext:tag-file.el" (tag) t)
716 (declare-function bbdb "ext:bbdb-com")
717 (declare-function bbdb-current-record "ext:bbdb-com")
718 (declare-function bbdb-redisplay-one-record "ext:bbdb-com")
719 (declare-function bbdb-record-net "ext:bbdb-com" (string) t)
720 (declare-function bbdb-current-record "ext:bbdb-com")
721 (declare-function bbdb-dwim-net-address "ext:bbdb-com")
722 (declare-function bbdb-records "ext:bbdb-com"
723 (&optional dont-check-disk already-in-db-buffer))
724 (declare-function eshell-read-aliases-list "em-alias")
725 (declare-function eshell-send-input "esh-mode" (&optional use-region queue-p no-newline))
726 (declare-function eldoc-current-symbol "eldoc")
727 (declare-function eldoc-get-fnsym-args-string "eldoc" (sym &optional index))
728 (declare-function eldoc-get-var-docstring "eldoc" (sym))
729 (declare-function eldoc-fnsym-in-current-sexp "eldoc")
730 (declare-function find-library-name "find-func.el" (library))
731 (declare-function adoc-construct "ext:auto-document.el" (buf))
732 (declare-function adoc-first-line "ext:auto-document.el" (str))
733 (declare-function adoc-prin1-to-string "ext:auto-document.el" (object))
737 ;;; compatibility
740 (unless (fboundp 'window-system)
741 (defun window-system (&optional arg)
742 window-system))
746 ;;; Customize
749 (defgroup anything-config nil
750 "Predefined configurations for `anything.el'."
751 :group 'anything)
753 (defcustom anything-c-adaptive-history-file
754 "~/.emacs.d/anything-c-adaptive-history"
755 "Path of file where history information is stored."
756 :type 'string
757 :group 'anything-config)
759 (defcustom anything-c-adaptive-history-length 50
760 "Maximum number of candidates stored for a source."
761 :type 'number
762 :group 'anything-config)
764 (defcustom anything-c-google-suggest-url
765 "http://google.com/complete/search?output=toolbar&q="
766 "URL used for looking up Google suggestions."
767 :type 'string
768 :group 'anything-config)
770 (defcustom anything-c-google-suggest-search-url
771 "http://www.google.com/search?ie=utf-8&oe=utf-8&q="
772 "URL used for Google searching."
773 :type 'string
774 :group 'anything-config)
776 (defcustom anything-google-suggest-use-curl-p nil
777 "*When non--nil use CURL to get info from `anything-c-google-suggest-url'.
778 Otherwise `url-retrieve-synchronously' is used."
779 :type 'boolean
780 :group 'anything-config)
782 (defcustom anything-c-yahoo-suggest-url
783 "http://search.yahooapis.com/WebSearchService/V1/relatedSuggestion?appid=Generic&query="
784 "Url used for looking up Yahoo suggestions."
785 :type 'string
786 :group 'anything-config)
788 (defcustom anything-c-yahoo-suggest-search-url
789 "http://search.yahoo.com/search?&ei=UTF-8&fr&h=c&p="
790 "Url used for Yahoo searching."
791 :type 'string
792 :group 'anything-config)
794 (defcustom anything-c-boring-buffer-regexp
795 (rx (or
796 (group bos " ")
797 ;; anything-buffer
798 "*anything"
799 ;; echo area
800 " *Echo Area" " *Minibuf"))
801 "The regexp that match boring buffers.
802 Buffer candidates matching this regular expression will be
803 filtered from the list of candidates if the
804 `anything-c-skip-boring-buffers' candidate transformer is used, or
805 they will be displayed with face `file-name-shadow' if
806 `anything-c-shadow-boring-buffers' is used."
807 :type 'string
808 :group 'anything-config)
809 ;; (string-match anything-c-boring-buffer-regexp "buf")
810 ;; (string-match anything-c-boring-buffer-regexp " hidden")
811 ;; (string-match anything-c-boring-buffer-regexp " *Minibuf-1*")
813 (defcustom anything-c-boring-file-regexp
814 (rx (or
815 ;; Boring directories
816 (and "/" (or ".svn" "CVS" "_darcs" ".git" ".hg") (or "/" eol))
817 ;; Boring files
818 (and line-start ".#")
819 (and (or ".class" ".la" ".o" "~") eol)))
820 "The regexp that match boring files.
821 File candidates matching this regular expression will be
822 filtered from the list of candidates if the
823 `anything-c-skip-boring-files' candidate transformer is used, or
824 they will be displayed with face `file-name-shadow' if
825 `anything-c-shadow-boring-files' is used."
826 :type 'string
827 :group 'anything-config)
829 (defcustom anything-kill-ring-threshold 10
830 "*Minimum length to be listed by `anything-c-source-kill-ring'."
831 :type 'integer
832 :group 'anything-config)
834 (defcustom anything-c-kill-ring-max-lines-number nil
835 "Max number of lines displayed per candidate in kill-ring browser.
836 If nil or zero, don't truncate candidate, show all."
837 :type 'integer
838 :group 'anything-config)
840 (defcustom anything-su-or-sudo "su"
841 "What command to use for root access."
842 :type 'string
843 :group 'anything-config)
845 (defcustom anything-for-files-prefered-list
846 '(anything-c-source-ffap-line
847 anything-c-source-ffap-guesser
848 anything-c-source-buffers-list
849 anything-c-source-recentf
850 anything-c-source-bookmarks
851 anything-c-source-file-cache
852 anything-c-source-files-in-current-dir+
853 anything-c-source-locate)
854 "Your prefered sources to find files."
855 :type 'list
856 :group 'anything-config)
858 (defcustom anything-create--actions-private nil
859 "User defined actions for `anything-create' / `anything-c-source-create'.
860 It is a list of (DISPLAY . FUNCTION) pairs like `action'
861 attribute of `anything-sources'.
863 It is prepended to predefined pairs."
864 :type 'list
865 :group 'anything-config)
867 (defcustom anything-allow-skipping-current-buffer t
868 "Show current buffer or not in anything buffer"
869 :type 'boolean
870 :group 'anything-config)
872 (defcustom anything-c-enable-eval-defun-hack t
873 "*If non-nil, execute `anything' using the source at point when C-M-x is pressed.
874 This hack is invoked when pressing C-M-x in the form \
875 (defvar anything-c-source-XXX ...) or (setq anything-c-source-XXX ...)."
876 :type 'boolean
877 :group 'anything-config)
879 (defcustom anything-tramp-verbose 0
880 "*Just like `tramp-verbose' but specific to anything.
881 When set to 0 don't show tramp messages in anything.
882 If you want to have the default tramp messages set it to 3."
883 :type 'integer
884 :group 'anything-config)
886 (defcustom anything-raise-command nil
887 "*A shell command to jump to a window running specific program.
888 Need external program wmctrl.
889 This will be use with `format', so use something like \"wmctrl -xa %s\"."
890 :type 'string
891 :group 'anything-config)
893 (defun anything-set-anything-command-map-prefix-key (var key)
894 (declare (special anything-command-map-prefix-key))
895 (when (boundp 'anything-command-map-prefix-key)
896 (global-unset-key (read-kbd-macro anything-command-map-prefix-key)))
897 (setq anything-command-map-prefix-key key)
898 (global-set-key (read-kbd-macro anything-command-map-prefix-key)
899 'anything-command-map))
901 (defcustom anything-command-map-prefix-key "<f5> a"
902 "*The prefix key for all `anything-command-map' commands.
904 !!WARNING!!
905 This default value is very likely to be changed,
906 because it is under discussion."
907 :type 'string
908 :set 'anything-set-anything-command-map-prefix-key
909 :group 'anything-config)
911 (defcustom anything-c-find-files-show-icons nil
912 "*Whether show or hide icons in `anything-find-files'."
913 :type 'boolean
914 :group 'anything-config)
916 (defcustom anything-c-find-files-icons-directory
917 (and (window-system)
918 (dolist (i image-load-path)
919 (if (file-directory-p (expand-file-name "tree-widget/default" (eval i)))
920 (return (expand-file-name "tree-widget/default" (eval i))))))
921 "*Default path where to find files and directory icons."
922 :type 'string
923 :group 'anything-config)
925 (defcustom anything-c-browse-code-regexp-lisp
926 "^ *\(def\\(un\\|subst\\|macro\\|face\\|alias\\|advice\\|struct\\|\
927 type\\|theme\\|var\\|group\\|custom\\|const\\|method\\|class\\)"
928 "*Regexp used to parse lisp buffer when browsing code."
929 :type 'string
930 :group 'anything-config)
932 (defcustom anything-c-browse-code-regexp-python
933 "\\<def\\>\\|\\<class\\>"
934 "*Regexp used to parse python buffer when browsing code."
935 :type 'string
936 :group 'anything-config)
938 (defcustom anything-c-browse-code-regexp-alist
939 `((lisp-interaction-mode . ,anything-c-browse-code-regexp-lisp)
940 (emacs-lisp-mode . ,anything-c-browse-code-regexp-lisp)
941 (lisp-mode . ,anything-c-browse-code-regexp-lisp)
942 (python-mode . ,anything-c-browse-code-regexp-python))
943 "*Alist to store regexps for browsing code corresponding \
944 to a specific `major-mode'."
945 :type 'list
946 :group 'anything-config)
948 (defcustom anything-c-external-programs-associations nil
949 "*Alist to store externals programs associated with file extension.
950 This variable overhide setting in .mailcap file.
951 e.g : '\(\(\"jpg\" . \"gqview\"\) (\"pdf\" . \"xpdf\"\)\) "
952 :type 'list
953 :group 'anything-config)
955 (defcustom anything-ff-auto-update-initial-value t
956 "Auto update when only one candidate directory is matched.
957 This is the default value when starting `anything-find-files'."
958 :group 'anything-config
959 :type 'boolean)
961 (defcustom anything-c-copy-async-prefered-emacs "emacs"
962 "Path to the emacs you want to use for copying async.
963 Emacs versions < 24 fail to copy directory due to a bug not fixed
964 in `copy-directory'."
965 :group 'anything-config
966 :type 'string)
968 (defcustom anything-ff-lynx-style-map t
969 "Use arrow keys to navigate with `anything-find-files'."
970 :group 'anything-config
971 :type 'boolean)
973 (defcustom anything-ff-history-max-length 100
974 "*Number of elements shown in `anything-find-files' history."
975 :group 'anything-config
976 :type 'integer)
978 (defcustom anything-ff-smart-completion t
979 "Try to complete filenames smarter when non--nil.
980 See `anything-ff-transform-fname-for-completion' for more info."
981 :group 'anything-config
982 :type 'boolean)
984 (defcustom anything-ff-default-kbsize 1024.0
985 "Default Kbsize to use for showing files size.
986 It is a float, usually 1024.0 but could be 1000.0 on some systems."
987 :group 'anything-config
988 :type 'float)
990 (defcustom anything-ff-tramp-not-fancy t
991 "No colors when listing remote files when set to non--nil.
992 This make listing much faster, specially on slow machines."
993 :group 'anything-config
994 :type 'boolean)
996 (defcustom anything-ff-exif-data-program "exiftran"
997 "*Program used to extract exif data of an image file."
998 :group 'anything-config
999 :type 'string)
1001 (defcustom anything-ff-exif-data-program-args "-d"
1002 "*Arguments used for `anything-ff-exif-data-program'."
1003 :group 'anything-config
1004 :type 'string)
1006 (defcustom anything-c-grep-use-ioccur-style-keys t
1007 "Use Arrow keys to jump to occurences."
1008 :group 'anything-config
1009 :type 'boolean)
1011 (defcustom anything-c-pdfgrep-default-read-command "xpdf '%f' %p"
1012 "Default command to read pdf files from pdfgrep.
1013 Where '%f' format spec is filename and '%p' is page number"
1014 :group 'anything-config
1015 :type 'string)
1017 (defcustom anything-c-etags-tag-file-name "TAGS"
1018 "Etags tag file name."
1019 :type 'string
1020 :group 'anything-config)
1022 (defcustom anything-c-etags-tag-file-search-limit 10
1023 "The limit level of directory to search tag file.
1024 Don't search tag file deeply if outside this value."
1025 :type 'number
1026 :group 'anything-config)
1028 (defcustom anything-c-filelist-file-name nil
1029 "Filename of file list.
1030 Accept a list of string for multiple files.
1032 This file tend to be very large \(> 100MB\) and recommend to be in ramdisk for speed.
1033 File list is created by make-filelist.rb script.
1035 Usage:
1036 ruby make-filelist.rb > /tmp/all.filelist
1038 Then
1039 ;; Assume that /tmp is ramdisk or tmpfs
1040 \(setq anything-grep-candidates-fast-directory-regexp \"^/tmp/\"\)
1041 \(setq anything-c-filelist-file-name \"/tmp/all.filelist\"\)
1043 :type 'string
1044 :group 'anything-config)
1046 (defcustom anything-c-eldoc-in-minibuffer-show-fn
1047 'anything-c-eldoc-show-in-mode-line
1048 "A function to display eldoc info.
1049 Should take one arg: the string to display."
1050 :group 'anything-config
1051 :type 'symbol)
1053 (defcustom anything-c-turn-on-show-completion t
1054 "Display candidate in buffer while moving selection when non--nil."
1055 :group 'anything-config
1056 :type 'boolean)
1058 (defcustom anything-lisp-completion-or-indent-delay 0.6
1059 "After this delay `anything-lisp-completion-counter' is reset to 0.
1060 This allow to indent again without completing lisp symbol after this delay.
1061 Default is 0.6 seconds."
1062 :group 'anything-config
1063 :type 'number)
1065 (defcustom anything-c-default-external-file-browser "nautilus"
1066 "Default external file browser for your system.
1067 Directories will be opened externally with it.
1068 Set to nil if you do not have external file browser
1069 or do not want to use it."
1070 :group 'anything-config
1071 :type 'string)
1073 (defcustom anything-c-use-adaptative-sorting nil
1074 "*Wheter to use or not adaptative sorting.
1075 Even if a source use it, it will have no effect when set to nil."
1076 :type 'boolean
1077 :group 'anything-config)
1079 (defcustom anything-ff-newfile-prompt-p t
1080 "Whether Prompt or not when creating new file.
1081 This set `ffap-newfile-prompt'."
1082 :type 'boolean
1083 :group 'anything-config)
1086 (defcustom anything-ff-avfs-directory nil
1087 "*The default avfs directory, usually '.avfs'.
1088 When this is set you will be able to expand archive filenames with `C-z'
1089 inside an avfs directory mounted with mountavfs.
1090 See <http://sourceforge.net/projects/avf/>."
1091 :type 'boolean
1092 :group 'anything-config)
1094 (defcustom anything-ff-file-compressed-list '("gz" "bz2" "zip" "7z")
1095 "*Minimal list of compressed files extension."
1096 :type 'list
1097 :group 'anything-config)
1099 (defcustom anything-locate-db-file-regexp "m?locate\.db$"
1100 "Default regexp to match locate database.
1101 If nil Search in all files."
1102 :type 'string
1103 :group 'anything-config)
1105 (defcustom anything-c-eldoc-show-in-mode-line-delay 12
1106 "Eldoc will show info in mode-line during this delay if user is idle."
1107 :type 'integer
1108 :group 'anything-config)
1110 (defcustom anything-c-copy-files-async-log-file "/tmp/dired.log"
1111 "The file used to communicate with two emacs when copying files async."
1112 :type 'string
1113 :group 'anything-config)
1115 (defcustom anything-ff-printer-list nil
1116 "A list of available printers on your system.
1117 When non--nil let you choose a printer to print file.
1118 Otherwise when nil the variable `printer-name' will be used.
1119 On Unix based systems you can use `anything-ff-find-printers' to
1120 find a list of available printers."
1121 :type 'list
1122 :group 'anything-config)
1126 ;;; General internal variables
1129 (defvar anything-c-external-commands-list nil
1130 "A list of all external commands the user can execute. If this
1131 variable is not set by the user, it will be calculated
1132 automatically.")
1135 ;;; Faces
1138 (defface anything-buffer-saved-out
1139 '((t (:foreground "red")))
1140 "*Face used for buffer files modified outside of emacs."
1141 :group 'anything-config)
1143 (defface anything-buffer-not-saved
1144 '((t (:foreground "Indianred2")))
1145 "*Face used for buffer files not already saved on disk."
1146 :group 'anything-config)
1148 (defface anything-ff-prefix
1149 '((t (:background "yellow" :foreground "black")))
1150 "*Face used to prefix new file or url paths in `anything-find-files'."
1151 :group 'anything-config)
1153 (defface anything-ff-executable
1154 '((t (:foreground "green")))
1155 "*Face used for executable files in `anything-find-files'."
1156 :group 'anything-config)
1158 (defface anything-ff-directory
1159 '((t (:foreground "DarkRed" :background "LightGray")))
1160 "*Face used for directories in `anything-find-files'."
1161 :group 'anything-config)
1163 (defface anything-ff-symlink
1164 '((t (:foreground "DarkOrange")))
1165 "*Face used for symlinks in `anything-find-files'."
1166 :group 'anything-config)
1168 (defface anything-ff-invalid-symlink
1169 '((t (:foreground "black" :background "red")))
1170 "*Face used for invalid symlinks in `anything-find-files'."
1171 :group 'anything-config)
1173 (defface anything-ff-file
1174 '((t (:foreground "CadetBlue" :underline t)))
1175 "*Face used for file names in `anything-find-files'."
1176 :group 'anything-config)
1178 (defface anything-grep-match
1179 '((t (:inherit match)))
1180 "Face used to highlight grep matches."
1181 :group 'anything-config)
1183 (defface anything-grep-file
1184 '((t (:foreground "BlueViolet" :underline t)))
1185 "Face used to highlight grep results filenames."
1186 :group 'anything-config)
1188 (defface anything-grep-lineno
1189 '((t (:foreground "Darkorange1")))
1190 "Face used to highlight grep number lines."
1191 :group 'anything-config)
1193 (defface anything-grep-running
1194 '((t (:foreground "Red")))
1195 "Face used in mode line when grep is running."
1196 :group 'anything-config)
1198 (defface anything-grep-finish
1199 '((t (:foreground "Green")))
1200 "Face used in mode line when grep is finish."
1201 :group 'anything-config)
1203 (defface anything-M-x-key-face '((t (:foreground "orange" :underline t)))
1204 "*Face used in anything-M-x to show keybinding."
1205 :group 'anything)
1207 (defface anything-bmkext-info
1208 '((t (:foreground "green")))
1209 "*Face used for W3m Emacs bookmarks (not w3m bookmarks)."
1210 :group 'anything)
1212 (defface anything-bmkext-w3m
1213 '((t (:foreground "yellow")))
1214 "*Face used for W3m Emacs bookmarks (not w3m bookmarks)."
1215 :group 'anything)
1217 (defface anything-bmkext-gnus
1218 '((t (:foreground "magenta")))
1219 "*Face used for Gnus bookmarks."
1220 :group 'anything)
1222 (defface anything-bmkext-man
1223 '((t (:foreground "Orange4")))
1224 "*Face used for Woman/man bookmarks."
1225 :group 'anything)
1227 (defface anything-bmkext-no--file
1228 '((t (:foreground "grey")))
1229 "*Face used for non--file bookmarks."
1230 :group 'anything)
1232 (defface anything-bmkext-file
1233 '((t (:foreground "Deepskyblue2")))
1234 "*Face used for non--file bookmarks."
1235 :group 'anything)
1237 (defface anything-bookmarks-su-face '((t (:foreground "red")))
1238 "Face for su/sudo bookmarks."
1239 :group 'anything)
1241 (defface anything-w3m-bookmarks-face '((t (:foreground "cyan1" :underline t)))
1242 "Face for w3m bookmarks" :group 'anything)
1244 (defface anything-emms-playlist
1245 '((t (:foreground "Springgreen4" :underline t)))
1246 "*Face used for tracks in current emms playlist."
1247 :group 'anything)
1249 (defface anything-apt-installed
1250 '((t (:foreground "green")))
1251 "*Face used for apt installed candidates."
1252 :group 'anything)
1254 (defface anything-gentoo-match-face '((t (:foreground "red")))
1255 "Face for anything-gentoo installed packages."
1256 :group 'traverse-faces)
1258 (defface anything-lisp-show-completion
1259 '((t (:background "DarkSlateGray")))
1260 "*Face used for showing candidates in `anything-lisp-completion'."
1261 :group 'anything-config)
1263 (defface anything-lisp-completion-info
1264 '((t (:foreground "red")))
1265 "*Face used for showing info in `anything-lisp-completion'."
1266 :group 'anything-config)
1268 (defface anything-overlay-line-face '((t (:background "IndianRed4" :underline t)))
1269 "Face for source header in the anything buffer." :group 'anything)
1271 ;;;###autoload
1272 (defun anything-configuration ()
1273 "Customize `anything'."
1274 (interactive)
1275 (customize-group "anything-config"))
1279 ;;; Anything-command-map
1282 ;;;###autoload
1283 (defvar anything-command-map)
1284 (define-prefix-command 'anything-command-map)
1287 (define-key anything-command-map (kbd "<SPC>") 'anything-execute-anything-command)
1288 (define-key anything-command-map (kbd "e") 'anything-c-etags-select)
1289 (define-key anything-command-map (kbd "l") 'anything-locate)
1290 (define-key anything-command-map (kbd "s") 'anything-surfraw)
1291 (define-key anything-command-map (kbd "r") 'anything-regexp)
1292 (define-key anything-command-map (kbd "w") 'anything-w3m-bookmarks)
1293 (define-key anything-command-map (kbd "x") 'anything-firefox-bookmarks)
1294 (define-key anything-command-map (kbd "#") 'anything-emms)
1295 (define-key anything-command-map (kbd "m") 'anything-man-woman)
1296 (define-key anything-command-map (kbd "t") 'anything-top)
1297 (define-key anything-command-map (kbd "i") 'anything-imenu)
1298 (define-key anything-command-map (kbd "<tab>") 'anything-lisp-completion-at-point)
1299 (define-key anything-command-map (kbd "p") 'anything-list-emacs-process)
1300 (define-key anything-command-map (kbd "C-x r b") 'anything-c-pp-bookmarks)
1301 (define-key anything-command-map (kbd "M-y") 'anything-show-kill-ring)
1302 (define-key anything-command-map (kbd "C-c <SPC>") 'anything-all-mark-rings)
1303 (define-key anything-command-map (kbd "C-x C-f") 'anything-find-files)
1304 (define-key anything-command-map (kbd "f") 'anything-for-files)
1305 (define-key anything-command-map (kbd "C-:") 'anything-eval-expression-with-eldoc)
1306 (define-key anything-command-map (kbd "C-,") 'anything-calcul-expression)
1307 (define-key anything-command-map (kbd "M-x") 'anything-M-x)
1308 (define-key anything-command-map (kbd "C-x C-w") 'anything-write-file)
1309 (define-key anything-command-map (kbd "C-x i") 'anything-insert-file)
1310 (define-key anything-command-map (kbd "M-s o") 'anything-occur)
1311 (define-key anything-command-map (kbd "M-g s") 'anything-do-grep)
1312 (define-key anything-command-map (kbd "c") 'anything-colors)
1313 (define-key anything-command-map (kbd "F") 'anything-select-xfont)
1314 (define-key anything-command-map (kbd "C-c f") 'anything-recentf)
1315 (define-key anything-command-map (kbd "C-c g") 'anything-google-suggest)
1316 (define-key anything-command-map (kbd "h i") 'anything-info-at-point)
1317 (define-key anything-command-map (kbd "h r") 'anything-info-emacs)
1318 (define-key anything-command-map (kbd "h g") 'anything-info-gnus)
1319 (define-key anything-command-map (kbd "C-x C-b") 'anything-buffers-list)
1320 (define-key anything-command-map (kbd "C-c C-b") 'anything-browse-code)
1321 (define-key anything-command-map (kbd "C-x r i") 'anything-register)
1322 (define-key anything-command-map (kbd "C-c C-x") 'anything-c-run-external-command)
1324 ;; In Emacs 23.1.50, minibuffer-local-must-match-filename-map was renamed to
1325 ;; minibuffer-local-filename-must-match-map.
1326 (defvar minibuffer-local-filename-must-match-map (make-sparse-keymap)) ;; Emacs 23.1.+
1327 (defvar minibuffer-local-must-match-filename-map (make-sparse-keymap)) ;; Older Emacsen
1328 (dolist (map (list minibuffer-local-filename-completion-map
1329 minibuffer-local-completion-map
1330 minibuffer-local-must-match-filename-map
1331 minibuffer-local-filename-must-match-map
1332 minibuffer-local-map
1333 minibuffer-local-isearch-map
1334 minibuffer-local-must-match-map
1335 minibuffer-local-ns-map))
1336 (define-key map "\C-r" 'anything-minibuffer-history))
1340 ;;; Menu
1343 (easy-menu-define nil global-map
1344 "`anything' menu"
1345 '("Anything"
1346 ["All anything commands" anything-execute-anything-command t]
1347 ["Find any Files/Buffers" anything-for-files t]
1348 "----"
1349 ("Files:"
1350 ["Find files" anything-find-files t]
1351 ["Recent Files" anything-recentf t]
1352 ["Locate" anything-locate t]
1353 ["Bookmarks" anything-c-pp-bookmarks t])
1354 ("Buffers:"
1355 ["Find buffers" anything-buffers-list t])
1356 ("Commands:"
1357 ["Emacs Commands" anything-M-x t]
1358 ["Externals Commands" anything-c-run-external-command t])
1359 ("Info:"
1360 ["Info at point" anything-info-at-point t]
1361 ["Emacs Manual index" anything-info-emacs t]
1362 ["Gnus Manual index" anything-info-gnus t])
1363 ("Org:"
1364 ["Org keywords" anything-org-keywords t]
1365 ["Org headlines" anything-org-headlines t])
1366 ("Tools:"
1367 ["Occur" anything-occur t]
1368 ["Grep" anything-do-grep t]
1369 ["Etags" anything-c-etags-select t]
1370 ["Lisp complete at point" anything-lisp-completion-at-point t]
1371 ["Browse Kill ring" anything-show-kill-ring t]
1372 ["Browse register" anything-register t]
1373 ["Browse code" anything-browse-code t]
1374 ["Mark Ring" anything-all-mark-rings t]
1375 ["Regexp handler" anything-regexp t]
1376 ["Colors & Faces" anything-colors t]
1377 ["Show xfonts" anything-select-xfont t]
1378 ["Imenu" anything-imenu t]
1379 ["Google Suggest" anything-google-suggest t]
1380 ["Eval expression" anything-eval-expression-with-eldoc t]
1381 ["Calcul expression" anything-calcul-expression t]
1382 ["Man pages" anything-man-woman t]
1383 ["Top externals process" anything-top t]
1384 ["Emacs internals process" anything-list-emacs-process t])
1385 "----"
1386 ["Prefered Options" anything-configuration t]))
1390 ;;; Specialized keymaps
1393 (defvar anything-c-buffer-map
1394 (let ((map (copy-keymap anything-map)))
1395 (define-key map (kbd "C-c ?") 'anything-c-buffer-help)
1396 ;; No need to have separate command for grep and zgrep
1397 ;; as we don't use recursivity for buffers.
1398 ;; So use zgrep for both as it is capable to handle non--compressed files.
1399 (define-key map (kbd "M-g s") 'anything-buffer-run-zgrep)
1400 (define-key map (kbd "C-o") 'anything-buffer-switch-other-window)
1401 (define-key map (kbd "C-c C-o") 'anything-buffer-switch-other-frame)
1402 (define-key map (kbd "C-c =") 'anything-buffer-run-ediff)
1403 (define-key map (kbd "M-=") 'anything-buffer-run-ediff-merge)
1404 (define-key map (kbd "C-=") 'anything-buffer-diff-persistent)
1405 (define-key map (kbd "M-U") 'anything-buffer-revert-persistent)
1406 (define-key map (kbd "M-D") 'anything-buffer-run-kill-buffers)
1407 (define-key map (kbd "C-x C-s") 'anything-buffer-save-persistent)
1408 (define-key map (kbd "C-M-%") 'anything-buffer-run-query-replace-regexp)
1409 (define-key map (kbd "M-%") 'anything-buffer-run-query-replace)
1410 (define-key map (kbd "M-m") 'anything-toggle-all-marks)
1411 (define-key map (kbd "M-a") 'anything-mark-all)
1412 (when (locate-library "elscreen")
1413 (define-key map (kbd "<C-tab>") 'anything-buffer-switch-to-elscreen))
1414 (delq nil map))
1415 "Keymap for buffer sources in anything.")
1417 (defvar anything-find-files-map
1418 (let ((map (copy-keymap anything-map)))
1419 (define-key map (kbd "C-x C-f") 'anything-ff-run-locate)
1420 (define-key map (kbd "M-g s") 'anything-ff-run-grep)
1421 (define-key map (kbd "M-g p") 'anything-ff-run-pdfgrep)
1422 (define-key map (kbd "M-g z") 'anything-ff-run-zgrep)
1423 (define-key map (kbd "M-.") 'anything-ff-run-etags)
1424 (define-key map (kbd "M-R") 'anything-ff-run-rename-file)
1425 (define-key map (kbd "M-C") 'anything-ff-run-copy-file)
1426 (define-key map (kbd "M-B") 'anything-ff-run-byte-compile-file)
1427 (define-key map (kbd "M-L") 'anything-ff-run-load-file)
1428 (define-key map (kbd "M-S") 'anything-ff-run-symlink-file)
1429 (define-key map (kbd "M-D") 'anything-ff-run-delete-file)
1430 (define-key map (kbd "M-K") 'anything-ff-run-kill-buffer-persistent)
1431 (define-key map (kbd "M-e") 'anything-ff-run-switch-to-eshell)
1432 (define-key map (kbd "<M-tab>") 'anything-ff-run-complete-fn-at-point)
1433 (define-key map (kbd "C-o") 'anything-ff-run-switch-other-window)
1434 (define-key map (kbd "C-c C-o") 'anything-ff-run-switch-other-frame)
1435 (define-key map (kbd "C-c C-x") 'anything-ff-run-open-file-externally)
1436 (define-key map (kbd "M-!") 'anything-ff-run-eshell-command-on-file)
1437 (define-key map (kbd "C-=") 'anything-ff-run-ediff-file)
1438 (define-key map (kbd "C-c =") 'anything-ff-run-ediff-merge-file)
1439 (define-key map (kbd "M-p") 'anything-ff-run-switch-to-history)
1440 (define-key map (kbd "M-i") 'anything-ff-properties-persistent)
1441 (define-key map (kbd "C-c ?") 'anything-ff-help)
1442 (define-key map (kbd "C-}") 'anything-narrow-window)
1443 (define-key map (kbd "C-{") 'anything-enlarge-window)
1444 (define-key map (kbd "C-<backspace>") 'anything-ff-run-toggle-auto-update)
1445 (define-key map (kbd "M-a") 'anything-mark-all)
1446 (define-key map (kbd "M-m") 'anything-toggle-all-marks)
1447 (define-key map (kbd "M-u") 'anything-unmark-all)
1448 (define-key map (kbd "C-c C-a") 'anything-ff-run-gnus-attach-files)
1449 (define-key map (kbd "C-c p") 'anything-ff-run-print-file)
1450 ;; Next 2 have no effect if candidate is not an image file.
1451 (define-key map (kbd "M-l") 'anything-ff-rotate-left-persistent)
1452 (define-key map (kbd "M-r") 'anything-ff-rotate-right-persistent)
1453 (define-key map (kbd "C-.") 'anything-find-files-down-one-level)
1454 (define-key map (kbd "C-l") 'anything-find-files-down-one-level)
1455 (define-key map (kbd "C-h C-b") 'anything-send-bug-report-from-anything)
1456 (define-key map (kbd "C-h C-d") 'anything-debug-output)
1457 (when anything-ff-lynx-style-map
1458 (define-key map (kbd "<left>") 'anything-find-files-down-one-level)
1459 (define-key map (kbd "<right>") 'anything-execute-persistent-action))
1460 (delq nil map))
1461 "Keymap for `anything-find-files'.")
1463 (defvar anything-c-read-file-map
1464 (let ((map (copy-keymap anything-map)))
1465 (define-key map (kbd "C-.") 'anything-find-files-down-one-level)
1466 (define-key map (kbd "C-l") 'anything-find-files-down-one-level)
1467 (define-key map (kbd "C-<backspace>") 'anything-ff-run-toggle-auto-update)
1468 (when anything-ff-lynx-style-map
1469 (define-key map (kbd "<left>") 'anything-find-files-down-one-level)
1470 (define-key map (kbd "<right>") 'anything-execute-persistent-action)
1471 (define-key map (kbd "<M-left>") 'anything-previous-source)
1472 (define-key map (kbd "<M-right>") 'anything-next-source))
1473 (delq nil map))
1474 "Keymap for `anything-c-read-file-name'.")
1476 (defvar anything-generic-files-map
1477 (let ((map (copy-keymap anything-map)))
1478 (define-key map (kbd "M-g s") 'anything-ff-run-grep)
1479 (define-key map (kbd "M-g p") 'anything-ff-run-pdfgrep)
1480 (define-key map (kbd "M-D") 'anything-ff-run-delete-file)
1481 (define-key map (kbd "C-o") 'anything-ff-run-switch-other-window)
1482 (define-key map (kbd "M-i") 'anything-ff-properties-persistent)
1483 (define-key map (kbd "C-c C-x") 'anything-ff-run-open-file-externally)
1484 (define-key map (kbd "C-w") 'anything-yank-text-at-point)
1485 (define-key map (kbd "C-c ?") 'anything-generic-file-help)
1486 map)
1487 "Generic Keymap for files.")
1489 (defvar anything-c-grep-map
1490 (let ((map (copy-keymap anything-map)))
1491 (define-key map (kbd "M-<down>") 'anything-c-goto-next-file)
1492 (define-key map (kbd "M-<up>") 'anything-c-goto-precedent-file)
1493 (define-key map (kbd "C-o") 'anything-c-grep-run-other-window-action)
1494 (define-key map (kbd "C-w") 'anything-yank-text-at-point)
1495 (define-key map (kbd "C-x C-s") 'anything-c-grep-run-save-buffer)
1496 (when anything-c-grep-use-ioccur-style-keys
1497 (define-key map (kbd "<right>") 'anything-c-grep-run-persistent-action)
1498 (define-key map (kbd "<left>") 'anything-c-grep-run-default-action))
1499 (define-key map (kbd "C-c ?") 'anything-grep-help)
1500 (delq nil map))
1501 "Keymap used in Grep sources.")
1503 (defvar anything-c-pdfgrep-map
1504 (let ((map (copy-keymap anything-map)))
1505 (define-key map (kbd "M-<down>") 'anything-c-goto-next-file)
1506 (define-key map (kbd "M-<up>") 'anything-c-goto-precedent-file)
1507 (define-key map (kbd "C-w") 'anything-yank-text-at-point)
1508 (define-key map (kbd "C-c ?") 'anything-pdfgrep-help)
1509 map)
1510 "Keymap used in pdfgrep.")
1512 (defvar anything-c-etags-map
1513 (let ((map (copy-keymap anything-map)))
1514 (define-key map (kbd "M-<down>") 'anything-c-goto-next-file)
1515 (define-key map (kbd "M-<up>") 'anything-c-goto-precedent-file)
1516 (define-key map (kbd "C-w") 'anything-yank-text-at-point)
1517 (define-key map (kbd "C-c ?") 'anything-etags-help)
1518 map)
1519 "Keymap used in Etags.")
1521 (defvar anything-eval-expression-map
1522 (let ((map (copy-keymap anything-map)))
1523 (define-key map (kbd "<C-return>") 'anything-eval-new-line-and-indent)
1524 (define-key map (kbd "<tab>") 'lisp-indent-line)
1525 (define-key map (kbd "<C-tab>") 'lisp-complete-symbol)
1526 (define-key map (kbd "C-p") 'previous-line)
1527 (define-key map (kbd "C-n") 'next-line)
1528 (define-key map (kbd "<up>") 'previous-line)
1529 (define-key map (kbd "<down>") 'next-line)
1530 (define-key map (kbd "<right>") 'forward-char)
1531 (define-key map (kbd "<left>") 'backward-char)
1532 map))
1536 ;;; Embeded documentation.
1539 (defun anything-c-list-preconfigured-anything ()
1540 "Collect preconfigured anything functions in this file."
1541 (loop with doc
1542 with sym
1543 for entry in (cdr (assoc
1544 (file-truename (locate-library "anything-config"))
1545 load-history))
1546 if (and (consp entry)
1547 (eq (car entry) 'defun)
1548 (string-match "^Preconfigured.+$"
1549 (setq doc (or (documentation (setq sym (cdr entry)))
1550 ""))))
1551 collect (cons sym (match-string 0 doc))))
1553 (defun anything-c-format-preconfigured-anything ()
1554 (mapcar (lambda (x) (format "\\[%s] : %s\n" (car x) (cdr x)))
1555 (anything-c-list-preconfigured-anything)))
1557 ;;; Global help message - Used by `anything-help'
1560 (setq anything-help-message
1561 (lambda ()
1562 (concat
1563 "\\<anything-map>"
1564 "`anything' is QuickSilver-like candidate-selection framework.
1566 Narrow the list by typing some pattern,
1567 Multiple patterns are allowed by splitting by space.
1568 Select with natural Emacs operations, choose with RET.
1570 If you have any problems, press C-c C-x C-b!!
1571 Feel free to send bug reports. I'll fix them.
1572 The steps are described in the beginning of anything.el file.
1574 == Basic Operations ==
1575 C-p, Up: Previous Line
1576 C-n, Down : Next Line
1577 M-v, PageUp : Previous Page
1578 C-v, PageDown : Next Page
1579 Enter : Execute first (default) action / Select
1580 M-< : First Line
1581 M-> : Last Line
1582 M-PageUp, C-M-S-v, C-M-y : Previous Page (other-window)
1583 M-PageDown, C-M-v : Next Page (other-window)
1585 Tab, C-i : Show action list
1586 Left : Previous Source
1587 Right, C-o : Next Source
1588 C-k : Delete pattern
1589 C-z : Persistent Action (Execute action with anything session kept)
1590 C-c C-x C-b: Send a bug report
1592 == Shortcuts For 2nd/3rd Action ==
1593 \\[anything-select-2nd-action-or-end-of-line] : Execute 2nd Action (if the minibuffer cursor is at end of line)
1594 \\[anything-select-3rd-action] : Execute 3rd Action
1596 == Visible Marks ==
1597 Visible marks store candidate. Some actions uses marked candidates.
1599 \\[anything-toggle-visible-mark] : Toggle Visible Mark
1600 \\[anything-prev-visible-mark] : Previous Mark
1601 \\[anything-next-visible-mark] : Next Mark
1603 == Miscellaneous Commands ==
1604 \\[anything-toggle-resplit-window] : Toggle vertical/horizontal split anything window
1605 \\[anything-quit-and-find-file] : Drop into `find-file'
1606 \\[anything-delete-current-selection] : Delete Selected Item (visually)
1607 \\[anything-kill-selection-and-quit] : Set Item Into the kill-ring And Quit
1608 \\[anything-yank-selection] : Yank Selected Item Into Pattern
1609 \\[anything-follow-mode] : Toggle Automatical Execution Of Persistent Action
1610 \\[anything-force-update] : Recalculate And Redisplay Candidates
1612 == Global Commands ==
1613 \\<global-map>\\[anything-resume] revives last `anything' session.
1614 It is very useful, so you should bind any key.
1616 Single source is executed by \\[anything-call-source].
1618 == Preconfigured `anything' ==
1619 Preconfigured `anything' is commands that uses `anything' interface.
1620 You can use them without configuration.
1623 (apply 'concat (anything-c-format-preconfigured-anything))
1625 Enjoy!")))
1627 ;;; `anything-buffer-list' help
1630 ;;;###autoload
1631 (defun anything-c-buffer-help ()
1632 "Help command for anything buffers."
1633 (interactive)
1634 (let ((anything-help-message "== Anything Buffer ==
1635 \nTips:
1636 You can enter a partial name of major-mode (e.g lisp, sh) to narrow down buffers.
1637 Enter then a space and a pattern to narrow down to buffers matching this pattern.
1638 \nSpecific commands for `anything-buffers-list':
1639 \\<anything-c-buffer-map>
1640 \\[anything-buffer-run-zgrep]\t\t->Grep Buffer(s) works as zgrep too. (C-u grep all buffers but non--file buffers).
1641 \\[anything-buffer-switch-other-window]\t\t->Switch other window.
1642 \\[anything-buffer-switch-other-frame]\t\t->Switch other frame.
1643 \\[anything-buffer-run-query-replace-regexp]\t\t->Query replace regexp in marked buffers.
1644 \\[anything-buffer-run-query-replace]\t\t->Query replace in marked buffers.
1645 \\[anything-buffer-switch-to-elscreen]\t\t->Find buffer in Elscreen.
1646 \\[anything-buffer-run-ediff]\t\t->Ediff current buffer with candidate. If two marked buffers ediff those buffers.
1647 \\[anything-buffer-run-ediff-merge]\t\t->Ediff merge current buffer with candidate. If two marked buffers ediff merge those buffers.
1648 \\[anything-buffer-diff-persistent]\t\t->Toggle Diff buffer with saved file without quitting.
1649 \\[anything-buffer-revert-persistent]\t\t->Revert buffer without quitting.
1650 \\[anything-buffer-save-persistent]\t\t->Save buffer without quitting.
1651 \\[anything-buffer-run-kill-buffers]\t\t->Delete marked buffers and quit.
1652 \\[anything-toggle-all-marks]\t\t->Toggle all marks.
1653 \\[anything-mark-all]\t\t->Mark all.
1654 \\[anything-c-buffer-help]\t\t->Display this help.
1655 \n== Anything Map ==
1656 \\{anything-map}
1658 (anything-help)))
1661 ;;; Find files help (`anything-find-files')
1664 ;;;###autoload
1665 (defun anything-ff-help ()
1666 "Help command for `anything-find-files'."
1667 (interactive)
1668 (let ((anything-help-message "== Anything Find Files ==
1669 \nTips:
1670 \nEnter \"~/\" at anytime to reach home directory.
1671 Enter \"/\" at anytime to reach root of your file system.
1672 You can complete with partial basename \(e.g \"fb\" will complete \"foobar\"\).
1673 Use `C-u C-z' to watch an image.
1674 To browse images directories turn on `anything-follow-mode'.
1675 \nSpecific commands for `anything-find-files':
1676 \\<anything-find-files-map>
1677 \\[anything-ff-run-locate]\t\t->Run Locate on basename of candidate (C-u to specify locate db).
1678 \\[anything-ff-run-grep]\t\t->Run Grep (C-u Recursive).
1679 \\[anything-ff-run-pdfgrep]\t\t->Run Pdfgrep on marked files.
1680 \\[anything-ff-run-zgrep]\t\t->Run zgrep (C-u Recursive).
1681 \\[anything-ff-run-etags]\t\t->Run Etags (C-u use thing-at-point `C-u C-u' reload cache)
1682 \\[anything-ff-run-rename-file]\t\t->Rename File (C-u Follow).
1683 \\[anything-ff-run-copy-file]\t\t->Copy File (C-u Follow).
1684 \\[anything-ff-run-byte-compile-file]\t\t->Byte Compile File (C-u Load).
1685 \\[anything-ff-run-load-file]\t\t->Load File.
1686 \\[anything-ff-run-symlink-file]\t\t->Symlink File.
1687 \\[anything-ff-run-delete-file]\t\t->Delete File.
1688 \\[anything-ff-run-kill-buffer-persistent]\t\t->Kill buffer candidate without quitting.
1689 \\[anything-ff-run-switch-to-eshell]\t\t->Switch to Eshell.
1690 \\[anything-ff-run-eshell-command-on-file]\t\t->Eshell command on file (C-u Run on all marked files at once).
1691 \\[anything-ff-run-ediff-file]\t\t->Ediff file.
1692 \\[anything-ff-run-ediff-merge-file]\t\t->Ediff merge file.
1693 \\[anything-ff-run-complete-fn-at-point]\t\t->Complete file name at point.
1694 \\[anything-ff-run-switch-other-window]\t\t->Switch other window.
1695 \\[anything-ff-run-switch-other-frame]\t\t->Switch other frame.
1696 \\[anything-ff-run-open-file-externally]\t\t->Open file with external program (C-u to choose).
1697 \\[anything-ff-rotate-left-persistent]\t\t->Rotate Image Left.
1698 \\[anything-ff-rotate-right-persistent]\t\t->Rotate Image Right.
1699 \\[anything-find-files-down-one-level]\t\t->Go down precedent directory.
1700 \\[anything-ff-run-switch-to-history]\t\t->Switch to anything find-files history.
1701 \\[anything-ff-properties-persistent]\t\t->Show file properties in a tooltip.
1702 \\[anything-mark-all]\t\t->Mark all visibles candidates.
1703 \\[anything-ff-run-toggle-auto-update]\t->Toggle auto expansion of directories.
1704 \\[anything-unmark-all]\t\t->Unmark all candidates, visibles and invisibles.
1705 \\[anything-ff-run-gnus-attach-files]\t\t->Gnus attach files to message buffer.
1706 \\[anything-ff-run-print-file]\t\t->Print file with default printer.
1707 \\[anything-enlarge-window]\t\t->Enlarge anything window.
1708 \\[anything-narrow-window]\t\t->Narrow anything window.
1709 \\[anything-send-bug-report-from-anything]\t\t->Send Bug report.
1710 \\[anything-ff-help]\t\t->Display this help info.
1711 \n== Anything Map ==
1712 \\{anything-map}
1714 (anything-help)))
1716 ;;; Generic file help - Used by locate.
1719 ;;;###autoload
1720 (defun anything-generic-file-help ()
1721 (interactive)
1722 (let ((anything-help-message "== Anything Generic files Map ==\
1723 \nSpecific commands for anything locate and others files sources:
1724 \\<anything-generic-files-map>
1725 \\[anything-ff-run-grep]\t\t->Run grep (C-u recurse).
1726 \\[anything-ff-run-pdfgrep]\t\t->Run Pdfgrep on marked files.
1727 \\[anything-ff-run-delete-file]\t\t->Delete file.
1728 \\[anything-ff-run-switch-other-window]\t\t->Switch other window.
1729 \\[anything-ff-properties-persistent]\t\t->Show file properties.
1730 \\[anything-yank-text-at-point]\t\t->Yank text at point.
1731 \\[anything-ff-run-open-file-externally]\t\t->Open file with external program (C-u to choose).
1732 \nLocate tips:
1733 You can add after writing search pattern any of the locate command line options.
1734 e.g -b, -e, -n <number>...etc.
1735 See Man locate for more infos.
1736 \n== Anything Map ==
1737 \\{anything-map}"))
1738 (anything-help)))
1741 ;;; Grep help
1744 ;;;###autoload
1745 (defun anything-grep-help ()
1746 (interactive)
1747 (let ((anything-help-message "== Anything Grep Map ==\
1748 \nSpecific commands for Grep and Etags:
1749 \\<anything-c-grep-map>
1750 \\[anything-c-goto-next-file]\t->Next File.
1751 \\[anything-c-goto-precedent-file]\t\t->Precedent File.
1752 \\[anything-yank-text-at-point]\t\t->Yank Text at point in minibuffer.
1753 \\[anything-c-grep-run-other-window-action]\t\t->Jump other window.
1754 \\[anything-c-grep-run-persistent-action]\t\t->Run persistent action (Same as `C-z').
1755 \\[anything-c-grep-run-default-action]\t\t->Run default action (Same as RET).
1756 \\[anything-grep-help]\t\t->Show this help.
1757 \n== Anything Map ==
1758 \\{anything-map}"))
1759 (anything-help)))
1761 ;;; Pdf grep help
1764 ;;;###autoload
1765 (defun anything-pdfgrep-help ()
1766 (interactive)
1767 (let ((anything-help-message "== Anything PdfGrep Map ==\
1768 \nSpecific commands for Pdf Grep:
1769 \\<anything-c-pdfgrep-map>
1770 \\[anything-c-goto-next-file]\t->Next File.
1771 \\[anything-c-goto-precedent-file]\t\t->Precedent File.
1772 \\[anything-yank-text-at-point]\t\t->Yank Text at point in minibuffer.
1773 \\[anything-pdfgrep-help]\t\t->Show this help.
1774 \n== Anything Map ==
1775 \\{anything-map}"))
1776 (anything-help)))
1778 ;;; Etags help
1781 ;;;###autoload
1782 (defun anything-etags-help ()
1783 "The help function for etags."
1784 (interactive)
1785 (let ((anything-help-message "== Anything Etags Map ==\
1786 \nSpecific commands for Etags:
1787 \\<anything-c-etags-map>
1788 \\[anything-c-goto-next-file]\t->Next File.
1789 \\[anything-c-goto-precedent-file]\t\t->Precedent File.
1790 \\[anything-yank-text-at-point]\t\t->Yank Text at point in minibuffer.
1791 \\[anything-etags-help]\t\t->Show this help.
1792 \n== Anything Map ==
1793 \\{anything-map}"))
1794 (anything-help)))
1798 ;;; Mode line strings
1801 (defvar anything-buffer-mode-line-string
1802 '("Buffer(s)"
1803 "\\<anything-c-buffer-map>\
1804 \\[anything-c-buffer-help]:Help, \
1805 \\<anything-map>\
1806 \\[anything-select-action]:Acts,\
1807 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
1808 \\[anything-select-3rd-action]:NthAct,\
1809 \\[anything-send-bug-report-from-anything]:BugReport."
1810 "String displayed in mode-line in `anything-c-source-buffers-list'"))
1812 (defvar anything-ff-mode-line-string
1813 "\\<anything-find-files-map>\
1814 \\[anything-ff-help]:Help, \
1815 \\[anything-send-bug-report-from-anything]:BugReport, \
1816 \\<anything-map>\
1817 \\[anything-select-action]:Acts, \
1818 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
1819 \\[anything-select-3rd-action]:NthAct"
1820 "String displayed in mode-line in `anything-c-source-find-files'")
1822 (defvar anything-generic-file-mode-line-string
1823 "\\<anything-generic-files-map>\
1824 \\[anything-generic-file-help]:Help, \
1825 \\<anything-map>\
1826 \\[anything-select-action]:Acts,\
1827 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
1828 \\[anything-select-3rd-action]:NthAct,\
1829 \\[anything-send-bug-report-from-anything]:BugReport."
1830 "String displayed in mode-line in `anything-c-source-find-files'")
1832 (defvar anything-grep-mode-line-string
1833 "\\<anything-c-grep-map>\
1834 \\[anything-grep-help]:Help,\
1835 \\<anything-map>\
1836 \\[anything-select-action]:Acts,\
1837 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
1838 \\[anything-select-3rd-action]:NthAct,\
1839 \\[anything-send-bug-report-from-anything]:BugReport."
1840 "String displayed in mode-line in `anything-do-grep'.")
1842 (defvar anything-pdfgrep-mode-line-string
1843 "\\<anything-c-pdfgrep-map>\
1844 \\[anything-pdfgrep-help]:Help,\
1845 \\<anything-map>\
1846 \\[anything-select-action]:Acts,\
1847 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
1848 \\[anything-select-3rd-action]:NthAct,\
1849 \\[anything-send-bug-report-from-anything]:BugReport."
1850 "String displayed in mode-line in `anything-do-pdfgrep'.")
1852 (defvar anything-etags-mode-line-string
1853 "\\<anything-c-etags-map>\
1854 \\[anything-etags-help]:Help,\
1855 \\<anything-map>\
1856 \\[anything-select-action]:Acts,\
1857 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
1858 \\[anything-select-3rd-action]:NthAct,\
1859 \\[anything-send-bug-report-from-anything]:BugReport."
1860 "String displayed in mode-line in `anything-c-etags-select'.")
1864 ;;; Preconfigured Anything
1867 ;;;###autoload
1868 (defun anything-mini ()
1869 "Preconfigured `anything' lightweight version \(buffer -> recentf\)."
1870 (interactive)
1871 (anything-other-buffer '(anything-c-source-buffers-list anything-c-source-recentf)
1872 "*anything mini*"))
1873 ;;;###autoload
1874 (defun anything-for-files ()
1875 "Preconfigured `anything' for opening files.
1876 ffap -> recentf -> buffer -> bookmark -> file-cache -> files-in-current-dir -> locate."
1877 (interactive)
1878 (anything-other-buffer anything-for-files-prefered-list "*anything for files*"))
1880 ;;;###autoload
1881 (defun anything-recentf ()
1882 "Preconfigured `anything' for `recentf'."
1883 (interactive)
1884 (anything-other-buffer 'anything-c-source-recentf "*anything recentf*"))
1886 ;;;###autoload
1887 (defun anything-info-at-point (arg)
1888 "Preconfigured `anything' for searching info at point.
1889 With a prefix-arg insert symbol at point."
1890 (interactive "P")
1891 (let ((anything-c-google-suggest-default-function
1892 'anything-c-google-suggest-emacs-lisp))
1893 (anything :sources'(anything-c-source-info-elisp
1894 anything-c-source-info-cl
1895 anything-c-source-info-pages
1896 anything-c-source-google-suggest)
1897 :input (and arg (thing-at-point 'symbol))
1898 :buffer "*anything info*")))
1900 ;;;###autoload
1901 (defun anything-info-emacs ()
1902 "Preconfigured anything for Emacs manual index."
1903 (interactive)
1904 (anything-other-buffer 'anything-c-source-info-emacs "*info emacs*"))
1906 ;;;###autoload
1907 (defun anything-show-kill-ring ()
1908 "Preconfigured `anything' for `kill-ring'.
1909 It is drop-in replacement of `yank-pop'.
1910 You may bind this command to M-y.
1911 First call open the kill-ring browser, next calls move to next line."
1912 (interactive)
1913 (let ((buf "*anything kill-ring*"))
1914 (if (get-buffer-window buf)
1915 (with-anything-window
1916 (if (eq (overlay-end anything-selection-overlay) (point-max))
1917 (anything-beginning-of-buffer)
1918 (anything-next-line)))
1919 (anything-other-buffer 'anything-c-source-kill-ring buf))))
1921 ;;;###autoload
1922 (defun anything-minibuffer-history ()
1923 "Preconfigured `anything' for `minibuffer-history'."
1924 (interactive)
1925 (let ((enable-recursive-minibuffers t))
1926 (anything-other-buffer 'anything-c-source-minibuffer-history
1927 "*anything minibuffer-history*")))
1929 ;;;###autoload
1930 (defun anything-gentoo ()
1931 "Preconfigured `anything' for gentoo linux."
1932 (interactive)
1933 (anything-other-buffer '(anything-c-source-gentoo
1934 anything-c-source-use-flags)
1935 "*anything gentoo*"))
1937 ;;;###autoload
1938 (defun anything-imenu ()
1939 "Preconfigured `anything' for `imenu'."
1940 (interactive)
1941 (anything 'anything-c-source-imenu nil nil nil nil "*anything imenu*"))
1943 ;;;###autoload
1944 (defun anything-google-suggest ()
1945 "Preconfigured `anything' for google search with google suggest."
1946 (interactive)
1947 (anything-other-buffer 'anything-c-source-google-suggest "*anything google*"))
1949 ;;;###autoload
1950 (defun anything-yahoo-suggest ()
1951 "Preconfigured `anything' for Yahoo searching with Yahoo suggest."
1952 (interactive)
1953 (anything-other-buffer 'anything-c-source-yahoo-suggest "*anything yahoo*"))
1955 ;;; Converted from anything-show-*-only
1956 ;;;###autoload
1957 (defun anything-for-buffers ()
1958 "Preconfigured `anything' for buffer."
1959 (interactive)
1960 (anything-other-buffer 'anything-c-source-buffers "*anything for buffers*"))
1962 ;;;###autoload
1963 (defun anything-buffers-list ()
1964 "Enhanced preconfigured `anything' for buffer."
1965 (interactive)
1966 (anything :sources '(anything-c-source-buffers-list
1967 anything-c-source-buffer-not-found)
1968 :buffer "*anything buffers*" :keymap anything-c-buffer-map))
1970 ;;;###autoload
1971 (defun anything-bbdb ()
1972 "Preconfigured `anything' for BBDB.
1974 Needs BBDB.
1976 http://bbdb.sourceforge.net/"
1977 (interactive)
1978 (anything-other-buffer 'anything-c-source-bbdb "*anything bbdb*"))
1980 ;;;###autoload
1981 (defun anything-locate (arg)
1982 "Preconfigured `anything' for Locate.
1983 Note: you can add locate options after entering pattern.
1984 See 'man locate' for valid options.
1986 You can specify a specific database with prefix argument ARG \(C-u\).
1987 Many databases can be used: navigate and mark them.
1988 See also `anything-locate-with-db'.
1990 To create a user specific db, use
1991 \"updatedb -l 0 -o db_path -U directory\".
1992 Where db_path is a filename matched by
1993 `anything-locate-db-file-regexp'."
1994 (interactive "P")
1995 (anything-locate-1 arg))
1997 ;;;###autoload
1998 (defun anything-w3m-bookmarks ()
1999 "Preconfigured `anything' for w3m bookmark.
2001 Needs w3m and emacs-w3m.
2003 http://w3m.sourceforge.net/
2004 http://emacs-w3m.namazu.org/"
2005 (interactive)
2006 (anything-other-buffer 'anything-c-source-w3m-bookmarks
2007 "*anything w3m bookmarks*"))
2009 ;;;###autoload
2010 (defun anything-firefox-bookmarks ()
2011 "Preconfigured `anything' for firefox bookmark.
2012 You will have to enable html bookmarks in firefox:
2013 open about:config in firefox and double click on this line to enable value \
2014 to true:
2016 user_pref(\"browser.bookmarks.autoExportHTML\", false);
2018 You should have now:
2020 user_pref(\"browser.bookmarks.autoExportHTML\", true);
2022 After closing firefox, you will be able to browse you bookmarks.
2024 (interactive)
2025 (anything-other-buffer 'anything-c-source-firefox-bookmarks
2026 "*Anything Firefox*"))
2028 ;;;###autoload
2029 (defun anything-colors ()
2030 "Preconfigured `anything' for color."
2031 (interactive)
2032 (anything-other-buffer
2033 '(anything-c-source-colors anything-c-source-customize-face)
2034 "*anything colors*"))
2036 ;;;###autoload
2037 (defun anything-bookmarks ()
2038 "Preconfigured `anything' for bookmarks."
2039 (interactive)
2040 (anything-other-buffer 'anything-c-source-bookmarks "*anything bookmarks*"))
2042 ;;;###autoload
2043 (defun anything-c-pp-bookmarks ()
2044 "Preconfigured `anything' for bookmarks (pretty-printed)."
2045 (interactive)
2046 (anything-other-buffer '(anything-c-source-bookmarks-local
2047 anything-c-source-bookmarks-su
2048 anything-c-source-bookmarks-ssh)
2049 "*anything pp bookmarks*"))
2051 ;;;###autoload
2052 (defun anything-c-insert-latex-math ()
2053 "Preconfigured anything for latex math symbols completion."
2054 (interactive)
2055 (anything-other-buffer 'anything-c-source-latex-math "*anything latex*"))
2057 ;;;###autoload
2058 (defun anything-register ()
2059 "Preconfigured `anything' for Emacs registers."
2060 (interactive)
2061 (anything-other-buffer 'anything-c-source-register "*anything register*"))
2063 ;;;###autoload
2064 (defun anything-man-woman ()
2065 "Preconfigured `anything' for Man and Woman pages."
2066 (interactive)
2067 (anything-other-buffer 'anything-c-source-man-pages "*Anything man woman*"))
2069 ;;;###autoload
2070 (defun anything-org-keywords ()
2071 "Preconfigured `anything' for org keywords."
2072 (interactive)
2073 (anything-other-buffer 'anything-c-source-org-keywords "*org keywords*"))
2075 ;;;###autoload
2076 (defun anything-emms ()
2077 "Preconfigured `anything' for emms sources."
2078 (interactive)
2079 (anything '(anything-c-source-emms-streams
2080 anything-c-source-emms-files
2081 anything-c-source-emms-dired)
2082 nil nil nil nil
2083 "*Anything Emms*"))
2085 ;;;###autoload
2086 (defun anything-eev-anchors ()
2087 "Preconfigured `anything' for eev anchors."
2088 (interactive)
2089 (anything-other-buffer 'anything-c-source-eev-anchor "*Anything eev anchors*"))
2091 ;;;###autoload
2092 (defun anything-bm-list ()
2093 "Preconfigured `anything' for visible bookmarks.
2095 Needs bm.el
2097 http://cvs.savannah.gnu.org/viewvc/*checkout*/bm/bm/bm.el"
2098 (interactive)
2099 (let ((anything-outline-using t))
2100 (anything-other-buffer 'anything-c-source-bm "*anything bm list*")))
2102 ;;;###autoload
2103 (defun anything-timers ()
2104 "Preconfigured `anything' for timers."
2105 (interactive)
2106 (anything-other-buffer '(anything-c-source-absolute-time-timers
2107 anything-c-source-idle-time-timers)
2108 "*anything timers*"))
2110 ;;;###autoload
2111 (defun anything-list-emacs-process ()
2112 "Preconfigured `anything' for emacs process."
2113 (interactive)
2114 (anything-other-buffer 'anything-c-source-emacs-process "*anything process*"))
2116 ;;;###autoload
2117 (defun anything-occur ()
2118 "Preconfigured Anything for Occur source.
2119 If region is active, search only in region,
2120 otherwise search in whole buffer."
2121 (interactive)
2122 (let ((anything-compile-source-functions
2123 ;; rule out anything-match-plugin because the input is one regexp.
2124 (delq 'anything-compile-source--match-plugin
2125 (copy-sequence anything-compile-source-functions))))
2126 (anything-other-buffer 'anything-c-source-occur "*Anything Occur*")))
2128 ;;;###autoload
2129 (defun anything-browse-code ()
2130 "Preconfigured anything to browse code."
2131 (interactive)
2132 (anything-other-buffer 'anything-c-source-browse-code "*Browse code*"))
2134 ;;;###autoload
2135 (defun anything-org-headlines ()
2136 "Preconfigured anything to show org headlines."
2137 (interactive)
2138 (anything-other-buffer 'anything-c-source-org-headline "*org headlines*"))
2140 ;;;###autoload
2141 (defun anything-info-gnus ()
2142 "Preconfigured anything to browse Gnus Manual."
2143 (interactive)
2144 (anything-other-buffer 'anything-c-source-info-gnus "*info Gnus*"))
2146 ;;;###autoload
2147 (defun anything-regexp ()
2148 "Preconfigured anything to build regexps and run query-replace-regexp \
2149 against."
2150 (interactive)
2151 (save-restriction
2152 (let ((anything-compile-source-functions
2153 ;; rule out anything-match-plugin because the input is one regexp.
2154 (delq 'anything-compile-source--match-plugin
2155 (copy-sequence anything-compile-source-functions))))
2156 (when (and (anything-region-active-p)
2157 ;; Don't narrow to region if buffer is already narrowed.
2158 (not (anything-current-buffer-narrowed-p)))
2159 (narrow-to-region (region-beginning) (region-end)))
2160 (anything :sources
2161 anything-c-source-regexp
2162 :buffer "*anything regexp*"
2163 :prompt "Regexp: "))))
2165 (defun anything-c-copy-files-async ()
2166 "Preconfigured anything to copy file list FLIST to DEST asynchronously."
2167 (interactive)
2168 (let* ((flist (anything-c-read-file-name
2169 "Copy File async: "
2170 :marked-candidates t))
2171 (dest (anything-c-read-file-name
2172 "Copy File async To: "
2173 :preselect (car flist)
2174 :initial-input (car anything-ff-history)
2175 :history (anything-find-files-history :comp-read nil))))
2176 (anything-c-copy-async-with-log flist dest)))
2178 ;;;###autoload
2179 (defun anything-find-files (arg)
2180 "Preconfigured `anything' for anything implementation of `find-file'.
2181 Called with a prefix arg show history if some.
2182 Don't call it from programs, use `anything-find-files-1' instead.
2183 This is the starting point for nearly all actions you can do on files."
2184 (interactive "P")
2185 (let ((any-input (if (and arg anything-ff-history)
2186 (anything-find-files-history)
2187 (anything-find-files-initial-input))))
2188 (when (and (eq major-mode 'org-agenda-mode)
2189 org-directory
2190 (not any-input))
2191 (setq any-input (expand-file-name org-directory)))
2192 (set-text-properties 0 (length any-input) nil any-input)
2193 (if any-input
2194 (anything-find-files-1 any-input)
2195 (setq any-input (expand-file-name (anything-c-current-directory)))
2196 (anything-find-files-1 any-input (buffer-file-name (current-buffer))))))
2198 ;;;###autoload
2199 (defun anything-write-file ()
2200 "Preconfigured `anything' providing completion for `write-file'."
2201 (interactive)
2202 (let ((anything-mp-highlight-delay nil))
2203 (anything :sources 'anything-c-source-write-file
2204 :input (expand-file-name default-directory)
2205 :prompt "Write buffer to file: "
2206 :buffer "*Anything write file*")))
2208 ;;;###autoload
2209 (defun anything-insert-file ()
2210 "Preconfigured `anything' providing completion for `insert-file'."
2211 (interactive)
2212 (let ((anything-mp-highlight-delay nil))
2213 (anything :sources 'anything-c-source-insert-file
2214 :input (expand-file-name default-directory)
2215 :prompt "Insert file: "
2216 :buffer "*Anything insert file*")))
2218 ;;;###autoload
2219 (defun anything-dired-rename-file ()
2220 "Preconfigured `anything' to rename files from dired."
2221 (interactive)
2222 (anything-dired-do-action-on-file :action 'rename))
2224 ;;;###autoload
2225 (defun anything-dired-copy-file ()
2226 "Preconfigured `anything' to copy files from dired."
2227 (interactive)
2228 (anything-dired-do-action-on-file :action 'copy))
2230 ;;;###autoload
2231 (defun anything-dired-symlink-file ()
2232 "Preconfigured `anything' to symlink files from dired."
2233 (interactive)
2234 (anything-dired-do-action-on-file :action 'symlink))
2236 ;;;###autoload
2237 (defun anything-dired-hardlink-file ()
2238 "Preconfigured `anything' to hardlink files from dired."
2239 (interactive)
2240 (anything-dired-do-action-on-file :action 'hardlink))
2242 ;;;###autoload
2243 (defun anything-do-grep ()
2244 "Preconfigured anything for grep.
2245 Contrarily to Emacs `grep' no default directory is given, but
2246 the full path of candidates in ONLY.
2247 That allow to grep different files not only in `default-directory' but anywhere
2248 by marking them (C-<SPACE>). If one or more directory is selected
2249 grep will search in all files of these directories.
2250 You can use also wildcard in the base name of candidate.
2251 If a prefix arg is given use the -r option of grep.
2252 The prefix arg can be passed before or after start.
2253 See also `anything-do-grep-1'."
2254 (interactive)
2255 (let ((only (anything-c-read-file-name
2256 "Search in file(s): "
2257 :marked-candidates t
2258 :preselect (or (dired-get-filename nil t)
2259 (buffer-file-name (current-buffer)))))
2260 (prefarg (or current-prefix-arg anything-current-prefix-arg)))
2261 (anything-do-grep-1 only prefarg)))
2263 ;;;###autoload
2264 (defun anything-do-zgrep (candidate)
2265 "Preconfigured anything for zgrep."
2266 (let ((prefarg (or current-prefix-arg anything-current-prefix-arg))
2267 (ls (anything-c-read-file-name
2268 "Search in file(s): "
2269 :marked-candidates t
2270 :preselect (or (dired-get-filename nil t)
2271 (buffer-file-name (current-buffer))))))
2272 (anything-ff-zgrep-1 ls prefarg)))
2274 (defun anything-c-etags-select (arg)
2275 "Preconfigured anything for etags.
2276 Called with one prefix arg use symbol at point as initial input.
2277 Called with two prefix arg reinitialize cache.
2278 If tag file have been modified reinitialize cache."
2279 (interactive "P")
2280 (let ((tag (anything-c-etags-get-tag-file))
2281 (init (and (equal arg '(4)) (thing-at-point 'symbol)))
2282 (anything-quit-if-no-candidate t)
2283 (anything-execute-action-at-once-if-one t))
2284 (when (or (equal arg '(16))
2285 (and anything-c-etags-mtime-alist
2286 (anything-c-etags-file-modified-p tag)))
2287 (remhash tag anything-c-etags-cache))
2288 (if (and tag (file-exists-p tag))
2289 (anything :sources 'anything-c-source-etags-select
2290 :keymap anything-c-etags-map
2291 :input init
2292 :buffer "*anything etags*")
2293 (message "Error: No tag file found, please create one with etags shell command."))))
2295 ;;;###autoload
2296 (defun anything-filelist ()
2297 "Preconfigured `anything' to open files instantly.
2299 See `anything-c-filelist-file-name' docstring for usage."
2300 (interactive)
2301 (anything-other-buffer 'anything-c-source-filelist "*anything file list*"))
2303 ;;;###autoload
2304 (defun anything-filelist+ ()
2305 "Preconfigured `anything' to open files/buffers/bookmarks instantly.
2307 This is a replacement for `anything-for-files'.
2308 See `anything-c-filelist-file-name' docstring for usage."
2309 (interactive)
2310 (anything-other-buffer
2311 '(anything-c-source-ffap-line
2312 anything-c-source-ffap-guesser
2313 anything-c-source-buffers-list
2314 anything-c-source-recentf
2315 anything-c-source-bookmarks
2316 anything-c-source-file-cache
2317 anything-c-source-filelist)
2318 "*anything file list*"))
2320 ;;;###autoload
2321 (defun anything-M-x ()
2322 "Preconfigured `anything' for Emacs commands.
2323 It is `anything' replacement of regular `M-x' `execute-extended-command'."
2324 (interactive)
2325 (let* (in-help
2326 help-cand
2327 anything-persistent-action-use-special-display
2328 (history (loop with hist
2329 for i in extended-command-history
2330 for com = (intern i)
2331 when (and (fboundp com) (not (member i hist)))
2332 collect i into hist finally return hist))
2333 (command (anything-comp-read
2334 "M-x " obarray
2335 :test 'commandp
2336 :must-match t
2337 :requires-pattern 2
2338 :name "Emacs Commands"
2339 :persistent-action
2340 #'(lambda (candidate)
2341 (let ((hbuf (get-buffer (help-buffer))))
2342 (if (and in-help (string= candidate help-cand))
2343 (progn
2344 ;; When M-x is started from a help buffer,
2345 ;; Don't kill it as it is anything-current-buffer.
2346 (unless (equal hbuf anything-current-buffer)
2347 (kill-buffer hbuf))
2348 (setq in-help nil))
2349 ;; Be sure anything-current-buffer have not a dedicated window.
2350 (set-window-dedicated-p
2351 (get-buffer-window anything-current-buffer) nil)
2352 (describe-function (intern candidate))
2353 (message nil) ; Erase the new stupid message Type "q"[...]
2354 (setq in-help t))
2355 (setq help-cand candidate)))
2356 :persistent-help "Describe this command"
2357 :history history
2358 :sort 'string-lessp
2359 :fc-transformer 'anything-M-x-transformer)))
2360 (unless current-prefix-arg (setq current-prefix-arg anything-current-prefix-arg))
2361 (call-interactively (intern command))
2362 (setq extended-command-history (cons command (delete command history)))))
2364 ;;;###autoload
2365 (defun anything-manage-advice ()
2366 "Preconfigured `anything' to disable/enable function advices."
2367 (interactive)
2368 (anything-other-buffer 'anything-c-source-advice "*anything advice*"))
2370 ;;;###autoload
2371 (defun anything-bookmark-ext ()
2372 "Preconfigured `anything' for bookmark-extensions sources.
2373 Needs bookmark-ext.el:
2374 <http://mercurial.intuxication.org/hg/emacs-bookmark-extension>.
2375 Contain also `anything-c-source-google-suggest'."
2376 (interactive)
2377 (anything
2378 :sources
2379 '(anything-c-source-bookmark-files&dirs
2380 anything-c-source-bookmark-w3m
2381 anything-c-source-google-suggest
2382 anything-c-source-bmkext-addressbook
2383 anything-c-source-bookmark-gnus
2384 anything-c-source-bookmark-info
2385 anything-c-source-bookmark-man
2386 anything-c-source-bookmark-images
2387 anything-c-source-bookmark-su-files&dirs
2388 anything-c-source-bookmark-ssh-files&dirs)
2389 :prompt "SearchBookmark: "
2390 :buffer "*anything bmkext*"))
2392 ;;;###autoload
2393 (defun anything-simple-call-tree ()
2394 "Preconfigured `anything' for simple-call-tree. List function relationships.
2396 Needs simple-call-tree.el.
2397 http://www.emacswiki.org/cgi-bin/wiki/download/simple-call-tree.el"
2398 (interactive)
2399 (anything-other-buffer
2400 '(anything-c-source-simple-call-tree-functions-callers
2401 anything-c-source-simple-call-tree-callers-functions)
2402 "*anything simple-call-tree*"))
2404 ;;;###autoload
2405 (defun anything-mark-ring ()
2406 "Preconfigured `anything' for `anything-c-source-mark-ring'."
2407 (interactive)
2408 (anything 'anything-c-source-mark-ring))
2410 ;;;###autoload
2411 (defun anything-global-mark-ring ()
2412 "Preconfigured `anything' for `anything-c-source-global-mark-ring'."
2413 (interactive)
2414 (anything 'anything-c-source-global-mark-ring))
2416 ;;;###autoload
2417 (defun anything-all-mark-rings ()
2418 "Preconfigured `anything' for `anything-c-source-global-mark-ring' and \
2419 `anything-c-source-mark-ring'."
2420 (interactive)
2421 (anything '(anything-c-source-mark-ring
2422 anything-c-source-global-mark-ring)))
2424 ;;;###autoload
2425 (defun anything-yaoddmuse-emacswiki-edit-or-view ()
2426 "Preconfigured `anything' to edit or view EmacsWiki page.
2428 Needs yaoddmuse.el.
2430 http://www.emacswiki.org/emacs/download/yaoddmuse.el"
2431 (interactive)
2432 (anything 'anything-c-source-yaoddmuse-emacswiki-edit-or-view))
2434 ;;;###autoload
2435 (defun anything-yaoddmuse-emacswiki-post-library ()
2436 "Preconfigured `anything' to post library to EmacsWiki.
2438 Needs yaoddmuse.el.
2440 http://www.emacswiki.org/emacs/download/yaoddmuse.el"
2441 (interactive)
2442 (anything 'anything-c-source-yaoddmuse-emacswiki-post-library))
2444 ;;;###autoload
2445 (defun anything-eval-expression (arg)
2446 "Preconfigured anything for `anything-c-source-evaluation-result'."
2447 (interactive "P")
2448 (anything :sources 'anything-c-source-evaluation-result
2449 :input (when arg (thing-at-point 'sexp))
2450 :buffer "*anything eval*"
2451 :keymap anything-eval-expression-map))
2453 ;;;###autoload
2454 (defun anything-eval-expression-with-eldoc ()
2455 "Preconfigured anything for `anything-c-source-evaluation-result' with `eldoc' support. "
2456 (interactive)
2457 (declare (special eldoc-idle-delay))
2458 (let ((timer (run-with-idle-timer eldoc-idle-delay
2459 'repeat 'anything-eldoc-show-in-eval))
2460 (minibuffer-completing-symbol t) ; Enable lisp completion.
2461 (completion-cycle-threshold t)) ; Always cycle, no pesty completion buffer (emacs24 only).
2462 (unwind-protect
2463 (minibuffer-with-setup-hook
2464 'anything-eldoc-store-minibuffer
2465 (call-interactively 'anything-eval-expression))
2466 (and timer (cancel-timer timer))
2467 (setq anything-eldoc-active-minibuffers-list
2468 (cdr anything-eldoc-active-minibuffers-list)))))
2470 ;;;###autoload
2471 (defun anything-calcul-expression ()
2472 "Preconfigured anything for `anything-c-source-calculation-result'."
2473 (interactive)
2474 (anything-other-buffer 'anything-c-source-calculation-result "*anything calcul*"))
2476 ;;;###autoload
2477 (defun anything-surfraw (pattern engine)
2478 "Preconfigured `anything' to search PATTERN with search ENGINE."
2479 (interactive (list (read-string "SearchFor: ")
2480 (anything-comp-read
2481 "Engine: "
2482 (anything-c-build-elvi-list)
2483 :must-match t
2484 :name "Surfraw Search Engines"
2485 :history anything-surfraw-engines-history)))
2486 (let* ((engine-nodesc (car (split-string engine)))
2487 (url (shell-command-to-string
2488 (format "surfraw %s -p %s"
2489 engine-nodesc pattern)))
2490 (browse-url-browser-function
2491 (or anything-surfraw-default-browser-function
2492 browse-url-browser-function)))
2493 (if (string= engine-nodesc "W")
2494 (anything-c-browse-url)
2495 (anything-c-browse-url url)
2496 (setq anything-surfraw-engines-history
2497 (cons engine (delete engine anything-surfraw-engines-history))))))
2499 ;;;###autoload
2500 (defun anything-call-source ()
2501 "Preconfigured `anything' to call anything source."
2502 (interactive)
2503 (anything 'anything-c-source-call-source nil nil nil nil
2504 anything-source-select-buffer))
2506 ;;;###autoload
2507 (defun anything-execute-anything-command ()
2508 "Preconfigured `anything' to execute preconfigured `anything'."
2509 (interactive)
2510 (anything-other-buffer 'anything-c-source-anything-commands
2511 "*anything commands*"))
2513 ;;;###autoload
2514 (defun anything-create (&optional string initial-input)
2515 "Preconfigured `anything' to do many create actions from STRING.
2516 See also `anything-create--actions'."
2517 (interactive)
2518 (setq string (or string (read-string "Create Anything: " initial-input)))
2519 (anything '(((name . "Anything Create")
2520 (header-name . (lambda (_) (format "Action for \"%s\"" string)))
2521 (candidates . anything-create--actions)
2522 (candidate-number-limit)
2523 (action . (lambda (func) (funcall func string)))))))
2525 ;;;###autoload
2526 (defun anything-top ()
2527 "Preconfigured `anything' for top command."
2528 (interactive)
2529 (let ((anything-samewindow t)
2530 (anything-enable-shortcuts)
2531 (anything-display-function 'anything-default-display-buffer)
2532 (anything-candidate-number-limit 9999))
2533 (save-window-excursion
2534 (delete-other-windows)
2535 (anything-other-buffer 'anything-c-source-top "*anything top*"))))
2537 ;;;###autoload
2538 (defun anything-select-xfont ()
2539 "Preconfigured `anything' to select Xfont."
2540 (interactive)
2541 (anything-other-buffer 'anything-c-source-xfonts "*anything select* xfont"))
2543 ;;;###autoload
2544 (defun anything-world-time ()
2545 "Preconfigured `anything' to show world time."
2546 (interactive)
2547 (anything-other-buffer 'anything-c-source-time-world "*anything world time*"))
2549 ;;;###autoload
2550 (defun anything-apt (arg query)
2551 "Preconfigured `anything' : frontend of APT package manager.
2552 With a prefix arg reload cache."
2553 (interactive "P\nsSearch Package: ")
2554 (when arg
2555 (setq anything-c-apt-installed-packages nil)
2556 (setq anything-c-apt-all-packages nil))
2557 (anything :sources 'anything-c-source-apt
2558 :prompt "Search Package: " :input query))
2560 ;;;###autoload
2561 (defun anything-esh-pcomplete ()
2562 "Preconfigured anything to provide anything completion in eshell."
2563 (interactive)
2564 (let* ((anything-quit-if-no-candidate t)
2565 (anything-execute-action-at-once-if-one t)
2566 (target (thing-at-point 'symbol))
2567 (end (point))
2568 (beg (or (and target (- end (length target)))
2569 ;; Nothing at point.
2570 (progn (insert " ") (point)))))
2571 (setq anything-ec-target (or target " "))
2572 (with-anything-show-completion beg end
2573 (anything :sources 'anything-c-source-esh
2574 :input (anything-ff-set-pattern ; Handle tramp filenames.
2575 (car (last (ignore-errors ; Needed in lisp symbols completion.
2576 (pcomplete-parse-arguments)))))))))
2578 ;;;###autoload
2579 (defun anything-eshell-history ()
2580 "Preconfigured anything for eshell history."
2581 (interactive)
2582 (let* ((end (point))
2583 (beg (progn (save-excursion (insert " ") (point)))))
2584 (with-anything-show-completion beg end
2585 (anything-other-buffer anything-c-source-eshell-history "*Eshell history*"))))
2587 ;;;###autoload
2588 (defun anything-c-run-external-command (program)
2589 "Preconfigured `anything' to run External PROGRAM asyncronously from Emacs.
2590 If program is already running exit with error.
2591 You can set your own list of commands with
2592 `anything-c-external-commands-list'."
2593 (interactive (list
2594 (anything-comp-read
2595 "RunProgram: "
2596 (anything-c-external-commands-list-1 'sort)
2597 :must-match t
2598 :name "External Commands"
2599 :history anything-external-command-history)))
2600 (anything-run-or-raise program)
2601 (setq anything-external-command-history
2602 (cons program (delete program
2603 (loop for i in anything-external-command-history
2604 when (executable-find i) collect i)))))
2606 ;;;###autoload
2607 (defun anything-ratpoison-commands ()
2608 "Preconfigured `anything' to execute ratpoison commands."
2609 (interactive)
2610 (anything-other-buffer 'anything-c-source-ratpoison-commands
2611 "*anything ratpoison commands*"))
2616 ;;; Utilities Functions
2619 (defun anything-ff-find-printers ()
2620 "Return a list of available printers on Unix systems."
2621 (let ((printer-list (with-temp-buffer
2622 (call-process "lpstat" nil t nil "-a")
2623 (split-string (buffer-string) "\n"))))
2624 (loop for p in printer-list
2625 for printer = (car (split-string p))
2626 when printer
2627 collect printer)))
2629 ;; Shut up byte compiler in emacs24*.
2630 (defun anything-c-switch-to-buffer (buffer-or-name)
2631 "Same as `switch-to-buffer' whithout warnings at compile time."
2632 (with-no-warnings
2633 (switch-to-buffer buffer-or-name)))
2635 (defsubst* anything-c-position (item seq &key (test 'eq))
2636 "A simple and faster replacement of CL `position'."
2637 (loop for i in seq for index from 0
2638 when (funcall test i item) return index))
2640 (defun anything-c-get-pid-from-process-name (process-name)
2641 "Get pid from running process PROCESS-NAME."
2642 (loop with process-list = (list-system-processes)
2643 for pid in process-list
2644 for process = (assoc-default 'comm (process-attributes pid))
2645 when (and process (string-match process-name process))
2646 return pid))
2648 (defun* anything-current-buffer-narrowed-p (&optional
2649 (buffer anything-current-buffer))
2650 "Check if BUFFER is narrowed.
2651 Default is `anything-current-buffer'."
2652 (with-current-buffer buffer
2653 (let ((beg (point-min))
2654 (end (point-max))
2655 (total (buffer-size)))
2656 (or (/= beg 1) (/= end (1+ total))))))
2658 (defun anything-region-active-p ()
2659 (and transient-mark-mode mark-active (/= (mark) (point))))
2661 (defun anything-goto-line (lineno)
2662 "Goto LINENO opening only outline headline if needed."
2663 (goto-char (point-min)) (forward-line (1- lineno))
2664 (when (or (eq major-mode 'org-mode) outline-minor-mode)
2665 (org-reveal))
2666 (anything-match-line-color-current-line) (sit-for 0.3)
2667 (anything-match-line-cleanup))
2669 ;;;###autoload
2670 (defun anything-test-sources ()
2671 "List all anything sources for test.
2672 The output is sexps which are evaluated by \\[eval-last-sexp]."
2673 (interactive)
2674 (with-output-to-temp-buffer "*Anything Test Sources*"
2675 (mapc (lambda (s) (princ (format ";; (anything '%s)\n" s)))
2676 (apropos-internal "^anything-c-source" #'boundp))
2677 (pop-to-buffer standard-output)))
2679 (defun anything-nest (&rest same-as-anything)
2680 "Nested `anything'. If you use `anything' within `anything', use it."
2681 (with-selected-window (anything-window)
2682 (let (anything-current-position
2683 anything-current-buffer
2684 (orig-anything-buffer anything-buffer)
2685 anything-pattern
2686 anything-buffer
2687 anything-sources
2688 anything-compiled-sources
2689 anything-buffer-chars-modified-tick
2690 (anything-samewindow t)
2691 (enable-recursive-minibuffers t))
2692 (unwind-protect
2693 (apply #'anything same-as-anything)
2694 (anything-initialize-overlays orig-anything-buffer)
2695 (add-hook 'post-command-hook 'anything-check-minibuffer-input)))))
2697 (defun anything-displaying-source-names ()
2698 "Display sources name."
2699 (with-current-buffer anything-buffer
2700 (goto-char (point-min))
2701 (loop with pos
2702 while (setq pos (next-single-property-change (point) 'anything-header))
2703 do (goto-char pos)
2704 collect (buffer-substring-no-properties (point-at-bol)(point-at-eol))
2705 do (forward-line 1))))
2707 ;; [Obsolete]
2708 (defun anything-select-source ()
2709 "[OBSOLETE] Select source."
2710 (interactive)
2711 (let ((default (assoc-default 'name (anything-get-current-source)))
2712 (source-names (anything-displaying-source-names))
2713 (all-source-names (mapcar (lambda (s) (assoc-default 'name s))
2714 (anything-get-sources))))
2715 (setq anything-candidate-number-limit 9999)
2716 (anything-aif
2717 (let (anything-source-filter)
2718 (anything-nest '(((name . "Anything Source")
2719 (candidates . source-names)
2720 (action . identity))
2721 ((name . "Anything Source (ALL)")
2722 (candidates . all-source-names)
2723 (action . identity)))
2724 nil "Source: " nil
2725 default "*anything select source*"))
2726 (anything-set-source-filter (list it))
2727 (anything-set-source-filter nil))))
2729 (defun anything-c-match-on-file-name (candidate)
2730 "Return non-nil if `anything-pattern' match basename of filename CANDIDATE."
2731 (string-match anything-pattern (file-name-nondirectory candidate)))
2733 (defun anything-c-match-on-directory-name (candidate)
2734 "Return non-nil if `anything-pattern' match directory part of CANDIDATE."
2735 (anything-aif (file-name-directory candidate)
2736 (string-match anything-pattern it)))
2738 (defun anything-c-string-match (candidate)
2739 "Return non-nil if `anything-pattern' match CANDIDATE.
2740 The match is done with `string-match'."
2741 (string-match anything-pattern candidate))
2743 (defun anything-c-skip-entries (list regexp)
2744 "Remove entries which matches REGEXP from LIST."
2745 (remove-if (lambda (x) (and (stringp x) (string-match regexp x)))
2746 list))
2748 (defun anything-c-shadow-entries (list regexp)
2749 "Display elements of LIST matching REGEXP with the `file-name-shadow' face."
2750 (mapcar (lambda (file)
2751 ;; Add shadow face property to boring files.
2752 (let ((face (if (facep 'file-name-shadow)
2753 'file-name-shadow
2754 ;; fall back to default on XEmacs
2755 'default)))
2756 (if (string-match regexp file)
2757 (setq file (propertize file 'face face))))
2758 file)
2759 list))
2761 (defsubst anything-c-stringify (str-or-sym)
2762 "Get string of STR-OR-SYM."
2763 (if (stringp str-or-sym)
2764 str-or-sym
2765 (symbol-name str-or-sym)))
2767 (defsubst anything-c-symbolify (str-or-sym)
2768 "Get symbol of STR-OR-SYM."
2769 (if (symbolp str-or-sym)
2770 str-or-sym
2771 (intern str-or-sym)))
2773 (defun anything-c-describe-function (func)
2774 "FUNC is symbol or string."
2775 (describe-function (anything-c-symbolify func)))
2777 (defun anything-c-describe-variable (var)
2778 "VAR is symbol or string."
2779 (describe-variable (anything-c-symbolify var)))
2781 (defun anything-c-find-function (func)
2782 "FUNC is symbol or string."
2783 (find-function (anything-c-symbolify func)))
2785 (defun anything-c-find-variable (var)
2786 "VAR is symbol or string."
2787 (find-variable (anything-c-symbolify var)))
2789 (defun anything-c-kill-new (candidate &optional replace)
2790 "CANDIDATE is symbol or string.
2791 See `kill-new' for argument REPLACE."
2792 (kill-new (anything-c-stringify candidate) replace))
2794 (defun* anything-fast-remove-dups (seq &key (test 'eq))
2795 "Remove duplicates elements in list SEQ.
2796 This is same as `remove-duplicates' but with memoisation.
2797 It is much faster, especially in large lists.
2798 A test function can be provided with TEST argument key.
2799 Default is `eq'."
2800 (let ((cont (make-hash-table :test test)))
2801 (loop for elm in seq
2802 unless (gethash elm cont)
2803 do (puthash elm elm cont)
2804 finally return
2805 (loop for i being the hash-values in cont collect i))))
2807 (defadvice eval-defun (after anything-source-hack activate)
2808 "Allow immediate execution of anything source when evaling it.
2809 See `anything-c-enable-eval-defun-hack'."
2810 (when anything-c-enable-eval-defun-hack
2811 (let ((varsym (save-excursion
2812 (beginning-of-defun)
2813 (forward-char 1)
2814 (when (memq (read (current-buffer)) '(defvar setq))
2815 (read (current-buffer))))))
2816 (when (string-match "^anything-c-source-" (symbol-name varsym))
2817 (anything varsym)))))
2818 ;; (progn (ad-disable-advice 'eval-defun 'after 'anything-source-hack) (ad-update 'eval-defun))
2820 (defadvice anything-quit-and-find-file (around use-anything-find-files activate)
2821 "Let `anything-quit-and-find-file' take advantage of `anything-find-files'."
2822 (interactive)
2823 (anything-run-after-quit
2824 (lambda (f)
2825 (if (file-exists-p f)
2826 (anything-find-files-1 (file-name-directory f) f)
2827 (anything-find-files-1 f)))
2828 (anything-aif (get-buffer (anything-get-selection))
2829 (or (buffer-file-name it)
2830 (car (rassoc it dired-buffers))
2831 (and (with-current-buffer it
2832 (eq major-mode 'org-agenda-mode))
2833 org-directory
2834 (expand-file-name org-directory))
2835 default-directory)
2836 (let ((sel (anything-get-selection)))
2837 (if (file-exists-p sel)
2838 (expand-file-name sel)
2839 default-directory)))))
2841 (defmacro* anything-c-walk-directory (directory &key (path 'basename) (directories t) match)
2842 "Walk through DIRECTORY tree.
2843 PATH can be one of basename, relative, or full.
2844 DIRECTORIES when non--nil (default) return also directories names, otherwise
2845 skip directories names.
2846 MATCH match only filenames matching regexp MATCH."
2847 `(let (result
2848 (fn (case ,path
2849 (basename 'file-name-nondirectory)
2850 (relative 'file-relative-name)
2851 (full 'identity)
2852 (t (error "Error: Invalid path spec `%s', must be one of basename, relative or full." ,path)))))
2853 (labels ((ls-R (dir)
2854 (loop with ls = (directory-files dir t directory-files-no-dot-files-regexp)
2855 for f in ls
2856 if (file-directory-p f)
2857 do (progn (when ,directories
2858 (push (funcall fn f) result))
2859 ;; Don't recurse in directory symlink.
2860 (unless (file-symlink-p f)
2861 (ls-R f)))
2862 else do
2863 (unless (and ,match (not (string-match ,match (file-name-nondirectory f))))
2864 (push (funcall fn f) result)))))
2865 (ls-R ,directory)
2866 (nreverse result))))
2868 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Anything Applications ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2870 ;;; Anything regexp.
2873 (defun anything-c-query-replace-regexp (candidate)
2874 "Query replace regexp from `anything-regexp'.
2875 With a prefix arg replace only matches surrounded by word boundaries,
2876 i.e Don't replace inside a word, regexp is surrounded with \\bregexp\\b."
2877 (let ((regexp (funcall (anything-attr 'regexp))))
2878 (apply 'query-replace-regexp
2879 (anything-c-query-replace-args regexp))))
2881 (defun anything-c-kill-regexp-as-sexp (candidate)
2882 "Kill regexp in a format usable in lisp code."
2883 (anything-c-regexp-kill-new
2884 (prin1-to-string (funcall (anything-attr 'regexp)))))
2886 (defun anything-c-kill-regexp (candidate)
2887 "Kill regexp as it is in `anything-pattern'."
2888 (anything-c-regexp-kill-new (funcall (anything-attr 'regexp))))
2890 (defun anything-c-query-replace-args (regexp)
2891 "create arguments of `query-replace-regexp' action in `anything-regexp'."
2892 (let ((region-only (anything-region-active-p)))
2893 (list
2894 regexp
2895 (query-replace-read-to regexp
2896 (format "Query replace %sregexp %s"
2897 (if anything-current-prefix-arg "word " "")
2898 (if region-only "in region " ""))
2900 anything-current-prefix-arg
2901 (when region-only (region-beginning))
2902 (when region-only (region-end)))))
2904 (defvar anything-c-source-regexp
2905 '((name . "Regexp Builder")
2906 (init . (lambda ()
2907 (anything-candidate-buffer anything-current-buffer)))
2908 (candidates-in-buffer)
2909 (get-line . anything-c-regexp-get-line)
2910 (persistent-action . anything-c-regexp-persistent-action)
2911 (persistent-help . "Show this line")
2912 (multiline)
2913 (delayed)
2914 (requires-pattern . 2)
2915 (mode-line . "Press TAB to select action.")
2916 (regexp . (lambda () anything-input))
2917 (action . (("Kill Regexp as sexp" . anything-c-kill-regexp-as-sexp)
2918 ("Query Replace Regexp (C-u Not inside word.)"
2919 . anything-c-query-replace-regexp)
2920 ("Kill Regexp" . anything-c-kill-regexp)))))
2922 (defun anything-c-regexp-get-line (s e)
2923 (propertize
2924 (apply 'concat
2925 ;; Line contents
2926 (format "%5d: %s" (line-number-at-pos (1- s)) (buffer-substring s e))
2927 ;; subexps
2928 (loop for i from 0 to (1- (/ (length (match-data)) 2))
2929 collect (format "\n %s'%s'"
2930 (if (zerop i) "Group 0: " (format "Group %d: " i))
2931 (match-string i))))
2932 ;; match beginning
2933 ;; KLUDGE: point of anything-candidate-buffer is +1 than that of anything-current-buffer.
2934 ;; It is implementation problem of candidates-in-buffer.
2935 'anything-realvalue
2936 (1- s)))
2938 (defun anything-c-regexp-persistent-action (pt)
2939 (goto-char pt)
2940 (anything-persistent-highlight-point))
2942 (defun anything-c-regexp-kill-new (input)
2943 (kill-new input)
2944 (message "Killed: %s" input))
2948 ;;; Toggle all marks.
2951 ;;;###autoload
2952 (defun anything-mark-all ()
2953 "Mark all visible unmarked candidates in current source."
2954 (interactive)
2955 (with-anything-window
2956 (save-excursion
2957 (goto-char (anything-get-previous-header-pos))
2958 (anything-next-line)
2959 (let* ((next-head (anything-get-next-header-pos))
2960 (end (and next-head
2961 (save-excursion
2962 (goto-char next-head)
2963 (forward-line -1)
2964 (point))))
2965 (maxpoint (or end (point-max))))
2966 (while (< (point) maxpoint)
2967 (anything-mark-current-line)
2968 (let ((prefix (get-text-property (point-at-bol) 'display))
2969 (bn (anything-c-basename (anything-get-selection)))
2970 (src (assoc-default 'name (anything-get-current-source))))
2971 (when (and (not (anything-this-visible-mark))
2972 (not (or (string= prefix "[?]")
2973 (string= prefix "[@]"))))
2974 ;; Don't mark possibles directories ending with . or ..
2975 ;; and also autosave files/links.
2976 (unless
2977 (and (or (anything-file-completion-source-p)
2978 (equal src "Files from Current Directory"))
2979 (string-match "^\\.#.*\\|^#.*#$\\|\\.$" bn))
2980 (anything-make-visible-mark))))
2981 (forward-line 1) (end-of-line))))
2982 (anything-mark-current-line)
2983 (message "%s candidates marked" (length anything-marked-candidates))))
2985 ;;;###autoload
2986 (defun anything-unmark-all ()
2987 "Unmark all candidates in all sources of current anything session."
2988 (interactive)
2989 (with-anything-window
2990 (let ((len (length anything-marked-candidates)))
2991 (save-excursion
2992 (anything-clear-visible-mark))
2993 (setq anything-marked-candidates nil)
2994 (anything-mark-current-line)
2995 (message "%s candidates unmarked" len))))
2997 ;;;###autoload
2998 (defun anything-toggle-all-marks ()
2999 "Toggle all marks.
3000 Mark all visible candidates of current source or unmark all candidates
3001 visible or invisible in all sources of current anything session"
3002 (interactive)
3003 (let ((marked (anything-marked-candidates)))
3004 (if (and (>= (length marked) 1)
3005 (with-anything-window anything-visible-mark-overlays))
3006 (anything-unmark-all)
3007 (anything-mark-all))))
3009 (define-key anything-map (kbd "M-m") 'anything-toggle-all-marks)
3013 ;;; Buffers
3016 (defun anything-c-buffer-list ()
3017 "Return the list of names of buffers with boring buffers filtered out.
3018 Boring buffers is specified by `anything-c-boring-buffer-regexp'.
3019 The first buffer in the list will be the last recently used
3020 buffer that is not the current buffer."
3021 (let ((buffers (mapcar 'buffer-name (buffer-list))))
3022 (append (cdr buffers) (list (car buffers)))))
3024 (defvar anything-c-source-buffers
3025 '((name . "Buffers")
3026 (candidates . anything-c-buffer-list)
3027 (type . buffer)))
3028 ;; (anything 'anything-c-source-buffers)
3030 (defvar anything-c-source-buffer-not-found
3031 '((name . "Create buffer")
3032 (dummy)
3033 (filtered-candidate-transformer (lambda (cands source)
3034 (list anything-pattern)))
3035 (action . (lambda (candidate)
3036 (anything-c-switch-to-buffer (get-buffer-create candidate))))))
3037 ;; (anything 'anything-c-source-buffer-not-found)
3039 ;;; Buffers-list (was buffers+)
3042 (eval-when-compile (require 'dired))
3044 (defun anything-c-highlight-buffers (buffers)
3045 (loop for i in buffers
3046 for buf = (get-buffer i)
3047 for bfname = (buffer-file-name buf)
3048 collect
3049 (cond (;; A dired buffer.
3050 (rassoc buf dired-buffers)
3051 (propertize i 'face 'anything-ff-directory
3052 'help-echo (car (rassoc buf dired-buffers))))
3053 ;; A buffer file modified somewhere outside of emacs.
3054 ((and bfname (not (file-remote-p bfname))
3055 (file-exists-p bfname)
3056 (not (verify-visited-file-modtime buf)))
3057 (propertize i 'face 'anything-buffer-saved-out
3058 'help-echo bfname))
3059 ;; A new buffer file not already saved on disk.
3060 ((and bfname (not (file-remote-p bfname))
3061 (not (verify-visited-file-modtime buf)))
3062 (propertize i 'face 'anything-buffer-not-saved
3063 'help-echo bfname))
3064 ;; A Remote buffer file modified and not saved on disk.
3065 ((and bfname (file-remote-p bfname) (buffer-modified-p buf))
3066 (let ((prefix (propertize
3067 " " 'display
3068 (propertize "@ " 'face 'anything-ff-prefix))))
3069 (cons (concat prefix (propertize i 'face 'anything-ff-symlink
3070 'help-echo bfname)) i)))
3071 ;; A buffer file modified and not saved on disk.
3072 ((and bfname (buffer-modified-p buf))
3073 (propertize i 'face 'anything-ff-symlink
3074 'help-echo bfname))
3075 ;; A remote buffer file not modified and saved on disk.
3076 ((and bfname (file-remote-p bfname))
3077 (let ((prefix (propertize
3078 " " 'display
3079 (propertize "@ " 'face 'anything-ff-prefix))))
3080 (cons (concat prefix (propertize i 'face 'font-lock-type-face
3081 'help-echo bfname)) i)))
3082 ;; A buffer file not modified and saved on disk.
3083 (bfname
3084 (propertize i 'face 'font-lock-type-face
3085 'help-echo bfname))
3086 ;; Any non--file buffer.
3087 (t (propertize i 'face 'italic)))))
3090 (defvar anything-c-source-buffers-list
3091 '((name . "Buffers")
3092 (candidates . anything-c-buffer-list)
3093 (type . buffer)
3094 (match anything-c-buffer-match-major-mode)
3095 (diff-action . anything-buffer-toggle-diff)
3096 (revert-action . anything-buffer-revert-and-update)
3097 (save-action . anything-buffer-save-and-update)
3098 (candidate-transformer anything-c-skip-current-buffer
3099 anything-c-skip-boring-buffers
3100 anything-c-highlight-buffers)
3101 (persistent-action . anything-c-buffers-list-persistent-action)
3102 (volatile)
3103 (mode-line . anything-buffer-mode-line-string)
3104 (persistent-help . "Show this buffer / C-u \\[anything-execute-persistent-action]: Kill this buffer")))
3105 ;; (anything 'anything-c-source-buffers-list)
3107 (defun anything-c-buffer-match-major-mode (candidate)
3108 "Match maybe buffer by major-mode.
3109 If you give a major-mode or partial major-mode,
3110 it will list all buffers of this major-mode and/or buffers with name
3111 matching this major-mode.
3112 If you add a space after major-mode and then a space,
3113 it will match all buffers of the major-mode
3114 before space matching pattern after space.
3115 If you give a pattern which doesn't match a major-mode, it will search buffer
3116 with name matching pattern."
3117 (let* ((cand (replace-regexp-in-string "^\\s-\\{1\\}" "" candidate))
3118 (buf (get-buffer cand)))
3119 (when buf
3120 (with-current-buffer buf
3121 (let ((mjm (symbol-name major-mode))
3122 (split (split-string anything-pattern)))
3123 (cond ((string-match "\\s-$" anything-pattern)
3124 (string-match (car split) mjm))
3125 ((string-match "\\s-" anything-pattern)
3126 (and (string-match (car split) mjm)
3127 (string-match (cadr split) cand)))
3128 (t (or (string-match anything-pattern mjm)
3129 (string-match anything-pattern cand)))))))))
3131 (defun anything-c-buffer-query-replace-1 (&optional regexp-flag)
3132 "Query replace in marked buffers.
3133 If REGEXP-FLAG is given use `query-replace-regexp'."
3134 (let ((fn (if regexp-flag 'query-replace-regexp 'query-replace))
3135 (prompt (if regexp-flag "Query replace regexp" "Query replace"))
3136 (bufs (anything-marked-candidates)))
3137 (loop
3138 with replace = (query-replace-read-from prompt regexp-flag)
3139 with tostring = (unless (consp replace)
3140 (query-replace-read-to
3141 replace prompt regexp-flag))
3142 for buf in bufs
3144 (save-window-excursion
3145 (anything-c-switch-to-buffer buf)
3146 (save-excursion
3147 (let ((case-fold-search t))
3148 (goto-char (point-min))
3149 (if (consp replace)
3150 (apply fn (list (car replace) (cdr replace)))
3151 (apply fn (list replace tostring)))))))))
3153 (defun anything-c-buffer-query-replace-regexp (candidate)
3154 (anything-c-buffer-query-replace-1 'regexp))
3156 (defun anything-c-buffer-query-replace (candidate)
3157 (anything-c-buffer-query-replace-1))
3159 (defun anything-buffer-toggle-diff (candidate)
3160 "Toggle diff buffer CANDIDATE with it's file."
3161 (if (get-buffer-window "*Diff*")
3162 (kill-buffer "*Diff*")
3163 (diff-buffer-with-file (get-buffer candidate))))
3165 ;;;###autoload
3166 (defun anything-buffer-diff-persistent ()
3167 "Toggle diff buffer without quitting anything."
3168 (interactive)
3169 (anything-execute-persistent-action 'diff-action))
3171 (defun anything-buffer-revert-and-update (candidate)
3172 (let ((marked (anything-marked-candidates)))
3173 (loop for buf in marked do (anything-revert-buffer buf))
3174 (anything-force-update)
3175 (anything-c-recenter-window)))
3177 ;;;###autoload
3178 (defun anything-buffer-revert-persistent ()
3179 "Revert buffer without quitting anything."
3180 (interactive)
3181 (anything-execute-persistent-action 'revert-action))
3183 (defun anything-buffer-save-and-update (candidate)
3184 (let ((marked (anything-marked-candidates))
3185 (enable-recursive-minibuffers t))
3186 (loop for buf in marked do
3187 (with-current-buffer (get-buffer buf)
3188 (save-buffer)))
3189 (anything-force-update)
3190 (anything-c-recenter-window)))
3192 ;;;###autoload
3193 (defun anything-buffer-save-persistent ()
3194 "Save buffer without quitting anything."
3195 (interactive)
3196 (anything-execute-persistent-action 'save-action))
3198 ;;;###autoload
3199 (defun anything-buffer-run-kill-buffers ()
3200 "Run kill buffer action from `anything-c-source-buffers-list'."
3201 (interactive)
3202 (anything-c-quit-and-execute-action 'anything-kill-marked-buffers))
3204 ;;;###autoload
3205 (defun anything-buffer-run-grep ()
3206 "Run Grep action from `anything-c-source-buffers-list'."
3207 (interactive)
3208 (anything-c-quit-and-execute-action 'anything-c-grep-buffers))
3210 ;;;###autoload
3211 (defun anything-buffer-run-zgrep ()
3212 "Run Grep action from `anything-c-source-buffers-list'."
3213 (interactive)
3214 (anything-c-quit-and-execute-action 'anything-c-zgrep-buffers))
3216 ;;;###autoload
3217 (defun anything-buffer-run-query-replace-regexp ()
3218 "Run Query replace regexp action from `anything-c-source-buffers-list'."
3219 (interactive)
3220 (anything-c-quit-and-execute-action 'anything-c-buffer-query-replace-regexp))
3222 ;;;###autoload
3223 (defun anything-buffer-run-query-replace ()
3224 "Run Query replace action from `anything-c-source-buffers-list'."
3225 (interactive)
3226 (anything-c-quit-and-execute-action 'anything-c-buffer-query-replace))
3228 ;;;###autoload
3229 (defun anything-buffer-switch-other-window ()
3230 "Run switch to other window action from `anything-c-source-buffers-list'."
3231 (interactive)
3232 (anything-c-quit-and-execute-action 'switch-to-buffer-other-window))
3234 ;;;###autoload
3235 (defun anything-buffer-switch-other-frame ()
3236 "Run switch to other frame action from `anything-c-source-buffers-list'."
3237 (interactive)
3238 (anything-c-quit-and-execute-action 'switch-to-buffer-other-frame))
3240 ;;;###autoload
3241 (defun anything-buffer-switch-to-elscreen ()
3242 "Run switch to elscreen action from `anything-c-source-buffers-list'."
3243 (interactive)
3244 (anything-c-quit-and-execute-action 'anything-find-buffer-on-elscreen))
3246 ;;;###autoload
3247 (defun anything-buffer-run-ediff ()
3248 "Run ediff action from `anything-c-source-buffers-list'."
3249 (interactive)
3250 (anything-c-quit-and-execute-action 'anything-ediff-marked-buffers))
3252 (defun anything-buffer-run-ediff-merge ()
3253 "Run ediff action from `anything-c-source-buffers-list'."
3254 (interactive)
3255 (anything-c-quit-and-execute-action 'anything-ediff-marked-buffers-merge))
3257 (defun anything-c-buffers-persistent-kill (buffer)
3258 "Persistent action to kill buffer."
3259 (with-current-buffer (get-buffer buffer)
3260 (if (and (buffer-modified-p)
3261 (buffer-file-name (current-buffer)))
3262 (progn
3263 (save-buffer)
3264 (kill-buffer buffer))
3265 (kill-buffer buffer)))
3266 (anything-delete-current-selection))
3268 (defun anything-c-recenter-window ()
3269 "Make visible current selection by recentering anything window."
3270 (with-anything-window (recenter)))
3272 (defun anything-c-buffers-list-persistent-action (candidate)
3273 (if current-prefix-arg
3274 (anything-c-buffers-persistent-kill candidate)
3275 (anything-c-switch-to-buffer candidate)))
3278 ;;;; <File>
3281 ;;; File name history
3282 (defvar anything-c-source-file-name-history
3283 '((name . "File Name History")
3284 (candidates . file-name-history)
3285 (match anything-c-match-on-file-name
3286 anything-c-match-on-directory-name)
3287 (type . file)))
3288 ;; (anything 'anything-c-source-file-name-history)
3290 ;;; Files in current dir
3293 (defvar anything-c-source-files-in-current-dir
3294 '((name . "Files from Current Directory")
3295 (candidates . (lambda ()
3296 (with-anything-current-buffer
3297 (directory-files (anything-c-current-directory)))))
3298 ;; volatile is not needed, I think.
3299 (type . file)))
3300 ;; (anything 'anything-c-source-files-in-current-dir)
3302 (defun anything-c-highlight-files (files)
3303 (loop for i in files
3304 if (file-directory-p i)
3305 collect (propertize (file-name-nondirectory i)
3306 'face 'anything-ff-directory
3307 'help-echo (expand-file-name i))
3308 else
3309 collect (propertize (file-name-nondirectory i)
3310 'face 'anything-ff-file
3311 'help-echo (expand-file-name i))))
3313 (defvar anything-c-source-files-in-current-dir+
3314 '((name . "Files from Current Directory")
3315 (candidates . (lambda ()
3316 (with-anything-current-buffer
3317 (directory-files (anything-c-current-directory) t))))
3318 (candidate-transformer anything-c-highlight-files)
3319 ;; volatile is not needed, I think.
3320 (type . file)))
3321 ;; (anything 'anything-c-source-files-in-current-dir+)
3325 ;;; Anything-find-files - The anything files browser.
3328 ;; Internal.
3329 (defvar anything-c-find-files-doc-header " (`C-l': Go to precedent level)"
3330 "*The doc that is inserted in the Name header of a find-files or dired source.")
3331 (defvar anything-ff-auto-update-flag anything-ff-auto-update-initial-value
3332 "Internal, flag to turn on/off auto-update in `anything-find-files'.
3333 Don't set it directly, use instead `anything-ff-auto-update-initial-value'.")
3334 (defvar anything-ff-last-expanded nil
3335 "Store last expanded directory or file.")
3336 (defvar anything-ff-default-directory nil)
3337 (defvar anything-ff-history nil)
3338 (defvar anything-ff-cand-to-mark nil)
3341 (defvar anything-c-source-find-files
3342 `((name . "Find Files")
3343 (header-name . (lambda (name)
3344 (concat name anything-c-find-files-doc-header)))
3345 ;; It is needed for filenames with capital letters
3346 (disable-shortcuts)
3347 (init . (lambda ()
3348 (setq anything-ff-auto-update-flag anything-ff-auto-update-initial-value)))
3349 (candidates . anything-find-files-get-candidates)
3350 (filtered-candidate-transformer anything-c-find-files-transformer)
3351 (image-action1 . anything-ff-rotate-image-left)
3352 (image-action2 . anything-ff-rotate-image-right)
3353 (properties-action . anything-ff-properties)
3354 (toggle-auto-update . anything-ff-toggle-auto-update)
3355 (kill-buffer-fname . anything-ff-kill-buffer-fname)
3356 (persistent-action . anything-find-files-persistent-action)
3357 (persistent-help . "Hit1 Expand Candidate, Hit2 or (C-u) Find file")
3358 (mode-line . anything-ff-mode-line-string)
3359 (volatile)
3360 (candidate-number-limit . 9999)
3361 (action-transformer . anything-find-files-action-transformer)
3362 (action
3363 . ,(delq
3365 `(("Find File" . anything-c-find-file-or-marked)
3366 ("Find file in Dired" . anything-c-point-file-in-dired)
3367 ,(and (locate-library "elscreen")
3368 '("Find file in Elscreen" . anything-elscreen-find-file))
3369 ,(and (locate-library "popwin")
3370 '("Find file in popup window" . popwin:find-file))
3371 ("Checksum File" . anything-ff-checksum)
3372 ("Complete at point `M-tab'"
3373 . anything-c-insert-file-name-completion-at-point)
3374 ("Open file externally `C-c C-x, C-u to choose'"
3375 . anything-c-open-file-externally)
3376 ("Grep File(s) `M-g s, C-u Recurse'" . anything-find-files-grep)
3377 ("Zgrep File(s) `M-g z, C-u Recurse'" . anything-ff-zgrep)
3378 ("Switch to Eshell `M-e'" . anything-ff-switch-to-eshell)
3379 ("Etags `M-., C-u tap, C-u C-u reload tag file'" . anything-ff-etags-select)
3380 ("Eshell command on file(s) `M-!, C-u run on all marked at once.'"
3381 . anything-find-files-eshell-command-on-file)
3382 ("Find file as root" . anything-find-file-as-root)
3383 ("Find file in hex dump" . hexl-find-file)
3384 ("Ediff File `C-='" . anything-find-files-ediff-files)
3385 ("Ediff Merge File `C-c ='" . anything-find-files-ediff-merge-files)
3386 ("Delete File(s) `M-D'" . anything-delete-marked-files)
3387 ("Copy file(s) `M-C, C-u to follow'" . anything-find-files-copy)
3388 ("Copy file(s) Async" . anything-ff-copy-async)
3389 ("Rename file(s) `M-R, C-u to follow'" . anything-find-files-rename)
3390 ("Serial rename files" . anything-ff-serial-rename)
3391 ("Serial rename by symlinking files" . anything-ff-serial-rename-by-symlink)
3392 ("Serial rename by copying files" . anything-ff-serial-rename-by-copying)
3393 ("Symlink files(s) `M-S, C-u to follow'" . anything-find-files-symlink)
3394 ("Relsymlink file(s) `C-u to follow'" . anything-find-files-relsymlink)
3395 ("Hardlink file(s) `C-u to follow'" . anything-find-files-hardlink)
3396 ("Find file other window `C-o'" . find-file-other-window)
3397 ("Switch to history `M-p'" . anything-find-files-switch-to-hist)
3398 ("Find file other frame `C-c C-o'" . find-file-other-frame)
3399 ("Print File `C-c p'" . anything-ff-print)
3400 ("Locate `C-x C-f, C-u to specify locate db'" . anything-ff-locate))))))
3401 ;; (anything 'anything-c-source-find-files)
3403 (defun anything-find-files-set-prompt-for-action (prompt files)
3404 "Set prompt for action in `anything-find-files'."
3405 (let ((len (length files)))
3406 (if (> len 1)
3407 (format "%s * %d Files to: " prompt len)
3408 (format "%s %s to: " prompt (car files)))))
3410 (defun anything-dwim-target-directory ()
3411 "Return value of `default-directory' of buffer in other window.
3412 If there is only one window return the value ot `default-directory'
3413 for current buffer."
3414 (with-anything-current-buffer
3415 (let ((num-windows (length (window-list))))
3416 (if (> num-windows 1)
3417 (save-window-excursion
3418 (other-window 1)
3419 default-directory)
3420 (car anything-ff-history)))))
3422 (defun anything-find-files-do-action (action)
3423 "Generic function for creating action from `anything-c-source-find-files'.
3424 ACTION must be an action supported by `anything-dired-action'."
3425 (let* ((ifiles (mapcar 'expand-file-name ; Allow modify '/foo/.' -> '/foo'
3426 (anything-marked-candidates)))
3427 (cand (anything-get-selection)) ; Target
3428 (prompt (anything-find-files-set-prompt-for-action
3429 (capitalize (symbol-name action)) ifiles))
3430 (parg anything-current-prefix-arg)
3431 (dest (anything-c-read-file-name
3432 prompt
3433 :preselect cand
3434 :initial-input (anything-dwim-target-directory)
3435 :history (anything-find-files-history :comp-read nil)))
3436 (win-conf (current-window-configuration)))
3437 (unwind-protect
3438 (let ((default-directory anything-ff-default-directory))
3439 (anything-dired-action
3440 dest :files ifiles :action action :follow parg))
3441 ;; Don't reset win-conf when following.
3442 (unless parg (set-window-configuration win-conf)))))
3444 (defun anything-find-files-copy (candidate)
3445 "Copy files from `anything-find-files'."
3446 (anything-find-files-do-action 'copy))
3448 (defun anything-find-files-rename (candidate)
3449 "Rename files from `anything-find-files'."
3450 (anything-find-files-do-action 'rename))
3452 (defun anything-find-files-symlink (candidate)
3453 "Symlink files from `anything-find-files'."
3454 (anything-find-files-do-action 'symlink))
3456 (defun anything-find-files-relsymlink (candidate)
3457 "Relsymlink files from `anything-find-files'."
3458 (anything-find-files-do-action 'relsymlink))
3460 (defun anything-find-files-hardlink (candidate)
3461 "Hardlink files from `anything-find-files'."
3462 (anything-find-files-do-action 'hardlink))
3464 (defun anything-find-files-byte-compile (candidate)
3465 "Byte compile elisp files from `anything-find-files'."
3466 (let ((files (anything-marked-candidates))
3467 (parg anything-current-prefix-arg))
3468 (loop for fname in files
3469 do (byte-compile-file fname parg))))
3471 (defun anything-find-files-load-files (candidate)
3472 "Load elisp files from `anything-find-files'."
3473 (let ((files (anything-marked-candidates)))
3474 (loop for fname in files
3475 do (load fname))))
3477 (defun anything-find-files-ediff-files (candidate)
3478 "Default action to ediff files in `anything-find-files'."
3479 (ediff-files
3480 candidate
3481 (anything-c-read-file-name
3482 (format "Ediff `%s' With File: " (file-name-nondirectory candidate)))))
3484 (defun anything-find-files-ediff-merge-files (candidate)
3485 "Default action to ediff merge files in `anything-find-files'."
3486 (ediff-merge-files
3487 candidate
3488 (anything-c-read-file-name
3489 (format "Ediff Merge `%s' With File: "
3490 (file-name-nondirectory candidate)))))
3492 (defun anything-find-files-grep (candidate)
3493 "Default action to grep files from `anything-find-files'."
3494 (anything-do-grep-1 (anything-marked-candidates)
3495 anything-current-prefix-arg))
3497 (defun anything-ff-zgrep (candidate)
3498 "Default action to zgrep files from `anything-find-files'."
3499 (let ((prefarg anything-current-prefix-arg)
3500 (ls (anything-marked-candidates)))
3501 (anything-ff-zgrep-1 ls prefarg)))
3503 (defun anything-ff-pdfgrep (candidate)
3504 "Default action to pdfgrep files from `anything-find-files'."
3505 (let ((cands (loop for file in (anything-marked-candidates)
3506 if (or (string= (file-name-extension file) "pdf")
3507 (string= (file-name-extension file) "PDF"))
3508 collect file))
3509 (anything-c-pdfgrep-default-function 'anything-c-pdfgrep-init))
3510 (when cands
3511 (anything-do-pdfgrep-1 cands))))
3513 (defun anything-ff-etags-select (candidate)
3514 "Default action to jump to etags from `anything-find-files'."
3515 (when (get-buffer anything-action-buffer)
3516 (kill-buffer anything-action-buffer))
3517 (let ((default-directory anything-ff-default-directory))
3518 (anything-c-etags-select anything-current-prefix-arg)))
3520 (defun anything-find-files-switch-to-hist (candidate)
3521 "Switch to anything-find-files history."
3522 (anything-find-files t))
3524 ;;; Asynchronous copy of files.
3527 (defun anything-c-copy-files-async-1 (flist dest)
3528 "Copy a list of Files FLIST to DEST asynchronously.
3529 It use another emacs process to do the job.
3530 Communication with background emacs is done with temp file
3531 `anything-c-copy-files-async-log-file'."
3532 (start-file-process "emacs-batch" nil anything-c-copy-async-prefered-emacs
3533 "-Q" "--batch" "--eval"
3534 (format "(progn
3535 (require 'dired) (require 'cl)
3536 (let ((dired-recursive-copies 'always)
3537 failures success
3538 (ovw-count 0)
3539 (cpf-count 0))
3540 (dolist (f '%S)
3541 (condition-case err
3542 (let ((file-exists (file-exists-p
3543 (expand-file-name
3544 (file-name-nondirectory (directory-file-name f))
3545 (file-name-directory
3546 (file-name-as-directory \"%s\"))))))
3547 (dired-copy-file f \"%s\" t)
3548 (if file-exists
3549 (progn (push (cons \"Overwriting\" f) success)
3550 (incf ovw-count))
3551 (push (cons \"Copying\" f) success)
3552 (incf cpf-count)))
3553 (file-error
3554 (push (dired-make-relative
3555 (expand-file-name
3556 (file-name-nondirectory (directory-file-name f))
3557 (file-name-directory \"%s\")))
3558 failures))))
3559 (with-current-buffer (find-file-noselect \"%s\")
3560 (erase-buffer)
3561 (when failures
3562 (dolist (fail (reverse failures))
3563 (insert (concat \"Failed to copy \" fail \"\n\"))))
3564 (when success
3565 (loop for (a . s) in (reverse success) do
3566 (insert (concat a \" \" s \" to %s done\n\"))))
3567 (and (/= cpf-count 0) (insert (concat (int-to-string cpf-count) \" File(s) Copied\n\")))
3568 (and (/= ovw-count 0) (insert (concat (int-to-string ovw-count) \" File(s) Overwrited\n\")))
3569 (and failures (insert (concat (int-to-string (length failures)) \" File(s) Failed to copy\n\")))
3570 (save-buffer))))"
3571 flist dest dest dest anything-c-copy-files-async-log-file dest)))
3573 (defun anything-c-copy-async-with-log (flist dest)
3574 "Copy file list FLIST to DEST showing log.
3575 Log is send to `anything-c-copy-files-async-log-file'.
3576 Copying is done asynchronously with `anything-c-copy-files-async-1'."
3577 (declare (special auto-revert-interval))
3578 (pop-to-buffer (find-file-noselect anything-c-copy-files-async-log-file))
3579 (set (make-local-variable 'auto-revert-interval) 1)
3580 (erase-buffer)
3581 (insert "Wait copying files...\n")
3582 (sit-for 0.5) (save-buffer)
3583 (goto-char (point-max))
3584 (auto-revert-mode 1)
3585 (anything-c-copy-files-async-1 flist dest))
3587 (defun anything-ff-copy-async (candidate)
3588 "Anything find files action to copy files async.
3589 Copying is done asynchronously with `anything-c-copy-files-async-1'."
3590 (let ((flist (anything-marked-candidates))
3591 (dest (anything-c-read-file-name
3592 "Copy File(s) async To: "
3593 :preselect candidate
3594 :initial-input (car anything-ff-history)
3595 :history (anything-find-files-history :comp-read nil))))
3596 (anything-c-copy-async-with-log flist dest)))
3598 (defvar eshell-command-aliases-list nil)
3599 (defun anything-find-files-eshell-command-on-file-1 (candidate &optional map)
3600 "Run `eshell-command' on CANDIDATE or marked candidates possibly with an eshell alias.
3602 Basename of CANDIDATE can be a wild-card.
3603 If MAP is given run `eshell-command' on all marked files at once,
3604 Otherwise, run `eshell-command' on each marked files.
3606 If `eshell' or `eshell-command' have not been run once, or if you have no eshell aliases
3607 `eshell-command-aliases-list' will not be loaded first time you use this."
3608 (when (or eshell-command-aliases-list
3609 (y-or-n-p "Eshell is not loaded, run eshell-command without alias anyway? "))
3610 (and eshell-command-aliases-list (eshell-read-aliases-list))
3611 (let* ((cand-list (anything-marked-candidates))
3612 (default-directory (or anything-ff-default-directory
3613 ;; If candidate is an url *-ff-default-directory is nil
3614 ;; so keep value of default-directory.
3615 default-directory))
3616 (command (anything-comp-read
3617 "Command: "
3618 (loop for (a . c) in eshell-command-aliases-list
3619 when (string-match "\\(\\$1\\|\\$\\*\\)$" (car c))
3620 collect (propertize a 'help-echo (car c)) into ls
3621 finally return (sort ls 'string<))))
3622 (com-value (car (assoc-default command eshell-command-aliases-list))))
3623 (if (and (or map (and com-value (string-match "\\$\\*$" com-value)))
3624 (> (length cand-list) 1))
3625 ;; Run eshell-command with ALL marked files as arguments.
3626 (let ((mapfiles (mapconcat 'shell-quote-argument cand-list " ")))
3627 (eshell-command (format "%s %s" command mapfiles)))
3628 ;; Run eshell-command on EACH marked files.
3629 (loop
3630 for i in cand-list
3631 for bn = (anything-c-basename i)
3632 for files = (if (and bn (string-match "^\*" bn))
3633 ;; Assume if fname is a wildcard
3634 ;; cand-list have a length of 1.
3635 (mapconcat
3636 'shell-quote-argument
3637 (file-expand-wildcards i t) " ")
3638 (format "'%s'" i))
3639 for com = (if (string-match "'%s'\\|\"%s\"\\|%s" command)
3640 ;; This allow to enter other args AFTER filename
3641 ;; i.e <command %s some_more_args>
3642 (format command files)
3643 (format "%s %s" command files))
3644 do (eshell-command com))))))
3646 (defun anything-find-files-eshell-command-on-file (candidate)
3647 "Run `eshell-command' on CANDIDATE or marked candidates.
3648 See `anything-find-files-eshell-command-on-file-1' for more info."
3649 (anything-find-files-eshell-command-on-file-1
3650 candidate anything-current-prefix-arg))
3652 (defun anything-ff-switch-to-eshell (candidate)
3653 "Switch to eshell and cd to `anything-ff-default-directory'."
3654 (flet ((cd-eshell ()
3655 (goto-char (point-max))
3656 (insert
3657 (format "cd '%s'" anything-ff-default-directory))
3658 (eshell-send-input)))
3659 (if (get-buffer "*eshell*")
3660 (progn
3661 (anything-c-switch-to-buffer "*eshell*")
3662 (cd-eshell))
3663 (call-interactively 'eshell)
3664 (cd-eshell))))
3666 (defun anything-ff-serial-rename-action (method)
3667 "Rename all marked files to `anything-ff-default-directory' with METHOD.
3668 See `anything-ff-serial-rename-1'."
3669 (let ((cands (anything-marked-candidates))
3670 (name (read-string "NewName: "))
3671 (start (read-number "StartAtNumber: "))
3672 (dir (expand-file-name
3673 (anything-c-read-file-name
3674 "Serial Rename to directory: " :initial-input
3675 (expand-file-name anything-ff-default-directory)))))
3676 (when (y-or-n-p (format "Serial Rename %s *files to `%s' with prefix `%s'? "
3677 (length cands) dir name))
3678 (anything-ff-serial-rename-1 dir cands name start :method method)
3679 (anything-find-files-1 dir))))
3681 (defun anything-ff-member-directory-p (file directory)
3682 (let ((dir-file (expand-file-name (file-name-as-directory (file-name-directory file))))
3683 (cur-dir (expand-file-name (file-name-as-directory directory))))
3684 (string= dir-file cur-dir)))
3686 (defun* anything-ff-serial-rename-1
3687 (directory collection new-name start-at-num &key (method 'rename))
3688 "rename files in COLLECTION to DIRECTORY with the prefix name NEW-NAME.
3689 Rename start at number START-AT-NUM - ex: prefixname-01.jpg.
3690 METHOD can be one of rename, copy or symlink.
3691 Files will be renamed if they are files of current directory, otherwise they
3692 will be treated with METHOD.
3693 Default METHOD is rename."
3694 ;; Maybe remove directories selected by error in collection.
3695 (setq collection (remove-if 'file-directory-p collection))
3696 (flet ((symlink-file (file dest)
3697 (let ((flist (list file)))
3698 (anything-dired-action
3699 dest :action 'symlink :files flist))))
3701 (let* ((tmp-dir (file-name-as-directory
3702 (concat (file-name-as-directory directory)
3703 (symbol-name (gensym "tmp")))))
3704 (fn (case method
3705 (copy 'copy-file)
3706 (symlink 'symlink-file)
3707 (rename 'rename-file)
3708 (t (error "Error: Unknow method %s" method)))))
3709 (make-directory tmp-dir)
3710 (loop for i in collection
3711 for count from start-at-num
3712 for fnum = (if (< count 10) "0%s" "%s")
3713 for nname = (concat tmp-dir new-name (format fnum count)
3714 (file-name-extension i 'dot))
3715 do (if (anything-ff-member-directory-p i directory)
3716 (rename-file i nname)
3717 (funcall fn i nname)))
3718 (loop with dirlist = (directory-files
3719 tmp-dir t directory-files-no-dot-files-regexp)
3720 for f in dirlist do
3721 (if (file-symlink-p f)
3722 (symlink-file (file-truename f)
3723 (concat (file-name-as-directory directory)
3724 (anything-c-basename f)))
3725 (rename-file f directory)))
3726 (delete-directory tmp-dir t))))
3728 (defun anything-ff-serial-rename (candidate)
3729 "Serial rename all marked files to `anything-ff-default-directory'.
3730 Rename only file of current directory, and symlink files coming from
3731 other directories.
3732 See `anything-ff-serial-rename-1'."
3733 (anything-ff-serial-rename-action 'rename))
3735 (defun anything-ff-serial-rename-by-symlink (candidate)
3736 "Serial rename all marked files to `anything-ff-default-directory'.
3737 Rename only file of current directory, and symlink files coming from
3738 other directories.
3739 See `anything-ff-serial-rename-1'."
3740 (anything-ff-serial-rename-action 'symlink))
3742 (defun anything-ff-serial-rename-by-copying (candidate)
3743 "Serial rename all marked files to `anything-ff-default-directory'.
3744 Rename only file of current directory, and copy files coming from
3745 other directories.
3746 See `anything-ff-serial-rename-1'."
3747 (anything-ff-serial-rename-action 'copy))
3749 (defun anything-c-quit-and-execute-action (action)
3750 "Quit current anything session and execute ACTION."
3751 (setq anything-saved-action action)
3752 (anything-exit-minibuffer))
3754 (defun anything-ff-toggle-auto-update (candidate)
3755 (setq anything-ff-auto-update-flag (not anything-ff-auto-update-flag))
3756 (message "[Auto expansion %s]"
3757 (if anything-ff-auto-update-flag "enabled" "disabled")))
3759 ;;;###autoload
3760 (defun anything-ff-run-toggle-auto-update ()
3761 (interactive)
3762 (anything-execute-persistent-action 'toggle-auto-update))
3764 ;;;###autoload
3765 (defun anything-ff-run-switch-to-history ()
3766 "Run Switch to history action from `anything-c-source-find-files'."
3767 (interactive)
3768 (anything-c-quit-and-execute-action 'anything-find-files-switch-to-hist))
3770 ;;;###autoload
3771 (defun anything-ff-run-grep ()
3772 "Run Grep action from `anything-c-source-find-files'."
3773 (interactive)
3774 (anything-c-quit-and-execute-action 'anything-find-files-grep))
3776 ;;;###autoload
3777 (defun anything-ff-run-pdfgrep ()
3778 "Run Pdfgrep action from `anything-c-source-find-files'."
3779 (interactive)
3780 (anything-c-quit-and-execute-action 'anything-ff-pdfgrep))
3782 ;;;###autoload
3783 (defun anything-ff-run-zgrep ()
3784 "Run Grep action from `anything-c-source-find-files'."
3785 (interactive)
3786 (anything-c-quit-and-execute-action 'anything-ff-zgrep))
3788 ;;;###autoload
3789 (defun anything-ff-run-copy-file ()
3790 "Run Copy file action from `anything-c-source-find-files'."
3791 (interactive)
3792 (anything-c-quit-and-execute-action 'anything-find-files-copy))
3794 ;;;###autoload
3795 (defun anything-ff-run-rename-file ()
3796 "Run Rename file action from `anything-c-source-find-files'."
3797 (interactive)
3798 (anything-c-quit-and-execute-action 'anything-find-files-rename))
3800 ;;;###autoload
3801 (defun anything-ff-run-byte-compile-file ()
3802 "Run Byte compile file action from `anything-c-source-find-files'."
3803 (interactive)
3804 (anything-c-quit-and-execute-action 'anything-find-files-byte-compile))
3806 ;;;###autoload
3807 (defun anything-ff-run-load-file ()
3808 "Run Load file action from `anything-c-source-find-files'."
3809 (interactive)
3810 (anything-c-quit-and-execute-action 'anything-find-files-load-files))
3812 ;;;###autoload
3813 (defun anything-ff-run-eshell-command-on-file ()
3814 "Run eshell command on file action from `anything-c-source-find-files'."
3815 (interactive)
3816 (anything-c-quit-and-execute-action 'anything-find-files-eshell-command-on-file))
3818 ;;;###autoload
3819 (defun anything-ff-run-ediff-file ()
3820 "Run Ediff file action from `anything-c-source-find-files'."
3821 (interactive)
3822 (anything-c-quit-and-execute-action 'anything-find-files-ediff-files))
3824 ;;;###autoload
3825 (defun anything-ff-run-ediff-merge-file ()
3826 "Run Ediff merge file action from `anything-c-source-find-files'."
3827 (interactive)
3828 (anything-c-quit-and-execute-action 'anything-find-files-ediff-merge-files))
3830 ;;;###autoload
3831 (defun anything-ff-run-symlink-file ()
3832 "Run Symlink file action from `anything-c-source-find-files'."
3833 (interactive)
3834 (anything-c-quit-and-execute-action 'anything-find-files-symlink))
3836 ;;;###autoload
3837 (defun anything-ff-run-delete-file ()
3838 "Run Delete file action from `anything-c-source-find-files'."
3839 (interactive)
3840 (anything-c-quit-and-execute-action 'anything-delete-marked-files))
3842 ;;;###autoload
3843 (defun anything-ff-run-complete-fn-at-point ()
3844 "Run complete file name action from `anything-c-source-find-files'."
3845 (interactive)
3846 (anything-c-quit-and-execute-action
3847 'anything-c-insert-file-name-completion-at-point))
3849 ;;;###autoload
3850 (defun anything-ff-run-switch-to-eshell ()
3851 "Run switch to eshell action from `anything-c-source-find-files'."
3852 (interactive)
3853 (anything-c-quit-and-execute-action 'anything-ff-switch-to-eshell))
3855 ;;;###autoload
3856 (defun anything-ff-run-switch-other-window ()
3857 "Run switch to other window action from `anything-c-source-find-files'."
3858 (interactive)
3859 (anything-c-quit-and-execute-action 'find-file-other-window))
3861 ;;;###autoload
3862 (defun anything-ff-run-switch-other-frame ()
3863 "Run switch to other frame action from `anything-c-source-find-files'."
3864 (interactive)
3865 (anything-c-quit-and-execute-action 'find-file-other-frame))
3867 ;;;###autoload
3868 (defun anything-ff-run-open-file-externally ()
3869 "Run open file externally command action from `anything-c-source-find-files'."
3870 (interactive)
3871 (anything-c-quit-and-execute-action 'anything-c-open-file-externally))
3873 (defun anything-ff-locate (candidate)
3874 "Locate action function for `anything-find-files'."
3875 (let ((input (concat (anything-c-basename
3876 (expand-file-name
3877 candidate
3878 anything-ff-default-directory))
3879 ;; The locate '-b' option doesn't exists
3880 ;; in everything.
3881 (unless (and (eq system-type 'windows-nt)
3882 (string-match "^es" anything-c-locate-command))
3883 " -b")))
3884 (anything-mp-highlight-delay 0.7))
3885 (anything-locate-1 anything-current-prefix-arg input)))
3887 ;;;###autoload
3888 (defun anything-ff-run-locate ()
3889 "Run locate action from `anything-c-source-find-files'."
3890 (interactive)
3891 (anything-c-quit-and-execute-action 'anything-ff-locate))
3893 ;;;###autoload
3894 (defun anything-ff-run-gnus-attach-files ()
3895 "Run gnus attach files command action from `anything-c-source-find-files'."
3896 (interactive)
3897 (anything-c-quit-and-execute-action 'anything-ff-gnus-attach-files))
3899 ;;;###autoload
3900 (defun anything-ff-run-etags ()
3901 "Run Etags command action from `anything-c-source-find-files'."
3902 (interactive)
3903 (anything-c-quit-and-execute-action 'anything-ff-etags-select))
3906 (defun anything-ff-print (candidate)
3907 "Print marked files.
3908 You have to set in order
3909 variables `lpr-command',`lpr-switches' and/or `printer-name'.
3911 e.g:
3912 \(setq lpr-command \"gtklp\"\)
3913 \(setq lpr-switches '(\"-P\")\)
3914 \(setq printer-name \"Epson-Stylus-Photo-R265\"\)
3916 Same as `dired-do-print' but for anything."
3917 (let* ((file-list (anything-marked-candidates))
3918 (len (length file-list))
3919 (printer-name (if anything-ff-printer-list
3920 (anything-comp-read
3921 "Printer: " anything-ff-printer-list)
3922 printer-name))
3923 (command (read-string
3924 (format "Print *%s File(s):\n%s with: "
3926 (mapconcat
3927 (lambda (f) (format "- %s\n" f))
3928 file-list ""))
3929 (when (and lpr-command
3930 (or lpr-switches
3931 printer-name))
3932 (mapconcat 'identity
3933 (cons lpr-command
3934 (append (if (stringp lpr-switches)
3935 (list lpr-switches)
3936 lpr-switches)
3937 (list printer-name)))
3938 " "))))
3939 (file-args (mapconcat #'(lambda (x)
3940 (format "'%s'" x))
3941 file-list " "))
3942 (cmd-line (concat command " " file-args)))
3943 (if command
3944 (start-process-shell-command "anything-print" nil cmd-line)
3945 (error "Error: Please verify your printer settings in Emacs."))))
3947 ;;;###autoload
3948 (defun anything-ff-run-print-file ()
3949 "Run Print file action from `anything-c-source-find-files'."
3950 (interactive)
3951 (anything-c-quit-and-execute-action 'anything-ff-print))
3953 (defun* anything-ff-checksum (file)
3954 "Calculate the checksum of FILE with completion on algorithms to use.
3955 The checksum is copied to kill-ring."
3956 (let ((algo-list '(md5 sha1 sha224 sha256 sha384 sha512)))
3957 (kill-new
3958 (secure-hash (intern
3959 (anything-comp-read
3960 "Algorithm: " algo-list))
3961 file))
3962 (message "Checksum copied to kill-ring.")))
3964 (defun* anything-reduce-file-name (fname level &key unix-close expand)
3965 "Reduce FNAME by LEVEL from end or beginning depending LEVEL value.
3966 If LEVEL is positive reduce from end else from beginning.
3967 If UNIX-CLOSE is non--nil close filename with /.
3968 If EXPAND is non--nil expand-file-name."
3969 (let* ((exp-fname (expand-file-name fname))
3970 (fname-list (split-string (if (or (string= fname "~/") expand)
3971 exp-fname fname) "/" t))
3972 (len (length fname-list))
3973 (pop-list (if (< level 0)
3974 (subseq fname-list (* level -1))
3975 (subseq fname-list 0 (- len level))))
3976 (result (mapconcat 'identity pop-list "/"))
3977 (empty (string= result "")))
3978 (when unix-close (setq result (concat result "/")))
3979 (if (string-match "^~" result)
3980 (if (string= result "~/") "~/" result)
3981 (if (< level 0)
3982 (if empty "../" (concat "../" result))
3983 (cond ((eq system-type 'windows-nt)
3984 (if empty "c:/" result))
3985 (empty "/")
3987 (concat "/" result)))))))
3989 (defun anything-file-completion-source-p ()
3990 "Test if current source is a dired or find-files source."
3991 (let ((ff-sources '("Find Files" "Copy Files"
3992 "Read File Name History"
3993 "Rename Files" "Symlink Files"
3994 "Hardlink Files" "Write File"
3995 "Insert File" "Read file name"))
3996 (cur-source (cdr (assoc 'name (anything-get-current-source)))))
3997 (loop for i in ff-sources thereis (string= cur-source i))))
3999 (defun anything-find-files-down-one-level (arg)
4000 "Go down one level like unix command `cd ..'.
4001 If prefix numeric arg is given go ARG level down."
4002 (interactive "p")
4003 (with-anything-window
4004 (setq anything-follow-mode nil))
4005 ;; When going to precedent level we want to be at the line
4006 ;; corresponding to actual directory, so store this info
4007 ;; in `anything-ff-last-expanded'.
4008 (if (and (not (file-directory-p anything-pattern))
4009 (file-exists-p anything-pattern))
4010 (setq anything-ff-last-expanded anything-pattern)
4011 (setq anything-ff-last-expanded anything-ff-default-directory))
4012 (when (anything-file-completion-source-p)
4013 (let ((new-pattern (anything-reduce-file-name anything-pattern arg
4014 :unix-close t :expand t)))
4015 (with-selected-window (minibuffer-window)
4016 (delete-minibuffer-contents)
4017 (insert new-pattern)))))
4019 (defun anything-ff-retrieve-last-expanded ()
4020 "Move overlay to last visited directory `anything-ff-last-expanded'.
4021 This happen after using `anything-find-files-down-one-level',
4022 or hitting C-z on \"..\"."
4023 (when (and anything-ff-last-expanded
4024 (anything-file-completion-source-p))
4025 (let ((dirname (directory-file-name anything-ff-last-expanded)))
4026 (with-anything-window
4027 (when (or (re-search-forward (concat dirname "$") nil t)
4028 (re-search-forward
4029 (concat anything-ff-last-expanded "$") nil t))
4030 (forward-line 0)
4031 (anything-mark-current-line)))
4032 (setq anything-ff-last-expanded nil))))
4033 (add-hook 'anything-after-update-hook 'anything-ff-retrieve-last-expanded)
4035 ;; Auto-update - anything-find-files auto expansion of directories.
4037 (defun anything-ff-update-when-only-one-matched ()
4038 "Expand to directory when sole completion.
4039 When only one candidate is remaining and it is a directory,
4040 expand to this directory."
4041 (let ((history-p (string= (assoc-default
4042 'name (anything-get-current-source))
4043 "Read File Name History"))
4044 (completed-p (string= (file-name-as-directory anything-pattern)
4045 anything-ff-default-directory)))
4046 (when (and anything-ff-auto-update-flag
4047 (or (and (anything-file-completion-source-p)
4048 (<= (anything-approximate-candidate-number) 2)
4049 (>= (length (anything-c-basename anything-pattern)) 2))
4050 completed-p)
4051 (not history-p))
4052 (with-anything-window
4053 (and (not completed-p) (anything-next-line))
4054 (let ((cur-cand (anything-get-selection)))
4055 (when (file-directory-p cur-cand)
4056 (if (and (not (string-match "^.*[.]\\{1,2\\}$" cur-cand)) ; [1]
4057 ;; Maybe we are here because completed-p is true
4058 ;; So check this again to be sure.
4059 ;; (this happen only on windows dirs)
4060 (<= (anything-approximate-candidate-number) 2)) ; [2]
4061 ;; If after going to next line the candidate is not "." or ".." [1]
4062 ;; and only one candidate is remaining [2],
4063 ;; assume candidate is a new directory to expand, and do it.
4064 (anything-set-pattern (file-name-as-directory cur-cand))
4065 ;; The candidate is one of "." or ".." (it should be "..").
4066 ;; that mean we have entered the last letter of the directory name
4067 ;; in prompt, so expansion is already done, just add the "/" at end
4068 ;; of name unless anything-pattern ends with "."
4069 (unless (string-match "^.*[.]\\{1\\}$" anything-pattern)
4070 (anything-set-pattern (file-name-as-directory anything-pattern))))
4071 (anything-check-minibuffer-input-1)))))))
4072 (add-hook 'anything-after-update-hook 'anything-ff-update-when-only-one-matched)
4074 ;; Allow expanding to home directory or root
4075 ;; when entering respectively "~/" or "//" at end of pattern.
4076 ;; e.g /home/thierry/labo/anything-config-qp/~/
4077 ;; will expand to "~/"
4078 ;; and /home/thierry/labo/anything-config-qp//
4079 ;; will expand to "/"
4080 (defun anything-ff-auto-expand-to-home-or-root ()
4081 (when (and (anything-file-completion-source-p)
4082 (string-match ".*\\(/~/\\|/\\{2\\}\\)$" anything-pattern))
4083 (let ((match (match-string 1 anything-pattern)))
4084 (cond ((string= match "//")
4085 (if (eq system-type 'windows-nt)
4086 (setq anything-pattern "c:/")
4087 (setq anything-pattern "/")))
4088 ((string= match "/~/")
4089 (if (eq system-type 'windows-nt)
4090 (setq anything-pattern (replace-regexp-in-string
4091 "\\\\" "/" (getenv "HOME")))
4092 (setq anything-pattern "~/")))))
4093 (setq anything-ff-default-directory anything-pattern)
4094 (with-current-buffer (window-buffer (minibuffer-window))
4095 (delete-minibuffer-contents)
4096 (insert anything-pattern))))
4097 (add-hook 'anything-after-update-hook 'anything-ff-auto-expand-to-home-or-root)
4099 (defun anything-c-point-file-in-dired (file)
4100 "Put point on filename FILE in dired buffer."
4101 (dired (file-name-directory file))
4102 (dired-goto-file file))
4104 (defun anything-create-tramp-name (fname)
4105 "Build filename for `anything-pattern' like /su:: or /sudo::."
4106 (apply #'tramp-make-tramp-file-name
4107 (loop with v = (tramp-dissect-file-name fname)
4108 for i across v collect i)))
4110 (defun anything-ff-set-pattern (pattern)
4111 "Handle tramp filenames in `anything-pattern'."
4112 (let ((methods (mapcar 'car tramp-methods))
4113 (reg "\\`/\\([^[/:]+\\|[^/]+]\\):.*:")
4114 cur-method tramp-name)
4115 (cond ((string= pattern "") "")
4116 ((string-match ".*\\(~//\\|//\\)$" pattern)
4117 (if (eq system-type 'windows-nt) "c:/" "/"))
4118 ((string-match "^~\\|.*/~/$" pattern)
4119 (let* ((home (getenv "HOME"))
4120 (replace (if (eq system-type 'windows-nt)
4121 (replace-regexp-in-string
4122 "\\\\" "/" home)
4123 home)))
4124 (replace-match replace nil t pattern)))
4125 ;; Match "/method:maybe_hostname:"
4126 ((and (string-match reg pattern)
4127 (setq cur-method (match-string 1 pattern))
4128 (member cur-method methods))
4129 (setq tramp-name (anything-create-tramp-name
4130 (match-string 0 pattern)))
4131 (replace-match tramp-name nil t pattern))
4132 ;; Match "/hostname:"
4133 ((and (string-match tramp-file-name-regexp pattern)
4134 (setq cur-method (match-string 1 pattern))
4135 (and cur-method (not (member cur-method methods))))
4136 (setq tramp-name (anything-create-tramp-name
4137 (match-string 0 pattern)))
4138 (replace-match tramp-name nil t pattern))
4139 ;; Match "/method:" in this case don't try to connect.
4140 ((and (not (string-match reg pattern))
4141 (string-match tramp-file-name-regexp pattern)
4142 (member (match-string 1 pattern) methods))
4143 "Invalid tramp file name") ; Write in anything-buffer.
4144 ;; PATTERN is a directory, end it with "/".
4145 ;; This will make PATTERN not ending yet with "/"
4146 ;; candidate for `anything-ff-default-directory',
4147 ;; allowing `anything-ff-retrieve-last-expanded' to retrieve it
4148 ;; when descending level.
4149 ((file-directory-p pattern)
4150 (file-name-as-directory pattern))
4151 ;; Return PATTERN unchanged.
4152 (t pattern))))
4155 (defun anything-find-files-get-candidates ()
4156 "Create candidate list for `anything-c-source-find-files'."
4157 (let* ((path (anything-ff-set-pattern anything-pattern))
4158 (path-name-dir (if (file-directory-p path)
4159 (file-name-as-directory path)
4160 (file-name-directory path)))
4161 (tramp-verbose anything-tramp-verbose)) ; No tramp message when 0.
4162 (set-text-properties 0 (length path) nil path)
4163 (setq anything-pattern (anything-ff-transform-fname-for-completion path))
4164 (setq anything-ff-default-directory
4165 (if (string= anything-pattern "")
4166 (if (eq system-type 'windows-nt) "c:/" "/")
4167 (unless (string-match ffap-url-regexp path)
4168 path-name-dir)))
4169 (cond ((or (string= path "Invalid tramp file name")
4170 (file-regular-p path)
4171 (and (not (file-exists-p path)) (string-match "/$" path))
4172 (and ffap-url-regexp (string-match ffap-url-regexp path)))
4173 (list path))
4174 ((string= path "") (directory-files "/" t))
4175 ((and (file-directory-p path) (not (file-readable-p path)))
4176 (list (format "Opening directory: access denied, `%s'" path)))
4177 ((file-directory-p path) (directory-files path t))
4179 (append (list path) (directory-files path-name-dir t))))))
4181 (defun anything-ff-transform-fname-for-completion (fname)
4182 "Return FNAME with it's basename modified as a regexp.
4183 e.g foo => f.*o.*o .
4184 If basename contain one or more space or FNAME is a valid directory name
4185 return FNAME unchanged."
4186 (let ((bn (anything-c-basename fname)))
4187 (if (or (not anything-ff-smart-completion)
4188 (string-match "\\s-" bn)
4189 (string-match "/$" fname) ; Allow mkdir.
4190 (file-directory-p fname))
4191 fname ; Fall back to match-plugin.
4192 (setq bn (if (> (length bn) 2) ; Normal completion on first 2 char.
4193 (mapconcat 'identity (split-string bn "" t) ".*") bn))
4194 (concat (file-name-directory fname) bn))))
4196 (defun anything-ff-save-history ()
4197 "Store the last value of `anything-ff-default-directory' \
4198 in `anything-ff-history'."
4199 (when (and anything-ff-default-directory
4200 (anything-file-completion-source-p))
4201 (push anything-ff-default-directory anything-ff-history)))
4202 (add-hook 'anything-cleanup-hook 'anything-ff-save-history)
4204 (defun anything-ff-valid-symlink-p (file)
4205 (file-exists-p (file-truename file)))
4207 (defun anything-ff-properties (candidate)
4208 "Show file properties of CANDIDATE in a tooltip or message."
4209 (let ((type (anything-ff-attributes candidate :type t))
4210 (dired-line (anything-ff-attributes candidate :dired t :human-size t)))
4211 (if (window-system)
4212 (tooltip-show
4213 (concat
4214 (anything-c-basename candidate) ": \n"
4215 "Type: " type "\n"
4216 (when (string= type "symlink")
4217 (format "True name: '%s'\n"
4218 (cond ((string-match "^\.#" (anything-c-basename candidate))
4219 "Autosave symlink")
4220 ((anything-ff-valid-symlink-p candidate)
4221 (file-truename candidate))
4222 (t "Invalid Symlink"))))
4223 dired-line))
4224 (message dired-line) (sit-for 5))))
4226 ;;;###autoload
4227 (defun anything-ff-properties-persistent ()
4228 "Show properties without quitting anything."
4229 (interactive)
4230 (anything-execute-persistent-action 'properties-action))
4232 (defun anything-ff-kill-buffer-fname (candidate)
4233 (let* ((buf (get-file-buffer candidate))
4234 (buf-name (buffer-name buf)))
4235 (if buf
4236 (progn
4237 (kill-buffer buf) (message "Buffer `%s' killed" buf))
4238 (message "No buffer to kill"))))
4240 (defun anything-ff-kill-or-find-buffer-fname (candidate)
4241 "Find file CANDIDATE or kill it's buffer if it is visible.
4242 Never kill `anything-current-buffer'.
4243 Never kill buffer modified.
4244 This is called normally on third hit of \
4245 \\<anything-map>\\[anything-execute-persistent-action]
4246 in `anything-find-files-persistent-action'."
4247 (let* ((buf (get-file-buffer candidate))
4248 (buf-name (buffer-name buf)))
4249 (if (and buf (get-buffer-window buf)
4250 (not (eq buf (get-buffer anything-current-buffer)))
4251 (not (buffer-modified-p buf)))
4252 (progn
4253 (kill-buffer buf) (message "Buffer `%s' killed" buf-name))
4254 (find-file candidate))))
4256 ;;;###autoload
4257 (defun anything-ff-run-kill-buffer-persistent ()
4258 "Execute `anything-ff-kill-buffer-fname' whitout quitting."
4259 (interactive)
4260 (anything-execute-persistent-action 'kill-buffer-fname))
4262 (defun anything-ff-human-size (size)
4263 "Return a string showing SIZE of a file in human readable form.
4264 SIZE can be an integer or a float depending it's value.
4265 `file-attributes' will take care of that to avoid overflow error.
4266 KBSIZE if a floating point number, default value is 1024.0."
4267 (let ((M (cons "M" (/ size (expt anything-ff-default-kbsize 2))))
4268 (G (cons "G" (/ size (expt anything-ff-default-kbsize 3))))
4269 (K (cons "K" (/ size anything-ff-default-kbsize)))
4270 (B (cons "B" size)))
4271 (loop with result = B
4272 for (a . b) in
4273 (loop for (x . y) in (list M G K B)
4274 unless (< y 1) collect (cons x y))
4275 when (< b (cdr result)) do (setq result (cons a b))
4276 finally return (if (string= (car result) "B")
4277 (format "%s" size)
4278 (format "%.1f%s" (cdr result) (car result))))))
4280 (defun* anything-ff-attributes
4281 (file &key type links uid gid access-time modif-time
4282 status size mode gid-change inode device-num dired human-size)
4283 "Easy interface for `file-attributes'."
4284 (let ((all (destructuring-bind
4285 (type links uid gid access-time modif-time
4286 status size mode gid-change inode device-num)
4287 (file-attributes file 'string)
4288 (list :type type
4289 :links links
4290 :uid uid
4291 :gid gid
4292 :access-time access-time
4293 :modif-time modif-time
4294 :status status
4295 :size size
4296 :mode mode
4297 :gid-change gid-change
4298 :inode inode
4299 :device-num device-num))))
4300 (cond (type
4301 (let ((result (getf all :type)))
4302 (cond ((stringp result)
4303 "symlink")
4304 (result "directory")
4305 (t "file"))))
4306 (links (getf all :links))
4307 (uid (getf all :uid))
4308 (gid (getf all :gid))
4309 (access-time
4310 (format-time-string "%Y-%m-%d %R" (getf all :access-time)))
4311 (modif-time
4312 (format-time-string "%Y-%m-%d %R" (getf all :modif-time)))
4313 (status
4314 (format-time-string "%Y-%m-%d %R" (getf all :status)))
4315 (size (if human-size (anything-ff-human-size (getf all :size))
4316 (getf all :size)))
4317 (mode (getf all :mode))
4318 (gid-change (getf all :gid-change))
4319 (inode (getf all :inode))
4320 (device-num (getf all :device-num))
4321 (dired
4322 (concat
4323 (getf all :mode) " "
4324 (number-to-string (getf all :links)) " "
4325 (getf all :uid) ":"
4326 (getf all :gid) " "
4327 (if human-size (anything-ff-human-size (getf all :size))
4328 (int-to-string (getf all :size))) " "
4329 (format-time-string "%Y-%m-%d %R" (getf all :modif-time))))
4330 (t all))))
4333 (defun anything-c-prefix-filename (fname &optional image file-or-symlinkp)
4334 "Return filename FNAME maybe prefixed with icon IMAGE.
4335 If FILE-OR-SYMLINKP is non--nil this mean we assume FNAME is an
4336 existing filename or valid symlink and there is no need to test it."
4337 (let* ((img-name (and image (expand-file-name
4338 image anything-c-find-files-icons-directory)))
4339 (img (and image (create-image img-name)))
4340 (prefix-img (and image (propertize " " 'display img)))
4341 (prefix-new (propertize
4342 " " 'display
4343 (propertize "[?]" 'face 'anything-ff-prefix)))
4344 (prefix-url (propertize
4345 " " 'display
4346 (propertize "[@]" 'face 'anything-ff-prefix))))
4347 (cond ((or file-or-symlinkp
4348 (file-exists-p fname)
4349 (file-symlink-p fname))
4350 (if image (concat prefix-img fname) fname))
4351 ((string-match ffap-url-regexp fname) (concat prefix-url " " fname))
4352 (t (concat prefix-new " " fname)))))
4354 (defun anything-c-find-files-transformer (files sources)
4355 "Transformer for `anything-c-source-find-files'.
4356 It will choose which transformer function to use according to
4357 `anything-c-find-files-show-icons' or `anything-ff-tramp-not-fancy'."
4358 (if (and (string-match tramp-file-name-regexp anything-pattern)
4359 anything-ff-tramp-not-fancy)
4360 files
4361 (if (and (window-system) anything-c-find-files-show-icons)
4362 (anything-c-highlight-ffiles1 files sources)
4363 (anything-c-highlight-ffiles files sources))))
4365 (defun anything-c-highlight-ffiles (files sources)
4366 "Candidate transformer for `anything-c-source-find-files' without icons."
4367 (loop for i in files collect
4368 (cond ((and (stringp (car (file-attributes i)))
4369 (not (anything-ff-valid-symlink-p i))
4370 (not (string-match "^\.#" (anything-c-basename i))))
4371 (cons (anything-c-prefix-filename
4372 (propertize i 'face 'anything-ff-invalid-symlink) nil t)
4374 ((stringp (car (file-attributes i)))
4375 (cons (anything-c-prefix-filename
4376 (propertize i 'face 'anything-ff-symlink) nil t)
4378 ((eq t (car (file-attributes i)))
4379 (cons (anything-c-prefix-filename
4380 (propertize i 'face 'anything-ff-directory) nil t)
4382 ((file-executable-p i)
4383 (cons (anything-c-prefix-filename
4384 (propertize i 'face 'anything-ff-executable) nil t)
4387 (cons (anything-c-prefix-filename
4388 (propertize i 'face 'anything-ff-file))
4389 i)))))
4391 (defun anything-c-highlight-ffiles1 (files sources)
4392 "Candidate transformer for `anything-c-source-find-files' that show icons."
4393 (loop for i in files
4394 for af = (file-name-nondirectory i)
4395 collect (cond ( ;; Files.
4396 (eq nil (car (file-attributes i)))
4397 (let ((face (if (file-executable-p i)
4398 'anything-ff-executable
4399 'anything-ff-file)))
4400 (cons (anything-c-prefix-filename
4401 (propertize i 'face face) "leaf.xpm")
4402 i)))
4403 ( ;; Empty directories.
4404 (and (eq t (car (file-attributes i)))
4405 ;; Be sure to have permission to list content.
4406 (file-readable-p i)
4407 (eq 0 (length
4408 (directory-files
4409 i nil directory-files-no-dot-files-regexp t))))
4410 (cons (anything-c-prefix-filename
4411 (propertize
4412 i 'face 'anything-ff-directory)
4413 "empty.xpm")
4415 ( ;; Open directories.
4416 (and (eq t (car (file-attributes i))) (get-buffer af))
4417 (cons (anything-c-prefix-filename
4418 (propertize
4419 i 'face 'anything-ff-directory)
4420 "open.xpm")
4422 ( ;; Closed directories.
4423 (eq t (car (file-attributes i)))
4424 (cons (anything-c-prefix-filename
4425 (propertize
4426 i 'face 'anything-ff-directory)
4427 "close.xpm")
4429 ( ;; Open Symlinks directories.
4430 (and (stringp (car (file-attributes i)))
4431 (file-directory-p i) (get-buffer af))
4432 (cons (anything-c-prefix-filename
4433 (propertize i 'face 'anything-ff-symlink))
4435 ( ;; Closed Symlinks directories.
4436 (and (stringp (car (file-attributes i)))
4437 (file-directory-p i))
4438 (cons (anything-c-prefix-filename
4439 (propertize i 'face 'anything-ff-symlink))
4441 ( ;; Invalid Symlinks
4442 (and (stringp (car (file-attributes i)))
4443 (not (anything-ff-valid-symlink-p i))
4444 (not (string-match "^\.#" (anything-c-basename i))))
4445 (cons (anything-c-prefix-filename
4446 (propertize i 'face 'anything-ff-invalid-symlink)
4447 "leaf.xpm")
4449 ( ;; Files symlinks.
4450 (stringp (car (file-attributes i)))
4451 (cons (anything-c-prefix-filename
4452 (propertize i 'face 'anything-ff-symlink)
4453 "leaf.xpm")
4454 i)))))
4456 (defun anything-find-files-action-transformer (actions candidate)
4457 "Action transformer for `anything-c-source-find-files'."
4458 (cond ((with-anything-current-buffer
4459 (eq major-mode 'message-mode))
4460 (append (subseq actions 0 4)
4461 '(("Gnus attach file(s)" . anything-ff-gnus-attach-files))
4462 (subseq actions 4)))
4463 ((string-match (image-file-name-regexp) candidate)
4464 (append (subseq actions 0 4)
4465 '(("Rotate image right `M-r'" . anything-ff-rotate-image-right)
4466 ("Rotate image left `M-l'" . anything-ff-rotate-image-left))
4467 (subseq actions 4)))
4468 ((string-match "\.el$" (anything-aif (anything-marked-candidates)
4469 (car it) candidate))
4470 (append (subseq actions 0 4)
4471 '(("Byte compile lisp file(s) `M-B, C-u to load'"
4472 . anything-find-files-byte-compile)
4473 ("Load File(s) `M-L'" . anything-find-files-load-files))
4474 (subseq actions 4)))
4475 ((and (string-match "\.html?$" candidate)
4476 (file-exists-p candidate))
4477 (append (subseq actions 0 4)
4478 '(("Browse url file" . browse-url-of-file))
4479 (subseq actions 5)))
4480 ((or (string= (file-name-extension candidate) "pdf")
4481 (string= (file-name-extension candidate) "PDF"))
4482 (append (subseq actions 0 4)
4483 '(("Pdfgrep File(s)" . anything-ff-pdfgrep))
4484 (subseq actions 5)))
4485 (t actions)))
4487 (defun anything-ff-gnus-attach-files (candidate)
4488 "Run `gnus-dired-attach' on `anything-marked-candidates' or CANDIDATE."
4489 (let ((flist (anything-marked-candidates)))
4490 (gnus-dired-attach flist)))
4492 (defun anything-ff-rotate-current-image-1 (file &optional num-arg)
4493 "Rotate current image at NUM-ARG degrees.
4494 This is a destructive operation on FILE made by external tool mogrify."
4495 (declare (special image-dired-display-image-buffer))
4496 (setq file (file-truename file)) ; For symlinked images.
4497 ;; When FILE is not an image-file, do nothing.
4498 (when (string-match (image-file-name-regexp) file)
4499 (if (executable-find "mogrify")
4500 (progn
4501 (shell-command (format "mogrify -rotate %s %s"
4502 (or num-arg 90)
4503 (shell-quote-argument file)))
4504 (when (buffer-live-p image-dired-display-image-buffer)
4505 (kill-buffer image-dired-display-image-buffer))
4506 (image-dired-display-image file)
4507 (message nil)
4508 (display-buffer (get-buffer image-dired-display-image-buffer)))
4509 (error "mogrify not found"))))
4511 (defun anything-ff-rotate-image-left (candidate)
4512 "Rotate image file CANDIDATE left.
4513 This affect directly file CANDIDATE."
4514 (anything-ff-rotate-current-image-1 candidate -90))
4516 (defun anything-ff-rotate-image-right (candidate)
4517 "Rotate image file CANDIDATE right.
4518 This affect directly file CANDIDATE."
4519 (anything-ff-rotate-current-image-1 candidate))
4521 (defun anything-ff-rotate-left-persistent ()
4522 "Rotate image left without quitting anything."
4523 (interactive)
4524 (anything-execute-persistent-action 'image-action1))
4526 (defun anything-ff-rotate-right-persistent ()
4527 "Rotate image right without quitting anything."
4528 (interactive)
4529 (anything-execute-persistent-action 'image-action2))
4531 (defun anything-ff-exif-data (candidate)
4532 "Extract exif data from file CANDIDATE using `anything-ff-exif-data-program'."
4533 (if (and anything-ff-exif-data-program
4534 (executable-find anything-ff-exif-data-program))
4535 (shell-command-to-string (format "%s %s %s"
4536 anything-ff-exif-data-program
4537 anything-ff-exif-data-program-args
4538 candidate))
4539 (format "No program %s found to extract exif"
4540 anything-ff-exif-data-program)))
4542 (defun anything-find-files-persistent-action (candidate)
4543 "Open subtree CANDIDATE without quitting anything.
4544 If CANDIDATE is not a directory expand CANDIDATE filename.
4545 If CANDIDATE is alone, open file CANDIDATE filename.
4546 That's mean:
4547 First hit on C-z expand CANDIDATE second hit open file.
4548 If a prefix arg is given or `anything-follow-mode' is on open file."
4549 (let ((follow (buffer-local-value
4550 'anything-follow-mode
4551 (get-buffer-create anything-buffer)))
4552 (new-pattern (anything-get-selection))
4553 (num-lines-buf (with-current-buffer anything-buffer
4554 (count-lines (point-min) (point-max)))))
4555 (flet ((insert-in-minibuffer (fname)
4556 (with-selected-window (minibuffer-window)
4557 (unless follow
4558 (delete-minibuffer-contents)
4559 (set-text-properties 0 (length fname) nil fname)
4560 (insert fname)))))
4561 (cond (;; A symlink directory, expand it's truename.
4562 (and (file-directory-p candidate) (file-symlink-p candidate))
4563 (insert-in-minibuffer (file-name-as-directory
4564 (file-truename
4565 (expand-file-name candidate)))))
4566 ;; A directory, open it.
4567 ((file-directory-p candidate)
4568 (when (string= (anything-c-basename candidate) "..")
4569 (setq anything-ff-last-expanded anything-ff-default-directory))
4570 (insert-in-minibuffer (file-name-as-directory
4571 (expand-file-name candidate))))
4572 ;; A symlink file, expand to it's true name. (first hit)
4573 ((and (file-symlink-p candidate) (not current-prefix-arg) (not follow))
4574 (insert-in-minibuffer (file-truename candidate)))
4575 ;; A regular file, expand it, (first hit)
4576 ((and (>= num-lines-buf 3) (not current-prefix-arg) (not follow))
4577 (insert-in-minibuffer new-pattern))
4578 ;; An image file and it is the second hit on C-z,
4579 ;; show the file in `image-dired'.
4580 ((string-match (image-file-name-regexp) candidate)
4581 (when (buffer-live-p image-dired-display-image-buffer)
4582 (kill-buffer image-dired-display-image-buffer))
4583 (image-dired-display-image candidate)
4584 (message nil)
4585 (anything-c-switch-to-buffer image-dired-display-image-buffer)
4586 (with-current-buffer image-dired-display-image-buffer
4587 (let ((exif-data (anything-ff-exif-data candidate)))
4588 (image-dired-update-property 'help-echo exif-data))))
4589 ;; Allow browsing archive on avfs fs.
4590 ;; Assume volume is already mounted with mountavfs.
4591 ((and anything-ff-avfs-directory
4592 (string-match
4593 (regexp-quote (expand-file-name anything-ff-avfs-directory))
4594 (file-name-directory candidate))
4595 (anything-ff-file-compressed-p candidate))
4596 (insert-in-minibuffer (concat candidate "#")))
4597 ;; On second hit we open file.
4598 ;; On Third hit we kill it's buffer maybe.
4600 (anything-ff-kill-or-find-buffer-fname candidate))))))
4602 (defun anything-ff-file-compressed-p (candidate)
4603 "Whether CANDIDATE is a compressed file or not."
4604 (member (file-name-extension candidate)
4605 anything-ff-file-compressed-list))
4607 (defun anything-c-insert-file-name-completion-at-point (candidate)
4608 "Insert file name completion at point."
4609 (with-anything-current-buffer
4610 (if buffer-read-only
4611 (error "Error: Buffer `%s' is read-only" (buffer-name))
4612 (let* ((end (point))
4613 (guess (substring-no-properties (thing-at-point 'filename)))
4614 (beg (- (point) (length guess)))
4615 (full-path-p (or (string-match-p (concat "^" (getenv "HOME")) guess)
4616 (string-match-p "^[^\~]" guess))))
4617 (set-text-properties 0 (length candidate) nil candidate)
4618 (if (and guess (not (string= guess ""))
4619 (string-match-p "^~\\|/.*" guess))
4620 (progn
4621 (delete-region beg end)
4622 (insert (if full-path-p
4623 (expand-file-name candidate)
4624 (abbreviate-file-name candidate))))
4625 (error "Aborting completion: No valid file name at point"))))))
4627 (defun* anything-find-files-history (&key (comp-read t))
4628 "The `anything-find-files' history.
4629 Show the first `anything-ff-history-max-length' elements of `anything-ff-history'
4630 in an `anything-comp-read'."
4631 (let ((history (when anything-ff-history
4632 (loop with dup for i in anything-ff-history
4633 ;; Remove duplicate and not existing files.
4634 ;; Keep remote files.
4635 unless (or (member i dup)
4636 (and (not (file-remote-p i))
4637 (not (file-exists-p i))))
4638 collect i into dup
4639 finally return dup)))) ; Remove dups.
4640 (when history
4641 (setq anything-ff-history
4642 (if (>= (length history) anything-ff-history-max-length)
4643 (subseq history 0 anything-ff-history-max-length)
4644 history))
4645 (if comp-read
4646 (anything-comp-read
4647 "Switch to Directory: "
4648 anything-ff-history
4649 :name "Anything Find Files History"
4650 :must-match t)
4651 anything-ff-history))))
4653 (defun anything-find-files-1 (fname &optional preselect)
4654 "Find FNAME with `anything' completion.
4655 Like `find-file' but with `anything' support.
4656 Use it for non--interactive calls of `anything-find-files'."
4657 (when (get-buffer anything-action-buffer)
4658 (kill-buffer anything-action-buffer))
4659 (let ((anything-mp-highlight-delay nil))
4660 (anything :sources 'anything-c-source-find-files
4661 :input fname
4662 :preselect preselect
4663 :keymap anything-find-files-map
4664 :prompt "Find Files or Url: "
4665 :buffer "*Anything Find Files*")))
4668 (defun anything-find-files-initial-input (&optional input)
4669 "Return INPUT if present, otherwise try to guess it."
4670 (or (and input (expand-file-name input))
4671 (anything-find-files-input
4672 (ffap-guesser)
4673 (thing-at-point 'filename))))
4675 (defun anything-find-files-input (fap tap)
4676 "Default input of `anything-find-files'."
4677 (let* ((def-dir (anything-c-current-directory))
4678 (lib (anything-find-library-at-point))
4679 (url (anything-ff-find-url-at-point))
4680 (file-p (and fap (not (string= fap ""))
4681 (file-exists-p fap)
4682 tap (not (string= tap ""))
4683 (file-exists-p
4684 (file-name-directory (expand-file-name tap def-dir))))))
4685 (cond (lib) ; e.g we are inside a require sexp.
4686 (url) ; String at point is an hyperlink.
4687 (file-p (expand-file-name tap def-dir))
4688 (t (and (not (string= fap "")) fap)))))
4690 (defun anything-c-current-directory ()
4691 "Return current-directory name at point.
4692 Useful in dired buffers when there is inserted subdirs."
4693 (if (eq major-mode 'dired-mode)
4694 (dired-current-directory)
4695 default-directory))
4697 (defun anything-ff-find-url-at-point ()
4698 "Try to find link to an url in text-property at point."
4699 (let* ((he (get-text-property (point) 'help-echo))
4700 (ov (overlays-at (point)))
4701 (ov-he (and ov (overlay-get
4702 (car (overlays-at (point))) 'help-echo)))
4703 (w3m-l (get-text-property (point) 'w3m-href-anchor))
4704 (nt-prop (get-text-property (point) 'nt-link)))
4705 ;; Org link.
4706 (when (and (stringp he) (string-match "^LINK: " he))
4707 (setq he (replace-match "" t t he)))
4708 (loop for i in (list he ov-he w3m-l nt-prop)
4709 thereis (and (stringp i) (string-match ffap-url-regexp i) i))))
4711 (defun anything-find-library-at-point ()
4712 "Try to find library path at point.
4713 Find inside `require' and `declare-function' sexp."
4714 (require 'find-func)
4715 (let* ((beg-sexp (save-excursion (search-backward "(" (point-at-bol) t)))
4716 (end-sexp (save-excursion (search-forward ")" (point-at-eol) t)))
4717 (sexp (and beg-sexp end-sexp
4718 (buffer-substring-no-properties
4719 (1+ beg-sexp) (1- end-sexp)))))
4720 (ignore-errors
4721 (cond ((and sexp (string-match "require \'.+[^)]" sexp))
4722 (find-library-name
4723 (replace-regexp-in-string
4724 "'\\|\)\\|\(" ""
4725 ;; If require use third arg, ignore it,
4726 ;; always use library path found in `load-path'.
4727 (second (split-string (match-string 0 sexp))))))
4728 ((and sexp (string-match-p "^declare-function" sexp))
4729 (find-library-name
4730 (replace-regexp-in-string
4731 "\"\\|ext:" ""
4732 (third (split-string sexp)))))
4733 (t nil)))))
4735 ;;; Anything completion for `write-file'.==> C-x C-w
4736 (defvar anything-c-source-write-file
4737 `((name . "Write File")
4738 (header-name . (lambda (name)
4739 (concat name anything-c-find-files-doc-header)))
4740 ;; It is needed for filenames with capital letters
4741 (disable-shortcuts)
4742 (candidates . anything-find-files-get-candidates)
4743 (filtered-candidate-transformer anything-c-find-files-transformer)
4744 (persistent-action . anything-find-files-persistent-action)
4745 (persistent-help . "Expand Candidate")
4746 (volatile)
4747 (action .
4748 (("Write File" . (lambda (candidate)
4749 (write-file candidate 'confirm)))))))
4751 ;;; Anything completion for `insert-file'.==> C-x i
4752 (defvar anything-c-source-insert-file
4753 `((name . "Insert File")
4754 (header-name . (lambda (name)
4755 (concat name anything-c-find-files-doc-header)))
4756 ;; It is needed for filenames with capital letters
4757 (disable-shortcuts)
4758 (candidates . anything-find-files-get-candidates)
4759 (filtered-candidate-transformer anything-c-find-files-transformer)
4760 (persistent-action . anything-find-files-persistent-action)
4761 (persistent-help . "Expand Candidate")
4762 (volatile)
4763 (action .
4764 (("Insert File" . (lambda (candidate)
4765 (when (y-or-n-p (format "Really insert %s in %s "
4766 candidate anything-current-buffer))
4767 (insert-file-contents candidate))))))))
4769 ;;; Anything completion for copy, rename and (rel)sym/hard/link files from dired.
4770 (defvar anything-c-source-copy-files
4771 `((name . "Copy Files")
4772 (header-name . (lambda (name)
4773 (concat name anything-c-find-files-doc-header)))
4774 ;; It is needed for filenames with capital letters
4775 (disable-shortcuts)
4776 (candidates . anything-find-files-get-candidates)
4777 (filtered-candidate-transformer anything-c-find-files-transformer)
4778 (persistent-action . anything-find-files-persistent-action)
4779 (persistent-help . "Expand Candidate")
4780 (volatile)
4781 (action .
4782 (("Copy File"
4783 . (lambda (candidate)
4784 (anything-dired-action candidate :action 'copy)))
4785 ("Copy and Follow"
4786 . (lambda (candidate)
4787 (anything-dired-action candidate :action 'copy :follow t)))))))
4790 (defvar anything-c-source-rename-files
4791 `((name . "Rename Files")
4792 (header-name . (lambda (name)
4793 (concat name anything-c-find-files-doc-header)))
4794 ;; It is needed for filenames with capital letters
4795 (disable-shortcuts)
4796 (candidates . anything-find-files-get-candidates)
4797 (filtered-candidate-transformer anything-c-find-files-transformer)
4798 (persistent-action . anything-find-files-persistent-action)
4799 (persistent-help . "Expand Candidate")
4800 (volatile)
4801 (action .
4802 (("Rename File"
4803 . (lambda (candidate)
4804 (anything-dired-action candidate :action 'rename)))
4805 ("Rename and Follow"
4806 . (lambda (candidate)
4807 (anything-dired-action candidate :action 'rename :follow t)))))))
4809 (defvar anything-c-source-symlink-files
4810 `((name . "Symlink Files")
4811 (header-name . (lambda (name)
4812 (concat name anything-c-find-files-doc-header)))
4813 ;; It is needed for filenames with capital letters
4814 (disable-shortcuts)
4815 (candidates . anything-find-files-get-candidates)
4816 (filtered-candidate-transformer anything-c-find-files-transformer)
4817 (persistent-action . anything-find-files-persistent-action)
4818 (persistent-help . "Expand Candidate")
4819 (volatile)
4820 (action
4821 . (("Symlink File"
4822 . (lambda (candidate)
4823 (anything-dired-action candidate :action 'symlink)))
4824 ("RelSymlink File"
4825 . (lambda (candidate)
4826 (anything-dired-action candidate :action 'relsymlink)))))))
4829 (defvar anything-c-source-hardlink-files
4830 `((name . "Hardlink Files")
4831 (header-name . (lambda (name)
4832 (concat name anything-c-find-files-doc-header)))
4833 ;; It is needed for filenames with capital letters
4834 (disable-shortcuts)
4835 (candidates . anything-find-files-get-candidates)
4836 (filtered-candidate-transformer anything-c-find-files-transformer)
4837 (persistent-action . anything-find-files-persistent-action)
4838 (persistent-help . "Expand Candidate")
4839 (volatile)
4840 (action
4841 . (("Hardlink File"
4842 . (lambda (candidate)
4843 (anything-dired-action candidate :action 'hardlink)))))))
4845 (defun* anything-dired-action (candidate &key action follow (files (dired-get-marked-files)))
4846 "Copy, rename or symlink file at point or marked files in dired to CANDIDATE.
4847 ACTION is a key that can be one of 'copy, 'rename, 'symlink, 'relsymlink."
4848 (when (get-buffer dired-log-buffer) (kill-buffer dired-log-buffer))
4849 (let ((fn (case action
4850 ('copy 'dired-copy-file)
4851 ('rename 'dired-rename-file)
4852 ('symlink 'make-symbolic-link)
4853 ('relsymlink 'dired-make-relative-symlink)
4854 ('hardlink 'dired-hardlink)))
4855 (marker (case action
4856 ((copy rename) dired-keep-marker-copy)
4857 ('symlink dired-keep-marker-symlink)
4858 ('relsymlink dired-keep-marker-relsymlink)
4859 ('hardlink dired-keep-marker-hardlink)))
4860 (dirflag (and (= (length files) 1)
4861 (file-directory-p (car files))
4862 (not (file-directory-p candidate)))))
4863 (dired-create-files
4864 fn (symbol-name action) files
4865 ;; CANDIDATE is the destination.
4866 (if (file-directory-p candidate)
4867 ;; When CANDIDATE is a directory, build file-name in this directory.
4868 ;; Else we use CANDIDATE.
4869 #'(lambda (from)
4870 (expand-file-name (file-name-nondirectory from) candidate))
4871 #'(lambda (from) candidate))
4872 marker)
4873 (when (and follow (not (get-buffer dired-log-buffer)))
4874 (let ((moved-flist (anything-get-dest-fnames-from-list files candidate dirflag))
4875 (target (directory-file-name candidate)))
4876 (unwind-protect
4877 (progn
4878 (setq anything-ff-cand-to-mark moved-flist)
4879 (if (and dirflag (eq action 'rename))
4880 (anything-find-files-1 (file-name-directory target) target)
4881 (anything-find-files-1 (expand-file-name candidate))))
4882 (setq anything-ff-cand-to-mark nil))))))
4885 (defun anything-c-basename (fname)
4886 "Resolve basename of file or directory named FNAME."
4887 (file-name-nondirectory (directory-file-name fname)))
4889 (defun anything-get-dest-fnames-from-list (flist dest-cand rename-dir-flag)
4890 "Transform filenames of FLIST to abs of DEST-CAND."
4891 ;; At this point files have been renamed/copied at destination.
4892 ;; That's mean DEST-CAND exists.
4893 (loop
4894 with dest = (expand-file-name dest-cand)
4895 for src in flist
4896 for basename-src = (anything-c-basename src)
4897 for fname = (cond (rename-dir-flag (directory-file-name dest))
4898 ((file-directory-p dest)
4899 (concat (file-name-as-directory dest) basename-src))
4900 (t dest))
4901 when (file-exists-p fname)
4902 collect fname into tmp-list
4903 finally return (sort tmp-list 'string<)))
4905 (defun anything-c-maybe-mark-candidates ()
4906 "Mark all candidates of list `anything-ff-cand-to-mark'."
4907 (when (and (string= (assoc-default 'name (anything-get-current-source))
4908 (assoc-default 'name anything-c-source-find-files))
4909 anything-ff-cand-to-mark)
4910 (with-anything-window
4911 (while anything-ff-cand-to-mark
4912 (if (search-forward (car anything-ff-cand-to-mark) (point-at-eol) t)
4913 (progn
4914 (anything-mark-current-line)
4915 (anything-make-visible-mark)
4916 (forward-line 1)
4917 (setq anything-ff-cand-to-mark (cdr anything-ff-cand-to-mark)))
4918 (forward-line 1)))
4919 (unless (anything-this-visible-mark)
4920 (anything-prev-visible-mark)))))
4922 (add-hook 'anything-after-update-hook #'anything-c-maybe-mark-candidates)
4924 (defun* anything-dired-do-action-on-file (&key action)
4925 (let* ((files (dired-get-marked-files))
4926 (len (length files))
4927 (fname (if (> len 1)
4928 (format "* %d Files" len)
4929 (car files)))
4930 (source (case action
4931 ('copy 'anything-c-source-copy-files)
4932 ('rename 'anything-c-source-rename-files)
4933 ('symlink 'anything-c-source-symlink-files)
4934 ('hardlink 'anything-c-source-hardlink-files)))
4935 (prompt-fm (case action
4936 ('copy "Copy %s to: ")
4937 ('rename "Rename %s to: ")
4938 ('symlink "Symlink %s to: ")
4939 ('hardlink "Hardlink %s to: ")))
4940 (buffer (case action
4941 ('copy "*Anything Copy Files*")
4942 ('rename "*Anything Rename Files*")
4943 ('symlink "*Anything Symlink Files*")
4944 ('hardlink "*Anything Hardlink Files*")))
4945 (anything-mp-highlight-delay nil))
4946 (anything :sources source
4947 :input (or (dired-dwim-target-directory)
4948 (expand-file-name (anything-c-current-directory)))
4949 :preselect (dired-get-filename)
4950 :prompt (format prompt-fm fname)
4951 :keymap anything-c-read-file-map
4952 :buffer buffer)))
4954 ;;;###autoload
4955 (define-minor-mode anything-dired-mode ()
4956 "Enable anything completion in Dired functions.
4957 Bindings affected are C, R, S, H."
4958 :group 'anything-config
4959 :global t
4960 (if anything-dired-mode
4961 (progn
4962 (substitute-key-definition
4963 'dired-do-copy 'anything-dired-copy-file dired-mode-map)
4964 (substitute-key-definition
4965 'dired-do-rename 'anything-dired-rename-file dired-mode-map)
4966 (substitute-key-definition
4967 'dired-do-symlink 'anything-dired-symlink-file dired-mode-map)
4968 (substitute-key-definition
4969 'dired-do-hardlink 'anything-dired-hardlink-file dired-mode-map))
4970 (substitute-key-definition
4971 'anything-dired-copy-file 'dired-do-copy dired-mode-map)
4972 (substitute-key-definition
4973 'anything-dired-rename-file 'dired-do-rename dired-mode-map)
4974 (substitute-key-definition
4975 'anything-dired-symlink-file 'dired-do-symlink dired-mode-map)
4976 (substitute-key-definition
4977 'anything-dired-hardlink-file 'dired-do-hardlink dired-mode-map)))
4979 (defalias 'anything-dired-bindings 'anything-dired-mode)
4981 (defun* anything-c-read-file-name (prompt
4982 &key
4983 (initial-input (expand-file-name default-directory))
4984 (buffer "*Anything Completions*")
4985 test
4986 (preselect nil)
4987 must-match
4988 (history nil)
4989 (marked-candidates nil)
4990 (alistp t)
4991 (persistent-action 'anything-find-files-persistent-action)
4992 (persistent-help "Hit1 Expand Candidate, Hit2 or (C-u) Find file"))
4993 "Anything `read-file-name' emulation.
4994 INITIAL-INPUT is a valid path, TEST is a predicate that take one arg."
4995 (when (get-buffer anything-action-buffer)
4996 (kill-buffer anything-action-buffer))
4997 (let ((anything-mp-highlight-delay nil))
4998 (flet ((action-fn (candidate)
4999 (if marked-candidates
5000 (anything-marked-candidates)
5001 (identity candidate))))
5002 (or (anything
5003 :sources
5004 `(((name . "Read File Name History")
5005 (header-name . (lambda (name)
5006 (concat name anything-c-find-files-doc-header)))
5007 (disable-shortcuts)
5008 (candidates . (lambda ()
5009 (anything-comp-read-get-candidates history nil nil alistp)))
5010 (persistent-action . ,persistent-action)
5011 (persistent-help . ,persistent-help)
5012 (action . ,'action-fn))
5013 ((name . "Read file name")
5014 (header-name . (lambda (name)
5015 (concat name anything-c-find-files-doc-header)))
5016 ;; It is needed for filenames with capital letters
5017 (disable-shortcuts)
5018 (candidates . (lambda ()
5019 (let ((seq (anything-find-files-get-candidates)))
5020 (if test
5021 (loop
5022 for fname in seq when (funcall test fname)
5023 collect fname into ls
5024 finally return
5025 (if must-match ls
5026 (append (list anything-pattern) ls)))
5027 (if must-match
5028 (if (file-exists-p (car seq)) seq (cdr seq))
5029 seq)))))
5030 (filtered-candidate-transformer anything-c-find-files-transformer)
5031 (persistent-action . ,persistent-action)
5032 (candidate-number-limit . 9999)
5033 (toggle-auto-update . anything-ff-toggle-auto-update)
5034 (persistent-help . ,persistent-help)
5035 (volatile)
5036 (action . ,'action-fn)))
5037 :input initial-input
5038 :prompt prompt
5039 :keymap anything-c-read-file-map
5040 :resume 'noresume
5041 :buffer buffer
5042 :preselect preselect)
5043 (keyboard-quit)))))
5046 ;;; File Cache
5047 (defvar anything-c-file-cache-initialized-p nil)
5049 (defvar anything-c-file-cache-files nil)
5051 (defvar anything-c-source-file-cache
5052 '((name . "File Cache")
5053 (init
5054 . (lambda ()
5055 (require 'filecache nil t)
5056 (unless anything-c-file-cache-initialized-p
5057 (setq anything-c-file-cache-files
5058 (loop for item in file-cache-alist append
5059 (destructuring-bind (base &rest dirs) item
5060 (loop for dir in dirs collect
5061 (concat dir base)))))
5062 (defadvice file-cache-add-file (after file-cache-list activate)
5063 (add-to-list 'anything-c-file-cache-files (expand-file-name file)))
5064 (setq anything-c-file-cache-initialized-p t))))
5065 (candidates . anything-c-file-cache-files)
5066 (match anything-c-match-on-file-name
5067 anything-c-match-on-directory-name)
5068 (type . file)))
5069 ;; (anything 'anything-c-source-file-cache)
5072 ;;; Locate
5075 ;; NOTE for WINDOZE users:
5076 ;; You have to install Everything with his command line interface here:
5077 ;; http://www.voidtools.com/download.php
5079 (defvar anything-c-locate-command
5080 (case system-type
5081 ('gnu/linux "locate -i -r %s")
5082 ('berkeley-unix "locate -i %s")
5083 ('windows-nt "es -i -r %s")
5084 (t "locate %s"))
5085 "A list of arguments for locate program.
5086 The \"-r\" option must be the last option.")
5088 (defun anything-locate-1 (&optional localdb init)
5089 "Generic function to run Locate.
5090 if LOCALDB is non--nil search and use a local locate db file.
5091 INIT is a string to use as initial input in prompt.
5092 See `anything-locate-with-db' and `anything-locate'."
5093 (anything-locate-with-db
5094 (and localdb
5095 (anything-c-read-file-name
5096 "LocateDBFiles: "
5097 :marked-candidates t
5098 :preselect anything-locate-db-file-regexp
5099 :test #'(lambda (x)
5100 (if anything-locate-db-file-regexp
5101 ;; Select only locate db files and directories
5102 ;; to allow navigation.
5103 (or (string-match
5104 anything-locate-db-file-regexp x)
5105 (file-directory-p x))
5106 x))))
5107 init))
5108 ;; (anything-locate-1 t)
5110 (defun anything-locate-with-db (&optional db initial-input)
5111 "Run locate -d DB.
5112 If DB is not given or nil use locate without -d option.
5113 Argument DB can be given as a string or list of db files.
5114 Argument INITIAL-INPUT is a string to use as initial-input.
5115 See also `anything-locate'."
5116 (when (and db (stringp db)) (setq db (list db)))
5117 (let ((anything-c-locate-command
5118 (if db
5119 (replace-regexp-in-string
5120 "locate"
5121 (format "locate -d %s"
5122 (mapconcat 'identity
5123 ;; Remove eventually
5124 ;; marked directories by error.
5125 (loop for i in db
5126 unless (file-directory-p i)
5127 collect i) ":"))
5128 anything-c-locate-command)
5129 anything-c-locate-command)))
5130 (anything :sources 'anything-c-source-locate
5131 :buffer "*anything locate*"
5132 :input initial-input
5133 :keymap anything-generic-files-map)))
5134 ;; (anything-locate-with-db "~/locate.db")
5136 (defun anything-c-locate-init ()
5137 "Initialize async locate process for `anything-c-source-locate'."
5138 (setq mode-line-format
5139 '(" " mode-line-buffer-identification " "
5140 (line-number-mode "%l") " "
5141 (:eval (propertize "(Locate Process Running) "
5142 'face '((:foreground "red"))))))
5143 (prog1
5144 (start-process-shell-command "locate-process" nil
5145 (format anything-c-locate-command
5146 anything-pattern))
5147 (set-process-sentinel (get-process "locate-process")
5148 #'(lambda (process event)
5149 (when (string= event "finished\n")
5150 (with-anything-window
5151 (force-mode-line-update nil)
5152 (anything-update-move-first-line)))))))
5154 (defvar anything-c-source-locate
5155 '((name . "Locate")
5156 (candidates . anything-c-locate-init)
5157 (type . file)
5158 (properties-action . anything-ff-properties)
5159 (requires-pattern . 3)
5160 (mode-line . anything-generic-file-mode-line-string)
5161 (delayed))
5162 "Find files matching the current input pattern with locate.")
5163 ;; (anything 'anything-c-source-locate)
5166 ;;; Anything Incremental Grep.
5169 ;; Allow to grep incrementally with anything interface.
5170 ;; It allow also to Grep files recursively without using 'find' shell command.
5171 ;; On Windows you will need at least Grep version 2.5.4 of Gnuwin32.
5172 (defvar anything-c-grep-default-command
5173 "grep -d skip %e -niH -e %p %f"
5174 "Default grep format command for `anything-do-grep-1'.
5175 Where:
5176 '%e' format spec is for --exclude or --include grep options.
5177 '%p' format spec is for pattern.
5178 '%f' format spec is for filenames.")
5180 (defvar anything-c-grep-default-recurse-command
5181 "grep -d recurse %e -niH -e %p %f"
5182 "Default recursive grep format command for `anything-do-grep-1'.
5183 See `anything-c-grep-default-command' for format specs.")
5185 (defvar anything-c-default-zgrep-command "zgrep -niH -e %p %f")
5187 (defvar anything-c-rzgrep-cache (make-hash-table :test 'equal))
5189 (defvar anything-c-grep-default-function 'anything-c-grep-init)
5191 (defvar anything-c-grep-debug-command-line nil
5192 "Turn on anything grep command-line debugging when non--nil.")
5194 (defvar anything-c-zgrep-recurse-flag nil)
5196 (defvar anything-c-grep-history nil)
5198 (defvar anything-c-grep-max-length-history 100
5199 "*Max number of elements to save in `anything-c-grep-history'.")
5201 (defun anything-c-grep-prepare-candidates (candidates)
5202 "Prepare filenames and directories CANDIDATES for grep command line."
5203 ;; If one or more candidate is a directory, search in all files
5204 ;; of this candidate (e.g /home/user/directory/*).
5205 ;; If r option is enabled search also in subdidrectories.
5206 ;; We need here to expand wildcards to support crap windows filenames
5207 ;; as grep don't accept quoted wildcards (e.g "dir/*.el").
5208 (if anything-c-zgrep-recurse-flag
5209 (mapconcat 'shell-quote-argument candidates " ")
5210 (loop for i in candidates append
5211 (cond ( ;; Candidate is a directory and we use recursion.
5212 (and (file-directory-p i)
5213 (anything-c-grep-recurse-p))
5214 (list (expand-file-name i)))
5215 ;; Candidate is a directory, search in all files.
5216 ((file-directory-p i)
5217 (file-expand-wildcards
5218 (concat (file-name-as-directory (expand-file-name i)) "*") t))
5219 ;; Candidate is a file or wildcard and we use recursion, use the
5220 ;; current directory instead of candidate.
5221 ((and (or (file-exists-p i) (string-match "\*" i))
5222 (anything-c-grep-recurse-p))
5223 (list (expand-file-name
5224 (directory-file-name ; Needed for windoze.
5225 (file-name-directory (directory-file-name i))))))
5226 ;; Candidate use wildcard.
5227 ((string-match "^\*" (anything-c-basename i))
5228 (file-expand-wildcards i t))
5229 ;; Else should be one or more file.
5230 (t (list i))) into all-files
5231 finally return
5232 (mapconcat 'shell-quote-argument all-files " "))))
5234 (defun anything-c-grep-recurse-p ()
5235 "Check if `anything-do-grep-1' have switched to recursive."
5236 (let ((args (replace-regexp-in-string
5237 "grep" "" anything-c-grep-default-command)))
5238 (string-match-p "r\\|recurse" args)))
5240 (defun anything-c-grep-init (only-files &optional include zgrep)
5241 "Start an asynchronous grep process in ONLY-FILES list."
5242 (let* ((fnargs (anything-c-grep-prepare-candidates
5243 (if (file-remote-p anything-ff-default-directory)
5244 (mapcar #'(lambda (x)
5245 (file-remote-p x 'localname))
5246 only-files)
5247 only-files)))
5248 (ignored-files (mapconcat
5249 #'(lambda (x)
5250 (concat "--exclude=" (shell-quote-argument x)))
5251 grep-find-ignored-files " "))
5252 (ignored-dirs (mapconcat
5253 ;; Need grep version 2.5.4 of Gnuwin32 on windoze.
5254 #'(lambda (x)
5255 (concat "--exclude-dir=" (shell-quote-argument x)))
5256 grep-find-ignored-directories " "))
5257 (exclude (if (anything-c-grep-recurse-p)
5258 (concat (or include ignored-files) " " ignored-dirs)
5259 ignored-files))
5260 (cmd-line (format-spec
5261 anything-c-grep-default-command
5262 (delq nil
5263 (list (unless zgrep (cons ?e exclude))
5264 (cons ?p (shell-quote-argument anything-pattern))
5265 (cons ?f fnargs))))))
5266 (when anything-c-grep-debug-command-line
5267 (with-current-buffer (get-buffer-create "*any grep debug*")
5268 (goto-char (point-max))
5269 (insert (concat ">>> " cmd-line "\n\n"))))
5270 (setq mode-line-format
5271 '(" " mode-line-buffer-identification " "
5272 (line-number-mode "%l") " "
5273 (:eval (when (get-process "grep-process")
5274 (propertize "[Grep Process Running] "
5275 'face 'anything-grep-running)))))
5276 (force-mode-line-update nil)
5277 (prog1
5278 (let ((default-directory anything-ff-default-directory))
5279 (start-file-process-shell-command "grep-process" nil cmd-line))
5280 (message nil)
5281 (set-process-sentinel
5282 (get-process "grep-process")
5283 #'(lambda (process event)
5284 (when (string= event "finished\n")
5285 (with-anything-window
5286 (anything-update-move-first-line)
5287 (setq mode-line-format
5288 '(" " mode-line-buffer-identification " "
5289 (line-number-mode "%l") " "
5290 (:eval (propertize
5291 (format "[Grep Process Finished - (%s results)] "
5292 (let ((nlines (1- (count-lines
5293 (point-min)
5294 (point-max)))))
5295 (if (> nlines 0) nlines 0)))
5296 'face 'anything-grep-finish))))
5297 (force-mode-line-update nil))))))))
5299 (defun anything-c-grep-action (candidate &optional where mark)
5300 "Define a default action for `anything-do-grep' on CANDIDATE.
5301 WHERE can be one of other-window, elscreen, other-frame."
5302 (let* ((split (anything-c-grep-split-line candidate))
5303 (lineno (string-to-number (nth 1 split)))
5304 (loc-fname (car split))
5305 (tramp-method (file-remote-p anything-ff-default-directory 'method))
5306 (tramp-host (file-remote-p anything-ff-default-directory 'host))
5307 (tramp-prefix (concat "/" tramp-method ":" tramp-host ":"))
5308 (fname (if tramp-host
5309 (concat tramp-prefix loc-fname) loc-fname)))
5310 (case where
5311 (other-window (find-file-other-window fname))
5312 (elscreen (anything-elscreen-find-file fname))
5313 (other-frame (find-file-other-frame fname))
5314 (t (find-file fname)))
5315 (anything-goto-line lineno)
5316 (when mark
5317 (set-marker (mark-marker) (point))
5318 (push-mark (point) 'nomsg))
5319 ;; Save history
5320 (unless (or anything-in-persistent-action
5321 (string= anything-pattern ""))
5322 (setq anything-c-grep-history
5323 (cons anything-pattern
5324 (delete anything-pattern anything-c-grep-history)))
5325 (when (> (length anything-c-grep-history)
5326 anything-c-grep-max-length-history)
5327 (setq anything-c-grep-history
5328 (delete (car (last anything-c-grep-history))
5329 anything-c-grep-history))))))
5331 (defun anything-c-grep-other-window (candidate)
5332 "Jump to result in other window from anything grep."
5333 (anything-c-grep-action candidate 'other-window))
5335 (defun anything-c-grep-other-frame (candidate)
5336 "Jump to result in other frame from anything grep."
5337 (anything-c-grep-action candidate 'other-frame))
5339 (defun anything-c-grep-jump-elscreen (candidate)
5340 "Jump to result in elscreen from anything grep."
5341 (anything-c-grep-action candidate 'elscreen))
5343 (defun anything-c-grep-save-results (candidate)
5344 "Save anything grep result in a `grep-mode' buffer."
5345 (let ((buf "*grep*")
5346 new-buf)
5347 (when (get-buffer buf)
5348 (setq new-buf (read-string "GrepBufferName: " buf))
5349 (loop for b in (anything-c-buffer-list)
5350 when (and (string= new-buf b)
5351 (not (y-or-n-p
5352 (format "Buffer `%s' already exists overwrite? "
5353 new-buf))))
5354 do (setq new-buf (read-string "GrepBufferName: " "*grep ")))
5355 (setq buf new-buf))
5356 (with-current-buffer (get-buffer-create buf)
5357 (let ((inhibit-read-only t))
5358 (erase-buffer)
5359 (insert "-*- mode: grep -*-\n\n"
5360 (format "Grep Results for `%s':\n\n" anything-pattern))
5361 (save-excursion
5362 (insert (with-current-buffer anything-buffer
5363 (forward-line 1)
5364 (buffer-substring (point) (point-max))))
5365 (grep-mode))))
5366 (message "Anything Grep Results saved in `%s' buffer" buf)))
5368 (defun anything-c-grep-persistent-action (candidate)
5369 "Persistent action for `anything-do-grep'.
5370 With a prefix arg record CANDIDATE in `mark-ring'."
5371 (if current-prefix-arg
5372 (anything-c-grep-action candidate nil 'mark)
5373 (anything-c-grep-action candidate))
5374 (anything-match-line-color-current-line))
5376 (defun anything-c-grep-guess-extensions (files)
5377 "Try to guess file extensions in FILES list when using grep recurse.
5378 These extensions will be added to command line with --include arg of grep."
5379 (loop
5380 with glob-list = nil
5381 with lst = (if (file-directory-p (car files))
5382 (directory-files
5383 (car files) nil
5384 directory-files-no-dot-files-regexp)
5385 files)
5386 for i in lst
5387 for ext = (file-name-extension i t)
5388 for glob = (and ext (not (string= ext ""))
5389 (concat "*" ext))
5390 unless (or (not glob)
5391 (member glob glob-list)
5392 (member glob grep-find-ignored-files))
5393 collect glob into glob-list
5394 finally return glob-list))
5396 (defun anything-do-grep-1 (only &optional recurse zgrep)
5397 "Launch grep with a list of ONLY files.
5398 When RECURSE is given use -r option of grep and prompt user
5399 to set the --include args of grep.
5400 You can give more than one arg separated by space.
5401 e.g *.el *.py *.tex.
5402 If it's empty --exclude `grep-find-ignored-files' is used instead."
5403 (let* ((anything-compile-source-functions
5404 ;; rule out anything-match-plugin because the input is one regexp.
5405 (delq 'anything-compile-source--match-plugin
5406 (copy-sequence anything-compile-source-functions)))
5407 (exts (anything-c-grep-guess-extensions only))
5408 (globs (and (not zgrep) (mapconcat 'identity exts " ")))
5409 (include-files (and recurse (not zgrep)
5410 (read-string "OnlyExt(*.[ext]): "
5411 globs)))
5412 ;; Set `minibuffer-history' AFTER includes-files
5413 ;; to avoid storing wild-cards here.
5414 (minibuffer-history anything-c-grep-history)
5415 (anything-c-grep-default-command (cond ((and recurse zgrep) anything-c-default-zgrep-command)
5416 (recurse anything-c-grep-default-recurse-command)
5417 (zgrep anything-c-default-zgrep-command)
5418 (t anything-c-grep-default-command)))
5419 ;; Disable match-plugin and use here own highlighting.
5420 (anything-mp-highlight-delay nil))
5421 (when include-files
5422 (setq include-files
5423 (and (not (string= include-files ""))
5424 (mapconcat #'(lambda (x)
5425 (concat "--include=" (shell-quote-argument x)))
5426 (split-string include-files) " "))))
5427 ;; When called as action from an other source e.g *-find-files
5428 ;; we have to kill action buffer.
5429 (when (get-buffer anything-action-buffer)
5430 (kill-buffer anything-action-buffer))
5431 ;; `anything-find-files' haven't already started,
5432 ;; give a default value to `anything-ff-default-directory'.
5433 (setq anything-ff-default-directory (or anything-ff-default-directory
5434 default-directory))
5435 (anything
5436 :sources
5437 `(((name . "Grep (C-c ? Help)")
5438 (candidates
5439 . (lambda ()
5440 (funcall anything-c-grep-default-function only include-files zgrep)))
5441 (filtered-candidate-transformer anything-c-grep-cand-transformer)
5442 (candidate-number-limit . 9999)
5443 (mode-line . anything-grep-mode-line-string)
5444 (jump-persistent . anything-c-grep-persistent-action)
5445 (action . ,(delq
5447 `(("Find File" . anything-c-grep-action)
5448 ("Find file other frame" . anything-c-grep-other-frame)
5449 ,(and (locate-library "elscreen")
5450 '("Find file in Elscreen"
5451 . anything-c-grep-jump-elscreen))
5452 ("Save results in grep buffer" . anything-c-grep-save-results)
5453 ("Find file other window" . anything-c-grep-other-window))))
5454 (persistent-action . anything-c-grep-persistent-action)
5455 (persistent-help . "Jump to line (`C-u' Record in mark ring)")
5456 (requires-pattern . 3)
5457 (delayed)))
5458 :keymap anything-c-grep-map
5459 :buffer "*anything grep*")))
5461 (defun anything-ff-zgrep-1 (flist recursive)
5462 (unwind-protect
5463 (let* ((def-dir (or anything-ff-default-directory
5464 default-directory))
5465 (only (if recursive
5466 (or (gethash def-dir anything-c-rzgrep-cache)
5467 (puthash
5468 def-dir
5469 (anything-c-walk-directory
5470 def-dir
5471 :directories nil
5472 :path 'full
5473 :match ".*\\(\.gz\\|\.bz\\|\.xz\\|\.lzma\\)$")
5474 anything-c-rzgrep-cache))
5475 flist)))
5476 (when recursive (setq anything-c-zgrep-recurse-flag t))
5477 (anything-do-grep-1 only recursive 'zgrep))
5478 (setq anything-c-zgrep-recurse-flag nil)))
5480 (defun anything-c-grep-split-line (line)
5481 "Split a grep output line."
5482 (let (beg fname lineno str)
5483 ;; Don't print until grep line is valid.
5484 (when (string-match "\\(.*\\)\\(:[0-9]+:\\)\\(.*\\)" line)
5485 (with-temp-buffer
5486 (insert line)
5487 (goto-char (point-min))
5488 (setq beg (point))
5489 (forward-char 2)
5490 (re-search-forward ":" nil t)
5491 (setq fname (buffer-substring-no-properties beg (1- (point))))
5492 (setq beg (point))
5493 (re-search-forward ":" nil t)
5494 (setq lineno (buffer-substring-no-properties beg (1- (point))))
5495 (setq str (buffer-substring-no-properties (point) (point-at-eol))))
5496 (list fname lineno str))))
5498 (defun anything-c-grep-cand-transformer (candidates sources)
5499 "Filtered candidate transformer function for `anything-do-grep'."
5500 (loop for i in candidates
5501 for split = (and i (anything-c-grep-split-line i))
5502 for fname = (car split)
5503 for lineno = (nth 1 split)
5504 for str = (nth 2 split)
5505 when (and fname lineno str)
5506 collect
5507 (cons (concat (propertize (file-name-nondirectory fname)
5508 'face 'anything-grep-file
5509 'help-echo fname) ":"
5510 (propertize lineno 'face 'anything-grep-lineno) ":"
5511 (anything-c-grep-highlight-match str))
5512 i)))
5514 (defun anything-c-grep-highlight-match (str)
5515 "Highlight in string STR all occurences matching `anything-pattern'."
5516 (condition-case nil
5517 (with-temp-buffer
5518 (insert str)
5519 (goto-char (point-min))
5520 (while (and (re-search-forward anything-pattern nil t)
5521 (> (- (match-end 0) (match-beginning 0)) 0))
5522 (add-text-properties
5523 (match-beginning 0) (match-end 0)
5524 '(face anything-grep-match)))
5525 (buffer-string))
5526 (error nil)))
5528 ;; Go to next or precedent file (common to etags and grep).
5529 (defun anything-c-goto-next-or-prec-file (n)
5530 "Go to next or precedent candidate file in anything grep/etags buffers.
5531 If N is positive go forward otherwise go backward."
5532 (with-anything-window
5533 (let* ((current-line-list (split-string
5534 (buffer-substring
5535 (point-at-bol)
5536 (point-at-eol)) ":"))
5537 (current-fname (nth 0 current-line-list))
5538 (fn-b-o-f (if (eq n 1) 'eobp 'bobp)))
5539 (catch 'break
5540 (while (not (funcall fn-b-o-f))
5541 (forward-line n) ; Go forward or backward depending of n value.
5542 (unless (search-forward current-fname (point-at-eol) t)
5543 (anything-mark-current-line)
5544 (throw 'break nil))))
5545 (cond ((and (eq n 1) (eobp))
5546 (re-search-backward ".")
5547 (forward-line 0)
5548 (anything-mark-current-line))
5549 ((and (< n 1) (bobp))
5550 (forward-line 1)
5551 (anything-mark-current-line))))))
5553 ;;;###autoload
5554 (defun anything-c-goto-precedent-file ()
5555 "Go to precedent file in anything grep/etags buffers."
5556 (interactive)
5557 (anything-c-goto-next-or-prec-file -1))
5559 ;;;###autoload
5560 (defun anything-c-goto-next-file ()
5561 "Go to precedent file in anything grep/etags buffers."
5562 (interactive)
5563 (anything-c-goto-next-or-prec-file 1))
5565 ;;;###autoload
5566 (defun anything-c-grep-run-persistent-action ()
5567 "Run grep persistent action from `anything-do-grep-1'."
5568 (interactive)
5569 (anything-execute-persistent-action 'jump-persistent))
5571 ;;;###autoload
5572 (defun anything-c-grep-run-default-action ()
5573 "Run grep default action from `anything-do-grep-1'."
5574 (interactive)
5575 (anything-c-quit-and-execute-action 'anything-c-grep-action))
5577 ;;;###autoload
5578 (defun anything-c-grep-run-other-window-action ()
5579 "Run grep goto other window action from `anything-do-grep-1'."
5580 (interactive)
5581 (anything-c-quit-and-execute-action 'anything-c-grep-other-window))
5583 ;;;###autoload
5584 (defun anything-c-grep-run-save-buffer ()
5585 "Run grep save results action from `anything-do-grep-1'."
5586 (interactive)
5587 (anything-c-quit-and-execute-action 'anything-c-grep-save-results))
5589 ;; Grep buffers
5590 (defun anything-c-grep-buffers-1 (candidate &optional zgrep)
5591 "Run grep on all file--buffers or CANDIDATE if it is a file--buffer.
5592 If one of selected buffers is not a file--buffer,
5593 it is ignored and grep will run on all others file--buffers.
5594 If only one candidate is selected and it is not a file--buffer,
5595 switch to this buffer and run `anything-occur'.
5596 If a prefix arg is given run grep on all buffers ignoring non--file-buffers."
5597 (let* ((prefarg (or current-prefix-arg anything-current-prefix-arg))
5598 (cands (if prefarg
5599 (buffer-list)
5600 (anything-marked-candidates)))
5601 (win-conf (current-window-configuration))
5602 ;; Non--fname buffers are ignored.
5603 (bufs (loop for buf in cands
5604 for fname = (buffer-file-name (get-buffer buf))
5605 when fname
5606 collect (expand-file-name fname))))
5607 (if bufs
5608 (if zgrep
5609 (anything-do-grep-1 bufs nil 'zgrep)
5610 (anything-do-grep-1 bufs))
5611 ;; bufs is empty, thats mean we have only CANDIDATE
5612 ;; and it is not a buffer-filename, fallback to occur.
5613 (anything-c-switch-to-buffer candidate)
5614 (when (get-buffer anything-action-buffer)
5615 (kill-buffer anything-action-buffer))
5616 (anything-occur)
5617 (when (eq anything-exit-status 1)
5618 (set-window-configuration win-conf)))))
5620 (defun anything-c-grep-buffers (candidate)
5621 "Action to grep buffers."
5622 (anything-c-grep-buffers-1 candidate))
5624 (defun anything-c-zgrep-buffers (candidate)
5625 "Action to zgrep buffers."
5626 (anything-c-grep-buffers-1 candidate 'zgrep))
5629 ;;; Anything interface for pdfgrep
5630 ;; pdfgrep program <http://pdfgrep.sourceforge.net/>
5631 ;; and a pdf-reader (e.g xpdf) are needed.
5633 (defvar anything-c-pdfgrep-default-command "pdfgrep --color never -niH %s %s")
5634 (defvar anything-c-pdfgrep-default-function 'anything-c-pdfgrep-init)
5635 (defvar anything-c-pdfgrep-debug-command-line nil)
5637 (defun anything-c-pdfgrep-init (only-files)
5638 "Start an asynchronous pdfgrep process in ONLY-FILES list."
5639 (let* ((fnargs (anything-c-grep-prepare-candidates
5640 (if (file-remote-p anything-ff-default-directory)
5641 (mapcar #'(lambda (x)
5642 (file-remote-p x 'localname))
5643 only-files)
5644 only-files)))
5645 (cmd-line (format anything-c-pdfgrep-default-command
5646 anything-pattern
5647 fnargs)))
5648 (when anything-c-pdfgrep-debug-command-line
5649 (with-current-buffer (get-buffer-create "*any pdfgrep debug*")
5650 (goto-char (point-max))
5651 (insert (concat ">>> " cmd-line "\n\n"))))
5652 (setq mode-line-format
5653 '(" " mode-line-buffer-identification " "
5654 (line-number-mode "%l") " "
5655 (:eval (propertize "(Pdfgrep Process Running) "
5656 'face '((:foreground "red"))))))
5657 (prog1
5658 (let ((default-directory anything-ff-default-directory))
5659 (start-file-process-shell-command "pdfgrep-process" nil cmd-line))
5660 (message nil)
5661 (set-process-sentinel
5662 (get-process "pdfgrep-process")
5663 #'(lambda (process event)
5664 (when (string= event "finished\n")
5665 (with-anything-window
5666 (anything-update-move-first-line))
5667 (force-mode-line-update nil)))))))
5670 (defun anything-do-pdfgrep-1 (only)
5671 "Launch pdfgrep with a list of ONLY files."
5672 (unless (executable-find "pdfgrep")
5673 (error "Error: No such program `pdfgrep'."))
5674 (let* ((anything-compile-source-functions
5675 ;; rule out anything-match-plugin because the input is one regexp.
5676 (delq 'anything-compile-source--match-plugin
5677 (copy-sequence anything-compile-source-functions)))
5678 ;; Disable match-plugin and use here own highlighting.
5679 (anything-mp-highlight-delay nil))
5680 ;; When called as action from an other source e.g *-find-files
5681 ;; we have to kill action buffer.
5682 (when (get-buffer anything-action-buffer)
5683 (kill-buffer anything-action-buffer))
5684 ;; If `anything-find-files' haven't already started,
5685 ;; give a default value to `anything-ff-default-directory'.
5686 (setq anything-ff-default-directory (or anything-ff-default-directory
5687 default-directory))
5688 (anything
5689 :sources
5690 `(((name . "PdfGrep")
5691 (candidates
5692 . (lambda ()
5693 (funcall anything-c-pdfgrep-default-function only)))
5694 (filtered-candidate-transformer anything-c-grep-cand-transformer)
5695 (candidate-number-limit . 9999)
5696 (mode-line . anything-pdfgrep-mode-line-string)
5697 (action . anything-c-pdfgrep-action)
5698 (persistent-help . "Jump to PDF Page")
5699 (requires-pattern . 3)
5700 (delayed)))
5701 :keymap anything-c-pdfgrep-map
5702 :buffer "*anything grep*")))
5705 (defun anything-c-pdfgrep-action (candidate)
5706 (let* ((split (anything-c-grep-split-line candidate))
5707 (pageno (nth 1 split))
5708 (fname (car split)))
5709 (start-file-process-shell-command
5710 "pdf-reader" nil
5711 (format-spec anything-c-pdfgrep-default-read-command
5712 (list (cons ?f fname) (cons ?p pageno))))))
5714 (defun anything-do-pdfgrep ()
5715 (interactive)
5716 (let ((only (anything-c-read-file-name
5717 "Search in file(s): "
5718 :marked-candidates t
5719 :test #'(lambda (file)
5720 (or (string= (file-name-extension file) "pdf")
5721 (string= (file-name-extension file) "PDF")
5722 (file-directory-p file)))
5723 :preselect (or (dired-get-filename nil t)
5724 (buffer-file-name (current-buffer)))))
5725 (anything-c-grep-default-function 'anything-c-pdfgrep-init))
5726 (anything-do-pdfgrep-1 only)))
5729 ;; Yank text at point.
5732 ;; Internal
5733 (defvar anything-yank-point nil)
5735 ;;;###autoload
5736 (defun anything-yank-text-at-point ()
5737 "Yank text at point in minibuffer."
5738 (interactive)
5739 (let (input)
5740 (flet ((insert-in-minibuffer (word)
5741 (with-selected-window (minibuffer-window)
5742 (let ((str anything-pattern))
5743 (delete-minibuffer-contents)
5744 (set-text-properties 0 (length word) nil word)
5745 (insert (concat str word))))))
5746 (with-anything-current-buffer
5747 ;; Start to initial point if C-w have never been hit.
5748 (unless anything-yank-point (setq anything-yank-point (point)))
5749 (and anything-yank-point (goto-char anything-yank-point))
5750 (forward-word 1)
5751 (setq input (buffer-substring-no-properties anything-yank-point (point)))
5752 (setq anything-yank-point (point))) ; End of last forward-word
5753 (insert-in-minibuffer input))))
5755 (defun anything-reset-yank-point ()
5756 (setq anything-yank-point nil))
5758 (add-hook 'anything-after-persistent-action-hook 'anything-reset-yank-point)
5759 (add-hook 'anything-cleanup-hook 'anything-reset-yank-point)
5760 (define-key anything-map (kbd "C-w") 'anything-yank-text-at-point)
5763 ;;; Recentf files
5766 (defvar anything-c-source-recentf
5767 '((name . "Recentf")
5768 (init . (lambda ()
5769 (require 'recentf)
5770 (or recentf-mode (recentf-mode 1))
5771 ;; Big value empowers anything/recentf
5772 (when (and (numberp recentf-max-saved-items)
5773 (<= recentf-max-saved-items 20))
5774 (setq recentf-max-saved-items 500))))
5775 (candidates . recentf-list)
5776 (match anything-c-match-on-file-name
5777 anything-c-match-on-directory-name)
5778 (type . file))
5779 "See (info \"(emacs)File Conveniences\").
5780 if `recentf-max-saved-items' is too small, set it to 500.")
5781 ;; (anything 'anything-c-source-recentf)
5783 ;;; ffap
5784 (eval-when-compile (require 'ffap))
5785 (defvar anything-c-source-ffap-guesser
5786 '((name . "File at point")
5787 (init . (lambda () (require 'ffap)))
5788 (candidates . (lambda ()
5789 (anything-aif
5790 (with-anything-current-buffer
5791 (ffap-guesser))
5792 (list it))))
5793 (type . file)))
5794 ;; (anything 'anything-c-source-ffap-guesser)
5796 ;;; ffap with line number
5797 (defun anything-c-ffap-file-line-at-point ()
5798 "Get (FILENAME . LINENO) at point."
5799 (anything-aif (let (ffap-alist) (ffap-file-at-point))
5800 (save-excursion
5801 (beginning-of-line)
5802 (when (and (search-forward it nil t)
5803 (looking-at ":\\([0-9]+\\)"))
5804 (cons it (string-to-number (match-string 1)))))))
5806 (defvar anything-c-ffap-line-location nil
5807 "(FILENAME . LINENO) used by `anything-c-source-ffap-line'.
5808 It is cleared after jumping line.")
5810 (defun anything-c-ffap-line-candidates ()
5811 (with-anything-current-buffer
5812 (setq anything-c-ffap-line-location (anything-c-ffap-file-line-at-point)))
5813 (when anything-c-ffap-line-location
5814 (destructuring-bind (file . line) anything-c-ffap-line-location
5815 (list (cons (format "%s (line %d)" file line) file)))))
5817 ;;; Goto line after opening file by `anything-c-source-ffap-line'.
5818 (defun anything-c-ffap-line-goto-line ()
5819 (when (car anything-c-ffap-line-location)
5820 (unwind-protect
5821 (ignore-errors
5822 (with-selected-window
5823 (get-buffer-window
5824 (get-file-buffer (car anything-c-ffap-line-location)))
5825 (anything-goto-line (cdr anything-c-ffap-line-location)))))))
5826 (add-hook 'anything-after-action-hook 'anything-c-ffap-line-goto-line)
5827 (add-hook 'anything-after-persistent-action-hook 'anything-c-ffap-line-goto-line)
5829 (defvar anything-c-source-ffap-line
5830 '((name . "File/Lineno at point")
5831 (init . (lambda () (require 'ffap)))
5832 (candidates . anything-c-ffap-line-candidates)
5833 (type . file)))
5834 ;; (anything 'anything-c-source-ffap-line)
5836 ;;; list of files gleaned from every dired buffer
5837 (defun anything-c-files-in-all-dired-candidates ()
5838 (save-excursion
5839 (mapcan
5840 (lambda (dir)
5841 (cond ((listp dir) ;filelist
5842 dir)
5843 ((equal "" (file-name-nondirectory dir)) ;dir
5844 (directory-files dir t))
5845 (t ;wildcard
5846 (file-expand-wildcards dir t))))
5847 (delq nil
5848 (mapcar (lambda (buf)
5849 (set-buffer buf)
5850 (when (eq major-mode 'dired-mode)
5851 (if (consp dired-directory)
5852 (cdr dired-directory) ;filelist
5853 dired-directory))) ;dir or wildcard
5854 (buffer-list))))))
5855 ;; (dired '("~/" "~/.emacs-custom.el" "~/.emacs.bmk"))
5857 (defvar anything-c-source-files-in-all-dired
5858 '((name . "Files in all dired buffer.")
5859 (candidates . anything-c-files-in-all-dired-candidates)
5860 (type . file)))
5861 ;; (anything 'anything-c-source-files-in-all-dired)
5863 (defvar anything-c-source-filelist
5864 '((name . "FileList")
5865 (grep-candidates . anything-c-filelist-file-name)
5866 (candidate-number-limit . 200)
5867 (requires-pattern . 4)
5868 (type . file))
5869 "Source to find files instantly.
5870 See `anything-c-filelist-file-name' docstring for usage.")
5873 ;;;; <info>
5874 ;;; Info pages
5875 (defvar anything-c-info-pages nil
5876 "All info pages on system.
5877 Will be calculated the first time you invoke anything with this
5878 source.")
5880 (defvar anything-c-source-info-pages
5881 `((name . "Info Pages")
5882 (candidates
5883 . (lambda ()
5884 (if anything-c-info-pages
5885 anything-c-info-pages
5886 (setq anything-c-info-pages
5887 (save-window-excursion
5888 (save-excursion
5889 (require 'info)
5890 (Info-find-node "dir" "top")
5891 (goto-char (point-min))
5892 (let ((info-topic-regexp "\\* +\\([^:]+: ([^)]+)[^.]*\\)\\.")
5893 topics)
5894 (while (re-search-forward info-topic-regexp nil t)
5895 (add-to-list 'topics (match-string-no-properties 1)))
5896 (goto-char (point-min))
5897 (Info-exit)
5898 topics)))))))
5899 (action . (("Show with Info" .(lambda (node-str)
5900 (info (replace-regexp-in-string
5901 "^[^:]+: " "" node-str))))))
5902 (requires-pattern . 2)))
5903 ;; (anything 'anything-c-source-info-pages)
5906 ;; FIXME should be merged in anything.el with `anything-describe-anything-attribute'.
5907 (defun anything-c-describe-attributes (anything-attribute)
5908 "Display the full documentation of ANYTHING-ATTRIBUTE (a symbol).
5909 Same as `anything-describe-anything-attribute' but with anything completion."
5910 (interactive (list (intern
5911 (anything-comp-read
5912 "Describe anything attribute: "
5913 (mapcar 'symbol-name anything-additional-attributes)
5914 :must-match t
5915 :persistent-action
5916 #'(lambda (candidate)
5917 (with-output-to-temp-buffer "*Help*"
5918 (princ (get (intern candidate) 'anything-attrdoc))))))))
5919 (with-output-to-temp-buffer "*Help*"
5920 (princ (get anything-attribute 'anything-attrdoc))))
5923 ;;; Use info-index plug-in.
5926 ;; Note that `name' attribute is not needed since
5927 ;; `anything-c-insert-summary' have been removed.
5928 ;; Info Elisp
5929 (defvar anything-c-source-info-elisp
5930 '((name . "Info index: elisp")
5931 (info-index . "elisp")))
5932 ;; (anything 'anything-c-source-info-elisp)
5934 ;; Info-Common-Lisp
5935 (defvar anything-c-source-info-cl
5936 '((name . "Info index: cl")
5937 (info-index . "cl")))
5938 ;; (anything 'anything-c-source-info-cl)
5940 ;; Info Index org
5941 (defvar anything-c-source-info-org
5942 '((name . "Info index: org")
5943 (info-index . "org")))
5944 ;; (anything 'anything-c-source-info-org)
5946 ;; Info Index gnus
5947 (defvar anything-c-source-info-gnus
5948 '((name . "Info index: Gnus")
5949 (info-index . "gnus")))
5951 ;; Info Index ratpoison
5952 (defvar anything-c-source-info-ratpoison
5953 '((name . "Info index: ratpoison")
5954 (info-index . "ratpoison")))
5955 ;; (anything 'anything-c-source-info-ratpoison)
5957 ;; Info Index zsh
5958 (defvar anything-c-source-info-zsh
5959 '((name . "Info index: zsh")
5960 (info-index . "zsh")))
5961 ;; (anything 'anything-c-source-info-zsh)
5963 ;; Info Index bash
5964 (defvar anything-c-source-info-bash
5965 '((name . "Info index: bash")
5966 (info-index . "bash")))
5967 ;; (anything 'anything-c-source-info-bash)
5969 ;; Info Index coreutils
5970 (defvar anything-c-source-info-coreutils
5971 '((name . "Info index: coreutils")
5972 (info-index . "coreutils")))
5973 ;; (anything 'anything-c-source-info-coreutils)
5975 ;; Info Index fileutils
5976 (defvar anything-c-source-info-fileutils
5977 '((name . "Info index: fileutils")
5978 (info-index . "fileutils")))
5979 ;; (anything 'anything-c-source-info-fileutils)
5981 ;; Info Index find
5982 (defvar anything-c-source-info-find
5983 '((name . "Info index: find")
5984 (info-index . "find")))
5985 ;; (anything 'anything-c-source-info-find)
5987 ;; Info Index sh-utils
5988 (defvar anything-c-source-info-sh-utils
5989 '((name . "Info index: sh-utils")
5990 (info-index . "sh-utils")))
5991 ;; (anything 'anything-c-source-info-sh-utils)
5993 ;; Info Index textutils
5994 (defvar anything-c-source-info-textutils
5995 '((name . "Info index: textutils")
5996 (info-index . "textutils")))
5997 ;; (anything 'anything-c-source-info-textutils)
5999 ;; Info Index libc
6000 (defvar anything-c-source-info-libc
6001 '((name . "Info index: libc")
6002 (info-index . "libc")))
6003 ;; (anything 'anything-c-source-info-libc)
6005 ;; Info Index make
6006 (defvar anything-c-source-info-make
6007 '((name . "Info index: make")
6008 (info-index . "make")))
6009 ;; (anything 'anything-c-source-info-make)
6011 ;; Info Index automake
6012 (defvar anything-c-source-info-automake
6013 '((name . "Info index: automake")
6014 (info-index . "automake")))
6015 ;; (anything 'anything-c-source-info-automake)
6017 ;; Info Index autoconf
6018 (defvar anything-c-source-info-autoconf
6019 '((name . "Info index: autoconf")
6020 (info-index . "autoconf")))
6021 ;; (anything 'anything-c-source-info-autoconf)
6023 ;; Info Index emacs-lisp-intro
6024 (defvar anything-c-source-info-emacs-lisp-intro
6025 '((name . "Info index: emacs-lisp-intro")
6026 (info-index . "emacs-lisp-intro")))
6027 ;; (anything 'anything-c-source-info-emacs-lisp-intro)
6029 ;; Info Index emacs
6030 (defvar anything-c-source-info-emacs
6031 '((name . "Info index: emacs")
6032 (info-index . "emacs")))
6033 ;; (anything 'anything-c-source-info-emacs)
6035 ;; Info Index elib
6036 (defvar anything-c-source-info-elib
6037 '((name . "Info index: elib")
6038 (info-index . "elib")))
6039 ;; (anything 'anything-c-source-info-elib)
6041 ;; Info Index eieio
6042 (defvar anything-c-source-info-eieio
6043 '((name . "Info index: eieio")
6044 (info-index . "eieio")))
6045 ;; (anything 'anything-c-source-info-eieio)
6047 ;; Info Index gauche-refe
6048 (defvar anything-c-source-info-gauche-refe
6049 '((name . "Info index: gauche")
6050 (info-index . "gauche-refe")))
6051 ;; (anything 'anything-c-source-info-gauche-refe)
6053 ;; Info Index guile
6054 (defvar anything-c-source-info-guile
6055 '((name . "Info index: guile")
6056 (info-index . "guile")))
6057 ;; (anything 'anything-c-source-info-guile)
6059 ;; Info Index guile-tut
6060 (defvar anything-c-source-info-guile-tut
6061 '((name . "Info index: guile-tut")
6062 (info-index . "guile-tut")))
6063 ;; (anything 'anything-c-source-info-guile-tut)
6065 ;; Info Index goops
6066 (defvar anything-c-source-info-goops
6067 '((name . "Info index: goops")
6068 (info-index . "goops")))
6069 ;; (anything 'anything-c-source-info-goops)
6071 ;; Info Index screen
6072 (defvar anything-c-source-info-screen
6073 '((name . "Info index: screen")
6074 (info-index . "screen")
6075 (index-nodes "Concept Index" "Command Index" "Keystroke Index")))
6076 ;; (anything 'anything-c-source-info-screen)
6078 ;; Info Index latex
6079 (defvar anything-c-source-info-latex
6080 '((name . "Info index: latex")
6081 (info-index . "latex")))
6082 ;; (anything 'anything-c-source-info-latex)
6084 ;; Info Index gawk
6085 (defvar anything-c-source-info-gawk
6086 '((name . "Info index: gawk")
6087 (info-index . "gawk")))
6088 ;; (anything 'anything-c-source-info-gawk)
6090 ;; Info Index sed
6091 (defvar anything-c-source-info-sed
6092 '((name . "Info index: sed")
6093 (info-index . "sed")))
6094 ;; (anything 'anything-c-source-info-sed)
6096 ;; Info Index m4
6097 (defvar anything-c-source-info-m4
6098 '((name . "Info index: m4")
6099 (info-index . "m4")))
6100 ;; (anything 'anything-c-source-info-m4)
6102 ;; Info Index wget
6103 (defvar anything-c-source-info-wget
6104 '((name . "Info index: wget")
6105 (info-index . "wget")))
6106 ;; (anything 'anything-c-source-info-wget)
6108 ;; Info Index binutils
6109 (defvar anything-c-source-info-binutils
6110 '((name . "Info index: binutils")
6111 (info-index . "binutils")))
6112 ;; (anything 'anything-c-source-info-binutils)
6114 ;; Info Index as
6115 (defvar anything-c-source-info-as
6116 '((name . "Info index: as")
6117 (info-index . "as")))
6118 ;; (anything 'anything-c-source-info-as)
6120 ;; Info Index bfd
6121 (defvar anything-c-source-info-bfd
6122 '((name . "Info index: bfd")
6123 (info-index . "bfd")))
6124 ;; (anything 'anything-c-source-info-bfd)
6126 ;; Info Index gprof
6127 (defvar anything-c-source-info-gprof
6128 '((name . "Info index: gprof")
6129 (info-index . "gprof")))
6130 ;; (anything 'anything-c-source-info-gprof)
6132 ;; Info Index ld
6133 (defvar anything-c-source-info-ld
6134 '((name . "Info index: ld")
6135 (info-index . "ld")))
6136 ;; (anything 'anything-c-source-info-ld)
6138 ;; Info Index diff
6139 (defvar anything-c-source-info-diff
6140 '((name . "Info index: diff")
6141 (info-index . "diff")))
6142 ;; (anything 'anything-c-source-info-diff)
6144 ;; Info Index flex
6145 (defvar anything-c-source-info-flex
6146 '((name . "Info index: flex")
6147 (info-index . "flex")))
6148 ;; (anything 'anything-c-source-info-flex)
6150 ;; Info Index grep
6151 (defvar anything-c-source-info-grep
6152 '((name . "Info index: grep")
6153 (info-index . "grep")))
6154 ;; (anything 'anything-c-source-info-grep)
6156 ;; Info Index gzip
6157 (defvar anything-c-source-info-gzip
6158 '((name . "Info index: gzip")
6159 (info-index . "gzip")))
6160 ;; (anything 'anything-c-source-info-gzip)
6162 ;; Info Index libtool
6163 (defvar anything-c-source-info-libtool
6164 '((name . "Info index: libtool")
6165 (info-index . "libtool")))
6166 ;; (anything 'anything-c-source-info-libtool)
6168 ;; Info Index texinfo
6169 (defvar anything-c-source-info-texinfo
6170 '((name . "Info index: texinfo")
6171 (info-index . "texinfo")))
6172 ;; (anything 'anything-c-source-info-texinfo)
6174 ;; Info Index info
6175 (defvar anything-c-source-info-info
6176 '((name . "Info index: info")
6177 (info-index . "info")))
6178 ;; (anything 'anything-c-source-info-info)
6180 ;; Info Index gdb
6181 (defvar anything-c-source-info-gdb
6182 '((name . "Info index: gdb")
6183 (info-index . "gdb")))
6184 ;; (anything 'anything-c-source-info-gdb)
6186 ;; Info Index stabs
6187 (defvar anything-c-source-info-stabs
6188 '((name . "Info index: stabs")
6189 (info-index . "stabs")))
6190 ;; (anything 'anything-c-source-info-stabs)
6192 ;; Info Index cvsbook
6193 (defvar anything-c-source-info-cvsbook
6194 '((name . "Info index: cvsbook")
6195 (info-index . "cvsbook")))
6196 ;; (anything 'anything-c-source-info-cvsbook)
6198 ;; Info Index cvs
6199 (defvar anything-c-source-info-cvs
6200 '((name . "Info index: cvs")
6201 (info-index . "cvs")))
6202 ;; (anything 'anything-c-source-info-cvs)
6204 ;; Info Index bison
6205 (defvar anything-c-source-info-bison
6206 '((name . "Info index: bison")
6207 (info-index . "bison")))
6208 ;; (anything 'anything-c-source-info-bison)
6210 ;; Info Index id-utils
6211 (defvar anything-c-source-info-id-utils
6212 '((name . "Info index: id-utils")
6213 (info-index . "id-utils")))
6214 ;; (anything 'anything-c-source-info-id-utils)
6216 ;; Info Index global
6217 (defvar anything-c-source-info-global
6218 '((name . "Info index: global")
6219 (info-index . "global")))
6220 ;; (anything 'anything-c-source-info-global)
6223 ;;;; <Help>
6224 ;;; Man and woman UI
6227 (defvar anything-c-man-pages nil
6228 "All man pages on system.
6229 Will be calculated the first time you invoke anything with this
6230 source.")
6232 (defun anything-c-man-default-action (candidate)
6233 "Default action for jumping to a woman or man page from anything."
6234 (let ((wfiles (woman-file-name-all-completions candidate)))
6235 (condition-case err
6236 (if (> (length wfiles) 1)
6237 (woman-find-file
6238 (anything-comp-read
6239 "ManFile: " wfiles :must-match t))
6240 (woman candidate))
6241 ;; If woman is unable to format correctly
6242 ;; use man instead.
6243 (error (kill-buffer) ; Kill woman buffer.
6244 (let ((Man-notify-method 'meek))
6245 (Man-getpage-in-background candidate))))))
6247 (defvar anything-c-source-man-pages
6248 `((name . "Manual Pages")
6249 (candidates . (lambda ()
6250 (if anything-c-man-pages
6251 anything-c-man-pages
6252 ;; XEmacs doesn't have a woman :)
6253 (setq anything-c-man-pages
6254 (ignore-errors
6255 (require 'woman)
6256 (woman-file-name "")
6257 (sort (mapcar 'car woman-topic-all-completions)
6258 'string-lessp))))))
6259 (action ("Show with Woman" . anything-c-man-default-action))
6260 ;; Woman does not work OS X
6261 ;; http://xahlee.org/emacs/modernization_man_page.html
6262 (action-transformer . (lambda (actions candidate)
6263 (if (eq system-type 'darwin)
6264 '(("Show with Man" . man))
6265 actions)))
6266 (requires-pattern . 2)))
6267 ;; (anything 'anything-c-source-man-pages)
6270 ;;;; <Command>
6271 ;;; Complex command history
6274 (defvar anything-c-source-complex-command-history
6275 '((name . "Complex Command History")
6276 (candidates . (lambda () (mapcar 'prin1-to-string command-history)))
6277 (type . sexp)))
6278 ;; (anything 'anything-c-source-complex-command-history)
6280 ;;; M-x history (not related to `anything-M-x')
6283 (defvar anything-c-source-extended-command-history
6284 '((name . "Emacs Commands History")
6285 (candidates . extended-command-history)
6286 (type . command)))
6287 ;; (anything 'anything-c-source-extended-command-history)
6289 ;;; Emacs commands (Basic source for emacs commands)
6292 (defvar anything-c-source-emacs-commands
6293 '((name . "Emacs Commands")
6294 (candidates . (lambda ()
6295 (let (commands)
6296 (mapatoms (lambda (a)
6297 (if (commandp a)
6298 (push (symbol-name a)
6299 commands))))
6300 (sort commands 'string-lessp))))
6301 (type . command)
6302 (requires-pattern . 2))
6303 "Source for completing and invoking Emacs commands.
6304 A command is a function with interactive spec that can
6305 be invoked with `M-x'.
6307 To get non-interactive functions listed, use
6308 `anything-c-source-emacs-functions'.")
6309 ;; (anything 'anything-c-source-emacs-commands)
6312 ;;; Anything M-x - Enhanced M-x UI
6315 ;; Another replacement of `M-x' that act exactly like the
6316 ;; vanilla Emacs one, no problem of windows configuration, prefix args
6317 ;; can be passed before calling `M-x' (e.g C-u M-x..) but also during
6318 ;; anything invocation.
6319 ;; Documentation of commands available without quitting,
6320 ;; Show keybindings of commands.
6321 ;; Show history.
6322 (defun* anything-M-x-get-major-mode-command-alist (mode-map)
6323 "Return alist of MODE-MAP."
6324 (loop for key being the key-seqs of mode-map using (key-bindings com)
6325 for str-key = (key-description key)
6326 for ismenu = (string-match "<menu-bar>" str-key)
6327 unless ismenu collect (cons str-key com)))
6329 (defun anything-get-mode-map-from-mode (mode)
6330 "Guess the mode-map name according to MODE.
6331 Some modes don't use conventional mode-map name
6332 so we need to guess mode-map name. e.g python-mode ==> py-mode-map.
6333 Return nil if no mode-map found."
6334 (loop
6335 ;; Start with a conventional mode-map name.
6336 with mode-map = (intern-soft (format "%s-map" mode))
6337 with mode-string = (symbol-name mode)
6338 with mode-name = (replace-regexp-in-string "-mode" "" mode-string)
6339 while (not mode-map)
6340 for count downfrom (length mode-name)
6341 ;; Return when no result after parsing entire string.
6342 when (eq count 0) return nil
6343 for sub-name = (substring mode-name 0 count)
6344 do (setq mode-map (intern-soft (format "%s-map" (concat sub-name "-mode"))))
6345 finally return mode-map))
6347 (defun anything-M-x-current-mode-map-alist ()
6348 "Return mode-map alist of current `major-mode'."
6349 (let ((map (anything-get-mode-map-from-mode major-mode)))
6350 (when (and map (boundp map))
6351 (anything-M-x-get-major-mode-command-alist (symbol-value map)))))
6354 (defun anything-M-x-transformer (candidates sources)
6355 "filtered-candidate-transformer to show bindings in emacs commands.
6356 Show global bindings and local bindings according to current `major-mode'."
6357 (with-anything-current-buffer
6358 (loop
6359 with local-map = (anything-M-x-current-mode-map-alist)
6360 for cand in candidates
6361 for local-key = (car (rassq cand local-map))
6362 for key = (substitute-command-keys (format "\\[%s]" cand))
6363 collect
6364 (cons (cond ((and (string-match "^M-x" key) local-key)
6365 (format "%s (%s)"
6366 cand (propertize
6367 local-key
6368 'face 'anything-M-x-key-face)))
6369 ((string-match "^M-x" key) cand)
6370 (t (format "%s (%s)"
6371 cand (propertize
6373 'face 'anything-M-x-key-face)))) cand))))
6376 ;;; LaCarte
6377 (defvar anything-c-source-lacarte
6378 '((name . "Lacarte")
6379 (init . (lambda () (require 'lacarte )))
6380 (candidates . (lambda () (delete '(nil) (lacarte-get-overall-menu-item-alist))))
6381 (candidate-number-limit . 9999)
6382 (action . anything-c-call-interactively))
6383 "Needs lacarte.el.
6385 http://www.emacswiki.org/cgi-bin/wiki/download/lacarte.el")
6386 ;; (anything 'anything-c-source-lacarte)
6389 ;;;; <Function>
6390 ;;; Emacs functions
6393 (defvar anything-c-source-emacs-functions
6394 '((name . "Emacs Functions")
6395 (candidates . (lambda ()
6396 (let (commands)
6397 (mapatoms (lambda (a)
6398 (if (functionp a)
6399 (push (symbol-name a) commands))))
6400 (sort commands 'string-lessp))))
6401 (type . function)
6402 (requires-pattern . 2))
6403 "Source for completing Emacs functions.")
6404 ;; (anything 'anything-c-source-emacs-functions)
6406 ;;; With abbrev expansion
6407 ;;; Similar to my exec-abbrev-cmd.el
6408 ;;; See http://www.tsdh.de/cgi-bin/wiki.pl/exec-abbrev-cmd.el
6409 (defvar anything-c-function-abbrev-regexp nil
6410 "The regexp for `anything-c-source-emacs-functions-with-abbrevs'.
6411 Regexp built from the current `anything-pattern' interpreting it
6412 as abbreviation.
6413 Only for internal use.")
6415 (defun anything-c-match-function-by-abbrev (candidate)
6416 "Return non-nil if `anything-pattern' is an abbreviation of the function CANDIDATE.
6418 Abbreviations are made by taking the first character from each
6419 word in the function's name, e.g. \"bb\" is an abbrev for
6420 `bury-buffer', \"stb\" is an abbrev for `anything-c-switch-to-buffer'."
6421 (string-match anything-c-function-abbrev-regexp candidate))
6423 (defvar anything-c-source-emacs-functions-with-abbrevs
6424 (append anything-c-source-emacs-functions
6425 '((match anything-c-match-function-by-abbrev
6426 anything-c-string-match))
6427 '((init
6428 . (lambda ()
6429 (defadvice anything-update
6430 (before anything-c-update-function-abbrev-regexp activate)
6431 (let ((char-list (append anything-pattern nil))
6432 (str "^"))
6433 (dolist (c char-list)
6434 (setq str (concat str (list c) "[^-]*-")))
6435 (setq str (concat (substring str 0 (1- (length str))) "$"))
6436 (setq anything-c-function-abbrev-regexp str))))))))
6437 ;; (anything 'anything-c-source-emacs-functions-with-abbrevs)
6439 (defvar anything-c-source-advice
6440 '((name . "Function Advice")
6441 (candidates . anything-c-advice-candidates)
6442 (action ("Toggle Enable/Disable" . anything-c-advice-toggle))
6443 ;; (real-to-display . anything-c-advice-real-to-display)
6444 (persistent-action . anything-c-advice-persistent-action)
6445 (persistent-help . "Describe function / C-u C-z: Toggle advice")))
6446 ;; (anything 'anything-c-source-advice)
6447 ;; (let ((debug-on-signal t))(anything 'anything-c-source-advice))
6448 ;; (testadvice)
6450 (defun anything-c-advice-candidates ()
6451 (require 'advice)
6452 (loop for (fname) in ad-advised-functions
6453 for function = (intern fname)
6454 append
6455 (loop for class in ad-advice-classes append
6456 (loop for advice in (ad-get-advice-info-field function class)
6457 for enabled = (ad-advice-enabled advice)
6458 collect
6459 (cons (format
6460 "%s %s %s"
6461 (if enabled "Enabled " "Disabled")
6462 (propertize fname 'face 'font-lock-function-name-face)
6463 (ad-make-single-advice-docstring advice class nil))
6464 (list function class advice))))))
6466 (defun anything-c-advice-persistent-action (func-class-advice)
6467 (if current-prefix-arg
6468 (anything-c-advice-toggle func-class-advice)
6469 (describe-function (car func-class-advice))))
6471 (defun anything-c-advice-toggle (func-class-advice)
6472 (destructuring-bind (function class advice) func-class-advice
6473 (cond ((ad-advice-enabled advice)
6474 (ad-advice-set-enabled advice nil)
6475 (message "Disabled"))
6476 (t ;disabled
6477 (ad-advice-set-enabled advice t)
6478 (message "Enabled")))
6479 (ad-activate function)
6480 (and anything-in-persistent-action
6481 (anything-c-advice-update-current-display-string))))
6483 (defun anything-c-advice-update-current-display-string ()
6484 (anything-edit-current-selection
6485 (let ((newword (cond ((looking-at "Disabled") "Enabled")
6486 ((looking-at "Enabled") "Disabled")))
6487 realvalue)
6488 (when newword
6489 (delete-region (point) (progn (forward-word 1) (point)))
6490 (insert newword)))))
6493 ;;;; <Variable>
6494 ;;; Emacs variables
6497 (defvar anything-c-source-emacs-variables
6498 '((name . "Emacs Variables")
6499 (candidates . (lambda ()
6500 (sort (all-completions "" obarray 'boundp) 'string-lessp)))
6501 (type . variable)
6502 (requires-pattern . 2))
6503 "Source for completing Emacs variables.")
6504 ;; (anything 'anything-c-source-emacs-variables)
6507 ;;; Bookmarks
6510 ;; Bind some faces for bookmarks.
6511 (defvar anything-c-bookmarks-face1 'anything-ff-directory)
6512 (defvar anything-c-bookmarks-face2 'anything-ff-file)
6513 (defvar anything-c-bookmarks-face3 'anything-bookmarks-su-face)
6515 (eval-when-compile (require 'bookmark))
6516 (defvar anything-c-source-bookmarks
6517 '((name . "Bookmarks")
6518 (init . (lambda ()
6519 (require 'bookmark)))
6520 (candidates . bookmark-all-names)
6521 (type . bookmark))
6522 "See (info \"(emacs)Bookmarks\").")
6523 ;; (anything 'anything-c-source-bookmarks)
6525 ;;; bookmark-set
6526 (defvar anything-c-source-bookmark-set
6527 '((name . "Set Bookmark")
6528 (dummy)
6529 (action . bookmark-set))
6530 "See (info \"(emacs)Bookmarks\").")
6531 ;; (anything 'anything-c-source-bookmark-set)
6533 ;;; Visible Bookmarks
6534 ;; (install-elisp "http://cvs.savannah.gnu.org/viewvc/*checkout*/bm/bm/bm.el")
6537 ;; http://d.hatena.ne.jp/grandVin/20080911/1221114327
6538 (defvar anything-c-source-bm
6539 '((name . "Visible Bookmarks")
6540 (init . anything-c-bm-init)
6541 (candidates-in-buffer)
6542 (type . line))
6543 "Needs bm.el.
6545 http://www.nongnu.org/bm/")
6547 (defun anything-c-bm-init ()
6548 "Init function for `anything-c-source-bm'."
6549 (when (require 'bm nil t)
6550 (with-no-warnings
6551 (let ((bookmarks (bm-lists))
6552 (buf (anything-candidate-buffer 'global)))
6553 (dolist (bm (sort* (append (car bookmarks) (cdr bookmarks))
6554 '< :key 'overlay-start))
6555 (let ((start (overlay-start bm))
6556 (end (overlay-end bm))
6557 (annotation (or (overlay-get bm 'annotation) "")))
6558 (unless (< (- end start) 1) ; org => (if (< (- end start) 2)
6559 (let ((str (format "%5d: [%s]: %s\n"
6560 (line-number-at-pos start)
6561 annotation
6562 (buffer-substring start (1- end)))))
6563 (with-current-buffer buf (insert str))))))))))
6565 ;;; Special bookmarks
6566 (defvar anything-c-source-bookmarks-ssh
6567 '((name . "Bookmarks-ssh")
6568 (init . (lambda ()
6569 (require 'bookmark)))
6570 (candidates . (lambda () (anything-c-collect-bookmarks :ssh t)))
6571 (type . bookmark))
6572 "See (info \"(emacs)Bookmarks\").")
6573 ;; (anything 'anything-c-source-bookmarks-ssh)
6575 (defvar anything-c-source-bookmarks-su
6576 '((name . "Bookmarks-root")
6577 (init . (lambda ()
6578 (require 'bookmark)))
6579 (candidates . (lambda () (anything-c-collect-bookmarks :su t)))
6580 (filtered-candidate-transformer anything-c-highlight-bookmark-su)
6582 (type . bookmark))
6583 "See (info \"(emacs)Bookmarks\").")
6584 ;; (anything 'anything-c-source-bookmarks-su)
6586 (defvar anything-c-source-bookmarks-local
6587 '((name . "Bookmarks-Local")
6588 (init . (lambda ()
6589 (require 'bookmark)))
6590 (candidates . (lambda () (anything-c-collect-bookmarks :local t)))
6591 (filtered-candidate-transformer
6592 anything-c-adaptive-sort
6593 anything-c-highlight-bookmark)
6594 (type . bookmark))
6595 "See (info \"(emacs)Bookmarks\").")
6596 ;; (anything 'anything-c-source-bookmarks-local)
6598 (defun* anything-c-collect-bookmarks (&key local su sudo ssh)
6599 (let* ((lis-all (bookmark-all-names))
6600 (lis-loc (cond (local (loop for i in lis-all
6601 unless (string-match "^(ssh)\\|^(su)" i)
6602 collect i))
6603 (su (loop for i in lis-all
6604 when (string-match "^(su)" i)
6605 collect i))
6606 (sudo (loop for i in lis-all
6607 when (string-match "^(sudo)" i)
6608 collect i))
6609 (ssh (loop for i in lis-all
6610 when (string-match "^(ssh)" i)
6611 collect i)))))
6612 (sort lis-loc 'string-lessp)))
6614 (defun anything-c-bookmark-root-logged-p ()
6615 (catch 'break
6616 (dolist (i (mapcar #'buffer-name (buffer-list)))
6617 (when (string-match (format "*tramp/%s ." anything-su-or-sudo) i)
6618 (throw 'break t)))))
6620 (defun anything-c-highlight-bookmark-su (files source)
6621 (if (anything-c-bookmark-root-logged-p)
6622 (anything-c-highlight-bookmark files source)
6623 (anything-c-highlight-not-logged files source)))
6625 (defun anything-c-highlight-not-logged (files source)
6626 (loop for i in files
6627 collect (propertize i 'face anything-c-bookmarks-face3)))
6629 (defun anything-c-highlight-bookmark (bookmarks source)
6630 "Used as `candidate-transformer' to colorize bookmarks.
6631 Work both with standard Emacs bookmarks and bookmark-extensions.el."
6632 (loop for i in bookmarks
6633 for isfile = (bookmark-get-filename i)
6634 for bufp = (and (fboundp 'bmkext-get-buffer-name)
6635 (bmkext-get-buffer-name i))
6636 for handlerp = (and (fboundp 'bookmark-get-handler)
6637 (bookmark-get-handler i))
6638 for isw3m = (and (fboundp 'bmkext-w3m-bookmark-p)
6639 (bmkext-w3m-bookmark-p i))
6640 for isgnus = (and (fboundp 'bmkext-gnus-bookmark-p)
6641 (bmkext-gnus-bookmark-p i))
6642 for isman = (and (fboundp 'bmkext-man-bookmark-p) ; Man
6643 (bmkext-man-bookmark-p i))
6644 for iswoman = (and (fboundp 'bmkext-woman-bookmark-p) ; Woman
6645 (bmkext-woman-bookmark-p i))
6646 for handlerp = (bookmark-get-handler i)
6647 for isannotation = (bookmark-get-annotation i)
6648 for isabook = (string= (bookmark-prop-get i 'type) "addressbook")
6649 for isinfo = (eq handlerp 'Info-bookmark-jump)
6650 ;; Add a * if bookmark have annotation
6651 if (and isannotation (not (string-equal isannotation "")))
6652 do (setq i (concat "*" i))
6653 collect (cond (;; info buffers
6654 isinfo
6655 (propertize i 'face 'anything-bmkext-info 'help-echo isfile))
6656 (;; w3m buffers
6657 isw3m
6658 (propertize i 'face 'anything-bmkext-w3m 'help-echo isfile))
6659 (;; gnus buffers
6660 isgnus
6661 (propertize i 'face 'anything-bmkext-gnus 'help-echo isfile))
6662 (;; Man Woman
6663 (or iswoman isman)
6664 (propertize i 'face 'anything-bmkext-man 'help-echo isfile))
6665 (;; Addressbook
6666 isabook
6667 (propertize i 'face '((:foreground "Tomato"))))
6668 (;; directories
6669 (and isfile (file-directory-p isfile))
6670 (propertize i 'face anything-c-bookmarks-face1 'help-echo isfile))
6671 (;; regular files
6673 (propertize i 'face 'anything-bmkext-file 'help-echo isfile)))))
6677 ;;; Sources to filter bookmark-extensions bookmarks.
6680 ;; Dependency: http://mercurial.intuxication.org/hg/emacs-bookmark-extension
6681 ;; If you want to enable google-maps in addressbook you will need
6682 ;; Julien Danjou google-maps-el package available here:
6683 ;; http://julien.danjou.info/google-maps-el.html
6685 (defun anything-c-bmkext-filter-setup-alist (fn &rest args)
6686 "Return a filtered `bookmark-alist' sorted alphabetically."
6687 (loop
6688 with alist = (if args
6689 (apply #'(lambda (x) (funcall fn x)) args)
6690 (funcall fn))
6691 for i in alist
6692 for b = (car i)
6693 collect b into sa
6694 finally return (sort sa 'string-lessp)))
6696 ;;; Addressbook.
6699 (defvar anything-c-source-bmkext-addressbook
6700 '((name . "Bookmark Addressbook")
6701 (init . (lambda ()
6702 (require 'bookmark-extensions)
6703 (bookmark-maybe-load-default-file)))
6704 (candidates . anything-c-bmkext-addressbook-setup-alist)
6705 (persistent-action
6706 . (lambda (candidate)
6707 (let ((bmk (anything-bookmark-get-bookmark-from-name
6708 candidate)))
6709 (bookmark--jump-via bmk 'pop-to-buffer))))
6710 (persistent-help . "Show contact - Prefix with C-u to append")
6711 (filtered-candidate-transformer
6712 anything-c-adaptive-sort
6713 anything-c-highlight-bookmark)
6714 (action . (("Show Contact(s)"
6715 . (lambda (candidate)
6716 (let* ((contacts (anything-marked-candidates))
6717 (current-prefix-arg (or anything-current-prefix-arg
6718 (> (length contacts) 1))))
6719 (bookmark-jump
6720 (anything-bookmark-get-bookmark-from-name (car contacts)))
6721 (anything-aif (cdr contacts)
6722 (loop for bmk in it do
6723 (bookmark-jump
6724 (anything-bookmark-get-bookmark-from-name bmk)))))))
6725 ("Send Mail"
6726 . (lambda (candidate)
6727 (let* ((contacts (anything-marked-candidates))
6728 (bmk (anything-bookmark-get-bookmark-from-name
6729 (car contacts)))
6730 (append (message-buffers)))
6731 (if append
6732 (addressbook-set-mail-buffer1 bmk 'append)
6733 (addressbook-set-mail-buffer1 bmk))
6734 (setq contacts (cdr contacts))
6735 (when contacts
6736 (loop for bmk in contacts do
6737 (addressbook-set-mail-buffer1 bmk 'append))))))
6738 ("Edit Bookmark"
6739 . (lambda (candidate)
6740 (let ((bmk (anything-bookmark-get-bookmark-from-name
6741 candidate)))
6742 (addressbook-bookmark-edit
6743 (assoc bmk bookmark-alist)))))
6744 ("Insert Email at point"
6745 . (lambda (candidate)
6746 (let* ((bmk (anything-bookmark-get-bookmark-from-name
6747 candidate))
6748 (mlist (split-string
6749 (assoc-default
6750 'email (assoc bmk bookmark-alist))
6751 ", ")))
6752 (insert
6753 (if (> (length mlist) 1)
6754 (anything-comp-read
6755 "Insert Mail Address: " mlist :must-match t)
6756 (car mlist))))))
6757 ("Show annotation"
6758 . (lambda (candidate)
6759 (let ((bmk (anything-bookmark-get-bookmark-from-name
6760 candidate)))
6761 (bookmark-show-annotation bmk))))
6762 ("Edit annotation"
6763 . (lambda (candidate)
6764 (let ((bmk (anything-bookmark-get-bookmark-from-name
6765 candidate)))
6766 (bookmark-edit-annotation bmk))))
6767 ("Show Google map"
6768 . (lambda (candidate)
6769 (let* ((bmk (anything-bookmark-get-bookmark-from-name
6770 candidate))
6771 (full-bmk (assoc bmk bookmark-alist)))
6772 (addressbook-google-map full-bmk))))))))
6775 (defun anything-c-bmkext-addressbook-setup-alist ()
6776 "Specialized filter function for bookmarks w3m."
6777 (anything-c-bmkext-filter-setup-alist 'bmkext-addressbook-alist-only))
6779 ;; W3m bookmarks from bookmark-extensions.
6780 (defvar anything-c-source-bookmark-w3m
6781 '((name . "Bookmark W3m")
6782 (init . (lambda ()
6783 (require 'bookmark-extensions)
6784 (bookmark-maybe-load-default-file)))
6785 (candidates . anything-c-bookmark-w3m-setup-alist)
6786 (filtered-candidate-transformer
6787 anything-c-adaptive-sort
6788 anything-c-highlight-bookmark)
6789 (type . bookmark)))
6790 ;; (anything 'anything-c-source-bookmark-w3m)
6792 (defun anything-c-bookmark-w3m-setup-alist ()
6793 "Specialized filter function for bookmarks w3m."
6794 (anything-c-bmkext-filter-setup-alist 'bmkext-w3m-alist-only))
6796 ;; Images
6797 (defvar anything-c-source-bookmark-images
6798 '((name . "Bookmark Images")
6799 (init . (lambda ()
6800 (require 'bookmark-extensions)
6801 (bookmark-maybe-load-default-file)))
6802 (candidates . anything-c-bookmark-images-setup-alist)
6803 (filtered-candidate-transformer
6804 anything-c-adaptive-sort
6805 anything-c-highlight-bookmark)
6806 (type . bookmark)))
6807 ;; (anything 'anything-c-source-bookmark-images)
6809 (defun anything-c-bookmark-images-setup-alist ()
6810 "Specialized filter function for images bookmarks."
6811 (anything-c-bmkext-filter-setup-alist 'bmkext-image-file-alist-only))
6813 ;; Woman Man
6814 (defvar anything-c-source-bookmark-man
6815 '((name . "Bookmark Woman&Man")
6816 (init . (lambda ()
6817 (require 'bookmark-extensions)
6818 (bookmark-maybe-load-default-file)))
6819 (candidates . anything-c-bookmark-man-setup-alist)
6820 (filtered-candidate-transformer
6821 anything-c-adaptive-sort
6822 anything-c-highlight-bookmark)
6823 (type . bookmark)))
6824 ;; (anything 'anything-c-source-bookmark-man)
6826 (defun anything-c-bookmark-man-setup-alist ()
6827 "Specialized filter function for bookmarks w3m."
6828 (append (anything-c-bmkext-filter-setup-alist 'bmkext-man-alist-only)
6829 (anything-c-bmkext-filter-setup-alist 'bmkext-woman-alist-only)))
6831 ;; Gnus
6832 (defvar anything-c-source-bookmark-gnus
6833 '((name . "Bookmark Gnus")
6834 (init . (lambda ()
6835 (require 'bookmark-extensions)
6836 (bookmark-maybe-load-default-file)))
6837 (candidates . anything-c-bookmark-gnus-setup-alist)
6838 (filtered-candidate-transformer
6839 anything-c-adaptive-sort
6840 anything-c-highlight-bookmark)
6841 (type . bookmark)))
6842 ;; (anything 'anything-c-source-bookmark-gnus)
6844 (defun anything-c-bookmark-gnus-setup-alist ()
6845 "Specialized filter function for bookmarks gnus."
6846 (anything-c-bmkext-filter-setup-alist 'bmkext-gnus-alist-only))
6848 ;; Info
6849 (defvar anything-c-source-bookmark-info
6850 '((name . "Bookmark Info")
6851 (init . (lambda ()
6852 (require 'bookmark-extensions)
6853 (bookmark-maybe-load-default-file)))
6854 (candidates . anything-c-bookmark-info-setup-alist)
6855 (filtered-candidate-transformer
6856 anything-c-adaptive-sort
6857 anything-c-highlight-bookmark)
6858 (type . bookmark)))
6859 ;; (anything 'anything-c-source-bookmark-info)
6861 (defun anything-c-bookmark-info-setup-alist ()
6862 "Specialized filter function for bookmarks info."
6863 (anything-c-bmkext-filter-setup-alist 'bmkext-info-alist-only))
6865 ;; Local Files&directories
6866 (defvar anything-c-source-bookmark-files&dirs
6867 '((name . "Bookmark Files&Directories")
6868 (init . (lambda ()
6869 (require 'bookmark-extensions)
6870 (bookmark-maybe-load-default-file)))
6871 (candidates . anything-c-bookmark-local-files-setup-alist)
6872 (filtered-candidate-transformer
6873 anything-c-adaptive-sort
6874 anything-c-highlight-bookmark)
6875 (type . bookmark)))
6876 ;; (anything 'anything-c-source-bookmark-files&dirs)
6878 (defun anything-c-bookmark-local-files-setup-alist ()
6879 "Specialized filter function for bookmarks locals files."
6880 (anything-c-bmkext-filter-setup-alist 'bmkext-local-file-alist-only))
6882 ;; Su Files&directories
6883 (defvar anything-c-source-bookmark-su-files&dirs
6884 '((name . "Bookmark Root-Files&Directories")
6885 (init . (lambda ()
6886 (require 'bookmark-extensions)
6887 (bookmark-maybe-load-default-file)))
6888 (candidates . anything-c-bookmark-su-files-setup-alist)
6889 (filtered-candidate-transformer
6890 anything-c-adaptive-sort
6891 anything-c-highlight-bookmark-su)
6892 (type . bookmark)))
6893 ;; (anything 'anything-c-source-bookmark-su-files&dirs)
6895 (defun anything-c-bookmark-su-files-setup-alist ()
6896 "Specialized filter function for bookmarks su/sudo files."
6897 (declare (special bmkext-su-or-sudo-regexp))
6898 (loop
6899 with l = (anything-c-bmkext-filter-setup-alist 'bmkext-remote-file-alist-only)
6900 for i in l
6901 for isfile = (bookmark-get-filename i)
6902 for istramp = (and isfile (boundp 'tramp-file-name-regexp)
6903 (save-match-data
6904 (string-match tramp-file-name-regexp isfile)))
6905 for issu = (and istramp
6906 (string-match bmkext-su-or-sudo-regexp isfile))
6907 if issu
6908 collect i))
6910 ;; Ssh Files&directories
6911 (defvar anything-c-source-bookmark-ssh-files&dirs
6912 '((name . "Bookmark Ssh-Files&Directories")
6913 (init . (lambda ()
6914 (require 'bookmark-extensions)
6915 (bookmark-maybe-load-default-file)))
6916 (candidates . anything-c-bookmark-ssh-files-setup-alist)
6917 (filtered-candidate-transformer . anything-c-adaptive-sort)
6918 (type . bookmark)))
6919 ;; (anything 'anything-c-source-bookmark-ssh-files&dirs)
6921 (defun anything-c-bookmark-ssh-files-setup-alist ()
6922 "Specialized filter function for bookmarks ssh files."
6923 (loop
6924 with l = (anything-c-bmkext-filter-setup-alist 'bmkext-remote-file-alist-only)
6925 for i in l
6926 for isfile = (bookmark-get-filename i)
6927 for istramp = (and isfile (boundp 'tramp-file-name-regexp)
6928 (save-match-data
6929 (string-match tramp-file-name-regexp isfile)))
6930 for isssh = (and istramp
6931 (string-match "/ssh:" isfile))
6932 if isssh
6933 collect i))
6937 ;;; Firefox bookmarks
6940 ;; You will have to set firefox to import bookmarks in his html file bookmarks.html.
6941 ;; (only for firefox versions >=3)
6942 ;; To achieve that, open about:config in firefox and double click on this line to enable value
6943 ;; to true:
6944 ;; user_pref("browser.bookmarks.autoExportHTML", false);
6945 ;; You should have now:
6946 ;; user_pref("browser.bookmarks.autoExportHTML", true);
6948 (defvar anything-firefox-bookmark-url-regexp "\\(https\\|http\\|ftp\\|about\\|file\\)://[^ \"]*")
6949 (defvar anything-firefox-bookmarks-regexp ">\\([^><]+.[^</a>]\\)")
6951 (defun anything-get-firefox-user-init-dir ()
6952 "Guess the default Firefox user directory name."
6953 (let* ((moz-dir (concat (getenv "HOME") "/.mozilla/firefox/"))
6954 (moz-user-dir
6955 (with-current-buffer (find-file-noselect (concat moz-dir "profiles.ini"))
6956 (goto-char (point-min))
6957 (prog1
6958 (when (search-forward "Path=" nil t)
6959 (buffer-substring-no-properties (point) (point-at-eol)))
6960 (kill-buffer)))))
6961 (file-name-as-directory (concat moz-dir moz-user-dir))))
6963 (defun anything-guess-firefox-bookmark-file ()
6964 "Return the path of the Firefox bookmarks file."
6965 (concat (anything-get-firefox-user-init-dir) "bookmarks.html"))
6967 (defun anything-html-bookmarks-to-alist (file url-regexp bmk-regexp)
6968 "Parse html bookmark FILE and return an alist with (title . url) as elements."
6969 (let (bookmarks-alist url title)
6970 (with-temp-buffer
6971 (insert-file-contents file)
6972 (goto-char (point-min))
6973 (while (re-search-forward "href=\\|^ *<DT><A HREF=" nil t)
6974 (forward-line 0)
6975 (when (re-search-forward url-regexp nil t)
6976 (setq url (match-string 0)))
6977 (when (re-search-forward bmk-regexp nil t)
6978 (setq title (match-string 1)))
6979 (push (cons title url) bookmarks-alist)
6980 (forward-line)))
6981 (nreverse bookmarks-alist)))
6983 (defvar anything-c-firefox-bookmarks-alist nil)
6984 (defvar anything-c-source-firefox-bookmarks
6985 '((name . "Firefox Bookmarks")
6986 (init . (lambda ()
6987 (setq anything-c-firefox-bookmarks-alist
6988 (anything-html-bookmarks-to-alist
6989 (anything-guess-firefox-bookmark-file)
6990 anything-firefox-bookmark-url-regexp
6991 anything-firefox-bookmarks-regexp))))
6992 (candidates . (lambda ()
6993 (mapcar #'car anything-c-firefox-bookmarks-alist)))
6994 (filtered-candidate-transformer
6995 anything-c-adaptive-sort
6996 anything-c-highlight-firefox-bookmarks)
6997 (action . (("Browse Url Firefox"
6998 . (lambda (candidate)
6999 (browse-url-firefox
7000 (anything-c-firefox-bookmarks-get-value candidate))))
7001 ("Browse Url w3m"
7002 . (lambda (candidate)
7003 (w3m-browse-url
7004 (anything-c-firefox-bookmarks-get-value candidate))))
7005 ("Copy Url"
7006 . (lambda (elm)
7007 (kill-new (anything-c-w3m-bookmarks-get-value elm))))))))
7009 ;; (anything 'anything-c-source-firefox-bookmarks)
7011 (defun anything-c-firefox-bookmarks-get-value (elm)
7012 (assoc-default elm anything-c-firefox-bookmarks-alist))
7014 (defun anything-c-highlight-firefox-bookmarks (bookmarks source)
7015 (loop for i in bookmarks
7016 collect (propertize
7017 i 'face '((:foreground "YellowGreen"))
7018 'help-echo (anything-c-firefox-bookmarks-get-value i))))
7022 ;;; W3m bookmark - anything interface.
7025 ;; Some users have the emacs-w3m library in load-path
7026 ;; without having the w3m executable :-;
7027 ;; So check if w3m program is present before trying to load
7028 ;; emacs-w3m.
7029 (eval-when-compile
7030 (when (executable-find "w3m")
7031 (require 'w3m-bookmark nil t)))
7033 (defvar w3m-bookmark-file "~/.w3m/bookmark.html")
7034 (defvar anything-w3m-bookmarks-regexp ">\\([^><]+.[^</a>]\\)")
7035 (defvar anything-w3m-bookmark-url-regexp "\\(https\\|http\\|ftp\\|file\\)://[^>]*")
7036 (defvar anything-c-w3m-bookmarks-alist nil)
7037 (defvar anything-c-source-w3m-bookmarks
7038 '((name . "W3m Bookmarks")
7039 (init . (lambda ()
7040 (setq anything-c-w3m-bookmarks-alist
7041 (anything-html-bookmarks-to-alist
7042 w3m-bookmark-file
7043 anything-w3m-bookmark-url-regexp
7044 anything-w3m-bookmarks-regexp))))
7045 (candidates . (lambda ()
7046 (mapcar #'car anything-c-w3m-bookmarks-alist)))
7047 (filtered-candidate-transformer
7048 anything-c-adaptive-sort
7049 anything-c-highlight-w3m-bookmarks)
7050 (action . (("Browse Url"
7051 . (lambda (candidate)
7052 (anything-c-w3m-browse-bookmark candidate)))
7053 ("Copy Url"
7054 . (lambda (elm)
7055 (kill-new (anything-c-w3m-bookmarks-get-value elm))))
7056 ("Browse Url Firefox"
7057 . (lambda (candidate)
7058 (anything-c-w3m-browse-bookmark candidate t)))
7059 ("Delete Bookmark"
7060 . (lambda (candidate)
7061 (anything-c-w3m-delete-bookmark candidate)))
7062 ("Rename Bookmark"
7063 . (lambda (candidate)
7064 (anything-c-w3m-rename-bookmark candidate)))))
7065 (persistent-action . (lambda (candidate)
7066 (if current-prefix-arg
7067 (anything-c-w3m-browse-bookmark candidate t)
7068 (anything-c-w3m-browse-bookmark candidate nil t))))
7069 (persistent-help . "Open URL with emacs-w3m in new tab / \
7070 C-u \\[anything-execute-persistent-action]: Open URL with Firefox"))
7071 "Needs w3m and emacs-w3m.
7073 http://w3m.sourceforge.net/
7074 http://emacs-w3m.namazu.org/")
7076 ;; (anything 'anything-c-source-w3m-bookmarks)
7078 (defun anything-c-w3m-bookmarks-get-value (elm)
7079 (replace-regexp-in-string
7080 "\"" "" (cdr (assoc elm anything-c-w3m-bookmarks-alist))))
7082 (defun anything-c-w3m-browse-bookmark (elm &optional use-firefox new-tab)
7083 (let* ((fn (if use-firefox 'browse-url-firefox 'w3m-browse-url))
7084 (arg (and (eq fn 'w3m-browse-url) new-tab)))
7085 (funcall fn (anything-c-w3m-bookmarks-get-value elm) arg)))
7087 (defun anything-c-highlight-w3m-bookmarks (bookmarks source)
7088 (loop for i in bookmarks
7089 collect (propertize
7090 i 'face 'anything-w3m-bookmarks-face
7091 'help-echo (anything-c-w3m-bookmarks-get-value i))))
7094 (defun anything-c-w3m-delete-bookmark (elm)
7095 "Delete w3m bookmark from `w3m-bookmark-file'."
7096 (with-current-buffer
7097 (find-file-literally w3m-bookmark-file)
7098 (goto-char (point-min))
7099 (when (re-search-forward elm nil t)
7100 (beginning-of-line)
7101 (delete-region (point)
7102 (line-end-position))
7103 (delete-blank-lines))
7104 (save-buffer)
7105 (kill-buffer)))
7107 (defun anything-c-w3m-rename-bookmark (elm)
7108 "Rename w3m bookmark in `w3m-bookmark-file'."
7109 (let* ((old-title (replace-regexp-in-string ">" "" elm))
7110 (new-title (read-string "NewTitle: " old-title)))
7111 (with-current-buffer
7112 (find-file-literally w3m-bookmark-file)
7113 (goto-char (point-min))
7114 (when (re-search-forward (concat elm "<") nil t)
7115 (goto-char (1- (point)))
7116 (delete-char (- (length old-title)))
7117 (insert new-title))
7118 (save-buffer)
7119 (kill-buffer))))
7122 ;;;; <Library>
7123 ;;; Elisp library scan
7126 (defvar anything-c-source-elisp-library-scan
7127 '((name . "Elisp libraries (Scan)")
7128 (init . (anything-c-elisp-library-scan-init))
7129 (candidates-in-buffer)
7130 (action ("Find library"
7131 . (lambda (candidate) (find-file (find-library-name candidate))))
7132 ("Find library other window"
7133 . (lambda (candidate)
7134 (find-file-other-window (find-library-name candidate))))
7135 ("Load library"
7136 . (lambda (candidate) (load-library candidate))))))
7137 ;; (anything 'anything-c-source-elisp-library-scan)
7139 (defun anything-c-elisp-library-scan-init ()
7140 "Init anything buffer status."
7141 (let ((anything-buffer (anything-candidate-buffer 'global))
7142 (library-list (anything-c-elisp-library-scan-list)))
7143 (with-current-buffer anything-buffer
7144 (dolist (library library-list)
7145 (insert (format "%s\n" library))))))
7147 (defun anything-c-elisp-library-scan-list (&optional dirs string)
7148 "Do completion for file names passed to `locate-file'.
7149 DIRS is directory to search path.
7150 STRING is string to match."
7151 ;; Use `load-path' as path when ignore `dirs'.
7152 (or dirs (setq dirs load-path))
7153 ;; Init with blank when ignore `string'.
7154 (or string (setq string ""))
7155 ;; Get library list.
7156 (let ((string-dir (file-name-directory string))
7157 ;; File regexp that suffix match `load-file-rep-suffixes'.
7158 (match-regexp (format "^.*\\.el%s$" (regexp-opt load-file-rep-suffixes)))
7159 name
7160 names)
7161 (dolist (dir dirs)
7162 (unless dir
7163 (setq dir default-directory))
7164 (if string-dir
7165 (setq dir (expand-file-name string-dir dir)))
7166 (when (file-directory-p dir)
7167 (dolist (file (file-name-all-completions
7168 (file-name-nondirectory string) dir))
7169 ;; Suffixes match `load-file-rep-suffixes'.
7170 (setq name (if string-dir (concat string-dir file) file))
7171 (if (string-match match-regexp name)
7172 (add-to-list 'names name)))))
7173 names))
7176 ;;;; <Programming>
7180 ;;; Imenu
7183 (defvar anything-c-imenu-delimiter " / ")
7185 (defvar anything-c-imenu-index-filter nil)
7186 (make-variable-buffer-local 'anything-c-imenu-index-filter)
7188 (defvar anything-c-cached-imenu-alist nil)
7189 (make-variable-buffer-local 'anything-c-cached-imenu-alist)
7191 (defvar anything-c-cached-imenu-candidates nil)
7192 (make-variable-buffer-local 'anything-c-cached-imenu-candidates)
7194 (defvar anything-c-cached-imenu-tick nil)
7195 (make-variable-buffer-local 'anything-c-cached-imenu-tick)
7197 (eval-when-compile (require 'imenu))
7198 (setq imenu-auto-rescan t)
7200 (defun anything-imenu-create-candidates (entry)
7201 "Create candidates with ENTRY."
7202 (if (listp (cdr entry))
7203 (mapcan
7204 (lambda (sub)
7205 (if (consp (cdr sub))
7206 (mapcar
7207 (lambda (subentry)
7208 (concat (car entry) anything-c-imenu-delimiter subentry))
7209 (anything-imenu-create-candidates sub))
7210 (list (concat (car entry) anything-c-imenu-delimiter (car sub)))))
7211 (cdr entry))
7212 (list entry)))
7214 (defvar anything-c-source-imenu
7215 '((name . "Imenu")
7216 (init . (lambda () (require 'imenu)))
7217 (candidates . anything-c-imenu-candidates)
7218 (persistent-action . (lambda (elm)
7219 (anything-c-imenu-default-action elm)
7220 (unless (fboundp 'semantic-imenu-tag-overlay)
7221 (anything-match-line-color-current-line))))
7222 (persistent-help . "Show this entry")
7223 (action . anything-c-imenu-default-action))
7224 "See (info \"(emacs)Imenu\")")
7226 ;; (anything 'anything-c-source-imenu)
7228 (defun anything-c-imenu-candidates ()
7229 (with-anything-current-buffer
7230 (let ((tick (buffer-modified-tick)))
7231 (if (eq anything-c-cached-imenu-tick tick)
7232 anything-c-cached-imenu-candidates
7233 (setq imenu--index-alist nil)
7234 (setq anything-c-cached-imenu-tick tick
7235 anything-c-cached-imenu-candidates
7236 (ignore-errors
7237 (mapcan
7238 'anything-imenu-create-candidates
7239 (setq anything-c-cached-imenu-alist
7240 (let ((index (imenu--make-index-alist)))
7241 (if anything-c-imenu-index-filter
7242 (funcall anything-c-imenu-index-filter index)
7243 index))))))
7244 (setq anything-c-cached-imenu-candidates
7245 (mapcar #'(lambda (x)
7246 (if (stringp x)
7248 (car x)))
7249 anything-c-cached-imenu-candidates))))))
7251 (setq imenu-default-goto-function 'imenu-default-goto-function)
7252 (defun anything-c-imenu-default-action (elm)
7253 "The default action for `anything-c-source-imenu'."
7254 (let ((path (split-string elm anything-c-imenu-delimiter))
7255 (alist anything-c-cached-imenu-alist))
7256 (dolist (elm path)
7257 (setq alist (assoc elm alist)))
7258 (imenu alist)))
7262 ;;; Ctags
7265 (defvar anything-c-ctags-modes
7266 '( c-mode c++-mode awk-mode csharp-mode java-mode javascript-mode lua-mode
7267 makefile-mode pascal-mode perl-mode cperl-mode php-mode python-mode
7268 scheme-mode sh-mode slang-mode sql-mode tcl-mode ))
7270 (defun anything-c-source-ctags-init ()
7271 (when (and buffer-file-name
7272 (memq major-mode anything-c-ctags-modes)
7273 (anything-current-buffer-is-modified))
7274 (with-current-buffer (anything-candidate-buffer 'local)
7275 (call-process-shell-command
7276 (if (string-match "\\.el\\.gz$" anything-buffer-file-name)
7277 (format "ctags -e -u -f- --language-force=lisp --fields=n =(zcat %s) "
7278 anything-buffer-file-name)
7279 (format "ctags -e -u -f- --fields=n %s " anything-buffer-file-name))
7280 nil (current-buffer))
7281 (goto-char (point-min))
7282 (forward-line 2)
7283 (delete-region (point-min) (point))
7284 (loop while (and (not (eobp)) (search-forward "\001" (point-at-eol) t))
7285 for lineno-start = (point)
7286 for lineno = (buffer-substring
7287 lineno-start
7288 (1- (search-forward "," (point-at-eol) t)))
7290 (beginning-of-line)
7291 (insert (format "%5s:" lineno))
7292 (search-forward "\177" (point-at-eol) t)
7293 (delete-region (1- (point)) (point-at-eol))
7294 (forward-line 1)))))
7296 (defvar anything-c-source-ctags
7297 '((name . "Exuberant ctags")
7298 (init . anything-c-source-ctags-init)
7299 (candidates-in-buffer)
7300 (adjust)
7301 (type . line))
7302 "Needs Exuberant Ctags.
7304 http://ctags.sourceforge.net/")
7305 ;; (anything 'anything-c-source-ctags)
7308 ;;; Etags
7311 ;; anything-etags.el is deprecated, if this file is found,
7312 ;; warn user at compile time.
7313 (eval-when-compile
7314 (when (locate-library "anything-etags.el")
7315 (display-warning
7316 '(anything-config)
7317 "You are using obsolete library `anything-etags.el' and should remove it."
7318 :warning)))
7320 (defvar anything-c-etags-tag-file-dir nil
7321 "Etags file directory.")
7322 (defvar anything-c-etags-mtime-alist nil
7323 "Store the last modification time of etags files here.")
7324 (defvar anything-c-etags-cache (make-hash-table :test 'equal)
7325 "Cache content of etags files used here for faster access.")
7327 (defun anything-c-etags-get-tag-file (&optional directory)
7328 "Return the path of etags file if found."
7329 ;; Get tag file from `default-directory' or upper directory.
7330 (let ((current-dir (anything-c-etags-find-tag-file-directory
7331 (or directory default-directory))))
7332 ;; Return nil if not find tag file.
7333 (when current-dir
7334 ;; Set tag file directory.
7335 (setq anything-c-etags-tag-file-dir current-dir)
7336 (expand-file-name anything-c-etags-tag-file-name current-dir))))
7338 (defun anything-c-etags-find-tag-file-directory (current-dir)
7339 "Try to find the directory containing tag file.
7340 If not found in CURRENT-DIR search in upper directory."
7341 (flet ((file-exists? (dir)
7342 (let ((tag-path (expand-file-name
7343 anything-c-etags-tag-file-name dir)))
7344 (and (stringp tag-path)
7345 (file-exists-p tag-path)
7346 (file-readable-p tag-path)))))
7347 (loop with count = 0
7348 until (file-exists? current-dir)
7349 ;; Return nil if outside the value of
7350 ;; `anything-c-etags-tag-file-search-limit'.
7351 if (= count anything-c-etags-tag-file-search-limit)
7352 do (return nil)
7353 ;; Or search upper directories.
7354 else
7355 do (incf count)
7356 (setq current-dir (expand-file-name (concat current-dir "../")))
7357 finally return current-dir)))
7359 (defun anything-c-source-etags-header-name (x)
7360 "Create header name for this anything etags session."
7361 (concat "Etags in "
7362 (with-anything-current-buffer
7363 (anything-c-etags-get-tag-file))))
7365 (defmacro anything-c-etags-create-buffer (file)
7366 "Create the `anything-buffer' based on contents of etags tag FILE."
7367 `(let* ((tag-fname ,file)
7369 (split (with-current-buffer (find-file-noselect tag-fname)
7370 (prog1
7371 (split-string (buffer-string) "\n" 'omit-nulls)
7372 (setq max (line-number-at-pos (point-max)))
7373 (kill-buffer))))
7374 (progress-reporter (make-progress-reporter "Loading tag file..." 0 max)))
7375 (loop
7376 with fname
7377 with cand
7378 for i in split for count from 0
7379 for elm = (unless (string-match "^\x0c" i)
7380 (anything-aif (string-match "\177" i)
7381 (substring i 0 it)
7383 do (cond ((and elm (string-match "^\\(.+\\),[0-9]+" elm))
7384 (setq fname (match-string 1 elm)))
7385 (elm (setq cand (concat fname ": " elm)))
7386 (t (setq cand nil)))
7387 when cand do (progn
7388 (insert (concat cand "\n"))
7389 (progress-reporter-update progress-reporter count)))))
7391 (defun anything-c-etags-init ()
7392 "Feed `anything-buffer' using `anything-c-etags-cache' or tag file.
7393 If no entry in cache, create one."
7394 (let ((tagfile (anything-c-etags-get-tag-file)))
7395 (when tagfile
7396 (with-current-buffer (anything-candidate-buffer 'global)
7397 (anything-aif (gethash tagfile anything-c-etags-cache)
7398 ;; An entry is present in cache, insert it.
7399 (insert it)
7400 ;; No entry, create a new buffer using content of tag file (slower).
7401 (anything-c-etags-create-buffer tagfile)
7402 ;; Store content of buffer in cache.
7403 (puthash tagfile (buffer-string) anything-c-etags-cache)
7404 ;; Store or set the last modification of tag file.
7405 (anything-aif (assoc tagfile anything-c-etags-mtime-alist)
7406 ;; If an entry exists modify it.
7407 (setcdr it (anything-c-etags-mtime tagfile))
7408 ;; No entry create a new one.
7409 (add-to-list 'anything-c-etags-mtime-alist
7410 (cons tagfile (anything-c-etags-mtime tagfile)))))))))
7412 (defvar anything-c-source-etags-select
7413 '((name . "Etags")
7414 (header-name . anything-c-source-etags-header-name)
7415 (init . anything-c-etags-init)
7416 (candidates-in-buffer)
7417 (mode-line . anything-etags-mode-line-string)
7418 (action . anything-c-etags-default-action)
7419 (persistent-action . (lambda (candidate)
7420 (anything-c-etags-default-action candidate)
7421 (anything-match-line-color-current-line))))
7422 "Anything source for Etags.")
7424 (defun anything-c-etags-default-action (candidate)
7425 "Anything default action to jump to an etags entry."
7426 (let* ((split (split-string candidate ": "))
7427 (fname (expand-file-name
7428 (car split) anything-c-etags-tag-file-dir))
7429 (elm (cadr split)))
7430 (find-file fname)
7431 (goto-char (point-min))
7432 (search-forward elm nil t)
7433 (goto-char (match-beginning 0))))
7435 (defun anything-c-etags-mtime (file)
7436 "Last modification time of etags tag FILE."
7437 (cadr (nth 5 (file-attributes file))))
7439 (defun anything-c-etags-file-modified-p (file)
7440 "Check if tag FILE have been modified in this session.
7441 If FILE is nil return nil."
7442 (let ((last-modif (and file
7443 (assoc-default file anything-c-etags-mtime-alist))))
7444 (and last-modif
7445 (/= last-modif (anything-c-etags-mtime file)))))
7449 ;;; Semantic
7452 (defvar anything-semantic-candidates nil)
7454 (defun anything-semantic-construct-candidates (tags depth)
7455 (when (require 'semantic nil t)
7456 (apply
7457 'append
7458 (mapcar
7459 (lambda (tag)
7460 (if (listp tag)
7461 (let ((type (semantic-tag-type tag))
7462 (class (semantic-tag-class tag)))
7463 (if (or (and (stringp type)
7464 (or (string= type "class")
7465 (string= type "namespace")))
7466 (eq class 'function)
7467 (eq class 'variable))
7468 (cons (cons (concat (make-string (* depth 2) ?\s)
7469 (semantic-format-tag-summarize tag nil t))
7470 tag)
7471 (anything-semantic-construct-candidates
7472 (semantic-tag-components tag) (1+ depth)))))))
7473 tags))))
7475 (defun anything-semantic-default-action (candidate)
7476 (let ((tag (cdr (assoc candidate anything-semantic-candidates))))
7477 (semantic-go-to-tag tag)))
7479 (defvar anything-c-source-semantic
7480 '((name . "Semantic Tags")
7481 (init . (lambda ()
7482 (setq anything-semantic-candidates
7483 (ignore-errors (anything-semantic-construct-candidates
7484 (semantic-fetch-tags) 0)))))
7485 (candidates . (lambda ()
7486 (if anything-semantic-candidates
7487 (mapcar 'car anything-semantic-candidates))))
7488 (persistent-action . (lambda (elm)
7489 (anything-semantic-default-action elm)
7490 (anything-match-line-color-current-line)))
7491 (persistent-help . "Show this entry")
7492 (action . anything-semantic-default-action)
7493 "Needs semantic in CEDET.
7495 http://cedet.sourceforge.net/semantic.shtml
7496 http://cedet.sourceforge.net/"))
7498 ;; (anything 'anything-c-source-semantic)
7501 ;;; Anything interface of `simple-call-tree.el'.
7503 ;; <http://www.emacswiki.org/cgi-bin/wiki/download/simple-call-tree.el>
7505 ;; Function is called by
7506 (defvar anything-c-source-simple-call-tree-functions-callers
7507 '((name . "Function is called by")
7508 (init . anything-c-simple-call-tree-functions-callers-init)
7509 (multiline)
7510 (candidates . anything-c-simple-call-tree-candidates)
7511 (persistent-action . anything-c-simple-call-tree-persistent-action)
7512 (persistent-help . "Show function definitions by rotation")
7513 (action ("Find definition selected by persistent-action" .
7514 anything-c-simple-call-tree-find-definition)))
7515 "Needs simple-call-tree.el.
7516 http://www.emacswiki.org/cgi-bin/wiki/download/simple-call-tree.el")
7518 (defvar anything-c-simple-call-tree-tick nil)
7519 (make-variable-buffer-local 'anything-c-simple-call-tree-tick)
7520 (defun anything-c-simple-call-tree-analyze-maybe ()
7521 (unless (eq (buffer-chars-modified-tick) anything-c-simple-call-tree-tick)
7522 (simple-call-tree-analyze)
7523 (setq anything-c-simple-call-tree-tick (buffer-chars-modified-tick))))
7525 (defun anything-c-simple-call-tree-init-base (function message)
7526 (require 'simple-call-tree)
7527 (with-no-warnings
7528 (when (anything-current-buffer-is-modified)
7529 (anything-c-simple-call-tree-analyze-maybe)
7530 (let ((list (funcall function simple-call-tree-alist)))
7531 (with-current-buffer (anything-candidate-buffer 'local)
7532 (dolist (entry list)
7533 (let ((funcs (concat " " (mapconcat #'identity (cdr entry) "\n "))))
7534 (insert (car entry) message
7535 (if (string= funcs " ")
7536 " no functions."
7537 funcs)
7538 "\n\n"))))))))
7540 (defun anything-c-simple-call-tree-functions-callers-init ()
7541 (anything-c-simple-call-tree-init-base 'simple-call-tree-invert
7542 " is called by\n"))
7544 (defun anything-c-simple-call-tree-candidates ()
7545 (with-current-buffer (anything-candidate-buffer)
7546 (split-string (buffer-string) "\n\n")))
7548 (defvar anything-c-simple-call-tree-related-functions nil)
7549 (defvar anything-c-simple-call-tree-function-index 0)
7550 (defun anything-c-simple-call-tree-persistent-action (candidate)
7551 (unless (eq last-command 'anything-execute-persistent-action)
7552 (setq anything-c-simple-call-tree-related-functions
7553 (delete "no functions."
7554 (split-string
7555 (replace-regexp-in-string " \\| is called by\\| calls "
7556 "" candidate)
7557 "\n")))
7558 (setq anything-c-simple-call-tree-function-index -1))
7559 (incf anything-c-simple-call-tree-function-index)
7560 (anything-c-simple-call-tree-find-definition candidate))
7562 (defun anything-c-simple-call-tree-find-definition (candidate)
7563 (find-function
7564 (intern
7565 (nth (mod anything-c-simple-call-tree-function-index
7566 (length anything-c-simple-call-tree-related-functions))
7567 anything-c-simple-call-tree-related-functions))))
7569 ;; (anything 'anything-c-source-simple-call-tree-functions-callers)
7571 ;;; Function calls
7572 (defvar anything-c-source-simple-call-tree-callers-functions
7573 '((name . "Function calls")
7574 (init . anything-c-simple-call-tree-callers-functions-init)
7575 (multiline)
7576 (candidates . anything-c-simple-call-tree-candidates)
7577 (persistent-action . anything-c-simple-call-tree-persistent-action)
7578 (persistent-help . "Show function definitions by rotation")
7579 (action ("Find definition selected by persistent-action" .
7580 anything-c-simple-call-tree-find-definition)))
7581 "Needs simple-call-tree.el.
7582 http://www.emacswiki.org/cgi-bin/wiki/download/simple-call-tree.el")
7584 (defun anything-c-simple-call-tree-callers-functions-init ()
7585 (anything-c-simple-call-tree-init-base 'identity " calls \n"))
7587 ;; (anything 'anything-c-source-simple-call-tree-callers-functions)
7591 ;;; Anything UI of auto-document.el
7593 ;; <http://www.emacswiki.org/cgi-bin/wiki/download/auto-document.el>
7595 ;; Commands/Options with doc
7596 (defvar anything-c-auto-document-data nil)
7597 (make-variable-buffer-local 'anything-c-auto-document-data)
7598 (defvar anything-c-source-commands-and-options-in-file
7599 '((name . "Commands/Options in file")
7600 (header-name
7601 . (lambda (x) (format "Commands/Options in %s"
7602 (buffer-local-value 'buffer-file-name
7603 anything-current-buffer))))
7604 (candidates . anything-command-and-options-candidates)
7605 (multiline)
7606 (action . imenu))
7607 "List Commands and Options with doc. It needs auto-document.el .
7609 http://www.emacswiki.org/cgi-bin/wiki/download/auto-document.el")
7611 (eval-when-compile (require 'auto-document nil t))
7612 (defun anything-command-and-options-candidates ()
7613 (with-anything-current-buffer
7614 (when (and (require 'auto-document nil t)
7615 (eq major-mode 'emacs-lisp-mode)
7616 (or (anything-current-buffer-is-modified)
7617 (not anything-c-auto-document-data)))
7618 (or imenu--index-alist (imenu--make-index-alist t))
7619 (setq anything-c-auto-document-data
7620 (destructuring-bind (commands options)
7621 (adoc-construct anything-current-buffer)
7622 (append
7623 (loop for (command . doc) in commands
7624 for cmdname = (symbol-name command)
7625 collect
7626 (cons
7627 (format "Command: %s\n %s"
7628 (propertize cmdname 'face font-lock-function-name-face)
7629 (adoc-first-line doc))
7630 (assoc cmdname imenu--index-alist)))
7631 (loop with var-alist = (cdr (assoc "Variables" imenu--index-alist))
7632 for (option doc default) in options
7633 for optname = (symbol-name option)
7634 collect
7635 (cons
7636 (format "Option: %s\n %s\n default = %s"
7637 (propertize optname 'face font-lock-variable-name-face)
7638 (adoc-first-line doc)
7639 (adoc-prin1-to-string default))
7640 (assoc optname
7641 var-alist)))))))
7642 anything-c-auto-document-data))
7644 ;; (anything 'anything-c-source-commands-and-options-in-file)
7647 ;;;; <Color and Face>
7650 ;;; Customize Face
7653 (defvar anything-c-source-customize-face
7654 '((name . "Customize Face")
7655 (init . (lambda ()
7656 (unless (anything-candidate-buffer)
7657 (save-window-excursion (list-faces-display))
7658 (anything-candidate-buffer (get-buffer "*Faces*")))))
7659 (candidates-in-buffer)
7660 (get-line . buffer-substring)
7661 (action . (lambda (line)
7662 (customize-face (intern (car (split-string line))))))
7663 (requires-pattern . 3))
7664 "See (info \"(emacs)Faces\")")
7665 ;; (anything 'anything-c-source-customize-face)
7667 ;;; Colors browser
7670 (defvar anything-c-source-colors
7671 '((name . "Colors")
7672 (init . (lambda () (unless (anything-candidate-buffer)
7673 (save-window-excursion (list-colors-display))
7674 (anything-candidate-buffer (get-buffer "*Colors*")))))
7675 (candidates-in-buffer)
7676 (get-line . buffer-substring)
7677 (action
7678 ("Copy Name" . (lambda (candidate)
7679 (kill-new (anything-c-colors-get-name candidate))))
7680 ("Copy RGB" . (lambda (candidate)
7681 (kill-new (anything-c-colors-get-rgb candidate))))
7682 ("Insert Name" . (lambda (candidate)
7683 (with-anything-current-buffer
7684 (insert (anything-c-colors-get-name candidate)))))
7685 ("Insert RGB" . (lambda (candidate)
7686 (with-anything-current-buffer
7687 (insert (anything-c-colors-get-rgb candidate))))))))
7688 ;; (anything 'anything-c-source-colors)
7690 (defun anything-c-colors-get-name (candidate)
7691 "Get color name."
7692 (replace-regexp-in-string
7693 " " ""
7694 (with-temp-buffer
7695 (insert (capitalize candidate))
7696 (goto-char (point-min))
7697 (search-forward-regexp "\\s-\\{2,\\}")
7698 (delete-region (point) (point-max))
7699 (buffer-string))))
7701 (defun anything-c-colors-get-rgb (candidate)
7702 "Get color RGB."
7703 (replace-regexp-in-string
7704 " " ""
7705 (with-temp-buffer
7706 (insert (capitalize candidate))
7707 (goto-char (point-max))
7708 (search-backward-regexp "\\s-\\{2,\\}")
7709 (delete-region (point) (point-min))
7710 (buffer-string))))
7713 ;;;; <Search Engine>
7714 ;;; Tracker desktop search
7715 (defvar anything-c-source-tracker-search
7716 '((name . "Tracker Search")
7717 (candidates . (lambda ()
7718 (start-process "tracker-search-process" nil
7719 "tracker-search"
7720 anything-pattern)))
7721 (type . file)
7722 (requires-pattern . 3)
7723 (delayed))
7724 "Source for retrieving files matching the current input pattern
7725 with the tracker desktop search.")
7726 ;; (anything 'anything-c-source-tracker-search)
7728 ;;; Spotlight (MacOS X desktop search)
7729 (defvar anything-c-source-mac-spotlight
7730 '((name . "mdfind")
7731 (candidates
7732 . (lambda () (start-process "mdfind-process" nil "mdfind" anything-pattern)))
7733 (type . file)
7734 (requires-pattern . 3)
7735 (delayed))
7736 "Source for retrieving files via Spotlight's command line
7737 utility mdfind.")
7738 ;; (anything 'anything-c-source-mac-spotlight)
7740 ;;; Picklist
7741 (defvar anything-c-source-picklist
7742 '((name . "Picklist")
7743 (candidates . (lambda () (mapcar 'car picklist-list)))
7744 (type . file)))
7745 ;; (anything 'anything-c-source-picklist)
7749 ;;; Kill ring
7752 (defvar anything-c-source-kill-ring
7753 '((name . "Kill Ring")
7754 (init . (lambda () (anything-attrset 'last-command last-command)))
7755 (candidates . anything-c-kill-ring-candidates)
7756 (filtered-candidate-transformer anything-c-kill-ring-transformer)
7757 (action . anything-c-kill-ring-action)
7758 (last-command)
7759 (migemo)
7760 (multiline))
7761 "Source for browse and insert contents of kill-ring.")
7763 (defun anything-c-kill-ring-candidates ()
7764 (loop for kill in (anything-fast-remove-dups kill-ring :test 'equal)
7765 unless (or (< (length kill) anything-kill-ring-threshold)
7766 (string-match "^[\\s\\t]+$" kill))
7767 collect kill))
7769 (defun anything-c-kill-ring-transformer (candidates source)
7770 "Display only the `anything-c-kill-ring-max-lines-number' lines of candidate."
7771 (loop for i in candidates
7772 for nlines = (with-temp-buffer (insert i) (count-lines (point-min) (point-max)))
7773 if (and anything-c-kill-ring-max-lines-number
7774 (> nlines anything-c-kill-ring-max-lines-number))
7775 collect (cons
7776 (with-temp-buffer
7777 (insert i)
7778 (goto-char (point-min))
7779 (concat
7780 (buffer-substring
7781 (point-min)
7782 (save-excursion
7783 (forward-line anything-c-kill-ring-max-lines-number)
7784 (point)))
7785 "[...]")) i)
7786 else collect i))
7788 (defun anything-c-kill-ring-action (str)
7789 "Insert STR in `kill-ring' and set STR to the head.
7790 If this action is executed just after `yank',
7791 replace with STR as yanked string."
7792 (setq kill-ring (delete str kill-ring))
7793 (if (not (eq (anything-attr 'last-command) 'yank))
7794 (insert-for-yank str)
7795 ;; from `yank-pop'
7796 (let ((inhibit-read-only t)
7797 (before (< (point) (mark t))))
7798 (if before
7799 (funcall (or yank-undo-function 'delete-region) (point) (mark t))
7800 (funcall (or yank-undo-function 'delete-region) (mark t) (point)))
7801 (setq yank-undo-function nil)
7802 (set-marker (mark-marker) (point) (current-buffer))
7803 (insert-for-yank str)
7804 ;; Set the window start back where it was in the yank command,
7805 ;; if possible.
7806 (set-window-start (selected-window) yank-window-start t)
7807 (if before
7808 ;; This is like exchange-point-and-mark, but doesn't activate the mark.
7809 ;; It is cleaner to avoid activation, even though the command
7810 ;; loop would deactivate the mark because we inserted text.
7811 (goto-char (prog1 (mark t)
7812 (set-marker (mark-marker) (point) (current-buffer)))))))
7813 (kill-new str))
7815 ;; (anything 'anything-c-source-kill-ring)
7818 ;;;; <Mark ring>
7819 ;; DO NOT include these sources in `anything-sources' use
7820 ;; the commands `anything-mark-ring', `anything-global-mark-ring' or
7821 ;; `anything-all-mark-rings' instead.
7823 (defun anything-c-source-mark-ring-candidates ()
7824 (flet ((get-marks (pos)
7825 (save-excursion
7826 (goto-char pos)
7827 (beginning-of-line)
7828 (let ((line (car (split-string (thing-at-point 'line) "[\n\r]"))))
7829 (when (string= "" line)
7830 (setq line "<EMPTY LINE>"))
7831 (format "%7d: %s" (line-number-at-pos) line)))))
7832 (with-anything-current-buffer
7833 (loop
7834 with marks = (if (mark) (cons (mark-marker) mark-ring) mark-ring)
7835 with recip = nil
7836 for i in marks
7837 for m = (get-marks i)
7838 unless (member m recip)
7839 collect m into recip
7840 finally return recip))))
7842 (defvar anything-mark-ring-cache nil)
7843 (defvar anything-c-source-mark-ring
7844 '((name . "mark-ring")
7845 (init . (lambda ()
7846 (setq anything-mark-ring-cache
7847 (ignore-errors (anything-c-source-mark-ring-candidates)))))
7848 (candidates . (lambda ()
7849 (anything-aif anything-mark-ring-cache
7850 it)))
7851 (action . (("Goto line"
7852 . (lambda (candidate)
7853 (anything-goto-line (string-to-number candidate))))))
7854 (persistent-action . (lambda (candidate)
7855 (anything-goto-line (string-to-number candidate))
7856 (anything-match-line-color-current-line)))
7857 (persistent-help . "Show this line")))
7859 ;; (anything 'anything-c-source-mark-ring)
7861 ;;; Global-mark-ring
7862 (defvar anything-c-source-global-mark-ring
7863 '((name . "global-mark-ring")
7864 (candidates . anything-c-source-global-mark-ring-candidates)
7865 (action . (("Goto line"
7866 . (lambda (candidate)
7867 (let ((items (split-string candidate ":")))
7868 (anything-c-switch-to-buffer (second items))
7869 (anything-goto-line (string-to-number (car items))))))))
7870 (persistent-action . (lambda (candidate)
7871 (let ((items (split-string candidate ":")))
7872 (anything-c-switch-to-buffer (second items))
7873 (anything-goto-line (string-to-number (car items)))
7874 (anything-match-line-color-current-line))))
7875 (persistent-help . "Show this line")))
7877 (defun anything-c-source-global-mark-ring-candidates ()
7878 (flet ((buf-fn (m)
7879 (with-current-buffer (marker-buffer m)
7880 (goto-char m)
7881 (beginning-of-line)
7882 (let (line)
7883 (if (string= "" line)
7884 (setq line "<EMPTY LINE>")
7885 (setq line (car (split-string (thing-at-point 'line)
7886 "[\n\r]"))))
7887 (format "%7d:%s: %s"
7888 (line-number-at-pos) (marker-buffer m) line)))))
7889 (loop
7890 with marks = global-mark-ring
7891 with recip = nil
7892 for i in marks
7893 for gm = (unless (or (string-match
7894 "^ " (format "%s" (marker-buffer i)))
7895 (null (marker-buffer i)))
7896 (buf-fn i))
7897 when (and gm (not (member gm recip)))
7898 collect gm into recip
7899 finally return recip)))
7901 ;; (anything 'anything-c-source-global-mark-ring)
7904 ;;;; <Register>
7905 ;;; Insert from register
7906 (defvar anything-c-source-register
7907 '((name . "Registers")
7908 (candidates . anything-c-register-candidates)
7909 (action-transformer . anything-c-register-action-transformer)
7910 (multiline)
7911 (action))
7912 "See (info \"(emacs)Registers\")")
7914 (defun anything-c-register-candidates ()
7915 "Collecting register contents and appropriate commands."
7916 (loop for (char . val) in register-alist
7917 for key = (single-key-description char)
7918 for string-actions =
7919 (cond
7920 ((numberp val)
7921 (list (int-to-string val)
7922 'insert-register
7923 'increment-register))
7924 ((markerp val)
7925 (let ((buf (marker-buffer val)))
7926 (if (null buf)
7927 (list "a marker in no buffer")
7928 (list (concat
7929 "a buffer position:"
7930 (buffer-name buf)
7931 ", position "
7932 (int-to-string (marker-position val)))
7933 'jump-to-register
7934 'insert-register))))
7935 ((and (consp val) (window-configuration-p (car val)))
7936 (list "window configuration."
7937 'jump-to-register))
7938 ((and (consp val) (frame-configuration-p (car val)))
7939 (list "frame configuration."
7940 'jump-to-register))
7941 ((and (consp val) (eq (car val) 'file))
7942 (list (concat "file:"
7943 (prin1-to-string (cdr val))
7944 ".")
7945 'jump-to-register))
7946 ((and (consp val) (eq (car val) 'file-query))
7947 (list (concat "file:a file-query reference: file "
7948 (car (cdr val))
7949 ", position "
7950 (int-to-string (car (cdr (cdr val))))
7951 ".")
7952 'jump-to-register))
7953 ((consp val)
7954 (let ((lines (format "%4d" (length val))))
7955 (list (format "%s: %s\n" lines
7956 (truncate-string-to-width
7957 (mapconcat 'identity (list (car val))
7958 ;; (mapconcat (lambda (y) y) val
7959 "^J") (- (window-width) 15)))
7960 'insert-register)))
7961 ((stringp val)
7962 (list ;; without properties
7963 (substring-no-properties val)
7964 'insert-register
7965 'append-to-register
7966 'prepend-to-register))
7968 "GARBAGE!"))
7969 collect (cons (format "register %3s: %s" key (car string-actions))
7970 (cons char (cdr string-actions)))))
7972 (defun anything-c-register-action-transformer (actions register-and-functions)
7973 "Decide actions by the contents of register."
7974 (loop with func-actions =
7975 '((insert-register
7976 "Insert Register" .
7977 (lambda (c) (insert-register (car c))))
7978 (jump-to-register
7979 "Jump to Register" .
7980 (lambda (c) (jump-to-register (car c))))
7981 (append-to-register
7982 "Append Region to Register" .
7983 (lambda (c) (append-to-register
7984 (car c) (region-beginning) (region-end))))
7985 (prepend-to-register
7986 "Prepend Region to Register" .
7987 (lambda (c) (prepend-to-register
7988 (car c) (region-beginning) (region-end))))
7989 (increment-register
7990 "Increment Prefix Arg to Register" .
7991 (lambda (c) (increment-register
7992 anything-current-prefix-arg (car c)))))
7993 for func in (cdr register-and-functions)
7994 for cell = (assq func func-actions)
7995 when cell
7996 collect (cdr cell)))
7998 ;; (anything 'anything-c-source-register)
8001 ;;; Latex completion
8002 (defun anything-c-latex-math-candidates ()
8003 "Collect candidates for latex math completion."
8004 (declare (special LaTeX-math-menu))
8005 (loop for i in (cddr LaTeX-math-menu)
8006 for elm = (loop for s in i when (vectorp s)
8007 collect (cons (aref s 0) (aref s 1)))
8008 append elm))
8010 (defvar anything-c-source-latex-math
8011 '((name . "Latex Math Menu")
8012 (init . (lambda ()
8013 (with-anything-current-buffer
8014 (LaTeX-math-mode 1))))
8015 (candidate-number-limit . 9999)
8016 (candidates . anything-c-latex-math-candidates)
8017 (action . (lambda (candidate)
8018 (call-interactively candidate)))))
8021 ;;;; <Headline Extraction>
8022 (defvar anything-c-source-fixme
8023 '((name . "TODO/FIXME/DRY comments")
8024 (headline . "^.*\\<\\(TODO\\|FIXME\\|DRY\\)\\>.*$")
8025 (adjust)
8026 (recenter))
8027 "Show TODO/FIXME/DRY comments in current file.")
8028 ;; (anything 'anything-c-source-fixme)
8030 (defvar anything-c-source-rd-headline
8031 '((name . "RD HeadLine")
8032 (headline "^= \\(.+\\)$" "^== \\(.+\\)$" "^=== \\(.+\\)$" "^==== \\(.+\\)$")
8033 (condition . (memq major-mode '(rdgrep-mode rd-mode)))
8034 (migemo)
8035 (subexp . 1))
8036 "Show RD headlines.
8038 RD is Ruby's POD.
8039 http://en.wikipedia.org/wiki/Ruby_Document_format")
8040 ;; (anything 'anything-c-source-rd-headline)
8042 (defvar anything-c-source-oddmuse-headline
8043 '((name . "Oddmuse HeadLine")
8044 (headline "^= \\(.+\\) =$" "^== \\(.+\\) ==$"
8045 "^=== \\(.+\\) ===$" "^==== \\(.+\\) ====$")
8046 (condition . (memq major-mode '(oddmuse-mode yaoddmuse-mode)))
8047 (migemo)
8048 (subexp . 1))
8049 "Show Oddmuse headlines, such as EmacsWiki.")
8050 ;; (anything 'anything-c-source-oddmuse-headline)
8052 (defvar anything-c-source-emacs-source-defun
8053 '((name . "Emacs Source DEFUN")
8054 (headline . "DEFUN\\|DEFVAR")
8055 (condition . (string-match "/emacs2[0-9].+/src/.+c$"
8056 (or buffer-file-name ""))))
8057 "Show DEFUN/DEFVAR in Emacs C source file.")
8058 ;; (anything 'anything-c-source-emacs-source-defun)
8060 (defvar anything-c-source-emacs-lisp-expectations
8061 '((name . "Emacs Lisp Expectations")
8062 (headline . "(desc[ ]\\|(expectations")
8063 (condition . (eq major-mode 'emacs-lisp-mode)))
8064 "Show descriptions (desc) in Emacs Lisp Expectations.
8066 http://www.emacswiki.org/cgi-bin/wiki/download/el-expectations.el")
8067 ;; (anything 'anything-c-source-emacs-lisp-expectations)
8069 (defvar anything-c-source-emacs-lisp-toplevels
8070 '((name . "Emacs Lisp Toplevel / Level 4 Comment / Linkd Star")
8071 (headline . "^(\\|(@\\*\\|^;;;;")
8072 (get-line . buffer-substring)
8073 (condition . (eq major-mode 'emacs-lisp-mode))
8074 (adjust))
8075 "Show top-level forms, level 4 comments and linkd stars (optional) in Emacs Lisp.
8076 linkd.el is optional because linkd stars are extracted by regexp.
8077 http://www.emacswiki.org/cgi-bin/wiki/download/linkd.el")
8078 ;; (anything 'anything-c-source-emacs-lisp-toplevels)
8081 ;;; Anything yaoddmuse
8083 ;; Be sure to have yaoddmuse.el installed
8084 ;; install-elisp may be required if you want to install elisp file from here.
8085 (defvar anything-yaoddmuse-use-cache-file nil)
8086 (defvar anything-c-yaoddmuse-cache-file "~/.emacs.d/yaoddmuse-cache.el")
8087 (defvar anything-c-yaoddmuse-ew-cache nil)
8089 (defun anything-yaoddmuse-get-candidates ()
8090 (declare (special yaoddmuse-pages-hash))
8091 (if anything-yaoddmuse-use-cache-file
8092 (ignore-errors
8093 (unless anything-c-yaoddmuse-ew-cache
8094 (load anything-c-yaoddmuse-cache-file)
8095 (setq anything-c-yaoddmuse-ew-cache
8096 (gethash "EmacsWiki" yaoddmuse-pages-hash)))
8097 anything-c-yaoddmuse-ew-cache)
8098 (yaoddmuse-update-pagename t)
8099 (gethash "EmacsWiki" yaoddmuse-pages-hash)))
8101 (defvar anything-c-source-yaoddmuse-emacswiki-edit-or-view
8102 '((name . "Yaoddmuse Edit or View (EmacsWiki)")
8103 (candidates . anything-yaoddmuse-get-candidates)
8104 (action . (("Edit page" . (lambda (candidate)
8105 (yaoddmuse-edit "EmacsWiki" candidate)))
8106 ("Browse page"
8107 . (lambda (candidate)
8108 (yaoddmuse-browse-page "EmacsWiki" candidate)))
8109 ("Browse page other window"
8110 . (lambda (candidate)
8111 (if (one-window-p)
8112 (split-window-vertically))
8113 (yaoddmuse-browse-page "EmacsWiki" candidate)))
8114 ("Browse diff"
8115 . (lambda (candidate)
8116 (yaoddmuse-browse-page-diff "EmacsWiki" candidate)))
8117 ("Copy URL"
8118 . (lambda (candidate)
8119 (kill-new (yaoddmuse-url "EmacsWiki" candidate))
8120 (message "Have copy page %s's URL to yank." candidate)))
8121 ("Create page"
8122 . (lambda (candidate)
8123 (yaoddmuse-edit "EmacsWiki" anything-input)))
8124 ("Update cache"
8125 . (lambda (candidate)
8126 (if anything-yaoddmuse-use-cache-file
8127 (progn
8128 (anything-yaoddmuse-cache-pages t)
8129 (setq anything-c-yaoddmuse-ew-cache
8130 (gethash "EmacsWiki" yaoddmuse-pages-hash)))
8131 (yaoddmuse-update-pagename))))))
8132 (action-transformer anything-c-yaoddmuse-action-transformer))
8133 "Needs yaoddmuse.el.
8135 http://www.emacswiki.org/emacs/download/yaoddmuse.el")
8137 ;; (anything 'anything-c-source-yaoddmuse-emacswiki-edit-or-view)
8139 (defvar anything-c-source-yaoddmuse-emacswiki-post-library
8140 '((name . "Yaoddmuse Post library (EmacsWiki)")
8141 (init . (anything-yaoddmuse-init))
8142 (candidates-in-buffer)
8143 (action . (("Post library and Browse"
8144 . (lambda (candidate)
8145 (yaoddmuse-post-file
8146 (find-library-name candidate)
8147 "EmacsWiki"
8148 (file-name-nondirectory (find-library-name candidate))
8149 nil t)))
8150 ("Post library"
8151 . (lambda (candidate)
8152 (yaoddmuse-post-file
8153 (find-library-name candidate)
8154 "EmacsWiki"
8155 (file-name-nondirectory
8156 (find-library-name candidate))))))))
8157 "Needs yaoddmuse.el.
8159 http://www.emacswiki.org/emacs/download/yaoddmuse.el")
8161 ;; (anything 'anything-c-source-yaoddmuse-emacswiki-post-library)
8163 (defun anything-c-yaoddmuse-action-transformer (actions candidate)
8164 "Allow the use of `install-elisp' only on elisp files."
8165 (if (string-match "\.el$" candidate)
8166 (append actions '(("Install Elisp"
8167 . (lambda (elm)
8168 (install-elisp-from-emacswiki elm)))))
8169 actions))
8171 ;;;###autoload
8172 (defun anything-yaoddmuse-cache-pages (&optional load)
8173 "Fetch the list of files on emacswiki and create cache file.
8174 If load is non--nil load the file and feed `yaoddmuse-pages-hash'."
8175 (interactive)
8176 (declare (special yaoddmuse-pages-hash))
8177 (yaoddmuse-update-pagename)
8178 (save-excursion
8179 (find-file anything-c-yaoddmuse-cache-file)
8180 (erase-buffer)
8181 (insert "(puthash \"EmacsWiki\" '(")
8182 (loop for i in (gethash "EmacsWiki" yaoddmuse-pages-hash)
8184 (insert (concat "(\"" (car i) "\") ")))
8185 (insert ") yaoddmuse-pages-hash)\n")
8186 (save-buffer)
8187 (kill-buffer (current-buffer))
8188 (when (or current-prefix-arg
8189 load)
8190 (load anything-c-yaoddmuse-cache-file))))
8192 (defun anything-yaoddmuse-init ()
8193 "Init anything buffer status."
8194 (let ((anything-buffer (anything-candidate-buffer 'global))
8195 (library-list (yaoddmuse-get-library-list)))
8196 (with-current-buffer anything-buffer
8197 ;; Insert library name.
8198 (dolist (library library-list)
8199 (insert (format "%s\n" library)))
8200 ;; Sort lines.
8201 (sort-lines nil (point-min) (point-max)))))
8204 ;;; Eev anchors
8205 (defvar anything-c-source-eev-anchor
8206 '((name . "Anchors")
8207 (candidates
8208 . (lambda ()
8209 (ignore-errors
8210 (with-anything-current-buffer
8211 (loop initially (goto-char (point-min))
8212 while (re-search-forward
8213 (format ee-anchor-format "\\([^\.].+\\)") nil t)
8214 for anchor = (match-string-no-properties 1)
8215 collect (cons (format "%5d:%s"
8216 (line-number-at-pos (match-beginning 0))
8217 (format ee-anchor-format anchor))
8218 anchor))))))
8219 (persistent-action . (lambda (item)
8220 (ee-to item)
8221 (anything-match-line-color-current-line)))
8222 (persistent-help . "Show this entry")
8223 (action . (("Goto link" . ee-to)))))
8224 ;; (anything 'anything-c-source-eev-anchor)
8227 ;;; Org headlines
8230 (defvar anything-c-source-org-headline
8231 '((name . "Org HeadLine")
8232 (headline "^\\*\\{1,8\\} \\(.+?\\)\\([ \t]*:[a-zA-Z0-9_@:]+:\\)?[ \t]*$")
8233 (condition . (eq major-mode 'org-mode))
8234 (migemo)
8235 (subexp . 1)
8236 (persistent-action . (lambda (elm)
8237 (anything-c-action-line-goto elm)
8238 (org-cycle)))
8239 (action-transformer
8240 . (lambda (actions candidate)
8241 '(("Go to Line" . anything-c-action-line-goto)
8242 ("Insert Link to This Headline"
8243 . anything-c-org-headline-insert-link-to-headline)))))
8244 "Show Org headlines.
8245 org-mode is very very much extended text-mode/outline-mode.
8247 See (find-library \"org.el\")
8248 See http://orgmode.org for the latest version.")
8250 (defun anything-c-org-headline-insert-link-to-headline (lineno-and-content)
8251 (insert
8252 (save-excursion
8253 (anything-goto-line (car lineno-and-content))
8254 (and (looking-at org-complex-heading-regexp)
8255 (org-make-link-string (concat "*" (match-string 4)))))))
8256 ;; (anything 'anything-c-source-org-headline)
8258 ;;; Org keywords
8261 (defvar anything-c-source-org-keywords
8262 '((name . "Org Keywords")
8263 (init . anything-c-org-keywords-init)
8264 (candidates . anything-c-org-keywords-candidates)
8265 (action . anything-c-org-keywords-insert)
8266 (persistent-action . anything-c-org-keywords-show-help)
8267 (persistent-help . "Show an example and info page to describe this keyword.")
8268 (keywords-examples)
8269 (keywords)))
8270 ;; (anything 'anything-c-source-org-keywords)
8272 (defvar anything-c-org-keywords-info-location
8273 '(("#+TITLE:" . "(org)Export options")
8274 ("#+AUTHOR:" . "(org)Export options")
8275 ("#+DATE:" . "(org)Export options")
8276 ("#+EMAIL:" . "(org)Export options")
8277 ("#+DESCRIPTION:" . "(org)Export options")
8278 ("#+KEYWORDS:" . "(org)Export options")
8279 ("#+LANGUAGE:" . "(org)Export options")
8280 ("#+TEXT:" . "(org)Export options")
8281 ("#+TEXT:" . "(org)Export options")
8282 ("#+OPTIONS:" . "(org)Export options")
8283 ("#+BIND:" . "(org)Export options")
8284 ("#+LINK_UP:" . "(org)Export options")
8285 ("#+LINK_HOME:" . "(org)Export options")
8286 ("#+LATEX_HEADER:" . "(org)Export options")
8287 ("#+EXPORT_SELECT_TAGS:" . "(org)Export options")
8288 ("#+EXPORT_EXCLUDE_TAGS:" . "(org)Export options")
8289 ("#+INFOJS_OPT" . "(org)Javascript support")
8290 ("#+BEGIN_HTML" . "(org)Quoting HTML tags")
8291 ("#+BEGIN_LaTeX" . "(org)Quoting LaTeX code")
8292 ("#+ORGTBL" . "(org)Radio tables")
8293 ("#+HTML:" . "(org)Quoting HTML tags")
8294 ("#+LaTeX:" . "(org)Quoting LaTeX code")
8295 ("#+BEGIN:" . "(org)Dynamic blocks") ;clocktable columnview
8296 ("#+BEGIN_EXAMPLE" . "(org)Literal examples")
8297 ("#+BEGIN_QUOTE" . "(org)Paragraphs")
8298 ("#+BEGIN_VERSE" . "(org)Paragraphs")
8299 ("#+BEGIN_SRC" . "(org)Literal examples")
8300 ("#+CAPTION" . "(org)Tables in HTML export")
8301 ("#+LABEL" . "(org)Tables in LaTeX export")
8302 ("#+ATTR_HTML" . "(org)Links")
8303 ("#+ATTR_LaTeX" . "(org)Images in LaTeX export")))
8305 (defun anything-c-org-keywords-init ()
8306 (unless (anything-attr 'keywords-examples)
8307 (require 'org)
8308 (anything-attrset 'keywords-examples
8309 (append
8310 (mapcar
8311 (lambda (x)
8312 (string-match "^#\\+\\(\\([A-Z_]+:?\\).*\\)" x)
8313 (cons (match-string 2 x) (match-string 1 x)))
8314 (org-split-string (org-get-current-options) "\n"))
8315 (mapcar 'list org-additional-option-like-keywords)))
8316 (anything-attrset 'keywords (mapcar 'car (anything-attr 'keywords-examples)))))
8318 (defun anything-c-org-keywords-candidates ()
8319 (and (or (eq (buffer-local-value 'major-mode anything-current-buffer) 'org-mode)
8320 (eq (buffer-local-value 'major-mode anything-current-buffer) 'message-mode))
8321 (anything-attr 'keywords)))
8323 (defun anything-c-org-keywords-insert (keyword)
8324 (cond ((and (string-match "BEGIN" keyword)
8325 (anything-region-active-p))
8326 (let ((beg (region-beginning))
8327 (end (region-end)))
8328 (goto-char end)
8329 (insert "\n#+" (replace-regexp-in-string
8330 "BEGIN" "END" keyword) "\n")
8331 (goto-char beg)
8332 (insert "#+" keyword " ")
8333 (save-excursion (insert "\n"))))
8334 ((string-match "BEGIN" keyword)
8335 (insert "#+" keyword " ")
8336 (save-excursion
8337 (insert "\n#+" (replace-regexp-in-string
8338 "BEGIN" "END" keyword) "\n")))
8339 (t (insert "#+" keyword " "))))
8341 (defun anything-c-org-keywords-show-help (keyword)
8342 (info (or (assoc-default (concat "#+" keyword) anything-c-org-keywords-info-location)
8343 "(org)In-buffer settings"))
8344 (search-forward (concat "#+" keyword) nil t)
8345 (anything-persistent-highlight-point)
8346 (message "%s" (or (cdr (assoc keyword (anything-attr 'keywords-examples))) "")))
8350 ;;; bbdb
8353 (defvar bbdb-records)
8354 (defvar bbdb-buffer-name)
8356 (defun anything-c-bbdb-candidates ()
8357 "Return a list of all names in the bbdb database. The format
8358 is \"Firstname Lastname\"."
8359 (mapcar (lambda (bbdb-record)
8360 (replace-regexp-in-string
8361 "\\s-+$" ""
8362 (concat (aref bbdb-record 0) " " (aref bbdb-record 1))))
8363 (bbdb-records)))
8365 (defun anything-c-bbdb-create-contact (actions candidate)
8366 "Action transformer that returns only an entry to add the
8367 current `anything-pattern' as new contact. All other actions are
8368 removed."
8369 (if (string= candidate "*Add to contacts*")
8370 '(("Add to contacts" . (lambda (actions)
8371 (bbdb-create-internal
8372 (read-from-minibuffer "Name: " anything-c-bbdb-name)
8373 (read-from-minibuffer "Company: ")
8374 (read-from-minibuffer "Email: ")
8377 (read-from-minibuffer "Note: ")))))
8378 actions))
8380 (defun anything-c-bbdb-get-record (candidate)
8381 "Return record that match CANDIDATE."
8382 (bbdb candidate nil)
8383 (set-buffer "*BBDB*")
8384 (bbdb-current-record))
8386 (defvar anything-c-bbdb-name nil
8387 "Only for internal use.")
8389 (defvar anything-c-source-bbdb
8390 '((name . "BBDB")
8391 (candidates . anything-c-bbdb-candidates)
8392 (action ("Send a mail" . anything-c-bbdb-compose-mail)
8393 ("View person's data" . anything-c-bbdb-view-person-action))
8394 (filtered-candidate-transformer . (lambda (candidates source)
8395 (setq anything-c-bbdb-name anything-pattern)
8396 (if (not candidates)
8397 (list "*Add to contacts*")
8398 candidates)))
8399 (action-transformer . (lambda (actions candidate)
8400 (anything-c-bbdb-create-contact actions candidate))))
8401 "Needs BBDB.
8403 http://bbdb.sourceforge.net/")
8404 ;; (anything 'anything-c-source-bbdb)
8406 (defun anything-c-bbdb-view-person-action (candidate)
8407 "View BBDB data of single CANDIDATE or marked candidates."
8408 (anything-aif (anything-marked-candidates)
8409 (let ((bbdb-append-records (length it)))
8410 (dolist (i it)
8411 (bbdb-redisplay-one-record (anything-c-bbdb-get-record i))))
8412 (bbdb-redisplay-one-record (anything-c-bbdb-get-record candidate))))
8414 (defun anything-c-bbdb-collect-mail-addresses ()
8415 "Return a list of all mail addresses of records in bbdb buffer."
8416 (with-current-buffer bbdb-buffer-name
8417 (loop for i in bbdb-records
8418 if (bbdb-record-net (car i))
8419 collect (bbdb-dwim-net-address (car i)))))
8421 (defun anything-c-bbdb-compose-mail (candidate)
8422 "Compose a mail with all records of bbdb buffer."
8423 (anything-c-bbdb-view-person-action candidate)
8424 (let* ((address-list (anything-c-bbdb-collect-mail-addresses))
8425 (address-str (mapconcat 'identity address-list ",\n ")))
8426 (compose-mail address-str)))
8429 ;;; Evaluation Result
8432 ;; Internal
8433 (defvar anything-eldoc-active-minibuffers-list nil)
8435 (defvar anything-c-source-evaluation-result
8436 '((name . "Evaluation Result")
8437 (disable-shortcuts)
8438 (dummy)
8439 (multiline)
8440 (mode-line . "C-RET: nl-and-indent, tab: reindent, C-tab:complete, C-p/n: next/prec-line.")
8441 (filtered-candidate-transformer . (lambda (candidates source)
8442 (list
8443 (condition-case nil
8444 (with-anything-current-buffer
8445 (pp-to-string
8446 (eval (read anything-pattern))))
8447 (error "Error")))))
8448 (action . (("Copy result to kill-ring" . (lambda (candidate)
8449 (with-current-buffer anything-buffer
8450 (let ((end (save-excursion
8451 (goto-char (point-max))
8452 (search-backward "\n")
8453 (point))))
8454 (kill-region (point) end)))))
8455 ("copy sexp to kill-ring" . (lambda (candidate)
8456 (kill-new anything-input)))))))
8457 ;; (anything 'anything-c-source-evaluation-result)
8459 (defun anything-eval-new-line-and-indent ()
8460 (interactive)
8461 (newline) (lisp-indent-line))
8463 (defun anything-eldoc-store-minibuffer ()
8464 "Store minibuffer buffer name in `anything-eldoc-active-minibuffers-list'."
8465 (with-selected-window (minibuffer-window)
8466 (push (buffer-name) anything-eldoc-active-minibuffers-list)))
8468 (defun anything-eldoc-show-in-eval ()
8469 "Return eldoc in mode-line for current minibuffer input."
8470 (let ((buf (with-selected-window (minibuffer-window)
8471 (buffer-name))))
8472 (when (member buf anything-eldoc-active-minibuffers-list)
8473 (let* ((str-all (with-current-buffer buf
8474 (minibuffer-completion-contents)))
8475 (sym (when str-all
8476 (with-temp-buffer
8477 (insert str-all)
8478 (goto-char (point-max))
8479 (unless (looking-back ")\\|\"") (forward-char -1))
8480 (eldoc-current-symbol))))
8481 (info-fn (eldoc-fnsym-in-current-sexp))
8482 (doc (or (eldoc-get-var-docstring sym)
8483 (eldoc-get-fnsym-args-string
8484 (car info-fn) (cadr info-fn)))))
8485 (when doc (funcall anything-c-eldoc-in-minibuffer-show-fn doc))))))
8487 (defun anything-c-eldoc-show-in-mode-line (str)
8488 "Show string STR in mode-line."
8489 (save-window-excursion
8490 (with-current-buffer anything-buffer
8491 (let ((mode-line-format (concat " " str)))
8492 (force-mode-line-update)
8493 (sit-for anything-c-eldoc-show-in-mode-line-delay))
8494 (force-mode-line-update))))
8496 ;;; Calculation Result
8499 (defvar anything-c-source-calculation-result
8500 '((name . "Calculation Result")
8501 (dummy)
8502 (filtered-candidate-transformer . (lambda (candidates source)
8503 (list
8504 (condition-case nil
8505 (calc-eval anything-pattern)
8506 (error "error")))))
8507 (action ("Copy result to kill-ring" . kill-new))))
8508 ;; (anything 'anything-c-source-calculation-result)
8511 ;;; Google Suggestions
8514 ;; Internal
8515 (defvar anything-ggs-max-length-real-flag 0)
8516 (defvar anything-ggs-max-length-num-flag 0)
8518 (defun anything-c-google-suggest-fetch (input)
8519 "Fetch suggestions for INPUT from XML buffer.
8520 Return an alist with elements like (data . number_results)."
8521 (setq anything-ggs-max-length-real-flag 0
8522 anything-ggs-max-length-num-flag 0)
8523 (let ((request (concat anything-c-google-suggest-url
8524 (url-hexify-string input))))
8525 (flet ((fetch ()
8526 (loop
8527 with result-alist = (xml-get-children
8528 (car (xml-parse-region
8529 (point-min) (point-max)))
8530 'CompleteSuggestion)
8531 for i in result-alist
8532 for data = (cdr (caadr (assoc 'suggestion i)))
8533 for nqueries = (cdr (caadr (assoc 'num_queries i)))
8534 for lqueries = (length (anything-c-ggs-set-number-result
8535 nqueries))
8536 for ldata = (length data)
8538 (progn
8539 (when (> ldata anything-ggs-max-length-real-flag)
8540 (setq anything-ggs-max-length-real-flag ldata))
8541 (when (> lqueries anything-ggs-max-length-num-flag)
8542 (setq anything-ggs-max-length-num-flag lqueries)))
8543 collect (cons data nqueries) into cont
8544 finally return cont)))
8545 (if anything-google-suggest-use-curl-p
8546 (with-temp-buffer
8547 (call-process "curl" nil t nil request)
8548 (fetch))
8549 (with-current-buffer
8550 (url-retrieve-synchronously request)
8551 (fetch))))))
8553 (defun anything-c-google-suggest-set-candidates (&optional request-prefix)
8554 "Set candidates with result and number of google results found."
8555 (let ((suggestions
8556 (loop with suggested-results = (anything-c-google-suggest-fetch
8557 (or (and request-prefix
8558 (concat request-prefix " " anything-pattern))
8559 anything-pattern))
8560 for (real . numresult) in suggested-results
8561 ;; Prepare number of results with ","
8562 for fnumresult = (anything-c-ggs-set-number-result numresult)
8563 ;; Calculate number of spaces to add before fnumresult
8564 ;; if it is smaller than longest result
8565 ;; `anything-ggs-max-length-num-flag'.
8566 ;; e.g 1,234,567
8567 ;; 345,678
8568 ;; To be sure it is aligned properly.
8569 for nspaces = (if (< (length fnumresult) anything-ggs-max-length-num-flag)
8570 (- anything-ggs-max-length-num-flag (length fnumresult))
8572 ;; Add now the spaces before fnumresult.
8573 for align-fnumresult = (concat (make-string nspaces ? ) fnumresult)
8574 for interval = (- anything-ggs-max-length-real-flag (length real))
8575 for spaces = (make-string (+ 2 interval) ? )
8576 for display = (format "%s%s(%s results)" real spaces align-fnumresult)
8577 collect (cons display real))))
8578 (if (loop for (disp . dat) in suggestions
8579 thereis (equal dat anything-pattern))
8580 suggestions
8581 ;; if there is no suggestion exactly matching the input then
8582 ;; prepend a Search on Google item to the list
8583 (append
8584 suggestions
8585 (list (cons (concat "Search for " "'" anything-input "'" " on Google")
8586 anything-input))))))
8588 (defun anything-c-ggs-set-number-result (num)
8589 (if num
8590 (progn
8591 (and (numberp num) (setq num (number-to-string num)))
8592 (loop for i in (reverse (split-string num "" t))
8593 for count from 1
8594 append (list i) into C
8595 when (= count 3)
8596 append (list ",") into C
8597 and do (setq count 0)
8598 finally return
8599 (replace-regexp-in-string
8600 "^," "" (mapconcat 'identity (reverse C) ""))))
8601 "?"))
8603 (defvar anything-c-google-suggest-default-browser-function nil
8604 "*The browse url function you prefer to use with google suggest.
8605 When nil, use the first browser function available
8606 See `anything-browse-url-default-browser-alist'.")
8608 (defun anything-c-google-suggest-action (candidate)
8609 "Default action to jump to a google suggested candidate."
8610 (let ((arg (concat anything-c-google-suggest-search-url
8611 (url-hexify-string candidate))))
8612 (anything-aif anything-c-google-suggest-default-browser-function
8613 (funcall it arg)
8614 (anything-c-browse-url arg))))
8616 (defvar anything-c-google-suggest-default-function
8617 'anything-c-google-suggest-set-candidates
8618 "Default function to use in anything google suggest.")
8620 (defvar anything-c-source-google-suggest
8621 '((name . "Google Suggest")
8622 (candidates . (lambda ()
8623 (funcall anything-c-google-suggest-default-function)))
8624 (action . (("Google Search" . anything-c-google-suggest-action)))
8625 (volatile)
8626 (requires-pattern . 3)
8627 (delayed)))
8629 (defun anything-c-google-suggest-emacs-lisp ()
8630 "Try to emacs lisp complete with google suggestions."
8631 (anything-c-google-suggest-set-candidates "emacs lisp"))
8633 ;; (anything 'anything-c-source-google-suggest)
8635 ;;; Yahoo suggestions
8638 (defun anything-c-yahoo-suggest-fetch (input)
8639 "Fetch Yahoo suggestions for INPUT from XML buffer.
8640 Return an alist with elements like (data . number_results)."
8641 (let ((request (concat anything-c-yahoo-suggest-url
8642 (url-hexify-string input))))
8643 (flet ((fetch ()
8644 (loop
8645 with result-alist = (xml-get-children
8646 (car (xml-parse-region (point-min) (point-max)))
8647 'Result)
8648 for i in result-alist
8649 collect (caddr i))))
8650 (with-current-buffer
8651 (url-retrieve-synchronously request)
8652 (fetch)))))
8654 (defun anything-c-yahoo-suggest-set-candidates ()
8655 "Set candidates with Yahoo results found."
8656 (let ((suggestions (anything-c-yahoo-suggest-fetch anything-input)))
8657 (or suggestions
8658 (append
8659 suggestions
8660 (list (cons (concat "Search for " "'" anything-input "'" " on Yahoo")
8661 anything-input))))))
8663 (defun anything-c-yahoo-suggest-action (candidate)
8664 "Default action to jump to a Yahoo suggested candidate."
8665 (anything-c-browse-url (concat anything-c-yahoo-suggest-search-url
8666 (url-hexify-string candidate))))
8668 (defvar anything-c-source-yahoo-suggest
8669 '((name . "Yahoo Suggest")
8670 (candidates . anything-c-yahoo-suggest-set-candidates)
8671 (action . (("Yahoo Search" . anything-c-yahoo-suggest-action)))
8672 (volatile)
8673 (requires-pattern . 3)
8674 (delayed)))
8676 ;; (anything 'anything-c-source-yahoo-suggest)
8679 ;;; Web browser functions.
8682 (require 'browse-url)
8683 ;; If default setting of `w3m-command' is not
8684 ;; what you want you and you modify it, you will have to reeval
8685 ;; also `anything-browse-url-default-browser-alist'.
8686 (defvar w3m-command "/usr/bin/w3m")
8687 (defvar anything-c-home-url "http://www.google.fr"
8688 "*Default url to use as home url.")
8690 (defvar browse-url-chromium-program "chromium-browser")
8691 (defvar browse-url-uzbl-program "uzbl-browser")
8692 (defvar anything-browse-url-default-browser-alist
8693 `((,w3m-command . w3m-browse-url)
8694 (,browse-url-firefox-program . browse-url-firefox)
8695 (,browse-url-chromium-program . browse-url-chromium)
8696 (,browse-url-uzbl-program . browse-url-uzbl)
8697 (,browse-url-kde-program . browse-url-kde)
8698 (,browse-url-gnome-moz-program . browse-url-gnome-moz)
8699 (,browse-url-mozilla-program . browse-url-mozilla)
8700 (,browse-url-galeon-program . browse-url-galeon)
8701 (,browse-url-netscape-program . browse-url-netscape)
8702 (,browse-url-mosaic-program . browse-url-mosaic)
8703 (,browse-url-xterm-program . browse-url-text-xterm))
8704 "*Alist of (executable . function) to try to find a suitable url browser.")
8706 (defun* anything-c-generic-browser (url name &rest args)
8707 "Browse URL with NAME browser."
8708 (let ((proc (concat name " " url)))
8709 (message "Starting %s..." name)
8710 (apply 'start-process proc nil name
8711 (append args (list url)))
8712 (set-process-sentinel
8713 (get-process proc)
8714 #'(lambda (process event)
8715 (when (string= event "finished\n")
8716 (message "%s process %s" process event))))))
8718 (defun browse-url-chromium (url)
8719 "Browse URL with google chrome browser."
8720 (interactive "sURL: ")
8721 (anything-c-generic-browser
8722 url browse-url-chromium-program))
8724 (defun browse-url-uzbl (url &optional ignore)
8725 "Browse URL with uzbl browser."
8726 (interactive "sURL: ")
8727 (anything-c-generic-browser url browse-url-uzbl-program "-u"))
8729 (defun anything-browse-url-default-browser (url &rest args)
8730 "Find the first available browser and ask it to load URL."
8731 (let ((default-browser-fn
8732 (loop for (exe . fn) in anything-browse-url-default-browser-alist
8733 thereis (and exe (executable-find exe) fn))))
8734 (if default-browser-fn
8735 (apply default-browser-fn url args)
8736 (error "No usable browser found"))))
8738 (defun* anything-c-browse-url (&optional (url anything-c-home-url))
8739 "Default command to browse URL."
8740 (if browse-url-browser-function
8741 (browse-url url)
8742 (anything-browse-url-default-browser url)))
8745 ;;; Surfraw
8747 ;; Need external program surfraw.
8748 ;; <http://surfraw.alioth.debian.org/>
8750 (defvar anything-surfraw-default-browser-function nil
8751 "*The browse url function you prefer to use with surfraw.
8752 When nil, fallback to `browse-url-browser-function'.")
8754 ;; Internal
8755 (defvar anything-surfraw-engines-history nil)
8757 (defun anything-c-build-elvi-list ()
8758 "Return list of all engines and descriptions handled by surfraw."
8759 (cdr
8760 (with-temp-buffer
8761 (call-process "surfraw" nil t nil
8762 "-elvi")
8763 (split-string (buffer-string) "\n"))))
8766 ;;; Emms
8769 (defun anything-emms-stream-edit-bookmark (elm)
8770 "Change the information of current emms-stream bookmark from anything."
8771 (declare (special emms-stream-list))
8772 (let* ((cur-buf anything-current-buffer)
8773 (bookmark (assoc elm emms-stream-list))
8774 (name (read-from-minibuffer "Description: "
8775 (nth 0 bookmark)))
8776 (url (read-from-minibuffer "URL: "
8777 (nth 1 bookmark)))
8778 (fd (read-from-minibuffer "Feed Descriptor: "
8779 (int-to-string (nth 2 bookmark))))
8780 (type (read-from-minibuffer "Type (url, streamlist, or lastfm): "
8781 (format "%s" (car (last bookmark))))))
8782 (save-excursion
8783 (emms-streams)
8784 (when (re-search-forward (concat "^" name) nil t)
8785 (beginning-of-line)
8786 (emms-stream-delete-bookmark)
8787 (emms-stream-add-bookmark name url (string-to-number fd) type)
8788 (emms-stream-save-bookmarks-file)
8789 (emms-stream-quit)
8790 (anything-c-switch-to-buffer cur-buf)))))
8792 (defun anything-emms-stream-delete-bookmark (elm)
8793 "Delete an emms-stream bookmark from anything."
8794 (let* ((cur-buf anything-current-buffer)
8795 (bookmark (assoc elm emms-stream-list))
8796 (name (nth 0 bookmark)))
8797 (save-excursion
8798 (emms-streams)
8799 (when (re-search-forward (concat "^" name) nil t)
8800 (beginning-of-line)
8801 (emms-stream-delete-bookmark)
8802 (emms-stream-save-bookmarks-file)
8803 (emms-stream-quit)
8804 (anything-c-switch-to-buffer cur-buf)))))
8806 (defvar anything-c-source-emms-streams
8807 '((name . "Emms Streams")
8808 (init . (lambda ()
8809 (emms-stream-init)))
8810 (candidates . (lambda ()
8811 (declare (special emms-stream-list))
8812 (mapcar 'car emms-stream-list)))
8813 (action . (("Play" . (lambda (elm)
8814 (declare (special emms-stream-list))
8815 (let* ((stream (assoc elm emms-stream-list))
8816 (fn (intern (concat "emms-play-" (symbol-name (car (last stream))))))
8817 (url (second stream)))
8818 (funcall fn url))))
8819 ("Delete" . anything-emms-stream-delete-bookmark)
8820 ("Edit" . anything-emms-stream-edit-bookmark)))
8821 (filtered-candidate-transformer . anything-c-adaptive-sort)))
8822 ;; (anything 'anything-c-source-emms-streams)
8824 ;; Don't forget to set `emms-source-file-default-directory'
8825 (defvar anything-c-source-emms-dired
8826 '((name . "Music Directory")
8827 (candidates . (lambda ()
8828 (cddr (directory-files emms-source-file-default-directory))))
8829 (action .
8830 (("Play Directory" . (lambda (item)
8831 (emms-play-directory
8832 (expand-file-name
8833 item
8834 emms-source-file-default-directory))))
8835 ("Open dired in file's directory" . (lambda (item)
8836 (anything-c-open-dired
8837 (expand-file-name
8838 item
8839 emms-source-file-default-directory))))))
8840 (filtered-candidate-transformer . anything-c-adaptive-sort)))
8841 ;; (anything 'anything-c-source-emms-dired)
8844 (defun anything-c-emms-files-modifier (candidates source)
8845 (let ((current-playlist (with-current-emms-playlist
8846 (loop
8847 with cur-list = (emms-playlist-tracks-in-region
8848 (point-min) (point-max))
8849 for i in cur-list
8850 collect (assoc-default 'name i)))))
8851 (loop for i in candidates
8852 if (member (cdr i) current-playlist)
8853 collect (cons (propertize (car i)
8854 'face 'anything-emms-playlist)
8855 (cdr i)) into lis
8856 else collect i into lis
8857 finally return lis)))
8859 (defun anything-c-emms-play-current-playlist ()
8860 "Play current playlist."
8861 (with-current-emms-playlist
8862 (emms-playlist-first)
8863 (emms-playlist-mode-play-smart)))
8865 (defvar anything-c-source-emms-files
8866 '((name . "Emms files")
8867 (candidates . (lambda ()
8868 (loop for v being the hash-values in emms-cache-db
8869 for name = (assoc-default 'name v)
8870 for artist = (or (assoc-default 'info-artist v) "unknown")
8871 for genre = (or (assoc-default 'info-genre v) "unknown")
8872 for tracknum = (or (assoc-default 'info-tracknumber v) "unknown")
8873 for song = (or (assoc-default 'info-title v) "unknown")
8874 for info = (concat artist " - " genre " - " tracknum ": " song)
8875 unless (string-match "^http:" name) collect (cons info name))))
8876 (filtered-candidate-transformer . anything-c-emms-files-modifier)
8877 (action . (("Play file" . emms-play-file)
8878 ("Add to Playlist and play (C-u clear current)"
8879 . (lambda (candidate)
8880 (when anything-current-prefix-arg
8881 (emms-playlist-current-clear))
8882 (emms-playlist-new)
8883 (mapc 'emms-add-playlist-file (anything-marked-candidates))
8884 (unless emms-player-playing-p
8885 (anything-c-emms-play-current-playlist))))))))
8887 ;; (anything 'anything-c-source-emms-files)
8890 ;;; Jabber Contacts (jabber.el)
8891 (defun anything-c-jabber-online-contacts ()
8892 "List online Jabber contacts."
8893 (with-no-warnings
8894 (let (jids)
8895 (dolist (item (jabber-concat-rosters) jids)
8896 (when (get item 'connected)
8897 (push (if (get item 'name)
8898 (cons (get item 'name) item)
8899 (cons (symbol-name item) item)) jids))))))
8901 (defvar anything-c-source-jabber-contacts
8902 '((name . "Jabber Contacts")
8903 (init . (lambda () (require 'jabber)))
8904 (candidates . (lambda () (mapcar 'car (anything-c-jabber-online-contacts))))
8905 (action . (lambda (x)
8906 (jabber-chat-with
8907 (jabber-read-account)
8908 (symbol-name
8909 (cdr (assoc x (anything-c-jabber-online-contacts)))))))))
8910 ;; (anything 'anything-c-source-jabber-contacts)
8914 ;;; Call source.
8915 (defvar anything-source-select-buffer "*anything source select*")
8916 (defvar anything-c-source-call-source
8917 `((name . "Call anything source")
8918 (candidate-number-limit)
8919 (candidates
8920 . (lambda ()
8921 (loop for vname in (all-completions "anything-c-source-" obarray)
8922 for var = (intern vname)
8923 for name = (ignore-errors (assoc-default 'name (symbol-value var)))
8924 if name collect
8925 (cons (format "%s `%s'"
8926 name (propertize vname 'face 'font-lock-variable-name-face))
8927 var))))
8928 (action
8929 . (("Invoke anything with selected source"
8931 (lambda (candidate)
8932 (setq anything-candidate-number-limit 9999)
8933 (anything candidate nil nil nil nil
8934 anything-source-select-buffer)))
8935 ("Describe variable" . describe-variable)
8936 ("Find variable" . find-variable)))
8937 (persistent-action . describe-variable)
8938 (persistent-help . "Show description of this source")))
8939 ;; (anything 'anything-c-source-call-source)
8941 (defun anything-call-source-from-anything ()
8942 "Call anything source within `anything' session."
8943 (interactive)
8944 (setq anything-input-idle-delay 0)
8945 (anything-set-sources '(anything-c-source-call-source)))
8947 ;;; Execute Preconfigured anything.
8948 (defvar anything-c-source-anything-commands
8949 '((name . "Preconfigured Anything")
8950 (candidates . anything-c-anything-commands-candidates)
8951 (type . command)
8952 (candidate-number-limit)))
8953 ;; (anything 'anything-c-source-anything-commands)
8955 (defun anything-c-anything-commands-candidates ()
8956 (loop for (cmd . desc) in (anything-c-list-preconfigured-anything)
8957 collect (cons (if (where-is-internal cmd nil t)
8958 (substitute-command-keys (format "M-x %s (\\[%s]) : %s" cmd cmd desc))
8959 (substitute-command-keys (format "\\[%s] : %s" cmd desc)))
8960 cmd)))
8963 ;;; Occur
8966 (defun anything-c-occur-init ()
8967 "Create the initial anything occur buffer.
8968 If region is active use region as buffer contents
8969 instead of whole buffer."
8970 (with-current-buffer (anything-candidate-buffer 'global)
8971 (erase-buffer)
8972 (let ((buf-contents
8973 (with-anything-current-buffer
8974 (if (anything-region-active-p)
8975 (buffer-substring (region-beginning) (region-end))
8976 (buffer-substring (point-min) (point-max))))))
8977 (insert buf-contents))))
8979 (defun anything-c-occur-get-line (s e)
8980 (format "%7d:%s" (line-number-at-pos (1- s)) (buffer-substring s e)))
8982 (defun anything-c-occur-query-replace-regexp (candidate)
8983 "Query replace regexp starting from CANDIDATE.
8984 If region is active ignore CANDIDATE and replace only in region.
8985 With a prefix arg replace only matches surrounded by word boundaries,
8986 i.e Don't replace inside a word, regexp is surrounded with \\bregexp\\b."
8987 (let ((regexp anything-input))
8988 (unless (anything-region-active-p)
8989 (anything-c-action-line-goto candidate))
8990 (apply 'query-replace-regexp
8991 (anything-c-query-replace-args regexp))))
8993 (defvar anything-c-source-occur
8994 '((name . "Occur")
8995 (init . anything-c-occur-init)
8996 (candidates-in-buffer)
8997 (migemo)
8998 (get-line . anything-c-occur-get-line)
8999 (display-to-real . anything-c-display-to-real-line)
9000 (action . (("Go to Line" . anything-c-action-line-goto)
9001 ("Query replace regexp (C-u Not inside word.)"
9002 . anything-c-occur-query-replace-regexp)))
9003 (recenter)
9004 (requires-pattern . 1)
9005 (delayed)
9006 (volatile)))
9007 ;; (anything 'anything-c-source-occur)
9010 ;;; Anything browse code.
9011 (defun anything-c-browse-code-get-line (beg end)
9012 "Select line if it match the regexp corresponding to current `major-mode'.
9013 Line is parsed for BEG position to END position."
9014 (let ((str-line (buffer-substring beg end))
9015 (regexp (assoc-default major-mode
9016 anything-c-browse-code-regexp-alist))
9017 (num-line (if (string= anything-pattern "") beg (1- beg))))
9018 (when (and regexp (string-match regexp str-line))
9019 (format "%4d:%s" (line-number-at-pos num-line) str-line))))
9022 (defvar anything-c-source-browse-code
9023 '((name . "Browse code")
9024 (init . (lambda ()
9025 (anything-candidate-buffer anything-current-buffer)
9026 (with-anything-current-buffer
9027 (jit-lock-fontify-now))))
9028 (candidate-number-limit . 9999)
9029 (candidates-in-buffer)
9030 (get-line . anything-c-browse-code-get-line)
9031 (type . line)
9032 (recenter)))
9035 ;; Do many actions for input
9036 (defvar anything-c-source-create
9037 '((name . "Create")
9038 (dummy)
9039 (action)
9040 (action-transformer . anything-create--actions))
9041 "Do many create actions from `anything-pattern'.
9042 See also `anything-create--actions'.")
9043 ;; (anything 'anything-c-source-create)
9045 (defun anything-create-from-anything ()
9046 "Run `anything-create' from `anything' as a fallback."
9047 (interactive)
9048 (anything-run-after-quit 'anything-create nil anything-pattern))
9050 (defun anything-create--actions (&rest ignored)
9051 "Default actions for `anything-create' / `anything-c-source-create'."
9052 (remove-if-not
9053 (lambda (pair) (and (consp pair) (functionp (cdr pair))))
9054 (append anything-create--actions-private
9055 '(("find-file" . find-file)
9056 ("find-file other window" . find-file-other-window)
9057 ("New buffer" . anything-c-switch-to-buffer)
9058 ("New buffer other window" . switch-to-buffer-other-window)
9059 ("Bookmark Set" . bookmark-set)
9060 ("Set Register" .
9061 (lambda (x) (set-register (read-char "Register: ") x)))
9062 ("Insert Linkd star" . linkd-insert-star)
9063 ("Insert Linkd Tag" . linkd-insert-tag)
9064 ("Insert Linkd Link" . linkd-insert-link)
9065 ("Insert Linkd Lisp" . linkd-insert-lisp)
9066 ("Insert Linkd Wiki" . linkd-insert-wiki)
9067 ("Google Search" . google)))))
9070 ;; Minibuffer History
9073 (defvar anything-c-source-minibuffer-history
9074 '((name . "Minibuffer History")
9075 (header-name . (lambda (name) (format "%s (%s)" name minibuffer-history-variable)))
9076 (candidates
9077 . (lambda ()
9078 (let ((history (loop
9079 for i in (symbol-value minibuffer-history-variable)
9080 unless (string= "" i) collect i)))
9081 (if (consp (car history))
9082 (mapcar 'prin1-to-string history)
9083 history))))
9084 (migemo)
9085 (action . insert)))
9086 ;; (anything 'anything-c-source-minibuffer-history)
9089 ;;; Elscreen
9092 (defvar anything-c-source-elscreen
9093 '((name . "Elscreen")
9094 (candidates . (lambda ()
9095 (if (cdr (elscreen-get-screen-to-name-alist))
9096 (sort
9097 (loop for sname in (elscreen-get-screen-to-name-alist)
9098 append (list (format "[%d] %s" (car sname) (cdr sname))) into lst
9099 finally (return lst))
9100 #'(lambda (a b) (compare-strings a nil nil b nil nil))))))
9101 (action . (("Change Screen".
9102 (lambda (candidate)
9103 (elscreen-goto (- (aref candidate 1) (aref "0" 0)))))
9104 ("Kill Screen(s)".
9105 (lambda (candidate)
9106 (dolist (i (anything-marked-candidates))
9107 (elscreen-goto (- (aref i 1) (aref "0" 0)))
9108 (elscreen-kill))))
9109 ("Only Screen".
9110 (lambda (candidate)
9111 (elscreen-goto (- (aref candidate 1) (aref "0" 0)))
9112 (elscreen-kill-others)))))))
9113 ;; (anything 'anything-c-source-elscreen)
9116 ;;;; <System>
9118 ;;; Top (process)
9119 (defvar anything-c-top-command "COLUMNS=%s top -b -n 1"
9120 "Top command (batch mode). %s is replaced with `frame-width'.")
9121 (defvar anything-c-source-top
9122 '((name . "Top (Press C-c C-u to refresh)")
9123 (init . anything-c-top-init)
9124 (candidates-in-buffer)
9125 (display-to-real . anything-c-top-display-to-real)
9126 (update . anything-c-top-update)
9127 (persistent-action . anything-c-top-sh-persistent-action)
9128 (persistent-help . "SIGTERM")
9129 (action
9130 ("kill (TERM)" . (lambda (pid) (anything-c-top-sh (format "kill -TERM %s" pid))))
9131 ("kill (KILL)" . (lambda (pid) (anything-c-top-sh (format "kill -KILL %s" pid))))
9132 ("Copy PID" . (lambda (pid) (kill-new pid))))))
9133 ;; (anything 'anything-c-source-top)
9135 (defun anything-c-top-sh (cmd)
9136 (message "Executed %s\n%s" cmd (shell-command-to-string cmd)))
9138 (defun anything-c-top-sh-persistent-action (pid)
9139 (delete-other-windows)
9140 (anything-c-top-sh (format "kill -TERM %s" pid))
9141 (anything-force-update))
9143 (defun anything-c-top-init ()
9144 (with-current-buffer (anything-candidate-buffer 'global)
9145 (call-process-shell-command
9146 (format anything-c-top-command
9147 (- (frame-width) (if anything-enable-digit-shortcuts 4 0)))
9148 nil (current-buffer))))
9150 (defun anything-c-top-display-to-real (line)
9151 (car (split-string line)))
9153 (defun anything-c-top-update ()
9154 (let ((anything-source-name (assoc-default 'name anything-c-source-top))) ;UGLY HACK
9155 (anything-c-top-init)))
9157 ;;; Timers
9158 (defvar anything-c-source-absolute-time-timers
9159 '((name . "Absolute Time Timers")
9160 (candidates . timer-list)
9161 (type . timer)))
9162 ;; (anything 'anything-c-source-absolute-time-timers)
9164 (defvar anything-c-source-idle-time-timers
9165 '((name . "Idle Time Timers")
9166 (candidates . timer-idle-list)
9167 (type . timer)))
9168 ;; (anything 'anything-c-source-idle-time-timers)
9170 (defun anything-c-timer-real-to-display (timer)
9171 (destructuring-bind (triggered t1 t2 t3 repeat-delay func args idle-delay)
9172 (append timer nil) ;use `append' to convert vector->list
9173 (format "%s repeat=%5S %s(%s)"
9174 (let ((time (list t1 t2 t3)))
9175 (if idle-delay
9176 (format-time-string "idle-for=%5s" time)
9177 (format-time-string "%m/%d %T" time)))
9178 repeat-delay
9179 func
9180 (mapconcat 'prin1-to-string args " "))))
9182 ;;; X RandR resolution change
9183 ;;; FIXME I do not care multi-display.
9184 (defvar anything-c-xrandr-output "VGA")
9185 (defvar anything-c-xrandr-screen "0")
9186 (defvar anything-c-source-xrandr-change-resolution
9187 '((name . "Change Resolution")
9188 (candidates
9189 . (lambda ()
9190 (with-temp-buffer
9191 (call-process "xrandr" nil (current-buffer) nil
9192 "--screen" anything-c-xrandr-screen "-q")
9193 (goto-char 1)
9194 (loop while (re-search-forward " \\([0-9]+x[0-9]+\\)" nil t)
9195 collect (match-string 1)))))
9196 (action
9197 ("Change Resolution" . (lambda (mode)
9198 (call-process "xrandr" nil nil nil
9199 "--screen" anything-c-xrandr-screen
9200 "--output" anything-c-xrandr-output
9201 "--mode" mode))))))
9202 ;; (anything 'anything-c-source-xrandr-change-resolution)
9204 ;;; Xfont selection
9207 (defun anything-c-persistent-xfont-action (elm)
9208 "Show current font temporarily"
9209 (let ((current-font (cdr (assoc 'font (frame-parameters))))
9210 (default-font elm))
9211 (unwind-protect
9212 (progn (set-frame-font default-font 'keep-size) (sit-for 2))
9213 (set-frame-font current-font))))
9215 (defvar anything-c-xfonts-cache nil)
9216 (defvar anything-c-source-xfonts
9217 '((name . "X Fonts")
9218 (init . (lambda ()
9219 (unless anything-c-xfonts-cache
9220 (setq anything-c-xfonts-cache
9221 (x-list-fonts "*")))))
9222 (candidates . anything-c-xfonts-cache)
9223 (action . (("Copy to kill ring" . (lambda (elm)
9224 (kill-new elm)))
9225 ("Set Font" . (lambda (elm)
9226 (kill-new elm)
9227 (set-frame-font elm 'keep-size)
9228 (message "New font have been copied to kill ring")))))
9229 (persistent-action . anything-c-persistent-xfont-action)
9230 (persistent-help . "Switch to this font temporarily")))
9232 ;; (anything 'anything-c-source-xfonts)
9234 (defvar anything-c-source-emacs-process
9235 '((name . "Emacs Process")
9236 (candidates . (lambda () (mapcar #'process-name (process-list))))
9237 (persistent-action . (lambda (elm)
9238 (delete-process (get-process elm))
9239 (anything-delete-current-selection)))
9240 (persistent-help . "Kill Process")
9241 (action ("Kill Process" . (lambda (elm)
9242 (delete-process (get-process elm)))))))
9243 ;; (anything 'anything-c-source-emacs-process)
9245 ;;; World time
9248 (defvar anything-c-source-time-world
9249 '((name . "Time World List")
9250 (init . (lambda ()
9251 (let ((anything-buffer (anything-candidate-buffer 'global)))
9252 (with-current-buffer anything-buffer
9253 (display-time-world-display display-time-world-list)))))
9254 (candidates-in-buffer)))
9258 ;;; Anything interface for Debian/Ubuntu packages (apt-*)
9261 (defvar anything-c-source-apt
9262 '((name . "APT")
9263 (init . anything-c-apt-init)
9264 (candidates-in-buffer)
9265 (candidate-transformer anything-c-apt-candidate-transformer)
9266 (display-to-real . anything-c-apt-display-to-real)
9267 (requires-pattern . 2)
9268 (delayed)
9269 (action
9270 ("Show package description" . anything-c-apt-cache-show)
9271 ("Install package" . anything-c-apt-install)
9272 ("Remove package" . anything-c-apt-uninstall)
9273 ("Purge package" . anything-c-apt-purge))
9274 (persistent-action . anything-c-apt-persistent-action)
9275 (persistent-help . "Show - C-u Refresh")))
9276 ;; (anything 'anything-c-source-apt)
9278 (defvar anything-c-apt-query "emacs")
9279 (defvar anything-c-apt-search-command "apt-cache search '%s'")
9280 (defvar anything-c-apt-show-command "apt-cache show '%s'")
9281 (defvar anything-c-apt-installed-packages nil)
9282 (defvar anything-c-apt-all-packages nil)
9285 (defun anything-c-apt-refresh ()
9286 "Refresh installed candidates list."
9287 (setq anything-c-apt-installed-packages nil)
9288 (setq anything-c-apt-all-packages nil)
9289 (anything-force-update))
9291 (defun anything-c-apt-persistent-action (candidate)
9292 "Persistent action for APT source."
9293 (if current-prefix-arg
9294 (anything-c-apt-refresh)
9295 (anything-c-apt-cache-show candidate)))
9297 (defun anything-c-apt-candidate-transformer (candidates)
9298 "Show installed candidates in a different color."
9299 (loop
9300 with all
9301 for cand in candidates
9302 for name = (anything-c-apt-display-to-real cand)
9303 if (member name anything-c-apt-installed-packages)
9304 collect (propertize cand 'face 'anything-apt-installed) into all
9305 else collect cand into all finally return all))
9307 (defun anything-c-apt-init ()
9308 "Initialize list of debian packages."
9309 (let ((query ""))
9310 (unless (and anything-c-apt-installed-packages
9311 anything-c-apt-all-packages)
9312 (message "Loading package list...")
9313 (setq anything-c-apt-installed-packages
9314 (with-temp-buffer
9315 (call-process-shell-command "dpkg --get-selections"
9316 nil (current-buffer))
9317 (loop for i in (split-string (buffer-string) "\n" t)
9318 collect (car (split-string i)))))
9319 (setq anything-c-apt-all-packages
9320 (with-current-buffer
9321 (anything-candidate-buffer
9322 (get-buffer-create (format "*anything-apt*")))
9323 (erase-buffer)
9324 (call-process-shell-command
9325 (format anything-c-apt-search-command query)
9326 nil (current-buffer))))
9327 (message "Loading package list done")
9328 (sit-for 0.5))))
9330 (defun anything-c-apt-display-to-real (line)
9331 "Return only name of a debian package.
9332 LINE is displayed like:
9333 package name - description."
9334 (car (split-string line " - ")))
9336 (defun anything-c-shell-command-if-needed (command)
9337 "Run shell command COMMAND to describe package.
9338 If a buffer named COMMAND already exists, just switch to it."
9339 (let ((buf (get-buffer command)))
9340 (anything-c-switch-to-buffer (get-buffer-create command))
9341 (unless buf (insert (shell-command-to-string command)))))
9343 (defun anything-c-apt-cache-show (package)
9344 "Show information on apt package PACKAGE."
9345 (anything-c-shell-command-if-needed
9346 (format anything-c-apt-show-command package)))
9348 (defun anything-c-apt-install (package)
9349 "Run 'apt-get install' shell command on PACKAGE."
9350 (anything-c-apt-generic-action :action 'install))
9352 (defun anything-c-apt-uninstall (package)
9353 "Run 'apt-get remove' shell command on PACKAGE."
9354 (anything-c-apt-generic-action :action 'uninstall))
9356 (defun anything-c-apt-purge (package)
9357 "Run 'apt-get purge' shell command on PACKAGE."
9358 (anything-c-apt-generic-action :action 'purge))
9360 (defun* anything-c-apt-generic-action (&key action)
9361 "Run 'apt-get ACTION'.
9362 Support install, remove and purge actions."
9363 (ansi-term (getenv "SHELL") "anything apt")
9364 (term-line-mode)
9365 (let ((command (case action
9366 ('install "sudo apt-get install ")
9367 ('uninstall "sudo apt-get remove ")
9368 ('purge "sudo apt-get purge ")
9369 (t (error "Unknow action"))))
9370 (beg (point))
9372 (cand-list (mapconcat #'(lambda (x) (format "'%s'" x))
9373 (anything-marked-candidates) " ")))
9374 (goto-char (point-max))
9375 (insert (concat command cand-list))
9376 (setq end (point))
9377 (if (y-or-n-p (format "%s package" (symbol-name action)))
9378 (progn
9379 (setq anything-c-external-commands-list nil)
9380 (setq anything-c-apt-installed-packages nil)
9381 (term-char-mode) (term-send-input))
9382 (delete-region beg end) (term-send-eof) (kill-buffer))))
9384 ;; (anything-c-apt-install "jed")
9387 ;;; Anything UI for gentoo portage.
9390 (defvar anything-c-gentoo-use-flags nil)
9391 (defvar anything-c-gentoo-buffer "*anything-gentoo-output*")
9392 (defvar anything-c-cache-gentoo nil)
9393 (defvar anything-c-cache-world nil)
9394 (defvar anything-c-source-gentoo
9395 '((name . "Portage sources")
9396 (init . (lambda ()
9397 (get-buffer-create anything-c-gentoo-buffer)
9398 (unless anything-c-cache-gentoo
9399 (anything-c-gentoo-setup-cache))
9400 (unless anything-c-cache-world
9401 (setq anything-c-cache-world (anything-c-gentoo-get-world)))
9402 (anything-c-gentoo-init-list)))
9403 (candidates-in-buffer)
9404 (match . identity)
9405 (candidate-transformer anything-c-highlight-world)
9406 (action . (("Show package" . (lambda (elm)
9407 (anything-c-gentoo-eshell-action elm "eix")))
9408 ("Show history" . (lambda (elm)
9409 (if (member elm anything-c-cache-world)
9410 (anything-c-gentoo-eshell-action elm "genlop -qe")
9411 (message "No infos on packages not yet installed"))))
9412 ("Copy in kill-ring" . kill-new)
9413 ("insert at point" . insert)
9414 ("Browse HomePage" . (lambda (elm)
9415 (let ((urls (anything-c-gentoo-get-url elm)))
9416 (browse-url (anything-comp-read "Url: " urls :must-match t)))))
9417 ("Show extra infos" . (lambda (elm)
9418 (if (member elm anything-c-cache-world)
9419 (anything-c-gentoo-eshell-action elm "genlop -qi")
9420 (message "No infos on packages not yet installed"))))
9421 ("Show use flags" . (lambda (elm)
9422 (anything-c-gentoo-default-action elm "equery" "-C" "u")
9423 (font-lock-add-keywords nil '(("^\+.*" . font-lock-variable-name-face)))
9424 (font-lock-mode 1)))
9425 ("Run emerge pretend" . (lambda (elm)
9426 (anything-c-gentoo-eshell-action elm "emerge -p")))
9427 ("Emerge" . (lambda (elm)
9428 (anything-gentoo-install elm :action 'install)))
9429 ("Unmerge" . (lambda (elm)
9430 (anything-gentoo-install elm :action 'uninstall)))
9431 ("Show dependencies" . (lambda (elm)
9432 (anything-c-gentoo-default-action elm "equery" "-C" "d")))
9433 ("Show related files" . (lambda (elm)
9434 (anything-c-gentoo-default-action elm "equery" "files")))
9435 ("Refresh" . (lambda (elm)
9436 (anything-c-gentoo-setup-cache)
9437 (setq anything-c-cache-world (anything-c-gentoo-get-world))))))))
9439 ;; (anything 'anything-c-source-gentoo)
9441 (defun* anything-gentoo-install (candidate &key action)
9442 (setq anything-c-external-commands-list nil)
9443 (ansi-term (getenv "SHELL") "Gentoo emerge")
9444 (term-line-mode)
9445 (let ((command (case action
9446 ('install "sudo emerge -av ")
9447 ('uninstall "sudo emerge -avC ")
9448 (t (error "Unknow action"))))
9449 (elms (mapconcat 'identity (anything-marked-candidates) " "))
9450 (beg (point)) end)
9451 (goto-char (point-max))
9452 (insert (concat command elms))
9453 (setq end (point))
9454 (term-char-mode) (term-send-input)))
9456 (defun anything-c-gentoo-default-action (elm command &rest args)
9457 "Gentoo default action that use `anything-c-gentoo-buffer'."
9458 (if (member elm anything-c-cache-world)
9459 (progn
9460 (anything-c-switch-to-buffer anything-c-gentoo-buffer)
9461 (erase-buffer)
9462 (let ((com-list (append args (list elm))))
9463 (apply #'call-process command nil t nil
9464 com-list)))
9465 (message "No infos on packages not yet installed")))
9467 (defvar anything-c-source-use-flags
9468 '((name . "Use Flags")
9469 (init . (lambda ()
9470 (unless anything-c-gentoo-use-flags
9471 (anything-c-gentoo-setup-use-flags-cache))
9472 (anything-c-gentoo-get-use)))
9473 (candidates-in-buffer)
9474 (match . identity)
9475 (candidate-transformer anything-c-highlight-local-use)
9476 (action . (("Description"
9477 . (lambda (elm)
9478 (anything-c-switch-to-buffer anything-c-gentoo-buffer)
9479 (erase-buffer)
9480 (apply #'call-process "euse" nil t nil
9481 `("-i"
9482 ,elm))
9483 (font-lock-add-keywords nil `((,elm . font-lock-variable-name-face)))
9484 (font-lock-mode 1)))
9485 ("Enable"
9486 . (lambda (elm)
9487 (anything-c-gentoo-eshell-action elm "*sudo -p Password: euse -E")))
9488 ("Disable"
9489 . (lambda (elm)
9490 (anything-c-gentoo-eshell-action elm "*sudo -p Password: euse -D")))
9491 ("Remove"
9492 . (lambda (elm)
9493 (anything-c-gentoo-eshell-action elm "*sudo -p Password: euse -P")))
9494 ("Show which dep use this flag"
9495 . (lambda (elm)
9496 (anything-c-switch-to-buffer anything-c-gentoo-buffer)
9497 (erase-buffer)
9498 (apply #'call-process "equery" nil t nil
9499 `("-C"
9501 ,elm))))))))
9504 ;; (anything 'anything-c-source-use-flags)
9506 (defun anything-c-gentoo-init-list ()
9507 "Initialize buffer with all packages in Portage."
9508 (let* ((portage-buf (get-buffer-create "*anything-gentoo*"))
9509 (buf (anything-candidate-buffer 'portage-buf)))
9510 (with-current-buffer buf
9511 (dolist (i anything-c-cache-gentoo)
9512 (insert (concat i "\n"))))))
9514 (defun anything-c-gentoo-setup-cache ()
9515 "Set up `anything-c-cache-gentoo'"
9516 (setq anything-c-cache-gentoo
9517 (split-string (with-temp-buffer
9518 (call-process "eix" nil t nil
9519 "--only-names")
9520 (buffer-string)))))
9522 (defun anything-c-gentoo-eshell-action (elm command)
9523 (when (get-buffer "*EShell Command Output*")
9524 (kill-buffer "*EShell Command Output*"))
9525 (message "Wait searching...")
9526 (let ((buf-fname (buffer-file-name anything-current-buffer)))
9527 (if (and buf-fname (string-match tramp-file-name-regexp buf-fname))
9528 (progn
9529 (save-window-excursion
9530 (pop-to-buffer "*scratch*")
9531 (eshell-command (format "%s %s" command elm)))
9532 (pop-to-buffer "*EShell Command Output*"))
9533 (eshell-command (format "%s %s" command elm)))))
9535 (defun anything-c-gentoo-get-use ()
9536 "Initialize buffer with all use flags."
9537 (let* ((use-buf (get-buffer-create "*anything-gentoo-use*"))
9538 (buf (anything-candidate-buffer 'use-buf)))
9539 (with-current-buffer buf
9540 (dolist (i anything-c-gentoo-use-flags)
9541 (insert (concat i "\n"))))))
9544 (defun anything-c-gentoo-setup-use-flags-cache ()
9545 "Setup `anything-c-gentoo-use-flags'"
9546 (setq anything-c-gentoo-use-flags
9547 (split-string (with-temp-buffer
9548 (call-process "eix" nil t nil
9549 "--print-all-useflags")
9550 (buffer-string)))))
9552 (defun anything-c-gentoo-get-url (elm)
9553 "Return a list of urls from eix output."
9554 (loop
9555 with url-list = (split-string
9556 (with-temp-buffer
9557 (call-process "eix" nil t nil
9558 elm "--format" "<homepage>\n")
9559 (buffer-string)))
9560 with all
9561 for i in url-list
9562 when (and (string-match "^http://.*" i)
9563 (not (member i all)))
9564 collect i into all
9565 finally return all))
9567 (defun anything-c-gentoo-get-world ()
9568 "Return list of all installed package on your system."
9569 (split-string (with-temp-buffer
9570 (call-process "qlist" nil t nil
9571 "-I")
9572 (buffer-string))))
9574 (defun anything-c-gentoo-get-local-use ()
9575 (split-string (with-temp-buffer
9576 (call-process "portageq" nil t nil
9577 "envvar"
9578 "USE")
9579 (buffer-string))))
9582 (defun anything-c-highlight-world (eix)
9583 "Highlight all installed package."
9584 (loop for i in eix
9585 if (member i anything-c-cache-world)
9586 collect (propertize i 'face 'anything-gentoo-match-face)
9587 else
9588 collect i))
9590 (defun anything-c-highlight-local-use (use-flags)
9591 (let ((local-uses (anything-c-gentoo-get-local-use)))
9592 (loop for i in use-flags
9593 if (member i local-uses)
9594 collect (propertize i 'face 'anything-gentoo-match-face)
9595 else
9596 collect i)))
9600 ;;; Anything ratpoison UI
9603 (defvar anything-c-source-ratpoison-commands
9604 '((name . "Ratpoison Commands")
9605 (init . anything-c-ratpoison-commands-init)
9606 (candidates-in-buffer)
9607 (action ("Execute the command" . anything-c-ratpoison-commands-execute))
9608 (display-to-real . anything-c-ratpoison-commands-display-to-real)
9609 (candidate-number-limit)))
9610 ;; (anything 'anything-c-source-ratpoison-commands)
9612 (defun anything-c-ratpoison-commands-init ()
9613 (unless (anything-candidate-buffer)
9614 (with-current-buffer (anything-candidate-buffer 'global)
9615 ;; with ratpoison prefix key
9616 (save-excursion
9617 (call-process "ratpoison" nil (current-buffer) nil "-c" "help"))
9618 (while (re-search-forward "^\\([^ ]+\\) \\(.+\\)$" nil t)
9619 (replace-match "<ratpoison> \\1: \\2"))
9620 (goto-char (point-max))
9621 ;; direct binding
9622 (save-excursion
9623 (call-process "ratpoison" nil (current-buffer) nil "-c" "help top"))
9624 (while (re-search-forward "^\\([^ ]+\\) \\(.+\\)$" nil t)
9625 (replace-match "\\1: \\2")))))
9627 (defun anything-c-ratpoison-commands-display-to-real (display)
9628 (and (string-match ": " display)
9629 (substring display (match-end 0))))
9631 (defun anything-c-ratpoison-commands-execute (candidate)
9632 (call-process "ratpoison" nil nil nil "-ic" candidate))
9636 ;;; Anything `completing-read' replacement
9639 (defun anything-comp-read-get-candidates (collection &optional test sort-fn alistp)
9640 "Convert COLLECTION to list removing elements that don't match TEST.
9641 SORT-FN is a predicate to sort COLLECTION.
9642 ALISTP is a flag to not use `all-completions' which doesn't handle alists correctly\
9643 for anything.
9644 If collection is an `obarray', a TEST is needed. See `obarray'."
9645 (let ((cands
9646 (cond ((and (eq collection obarray) test)
9647 (all-completions "" collection test))
9648 ((and (vectorp collection) test)
9649 (loop for i across collection when (funcall test i) collect i))
9650 ((vectorp collection)
9651 (loop for i across collection collect i))
9652 ((and alistp test)
9653 (loop for i in collection when (funcall test i) collect i))
9654 (alistp collection)
9655 ((and collection test)
9656 (all-completions "" collection test))
9657 (t (all-completions "" collection)))))
9658 (if sort-fn (sort cands sort-fn) cands)))
9660 (defun anything-cr-default-transformer (candidates source)
9661 "Default filter candidate function for `anything-comp-read'.
9662 Do nothing, just return candidate list unmodified."
9663 candidates)
9665 (defun* anything-comp-read (prompt collection
9666 &key
9667 test
9668 initial-input
9669 (buffer "*Anything Completions*")
9670 must-match
9671 (requires-pattern 0)
9672 (history nil)
9673 (persistent-action nil)
9674 (persistent-help "DoNothing")
9675 (name "Anything Completions")
9676 (volatile t)
9677 sort
9678 (fc-transformer 'anything-cr-default-transformer)
9679 (marked-candidates nil)
9680 (alistp t))
9681 "Anything `completing-read' emulation.
9682 PROMPT is the prompt name to use.
9683 COLLECTION can be a list, vector, obarray or hash-table.
9684 Keys:
9686 TEST: A predicate called with one arg i.e candidate.
9687 INITIAL-INPUT: Same as initial-input arg in `anything'.
9688 BUFFER: Name of anything-buffer.
9689 MUST-MATCH: Candidate selected must be one of COLLECTION.
9690 REQUIRES-PATTERN: Same as anything attribute, default is 0.
9691 HISTORY: A list containing specific history, default is nil.
9692 When it is non--nil, all elements of HISTORY are displayed in
9693 anything-buffer before COLLECTION.
9694 PERSISTENT-ACTION: A function called with one arg i.e candidate.
9695 PERSISTENT-HELP: A string to document PERSISTENT-ACTION.
9696 NAME: The name related to this local source.
9697 VOLATILE: Use volatile attribute.
9698 SORT: A predicate to give to `sort' e.g `string-lessp'.
9699 FC-TRANSFORMER: A `filtered-candidate-transformer' function.
9700 MARKED-CANDIDATES: If non--nil return candidate or marked candidates as a list.
9701 ALISTP: when non--nil \(default\) cdr of alist is returned otherwise it is the car.
9703 Any prefix args passed during `anything-comp-read' invocation will be recorded
9704 in `anything-current-prefix-arg', otherwise if prefix args where given before
9705 `anything-comp-read' invocation, the value of `current-prefix-arg' will be used.
9706 That's mean you can pass prefix arg before or after calling
9707 a command that use `anything-comp-read'.
9708 It support now also a function as argument, See `all-completions' for more details."
9709 (when (get-buffer anything-action-buffer)
9710 (kill-buffer anything-action-buffer))
9711 (flet ((action-fn (candidate)
9712 (if marked-candidates
9713 (anything-marked-candidates)
9714 (identity candidate))))
9715 (let ((hist `((name . ,(format "%s History" name))
9716 (candidates . (lambda ()
9717 (anything-comp-read-get-candidates
9718 history nil nil ,alistp)))
9719 (persistent-action . ,persistent-action)
9720 (persistent-help . ,persistent-help)
9721 (action . ,'action-fn)))
9722 (src `((name . ,name)
9723 (candidates
9724 . (lambda ()
9725 (let ((cands (anything-comp-read-get-candidates
9726 collection test sort alistp)))
9727 (if (or must-match (string= anything-pattern ""))
9728 cands (append (list anything-pattern) cands)))))
9729 (filtered-candidate-transformer ,fc-transformer)
9730 (requires-pattern . ,requires-pattern)
9731 (persistent-action . ,persistent-action)
9732 (persistent-help . ,persistent-help)
9733 (action . ,'action-fn))))
9734 (when volatile (setq src (append src '((volatile)))))
9735 (or (anything
9736 :sources `(,hist ,src)
9737 :input initial-input
9738 :prompt prompt
9739 :resume 'noresume
9740 :buffer buffer)
9741 (keyboard-quit)))))
9743 ;; Generic completing-read
9745 ;; Support also function as collection.
9746 ;; e.g M-x man is supported.
9747 ;; Support hash-table and vectors as collection.
9748 ;; NOTE:
9749 ;; Some crap emacs functions may not be supported
9750 ;; like ffap-alternate-file (bad use of completing-read)
9751 ;; and maybe others.
9752 ;; Provide a mode `anything-completion-mode' which turn on
9753 ;; anything in all `completing-read' and `read-file-name' in Emacs.
9755 (defun anything-completing-read-default
9756 (prompt collection &optional
9757 predicate require-match
9758 initial-input hist def
9759 inherit-input-method)
9760 "An anything replacement of `completing-read'.
9762 Don't use it directly, use instead `anything-comp-read' in your programs \
9763 which is more powerful.
9765 See documentation of `completing-read' and `all-completions' for details."
9766 (let ((init (or def initial-input)))
9767 (anything-comp-read
9768 prompt collection
9769 :test predicate
9770 :fc-transformer #'(lambda (candidates source)
9771 (loop for i in candidates
9772 if (consp i) collect (car i)
9773 else collect i))
9774 :history (eval (or (car-safe hist) hist))
9775 :must-match require-match
9776 :alistp nil
9777 :initial-input init)))
9779 (defun anything-generic-read-file-name
9780 (prompt &optional dir default-filename mustmatch initial predicate)
9781 "An anything replacement of `read-file-name'."
9782 (let* ((default (and default-filename
9783 (if (listp default-filename)
9784 (car default-filename)
9785 default-filename)))
9786 (init (or default initial dir default-directory))
9787 (ini-input (and init (expand-file-name init)))
9788 (anything-ff-auto-update-flag nil))
9789 (anything-c-read-file-name prompt
9790 :initial-input (expand-file-name init dir)
9791 :alistp nil
9792 :must-match mustmatch
9793 :test predicate)))
9795 (defvar anything-completion-mode-string " AC")
9796 ;;;###autoload
9797 (define-minor-mode anything-completion-mode
9798 "Toggle generic anything completion.
9799 All functions in Emacs that use `completing-read'
9800 or `read-file-name' and friends will use anything interface
9801 when this mode is turned on.
9802 Called with a positive arg, turn on inconditionnaly, with a
9803 negative arg turn off.
9804 You can turn it on with `ac-mode'.
9806 Some crap emacs functions may not be supported,
9807 e.g `ffap-alternate-file' and maybe others."
9808 :group 'anything
9809 :global t
9810 :lighter anything-completion-mode-string
9811 (declare (special completing-read-function))
9812 (if anything-completion-mode
9813 (progn
9814 (setq completing-read-function 'anything-completing-read-default
9815 read-file-name-function 'anything-generic-read-file-name)
9816 (message "Anything completion enabled"))
9817 (setq completing-read-function 'completing-read-default
9818 read-file-name-function 'read-file-name-default)
9819 (message "Anything completion disabled")))
9821 (defalias 'ac-mode 'anything-completion-mode)
9825 ;;; Eshell completion.
9827 ;; Enable like this in .emacs:
9829 ;; (add-hook 'eshell-mode-hook
9830 ;; #'(lambda ()
9831 ;; (define-key eshell-mode-map [remap pcomplete] 'anything-esh-pcomplete)))
9833 (defvar anything-c-source-esh
9834 '((name . "Eshell completions")
9835 (init . (lambda ()
9836 (setq pcomplete-current-completions nil
9837 pcomplete-last-completion-raw nil)))
9838 (candidates . anything-esh-get-candidates)
9839 (action . anything-ec-insert))
9840 "Anything source for Eshell completion.")
9842 ;; Internal.
9843 (defvar anything-ec-target "")
9844 (defun anything-ec-insert (candidate)
9845 "Insert CANDIDATE at point.
9846 This is the same as `ac-insert', just inlined here for compatibility."
9847 (let ((pt (point)))
9848 (when (and anything-ec-target
9849 (search-backward anything-ec-target nil t)
9850 (string= (buffer-substring (point) pt) anything-ec-target))
9851 (delete-region (point) pt)))
9852 (insert candidate))
9854 (defun anything-esh-get-candidates ()
9855 "Get candidates for eshell completion using `pcomplete'."
9856 (catch 'pcompleted
9857 (let* ((pcomplete-stub)
9858 pcomplete-seen pcomplete-norm-func
9859 pcomplete-args pcomplete-last pcomplete-index
9860 (pcomplete-autolist pcomplete-autolist)
9861 (pcomplete-suffix-list pcomplete-suffix-list))
9862 (with-anything-current-buffer
9863 (loop
9864 with table = (pcomplete-completions)
9865 with entry = (condition-case nil
9866 ;; For Emacs24
9867 (funcall (pcomplete-entries) anything-pattern nil nil)
9868 ;; Fall back to this in Emacs23 as pcomplete-entries seem broken.
9869 (error
9871 (let ((fc (car (last (pcomplete-parse-arguments)))))
9872 ;; Check if last arg require fname completion.
9873 (and (file-name-directory fc) fc))))
9874 for i in (if (listp table) table ; Emacs23 or commands.
9875 (all-completions pcomplete-stub table)) ; Emacs24
9876 for file-cand = (and entry (expand-file-name i (file-name-directory entry)))
9877 if (and file-cand (file-exists-p file-cand)) collect file-cand into ls
9878 else collect i into ls
9879 finally return
9880 (if (and entry (not (string= entry "")) (file-exists-p entry))
9881 (append (list (expand-file-name entry default-directory)) ls) ls))))))
9883 ;;; Eshell history.
9886 (defvar anything-c-source-eshell-history
9887 '((name . "Eshell history")
9888 (init . (lambda ()
9889 (with-current-buffer (anything-candidate-buffer 'global)
9890 (insert-file-contents eshell-history-file-name))))
9891 (candidates-in-buffer)
9892 (action . (lambda (candidate)
9893 (insert candidate))))
9894 "Anything source for Eshell history.")
9897 ;;; Show completion - an alternative of anything-show-completion.el.
9899 ;; Provide show completion with macro `with-anything-show-completion'.
9902 ;; Internal
9903 (defvar anything-c-show-completion-overlay nil)
9905 ;; Called each time cursor move in anything-buffer.
9906 (defun anything-c-show-completion ()
9907 (overlay-put anything-c-show-completion-overlay
9908 'display (anything-get-selection)))
9910 (defun anything-c-show-completion-init-overlay (beg end)
9911 (and anything-c-turn-on-show-completion
9912 (setq anything-c-show-completion-overlay (make-overlay beg end))
9913 (overlay-put anything-c-show-completion-overlay
9914 'face 'anything-lisp-show-completion)))
9916 (defmacro with-anything-show-completion (beg end &rest body)
9917 "Show anything candidate in an overlay at point.
9918 BEG and END are the beginning and end position of the current completion
9919 in `anything-current-buffer'.
9920 BODY is an anything call where we want to enable show completion.
9921 If `anything-c-turn-on-show-completion' is nil just do nothing."
9922 (declare (indent 2) (debug t))
9923 `(let ((anything-move-selection-after-hook
9924 (and anything-c-turn-on-show-completion
9925 (append (list 'anything-c-show-completion)
9926 anything-move-selection-after-hook))))
9927 (unwind-protect
9928 (progn (anything-c-show-completion-init-overlay ,beg ,end)
9929 ,@body)
9930 (and anything-c-turn-on-show-completion
9931 (delete-overlay anything-c-show-completion-overlay)))))
9934 ;;; Lisp symbol completion.
9937 ;;;###autoload
9938 (defun anything-lisp-completion-at-point ()
9939 "Anything lisp symbol completion at point."
9940 (interactive)
9941 (let* ((data (lisp-completion-at-point))
9942 (beg (car data))
9943 (end (point)) ; 'cadr data' is wrong when no space after point.
9944 (plist (nthcdr 3 data))
9945 (pred (plist-get plist :predicate))
9946 (lgst-len 0)
9947 (target (and beg end (buffer-substring-no-properties beg end)))
9948 (candidates (all-completions target (nth 2 data) pred))
9949 (anything-quit-if-no-candidate t)
9950 (anything-execute-action-at-once-if-one t)
9951 (anything-match-plugin-enabled
9952 (member 'anything-compile-source--match-plugin
9953 anything-compile-source-functions)))
9954 (if candidates
9955 (with-anything-show-completion beg end
9956 ;; Overlay is initialized now in anything-current-buffer.
9957 (anything
9958 :sources
9959 '((name . "Lisp completion")
9960 (init . (lambda ()
9961 (with-current-buffer (anything-candidate-buffer 'global)
9962 (loop for sym in candidates
9963 for len = (length sym)
9964 when (> len lgst-len) do (setq lgst-len len)
9965 do (insert (concat sym "\n"))))))
9966 (candidates-in-buffer)
9967 (persistent-action . (lambda (candidate)
9968 (let ((cursor-in-echo-area t)
9969 mode-line-in-non-selected-windows)
9970 (anything-c-eldoc-show-in-mode-line
9971 (propertize
9972 (anything-c-get-first-line-documentation
9973 (intern candidate))
9974 'face 'anything-lisp-completion-info)))))
9975 (persistent-help . "Show brief doc in mode-line")
9976 (filtered-candidate-transformer anything-lisp-completion-transformer)
9977 (action . (lambda (candidate)
9978 (delete-region beg end)
9979 (insert candidate))))
9980 :input (if anything-match-plugin-enabled (concat target " ") target)))
9981 (message "[No Match]"))))
9983 (defun anything-lisp-completion-transformer (candidates source)
9984 "Anything candidates transformer for lisp completion."
9985 (declare (special lgst-len))
9986 (loop for c in candidates
9987 for sym = (intern c)
9988 for annot = (cond ((commandp sym) " (Com)")
9989 ((fboundp sym) " (Fun)")
9990 ((boundp sym) " (Var)")
9991 ((facep sym) " (Face)"))
9992 for spaces = (make-string (- lgst-len (length c)) ? )
9993 collect (cons (concat c spaces annot) c)))
9995 (defun anything-c-get-first-line-documentation (sym)
9996 "Return first line documentation of symbol SYM.
9997 If SYM is not documented, return \"Not documented\"."
9998 (let ((doc (cond ((fboundp sym)
9999 (documentation sym t))
10000 ((boundp sym)
10001 (documentation-property sym 'variable-documentation t))
10002 ((facep sym)
10003 (face-documentation sym))
10004 (t nil))))
10005 (if (and doc (not (string= doc ""))
10006 ;; `documentation' return "\n\n(args...)"
10007 ;; for CL-style functions.
10008 (not (string-match-p "^\n\n" doc)))
10009 (car (split-string doc "\n"))
10010 "Not documented")))
10012 ;;; File completion.
10014 ;; Complete file name at point.
10015 (defun anything-c-thing-before-point ()
10016 "Get symbol name before point.
10017 Borrowed from anything-complete.el, inlined here for compatibility."
10018 (save-excursion
10019 (let ((beg (point)))
10020 ;; older regexp "\(\\|\\s-\\|^\\|\\_<\\|\r\\|'\\|#'"
10021 (when (re-search-backward
10022 "\\_<" (field-beginning nil nil (point-at-bol)) t)
10023 (buffer-substring-no-properties beg (match-end 0))))))
10025 ;;;###autoload
10026 (defun anything-c-complete-file-name-at-point ()
10027 "Complete file name at point."
10028 (interactive)
10029 (let* ((init (substring-no-properties (thing-at-point 'filename)))
10030 (end (point))
10031 (beg (- (point) (length init)))
10032 (anything-quit-if-no-candidate t)
10033 (anything-execute-action-at-once-if-one t)
10034 completion)
10035 (with-anything-show-completion beg end
10036 (setq completion (anything-c-read-file-name "FileName: "
10037 :initial-input init
10038 :must-match t)))
10039 (anything-c-insert-file-name-completion-at-point completion)))
10041 ;; Internal
10042 (defvar anything-lisp-completion-counter 0)
10043 ;;;###autoload
10044 (defun anything-lisp-completion-at-point-or-indent (arg)
10045 "First call indent and second call complete lisp symbol.
10046 The second call should happen before `anything-lisp-completion-or-indent-delay',
10047 after this delay, next call will indent again.
10048 After completion, next call is always indent.
10049 See that like click and double mouse click.
10050 One hit indent, two quick hits maybe indent and complete."
10051 (interactive "P")
10052 ;; Be sure `indent-for-tab-command' will not try
10053 ;; to use `completion-at-point'.
10054 (let ((tab-always-indent (if (eq tab-always-indent 'complete)
10055 t tab-always-indent)))
10056 (incf anything-lisp-completion-counter)
10057 (unwind-protect
10058 (if (> anything-lisp-completion-counter 1)
10059 (anything-lisp-completion-or-file-name-at-point)
10060 (indent-for-tab-command arg))
10061 ;; After `anything-lisp-completion-or-indent-delay' seconds
10062 ;; reset to 0.
10063 (run-with-timer anything-lisp-completion-or-indent-delay nil
10064 #'(lambda ()
10065 (setq anything-lisp-completion-counter 0)))
10066 ;; Always reset to 0 at second hit.
10067 (when (eq anything-lisp-completion-counter 2)
10068 (setq anything-lisp-completion-counter 0)))))
10070 ;;;###autoload
10071 (defun anything-lisp-completion-or-file-name-at-point ()
10072 "Complete lisp symbol or filename at point.
10073 Filename completion happen if filename is started in
10074 or between double quotes."
10075 (interactive)
10076 (let ((tap (substring-no-properties (thing-at-point 'filename))))
10077 (if (and tap (string-match "^\\(~/\\|/\\|[a-zA-Z]\:/\\).*" tap)
10078 (save-excursion (search-backward "\"" (point-at-bol) t)))
10079 (anything-c-complete-file-name-at-point)
10080 (anything-lisp-completion-at-point))))
10084 ;;; Run Externals commands within Emacs with anything completion
10087 (defvar anything-external-command-history nil)
10089 (defun anything-c-external-commands-list-1 (&optional sort)
10090 "Returns a list of all external commands the user can execute.
10091 If `anything-c-external-commands-list' is non-nil it will
10092 return its contents. Else it calculates all external commands
10093 and sets `anything-c-external-commands-list'."
10094 (if anything-c-external-commands-list
10095 anything-c-external-commands-list
10096 (setq anything-c-external-commands-list
10097 (loop
10098 with paths = (split-string (getenv "PATH") path-separator)
10099 with completions = ()
10100 for dir in paths
10101 when (and (file-exists-p dir) (file-accessible-directory-p dir))
10102 for lsdir = (loop for i in (directory-files dir t)
10103 for bn = (file-name-nondirectory i)
10104 when (and (not (member bn completions))
10105 (not (file-directory-p i))
10106 (file-executable-p i))
10107 collect bn)
10108 append lsdir into completions
10109 finally return (if sort (sort completions 'string-lessp) completions)))))
10111 (defun anything-run-or-raise (exe &optional file)
10112 "Generic command that run asynchronously EXE.
10113 If EXE is already running just jump to his window if `anything-raise-command'
10114 is non--nil.
10115 When FILE argument is provided run EXE with FILE.
10116 In this case EXE must be provided as \"EXE %s\"."
10117 (lexical-let* ((real-com (car (split-string (replace-regexp-in-string
10118 "'%s'" "" exe))))
10119 (proc (if file (concat real-com " " file) real-com)))
10120 (if (get-process proc)
10121 (if anything-raise-command
10122 (shell-command (format anything-raise-command real-com))
10123 (error "Error: %s is already running" real-com))
10124 (when (loop for i in anything-c-external-commands-list thereis real-com)
10125 (message "Starting %s..." real-com)
10126 (if file
10127 (start-process-shell-command proc nil (format exe file))
10128 (start-process-shell-command proc nil real-com))
10129 (set-process-sentinel
10130 (get-process proc)
10131 #'(lambda (process event)
10132 (when (and (string= event "finished\n")
10133 anything-raise-command
10134 (not (anything-c-get-pid-from-process-name real-com)))
10135 (shell-command (format anything-raise-command "emacs")))
10136 (message "%s process...Finished." process))))
10137 (setq anything-c-external-commands-list
10138 (cons real-com
10139 (delete real-com anything-c-external-commands-list))))))
10143 ;;; Generic action functions
10146 (defun anything-c-file-buffers (filename)
10147 "Returns a list of buffer names corresponding to FILENAME."
10148 (let ((name (expand-file-name filename))
10149 (buf-list ()))
10150 (dolist (buf (buffer-list) buf-list)
10151 (let ((bfn (buffer-file-name buf)))
10152 (when (and bfn (string= name bfn))
10153 (push (buffer-name buf) buf-list))))))
10155 (defun anything-revert-buffer (candidate)
10156 (with-current-buffer candidate
10157 (when (or (buffer-modified-p)
10158 (not (verify-visited-file-modtime
10159 (get-buffer candidate))))
10160 (revert-buffer t t))))
10162 (defun anything-revert-marked-buffers (ignore)
10163 (mapc 'anything-revert-buffer (anything-marked-candidates)))
10165 (defun anything-kill-marked-buffers (ignore)
10166 (mapc 'kill-buffer (anything-marked-candidates)))
10168 (defun anything-c-delete-file (file)
10169 "Delete the given file after querying the user.
10170 Ask to kill buffers associated with that file, too."
10171 (let ((buffers (anything-c-file-buffers file)))
10172 (if (< emacs-major-version 24)
10173 ;; `dired-delete-file' in Emacs versions < 24
10174 ;; doesn't support delete-by-moving-to-trash
10175 ;; so use `delete-directory' and `delete-file'
10176 ;; that handle it.
10177 (cond ((and (not (file-symlink-p file))
10178 (file-directory-p file)
10179 (directory-files file t dired-re-no-dot))
10180 (when (y-or-n-p (format "Recursive delete of `%s'? " file))
10181 (delete-directory file 'recursive)))
10182 ((and (not (file-symlink-p file))
10183 (file-directory-p file))
10184 (delete-directory file))
10185 (t (delete-file file)))
10186 (dired-delete-file
10187 file 'dired-recursive-deletes delete-by-moving-to-trash))
10188 (when buffers
10189 (dolist (buf buffers)
10190 (when (y-or-n-p (format "Kill buffer %s, too? " buf))
10191 (kill-buffer buf))))))
10193 (defun anything-get-mailcap-for-file (filename)
10194 "Get the command to use for FILENAME from mailcap files.
10195 The command is like <command %s> and is meant to use with `format'."
10196 (mailcap-parse-mailcaps)
10197 (let* ((ext (file-name-extension filename))
10198 (mime (when ext (mailcap-extension-to-mime ext)))
10199 (result (when mime (mailcap-mime-info mime))))
10200 ;; If elisp file have no associations in .mailcap
10201 ;; `mailcap-maybe-eval' is returned, in this case just return nil.
10202 (when (stringp result) result)))
10204 (defun anything-get-default-program-for-file (filename)
10205 "Try to find a default program to open FILENAME.
10206 Try first in `anything-c-external-programs-associations' and then in mailcap file
10207 if nothing found return nil."
10208 (let* ((ext (file-name-extension filename))
10209 (def-prog (assoc-default ext anything-c-external-programs-associations)))
10210 (cond ((and def-prog (not (string= def-prog "")))
10211 (concat def-prog " %s"))
10212 ((and anything-c-default-external-file-browser
10213 (file-directory-p filename))
10214 (concat anything-c-default-external-file-browser " %s"))
10215 (t (anything-get-mailcap-for-file filename)))))
10217 (defun anything-c-open-file-externally (file)
10218 "Open FILE with an external program.
10219 Try to guess which program to use with `anything-get-default-program-for-file'.
10220 If not found or a prefix arg is given query the user which tool to use."
10221 (let* ((fname (expand-file-name file))
10222 (collection (anything-c-external-commands-list-1 'sort))
10223 (def-prog (anything-get-default-program-for-file fname))
10224 (real-prog-name (if (or anything-current-prefix-arg (not def-prog))
10225 ;; Prefix arg or no default program.
10226 (prog1
10227 (anything-comp-read
10228 "Program: " collection
10229 :must-match t
10230 :name "Open file Externally"
10231 :history anything-external-command-history)
10232 ;; Always prompt to set this program as default.
10233 (setq def-prog nil))
10234 ;; No prefix arg or default program exists.
10235 (replace-regexp-in-string " %s\\| '%s'" "" def-prog)))
10236 (program (concat real-prog-name " '%s'")))
10237 (unless (or def-prog ; Association exists, no need to record it.
10238 ;; Don't try to record non--filenames associations (e.g urls).
10239 (not (file-exists-p fname)))
10240 (when
10241 (y-or-n-p
10242 (format
10243 "Do you want to make `%s' the default program for this kind of files? "
10244 real-prog-name))
10245 (anything-aif (assoc (file-name-extension fname)
10246 anything-c-external-programs-associations)
10247 (setq anything-c-external-programs-associations
10248 (delete it anything-c-external-programs-associations)))
10249 (push (cons (file-name-extension fname)
10250 (read-string
10251 "Program (Add args maybe and confirm): " real-prog-name))
10252 anything-c-external-programs-associations)
10253 (customize-save-variable 'anything-c-external-programs-associations
10254 anything-c-external-programs-associations)))
10255 (anything-run-or-raise program file)
10256 (setq anything-external-command-history
10257 (cons real-prog-name
10258 (delete real-prog-name
10259 (loop for i in anything-external-command-history
10260 when (executable-find i) collect i))))))
10263 (defun anything-c-find-file-or-marked (candidate)
10264 "Open file CANDIDATE or open anything marked files in background."
10265 (let ((marked (anything-marked-candidates))
10266 (ffap-newfile-prompt anything-ff-newfile-prompt-p)
10267 (find-file-wildcards nil))
10268 (if (> (length marked) 1)
10269 ;; Open all marked files in background and display
10270 ;; the first one.
10271 (progn (mapc 'find-file-noselect (cdr marked))
10272 (find-file (car marked)))
10273 (if (and (not (file-exists-p candidate))
10274 (and ffap-url-regexp
10275 (not (string-match ffap-url-regexp candidate)))
10276 (string-match "/$" candidate))
10277 ;; A a non--existing filename ending with /
10278 ;; Create a directory and jump to it.
10279 (when (y-or-n-p (format "Create directory `%s'? " candidate))
10280 (let ((dirfname (directory-file-name candidate)))
10281 (if (file-exists-p dirfname)
10282 (error "Mkdir: Unable to create directory `%s': file exists."
10283 (anything-c-basename dirfname))
10284 (make-directory candidate 'parent)))
10285 (anything-find-files-1 candidate))
10286 ;; A non--existing filename NOT ending with / or
10287 ;; an existing filename, create or jump to it.
10288 (find-file-at-point (car marked))))))
10290 (defun anything-delete-marked-files (ignore)
10291 (let* ((files (anything-marked-candidates))
10292 (len (length files)))
10293 (if (not (y-or-n-p
10294 (format "Delete *%s File(s):\n%s"
10296 (mapconcat (lambda (f) (format "- %s\n" f)) files ""))))
10297 (message "(No deletions performed)")
10298 (dolist (i files)
10299 (set-text-properties 0 (length i) nil i)
10300 (anything-c-delete-file i))
10301 (message "%s File(s) deleted" len))))
10303 (defun anything-ediff-marked-buffers (candidate &optional merge)
10304 "Ediff 2 marked buffers or CANDIDATE and `anything-current-buffer'.
10305 With optional arg MERGE call `ediff-merge-buffers'."
10306 (let ((lg-lst (length (anything-marked-candidates)))
10307 buf1 buf2)
10308 (case lg-lst
10310 (error "Error:You have to mark at least 1 buffer"))
10312 (setq buf1 anything-current-buffer
10313 buf2 (first (anything-marked-candidates))))
10315 (setq buf1 (first (anything-marked-candidates))
10316 buf2 (second (anything-marked-candidates))))
10318 (error "Error:To much buffers marked!")))
10319 (if merge
10320 (ediff-merge-buffers buf1 buf2)
10321 (ediff-buffers buf1 buf2))))
10323 (defun anything-ediff-marked-buffers-merge (candidate)
10324 "Ediff merge `anything-current-buffer' with CANDIDATE.
10325 See `anything-ediff-marked-buffers'."
10326 (anything-ediff-marked-buffers candidate t))
10328 (defun anything-bookmark-get-bookmark-from-name (bmk)
10329 "Return bookmark name even if it is a bookmark with annotation.
10330 e.g prepended with *.
10331 Return nil if bmk is not a valid bookmark."
10332 (let ((bookmark (replace-regexp-in-string "\*" "" bmk)))
10333 (if (assoc bookmark bookmark-alist)
10334 bookmark
10335 (when (assoc bmk bookmark-alist)
10336 bmk))))
10338 (defun anything-delete-marked-bookmarks (ignore)
10339 "Delete this bookmark or all marked bookmarks."
10340 (dolist (i (anything-marked-candidates))
10341 (bookmark-delete (anything-bookmark-get-bookmark-from-name i)
10342 'batch)))
10344 (defun anything-require-or-error (feature function)
10345 (or (require feature nil t)
10346 (error "Need %s to use `%s'." feature function)))
10348 (defun anything-find-buffer-on-elscreen (candidate)
10349 "Open buffer in new screen, if marked buffers open all in elscreens."
10350 (anything-require-or-error 'elscreen 'anything-find-buffer-on-elscreen)
10351 (anything-aif (anything-marked-candidates)
10352 (dolist (i it)
10353 (let ((target-screen (elscreen-find-screen-by-buffer
10354 (get-buffer i) 'create)))
10355 (elscreen-goto target-screen)))
10356 (let ((target-screen (elscreen-find-screen-by-buffer
10357 (get-buffer candidate) 'create)))
10358 (elscreen-goto target-screen))))
10360 (defun anything-elscreen-find-file (file)
10361 (anything-require-or-error 'elscreen 'anything-elscreen-find-file)
10362 (elscreen-find-file file))
10364 ;;;###autoload
10365 (defun w32-shell-execute-open-file (file)
10366 (interactive "fOpen file:")
10367 (with-no-warnings
10368 (w32-shell-execute "open" (replace-regexp-in-string ;for UNC paths
10369 "/" "\\"
10370 (replace-regexp-in-string ; strip cygdrive paths
10371 "/cygdrive/\\(.\\)" "\\1:"
10372 file nil nil) nil t))))
10374 (defun anything-c-open-file-with-default-tool (file)
10375 "Open FILE with the default tool on this platform."
10376 (if (eq system-type 'windows-nt)
10377 (w32-shell-execute-open-file file)
10378 (start-process "anything-c-open-file-with-default-tool"
10380 (cond ((eq system-type 'gnu/linux)
10381 "xdg-open")
10382 ((or (eq system-type 'darwin) ;; Mac OS X
10383 (eq system-type 'macos)) ;; Mac OS 9
10384 "open"))
10385 file)))
10387 (defun anything-c-open-dired (file)
10388 "Opens a dired buffer in FILE's directory. If FILE is a
10389 directory, open this directory."
10390 (if (file-directory-p file)
10391 (dired file)
10392 (dired (file-name-directory file))
10393 (dired-goto-file file)))
10395 (defun anything-c-display-to-real-line (candidate)
10396 (if (string-match "^ *\\([0-9]+\\):\\(.*\\)$" candidate)
10397 (list (string-to-number (match-string 1 candidate)) (match-string 2 candidate))
10398 (error "Line number not found")))
10400 (defun anything-c-action-line-goto (lineno-and-content)
10401 (apply #'anything-goto-file-line (anything-interpret-value (anything-attr 'target-file))
10402 (append lineno-and-content
10403 (list (if (and (anything-attr-defined 'target-file)
10404 (not anything-in-persistent-action))
10405 'find-file-other-window
10406 'find-file)))))
10408 (defun* anything-c-action-file-line-goto (file-line-content &optional (find-file-function #'find-file))
10409 (apply #'anything-goto-file-line
10410 (if (stringp file-line-content)
10411 ;; Case: filtered-candidate-transformer is skipped
10412 (cdr (anything-c-filtered-candidate-transformer-file-line-1 file-line-content))
10413 file-line-content)))
10415 (require 'compile)
10416 (defun anything-c-filtered-candidate-transformer-file-line (candidates source)
10417 (delq nil (mapcar 'anything-c-filtered-candidate-transformer-file-line-1 candidates)))
10419 (defun anything-c-filtered-candidate-transformer-file-line-1 (candidate)
10420 (when (string-match "^\\(.+?\\):\\([0-9]+\\):\\(.*\\)$" candidate)
10421 (let ((filename (match-string 1 candidate))
10422 (lineno (match-string 2 candidate))
10423 (content (match-string 3 candidate)))
10424 (cons (format "%s:%s\n %s"
10425 (propertize filename 'face compilation-info-face)
10426 (propertize lineno 'face compilation-line-face)
10427 content)
10428 (list (expand-file-name
10429 filename
10430 (or (anything-interpret-value (anything-attr 'default-directory))
10431 (and (anything-candidate-buffer)
10432 (buffer-local-value
10433 'default-directory (anything-candidate-buffer)))))
10434 (string-to-number lineno) content)))))
10436 (defun* anything-goto-file-line (file lineno content &optional (find-file-function #'find-file))
10437 (anything-aif (anything-attr 'before-jump-hook)
10438 (funcall it))
10439 (when file (funcall find-file-function file))
10440 (if (anything-attr-defined 'adjust)
10441 (anything-c-goto-line-with-adjustment lineno content)
10442 (anything-goto-line lineno))
10443 (unless (anything-attr-defined 'recenter)
10444 (set-window-start (get-buffer-window anything-current-buffer) (point)))
10445 (anything-aif (anything-attr 'after-jump-hook)
10446 (funcall it))
10447 (when anything-in-persistent-action
10448 (anything-match-line-color-current-line)))
10450 (defun anything-find-file-as-root (candidate)
10451 (find-file (concat "/" anything-su-or-sudo "::" (expand-file-name candidate))))
10453 (defun anything-find-many-files (ignore)
10454 (mapc 'find-file (anything-marked-candidates)))
10456 ;; borrowed from etags.el
10457 ;; (anything-c-goto-line-with-adjustment (line-number-at-pos) ";; borrowed from etags.el")
10458 (defun anything-c-goto-line-with-adjustment (line line-content)
10459 (let ((startpos)
10460 offset found pat)
10461 ;; This constant is 1/2 the initial search window.
10462 ;; There is no sense in making it too small,
10463 ;; since just going around the loop once probably
10464 ;; costs about as much as searching 2000 chars.
10465 (setq offset 1000
10466 found nil
10467 pat (concat (if (eq selective-display t)
10468 "\\(^\\|\^m\\) *" "^ *") ;allow indent
10469 (regexp-quote line-content)))
10470 ;; If no char pos was given, try the given line number.
10471 (setq startpos (progn (anything-goto-line line) (point)))
10472 (or startpos (setq startpos (point-min)))
10473 ;; First see if the tag is right at the specified location.
10474 (goto-char startpos)
10475 (setq found (looking-at pat))
10476 (while (and (not found)
10477 (progn
10478 (goto-char (- startpos offset))
10479 (not (bobp))))
10480 (setq found
10481 (re-search-forward pat (+ startpos offset) t)
10482 offset (* 3 offset))) ; expand search window
10483 (or found
10484 (re-search-forward pat nil t)
10485 (error "not found")))
10486 ;; Position point at the right place
10487 ;; if the search string matched an extra Ctrl-m at the beginning.
10488 (and (eq selective-display t)
10489 (looking-at "\^m")
10490 (forward-char 1))
10491 (beginning-of-line))
10493 (anything-document-attribute 'default-directory "type . file-line"
10494 "`default-directory' to interpret file.")
10495 (anything-document-attribute 'before-jump-hook "type . file-line / line"
10496 "Function to call before jumping to the target location.")
10497 (anything-document-attribute 'after-jump-hook "type . file-line / line"
10498 "Function to call after jumping to the target location.")
10499 (anything-document-attribute 'adjust "type . file-line"
10500 "Search around line matching line contents.")
10501 (anything-document-attribute 'recenter "type . file-line / line"
10502 "`recenter' after jumping.")
10503 (anything-document-attribute 'target-file "type . line"
10504 "Goto line of target-file.")
10506 ;;;###autoload
10507 (defun anything-c-call-interactively (cmd-or-name)
10508 "Execute CMD-OR-NAME as Emacs command.
10509 It is added to `extended-command-history'.
10510 `anything-current-prefix-arg' is used as the command's prefix argument."
10511 (setq extended-command-history
10512 (cons (anything-c-stringify cmd-or-name)
10513 (delete (anything-c-stringify cmd-or-name) extended-command-history)))
10514 (let ((current-prefix-arg anything-current-prefix-arg)
10515 (cmd (anything-c-symbolify cmd-or-name)))
10516 (if (stringp (symbol-function cmd))
10517 (execute-kbd-macro (symbol-function cmd))
10518 (setq this-command cmd)
10519 (call-interactively cmd))))
10521 ;;;###autoload
10522 (defun anything-c-set-variable (var)
10523 "Set value to VAR interactively."
10524 (interactive)
10525 (let ((sym (anything-c-symbolify var)))
10526 (set sym (eval-minibuffer (format "Set %s: " var)
10527 (prin1-to-string (symbol-value sym))))))
10528 ;; (setq hh 12)
10529 ;; (anything-c-set-variable 'hh)
10533 ;;; Persistent Action Helpers
10536 (defvar anything-match-line-overlay-face nil)
10537 (defvar anything-match-line-overlay nil)
10539 (defun anything-match-line-color-current-line (&optional start end buf face rec)
10540 "Highlight and underline current position"
10541 (let ((args (list (or start (line-beginning-position))
10542 (or end (1+ (line-end-position)))
10543 buf)))
10544 (if (not anything-match-line-overlay)
10545 (setq anything-match-line-overlay (apply 'make-overlay args))
10546 (apply 'move-overlay anything-match-line-overlay args)))
10547 (overlay-put anything-match-line-overlay
10548 'face (or face anything-match-line-overlay-face))
10549 (when rec
10550 (goto-char start)
10551 (recenter)))
10553 (defalias 'anything-persistent-highlight-point 'anything-match-line-color-current-line)
10556 (setq anything-match-line-overlay-face 'anything-overlay-line-face)
10558 (defun anything-match-line-cleanup ()
10559 (when anything-match-line-overlay
10560 (delete-overlay anything-match-line-overlay)
10561 (setq anything-match-line-overlay nil)))
10563 (defun anything-match-line-update ()
10564 (when anything-match-line-overlay
10565 (delete-overlay anything-match-line-overlay)
10566 (anything-match-line-color-current-line)))
10568 (add-hook 'anything-cleanup-hook 'anything-match-line-cleanup)
10569 (add-hook 'anything-after-persistent-action-hook 'anything-match-line-update)
10572 ;;; Actions Transformers
10575 ;;; Files
10576 (defun anything-c-transform-file-load-el (actions candidate)
10577 "Add action to load the file CANDIDATE if it is an emacs lisp
10578 file. Else return ACTIONS unmodified."
10579 (if (member (file-name-extension candidate) '("el" "elc"))
10580 (append actions '(("Load Emacs Lisp File" . load-file)))
10581 actions))
10583 (defun anything-c-transform-file-browse-url (actions candidate)
10584 "Add an action to browse the file CANDIDATE if it in a html
10585 file or URL. Else return ACTIONS unmodified."
10586 (let ((browse-action '("Browse with Browser" . browse-url)))
10587 (cond ((string-match "^http\\|^ftp" candidate)
10588 (cons browse-action actions))
10589 ((string-match "\\.html?$" candidate)
10590 (append actions (list browse-action)))
10591 (t actions))))
10593 ;;; Function
10594 (defun anything-c-transform-function-call-interactively (actions candidate)
10595 "Add an action to call the function CANDIDATE interactively if
10596 it is a command. Else return ACTIONS unmodified."
10597 (if (commandp (intern-soft candidate))
10598 (append actions '(("Call Interactively"
10600 anything-c-call-interactively)))
10601 actions))
10603 ;;;; S-Expressions
10604 (defun anything-c-transform-sexp-eval-command-sexp (actions candidate)
10605 "If CANDIDATE's `car' is a command, then add an action to
10606 evaluate it and put it onto the `command-history'."
10607 (if (commandp (car (read candidate)))
10608 ;; Make it first entry
10609 (cons '("Eval and put onto command-history" .
10610 (lambda (sexp)
10611 (let ((sym (read sexp)))
10612 (eval sym)
10613 (setq command-history
10614 (cons sym command-history)))))
10615 actions)
10616 actions))
10619 ;;; Candidate Transformers
10622 ;;; Buffers
10623 (defun anything-c-skip-boring-buffers (buffers)
10624 (anything-c-skip-entries buffers anything-c-boring-buffer-regexp))
10626 (defun anything-c-skip-current-buffer (buffers)
10627 (if anything-allow-skipping-current-buffer
10628 (remove (buffer-name anything-current-buffer) buffers)
10629 buffers))
10631 (defun anything-c-shadow-boring-buffers (buffers)
10632 "Buffers matching `anything-c-boring-buffer-regexp' will be
10633 displayed with the `file-name-shadow' face if available."
10634 (anything-c-shadow-entries buffers anything-c-boring-buffer-regexp))
10636 (defvar anything-c-buffer-display-string-functions
10637 '(anything-c-buffer-display-string--compilation
10638 anything-c-buffer-display-string--shell
10639 anything-c-buffer-display-string--eshell)
10640 "Functions to setup display string for buffer.
10642 Function has one argument, buffer name.
10643 If it returns string, use it.
10644 If it returns nil, display buffer name.
10645 See `anything-c-buffer-display-string--compilation' for example.")
10647 (defun anything-c-transform-buffer-display-string (buffers)
10648 "Setup display string for buffer candidates
10649 using `anything-c-buffer-display-string-functions'."
10650 (loop for buf in buffers
10651 if (consp buf)
10652 collect buf
10653 else
10654 for disp = (progn (set-buffer buf)
10655 (run-hook-with-args-until-success
10656 'anything-c-buffer-display-string-functions buf))
10657 collect (if disp (cons disp buf) buf)))
10659 (defun anything-c-buffer-display-string--compilation (buf)
10660 (anything-aif (car compilation-arguments)
10661 (format "%s: %s [%s]" buf it default-directory)))
10663 (defun anything-c-buffer-display-string--eshell (buf)
10664 (declare (special eshell-history-ring))
10665 (when (eq major-mode 'eshell-mode)
10666 (format "%s: %s [%s]" buf
10667 (ignore-errors (ring-ref eshell-history-ring 0))
10668 default-directory)))
10670 (defun anything-c-buffer-display-string--shell (buf)
10671 (when (eq major-mode 'shell-mode)
10672 (format "%s: %s [%s]" buf
10673 (ignore-errors (ring-ref comint-input-ring 0))
10674 default-directory)))
10676 ;;; Files
10677 (defun anything-c-shadow-boring-files (files)
10678 "Files matching `anything-c-boring-file-regexp' will be
10679 displayed with the `file-name-shadow' face if available."
10680 (anything-c-shadow-entries files anything-c-boring-file-regexp))
10682 (defun anything-c-skip-boring-files (files)
10683 "Files matching `anything-c-boring-file-regexp' will be skipped."
10684 (anything-c-skip-entries files anything-c-boring-file-regexp))
10685 ;; (anything-c-skip-boring-files '("README" "/src/.svn/hoge"))
10687 (defun anything-c-skip-current-file (files)
10688 "Current file will be skipped."
10689 (remove (buffer-file-name anything-current-buffer) files))
10691 (defun anything-c-w32-pathname-transformer (args)
10692 "Change undesirable features of windows pathnames to ones more acceptable to
10693 other candidate transformers."
10694 (if (eq system-type 'windows-nt)
10695 (mapcar (lambda (x)
10696 (replace-regexp-in-string "/cygdrive/\\(.\\)" "\\1:" x))
10697 (mapcar (lambda (y)
10698 (replace-regexp-in-string "\\\\" "/" y)) args))
10699 args))
10701 (defun anything-c-shorten-home-path (files)
10702 "Replaces /home/user with ~."
10703 (let ((home (replace-regexp-in-string "\\\\" "/" ; stupid Windows...
10704 (getenv "HOME"))))
10705 (mapcar (lambda (file)
10706 (if (and (stringp file) (string-match home file))
10707 (cons (replace-match "~" nil nil file) file)
10708 file))
10709 files)))
10711 ;;; Functions
10712 (defun anything-c-mark-interactive-functions (functions)
10713 "Mark interactive functions (commands) with (i) after the function name."
10714 (let (list)
10715 (loop for function in functions
10716 do (push (cons (concat function
10717 (when (commandp (intern-soft function)) " (i)"))
10718 function)
10719 list)
10720 finally (return (nreverse list)))))
10723 ;;; Adaptive Sorting of Candidates
10726 ;; Internal
10727 (defvar anything-c-adaptive-done nil
10728 "nil if history information is not yet stored for the current
10729 selection.")
10731 (defvar anything-c-adaptive-history nil
10732 "Contains the stored history information.
10733 Format: ((SOURCE-NAME (SELECTED-CANDIDATE (PATTERN . NUMBER-OF-USE) ...) ...) ...)")
10735 (defadvice anything-initial-setup (before anything-c-adaptive-initialize activate)
10736 "Reset `anything-c-adaptive-done' when anything is started."
10737 (when anything-c-use-adaptative-sorting
10738 (setq anything-c-adaptive-done nil)))
10740 (defadvice anything-exit-minibuffer (before anything-c-adaptive-exit-minibuffer activate)
10741 "Store history information when action is executed on selected candidate."
10742 (when anything-c-use-adaptative-sorting
10743 (anything-c-adaptive-store-selection)))
10745 (defadvice anything-select-action (before anything-c-adaptive-select-action activate)
10746 "Store history information when the user goes to the action buffer."
10747 (when anything-c-use-adaptative-sorting
10748 (anything-c-adaptive-store-selection)))
10750 (defun anything-c-source-use-adaptative-p (&optional source-name)
10751 "Return current source only if it use adaptative history, nil otherwise."
10752 (when anything-c-use-adaptative-sorting
10753 (let* ((source (or source-name (anything-get-current-source)))
10754 (adapt-source (or (assoc-default 'filtered-candidate-transformer
10755 (assoc (assoc-default 'type source)
10756 anything-type-attributes))
10757 (assoc-default 'candidate-transformer
10758 (assoc (assoc-default 'type source)
10759 anything-type-attributes))
10760 (assoc-default 'filtered-candidate-transformer source)
10761 (assoc-default 'candidate-transformer source))))
10762 (if (listp adapt-source)
10763 (when (member 'anything-c-adaptive-sort adapt-source) source)
10764 (when (eq adapt-source 'anything-c-adaptive-sort) source)))))
10766 (defun anything-c-adaptive-store-selection ()
10767 "Store history information for the selected candidate."
10768 (unless anything-c-adaptive-done
10769 (setq anything-c-adaptive-done t)
10770 (let ((source (anything-c-source-use-adaptative-p)))
10771 (when source
10772 (let* ((source-name (or (assoc-default 'type source)
10773 (assoc-default 'name source)))
10774 (source-info (or (assoc source-name anything-c-adaptive-history)
10775 (progn
10776 (push (list source-name) anything-c-adaptive-history)
10777 (car anything-c-adaptive-history))))
10778 (selection (anything-get-selection))
10779 (selection-info (progn
10780 (setcdr source-info
10781 (cons
10782 (let ((found (assoc selection (cdr source-info))))
10783 (if (not found)
10784 ;; new entry
10785 (list selection)
10787 ;; move entry to the beginning of the
10788 ;; list, so that it doesn't get
10789 ;; trimmed when the history is
10790 ;; truncated
10791 (setcdr source-info
10792 (delete found (cdr source-info)))
10793 found))
10794 (cdr source-info)))
10795 (cadr source-info)))
10796 (pattern-info (progn
10797 (setcdr selection-info
10798 (cons
10799 (let ((found (assoc anything-pattern (cdr selection-info))))
10800 (if (not found)
10801 ;; new entry
10802 (cons anything-pattern 0)
10804 ;; move entry to the beginning of the
10805 ;; list, so if two patterns used the
10806 ;; same number of times then the one
10807 ;; used last appears first in the list
10808 (setcdr selection-info
10809 (delete found (cdr selection-info)))
10810 found))
10811 (cdr selection-info)))
10812 (cadr selection-info))))
10814 ;; increase usage count
10815 (setcdr pattern-info (1+ (cdr pattern-info)))
10817 ;; truncate history if needed
10818 (if (> (length (cdr selection-info)) anything-c-adaptive-history-length)
10819 (setcdr selection-info
10820 (subseq (cdr selection-info) 0 anything-c-adaptive-history-length))))))))
10822 (defun anything-c-adaptative-maybe-load-history ()
10823 (when (and anything-c-use-adaptative-sorting
10824 (file-readable-p anything-c-adaptive-history-file))
10825 (load-file anything-c-adaptive-history-file)))
10827 (add-hook 'emacs-startup-hook 'anything-c-adaptative-maybe-load-history)
10828 (add-hook 'kill-emacs-hook 'anything-c-adaptive-save-history)
10830 (defun anything-c-adaptive-save-history (&optional arg)
10831 "Save history information to file given by `anything-c-adaptive-history-file'."
10832 (interactive "p")
10833 (when anything-c-use-adaptative-sorting
10834 (with-temp-buffer
10835 (insert
10836 ";; -*- mode: emacs-lisp -*-\n"
10837 ";; History entries used for anything adaptive display.\n")
10838 (prin1 `(setq anything-c-adaptive-history ',anything-c-adaptive-history)
10839 (current-buffer))
10840 (insert ?\n)
10841 (write-region (point-min) (point-max) anything-c-adaptive-history-file nil
10842 (unless arg 'quiet)))))
10844 (defun anything-c-adaptive-sort (candidates source)
10845 "Sort the CANDIDATES for SOURCE by usage frequency.
10846 This is a filtered candidate transformer you can use for the
10847 attribute `filtered-candidate-transformer' of a source in
10848 `anything-sources' or a type in `anything-type-attributes'."
10849 (let* ((source-name (or (assoc-default 'type source)
10850 (assoc-default 'name source)))
10851 (source-info (assoc source-name anything-c-adaptive-history)))
10852 (if source-info
10853 (let ((usage
10854 ;; ... assemble a list containing the (CANIDATE . USAGE-COUNT)
10855 ;; pairs
10856 (mapcar (lambda (candidate-info)
10857 (let ((count 0))
10858 (dolist (pattern-info (cdr candidate-info))
10859 (if (not (equal (car pattern-info)
10860 anything-pattern))
10861 (incf count (cdr pattern-info))
10863 ;; if current pattern is equal to the previously
10864 ;; used one then this candidate has priority
10865 ;; (that's why its count is boosted by 10000) and
10866 ;; it only has to compete with other candidates
10867 ;; which were also selected with the same pattern
10868 (setq count (+ 10000 (cdr pattern-info)))
10869 (return)))
10870 (cons (car candidate-info) count)))
10871 (cdr source-info)))
10872 sorted)
10873 (if (and usage (consp usage))
10874 ;; sort the list in descending order, so candidates with highest
10875 ;; priorty come first
10876 (progn
10877 (setq usage (sort usage (lambda (first second)
10878 (> (cdr first) (cdr second)))))
10880 ;; put those candidates first which have the highest usage count
10881 (dolist (info usage)
10882 (when (member* (car info) candidates
10883 :test 'anything-c-adaptive-compare)
10884 (push (car info) sorted)
10885 (setq candidates (remove* (car info) candidates
10886 :test 'anything-c-adaptive-compare))))
10888 ;; and append the rest
10889 (append (reverse sorted) candidates nil))
10890 (message "Your `%s' is maybe corrupted or too old, \
10891 you should reinitialize it with `anything-c-reset-adaptative-history'"
10892 anything-c-adaptive-history-file)
10893 (sit-for 1)
10894 candidates))
10895 ;; if there is no information stored for this source then do nothing
10896 candidates)))
10898 ;;;###autoload
10899 (defun anything-c-reset-adaptative-history ()
10900 "Delete all `anything-c-adaptive-history' and his file.
10901 Useful when you have a old or corrupted `anything-c-adaptive-history-file'."
10902 (interactive)
10903 (when (y-or-n-p "Really delete all your `anything-c-adaptive-history'? ")
10904 (setq anything-c-adaptive-history nil)
10905 (delete-file anything-c-adaptive-history-file)))
10907 (defun anything-c-adaptive-compare (x y)
10908 "Compare candidates X and Y taking into account that the
10909 candidate can be in (DISPLAY . REAL) format."
10910 (equal (if (listp x)
10911 (cdr x)
10913 (if (listp y)
10914 (cdr y)
10915 y)))
10919 ;;; Outliner
10922 (defvar anything-outline-goto-near-line-flag t)
10923 (defvar anything-outline-using nil)
10924 (defun anything-after-update-hook--outline ()
10925 (if (and (eq anything-outline-using t)
10926 (eq anything-outline-goto-near-line-flag t))
10927 (anything-outline-goto-near-line)))
10928 (add-hook 'anything-after-update-hook 'anything-after-update-hook--outline)
10930 (defun anything-outline-goto-near-line ()
10931 (with-anything-window
10932 ;; TODO need consideration whether to update position by every input.
10933 (when t ; (equal anything-pattern "")
10934 (anything-goto-line 2)
10935 (let ((lineno (with-anything-current-buffer
10936 (line-number-at-pos (car anything-current-position)))))
10937 (block exit
10938 (while (<= (progn (skip-chars-forward " ")
10939 (or (number-at-point) lineno))
10940 lineno)
10941 (forward-line 1)
10942 (when (eobp)
10943 (forward-line -1)
10944 (return-from exit))))
10945 (forward-line -1)
10946 (and (bobp) (forward-line 1))
10947 (and (anything-pos-header-line-p) (forward-line -2))
10948 (anything-mark-current-line)))))
10952 ;;; Plug-in
10955 ;; Plug-in: info-index
10956 (defun* anything-c-info-init (&optional (file (anything-attr 'info-file)))
10957 (let (result)
10958 (unless (anything-candidate-buffer)
10959 (save-window-excursion
10960 (info file)
10961 (let (Info-history
10962 (tobuf (anything-candidate-buffer 'global))
10963 (infobuf (current-buffer))
10964 s e)
10965 (dolist (node (or (anything-attr 'index-nodes) (Info-index-nodes)))
10966 (Info-goto-node node)
10967 (goto-char (point-min))
10968 (while (search-forward "\n* " nil t)
10969 (unless (search-forward "Menu:\n" (1+ (point-at-eol)) t)
10970 '(save-current-buffer (buffer-substring-no-properties (point-at-bol) (point-at-eol)) result)
10971 (setq s (point-at-bol)
10972 e (point-at-eol))
10973 (with-current-buffer tobuf
10974 (insert-buffer-substring infobuf s e)
10975 (insert "\n"))))))))))
10977 (defun anything-c-info-goto (node-line)
10978 (Info-goto-node (car node-line))
10979 (anything-goto-line (cdr node-line)))
10981 (defun anything-c-info-display-to-real (line)
10982 (and (string-match
10983 ;; This regexp is stolen from Info-apropos-matches
10984 "\\* +\\([^\n]*.+[^\n]*\\):[ \t]+\\([^\n]*\\)\\.\\(?:[ \t\n]*(line +\\([0-9]+\\))\\)?" line)
10985 (cons (format "(%s)%s" (anything-attr 'info-file) (match-string 2 line))
10986 (string-to-number (or (match-string 3 line) "1")))))
10988 (defun anything-c-make-info-source (source file)
10989 `(,@source
10990 (name . ,(concat "Info Index: " file))
10991 (info-file . ,file)
10992 (init . anything-c-info-init)
10993 (display-to-real . anything-c-info-display-to-real)
10994 (get-line . buffer-substring)
10995 (candidates-in-buffer)
10996 (action ("Goto node" . anything-c-info-goto))))
10998 (defun anything-compile-source--info-index (source)
10999 (anything-aif (anything-interpret-value (assoc-default 'info-index source))
11000 (anything-c-make-info-source source it)
11001 source))
11002 (add-to-list 'anything-compile-source-functions 'anything-compile-source--info-index)
11004 (anything-document-attribute 'info-index "info-index plugin"
11005 "Create a source of info index very easily.
11007 ex. (defvar anything-c-source-info-wget '((info-index . \"wget\"))")
11009 (anything-document-attribute 'index-nodes "info-index plugin (optional)"
11010 "Index nodes of info file.
11012 If it is omitted, `Info-index-nodes' is used to collect index nodes.
11013 Some info files are missing index specification.
11015 ex. See `anything-c-source-info-screen'.")
11017 ;; Plug-in: candidates-file
11018 (defun anything-compile-source--candidates-file (source)
11019 (if (assoc-default 'candidates-file source)
11020 `((init anything-p-candidats-file-init
11021 ,@(let ((orig-init (assoc-default 'init source)))
11022 (cond ((null orig-init) nil)
11023 ((functionp orig-init) (list orig-init))
11024 (t orig-init))))
11025 (candidates-in-buffer)
11026 ,@source)
11027 source))
11028 (add-to-list 'anything-compile-source-functions 'anything-compile-source--candidates-file)
11030 (defun anything-p-candidats-file-init ()
11031 (destructuring-bind (file &optional updating)
11032 (anything-mklist (anything-attr 'candidates-file))
11033 (setq file (anything-interpret-value file))
11034 (with-current-buffer (anything-candidate-buffer (find-file-noselect file))
11035 (when updating
11036 (buffer-disable-undo)
11037 (font-lock-mode -1)
11038 (auto-revert-mode 1)))))
11040 (anything-document-attribute 'candidates-file "candidates-file plugin"
11041 "Use a file as the candidates buffer.
11043 1st argument is a filename, string or function name or variable name.
11044 If optional 2nd argument is non-nil, the file opened with `auto-revert-mode'.")
11046 ;; Plug-in: headline
11047 (defun anything-compile-source--anything-headline (source)
11048 (if (assoc-default 'headline source)
11049 (append '((init . anything-headline-init)
11050 (get-line . buffer-substring)
11051 (type . line))
11052 source
11053 '((candidates-in-buffer)
11054 (persistent-help . "Show this line")))
11055 source))
11056 (add-to-list 'anything-compile-source-functions 'anything-compile-source--anything-headline)
11058 (defun anything-headline-init ()
11059 (when (and (anything-current-buffer-is-modified)
11060 (with-anything-current-buffer
11061 (eval (or (anything-attr 'condition) t))))
11062 (anything-headline-make-candidate-buffer
11063 (anything-interpret-value (anything-attr 'headline))
11064 (anything-interpret-value (anything-attr 'subexp)))))
11066 (anything-document-attribute 'headline "Headline plug-in"
11067 "Regexp string for anything-headline to scan.")
11068 (anything-document-attribute 'condition "Headline plug-in"
11069 "A sexp representing the condition to use anything-headline.")
11070 (anything-document-attribute 'subexp "Headline plug-in"
11071 "Display (match-string-no-properties subexp).")
11074 (defun anything-headline-get-candidates (regexp subexp)
11075 (with-anything-current-buffer
11076 (save-excursion
11077 (goto-char (point-min))
11078 (if (functionp regexp) (setq regexp (funcall regexp)))
11079 (let (hierarchy curhead)
11080 (flet ((matched ()
11081 (if (numberp subexp)
11082 (cons (match-string-no-properties subexp) (match-beginning subexp))
11083 (cons (buffer-substring (point-at-bol) (point-at-eol))
11084 (point-at-bol))))
11085 (hierarchies (headlines)
11086 (1+ (loop for (_ . hierarchy) in headlines
11087 maximize hierarchy)))
11088 (vector-0-n (v n)
11089 (loop for i from 0 to hierarchy
11090 collecting (aref curhead i)))
11091 (arrange (headlines)
11092 (unless (null headlines) ; FIX headlines empty bug!
11093 (loop with curhead = (make-vector (hierarchies headlines) "")
11094 for ((str . pt) . hierarchy) in headlines
11095 do (aset curhead hierarchy str)
11096 collecting
11097 (cons
11098 (format "H%d:%s" (1+ hierarchy)
11099 (mapconcat 'identity (vector-0-n curhead hierarchy) " / "))
11100 pt)))))
11101 (if (listp regexp)
11102 (arrange
11103 (sort
11104 (loop for re in regexp
11105 for hierarchy from 0
11106 do (goto-char (point-min))
11107 appending
11108 (loop
11109 while (re-search-forward re nil t)
11110 collect (cons (matched) hierarchy)))
11111 (lambda (a b) (> (cdar b) (cdar a)))))
11112 (loop while (re-search-forward regexp nil t)
11113 collect (matched))))))))
11116 (defun anything-headline-make-candidate-buffer (regexp subexp)
11117 (with-current-buffer (anything-candidate-buffer 'local)
11118 (loop for (content . pos) in (anything-headline-get-candidates regexp subexp)
11119 do (insert
11120 (format "%5d:%s\n"
11121 (with-anything-current-buffer
11122 (line-number-at-pos pos))
11123 content)))))
11125 (defun anything-headline-goto-position (pos recenter)
11126 (goto-char pos)
11127 (unless recenter
11128 (set-window-start (get-buffer-window anything-current-buffer) (point))))
11131 ;; Plug-in: persistent-help
11132 (defun anything-compile-source--persistent-help (source)
11133 (append source '((header-line . anything-persistent-help-string))))
11134 (add-to-list 'anything-compile-source-functions 'anything-compile-source--persistent-help)
11136 (defun anything-persistent-help-string ()
11137 (substitute-command-keys
11138 (concat "\\<anything-map>\\[anything-execute-persistent-action]: "
11139 (or (anything-interpret-value (anything-attr 'persistent-help))
11140 (anything-aif (or (assoc-default 'persistent-action
11141 (anything-get-current-source))
11142 (assoc-default 'action
11143 (anything-get-current-source)))
11144 (cond ((symbolp it) (symbol-name it))
11145 ((listp it) (or (ignore-errors (caar it)) ""))))
11147 " (keeping session)")))
11149 (anything-document-attribute 'persistent-help "persistent-help plug-in"
11150 "A string to explain persistent-action of this source.
11151 It also accepts a function or a variable name.")
11153 ;;; (anything '(((name . "persistent-help test")(candidates "a")(persistent-help . "TEST"))))
11155 ;; Plug-in: Type customize
11156 (defun anything-c-uniq-list (lst)
11157 "Like `remove-duplicates' in CL.
11158 But cut deeper duplicates and test by `equal'. "
11159 (reverse (remove-duplicates (reverse lst) :test 'equal)))
11160 (defvar anything-additional-type-attributes nil)
11161 (defun anything-c-arrange-type-attribute (type spec)
11162 "Override type attributes by `define-anything-type-attribute'.
11164 The SPEC is like source. The symbol `REST' is replaced with original attribute value.
11166 Example: Set `play-sound-file' as default action
11167 (anything-c-arrange-type-attribute 'file
11168 '((action (\"Play sound\" . play-sound-file)
11169 REST ;; Rest of actions (find-file, find-file-other-window, ...)
11172 (add-to-list 'anything-additional-type-attributes
11173 (cons type
11174 (loop with typeattr = (assoc-default type anything-type-attributes)
11175 for (attr . value) in spec
11176 if (listp value)
11177 collect (cons attr
11178 (anything-c-uniq-list
11179 (loop for v in value
11180 if (eq v 'REST)
11181 append (assoc-default attr typeattr)
11182 else
11183 collect v)))
11184 else
11185 collect (cons attr value)))))
11186 (put 'anything-c-arrange-type-attribute 'lisp-indent-function 1)
11188 (defun anything-compile-source--type-customize (source)
11189 (anything-aif (assoc-default (assoc-default 'type source) anything-additional-type-attributes)
11190 (append it source)
11191 source))
11192 (add-to-list 'anything-compile-source-functions 'anything-compile-source--type-customize t)
11194 ;; Plug-in: default-action
11195 (defun anything-compile-source--default-action (source)
11196 (anything-aif (assoc-default 'default-action source)
11197 (append `((action ,it ,@(remove it (assoc-default 'action source))))
11198 source)
11199 source))
11200 (add-to-list 'anything-compile-source-functions 'anything-compile-source--default-action t)
11201 (anything-document-attribute 'default-action "default-action plug-in"
11202 "Default action.")
11205 ;;; Toggle anything-match-plugin
11208 (defvar anything-mp-initial-highlight-delay nil)
11210 ;;;###autoload
11211 (defun anything-c-toggle-match-plugin ()
11212 "Toggle anything-match-plugin."
11213 (interactive)
11214 (let ((anything-match-plugin-enabled
11215 (member 'anything-compile-source--match-plugin
11216 anything-compile-source-functions)))
11217 (flet ((disable-match-plugin ()
11218 (setq anything-compile-source-functions
11219 (delq 'anything-compile-source--match-plugin
11220 anything-compile-source-functions))
11221 (setq anything-mp-initial-highlight-delay
11222 anything-mp-highlight-delay)
11223 (setq anything-mp-highlight-delay nil))
11224 (enable-match-plugin ()
11225 (require 'anything-match-plugin)
11226 (unless anything-mp-initial-highlight-delay
11227 (setq anything-mp-initial-highlight-delay
11228 anything-mp-highlight-delay))
11229 (setq anything-compile-source-functions
11230 (cons 'anything-compile-source--match-plugin
11231 anything-compile-source-functions))
11232 (unless anything-mp-highlight-delay
11233 (setq anything-mp-highlight-delay
11234 anything-mp-initial-highlight-delay))))
11235 (if anything-match-plugin-enabled
11236 (when (y-or-n-p "Really disable match-plugin? ")
11237 (disable-match-plugin)
11238 (message "Anything-match-plugin disabled"))
11239 (when (y-or-n-p "Really enable match-plugin? ")
11240 (enable-match-plugin)
11241 (message "Anything-match-plugin enabled"))))))
11245 ;;; Type Attributes
11248 (define-anything-type-attribute 'buffer
11249 `((action
11250 ("Switch to buffer" . anything-c-switch-to-buffer)
11251 ,(and (locate-library "popwin") '("Switch to buffer in popup window" . popwin:popup-buffer))
11252 ("Switch to buffer other window" . switch-to-buffer-other-window)
11253 ("Switch to buffer other frame" . switch-to-buffer-other-frame)
11254 ,(and (locate-library "elscreen") '("Display buffer in Elscreen" . anything-find-buffer-on-elscreen))
11255 ("Query replace regexp" . anything-c-buffer-query-replace-regexp)
11256 ("View buffer" . view-buffer)
11257 ("Display buffer" . display-buffer)
11258 ("Grep buffers (C-u grep all buffers)" . anything-c-grep-buffers)
11259 ("Revert buffer(s)" . anything-revert-marked-buffers)
11260 ("Insert buffer" . insert-buffer)
11261 ("Kill buffer(s)" . anything-kill-marked-buffers)
11262 ("Diff with file" . diff-buffer-with-file)
11263 ("Ediff Marked buffers" . anything-ediff-marked-buffers)
11264 ("Ediff Merge marked buffers" . (lambda (candidate)
11265 (anything-ediff-marked-buffers candidate t))))
11266 (persistent-help . "Show this buffer")
11267 (candidate-transformer anything-c-skip-current-buffer
11268 anything-c-skip-boring-buffers
11269 anything-c-transform-buffer-display-string))
11270 "Buffer or buffer name.")
11272 (define-anything-type-attribute 'file
11273 `((action
11274 ("Find file" . anything-find-many-files)
11275 ,(and (locate-library "popwin") '("Find file in popup window" . popwin:find-file))
11276 ("Find file as root" . anything-find-file-as-root)
11277 ("Find file other window" . find-file-other-window)
11278 ("Find file other frame" . find-file-other-frame)
11279 ("Open dired in file's directory" . anything-c-open-dired)
11280 ("Grep File(s) `C-u recurse'" . anything-find-files-grep)
11281 ("Pdfgrep File(s)" . anything-ff-pdfgrep)
11282 ("Checksum File" . anything-ff-checksum)
11283 ("View file" . view-file)
11284 ("Insert file" . insert-file)
11285 ("Delete file(s)" . anything-delete-marked-files)
11286 ("Open file externally (C-u to choose)" . anything-c-open-file-externally)
11287 ("Open file with default tool" . anything-c-open-file-with-default-tool)
11288 ("Find file in hex dump" . hexl-find-file))
11289 (persistent-help . "Show this file")
11290 (action-transformer anything-c-transform-file-load-el
11291 anything-c-transform-file-browse-url)
11292 (candidate-transformer anything-c-w32-pathname-transformer
11293 anything-c-skip-current-file
11294 anything-c-skip-boring-files
11295 anything-c-shorten-home-path))
11296 "File name.")
11298 (let ((actions '(("Describe command" . describe-function)
11299 ("Add command to kill ring" . anything-c-kill-new)
11300 ("Go to command's definition" . find-function)
11301 ("Debug on entry" . debug-on-entry)
11302 ("Cancel debug on entry" . cancel-debug-on-entry)
11303 ("Trace function" . trace-function)
11304 ("Trace function (background)" . trace-function-background)
11305 ("Untrace function" . untrace-function))))
11306 (define-anything-type-attribute 'command
11307 `((action ("Call interactively" . anything-c-call-interactively)
11308 ,@actions)
11309 ;; Sort commands according to their usage count.
11310 ;(filtered-candidate-transformer . anything-c-adaptive-sort)
11311 (coerce . anything-c-symbolify)
11312 (persistent-action . describe-function))
11313 "Command. (string or symbol)")
11315 (define-anything-type-attribute 'function
11316 `((action . ,actions)
11317 (action-transformer anything-c-transform-function-call-interactively)
11318 (candidate-transformer anything-c-mark-interactive-functions)
11319 (coerce . anything-c-symbolify))
11320 "Function. (string or symbol)"))
11322 (define-anything-type-attribute 'variable
11323 '((action ("Describe variable" . describe-variable)
11324 ("Add variable to kill ring" . anything-c-kill-new)
11325 ("Go to variable's definition" . find-variable)
11326 ("Set variable" . anything-c-set-variable))
11327 (coerce . anything-c-symbolify))
11328 "Variable.")
11330 (define-anything-type-attribute 'sexp
11331 '((action ("Eval s-expression" . (lambda (c) (eval (read c))))
11332 ("Add s-expression to kill ring" . kill-new))
11333 (action-transformer anything-c-transform-sexp-eval-command-sexp))
11334 "String representing S-Expressions.")
11336 (define-anything-type-attribute 'bookmark
11337 `((coerce . anything-bookmark-get-bookmark-from-name)
11338 (action
11339 ("Jump to bookmark" . (lambda (bookmark)
11340 (let ((current-prefix-arg anything-current-prefix-arg))
11341 (bookmark-jump bookmark))
11342 (anything-update)))
11343 ("Jump to BM other window" . (lambda (bookmark)
11344 (bookmark-jump-other-window bookmark)
11345 (anything-update)))
11346 ("Bookmark edit annotation" . bookmark-edit-annotation)
11347 ("Bookmark show annotation" . bookmark-show-annotation)
11348 ("Delete bookmark(s)" . anything-delete-marked-bookmarks)
11349 ,@(and (locate-library "bookmark-extensions")
11350 `(("Edit Bookmark" . bmkext-edit-bookmark)))
11351 ("Rename bookmark" . bookmark-rename)
11352 ("Relocate bookmark" . bookmark-relocate)))
11353 "Bookmark name.")
11355 (define-anything-type-attribute 'line
11356 '((display-to-real . anything-c-display-to-real-line)
11357 (action ("Go to Line" . anything-c-action-line-goto)))
11358 "LINENO:CONTENT string, eg. \" 16:foo\".
11360 Optional `target-file' attribute is a name of target file.
11362 Optional `before-jump-hook' attribute is a function with no
11363 arguments which is called before jumping to position.
11365 Optional `after-jump-hook' attribute is a function with no
11366 arguments which is called after jumping to position.
11368 If `adjust' attribute is specified, searches the line whose
11369 content is CONTENT near the LINENO.
11371 If `recenter' attribute is specified, the line is displayed at
11372 the center of window, otherwise at the top of window.
11375 (define-anything-type-attribute 'file-line
11376 `((filtered-candidate-transformer anything-c-filtered-candidate-transformer-file-line)
11377 (multiline)
11378 (action ("Go to" . anything-c-action-file-line-goto)))
11379 "FILENAME:LINENO:CONTENT string, eg. \"~/.emacs:16:;; comment\".
11381 Optional `default-directory' attribute is a default-directory
11382 FILENAME is interpreted.
11384 Optional `before-jump-hook' attribute is a function with no
11385 arguments which is called before jumping to position.
11387 Optional `after-jump-hook' attribute is a function with no
11388 arguments which is called after jumping to position.
11390 If `adjust' attribute is specified, searches the line whose
11391 content is CONTENT near the LINENO.
11393 If `recenter' attribute is specified, the line is displayed at
11394 the center of window, otherwise at the top of window.
11397 (define-anything-type-attribute 'timer
11398 '((real-to-display . anything-c-timer-real-to-display)
11399 (action ("Cancel Timer" . cancel-timer)
11400 ("Describe Function" . (lambda (tm) (describe-function (timer--function tm))))
11401 ("Find Function" . (lambda (tm) (find-function (timer--function tm)))))
11402 (persistent-action . (lambda (tm) (describe-function (timer--function tm))))
11403 (persistent-help . "Describe Function"))
11404 "Timer.")
11406 ;;;; Default `anything-sources'
11407 ;; Setting `anything-sources' is DEPRECATED, but it seems that newbies
11408 ;; tend to invoke M-x anything directly. So I offer default setting.
11409 (setq anything-sources
11410 '(anything-c-source-buffers-list
11411 anything-c-source-recentf
11412 anything-c-source-files-in-current-dir+))
11414 ;;; Unit tests are now in ../developer-tools/unit-test-anything-config.el.
11416 (provide 'anything-config)
11418 ;;; Local Variables:
11419 ;;; time-stamp-format: "%:y-%02m-%02d %02H:%02M:%02S (%Z) %u"
11420 ;;; End:
11422 ;; How to save (DO NOT REMOVE!!)
11423 ;; (progn (magit-push) (emacswiki-post "anything-config.el"))
11424 ;;; anything-config.el ends here
11426 ;;; LocalWords: Tassilo Patrovics Vagn Johansen Dahl Clementson infos
11427 ;;; LocalWords: Kamphausen informations McBrayer Volpiatto bbdb bb
11428 ;;; LocalWords: iswitchb imenu Recentf sym samewindow pos bol eol
11429 ;;; LocalWords: aif str lst func attrib recentf lessp prin mapatoms commandp
11430 ;;; LocalWords: cmd stb Picklist picklist mapcan subentry destructuring dirs
11431 ;;; LocalWords: darwin locat MacOS mdfind Firstname Lastname calc prepend jids
11432 ;;; LocalWords: dotimes Thierry online vname
11433 ;;; LocalWords: csharp javascript lua makefile cperl zcat lineno buf
11434 ;;; LocalWords: multiline href fn cand NewTitle cwd filepath thru ret
11435 ;;; LocalWords: bfn fOpen UNC cygdrive nt xdg macos FILE's elc rx svn hg
11436 ;;; LocalWords: CANDIDATE's darcs facep pathname args pathnames subseq priorty
11437 ;;; LocalWords: Vokes rfind berkeley JST ffap lacarte bos
11438 ;;; LocalWords: Lacarte Minibuf epp LaCarte bm attrset migemo attr conf mklist
11439 ;;; LocalWords: startpos noselect dont desc