* anything-config.el (anything-ff-update-when-only-one-matched): Add / to fname when...
[anything-config.git] / anything-config.el
blob4e3dd09809c6875e621cddb97095a8798d161bc9
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 ;; URL: http://www.emacswiki.org/emacs/download/anything-config.el
17 ;; Keywords: anything, anything-config
18 ;; Compatibility: GNU Emacs 22 ~ 23
20 ;; Features that might be required by this library:
22 ;; `anything'
25 ;;; This file is NOT part of GNU Emacs
27 ;;; License
29 ;; This program is free software; you can redistribute it and/or modify
30 ;; it under the terms of the GNU General Public License as published by
31 ;; the Free Software Foundation; either version 3, or (at your option)
32 ;; any later version.
34 ;; This program is distributed in the hope that it will be useful,
35 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
36 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
37 ;; GNU General Public License for more details.
39 ;; You should have received a copy of the GNU General Public License
40 ;; along with this program; see the file COPYING. If not, write to
41 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
42 ;; Floor, Boston, MA 02110-1301, USA.
44 ;;; !NOTICE!
46 ;; If this file does not work, upgrade anything.el!
47 ;; http://www.emacswiki.org/cgi-bin/wiki/download/anything.el
49 ;;; Commentary:
51 ;; Predefined configurations for `anything.el'
53 ;; For quick start, try `anything-for-files' to open files.
55 ;; To configure anything you should define anything command
56 ;; with your favorite sources, like below:
58 ;; (defun my-anything ()
59 ;; (interactive)
60 ;; (anything-other-buffer
61 ;; '(anything-c-source-buffers
62 ;; anything-c-source-file-name-history
63 ;; anything-c-source-info-pages
64 ;; anything-c-source-info-elisp
65 ;; anything-c-source-man-pages
66 ;; anything-c-source-locate
67 ;; anything-c-source-emacs-commands)
68 ;; " *my-anything*"))
70 ;; Then type M-x my-anything to use sources.
72 ;; Defining own command is better than setup `anything-sources'
73 ;; directly, because you can define multiple anything commands with
74 ;; different sources. Each anything command should have own anything
75 ;; buffer, because M-x anything-resume revives anything command.
77 ;;; Autodoc documentation:
78 ;; ---------------------
80 ;; * Commands defined here are:
81 ;; [EVAL] (autodoc-document-lisp-buffer :type 'command :prefix "anything-" :docstring t)
82 ;; `anything-configuration'
83 ;; Customize `anything'.
84 ;; `anything-mini'
85 ;; Preconfigured `anything' lightweight version (buffer -> recentf).
86 ;; `anything-for-files'
87 ;; Preconfigured `anything' for opening files.
88 ;; `anything-recentf'
89 ;; Preconfigured `anything' for `recentf'.
90 ;; `anything-info-at-point'
91 ;; Preconfigured `anything' for searching info at point.
92 ;; `anything-info-emacs'
93 ;; Preconfigured anything for Emacs manual index.
94 ;; `anything-show-kill-ring'
95 ;; Preconfigured `anything' for `kill-ring'.
96 ;; `anything-minibuffer-history'
97 ;; Preconfigured `anything' for `minibuffer-history'.
98 ;; `anything-gentoo'
99 ;; Preconfigured `anything' for gentoo linux.
100 ;; `anything-imenu'
101 ;; Preconfigured `anything' for `imenu'.
102 ;; `anything-google-suggest'
103 ;; Preconfigured `anything' for google search with google suggest.
104 ;; `anything-yahoo-suggest'
105 ;; Preconfigured `anything' for Yahoo searching with Yahoo suggest.
106 ;; `anything-for-buffers'
107 ;; Preconfigured `anything' for buffer.
108 ;; `anything-buffers-list'
109 ;; Enhanced preconfigured `anything' for buffer.
110 ;; `anything-bbdb'
111 ;; Preconfigured `anything' for BBDB.
112 ;; `anything-locate'
113 ;; Preconfigured `anything' for Locate.
114 ;; `anything-w3m-bookmarks'
115 ;; Preconfigured `anything' for w3m bookmark.
116 ;; `anything-firefox-bookmarks'
117 ;; Preconfigured `anything' for firefox bookmark.
118 ;; `anything-colors'
119 ;; Preconfigured `anything' for color.
120 ;; `anything-bookmarks'
121 ;; Preconfigured `anything' for bookmarks.
122 ;; `anything-c-pp-bookmarks'
123 ;; Preconfigured `anything' for bookmarks (pretty-printed).
124 ;; `anything-c-insert-latex-math'
125 ;; Preconfigured anything for latex math symbols completion.
126 ;; `anything-register'
127 ;; Preconfigured `anything' for Emacs registers.
128 ;; `anything-man-woman'
129 ;; Preconfigured `anything' for Man and Woman pages.
130 ;; `anything-org-keywords'
131 ;; Preconfigured `anything' for org keywords.
132 ;; `anything-emms'
133 ;; Preconfigured `anything' for emms sources.
134 ;; `anything-eev-anchors'
135 ;; Preconfigured `anything' for eev anchors.
136 ;; `anything-bm-list'
137 ;; Preconfigured `anything' for visible bookmarks.
138 ;; `anything-timers'
139 ;; Preconfigured `anything' for timers.
140 ;; `anything-list-emacs-process'
141 ;; Preconfigured `anything' for emacs process.
142 ;; `anything-occur'
143 ;; Preconfigured Anything for Occur source.
144 ;; `anything-browse-code'
145 ;; Preconfigured anything to browse code.
146 ;; `anything-org-headlines'
147 ;; Preconfigured anything to show org headlines.
148 ;; `anything-info-gnus'
149 ;; Preconfigured anything to browse Gnus Manual.
150 ;; `anything-regexp'
151 ;; Preconfigured anything to build regexps and run query-replace-regexp against.
152 ;; `anything-test-sources'
153 ;; List all anything sources for test.
154 ;; `anything-select-source'
155 ;; Select source.
156 ;; `anything-mark-all'
157 ;; Mark all visible unmarked candidates in current source.
158 ;; `anything-unmark-all'
159 ;; Unmark all candidates in all sources of current anything session.
160 ;; `anything-toggle-all-marks'
161 ;; Toggle all marks.
162 ;; `anything-c-buffer-help'
163 ;; Help command for anything buffers.
164 ;; `anything-buffer-diff-persistent'
165 ;; Toggle diff buffer without quitting anything.
166 ;; `anything-buffer-revert-persistent'
167 ;; Revert buffer without quitting anything.
168 ;; `anything-buffer-save-persistent'
169 ;; Save buffer without quitting anything.
170 ;; `anything-buffer-run-kill-buffers'
171 ;; Run kill buffer action from `anything-c-source-buffer+'.
172 ;; `anything-buffer-run-grep'
173 ;; Run Grep action from `anything-c-source-buffer+'.
174 ;; `anything-buffer-run-zgrep'
175 ;; Run Grep action from `anything-c-source-buffer+'.
176 ;; `anything-buffer-run-query-replace-regexp'
177 ;; Run Query replace regexp action from `anything-c-source-buffer+'.
178 ;; `anything-buffer-run-query-replace'
179 ;; Run Query replace action from `anything-c-source-buffer+'.
180 ;; `anything-buffer-switch-other-window'
181 ;; Run switch to other window action from `anything-c-source-buffer+'.
182 ;; `anything-buffer-switch-other-frame'
183 ;; Run switch to other frame action from `anything-c-source-buffer+'.
184 ;; `anything-buffer-switch-to-elscreen'
185 ;; Run switch to elscreen action from `anything-c-source-buffer+'.
186 ;; `anything-c-copy-files-async'
187 ;; Preconfigured anything to copy file list FLIST to DEST asynchronously.
188 ;; `anything-ff-help'
189 ;; Help command for `anything-find-files'.
190 ;; `anything-ff-run-toggle-auto-update'
191 ;; Not documented.
192 ;; `anything-ff-run-switch-to-history'
193 ;; Run Switch to history action from `anything-c-source-find-files'.
194 ;; `anything-ff-run-grep'
195 ;; Run Grep action from `anything-c-source-find-files'.
196 ;; `anything-ff-run-pdfgrep'
197 ;; Run Pdfgrep action from `anything-c-source-find-files'.
198 ;; `anything-ff-run-zgrep'
199 ;; Run Grep action from `anything-c-source-find-files'.
200 ;; `anything-ff-run-copy-file'
201 ;; Run Copy file action from `anything-c-source-find-files'.
202 ;; `anything-ff-run-rename-file'
203 ;; Run Rename file action from `anything-c-source-find-files'.
204 ;; `anything-ff-run-byte-compile-file'
205 ;; Run Byte compile file action from `anything-c-source-find-files'.
206 ;; `anything-ff-run-load-file'
207 ;; Run Load file action from `anything-c-source-find-files'.
208 ;; `anything-ff-run-eshell-command-on-file'
209 ;; Run eshell command on file action from `anything-c-source-find-files'.
210 ;; `anything-ff-run-ediff-file'
211 ;; Run Ediff file action from `anything-c-source-find-files'.
212 ;; `anything-ff-run-ediff-merge-file'
213 ;; Run Ediff merge file action from `anything-c-source-find-files'.
214 ;; `anything-ff-run-symlink-file'
215 ;; Run Symlink file action from `anything-c-source-find-files'.
216 ;; `anything-ff-run-delete-file'
217 ;; Run Delete file action from `anything-c-source-find-files'.
218 ;; `anything-ff-run-complete-fn-at-point'
219 ;; Run complete file name action from `anything-c-source-find-files'.
220 ;; `anything-ff-run-switch-to-eshell'
221 ;; Run switch to eshell action from `anything-c-source-find-files'.
222 ;; `anything-ff-run-switch-other-window'
223 ;; Run switch to other window action from `anything-c-source-find-files'.
224 ;; `anything-ff-run-switch-other-frame'
225 ;; Run switch to other frame action from `anything-c-source-find-files'.
226 ;; `anything-ff-run-open-file-externally'
227 ;; Run open file externally command action from `anything-c-source-find-files'.
228 ;; `anything-ff-run-gnus-attach-files'
229 ;; Run gnus attach files command action from `anything-c-source-find-files'.
230 ;; `anything-ff-run-etags'
231 ;; Run Etags command action from `anything-c-source-find-files'.
232 ;; `anything-ff-run-print-file'
233 ;; Run Print file action from `anything-c-source-find-files'.
234 ;; `anything-find-files-down-one-level'
235 ;; Go down one level like unix command `cd ..'.
236 ;; `anything-ff-properties-persistent'
237 ;; Show properties without quitting anything.
238 ;; `anything-ff-run-kill-buffer-persistent'
239 ;; Execute `anything-ff-kill-buffer-fname' whitout quitting.
240 ;; `anything-ff-rotate-left-persistent'
241 ;; Rotate image left without quitting anything.
242 ;; `anything-ff-rotate-right-persistent'
243 ;; Rotate image right without quitting anything.
244 ;; `anything-find-files'
245 ;; Preconfigured `anything' for anything implementation of `find-file'.
246 ;; `anything-write-file'
247 ;; Preconfigured `anything' providing completion for `write-file'.
248 ;; `anything-insert-file'
249 ;; Preconfigured `anything' providing completion for `insert-file'.
250 ;; `anything-dired-rename-file'
251 ;; Preconfigured `anything' to rename files from dired.
252 ;; `anything-dired-copy-file'
253 ;; Preconfigured `anything' to copy files from dired.
254 ;; `anything-dired-symlink-file'
255 ;; Preconfigured `anything' to symlink files from dired.
256 ;; `anything-dired-hardlink-file'
257 ;; Preconfigured `anything' to hardlink files from dired.
258 ;; `anything-generic-file-help'
259 ;; Not documented.
260 ;; `anything-do-grep'
261 ;; Preconfigured anything for grep.
262 ;; `anything-c-goto-precedent-file'
263 ;; Go to precedent file in anything grep/etags buffers.
264 ;; `anything-c-goto-next-file'
265 ;; Go to precedent file in anything grep/etags buffers.
266 ;; `anything-grep-help'
267 ;; Not documented.
268 ;; `anything-c-grep-run-persistent-action'
269 ;; Run grep persistent action from `anything-do-grep-1'.
270 ;; `anything-c-grep-run-default-action'
271 ;; Run grep default action from `anything-do-grep-1'.
272 ;; `anything-c-grep-run-other-window-action'
273 ;; Run grep goto other window action from `anything-do-grep-1'.
274 ;; `anything-c-grep-run-save-buffer'
275 ;; Run grep save results action from `anything-do-grep-1'.
276 ;; `anything-pdfgrep-help'
277 ;; Not documented.
278 ;; `anything-do-pdfgrep'
279 ;; Not documented.
280 ;; `anything-yank-text-at-point'
281 ;; Yank text at point in minibuffer.
282 ;; `anything-etags-help'
283 ;; The help function for etags.
284 ;; `anything-c-etags-select'
285 ;; Preconfigured anything for etags.
286 ;; `anything-filelist'
287 ;; Preconfigured `anything' to open files instantly.
288 ;; `anything-filelist+'
289 ;; Preconfigured `anything' to open files/buffers/bookmarks instantly.
290 ;; `anything-c-describe-attributes'
291 ;; Display the full documentation of ANYTHING-ATTRIBUTE (a symbol).
292 ;; `anything-M-x'
293 ;; Preconfigured `anything' for Emacs commands.
294 ;; `anything-manage-advice'
295 ;; Preconfigured `anything' to disable/enable function advices.
296 ;; `anything-bookmark-ext'
297 ;; Preconfigured `anything' for bookmark-extensions sources.
298 ;; `anything-simple-call-tree'
299 ;; Preconfigured `anything' for simple-call-tree. List function relationships.
300 ;; `anything-mark-ring'
301 ;; Preconfigured `anything' for `anything-c-source-mark-ring'.
302 ;; `anything-global-mark-ring'
303 ;; Preconfigured `anything' for `anything-c-source-global-mark-ring'.
304 ;; `anything-all-mark-rings'
305 ;; Preconfigured `anything' for `anything-c-source-global-mark-ring' and `anything-c-source-mark-ring'.
306 ;; `anything-yaoddmuse-cache-pages'
307 ;; Fetch the list of files on emacswiki and create cache file.
308 ;; `anything-yaoddmuse-emacswiki-edit-or-view'
309 ;; Preconfigured `anything' to edit or view EmacsWiki page.
310 ;; `anything-yaoddmuse-emacswiki-post-library'
311 ;; Preconfigured `anything' to post library to EmacsWiki.
312 ;; `anything-eval-expression'
313 ;; Preconfigured anything for `anything-c-source-evaluation-result'.
314 ;; `anything-eval-new-line-and-indent'
315 ;; Not documented.
316 ;; `anything-eval-expression-with-eldoc'
317 ;; Preconfigured anything for `anything-c-source-evaluation-result' with `eldoc' support.
318 ;; `anything-calcul-expression'
319 ;; Preconfigured anything for `anything-c-source-calculation-result'.
320 ;; `anything-surfraw'
321 ;; Preconfigured `anything' to search PATTERN with search ENGINE.
322 ;; `anything-call-source'
323 ;; Preconfigured `anything' to call anything source.
324 ;; `anything-call-source-from-anything'
325 ;; Call anything source within `anything' session.
326 ;; `anything-execute-anything-command'
327 ;; Preconfigured `anything' to execute preconfigured `anything'.
328 ;; `anything-create-from-anything'
329 ;; Run `anything-create' from `anything' as a fallback.
330 ;; `anything-create'
331 ;; Preconfigured `anything' to do many create actions from STRING.
332 ;; `anything-top'
333 ;; Preconfigured `anything' for top command.
334 ;; `anything-select-xfont'
335 ;; Preconfigured `anything' to select Xfont.
336 ;; `anything-world-time'
337 ;; Preconfigured `anything' to show world time.
338 ;; `anything-apt'
339 ;; Preconfigured `anything' : frontend of APT package manager.
340 ;; `anything-esh-pcomplete'
341 ;; Preconfigured anything to provide anything completion in eshell.
342 ;; `anything-eshell-history'
343 ;; Preconfigured anything for eshell history.
344 ;; `anything-lisp-completion-at-point'
345 ;; Anything lisp symbol completion at point.
346 ;; `anything-lisp-completion-at-point-or-indent'
347 ;; First call indent and second call complete lisp symbol.
348 ;; `anything-c-complete-file-name-at-point'
349 ;; Complete file name at point.
350 ;; `anything-c-run-external-command'
351 ;; Preconfigured `anything' to run External PROGRAM asyncronously from Emacs.
352 ;; `anything-ratpoison-commands'
353 ;; Preconfigured `anything' to execute ratpoison commands.
354 ;; `anything-c-set-variable'
355 ;; Set value to VAR interactively.
356 ;; `anything-c-adaptive-save-history'
357 ;; Save history information to file given by `anything-c-adaptive-history-file'.
358 ;; `anything-c-reset-adaptative-history'
359 ;; Delete all `anything-c-adaptive-history' and his file.
360 ;; `anything-c-toggle-match-plugin'
361 ;; Toggle anything-match-plugin.
363 ;; * User variables defined here:
364 ;; [EVAL] (autodoc-document-lisp-buffer :type 'user-variable :prefix "anything-" :var-value t)
365 ;; `anything-c-use-standard-keys'
366 ;; Default Value: nil
367 ;; `anything-c-adaptive-history-file'
368 ;; Default Value: "~/.emacs.d/anything-c-adaptive-history"
369 ;; `anything-c-adaptive-history-length'
370 ;; Default Value: 50
371 ;; `anything-c-google-suggest-url'
372 ;; Default Value: "http://google.com/complete/search?output=toolbar&q="
373 ;; `anything-c-google-suggest-search-url'
374 ;; Default Value: "http://www.google.com/search?ie=utf-8&oe=utf-8&q="
375 ;; `anything-google-suggest-use-curl-p'
376 ;; Default Value: nil
377 ;; `anything-c-yahoo-suggest-url'
378 ;; Default Value: "http://search.yahooapis.com/WebSearchService/V1/relatedSuggestion?appid=G [...]
379 ;; `anything-c-yahoo-suggest-search-url'
380 ;; Default Value: "http://search.yahoo.com/search?&ei=UTF-8&fr&h=c&p="
381 ;; `anything-c-boring-buffer-regexp'
382 ;; Default Value: "\\ (\\` \\)\\|\\*anything\\| \\*Echo Area\\| \\*Minibuf"
383 ;; `anything-c-boring-file-regexp'
384 ;; Default Value: "/\\ (?:\\(?:\\.\\(?:git\\|hg\\|svn\\)\\|CVS\\|_darcs\\)\\)\\(?:/\\|$\\)\\| [...]
385 ;; `anything-kill-ring-threshold'
386 ;; Default Value: 10
387 ;; `anything-su-or-sudo'
388 ;; Default Value: "su"
389 ;; `anything-for-files-prefered-list'
390 ;; Default Value: (anything-c-source-ffap-line anything-c-source-ffap-guesser anything-c-sou [...]
391 ;; `anything-create--actions-private'
392 ;; Default Value: nil
393 ;; `anything-allow-skipping-current-buffer'
394 ;; Default Value: t
395 ;; `anything-c-enable-eval-defun-hack'
396 ;; Default Value: t
397 ;; `anything-tramp-verbose'
398 ;; Default Value: 0
399 ;; `anything-raise-command'
400 ;; Default Value: nil
401 ;; `anything-command-map-prefix-key'
402 ;; Default Value: "<f5> a"
403 ;; `anything-c-find-files-show-icons'
404 ;; Default Value: nil
405 ;; `anything-c-find-files-icons-directory'
406 ;; Default Value: "/usr/local/share/emacs/24.0.50/etc/images/tree-widget/default"
407 ;; `anything-c-browse-code-regexp-lisp'
408 ;; Default Value: "^ * (def\\(un\\|subst\\|macro\\|face\\|alias\\|advice\\|struct\\|type\\|th [...]
409 ;; `anything-c-browse-code-regexp-python'
410 ;; Default Value: "\\<def\\>\\|\\<class\\>"
411 ;; `anything-c-browse-code-regexp-alist'
412 ;; Default Value: ((lisp-interaction-mode . "^ *(def\\(un\\|subst\\|macro\\|face\\|alias\\|a [...]
413 ;; `anything-c-external-programs-associations'
414 ;; Default Value: nil
415 ;; `anything-ff-auto-update-initial-value'
416 ;; Default Value: t
417 ;; `anything-c-copy-async-prefered-emacs'
418 ;; Default Value: "emacs"
419 ;; `anything-ff-lynx-style-map'
420 ;; Default Value: t
421 ;; `anything-ff-history-max-length'
422 ;; Default Value: 100
423 ;; `anything-ff-smart-completion'
424 ;; Default Value: t
425 ;; `anything-ff-default-kbsize'
426 ;; Default Value: 1024.0
427 ;; `anything-ff-tramp-not-fancy'
428 ;; Default Value: t
429 ;; `anything-ff-exif-data-program'
430 ;; Default Value: "exiftran"
431 ;; `anything-ff-exif-data-program-args'
432 ;; Default Value: "-d"
433 ;; `anything-c-grep-use-ioccur-style-keys'
434 ;; Default Value: t
435 ;; `anything-c-pdfgrep-default-read-command'
436 ;; Default Value: "xpdf '%f' %p"
437 ;; `anything-c-etags-tag-file-name'
438 ;; Default Value: "TAGS"
439 ;; `anything-c-etags-tag-file-search-limit'
440 ;; Default Value: 10
441 ;; `anything-c-filelist-file-name'
442 ;; Default Value: nil
443 ;; `anything-c-eldoc-in-minibuffer-show-fn'
444 ;; Default Value: anything-c-eldoc-show-in-mode-line
445 ;; `anything-c-turn-on-show-completion'
446 ;; Default Value: t
447 ;; `anything-lisp-completion-or-indent-delay'
448 ;; Default Value: 0.6
449 ;; `anything-c-default-external-file-browser'
450 ;; Default Value: "nautilus"
451 ;; `anything-c-use-adaptative-sorting'
452 ;; Default Value: nil
453 ;; `anything-ff-newfile-prompt-p'
454 ;; Default Value: t
456 ;; * Anything sources defined here:
457 ;; [EVAL] (autodoc-document-lisp-buffer :type 'anything-source :prefix "anything-" :any-sname t)
458 ;; `anything-c-source-regexp' (Regexp Builder)
459 ;; `anything-c-source-buffers' (Buffers)
460 ;; `anything-c-source-buffer-not-found' (Create buffer)
461 ;; `anything-c-source-buffers-list' (Buffers)
462 ;; `anything-c-source-file-name-history' (File Name History)
463 ;; `anything-c-source-files-in-current-dir' (Files from Current Directory)
464 ;; `anything-c-source-files-in-current-dir+' (Files from Current Directory)
465 ;; `anything-c-source-find-files' (Find Files (`C-.':Go to precedent level))
466 ;; `anything-c-source-write-file' (Write File (`C-.':Go to precedent level))
467 ;; `anything-c-source-insert-file' (Insert File (`C-.':Go to precedent level))
468 ;; `anything-c-source-copy-files' (Copy Files (`C-.':Go to precedent level))
469 ;; `anything-c-source-symlink-files' (Symlink Files (`C-.':Go to precedent level))
470 ;; `anything-c-source-hardlink-files' (Hardlink Files (`C-.':Go to precedent level))
471 ;; `anything-c-source-file-cache' (File Cache)
472 ;; `anything-c-source-locate' (Locate)
473 ;; `anything-c-source-etags-select' (Etags)
474 ;; `anything-c-source-recentf' (Recentf)
475 ;; `anything-c-source-ffap-guesser' (File at point)
476 ;; `anything-c-source-ffap-line' (File/Lineno at point)
477 ;; `anything-c-source-files-in-all-dired' (Files in all dired buffer.)
478 ;; `anything-c-source-filelist' (FileList)
479 ;; `anything-c-source-info-pages' (Info Pages)
480 ;; `anything-c-source-info-elisp' (Info index: elisp)
481 ;; `anything-c-source-info-cl' (Info index: cl)
482 ;; `anything-c-source-info-org' (Info index: org)
483 ;; `anything-c-source-info-ratpoison' (Info index: ratpoison)
484 ;; `anything-c-source-info-zsh' (Info index: zsh)
485 ;; `anything-c-source-info-bash' (Info index: bash)
486 ;; `anything-c-source-info-coreutils' (Info index: coreutils)
487 ;; `anything-c-source-info-fileutils' (Info index: fileutils)
488 ;; `anything-c-source-info-find' (Info index: find)
489 ;; `anything-c-source-info-sh-utils' (Info index: sh-utils)
490 ;; `anything-c-source-info-textutils' (Info index: textutils)
491 ;; `anything-c-source-info-libc' (Info index: libc)
492 ;; `anything-c-source-info-make' (Info index: make)
493 ;; `anything-c-source-info-automake' (Info index: automake)
494 ;; `anything-c-source-info-autoconf' (Info index: autoconf)
495 ;; `anything-c-source-info-emacs-lisp-intro' (Info index: emacs-lisp-intro)
496 ;; `anything-c-source-info-emacs' (Info index: emacs)
497 ;; `anything-c-source-info-elib' (Info index: elib)
498 ;; `anything-c-source-info-eieio' (Info index: eieio)
499 ;; `anything-c-source-info-gauche-refe' (Info index: gauche)
500 ;; `anything-c-source-info-guile' (Info index: guile)
501 ;; `anything-c-source-info-guile-tut' (Info index: guile-tut)
502 ;; `anything-c-source-info-goops' (Info index: goops)
503 ;; `anything-c-source-info-screen' (Info index: screen)
504 ;; `anything-c-source-info-latex' (Info index: latex)
505 ;; `anything-c-source-info-gawk' (Info index: gawk)
506 ;; `anything-c-source-info-sed' (Info index: sed)
507 ;; `anything-c-source-info-m4' (Info index: m4)
508 ;; `anything-c-source-info-wget' (Info index: wget)
509 ;; `anything-c-source-info-binutils' (Info index: binutils)
510 ;; `anything-c-source-info-as' (Info index: as)
511 ;; `anything-c-source-info-bfd' (Info index: bfd)
512 ;; `anything-c-source-info-gprof' (Info index: gprof)
513 ;; `anything-c-source-info-ld' (Info index: ld)
514 ;; `anything-c-source-info-diff' (Info index: diff)
515 ;; `anything-c-source-info-flex' (Info index: flex)
516 ;; `anything-c-source-info-grep' (Info index: grep)
517 ;; `anything-c-source-info-gzip' (Info index: gzip)
518 ;; `anything-c-source-info-libtool' (Info index: libtool)
519 ;; `anything-c-source-info-texinfo' (Info index: texinfo)
520 ;; `anything-c-source-info-info' (Info index: info)
521 ;; `anything-c-source-info-gdb' (Info index: gdb)
522 ;; `anything-c-source-info-stabs' (Info index: stabs)
523 ;; `anything-c-source-info-cvsbook' (Info index: cvsbook)
524 ;; `anything-c-source-info-cvs' (Info index: cvs)
525 ;; `anything-c-source-info-bison' (Info index: bison)
526 ;; `anything-c-source-info-id-utils' (Info index: id-utils)
527 ;; `anything-c-source-info-global' (Info index: global)
528 ;; `anything-c-source-man-pages' (Manual Pages)
529 ;; `anything-c-source-complex-command-history' (Complex Command History)
530 ;; `anything-c-source-extended-command-history' (Emacs Commands History)
531 ;; `anything-c-source-emacs-commands' (Emacs Commands)
532 ;; `anything-c-source-lacarte' (Lacarte)
533 ;; `anything-c-source-emacs-functions' (Emacs Functions)
534 ;; `anything-c-source-emacs-functions-with-abbrevs' (Emacs Functions)
535 ;; `anything-c-source-advice' (Function Advice)
536 ;; `anything-c-source-emacs-variables' (Emacs Variables)
537 ;; `anything-c-source-bookmarks' (Bookmarks)
538 ;; `anything-c-source-bookmark-set' (Set Bookmark)
539 ;; `anything-c-source-bm' (Visible Bookmarks)
540 ;; `anything-c-source-bookmarks-ssh' (Bookmarks-ssh)
541 ;; `anything-c-source-bookmarks-su' (Bookmarks-root)
542 ;; `anything-c-source-bookmarks-local' (Bookmarks-Local)
543 ;; `anything-c-source-bmkext-addressbook' (Bookmark Addressbook)
544 ;; `anything-c-source-bookmark-w3m' (Bookmark W3m)
545 ;; `anything-c-source-bookmark-images' (Bookmark Images)
546 ;; `anything-c-source-bookmark-man' (Bookmark Woman&Man)
547 ;; `anything-c-source-bookmark-gnus' (Bookmark Gnus)
548 ;; `anything-c-source-bookmark-info' (Bookmark Info)
549 ;; `anything-c-source-bookmark-files&dirs' (Bookmark Files&Directories)
550 ;; `anything-c-source-bookmark-su-files&dirs' (Bookmark Root-Files&Directories)
551 ;; `anything-c-source-bookmark-ssh-files&dirs' (Bookmark Ssh-Files&Directories)
552 ;; `anything-c-source-firefox-bookmarks' (Firefox Bookmarks)
553 ;; `anything-c-source-w3m-bookmarks' (W3m Bookmarks)
554 ;; `anything-c-source-elisp-library-scan' (Elisp libraries (Scan))
555 ;; `anything-c-source-imenu' (Imenu)
556 ;; `anything-c-source-ctags' (Exuberant ctags)
557 ;; `anything-c-source-semantic' (Semantic Tags)
558 ;; `anything-c-source-simple-call-tree-functions-callers' (Function is called by)
559 ;; `anything-c-source-simple-call-tree-callers-functions' (Function calls)
560 ;; `anything-c-source-commands-and-options-in-file' (Commands/Options in file)
561 ;; `anything-c-source-customize-face' (Customize Face)
562 ;; `anything-c-source-colors' (Colors)
563 ;; `anything-c-source-tracker-search' (Tracker Search)
564 ;; `anything-c-source-mac-spotlight' (mdfind)
565 ;; `anything-c-source-kill-ring' (Kill Ring)
566 ;; `anything-c-source-mark-ring' (mark-ring)
567 ;; `anything-c-source-global-mark-ring' (global-mark-ring)
568 ;; `anything-c-source-register' (Registers)
569 ;; `anything-c-source-latex-math' (Latex Math Menu)
570 ;; `anything-c-source-fixme' (TODO/FIXME/DRY comments)
571 ;; `anything-c-source-rd-headline' (RD HeadLine)
572 ;; `anything-c-source-oddmuse-headline' (Oddmuse HeadLine)
573 ;; `anything-c-source-emacs-source-defun' (Emacs Source DEFUN)
574 ;; `anything-c-source-emacs-lisp-expectations' (Emacs Lisp Expectations)
575 ;; `anything-c-source-emacs-lisp-toplevels' (Emacs Lisp Toplevel / Level 4 Comment / Linkd Star)
576 ;; `anything-c-source-org-headline' (Org HeadLine)
577 ;; `anything-c-source-yaoddmuse-emacswiki-edit-or-view' (Yaoddmuse Edit or View (EmacsWiki))
578 ;; `anything-c-source-yaoddmuse-emacswiki-post-library' (Yaoddmuse Post library (EmacsWiki))
579 ;; `anything-c-source-eev-anchor' (Anchors)
580 ;; `anything-c-source-org-keywords' (Org Keywords)
581 ;; `anything-c-source-picklist' (Picklist)
582 ;; `anything-c-source-bbdb' (BBDB)
583 ;; `anything-c-source-evaluation-result' (Evaluation Result)
584 ;; `anything-c-source-calculation-result' (Calculation Result)
585 ;; `anything-c-source-google-suggest' (Google Suggest)
586 ;; `anything-c-source-yahoo-suggest' (Yahoo Suggest)
587 ;; `anything-c-source-emms-streams' (Emms Streams)
588 ;; `anything-c-source-emms-dired' (Music Directory)
589 ;; `anything-c-source-emms-files' (Emms files)
590 ;; `anything-c-source-jabber-contacts' (Jabber Contacts)
591 ;; `anything-c-source-call-source' (Call anything source)
592 ;; `anything-c-source-anything-commands' (Preconfigured Anything)
593 ;; `anything-c-source-occur' (Occur)
594 ;; `anything-c-source-browse-code' (Browse code)
595 ;; `anything-c-source-create' (Create)
596 ;; `anything-c-source-minibuffer-history' (Minibuffer History)
597 ;; `anything-c-source-elscreen' (Elscreen)
598 ;; `anything-c-source-top' (Top (Press C-c C-u to refresh))
599 ;; `anything-c-source-absolute-time-timers' (Absolute Time Timers)
600 ;; `anything-c-source-idle-time-timers' (Idle Time Timers)
601 ;; `anything-c-source-xrandr-change-resolution' (Change Resolution)
602 ;; `anything-c-source-xfonts' (X Fonts)
603 ;; `anything-c-source-time-world' (Time World List)
604 ;; `anything-c-source-apt' (APT)
605 ;; `anything-c-source-gentoo' (Portage sources)
606 ;; `anything-c-source-use-flags' (Use Flags)
607 ;; `anything-c-source-emacs-process' (Emacs Process)
608 ;; `anything-c-source-esh' (Eshell completions)
609 ;; `anything-c-source-eshell-history' (Eshell history)
610 ;; `anything-c-source-ratpoison-commands' (Ratpoison Commands)
612 ;; *** END auto-documentation
615 ;;; Change log:
617 ;; Change log of this file is found at
618 ;; http://repo.or.cz/w/anything-config.git/history/master:/anything-config.el
620 ;; Change log of this project is found at
621 ;; http://repo.or.cz/w/anything-config.git?a=shortlog
623 ;;; Contributors:
625 ;; Tamas Patrovics
626 ;; Tassilo Horn <tassilo@member.fsf.org>
627 ;; Vagn Johansen <gonz808@hotmail.com>
628 ;; Mathias Dahl <mathias.dahl@gmail.com>
629 ;; Bill Clementson <billclem@gmail.com>
630 ;; Stefan Kamphausen (see http://www.skamphausen.de for more informations)
631 ;; Drew Adams <drew.adams@oracle.com>
632 ;; Jason McBrayer <jmcbray@carcosa.net>
633 ;; Andy Stewart <lazycat.manatee@gmail.com>
634 ;; Thierry Volpiatto <thierry.volpiatto@gmail.com>
635 ;; rubikitch <rubikitch@ruby-lang.org>
636 ;; Scott Vokes <vokes.s@gmail.com>
637 ;; Kenichirou Oyama <k1lowxb@gmail.com>
639 ;;; For Maintainers:
641 ;; Evaluate (autodoc-update-all) before commit. This function
642 ;; generates anything-c-source-* / functions / options list.
644 ;; Install also developer-tools/autodoc.el
645 ;; And eval it or run interactively.
647 ;; [EVAL IT] (autodoc-update-all)
649 ;; Please write details documentation about function, then others will
650 ;; read code more easier. -- Andy Stewart
654 ;;; TODO
656 ;; - Fix documentation, now many functions haven't documentations.
659 ;;; Require
660 (require 'anything)
661 (require 'thingatpt)
662 (require 'ffap)
663 (require 'cl)
664 (require 'dired-aux)
665 (require 'tramp)
666 (require 'grep)
667 (require 'url)
668 (require 'xml)
669 (eval-when-compile (require 'org)) ; Shut up byte compiler about org-directory.
670 (require 'anything-match-plugin)
672 ;;; Code:
674 ;; version check
675 (let ((version "1.263"))
676 (when (and (string= "1." (substring version 0 2))
677 (string-match "1\.\\([0-9]+\\)" anything-version)
678 (< (string-to-number (match-string 1 anything-version))
679 (string-to-number (substring version 2))))
680 (error "Please update anything.el!!
682 http://www.emacswiki.org/cgi-bin/wiki/download/anything.el
684 or M-x install-elisp-from-emacswiki anything.el")))
686 ;; compatibility
687 (unless (fboundp 'window-system)
688 (defun window-system (&optional arg)
689 window-system))
691 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Customize ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
692 (defgroup anything-config nil
693 "Predefined configurations for `anything.el'."
694 :group 'anything)
696 (defcustom anything-c-use-standard-keys nil
697 "Whether use standard keybindings. (no effect)
699 Key definitions in anything-config.el are removed because
700 anything.el uses Emacs-standard keys by default. e.g. M-p/M-n for
701 minibuffer history, C-s for isearch, etc.
703 If you use `iswitchb' with `anything',
704 evaluate (anything-iswitchb-setup) . Then some bindings that
705 conflict with `iswitchb', e.g. C-p/C-n for the minibuffer
706 history, are removed from `anything-map'. "
707 :type 'boolean
708 :group 'anything-config)
710 (defcustom anything-c-adaptive-history-file "~/.emacs.d/anything-c-adaptive-history"
711 "Path of file where history information is stored."
712 :type 'string
713 :group 'anything-config)
715 (defcustom anything-c-adaptive-history-length 50
716 "Maximum number of candidates stored for a source."
717 :type 'number
718 :group 'anything-config)
720 (defcustom anything-c-google-suggest-url
721 "http://google.com/complete/search?output=toolbar&q="
722 "URL used for looking up Google suggestions."
723 :type 'string
724 :group 'anything-config)
726 (defcustom anything-c-google-suggest-search-url
727 "http://www.google.com/search?ie=utf-8&oe=utf-8&q="
728 "URL used for Google searching."
729 :type 'string
730 :group 'anything-config)
732 (defcustom anything-google-suggest-use-curl-p nil
733 "*When non--nil use CURL to get info from `anything-c-google-suggest-url'.
734 Otherwise `url-retrieve-synchronously' is used."
735 :type 'boolean
736 :group 'anything-config)
738 (defcustom anything-c-yahoo-suggest-url
739 "http://search.yahooapis.com/WebSearchService/V1/relatedSuggestion?appid=Generic&query="
740 "Url used for looking up Yahoo suggestions."
741 :type 'string
742 :group 'anything-config)
744 (defcustom anything-c-yahoo-suggest-search-url
745 "http://search.yahoo.com/search?&ei=UTF-8&fr&h=c&p="
746 "Url used for Yahoo searching."
747 :type 'string
748 :group 'anything-config)
750 (defcustom anything-c-boring-buffer-regexp
751 (rx (or
752 (group bos " ")
753 ;; anything-buffer
754 "*anything"
755 ;; echo area
756 " *Echo Area" " *Minibuf"))
757 "The regexp that match boring buffers.
758 Buffer candidates matching this regular expression will be
759 filtered from the list of candidates if the
760 `anything-c-skip-boring-buffers' candidate transformer is used, or
761 they will be displayed with face `file-name-shadow' if
762 `anything-c-shadow-boring-buffers' is used."
763 :type 'string
764 :group 'anything-config)
765 ;; (string-match anything-c-boring-buffer-regexp "buf")
766 ;; (string-match anything-c-boring-buffer-regexp " hidden")
767 ;; (string-match anything-c-boring-buffer-regexp " *Minibuf-1*")
769 (defcustom anything-c-boring-file-regexp
770 (rx (or
771 ;; Boring directories
772 (and "/" (or ".svn" "CVS" "_darcs" ".git" ".hg") (or "/" eol))
773 ;; Boring files
774 (and line-start ".#")
775 (and (or ".class" ".la" ".o" "~") eol)))
776 "The regexp that match boring files.
777 File candidates matching this regular expression will be
778 filtered from the list of candidates if the
779 `anything-c-skip-boring-files' candidate transformer is used, or
780 they will be displayed with face `file-name-shadow' if
781 `anything-c-shadow-boring-files' is used."
782 :type 'string
783 :group 'anything-config)
785 (defcustom anything-kill-ring-threshold 10
786 "*Minimum length to be listed by `anything-c-source-kill-ring'."
787 :type 'integer
788 :group 'anything-config)
790 (defcustom anything-su-or-sudo "su"
791 "What command to use for root access."
792 :type 'string
793 :group 'anything-config)
795 (defcustom anything-for-files-prefered-list
796 '(anything-c-source-ffap-line
797 anything-c-source-ffap-guesser
798 anything-c-source-buffers-list
799 anything-c-source-recentf
800 anything-c-source-bookmarks
801 anything-c-source-file-cache
802 anything-c-source-files-in-current-dir+
803 anything-c-source-locate)
804 "Your prefered sources to find files."
805 :type 'list
806 :group 'anything-config)
808 (defcustom anything-create--actions-private nil
809 "User defined actions for `anything-create' / `anything-c-source-create'.
810 It is a list of (DISPLAY . FUNCTION) pairs like `action'
811 attribute of `anything-sources'.
813 It is prepended to predefined pairs."
814 :type 'list
815 :group 'anything-config)
817 (defcustom anything-allow-skipping-current-buffer t
818 "Show current buffer or not in anything buffer"
819 :type 'boolean
820 :group 'anything-config)
822 (defcustom anything-c-enable-eval-defun-hack t
823 "*If non-nil, execute `anything' using the source at point when C-M-x is pressed.
824 This hack is invoked when pressing C-M-x in the form \
825 (defvar anything-c-source-XXX ...) or (setq anything-c-source-XXX ...)."
826 :type 'boolean
827 :group 'anything-config)
829 (defcustom anything-tramp-verbose 0
830 "*Just like `tramp-verbose' but specific to anything.
831 When set to 0 don't show tramp messages in anything.
832 If you want to have the default tramp messages set it to 3."
833 :type 'integer
834 :group 'anything-config)
836 (defcustom anything-raise-command nil
837 "*A shell command to jump to a window running specific program.
838 Need external program wmctrl.
839 This will be use with `format', so use something like \"wmctrl -xa %s\"."
840 :type 'string
841 :group 'anything-config)
843 (defun anything-set-anything-command-map-prefix-key (var key)
844 (when (boundp 'anything-command-map-prefix-key)
845 (global-unset-key (read-kbd-macro anything-command-map-prefix-key)))
846 (setq anything-command-map-prefix-key key)
847 (global-set-key (read-kbd-macro anything-command-map-prefix-key)
848 'anything-command-map))
850 (defcustom anything-command-map-prefix-key "<f5> a"
851 "*The prefix key for all `anything-command-map' commands.
853 !!WARNING!!
854 This default value is very likely to be changed,
855 because it is under discussion."
856 :type 'string
857 :set 'anything-set-anything-command-map-prefix-key
858 :group 'anything-config)
860 (defcustom anything-c-find-files-show-icons nil
861 "*Whether show or hide icons in `anything-find-files'."
862 :type 'boolean
863 :group 'anything-config)
865 (defcustom anything-c-find-files-icons-directory
866 (and (window-system)
867 (dolist (i image-load-path)
868 (if (file-directory-p (expand-file-name "tree-widget/default" (eval i)))
869 (return (expand-file-name "tree-widget/default" (eval i))))))
870 "*Default path where to find files and directory icons."
871 :type 'string
872 :group 'anything-config)
874 (defcustom anything-c-browse-code-regexp-lisp
875 "^ *\(def\\(un\\|subst\\|macro\\|face\\|alias\\|advice\\|struct\\|\
876 type\\|theme\\|var\\|group\\|custom\\|const\\|method\\|class\\)"
877 "*Regexp used to parse lisp buffer when browsing code."
878 :type 'string
879 :group 'anything-config)
881 (defcustom anything-c-browse-code-regexp-python
882 "\\<def\\>\\|\\<class\\>"
883 "*Regexp used to parse python buffer when browsing code."
884 :type 'string
885 :group 'anything-config)
887 (defcustom anything-c-browse-code-regexp-alist
888 `((lisp-interaction-mode . ,anything-c-browse-code-regexp-lisp)
889 (emacs-lisp-mode . ,anything-c-browse-code-regexp-lisp)
890 (lisp-mode . ,anything-c-browse-code-regexp-lisp)
891 (python-mode . ,anything-c-browse-code-regexp-python))
892 "*Alist to store regexps for browsing code corresponding \
893 to a specific `major-mode'."
894 :type 'list
895 :group 'anything-config)
897 (defcustom anything-c-external-programs-associations nil
898 "*Alist to store externals programs associated with file extension.
899 This variable overhide setting in .mailcap file.
900 e.g : '\(\(\"jpg\" . \"gqview\"\) (\"pdf\" . \"xpdf\"\)\) "
901 :type 'list
902 :group 'anything-config)
904 (defcustom anything-ff-auto-update-initial-value t
905 "Auto update when only one candidate directory is matched.
906 This is the default value when starting `anything-find-files'."
907 :group 'anything-config
908 :type 'boolean)
910 (defcustom anything-c-copy-async-prefered-emacs "emacs"
911 "Path to the emacs you want to use for copying async.
912 Emacs versions < 24 fail to copy directory due to a bug not fixed
913 in `copy-directory'."
914 :group 'anything-config
915 :type 'string)
917 (defcustom anything-ff-lynx-style-map t
918 "Use arrow keys to navigate with `anything-find-files'."
919 :group 'anything-config
920 :type 'boolean)
922 (defcustom anything-ff-history-max-length 100
923 "*Number of elements shown in `anything-find-files' history."
924 :group 'anything-config
925 :type 'integer)
927 (defcustom anything-ff-smart-completion t
928 "Try to complete filenames smarter when non--nil.
929 See `anything-ff-transform-fname-for-completion' for more info."
930 :group 'anything-config
931 :type 'boolean)
933 (defcustom anything-ff-default-kbsize 1024.0
934 "Default Kbsize to use for showing files size.
935 It is a float, usually 1024.0 but could be 1000.0 on some systems."
936 :group 'anything-config
937 :type 'float)
939 (defcustom anything-ff-tramp-not-fancy t
940 "No colors when listing remote files when set to non--nil.
941 This make listing much faster, specially on slow machines."
942 :group 'anything-config
943 :type 'boolean)
945 (defcustom anything-ff-exif-data-program "exiftran"
946 "*Program used to extract exif data of an image file."
947 :group 'anything-config
948 :type 'string)
950 (defcustom anything-ff-exif-data-program-args "-d"
951 "*Arguments used for `anything-ff-exif-data-program'."
952 :group 'anything-config
953 :type 'string)
955 (defcustom anything-c-grep-use-ioccur-style-keys t
956 "Use Arrow keys to jump to occurences."
957 :group 'anything-config
958 :type 'boolean)
960 (defcustom anything-c-pdfgrep-default-read-command "xpdf '%f' %p"
961 "Default command to read pdf files from pdfgrep.
962 Where '%f' format spec is filename and '%p' is page number"
963 :group 'anything-config
964 :type 'string)
966 (defcustom anything-c-etags-tag-file-name "TAGS"
967 "Etags tag file name."
968 :type 'string
969 :group 'anything-config)
971 (defcustom anything-c-etags-tag-file-search-limit 10
972 "The limit level of directory to search tag file.
973 Don't search tag file deeply if outside this value."
974 :type 'number
975 :group 'anything-config)
977 (defcustom anything-c-filelist-file-name nil
978 "*Filename of file list.
979 Accept a list of string for multiple files.
981 This file tend to be very large (> 100MB) and recommend to be in ramdisk for speed.
982 File list is created by make-filelist.rb script.
984 Usage:
985 ruby make-filelist.rb > /tmp/all.filelist
987 Then
988 ;; Assume that /tmp is ramdisk or tmpfs
989 (setq anything-grep-candidates-fast-directory-regexp \"^/tmp/\")
990 (setq anything-c-filelist-file-name \"/tmp/all.filelist\")
992 :type 'string
993 :group 'anything-config)
995 (defcustom anything-c-eldoc-in-minibuffer-show-fn 'anything-c-eldoc-show-in-mode-line
996 "A function to display eldoc info.
997 Should take one arg: the string to display."
998 :group 'anything-config
999 :type 'symbol)
1001 (defcustom anything-c-turn-on-show-completion t
1002 "Display candidate in buffer while moving selection when non--nil."
1003 :group 'anything-config
1004 :type 'boolean)
1006 (defcustom anything-lisp-completion-or-indent-delay 0.6
1007 "After this delay `anything-lisp-completion-counter' is reset to 0.
1008 This allow to indent again without completing lisp symbol after this delay.
1009 Default is 0.6 seconds."
1010 :group 'anything-config
1011 :type 'number)
1013 (defcustom anything-c-default-external-file-browser "nautilus"
1014 "Default external file browser for your system.
1015 Directories will be opened externally with it.
1016 Set to nil if you do not have external file browser
1017 or do not want to use it."
1018 :group 'anything-config
1019 :type 'string)
1021 (defcustom anything-c-use-adaptative-sorting nil
1022 "*Wheter to use or not adaptative sorting.
1023 Even if a source use it, it will have no effect when set to nil."
1024 :type 'boolean
1025 :group 'anything-config)
1027 (defcustom anything-ff-newfile-prompt-p t
1028 "Whether Prompt or not when creating new file.
1029 This set `ffap-newfile-prompt'."
1030 :type 'boolean
1031 :group 'anything-config)
1033 ;;; Faces
1036 (defface anything-buffer-saved-out
1037 '((t (:foreground "red")))
1038 "*Face used for buffer files modified outside of emacs."
1039 :group 'anything-config)
1041 (defface anything-buffer-not-saved
1042 '((t (:foreground "Indianred2")))
1043 "*Face used for buffer files not already saved on disk."
1044 :group 'anything-config)
1046 (defface anything-ff-prefix
1047 '((t (:background "yellow" :foreground "black")))
1048 "*Face used to prefix new file or url paths in `anything-find-files'."
1049 :group 'anything-config)
1051 (defface anything-ff-executable
1052 '((t (:foreground "green")))
1053 "*Face used for executable files in `anything-find-files'."
1054 :group 'anything-config)
1056 (defface anything-ff-directory
1057 '((t (:foreground "DarkRed" :background "LightGray")))
1058 "*Face used for directories in `anything-find-files'."
1059 :group 'anything-config)
1061 (defface anything-ff-symlink
1062 '((t (:foreground "DarkOrange")))
1063 "*Face used for symlinks in `anything-find-files'."
1064 :group 'anything-config)
1066 (defface anything-ff-invalid-symlink
1067 '((t (:foreground "black" :background "red")))
1068 "*Face used for invalid symlinks in `anything-find-files'."
1069 :group 'anything-config)
1071 (defface anything-ff-file
1072 '((t (:foreground "CadetBlue" :underline t)))
1073 "*Face used for file names in `anything-find-files'."
1074 :group 'anything-config)
1076 (defface anything-grep-match
1077 '((t (:inherit match)))
1078 "Face used to highlight grep matches."
1079 :group 'anything-config)
1081 (defface anything-grep-file
1082 '((t (:foreground "BlueViolet" :underline t)))
1083 "Face used to highlight grep results filenames."
1084 :group 'anything-config)
1086 (defface anything-grep-lineno
1087 '((t (:foreground "Darkorange1")))
1088 "Face used to highlight grep number lines."
1089 :group 'anything-config)
1091 (defface anything-grep-running
1092 '((t (:foreground "Red")))
1093 "Face used in mode line when grep is running."
1094 :group 'anything-config)
1096 (defface anything-grep-finish
1097 '((t (:foreground "Green")))
1098 "Face used in mode line when grep is finish."
1099 :group 'anything-config)
1101 (defface anything-M-x-key-face '((t (:foreground "orange" :underline t)))
1102 "*Face used in anything-M-x to show keybinding."
1103 :group 'anything)
1105 (defface anything-bmkext-info
1106 '((t (:foreground "green")))
1107 "*Face used for W3m Emacs bookmarks (not w3m bookmarks)."
1108 :group 'anything)
1110 (defface anything-bmkext-w3m
1111 '((t (:foreground "yellow")))
1112 "*Face used for W3m Emacs bookmarks (not w3m bookmarks)."
1113 :group 'anything)
1115 (defface anything-bmkext-gnus
1116 '((t (:foreground "magenta")))
1117 "*Face used for Gnus bookmarks."
1118 :group 'anything)
1120 (defface anything-bmkext-man
1121 '((t (:foreground "Orange4")))
1122 "*Face used for Woman/man bookmarks."
1123 :group 'anything)
1125 (defface anything-bmkext-no--file
1126 '((t (:foreground "grey")))
1127 "*Face used for non--file bookmarks."
1128 :group 'anything)
1130 (defface anything-bmkext-file
1131 '((t (:foreground "Deepskyblue2")))
1132 "*Face used for non--file bookmarks."
1133 :group 'anything)
1135 (defface anything-bookmarks-su-face '((t (:foreground "red")))
1136 "Face for su/sudo bookmarks."
1137 :group 'anything)
1139 (defface anything-w3m-bookmarks-face '((t (:foreground "cyan1" :underline t)))
1140 "Face for w3m bookmarks" :group 'anything)
1142 (defface anything-emms-playlist
1143 '((t (:foreground "Springgreen4" :underline t)))
1144 "*Face used for tracks in current emms playlist."
1145 :group 'anything)
1147 (defface anything-apt-installed
1148 '((t (:foreground "green")))
1149 "*Face used for apt installed candidates."
1150 :group 'anything)
1152 (defface anything-gentoo-match-face '((t (:foreground "red")))
1153 "Face for anything-gentoo installed packages."
1154 :group 'traverse-faces)
1156 (defface anything-lisp-show-completion
1157 '((t (:background "DarkSlateGray")))
1158 "*Face used for showing candidates in `anything-lisp-completion'."
1159 :group 'anything-config)
1161 (defface anything-lisp-completion-info
1162 '((t (:foreground "red")))
1163 "*Face used for showing info in `anything-lisp-completion'."
1164 :group 'anything-config)
1166 (defface anything-overlay-line-face '((t (:background "IndianRed4" :underline t)))
1167 "Face for source header in the anything buffer." :group 'anything)
1170 ;;; Prefix argument in action.
1173 ;; TODO: This should be integrated in anything.el instead of having
1174 ;; a defadvice here.
1176 (defvar anything-current-prefix-arg nil
1177 "Record `current-prefix-arg' when exiting minibuffer.
1178 It will be cleared at start of next `anything' call when \
1179 `anything-before-initialize-hook' is called.")
1181 (defadvice anything-exit-minibuffer (before anything-current-prefix-arg activate)
1182 (unless anything-current-prefix-arg
1183 (setq anything-current-prefix-arg current-prefix-arg)))
1185 ;; using this hook instead of `anything-after-action-hook'
1186 ;; allow to record the prefix args and keep their values
1187 ;; when using `anything-comp-read'.
1188 ;; i.e when quitting `anything-comp-read' prefix args are preserved
1189 ;; for the following action.
1190 (add-hook 'anything-before-initialize-hook
1191 (lambda () (setq anything-current-prefix-arg nil)))
1193 ;;;###autoload
1194 (defun anything-configuration ()
1195 "Customize `anything'."
1196 (interactive)
1197 (customize-group "anything-config"))
1199 ;;; Anything-command-map
1200 ;;;###autoload
1201 (defvar anything-command-map)
1202 (define-prefix-command 'anything-command-map)
1204 ;; rubikitch: Please change it freely because it is in discussion. I'll track from git.
1205 (define-key anything-command-map (kbd "<SPC>") 'anything-execute-anything-command)
1206 (define-key anything-command-map (kbd "e") 'anything-c-etags-select)
1207 (define-key anything-command-map (kbd "l") 'anything-locate)
1208 (define-key anything-command-map (kbd "s") 'anything-surfraw)
1209 (define-key anything-command-map (kbd "r") 'anything-regexp)
1210 (define-key anything-command-map (kbd "w") 'anything-w3m-bookmarks)
1211 (define-key anything-command-map (kbd "x") 'anything-firefox-bookmarks)
1212 (define-key anything-command-map (kbd "#") 'anything-emms)
1213 (define-key anything-command-map (kbd "m") 'anything-man-woman)
1214 (define-key anything-command-map (kbd "t") 'anything-top)
1215 (define-key anything-command-map (kbd "i") 'anything-imenu)
1216 (define-key anything-command-map (kbd "<tab>") 'anything-lisp-completion-at-point)
1217 (define-key anything-command-map (kbd "p") 'anything-list-emacs-process)
1218 (define-key anything-command-map (kbd "C-x r b") 'anything-c-pp-bookmarks)
1219 (define-key anything-command-map (kbd "M-y") 'anything-show-kill-ring)
1220 (define-key anything-command-map (kbd "C-c <SPC>") 'anything-all-mark-rings)
1221 (define-key anything-command-map (kbd "C-x C-f") 'anything-find-files)
1222 (define-key anything-command-map (kbd "f") 'anything-for-files)
1223 (define-key anything-command-map (kbd "C-:") 'anything-eval-expression-with-eldoc)
1224 (define-key anything-command-map (kbd "C-,") 'anything-calcul-expression)
1225 (define-key anything-command-map (kbd "M-x") 'anything-M-x)
1226 (define-key anything-command-map (kbd "C-x C-w") 'anything-write-file)
1227 (define-key anything-command-map (kbd "C-x i") 'anything-insert-file)
1228 (define-key anything-command-map (kbd "M-s o") 'anything-occur)
1229 (define-key anything-command-map (kbd "M-g s") 'anything-do-grep)
1230 (define-key anything-command-map (kbd "c") 'anything-colors)
1231 (define-key anything-command-map (kbd "F") 'anything-select-xfont)
1232 (define-key anything-command-map (kbd "C-c f") 'anything-recentf)
1233 (define-key anything-command-map (kbd "C-c g") 'anything-google-suggest)
1234 (define-key anything-command-map (kbd "h i") 'anything-info-at-point)
1235 (define-key anything-command-map (kbd "h r") 'anything-info-emacs)
1236 (define-key anything-command-map (kbd "h g") 'anything-info-gnus)
1237 (define-key anything-command-map (kbd "C-x C-b") 'anything-buffers-list)
1238 (define-key anything-command-map (kbd "C-c C-b") 'anything-browse-code)
1239 (define-key anything-command-map (kbd "C-x r i") 'anything-register)
1240 (define-key anything-command-map (kbd "C-c C-x") 'anything-c-run-external-command)
1242 ;; In Emacs 23.1.50, minibuffer-local-must-match-filename-map was renamed to
1243 ;; minibuffer-local-filename-must-match-map.
1244 (defvar minibuffer-local-filename-must-match-map (make-sparse-keymap)) ;; Emacs 23.1.+
1245 (defvar minibuffer-local-must-match-filename-map (make-sparse-keymap)) ;; Older Emacsen
1246 (dolist (map (list minibuffer-local-filename-completion-map
1247 minibuffer-local-completion-map
1248 minibuffer-local-must-match-filename-map
1249 minibuffer-local-filename-must-match-map
1250 minibuffer-local-map
1251 minibuffer-local-isearch-map
1252 minibuffer-local-must-match-map
1253 minibuffer-local-ns-map))
1254 (define-key map "\C-r" 'anything-minibuffer-history))
1256 ;;; Menu
1257 (easy-menu-define nil global-map
1258 "`anything' menu"
1259 '("Anything"
1260 ["All anything commands" anything-execute-anything-command t]
1261 ["Find any Files/Buffers" anything-for-files t]
1262 "----"
1263 ("Files:"
1264 ["Find files" anything-find-files t]
1265 ["Recent Files" anything-recentf t]
1266 ["Locate" anything-locate t]
1267 ["Bookmarks" anything-c-pp-bookmarks t])
1268 ("Buffers:"
1269 ["Find buffers" anything-buffers-list t])
1270 ("Commands:"
1271 ["Emacs Commands" anything-M-x t]
1272 ["Externals Commands" anything-c-run-external-command t])
1273 ("Info:"
1274 ["Info at point" anything-info-at-point t]
1275 ["Emacs Manual index" anything-info-emacs t]
1276 ["Gnus Manual index" anything-info-gnus t])
1277 ("Org:"
1278 ["Org keywords" anything-org-keywords t]
1279 ["Org headlines" anything-org-headlines t])
1280 ("Tools:"
1281 ["Occur" anything-occur t]
1282 ["Grep" anything-do-grep t]
1283 ["Etags" anything-c-etags-select t]
1284 ["Lisp complete at point" anything-lisp-completion-at-point t]
1285 ["Browse Kill ring" anything-show-kill-ring t]
1286 ["Browse register" anything-register t]
1287 ["Browse code" anything-browse-code t]
1288 ["Mark Ring" anything-all-mark-rings t]
1289 ["Regexp handler" anything-regexp t]
1290 ["Colors & Faces" anything-colors t]
1291 ["Show xfonts" anything-select-xfont t]
1292 ["Imenu" anything-imenu t]
1293 ["Google Suggest" anything-google-suggest t]
1294 ["Eval expression" anything-eval-expression-with-eldoc t]
1295 ["Calcul expression" anything-calcul-expression t]
1296 ["Man pages" anything-man-woman t]
1297 ["Top externals process" anything-top t]
1298 ["Emacs internals process" anything-list-emacs-process t])
1299 "----"
1300 ["Prefered Options" anything-configuration t]))
1303 ;;; Documentation
1306 ;; Help message
1307 (defun anything-c-list-preconfigured-anything ()
1308 (loop with doc
1309 with sym
1310 for entry in (cdr (assoc
1311 (file-truename (locate-library "anything-config"))
1312 load-history))
1313 if (and (consp entry)
1314 (eq (car entry) 'defun)
1315 (string-match "^Preconfigured.+$"
1316 (setq doc (or (documentation (setq sym (cdr entry)))
1317 ""))))
1318 collect (cons sym (match-string 0 doc))))
1320 (defun anything-c-format-preconfigured-anything ()
1321 (mapcar (lambda (x) (format "\\[%s] : %s\n" (car x) (cdr x)))
1322 (anything-c-list-preconfigured-anything)))
1324 (setq anything-help-message
1325 (lambda ()
1326 (concat
1327 "\\<anything-map>"
1328 "`anything' is QuickSilver-like candidate-selection framework.
1330 Narrow the list by typing some pattern,
1331 Multiple patterns are allowed by splitting by space.
1332 Select with natural Emacs operations, choose with RET.
1334 If you have any problems, press C-c C-x C-b!!
1335 Feel free to send bug reports. I'll fix them.
1336 The steps are described in the beginning of anything.el file.
1338 == Basic Operations ==
1339 C-p, Up: Previous Line
1340 C-n, Down : Next Line
1341 M-v, PageUp : Previous Page
1342 C-v, PageDown : Next Page
1343 Enter : Execute first (default) action / Select
1344 M-< : First Line
1345 M-> : Last Line
1346 M-PageUp, C-M-S-v, C-M-y : Previous Page (other-window)
1347 M-PageDown, C-M-v : Next Page (other-window)
1349 Tab, C-i : Show action list
1350 Left : Previous Source
1351 Right, C-o : Next Source
1352 C-k : Delete pattern
1353 C-z : Persistent Action (Execute action with anything session kept)
1354 C-c C-x C-b: Send a bug report
1356 == Shortcuts For 2nd/3rd Action ==
1357 \\[anything-select-2nd-action-or-end-of-line] : Execute 2nd Action (if the minibuffer cursor is at end of line)
1358 \\[anything-select-3rd-action] : Execute 3rd Action
1360 == Visible Marks ==
1361 Visible marks store candidate. Some actions uses marked candidates.
1363 \\[anything-toggle-visible-mark] : Toggle Visible Mark
1364 \\[anything-prev-visible-mark] : Previous Mark
1365 \\[anything-next-visible-mark] : Next Mark
1367 == Miscellaneous Commands ==
1368 \\[anything-toggle-resplit-window] : Toggle vertical/horizontal split anything window
1369 \\[anything-quit-and-find-file] : Drop into `find-file'
1370 \\[anything-delete-current-selection] : Delete Selected Item (visually)
1371 \\[anything-kill-selection-and-quit] : Set Item Into the kill-ring And Quit
1372 \\[anything-yank-selection] : Yank Selected Item Into Pattern
1373 \\[anything-follow-mode] : Toggle Automatical Execution Of Persistent Action
1374 \\[anything-force-update] : Recalculate And Redisplay Candidates
1376 == Global Commands ==
1377 \\<global-map>\\[anything-resume] revives last `anything' session.
1378 It is very useful, so you should bind any key.
1380 Single source is executed by \\[anything-call-source].
1382 == Preconfigured `anything' ==
1383 Preconfigured `anything' is commands that uses `anything' interface.
1384 You can use them without configuration.
1387 (apply 'concat (anything-c-format-preconfigured-anything))
1389 Enjoy!")))
1391 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Preconfigured Anything ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1392 ;;;###autoload
1393 (defun anything-mini ()
1394 "Preconfigured `anything' lightweight version (buffer -> recentf)."
1395 (interactive)
1396 (anything-other-buffer '(anything-c-source-buffers-list anything-c-source-recentf)
1397 "*anything mini*"))
1398 ;;;###autoload
1399 (defun anything-for-files ()
1400 "Preconfigured `anything' for opening files.
1401 ffap -> recentf -> buffer -> bookmark -> file-cache -> files-in-current-dir -> locate"
1402 (interactive)
1403 (anything-other-buffer anything-for-files-prefered-list "*anything for files*"))
1405 ;;;###autoload
1406 (defun anything-recentf ()
1407 "Preconfigured `anything' for `recentf'."
1408 (interactive)
1409 (anything-other-buffer 'anything-c-source-recentf "*anything recentf*"))
1411 ;;;###autoload
1412 (defun anything-info-at-point (arg)
1413 "Preconfigured `anything' for searching info at point.
1414 With a prefix-arg insert symbol at point."
1415 (interactive "P")
1416 (let ((anything-c-google-suggest-default-function
1417 'anything-c-google-suggest-emacs-lisp))
1418 (anything :sources'(anything-c-source-info-elisp
1419 anything-c-source-info-cl
1420 anything-c-source-info-pages
1421 anything-c-source-google-suggest)
1422 :input (and arg (thing-at-point 'symbol))
1423 :buffer "*anything info*")))
1425 ;;;###autoload
1426 (defun anything-info-emacs ()
1427 "Preconfigured anything for Emacs manual index."
1428 (interactive)
1429 (anything-other-buffer 'anything-c-source-info-emacs "*info emacs*"))
1431 ;;;###autoload
1432 (defun anything-show-kill-ring ()
1433 "Preconfigured `anything' for `kill-ring'.
1434 It is drop-in replacement of `yank-pop'.
1435 You may bind this command to M-y.
1436 First call open the kill-ring browser, next calls move to next line."
1437 (interactive)
1438 (let ((buf "*anything kill-ring*"))
1439 (if (get-buffer-window buf)
1440 (with-anything-window
1441 (if (eq (point) (save-excursion
1442 (anything-end-of-buffer) (point)))
1443 (anything-beginning-of-buffer)
1444 (anything-next-line)))
1445 (anything-other-buffer 'anything-c-source-kill-ring buf))))
1447 ;;;###autoload
1448 (defun anything-minibuffer-history ()
1449 "Preconfigured `anything' for `minibuffer-history'."
1450 (interactive)
1451 (let ((enable-recursive-minibuffers t))
1452 (anything-other-buffer 'anything-c-source-minibuffer-history
1453 "*anything minibuffer-history*")))
1455 ;;;###autoload
1456 (defun anything-gentoo ()
1457 "Preconfigured `anything' for gentoo linux."
1458 (interactive)
1459 (anything-other-buffer '(anything-c-source-gentoo
1460 anything-c-source-use-flags)
1461 "*anything gentoo*"))
1463 ;;;###autoload
1464 (defun anything-imenu ()
1465 "Preconfigured `anything' for `imenu'."
1466 (interactive)
1467 (anything 'anything-c-source-imenu nil nil nil nil "*anything imenu*"))
1469 ;;;###autoload
1470 (defun anything-google-suggest ()
1471 "Preconfigured `anything' for google search with google suggest."
1472 (interactive)
1473 (anything-other-buffer 'anything-c-source-google-suggest "*anything google*"))
1475 ;;;###autoload
1476 (defun anything-yahoo-suggest ()
1477 "Preconfigured `anything' for Yahoo searching with Yahoo suggest."
1478 (interactive)
1479 (anything-other-buffer 'anything-c-source-yahoo-suggest "*anything yahoo*"))
1481 ;;; Converted from anything-show-*-only
1482 ;;;###autoload
1483 (defun anything-for-buffers ()
1484 "Preconfigured `anything' for buffer."
1485 (interactive)
1486 (anything-other-buffer 'anything-c-source-buffers "*anything for buffers*"))
1488 ;;;###autoload
1489 (defun anything-buffers-list ()
1490 "Enhanced preconfigured `anything' for buffer."
1491 (interactive)
1492 (anything :sources '(anything-c-source-buffers-list
1493 anything-c-source-buffer-not-found)
1494 :buffer "*anything buffers*" :keymap anything-c-buffer-map))
1496 ;;;###autoload
1497 (defun anything-bbdb ()
1498 "Preconfigured `anything' for BBDB.
1500 Needs BBDB.
1502 http://bbdb.sourceforge.net/"
1503 (interactive)
1504 (anything-other-buffer 'anything-c-source-bbdb "*anything bbdb*"))
1506 ;;;###autoload
1507 (defun anything-locate (arg)
1508 "Preconfigured `anything' for Locate.
1509 Note: you can add locate options after entering pattern.
1510 See 'man locate' for valid options.
1512 You can specify a specific database with prefix argument ARG \(C-u\).
1513 Many databases can be used: navigate and mark them.
1514 See also `anything-locate-with-db'.
1516 To create a user specific db, use
1517 \"updatedb -l 0 -o db_path -U directory\".
1518 Where db_path is a filename matched by
1519 `anything-locate-db-file-regexp'."
1520 (interactive "P")
1521 (let* ((db (and arg
1522 (anything-c-read-file-name
1523 "LocateDBFiles: "
1524 :marked-candidates t
1525 :preselect anything-locate-db-file-regexp
1526 :test #'(lambda (x)
1527 (if anything-locate-db-file-regexp
1528 ;; Select only locate db files and directories
1529 ;; to allow navigation.
1530 (or (string-match
1531 anything-locate-db-file-regexp x)
1532 (file-directory-p x))
1533 x))))))
1534 (anything-locate-with-db db)))
1536 ;;;###autoload
1537 (defun anything-w3m-bookmarks ()
1538 "Preconfigured `anything' for w3m bookmark.
1540 Needs w3m and emacs-w3m.
1542 http://w3m.sourceforge.net/
1543 http://emacs-w3m.namazu.org/"
1544 (interactive)
1545 (anything-other-buffer 'anything-c-source-w3m-bookmarks
1546 "*anything w3m bookmarks*"))
1548 ;;;###autoload
1549 (defun anything-firefox-bookmarks ()
1550 "Preconfigured `anything' for firefox bookmark.
1551 You will have to enable html bookmarks in firefox:
1552 open about:config in firefox and double click on this line to enable value \
1553 to true:
1555 user_pref(\"browser.bookmarks.autoExportHTML\", false);
1557 You should have now:
1559 user_pref(\"browser.bookmarks.autoExportHTML\", true);
1561 After closing firefox, you will be able to browse you bookmarks.
1563 (interactive)
1564 (anything-other-buffer 'anything-c-source-firefox-bookmarks
1565 "*Anything Firefox*"))
1567 ;;;###autoload
1568 (defun anything-colors ()
1569 "Preconfigured `anything' for color."
1570 (interactive)
1571 (anything-other-buffer
1572 '(anything-c-source-colors anything-c-source-customize-face)
1573 "*anything colors*"))
1575 ;;;###autoload
1576 (defun anything-bookmarks ()
1577 "Preconfigured `anything' for bookmarks."
1578 (interactive)
1579 (anything-other-buffer 'anything-c-source-bookmarks "*anything bookmarks*"))
1581 ;;;###autoload
1582 (defun anything-c-pp-bookmarks ()
1583 "Preconfigured `anything' for bookmarks (pretty-printed)."
1584 (interactive)
1585 (anything-other-buffer '(anything-c-source-bookmarks-local
1586 anything-c-source-bookmarks-su
1587 anything-c-source-bookmarks-ssh)
1588 "*anything pp bookmarks*"))
1590 ;;;###autoload
1591 (defun anything-c-insert-latex-math ()
1592 "Preconfigured anything for latex math symbols completion."
1593 (interactive)
1594 (anything-other-buffer 'anything-c-source-latex-math "*anything latex*"))
1596 ;;;###autoload
1597 (defun anything-register ()
1598 "Preconfigured `anything' for Emacs registers."
1599 (interactive)
1600 (anything-other-buffer 'anything-c-source-register "*anything register*"))
1602 ;;;###autoload
1603 (defun anything-man-woman ()
1604 "Preconfigured `anything' for Man and Woman pages."
1605 (interactive)
1606 (anything-other-buffer 'anything-c-source-man-pages "*Anything man woman*"))
1608 ;;;###autoload
1609 (defun anything-org-keywords ()
1610 "Preconfigured `anything' for org keywords."
1611 (interactive)
1612 (anything-other-buffer 'anything-c-source-org-keywords "*org keywords*"))
1614 ;;;###autoload
1615 (defun anything-emms ()
1616 "Preconfigured `anything' for emms sources."
1617 (interactive)
1618 (anything '(anything-c-source-emms-streams
1619 anything-c-source-emms-files
1620 anything-c-source-emms-dired)
1621 nil nil nil nil
1622 "*Anything Emms*"))
1624 ;;;###autoload
1625 (defun anything-eev-anchors ()
1626 "Preconfigured `anything' for eev anchors."
1627 (interactive)
1628 (anything-other-buffer 'anything-c-source-eev-anchor "*Anything eev anchors*"))
1630 ;;;###autoload
1631 (defun anything-bm-list ()
1632 "Preconfigured `anything' for visible bookmarks.
1634 Needs bm.el
1636 http://cvs.savannah.gnu.org/viewvc/*checkout*/bm/bm/bm.el"
1637 (interactive)
1638 (let ((anything-outline-using t))
1639 (anything-other-buffer 'anything-c-source-bm "*anything bm list*")))
1641 ;;;###autoload
1642 (defun anything-timers ()
1643 "Preconfigured `anything' for timers."
1644 (interactive)
1645 (anything-other-buffer '(anything-c-source-absolute-time-timers
1646 anything-c-source-idle-time-timers)
1647 "*anything timers*"))
1649 ;;;###autoload
1650 (defun anything-list-emacs-process ()
1651 "Preconfigured `anything' for emacs process."
1652 (interactive)
1653 (anything-other-buffer 'anything-c-source-emacs-process "*anything process*"))
1655 ;;;###autoload
1656 (defun anything-occur ()
1657 "Preconfigured Anything for Occur source.
1658 If region is active, search only in region,
1659 otherwise search in whole buffer."
1660 (interactive)
1661 (let ((anything-compile-source-functions
1662 ;; rule out anything-match-plugin because the input is one regexp.
1663 (delq 'anything-compile-source--match-plugin
1664 (copy-sequence anything-compile-source-functions))))
1665 (anything-other-buffer 'anything-c-source-occur "*Anything Occur*")))
1667 ;;;###autoload
1668 (defun anything-browse-code ()
1669 "Preconfigured anything to browse code."
1670 (interactive)
1671 (anything-other-buffer 'anything-c-source-browse-code "*Browse code*"))
1673 ;;;###autoload
1674 (defun anything-org-headlines ()
1675 "Preconfigured anything to show org headlines."
1676 (interactive)
1677 (anything-other-buffer 'anything-c-source-org-headline "*org headlines*"))
1679 ;;;###autoload
1680 (defun anything-info-gnus ()
1681 "Preconfigured anything to browse Gnus Manual."
1682 (interactive)
1683 (anything-other-buffer 'anything-c-source-info-gnus "*info Gnus*"))
1685 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Anything Applications ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1687 ;;; Anything regexp.
1690 (defun anything-c-query-replace-regexp (candidate)
1691 "Query replace regexp from `anything-regexp'.
1692 With a prefix arg replace only matches surrounded by word boundaries,
1693 i.e Don't replace inside a word, regexp is surrounded with \\bregexp\\b."
1694 (let ((regexp (funcall (anything-attr 'regexp))))
1695 (apply 'query-replace-regexp
1696 (anything-c-query-replace-args regexp))))
1698 (defun anything-c-kill-regexp-as-sexp (candidate)
1699 "Kill regexp in a format usable in lisp code."
1700 (anything-c-regexp-kill-new
1701 (prin1-to-string (funcall (anything-attr 'regexp)))))
1703 (defun anything-c-kill-regexp (candidate)
1704 "Kill regexp as it is in `anything-pattern'."
1705 (anything-c-regexp-kill-new (funcall (anything-attr 'regexp))))
1707 (defun anything-c-query-replace-args (regexp)
1708 "create arguments of `query-replace-regexp' action in `anything-regexp'."
1709 (let ((region-only (anything-region-active-p)))
1710 (list
1711 regexp
1712 (query-replace-read-to regexp
1713 (format "Query replace %sregexp %s"
1714 (if anything-current-prefix-arg "word " "")
1715 (if region-only "in region " ""))
1717 anything-current-prefix-arg
1718 (when region-only (region-beginning))
1719 (when region-only (region-end)))))
1721 (defvar anything-c-source-regexp
1722 '((name . "Regexp Builder")
1723 (init . (lambda ()
1724 (anything-candidate-buffer anything-current-buffer)))
1725 (candidates-in-buffer)
1726 (get-line . anything-c-regexp-get-line)
1727 (persistent-action . anything-c-regexp-persistent-action)
1728 (persistent-help . "Show this line")
1729 (multiline)
1730 (delayed)
1731 (requires-pattern . 2)
1732 (mode-line . "Press TAB to select action.")
1733 (regexp . (lambda () anything-input))
1734 (action . (("Kill Regexp as sexp" . anything-c-kill-regexp-as-sexp)
1735 ("Query Replace Regexp (C-u Not inside word.)"
1736 . anything-c-query-replace-regexp)
1737 ("Kill Regexp" . anything-c-kill-regexp)))))
1739 (defun anything-c-regexp-get-line (s e)
1740 (propertize
1741 (apply 'concat
1742 ;; Line contents
1743 (format "%5d: %s" (line-number-at-pos (1- s)) (buffer-substring s e))
1744 ;; subexps
1745 (loop for i from 0 to (1- (/ (length (match-data)) 2))
1746 collect (format "\n %s'%s'"
1747 (if (zerop i) "Group 0: " (format "Group %d: " i))
1748 (match-string i))))
1749 ;; match beginning
1750 ;; KLUDGE: point of anything-candidate-buffer is +1 than that of anything-current-buffer.
1751 ;; It is implementation problem of candidates-in-buffer.
1752 'anything-realvalue
1753 (1- s)))
1755 (defun anything-goto-line (lineno)
1756 "Goto LINENO opening only outline headline if needed."
1757 (goto-char (point-min)) (forward-line (1- lineno))
1758 (when (or (eq major-mode 'org-mode) outline-minor-mode)
1759 (org-reveal))
1760 (anything-match-line-color-current-line) (sit-for 0.3)
1761 (anything-match-line-cleanup))
1763 (defun anything-c-regexp-persistent-action (pt)
1764 (goto-char pt)
1765 (anything-persistent-highlight-point))
1767 (defun anything-c-regexp-kill-new (input)
1768 (kill-new input)
1769 (message "Killed: %s" input))
1771 (defun anything-region-active-p ()
1772 (and transient-mark-mode mark-active (/= (mark) (point))))
1774 (defun* anything-current-buffer-narrowed-p (&optional
1775 (buffer anything-current-buffer))
1776 "Check if BUFFER is narrowed.
1777 Default is `anything-current-buffer'."
1778 (with-current-buffer buffer
1779 (let ((beg (point-min))
1780 (end (point-max))
1781 (total (buffer-size)))
1782 (or (/= beg 1) (/= end (1+ total))))))
1784 ;;;###autoload
1785 (defun anything-regexp ()
1786 "Preconfigured anything to build regexps and run query-replace-regexp \
1787 against."
1788 (interactive)
1789 (save-restriction
1790 (let ((anything-compile-source-functions
1791 ;; rule out anything-match-plugin because the input is one regexp.
1792 (delq 'anything-compile-source--match-plugin
1793 (copy-sequence anything-compile-source-functions))))
1794 (when (and (anything-region-active-p)
1795 ;; Don't narrow to region if buffer is already narrowed.
1796 (not (anything-current-buffer-narrowed-p)))
1797 (narrow-to-region (region-beginning) (region-end)))
1798 (anything :sources
1799 anything-c-source-regexp
1800 :buffer "*anything regexp*"
1801 :prompt "Regexp: "))))
1804 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Utilities Functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1806 (defun anything-test-sources ()
1807 "List all anything sources for test.
1808 The output is sexps which are evaluated by \\[eval-last-sexp]."
1809 (interactive)
1810 (with-output-to-temp-buffer "*Anything Test Sources*"
1811 (mapc (lambda (s) (princ (format ";; (anything '%s)\n" s)))
1812 (apropos-internal "^anything-c-source" #'boundp))
1813 (pop-to-buffer standard-output)))
1815 ;;; For compatibility
1816 (unless (fboundp 'region-active-p)
1817 (defun region-active-p ()
1818 "Return t if Transient Mark mode is enabled and the mark is active.
1820 Most commands that act on the region if it is active and
1821 Transient Mark mode is enabled, and on the text near point
1822 otherwise, should use `use-region-p' instead. That function
1823 checks the value of `use-empty-active-region' as well."
1824 (and transient-mark-mode mark-active)))
1826 (defun anything-nest (&rest same-as-anything)
1827 "Nested `anything'. If you use `anything' within `anything', use it."
1828 (with-selected-window (anything-window)
1829 (let (anything-current-position
1830 anything-current-buffer
1831 (orig-anything-buffer anything-buffer)
1832 anything-pattern
1833 anything-buffer
1834 anything-sources
1835 anything-compiled-sources
1836 anything-buffer-chars-modified-tick
1837 (anything-samewindow t)
1838 (enable-recursive-minibuffers t))
1839 (unwind-protect
1840 (apply #'anything same-as-anything)
1841 (anything-initialize-overlays orig-anything-buffer)
1842 (add-hook 'post-command-hook 'anything-check-minibuffer-input)))))
1844 (defun anything-displaying-source-names ()
1845 "Display sources name."
1846 (with-current-buffer anything-buffer
1847 (goto-char (point-min))
1848 (loop with pos
1849 while (setq pos (next-single-property-change (point) 'anything-header))
1850 do (goto-char pos)
1851 collect (buffer-substring-no-properties (point-at-bol)(point-at-eol))
1852 do (forward-line 1))))
1854 (defun anything-select-source ()
1855 "Select source."
1856 (interactive)
1857 (let ((default (assoc-default 'name (anything-get-current-source)))
1858 (source-names (anything-displaying-source-names))
1859 (all-source-names (mapcar (lambda (s) (assoc-default 'name s))
1860 (anything-get-sources))))
1861 (setq anything-candidate-number-limit 9999)
1862 (anything-aif
1863 (let (anything-source-filter)
1864 (anything-nest '(((name . "Anything Source")
1865 (candidates . source-names)
1866 (action . identity))
1867 ((name . "Anything Source (ALL)")
1868 (candidates . all-source-names)
1869 (action . identity)))
1870 nil "Source: " nil
1871 default "*anything select source*"))
1872 (anything-set-source-filter (list it))
1873 (anything-set-source-filter nil))))
1875 (defun anything-c-match-on-file-name (candidate)
1876 "Return non-nil if `anything-pattern' match basename of filename CANDIDATE."
1877 (string-match anything-pattern (file-name-nondirectory candidate)))
1879 (defun anything-c-match-on-directory-name (candidate)
1880 "Return non-nil if `anything-pattern' match directory part of CANDIDATE."
1881 (anything-aif (file-name-directory candidate)
1882 (string-match anything-pattern it)))
1884 (defun anything-c-string-match (candidate)
1885 "Return non-nil if `anything-pattern' match CANDIDATE.
1886 The match is done with `string-match'."
1887 (string-match anything-pattern candidate))
1889 ;; `anything-c-compose' is no more needed, it is for compatibility.
1890 (defalias 'anything-c-compose 'anything-compose)
1892 (defun anything-c-skip-entries (list regexp)
1893 "Remove entries which matches REGEXP from LIST."
1894 (remove-if (lambda (x) (and (stringp x) (string-match regexp x)))
1895 list))
1897 (defun anything-c-shadow-entries (list regexp)
1898 "Display elements of LIST matching REGEXP with the `file-name-shadow' face."
1899 (mapcar (lambda (file)
1900 ;; Add shadow face property to boring files.
1901 (let ((face (if (facep 'file-name-shadow)
1902 'file-name-shadow
1903 ;; fall back to default on XEmacs
1904 'default)))
1905 (if (string-match regexp file)
1906 (setq file (propertize file 'face face))))
1907 file)
1908 list))
1910 (defsubst anything-c-stringify (str-or-sym)
1911 "Get string of STR-OR-SYM."
1912 (if (stringp str-or-sym)
1913 str-or-sym
1914 (symbol-name str-or-sym)))
1916 (defsubst anything-c-symbolify (str-or-sym)
1917 "Get symbol of STR-OR-SYM."
1918 (if (symbolp str-or-sym)
1919 str-or-sym
1920 (intern str-or-sym)))
1922 (defun anything-c-describe-function (func)
1923 "FUNC is symbol or string."
1924 (describe-function (anything-c-symbolify func)))
1926 (defun anything-c-describe-variable (var)
1927 "VAR is symbol or string."
1928 (describe-variable (anything-c-symbolify var)))
1930 (defun anything-c-find-function (func)
1931 "FUNC is symbol or string."
1932 (find-function (anything-c-symbolify func)))
1934 (defun anything-c-find-variable (var)
1935 "VAR is symbol or string."
1936 (find-variable (anything-c-symbolify var)))
1938 (defun anything-c-kill-new (string &optional replace yank-handler)
1939 "STRING is symbol or string."
1940 (kill-new (anything-c-stringify string) replace yank-handler))
1942 ;;; Toggle all marks.
1945 ;;;###autoload
1946 (defun anything-mark-all ()
1947 "Mark all visible unmarked candidates in current source."
1948 (interactive)
1949 (with-anything-window
1950 (save-excursion
1951 (goto-char (anything-get-previous-header-pos))
1952 (anything-next-line)
1953 (let* ((next-head (anything-get-next-header-pos))
1954 (end (and next-head
1955 (save-excursion
1956 (goto-char next-head)
1957 (forward-line -2)
1958 (point))))
1959 (maxpoint (or end (point-max))))
1960 (while (< (point) maxpoint)
1961 (anything-mark-current-line)
1962 (let ((prefix (get-text-property (point-at-bol) 'display))
1963 (bn (anything-c-basename (anything-get-selection)))
1964 (src (assoc-default 'name (anything-get-current-source))))
1965 (when (and (not (anything-this-visible-mark))
1966 (not (or (string= prefix "[?]")
1967 (string= prefix "[@]"))))
1968 ;; Don't mark possibles directories ending with . or ..
1969 ;; and also autosave files/links.
1970 (unless
1971 (and (or (anything-file-completion-source-p)
1972 (equal src "Files from Current Directory"))
1973 (string-match "^\\.#.*\\|^#.*#$\\|\\.$" bn))
1974 (anything-make-visible-mark))))
1975 (forward-line 1) (end-of-line))))
1976 (anything-mark-current-line)
1977 (message "%s candidates marked" (length anything-marked-candidates))))
1979 ;;;###autoload
1980 (defun anything-unmark-all ()
1981 "Unmark all candidates in all sources of current anything session."
1982 (interactive)
1983 (with-anything-window
1984 (let ((len (length anything-marked-candidates)))
1985 (save-excursion
1986 (anything-clear-visible-mark))
1987 (setq anything-marked-candidates nil)
1988 (anything-mark-current-line)
1989 (message "%s candidates unmarked" len))))
1991 ;;;###autoload
1992 (defun anything-toggle-all-marks ()
1993 "Toggle all marks.
1994 Mark all visible candidates of current source or unmark all candidates
1995 visible or invisible in all sources of current anything session"
1996 (interactive)
1997 (let ((marked (anything-marked-candidates)))
1998 (if (and (>= (length marked) 1)
1999 (with-anything-window anything-visible-mark-overlays))
2000 (anything-unmark-all)
2001 (anything-mark-all))))
2003 (define-key anything-map (kbd "M-m") 'anything-toggle-all-marks)
2005 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Hacks ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2006 (defadvice eval-defun (after anything-source-hack activate)
2007 "See `anything-c-enable-eval-defun-hack'."
2008 (when anything-c-enable-eval-defun-hack
2009 (let ((varsym (save-excursion
2010 (beginning-of-defun)
2011 (forward-char 1)
2012 (when (memq (read (current-buffer)) '(defvar setq))
2013 (read (current-buffer))))))
2014 (when (string-match "^anything-c-source-" (symbol-name varsym))
2015 (anything varsym)))))
2016 ;; (progn (ad-disable-advice 'eval-defun 'after 'anything-source-hack) (ad-update 'eval-defun))
2019 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Anything Sources ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2020 ;;;; <Buffer>
2021 (defun anything-c-buffer-list ()
2022 "Return the list of names of buffers with boring buffers filtered out.
2023 Boring buffers is specified by `anything-c-boring-buffer-regexp'.
2024 The first buffer in the list will be the last recently used
2025 buffer that is not the current buffer."
2026 (let ((buffers (mapcar 'buffer-name (buffer-list))))
2027 (append (cdr buffers) (list (car buffers)))))
2029 (defvar anything-c-source-buffers
2030 '((name . "Buffers")
2031 (candidates . anything-c-buffer-list)
2032 (type . buffer)))
2033 ;; (anything 'anything-c-source-buffers)
2035 (defvar anything-c-source-buffer-not-found
2036 '((name . "Create buffer")
2037 (dummy)
2038 (filtered-candidate-transformer (lambda (cands source)
2039 (list anything-pattern)))
2040 (action . (lambda (candidate)
2041 (anything-c-switch-to-buffer (get-buffer-create candidate))))))
2042 ;; (anything 'anything-c-source-buffer-not-found)
2044 ;;; Buffers+
2047 (eval-when-compile (require 'dired))
2049 (defun anything-c-highlight-buffers (buffers)
2050 (loop for i in buffers
2051 for buf = (get-buffer i)
2052 for bfname = (buffer-file-name buf)
2053 collect
2054 (cond (;; A dired buffer.
2055 (rassoc buf dired-buffers)
2056 (propertize i 'face 'anything-ff-directory
2057 'help-echo (car (rassoc buf dired-buffers))))
2058 ;; A buffer file modified somewhere outside of emacs.
2059 ((and bfname (not (file-remote-p bfname))
2060 (file-exists-p bfname)
2061 (not (verify-visited-file-modtime buf)))
2062 (propertize i 'face 'anything-buffer-saved-out
2063 'help-echo bfname))
2064 ;; A new buffer file not already saved on disk.
2065 ((and bfname (not (file-remote-p bfname))
2066 (not (verify-visited-file-modtime buf)))
2067 (propertize i 'face 'anything-buffer-not-saved
2068 'help-echo bfname))
2069 ;; A Remote buffer file modified and not saved on disk.
2070 ((and bfname (file-remote-p bfname) (buffer-modified-p buf))
2071 (let ((prefix (propertize
2072 " " 'display
2073 (propertize "@ " 'face 'anything-ff-prefix))))
2074 (cons (concat prefix (propertize i 'face 'anything-ff-symlink
2075 'help-echo bfname)) i)))
2076 ;; A buffer file modified and not saved on disk.
2077 ((and bfname (buffer-modified-p buf))
2078 (propertize i 'face 'anything-ff-symlink
2079 'help-echo bfname))
2080 ;; A remote buffer file not modified and saved on disk.
2081 ((and bfname (file-remote-p bfname))
2082 (let ((prefix (propertize
2083 " " 'display
2084 (propertize "@ " 'face 'anything-ff-prefix))))
2085 (cons (concat prefix (propertize i 'face 'font-lock-type-face
2086 'help-echo bfname)) i)))
2087 ;; A buffer file not modified and saved on disk.
2088 (bfname
2089 (propertize i 'face 'font-lock-type-face
2090 'help-echo bfname))
2091 ;; Any non--file buffer.
2092 (t (propertize i 'face 'italic)))))
2094 (defvar anything-buffer-mode-line-string
2095 '("Buffer(s)"
2096 "\\<anything-c-buffer-map>\
2097 \\[anything-c-buffer-help]:Help, \
2098 \\<anything-map>\
2099 \\[anything-select-action]:Acts,\
2100 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
2101 \\[anything-select-3rd-action]:NthAct,\
2102 \\[anything-send-bug-report-from-anything]:BugReport."
2103 "String displayed in mode-line in `anything-c-source-buffers-list'"))
2105 (defvar anything-c-source-buffers-list
2106 '((name . "Buffers")
2107 (candidates . anything-c-buffer-list)
2108 (type . buffer)
2109 (match anything-c-buffer-match-major-mode)
2110 (diff-action . anything-buffer-toggle-diff)
2111 (revert-action . anything-buffer-revert-and-update)
2112 (save-action . anything-buffer-save-and-update)
2113 (candidate-transformer anything-c-skip-current-buffer
2114 anything-c-skip-boring-buffers
2115 anything-c-highlight-buffers)
2116 (persistent-action . anything-c-buffers-list-persistent-action)
2117 (volatile)
2118 (mode-line . anything-buffer-mode-line-string)
2119 (persistent-help . "Show this buffer / C-u \\[anything-execute-persistent-action]: Kill this buffer")))
2121 (defun anything-c-buffer-match-major-mode (candidate)
2122 "Match maybe buffer by major-mode.
2123 If you give a major-mode or partial major-mode,
2124 it will list all buffers of this major-mode and/or buffers with name
2125 matching this major-mode.
2126 If you add a space after major-mode and then a space,
2127 it will match all buffers of the major-mode
2128 before space matching pattern after space.
2129 If you give a pattern which doesn't match a major-mode, it will search buffer
2130 with name matching pattern."
2131 (let* ((cand (replace-regexp-in-string "^\\s-\\{1\\}" "" candidate))
2132 (buf (get-buffer cand)))
2133 (when buf
2134 (with-current-buffer buf
2135 (let ((mjm (symbol-name major-mode))
2136 (split (split-string anything-pattern)))
2137 (cond ((string-match "\\s-$" anything-pattern)
2138 (string-match (car split) mjm))
2139 ((string-match "\\s-" anything-pattern)
2140 (and (string-match (car split) mjm)
2141 (string-match (cadr split) cand)))
2142 (t (or (string-match anything-pattern mjm)
2143 (string-match anything-pattern cand)))))))))
2145 (defun anything-c-buffer-query-replace-1 (&optional regexp-flag)
2146 "Query replace in marked buffers.
2147 If REGEXP-FLAG is given use `query-replace-regexp'."
2148 (let ((fn (if regexp-flag 'query-replace-regexp 'query-replace))
2149 (prompt (if regexp-flag "Query replace regexp" "Query replace"))
2150 (bufs (anything-marked-candidates)))
2151 (loop
2152 with replace = (query-replace-read-from prompt regexp-flag)
2153 with tostring = (unless (consp replace)
2154 (query-replace-read-to
2155 replace prompt regexp-flag))
2156 for buf in bufs
2158 (save-window-excursion
2159 (anything-c-switch-to-buffer buf)
2160 (save-excursion
2161 (let ((case-fold-search t))
2162 (goto-char (point-min))
2163 (if (consp replace)
2164 (apply fn (list (car replace) (cdr replace)))
2165 (apply fn (list replace tostring)))))))))
2167 (defun anything-c-buffer-query-replace-regexp (candidate)
2168 (anything-c-buffer-query-replace-1 'regexp))
2170 (defun anything-c-buffer-query-replace (candidate)
2171 (anything-c-buffer-query-replace-1))
2173 (defun anything-c-buffer-help ()
2174 "Help command for anything buffers."
2175 (interactive)
2176 (let ((anything-help-message "== Anything Buffer ==
2177 \nTips:
2178 You can enter a partial name of major-mode (e.g lisp, sh) to narrow down buffers.
2179 Enter then a space and a pattern to narrow down to buffers matching this pattern.
2180 \nSpecific commands for `anything-buffer+':
2181 \\<anything-c-buffer-map>
2182 \\[anything-buffer-run-grep]\t\t->Grep Buffer(s) (C-u grep all buffers linked to a file).
2183 \\[anything-buffer-run-zgrep]\t\t->Zgrep Buffer(s) (C-u grep all buffers linked to a file).
2184 \\[anything-buffer-switch-other-window]\t\t->Switch other window.
2185 \\[anything-buffer-switch-other-frame]\t\t->Switch other frame.
2186 \\[anything-buffer-run-query-replace-regexp]\t\t->Query replace regexp in marked buffers.
2187 \\[anything-buffer-run-query-replace]\t\t->Query replace in marked buffers.
2188 \\[anything-buffer-switch-to-elscreen]\t\t->Find buffer in Elscreen.
2189 \\[anything-buffer-diff-persistent]\t\t->Toggle Diff buffer without quitting.
2190 \\[anything-buffer-revert-persistent]\t\t->Revert buffer without quitting.
2191 \\[anything-buffer-save-persistent]\t\t->Save buffer without quitting.
2192 \\[anything-buffer-run-kill-buffers]\t\t->Delete marked buffers and quit.
2193 \\[anything-c-buffer-help]\t\t->Display this help.
2194 \n== Anything Map ==
2195 \\{anything-map}
2197 (anything-help)))
2199 (defvar anything-c-buffer-map
2200 (let ((map (copy-keymap anything-map)))
2201 (define-key map (kbd "C-c ?") 'anything-c-buffer-help)
2202 ;; No need to have separate command for grep and zgrep
2203 ;; as we don't use recursivity for buffers.
2204 ;; So use zgrep for both as it is capable to handle non--compressed files.
2205 (define-key map (kbd "M-g s") 'anything-buffer-run-zgrep)
2206 (define-key map (kbd "M-g z") 'anything-buffer-run-zgrep)
2207 (define-key map (kbd "C-o") 'anything-buffer-switch-other-window)
2208 (define-key map (kbd "C-c C-o") 'anything-buffer-switch-other-frame)
2209 (define-key map (kbd "C-=") 'anything-buffer-diff-persistent)
2210 (define-key map (kbd "M-U") 'anything-buffer-revert-persistent)
2211 (define-key map (kbd "M-D") 'anything-buffer-run-kill-buffers)
2212 (define-key map (kbd "C-x C-s") 'anything-buffer-save-persistent)
2213 (define-key map (kbd "C-M-%") 'anything-buffer-run-query-replace-regexp)
2214 (define-key map (kbd "M-%") 'anything-buffer-run-query-replace)
2215 (when (locate-library "elscreen")
2216 (define-key map (kbd "<C-tab>") 'anything-buffer-switch-to-elscreen))
2217 (delq nil map))
2218 "Keymap for buffer sources in anything.")
2220 (defun anything-buffer-toggle-diff (candidate)
2221 "Toggle diff buffer CANDIDATE with it's file."
2222 (if (get-buffer-window "*Diff*")
2223 (kill-buffer "*Diff*")
2224 (diff-buffer-with-file (get-buffer candidate))))
2226 ;;;###autoload
2227 (defun anything-buffer-diff-persistent ()
2228 "Toggle diff buffer without quitting anything."
2229 (interactive)
2230 (anything-execute-persistent-action 'diff-action))
2232 (defun anything-buffer-revert-and-update (candidate)
2233 (let ((marked (anything-marked-candidates)))
2234 (loop for buf in marked do (anything-revert-buffer buf))
2235 (anything-force-update)
2236 (anything-c-recenter-window)))
2238 ;;;###autoload
2239 (defun anything-buffer-revert-persistent ()
2240 "Revert buffer without quitting anything."
2241 (interactive)
2242 (anything-execute-persistent-action 'revert-action))
2244 (defun anything-buffer-save-and-update (candidate)
2245 (let ((marked (anything-marked-candidates))
2246 (enable-recursive-minibuffers t))
2247 (loop for buf in marked do
2248 (with-current-buffer (get-buffer buf)
2249 (save-buffer)))
2250 (anything-force-update)
2251 (anything-c-recenter-window)))
2253 ;;;###autoload
2254 (defun anything-buffer-save-persistent ()
2255 "Save buffer without quitting anything."
2256 (interactive)
2257 (anything-execute-persistent-action 'save-action))
2259 ;;;###autoload
2260 (defun anything-buffer-run-kill-buffers ()
2261 "Run kill buffer action from `anything-c-source-buffer+'."
2262 (interactive)
2263 (anything-c-quit-and-execute-action 'anything-kill-marked-buffers))
2265 ;;;###autoload
2266 (defun anything-buffer-run-grep ()
2267 "Run Grep action from `anything-c-source-buffer+'."
2268 (interactive)
2269 (anything-c-quit-and-execute-action 'anything-c-grep-buffers))
2271 ;;;###autoload
2272 (defun anything-buffer-run-zgrep ()
2273 "Run Grep action from `anything-c-source-buffer+'."
2274 (interactive)
2275 (anything-c-quit-and-execute-action 'anything-c-zgrep-buffers))
2277 ;;;###autoload
2278 (defun anything-buffer-run-query-replace-regexp ()
2279 "Run Query replace regexp action from `anything-c-source-buffer+'."
2280 (interactive)
2281 (anything-c-quit-and-execute-action 'anything-c-buffer-query-replace-regexp))
2283 ;;;###autoload
2284 (defun anything-buffer-run-query-replace ()
2285 "Run Query replace action from `anything-c-source-buffer+'."
2286 (interactive)
2287 (anything-c-quit-and-execute-action 'anything-c-buffer-query-replace))
2289 ;;;###autoload
2290 (defun anything-buffer-switch-other-window ()
2291 "Run switch to other window action from `anything-c-source-buffer+'."
2292 (interactive)
2293 (anything-c-quit-and-execute-action 'switch-to-buffer-other-window))
2295 ;;;###autoload
2296 (defun anything-buffer-switch-other-frame ()
2297 "Run switch to other frame action from `anything-c-source-buffer+'."
2298 (interactive)
2299 (anything-c-quit-and-execute-action 'switch-to-buffer-other-frame))
2301 ;;;###autoload
2302 (defun anything-buffer-switch-to-elscreen ()
2303 "Run switch to elscreen action from `anything-c-source-buffer+'."
2304 (interactive)
2305 (anything-c-quit-and-execute-action 'anything-find-buffer-on-elscreen))
2307 (defun anything-c-buffers-persistent-kill (buffer)
2308 "Persistent action to kill buffer."
2309 (with-current-buffer (get-buffer buffer)
2310 (if (and (buffer-modified-p)
2311 (buffer-file-name (current-buffer)))
2312 (progn
2313 (save-buffer)
2314 (kill-buffer buffer))
2315 (kill-buffer buffer)))
2316 (anything-delete-current-selection))
2318 (defun anything-c-recenter-window ()
2319 "Make visible current selection by recentering anything window."
2320 (with-anything-window (recenter)))
2322 (defun anything-c-buffers-list-persistent-action (candidate)
2323 (if current-prefix-arg
2324 (anything-c-buffers-persistent-kill candidate)
2325 (anything-c-switch-to-buffer candidate)))
2327 ;; (anything 'anything-c-source-buffers-list)
2329 (defadvice anything-quit-and-find-file (around use-anything-find-files activate)
2330 "Let `anything-quit-and-find-file' take advantage of `anything-find-files'."
2331 (interactive)
2332 (anything-run-after-quit
2333 (lambda (f)
2334 (anything-find-files-1 f))
2335 (anything-aif (get-buffer (anything-get-selection))
2336 (or (buffer-file-name it)
2337 (car (rassoc it dired-buffers))
2338 (and (with-current-buffer it
2339 (eq major-mode 'org-agenda-mode))
2340 org-directory
2341 (expand-file-name org-directory))
2342 default-directory)
2343 (let ((sel (anything-get-selection)))
2344 (if (file-exists-p sel)
2345 (expand-file-name sel)
2346 default-directory)))))
2348 ;;;; <File>
2351 ;;; File name history
2352 (defvar anything-c-source-file-name-history
2353 '((name . "File Name History")
2354 (candidates . file-name-history)
2355 (match anything-c-match-on-file-name
2356 anything-c-match-on-directory-name)
2357 (type . file)))
2358 ;; (anything 'anything-c-source-file-name-history)
2360 ;;; Files in current dir
2363 (defvar anything-c-source-files-in-current-dir
2364 '((name . "Files from Current Directory")
2365 (candidates . (lambda ()
2366 (with-current-buffer anything-current-buffer
2367 (directory-files (anything-c-current-directory)))))
2368 ;; volatile is not needed, I think.
2369 (type . file)))
2370 ;; (anything 'anything-c-source-files-in-current-dir)
2372 (defun anything-c-highlight-files (files)
2373 (loop for i in files
2374 if (file-directory-p i)
2375 collect (propertize (file-name-nondirectory i)
2376 'face 'anything-ff-directory
2377 'help-echo (expand-file-name i))
2378 else
2379 collect (propertize (file-name-nondirectory i)
2380 'face 'anything-ff-file
2381 'help-echo (expand-file-name i))))
2383 (defvar anything-c-source-files-in-current-dir+
2384 '((name . "Files from Current Directory")
2385 (candidates . (lambda ()
2386 (with-current-buffer anything-current-buffer
2387 (directory-files (anything-c-current-directory) t))))
2388 (candidate-transformer anything-c-highlight-files)
2389 ;; volatile is not needed, I think.
2390 (type . file)))
2391 ;; (anything 'anything-c-source-files-in-current-dir+)
2393 ;;; Anything-find-files
2396 (defvar anything-c-find-files-doc-header (format " (`%s':Go to precedent level)"
2397 (if window-system "C-." "C-l"))
2398 "*The doc that is inserted in the Name header of a find-files or dired source.")
2400 (defvar anything-ff-mode-line-string
2401 "\\<anything-find-files-map>\
2402 \\[anything-ff-help]:Help, \
2403 \\[anything-send-bug-report-from-anything]:BugReport, \
2404 \\<anything-map>\
2405 \\[anything-select-action]:Acts, \
2406 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
2407 \\[anything-select-3rd-action]:NthAct"
2409 "String displayed in mode-line in `anything-c-source-find-files'")
2411 (defvar anything-ff-auto-update-flag anything-ff-auto-update-initial-value
2412 "Internal, flag to turn on/off auto-update in `anything-find-files'.
2413 Don't set it directly, use instead `anything-ff-auto-update-initial-value'.")
2415 (defvar anything-c-source-find-files
2416 `((name . "Find Files")
2417 (header-name . (lambda (name)
2418 (concat name anything-c-find-files-doc-header)))
2419 ;; It is needed for filenames with capital letters
2420 (disable-shortcuts)
2421 (init . (lambda ()
2422 (setq anything-ff-auto-update-flag anything-ff-auto-update-initial-value)))
2423 (candidates . anything-find-files-get-candidates)
2424 (filtered-candidate-transformer anything-c-find-files-transformer)
2425 (image-action1 . anything-ff-rotate-image-left)
2426 (image-action2 . anything-ff-rotate-image-right)
2427 (properties-action . anything-ff-properties)
2428 (toggle-auto-update . anything-ff-toggle-auto-update)
2429 (kill-buffer-fname . anything-ff-kill-buffer-fname)
2430 (persistent-action . anything-find-files-persistent-action)
2431 (persistent-help . "Hit1 Expand Candidate, Hit2 or (C-u) Find file")
2432 (mode-line . anything-ff-mode-line-string)
2433 (volatile)
2434 (candidate-number-limit . 9999)
2435 (action-transformer . anything-find-files-action-transformer)
2436 (action
2437 . ,(delq
2439 `(("Find File" . anything-c-find-file-or-marked)
2440 ("Find file in Dired" . anything-c-point-file-in-dired)
2441 ,(and (locate-library "elscreen")
2442 '("Find file in Elscreen" . anything-elscreen-find-file))
2443 ,(and (locate-library "popwin")
2444 '("Find file in popup window" . popwin:find-file))
2445 ("Complete at point `M-tab'"
2446 . anything-c-insert-file-name-completion-at-point)
2447 ("Open file externally `C-c C-x, C-u to choose'"
2448 . anything-c-open-file-externally)
2449 ("Grep File(s) `M-g s, C-u Recurse'" . anything-find-files-grep)
2450 ("Zgrep File(s) `M-g z, C-u Recurse'" . anything-ff-zgrep)
2451 ("Switch to Eshell `M-e'" . anything-ff-switch-to-eshell)
2452 ("Etags `M-., C-u tap, C-u C-u reload tag file'" . anything-ff-etags-select)
2453 ("Eshell command on file(s) `M-!, C-u run on all marked at once.'"
2454 . anything-find-files-eshell-command-on-file)
2455 ("Find file as root" . anything-find-file-as-root)
2456 ("Find file in hex dump" . hexl-find-file)
2457 ("Ediff File `C-='" . anything-find-files-ediff-files)
2458 ("Ediff Merge File `C-c ='" . anything-find-files-ediff-merge-files)
2459 ("Delete File(s) `M-D'" . anything-delete-marked-files)
2460 ("Copy file(s) `M-C, C-u to follow'" . anything-find-files-copy)
2461 ("Copy file(s) Async" . anything-ff-copy-async)
2462 ("Rename file(s) `M-R, C-u to follow'" . anything-find-files-rename)
2463 ("Serial rename files" . anything-ff-serial-rename)
2464 ("Serial rename by symlinking files" . anything-ff-serial-rename-by-symlink)
2465 ("Serial rename by copying files" . anything-ff-serial-rename-by-copying)
2466 ("Symlink files(s) `M-S, C-u to follow'" . anything-find-files-symlink)
2467 ("Relsymlink file(s) `C-u to follow'" . anything-find-files-relsymlink)
2468 ("Hardlink file(s) `C-u to follow'" . anything-find-files-hardlink)
2469 ("Find file other window `C-o'" . find-file-other-window)
2470 ("Switch to history `M-p'" . anything-find-files-switch-to-hist)
2471 ("Find file other frame `C-c C-o'" . find-file-other-frame)
2472 ("Print File `C-c p'" . anything-ff-print))))))
2473 ;; (anything 'anything-c-source-find-files)
2475 (defun anything-find-files-set-prompt-for-action (prompt files)
2476 "Set prompt for action in `anything-find-files'."
2477 (let ((len (length files)))
2478 (if (> len 1)
2479 (format "%s * %d Files to: " prompt len)
2480 (format "%s %s to: " prompt (car files)))))
2482 (defun anything-find-files-do-action (action)
2483 "Generic function for creating action from `anything-c-source-find-files'.
2484 ACTION must be an action supported by `anything-dired-action'."
2485 (let* ((ifiles (anything-marked-candidates))
2486 (cand (anything-get-selection))
2487 (prompt (anything-find-files-set-prompt-for-action
2488 (capitalize (symbol-name action)) ifiles))
2489 (parg anything-current-prefix-arg)
2490 (dest (anything-c-read-file-name
2491 prompt
2492 :preselect cand
2493 :initial-input (car anything-ff-history)
2494 :history (anything-find-files-history :comp-read nil)))
2495 (win-conf (current-window-configuration)))
2496 (unwind-protect
2497 (let ((default-directory anything-ff-default-directory))
2498 (anything-dired-action
2499 dest :files ifiles :action action :follow parg))
2500 ;; Don't reset win-conf when following.
2501 (unless parg (set-window-configuration win-conf)))))
2503 (defun anything-find-files-copy (candidate)
2504 "Copy files from `anything-find-files'."
2505 (anything-find-files-do-action 'copy))
2507 (defun anything-find-files-rename (candidate)
2508 "Rename files from `anything-find-files'."
2509 (anything-find-files-do-action 'rename))
2511 (defun anything-find-files-symlink (candidate)
2512 "Symlink files from `anything-find-files'."
2513 (anything-find-files-do-action 'symlink))
2515 (defun anything-find-files-relsymlink (candidate)
2516 "Relsymlink files from `anything-find-files'."
2517 (anything-find-files-do-action 'relsymlink))
2519 (defun anything-find-files-hardlink (candidate)
2520 "Hardlink files from `anything-find-files'."
2521 (anything-find-files-do-action 'hardlink))
2523 (defun anything-find-files-byte-compile (candidate)
2524 "Byte compile elisp files from `anything-find-files'."
2525 (let ((files (anything-marked-candidates))
2526 (parg anything-current-prefix-arg))
2527 (loop for fname in files
2528 do (byte-compile-file fname parg))))
2530 (defun anything-find-files-load-files (candidate)
2531 "Load elisp files from `anything-find-files'."
2532 (let ((files (anything-marked-candidates)))
2533 (loop for fname in files
2534 do (load fname))))
2536 (defun anything-find-files-ediff-files (candidate)
2537 "Default action to ediff files in `anything-find-files'."
2538 (ediff-files
2539 candidate
2540 (anything-c-read-file-name
2541 (format "Ediff `%s' With File: " (file-name-nondirectory candidate)))))
2543 (defun anything-find-files-ediff-merge-files (candidate)
2544 "Default action to ediff merge files in `anything-find-files'."
2545 (ediff-merge-files
2546 candidate
2547 (anything-c-read-file-name
2548 (format "Ediff Merge `%s' With File: "
2549 (file-name-nondirectory candidate)))))
2551 (defun anything-find-files-grep (candidate)
2552 "Default action to grep files from `anything-find-files'."
2553 (anything-do-grep-1 (anything-marked-candidates)
2554 anything-current-prefix-arg))
2556 (defun anything-ff-zgrep (candidate)
2557 "Default action to zgrep files from `anything-find-files'."
2558 (let ((prefarg anything-current-prefix-arg)
2559 (ls (anything-marked-candidates)))
2560 (anything-ff-zgrep-1 ls prefarg)))
2562 (defun anything-ff-pdfgrep (candidate)
2563 "Default action to pdfgrep files from `anything-find-files'."
2564 (let ((cands (loop for file in (anything-marked-candidates)
2565 if (or (string= (file-name-extension file) "pdf")
2566 (string= (file-name-extension file) "PDF"))
2567 collect file))
2568 (anything-c-pdfgrep-default-function 'anything-c-pdfgrep-init))
2569 (when cands
2570 (anything-do-pdfgrep-1 cands))))
2572 (defun anything-ff-etags-select (candidate)
2573 "Default action to jump to etags from `anything-find-files'."
2574 (when (get-buffer anything-action-buffer)
2575 (kill-buffer anything-action-buffer))
2576 (let ((default-directory anything-ff-default-directory))
2577 (anything-c-etags-select anything-current-prefix-arg)))
2579 (defun anything-find-files-switch-to-hist (candidate)
2580 "Switch to anything-find-files history."
2581 (anything-find-files t))
2583 ;;; Asynchronous copy of files.
2586 (defvar anything-c-copy-files-async-log-file "/tmp/dired.log")
2587 (defun anything-c-copy-files-async-1 (flist dest)
2588 "Copy a list of Files FLIST to DEST asynchronously.
2589 It use another emacs process to do the job.
2590 Communication with background emacs is done with temp file
2591 `anything-c-copy-files-async-log-file'."
2592 (start-file-process "emacs-batch" nil anything-c-copy-async-prefered-emacs
2593 "-Q" "--batch" "--eval"
2594 (format "(progn
2595 (require 'dired) (require 'cl)
2596 (let ((dired-recursive-copies 'always)
2597 failures success
2598 (ovw-count 0)
2599 (cpf-count 0))
2600 (dolist (f '%S)
2601 (condition-case err
2602 (let ((file-exists (file-exists-p
2603 (expand-file-name
2604 (file-name-nondirectory (directory-file-name f))
2605 (file-name-directory
2606 (file-name-as-directory \"%s\"))))))
2607 (dired-copy-file f \"%s\" t)
2608 (if file-exists
2609 (progn (push (cons \"Overwriting\" f) success)
2610 (incf ovw-count))
2611 (push (cons \"Copying\" f) success)
2612 (incf cpf-count)))
2613 (file-error
2614 (push (dired-make-relative
2615 (expand-file-name
2616 (file-name-nondirectory (directory-file-name f))
2617 (file-name-directory \"%s\")))
2618 failures))))
2619 (with-current-buffer (find-file-noselect \"%s\")
2620 (erase-buffer)
2621 (when failures
2622 (dolist (fail (reverse failures))
2623 (insert (concat \"Failed to copy \" fail \"\n\"))))
2624 (when success
2625 (loop for (a . s) in (reverse success) do
2626 (insert (concat a \" \" s \" to %s done\n\"))))
2627 (and (/= cpf-count 0) (insert (concat (int-to-string cpf-count) \" File(s) Copied\n\")))
2628 (and (/= ovw-count 0) (insert (concat (int-to-string ovw-count) \" File(s) Overwrited\n\")))
2629 (and failures (insert (concat (int-to-string (length failures)) \" File(s) Failed to copy\n\")))
2630 (save-buffer))))"
2631 flist dest dest dest anything-c-copy-files-async-log-file dest)))
2633 (defun anything-c-copy-async-with-log (flist dest)
2634 "Copy file list FLIST to DEST showing log.
2635 Log is send to `anything-c-copy-files-async-log-file'.
2636 Copying is done asynchronously with `anything-c-copy-files-async-1'."
2637 (declare (special auto-revert-interval))
2638 (pop-to-buffer (find-file-noselect anything-c-copy-files-async-log-file))
2639 (set (make-local-variable 'auto-revert-interval) 1)
2640 (erase-buffer)
2641 (insert "Wait copying files...\n")
2642 (sit-for 0.5) (save-buffer)
2643 (goto-char (point-max))
2644 (auto-revert-mode 1)
2645 (anything-c-copy-files-async-1 flist dest))
2647 (defun anything-ff-copy-async (candidate)
2648 "Anything find files action to copy files async.
2649 Copying is done asynchronously with `anything-c-copy-files-async-1'."
2650 (let ((flist (anything-marked-candidates))
2651 (dest (anything-c-read-file-name
2652 "Copy File(s) async To: "
2653 :preselect candidate
2654 :initial-input (car anything-ff-history)
2655 :history (anything-find-files-history :comp-read nil))))
2656 (anything-c-copy-async-with-log flist dest)))
2658 (defun anything-c-copy-files-async ()
2659 "Preconfigured anything to copy file list FLIST to DEST asynchronously."
2660 (interactive)
2661 (let* ((flist (anything-c-read-file-name
2662 "Copy File async: "
2663 :marked-candidates t))
2664 (dest (anything-c-read-file-name
2665 "Copy File async To: "
2666 :preselect (car flist)
2667 :initial-input (car anything-ff-history)
2668 :history (anything-find-files-history :comp-read nil))))
2669 (anything-c-copy-async-with-log flist dest)))
2671 (defvar eshell-command-aliases-list nil)
2672 (declare-function eshell-read-aliases-list "em-alias")
2673 (defun anything-find-files-eshell-command-on-file-1 (candidate &optional map)
2674 "Run `eshell-command' on CANDIDATE or marked candidates possibly with an eshell alias.
2676 Basename of CANDIDATE can be a wild-card.
2677 If MAP is given run `eshell-command' on all marked files at once,
2678 Otherwise, run `eshell-command' on each marked files.
2680 If `eshell' or `eshell-command' have not been run once, or if you have no eshell aliases
2681 `eshell-command-aliases-list' will not be loaded first time you use this."
2682 (when (or eshell-command-aliases-list
2683 (y-or-n-p "Eshell is not loaded, run eshell-command without alias anyway? "))
2684 (and eshell-command-aliases-list (eshell-read-aliases-list))
2685 (let* ((cand-list (anything-marked-candidates))
2686 (default-directory (or anything-ff-default-directory
2687 ;; If candidate is an url *-ff-default-directory is nil
2688 ;; so keep value of default-directory.
2689 default-directory))
2690 (command (anything-comp-read
2691 "Command: "
2692 (loop for (a . c) in eshell-command-aliases-list
2693 when (string-match "\\(\\$1\\|\\$\\*\\)$" (car c))
2694 collect (propertize a 'help-echo (car c)) into ls
2695 finally return (sort ls 'string<))))
2696 (com-value (car (assoc-default command eshell-command-aliases-list))))
2697 (if (and (or map (and com-value (string-match "\\$\\*$" com-value)))
2698 (> (length cand-list) 1))
2699 ;; Run eshell-command with ALL marked files as arguments.
2700 (let ((mapfiles (mapconcat 'shell-quote-argument cand-list " ")))
2701 (eshell-command (format "%s %s" command mapfiles)))
2702 ;; Run eshell-command on EACH marked files.
2703 (loop
2704 for i in cand-list
2705 for bn = (anything-c-basename i)
2706 for files = (if (and bn (string-match "^\*" bn))
2707 ;; Assume if fname is a wildcard
2708 ;; cand-list have a length of 1.
2709 (mapconcat
2710 'shell-quote-argument
2711 (file-expand-wildcards i t) " ")
2712 (format "'%s'" i))
2713 for com = (if (string-match "'%s'\\|\"%s\"\\|%s" command)
2714 ;; This allow to enter other args AFTER filename
2715 ;; i.e <command %s some_more_args>
2716 (format command files)
2717 (format "%s %s" command files))
2718 do (eshell-command com))))))
2720 (defun anything-find-files-eshell-command-on-file (candidate)
2721 "Run `eshell-command' on CANDIDATE or marked candidates.
2722 See `anything-find-files-eshell-command-on-file-1' for more info."
2723 (anything-find-files-eshell-command-on-file-1
2724 candidate anything-current-prefix-arg))
2726 (declare-function eshell-send-input "esh-mode" (&optional use-region queue-p no-newline))
2727 (defun anything-ff-switch-to-eshell (candidate)
2728 "Switch to eshell and cd to `anything-ff-default-directory'."
2729 (flet ((cd-eshell ()
2730 (goto-char (point-max))
2731 (insert
2732 (format "cd '%s'" anything-ff-default-directory))
2733 (eshell-send-input)))
2734 (if (get-buffer "*eshell*")
2735 (progn
2736 (anything-c-switch-to-buffer "*eshell*")
2737 (cd-eshell))
2738 (call-interactively 'eshell)
2739 (cd-eshell))))
2741 (defun anything-ff-serial-rename-action (method)
2742 "Rename all marked files to `anything-ff-default-directory' with METHOD.
2743 See `anything-ff-serial-rename-1'."
2744 (let ((cands (anything-marked-candidates))
2745 (name (read-string "NewName: "))
2746 (start (read-number "StartAtNumber: "))
2747 (dir (expand-file-name
2748 (anything-c-read-file-name
2749 "Serial Rename to directory: " :initial-input
2750 (expand-file-name anything-ff-default-directory)))))
2751 (when (y-or-n-p (format "Serial Rename %s *files to `%s' with prefix `%s'? "
2752 (length cands) dir name))
2753 (anything-ff-serial-rename-1 dir cands name start :method method)
2754 (anything-find-files-1 dir))))
2756 (defun anything-ff-member-directory-p (file directory)
2757 (let ((dir-file (expand-file-name (file-name-as-directory (file-name-directory file))))
2758 (cur-dir (expand-file-name (file-name-as-directory directory))))
2759 (string= dir-file cur-dir)))
2761 (defun* anything-ff-serial-rename-1
2762 (directory collection new-name start-at-num &key (method 'rename))
2763 "rename files in COLLECTION to DIRECTORY with the prefix name NEW-NAME.
2764 Rename start at number START-AT-NUM - ex: prefixname-01.jpg.
2765 METHOD can be one of rename, copy or symlink.
2766 Files will be renamed if they are files of current directory, otherwise they
2767 will be treated with METHOD.
2768 Default METHOD is rename."
2769 ;; Maybe remove directories selected by error in collection.
2770 (setq collection (remove-if 'file-directory-p collection))
2771 (flet ((symlink-file (file dest)
2772 (let ((flist (list file)))
2773 (anything-dired-action
2774 dest :action 'symlink :files flist))))
2776 (let* ((tmp-dir (file-name-as-directory
2777 (concat (file-name-as-directory directory)
2778 (symbol-name (gensym "tmp")))))
2779 (fn (case method
2780 (copy 'copy-file)
2781 (symlink 'symlink-file)
2782 (rename 'rename-file)
2783 (t (error "Error: Unknow method %s" method)))))
2784 (make-directory tmp-dir)
2785 (loop for i in collection
2786 for count from start-at-num
2787 for fnum = (if (< count 10) "0%s" "%s")
2788 for nname = (concat tmp-dir new-name (format fnum count)
2789 (file-name-extension i 'dot))
2790 do (if (anything-ff-member-directory-p i directory)
2791 (rename-file i nname)
2792 (funcall fn i nname)))
2793 (loop with dirlist = (directory-files
2794 tmp-dir t directory-files-no-dot-files-regexp)
2795 for f in dirlist do
2796 (if (file-symlink-p f)
2797 (symlink-file (file-truename f)
2798 (concat (file-name-as-directory directory)
2799 (anything-c-basename f)))
2800 (rename-file f directory)))
2801 (delete-directory tmp-dir t))))
2803 (defun anything-ff-serial-rename (candidate)
2804 "Serial rename all marked files to `anything-ff-default-directory'.
2805 Rename only file of current directory, and symlink files coming from
2806 other directories.
2807 See `anything-ff-serial-rename-1'."
2808 (anything-ff-serial-rename-action 'rename))
2810 (defun anything-ff-serial-rename-by-symlink (candidate)
2811 "Serial rename all marked files to `anything-ff-default-directory'.
2812 Rename only file of current directory, and symlink files coming from
2813 other directories.
2814 See `anything-ff-serial-rename-1'."
2815 (anything-ff-serial-rename-action 'symlink))
2817 (defun anything-ff-serial-rename-by-copying (candidate)
2818 "Serial rename all marked files to `anything-ff-default-directory'.
2819 Rename only file of current directory, and copy files coming from
2820 other directories.
2821 See `anything-ff-serial-rename-1'."
2822 (anything-ff-serial-rename-action 'copy))
2824 (defun anything-ff-help ()
2825 "Help command for `anything-find-files'."
2826 (interactive)
2827 (let ((anything-help-message "== Anything Find Files ==
2828 \nTips:
2829 \nEnter \"~/\" at anytime to reach home directory.
2830 Enter \"/\" at anytime to reach root of your file system.
2831 You can complete with partial basename \(e.g \"fb\" will complete \"foobar\"\).
2832 \nSpecific commands for `anything-find-files':
2833 \\<anything-find-files-map>
2834 \\[anything-ff-run-grep]\t\t->Run Grep (C-u Recursive).
2835 \\[anything-ff-run-pdfgrep]\t\t->Run Pdfgrep on marked files.
2836 \\[anything-ff-run-zgrep]\t\t->Run zgrep (C-u Recursive).
2837 \\[anything-ff-run-etags]\t\t->Run Etags (C-u use thing-at-point `C-u C-u' reload cache)
2838 \\[anything-ff-run-rename-file]\t\t->Rename File (C-u Follow).
2839 \\[anything-ff-run-copy-file]\t\t->Copy File (C-u Follow).
2840 \\[anything-ff-run-byte-compile-file]\t\t->Byte Compile File (C-u Load).
2841 \\[anything-ff-run-load-file]\t\t->Load File.
2842 \\[anything-ff-run-symlink-file]\t\t->Symlink File.
2843 \\[anything-ff-run-delete-file]\t\t->Delete File.
2844 \\[anything-ff-run-kill-buffer-persistent]\t\t->Kill buffer candidate without quitting.
2845 \\[anything-ff-run-switch-to-eshell]\t\t->Switch to Eshell.
2846 \\[anything-ff-run-eshell-command-on-file]\t\t->Eshell command on file (C-u Run on all marked files at once).
2847 \\[anything-ff-run-ediff-file]\t\t->Ediff file.
2848 \\[anything-ff-run-ediff-merge-file]\t\t->Ediff merge file.
2849 \\[anything-ff-run-complete-fn-at-point]\t\t->Complete file name at point.
2850 \\[anything-ff-run-switch-other-window]\t\t->Switch other window.
2851 \\[anything-ff-run-switch-other-frame]\t\t->Switch other frame.
2852 \\[anything-ff-run-open-file-externally]\t\t->Open file with external program (C-u to choose).
2853 \\[anything-ff-rotate-left-persistent]\t\t->Rotate Image Left.
2854 \\[anything-ff-rotate-right-persistent]\t\t->Rotate Image Right.
2855 \\[anything-find-files-down-one-level]\t\t->Go down precedent directory.
2856 \\[anything-ff-run-switch-to-history]\t\t->Switch to anything find-files history.
2857 \\[anything-ff-properties-persistent]\t\t->Show file properties in a tooltip.
2858 \\[anything-mark-all]\t\t->Mark all visibles candidates.
2859 \\[anything-ff-run-toggle-auto-update]\t->Toggle auto expansion of directories.
2860 \\[anything-unmark-all]\t\t->Unmark all candidates, visibles and invisibles.
2861 \\[anything-ff-run-gnus-attach-files]\t\t->Gnus attach files to message buffer.
2862 \\[anything-ff-run-print-file]\t\t->Print file with default printer.
2863 \\[anything-send-bug-report-from-anything]\t\t->Send Bug report.
2864 \\[anything-ff-help]\t\t->Display this help info.
2865 \n== Anything Map ==
2866 \\{anything-map}
2868 (anything-help)))
2870 (defvar anything-find-files-map
2871 (let ((map (copy-keymap anything-map)))
2872 (define-key map (kbd "M-g s") 'anything-ff-run-grep)
2873 (define-key map (kbd "M-g p") 'anything-ff-run-pdfgrep)
2874 (define-key map (kbd "M-g z") 'anything-ff-run-zgrep)
2875 (define-key map (kbd "M-.") 'anything-ff-run-etags)
2876 (define-key map (kbd "M-R") 'anything-ff-run-rename-file)
2877 (define-key map (kbd "M-C") 'anything-ff-run-copy-file)
2878 (define-key map (kbd "M-B") 'anything-ff-run-byte-compile-file)
2879 (define-key map (kbd "M-L") 'anything-ff-run-load-file)
2880 (define-key map (kbd "M-S") 'anything-ff-run-symlink-file)
2881 (define-key map (kbd "M-D") 'anything-ff-run-delete-file)
2882 (define-key map (kbd "M-K") 'anything-ff-run-kill-buffer-persistent)
2883 (define-key map (kbd "M-e") 'anything-ff-run-switch-to-eshell)
2884 (define-key map (kbd "<M-tab>") 'anything-ff-run-complete-fn-at-point)
2885 (define-key map (kbd "C-o") 'anything-ff-run-switch-other-window)
2886 (define-key map (kbd "C-c C-o") 'anything-ff-run-switch-other-frame)
2887 (define-key map (kbd "C-c C-x") 'anything-ff-run-open-file-externally)
2888 (define-key map (kbd "M-!") 'anything-ff-run-eshell-command-on-file)
2889 (define-key map (kbd "C-=") 'anything-ff-run-ediff-file)
2890 (define-key map (kbd "C-c =") 'anything-ff-run-ediff-merge-file)
2891 (define-key map (kbd "M-p") 'anything-ff-run-switch-to-history)
2892 (define-key map (kbd "M-i") 'anything-ff-properties-persistent)
2893 (define-key map (kbd "C-c ?") 'anything-ff-help)
2894 (define-key map (kbd "C-<backspace>") 'anything-ff-run-toggle-auto-update)
2895 (define-key map (kbd "M-a") 'anything-mark-all)
2896 (define-key map (kbd "M-u") 'anything-unmark-all)
2897 (define-key map (kbd "C-c C-a") 'anything-ff-run-gnus-attach-files)
2898 (define-key map (kbd "C-c p") 'anything-ff-run-print-file)
2899 ;; Next 2 have no effect if candidate is not an image file.
2900 (define-key map (kbd "M-l") 'anything-ff-rotate-left-persistent)
2901 (define-key map (kbd "M-r") 'anything-ff-rotate-right-persistent)
2902 (define-key map (kbd "C-.") 'anything-find-files-down-one-level)
2903 (define-key map (kbd "C-l") 'anything-find-files-down-one-level)
2904 (define-key map (kbd "C-h C-b") 'anything-send-bug-report-from-anything)
2905 (define-key map (kbd "C-h C-d") 'anything-debug-output)
2906 (when anything-ff-lynx-style-map
2907 (define-key map (kbd "<left>") 'anything-find-files-down-one-level)
2908 (define-key map (kbd "<right>") 'anything-execute-persistent-action))
2909 (delq nil map))
2910 "Keymap for `anything-find-files'.")
2912 (defun anything-c-quit-and-execute-action (action)
2913 "Quit current anything session and execute ACTION."
2914 (setq anything-saved-action action)
2915 (anything-exit-minibuffer))
2917 (defun anything-ff-toggle-auto-update (candidate)
2918 (setq anything-ff-auto-update-flag (not anything-ff-auto-update-flag))
2919 (message "[Auto expansion %s]"
2920 (if anything-ff-auto-update-flag "enabled" "disabled")))
2922 ;;;###autoload
2923 (defun anything-ff-run-toggle-auto-update ()
2924 (interactive)
2925 (anything-execute-persistent-action 'toggle-auto-update))
2927 ;;;###autoload
2928 (defun anything-ff-run-switch-to-history ()
2929 "Run Switch to history action from `anything-c-source-find-files'."
2930 (interactive)
2931 (anything-c-quit-and-execute-action 'anything-find-files-switch-to-hist))
2933 ;;;###autoload
2934 (defun anything-ff-run-grep ()
2935 "Run Grep action from `anything-c-source-find-files'."
2936 (interactive)
2937 (anything-c-quit-and-execute-action 'anything-find-files-grep))
2939 ;;;###autoload
2940 (defun anything-ff-run-pdfgrep ()
2941 "Run Pdfgrep action from `anything-c-source-find-files'."
2942 (interactive)
2943 (anything-c-quit-and-execute-action 'anything-ff-pdfgrep))
2945 ;;;###autoload
2946 (defun anything-ff-run-zgrep ()
2947 "Run Grep action from `anything-c-source-find-files'."
2948 (interactive)
2949 (anything-c-quit-and-execute-action 'anything-ff-zgrep))
2951 ;;;###autoload
2952 (defun anything-ff-run-copy-file ()
2953 "Run Copy file action from `anything-c-source-find-files'."
2954 (interactive)
2955 (anything-c-quit-and-execute-action 'anything-find-files-copy))
2957 ;;;###autoload
2958 (defun anything-ff-run-rename-file ()
2959 "Run Rename file action from `anything-c-source-find-files'."
2960 (interactive)
2961 (anything-c-quit-and-execute-action 'anything-find-files-rename))
2963 ;;;###autoload
2964 (defun anything-ff-run-byte-compile-file ()
2965 "Run Byte compile file action from `anything-c-source-find-files'."
2966 (interactive)
2967 (anything-c-quit-and-execute-action 'anything-find-files-byte-compile))
2969 ;;;###autoload
2970 (defun anything-ff-run-load-file ()
2971 "Run Load file action from `anything-c-source-find-files'."
2972 (interactive)
2973 (anything-c-quit-and-execute-action 'anything-find-files-load-files))
2975 ;;;###autoload
2976 (defun anything-ff-run-eshell-command-on-file ()
2977 "Run eshell command on file action from `anything-c-source-find-files'."
2978 (interactive)
2979 (anything-c-quit-and-execute-action 'anything-find-files-eshell-command-on-file))
2981 ;;;###autoload
2982 (defun anything-ff-run-ediff-file ()
2983 "Run Ediff file action from `anything-c-source-find-files'."
2984 (interactive)
2985 (anything-c-quit-and-execute-action 'anything-find-files-ediff-files))
2987 ;;;###autoload
2988 (defun anything-ff-run-ediff-merge-file ()
2989 "Run Ediff merge file action from `anything-c-source-find-files'."
2990 (interactive)
2991 (anything-c-quit-and-execute-action 'anything-find-files-ediff-merge-files))
2993 ;;;###autoload
2994 (defun anything-ff-run-symlink-file ()
2995 "Run Symlink file action from `anything-c-source-find-files'."
2996 (interactive)
2997 (anything-c-quit-and-execute-action 'anything-find-files-symlink))
2999 ;;;###autoload
3000 (defun anything-ff-run-delete-file ()
3001 "Run Delete file action from `anything-c-source-find-files'."
3002 (interactive)
3003 (anything-c-quit-and-execute-action 'anything-delete-marked-files))
3005 ;;;###autoload
3006 (defun anything-ff-run-complete-fn-at-point ()
3007 "Run complete file name action from `anything-c-source-find-files'."
3008 (interactive)
3009 (anything-c-quit-and-execute-action
3010 'anything-c-insert-file-name-completion-at-point))
3012 ;;;###autoload
3013 (defun anything-ff-run-switch-to-eshell ()
3014 "Run switch to eshell action from `anything-c-source-find-files'."
3015 (interactive)
3016 (anything-c-quit-and-execute-action 'anything-ff-switch-to-eshell))
3018 ;;;###autoload
3019 (defun anything-ff-run-switch-other-window ()
3020 "Run switch to other window action from `anything-c-source-find-files'."
3021 (interactive)
3022 (anything-c-quit-and-execute-action 'find-file-other-window))
3024 ;;;###autoload
3025 (defun anything-ff-run-switch-other-frame ()
3026 "Run switch to other frame action from `anything-c-source-find-files'."
3027 (interactive)
3028 (anything-c-quit-and-execute-action 'find-file-other-frame))
3030 ;;;###autoload
3031 (defun anything-ff-run-open-file-externally ()
3032 "Run open file externally command action from `anything-c-source-find-files'."
3033 (interactive)
3034 (anything-c-quit-and-execute-action 'anything-c-open-file-externally))
3036 ;;;###autoload
3037 (defun anything-ff-run-gnus-attach-files ()
3038 "Run gnus attach files command action from `anything-c-source-find-files'."
3039 (interactive)
3040 (anything-c-quit-and-execute-action 'anything-ff-gnus-attach-files))
3042 ;;;###autoload
3043 (defun anything-ff-run-etags ()
3044 "Run Etags command action from `anything-c-source-find-files'."
3045 (interactive)
3046 (anything-c-quit-and-execute-action 'anything-ff-etags-select))
3048 (defun anything-ff-print (candidate)
3049 "Print marked files.
3050 Uses the shell command coming from variables `lpr-command' and
3051 `lpr-switches' as default.
3052 Same as `dired-do-print' but for anything."
3053 (let* ((file-list (anything-marked-candidates))
3054 (command (read-string
3055 "Print %s with: "
3056 (mapconcat 'identity
3057 (cons lpr-command
3058 (if (stringp lpr-switches)
3059 (list lpr-switches)
3060 lpr-switches))
3061 " ")))
3062 (file-args (mapconcat #'(lambda (x)
3063 (format "'%s'" x))
3064 file-list " "))
3065 (cmd-line (concat command " " file-args)))
3066 (start-process-shell-command "anything-print" nil cmd-line)))
3068 ;;;###autoload
3069 (defun anything-ff-run-print-file ()
3070 "Run Print file action from `anything-c-source-find-files'."
3071 (interactive)
3072 (anything-c-quit-and-execute-action 'anything-ff-print))
3074 (defun* anything-reduce-file-name (fname level &key unix-close expand)
3075 "Reduce FNAME by LEVEL from end or beginning depending LEVEL value.
3076 If LEVEL is positive reduce from end else from beginning.
3077 If UNIX-CLOSE is non--nil close filename with /.
3078 If EXPAND is non--nil expand-file-name."
3079 (let* ((exp-fname (expand-file-name fname))
3080 (fname-list (split-string (if (or (string= fname "~/") expand)
3081 exp-fname fname) "/" t))
3082 (len (length fname-list))
3083 (pop-list (if (< level 0)
3084 (subseq fname-list (* level -1))
3085 (subseq fname-list 0 (- len level))))
3086 (result (mapconcat 'identity pop-list "/"))
3087 (empty (string= result "")))
3088 (when unix-close (setq result (concat result "/")))
3089 (if (string-match "^~" result)
3090 (if (string= result "~/") "~/" result)
3091 (if (< level 0)
3092 (if empty "../" (concat "../" result))
3093 (cond ((eq system-type 'windows-nt)
3094 (if empty "c:/" result))
3095 (empty "/")
3097 (concat "/" result)))))))
3099 (defun anything-file-completion-source-p ()
3100 "Test if current source is a dired or find-files source."
3101 (let ((ff-sources '("Find Files" "Copy Files"
3102 "Read File Name History"
3103 "Rename Files" "Symlink Files"
3104 "Hardlink Files" "Write File"
3105 "Insert File" "Read file name"))
3106 (cur-source (cdr (assoc 'name (anything-get-current-source)))))
3107 (loop for i in ff-sources thereis (string= cur-source i))))
3109 ;; Internal.
3110 (defvar anything-ff-last-expanded nil
3111 "Store last expanded directory or file in `anything-find-files'.")
3113 (defun anything-find-files-down-one-level (arg)
3114 "Go down one level like unix command `cd ..'.
3115 If prefix numeric arg is given go ARG level down."
3116 (interactive "p")
3117 (with-anything-window
3118 (setq anything-follow-mode nil))
3119 ;; When going to precedent level we want to be at the line
3120 ;; corresponding to actual directory, so store this info
3121 ;; in `anything-ff-last-expanded'.
3122 (if (and (not (file-directory-p anything-pattern))
3123 (file-exists-p anything-pattern))
3124 (setq anything-ff-last-expanded anything-pattern)
3125 (setq anything-ff-last-expanded anything-ff-default-directory))
3126 (when (anything-file-completion-source-p)
3127 (let ((new-pattern (anything-reduce-file-name anything-pattern arg
3128 :unix-close t :expand t)))
3129 (with-selected-window (minibuffer-window)
3130 (delete-minibuffer-contents)
3131 (insert new-pattern)))))
3133 (defun anything-ff-retrieve-last-expanded ()
3134 "Move overlay to last visited directory `anything-ff-last-expanded'.
3135 This happen after using `anything-find-files-down-one-level',
3136 or hitting C-z on \"..\"."
3137 (when (and anything-ff-last-expanded
3138 (anything-file-completion-source-p))
3139 (let ((dirname (directory-file-name anything-ff-last-expanded)))
3140 (with-anything-window
3141 (when (or (re-search-forward (concat dirname "$") nil t)
3142 (re-search-forward
3143 (concat anything-ff-last-expanded "$") nil t))
3144 (forward-line 0)
3145 (anything-mark-current-line)))
3146 (setq anything-ff-last-expanded nil))))
3147 (add-hook 'anything-after-update-hook 'anything-ff-retrieve-last-expanded)
3149 ;; Auto-update: anything-find-files auto expansion of directories.
3150 ;; Internal
3151 (defun anything-ff-update-when-only-one-matched ()
3152 "Expand to directory when sole completion.
3153 When only one cndidate is remaining and it is a directory,
3154 expand to this directory."
3155 (let ((history-p (string= (assoc-default
3156 'name (anything-get-current-source))
3157 "Read File Name History"))
3158 (completed-p (string= (file-name-as-directory anything-pattern)
3159 anything-ff-default-directory)))
3160 (when (and anything-ff-auto-update-flag
3161 (or (and (anything-file-completion-source-p)
3162 (<= (anything-approximate-candidate-number) 2)
3163 (>= (length (anything-c-basename anything-pattern)) 2))
3164 completed-p)
3165 (not history-p))
3166 (with-anything-window
3167 (and (not completed-p) (anything-next-line))
3168 (let ((cur-cand (anything-get-selection)))
3169 (when (file-directory-p cur-cand)
3170 (if (not (string-match "^.*[.]\\{1,2\\}$" cur-cand))
3171 ;; If after going to next line the candidate is not "." or ".."
3172 ;; we assume candidate is a new directory to expand, so do it.
3173 (anything-set-pattern (file-name-as-directory cur-cand))
3174 ;; The candidate is one of "." or ".." (it should be "..").
3175 ;; that mean we have entered the last letter of the directory name
3176 ;; in prompt, so expansion is already done, just add the "/" at end
3177 ;; of name.
3178 (anything-set-pattern (file-name-as-directory anything-pattern)))
3179 (anything-check-minibuffer-input-1)))))))
3180 (add-hook 'anything-after-update-hook 'anything-ff-update-when-only-one-matched)
3182 ;; Allow expanding to home directory or root
3183 ;; when entering respectively "~/" or "//" at end of pattern.
3184 ;; e.g /home/thierry/labo/anything-config-qp/~/
3185 ;; will expand to "~/"
3186 ;; and /home/thierry/labo/anything-config-qp//
3187 ;; will expand to "/"
3188 (defun anything-ff-auto-expand-to-home-or-root ()
3189 (when (and (anything-file-completion-source-p)
3190 (string-match ".*\\(/~/\\|/\\{2\\}\\)$" anything-pattern))
3191 (let ((match (match-string 1 anything-pattern)))
3192 (cond ((string= match "//")
3193 (if (eq system-type 'windows-nt)
3194 (setq anything-pattern "c:/")
3195 (setq anything-pattern "/")))
3196 ((string= match "/~/")
3197 (if (eq system-type 'windows-nt)
3198 (setq anything-pattern (replace-regexp-in-string
3199 "\\\\" "/" (getenv "HOME")))
3200 (setq anything-pattern "~/")))))
3201 (setq anything-ff-default-directory anything-pattern)
3202 (with-current-buffer (window-buffer (minibuffer-window))
3203 (delete-minibuffer-contents)
3204 (insert anything-pattern))))
3205 (add-hook 'anything-after-update-hook 'anything-ff-auto-expand-to-home-or-root)
3207 (defun anything-c-point-file-in-dired (file)
3208 "Put point on filename FILE in dired buffer."
3209 (dired (file-name-directory file))
3210 (dired-goto-file file))
3212 (defun anything-create-tramp-name (fname)
3213 "Build filename for `anything-pattern' like /su:: or /sudo::."
3214 (apply #'tramp-make-tramp-file-name
3215 (loop with v = (tramp-dissect-file-name fname)
3216 for i across v collect i)))
3218 (defun anything-ff-set-pattern (pattern)
3219 "Handle tramp filenames in `anything-pattern'."
3220 (let ((methods (mapcar 'car tramp-methods))
3221 (reg "\\`/\\([^[/:]+\\|[^/]+]\\):.*:")
3222 cur-method tramp-name)
3223 (cond ((string= pattern "") "")
3224 ((string-match ".*\\(~//\\|//\\)$" pattern)
3225 (if (eq system-type 'windows-nt) "c:/" "/"))
3226 ((string-match "^~\\|.*/~/$" pattern)
3227 (let* ((home (getenv "HOME"))
3228 (replace (if (eq system-type 'windows-nt)
3229 (replace-regexp-in-string
3230 "\\\\" "/" home)
3231 home)))
3232 (replace-match replace nil t pattern)))
3233 ;; Match "/method:maybe_hostname:"
3234 ((and (string-match reg pattern)
3235 (setq cur-method (match-string 1 pattern))
3236 (member cur-method methods))
3237 (setq tramp-name (anything-create-tramp-name
3238 (match-string 0 pattern)))
3239 (replace-match tramp-name nil t pattern))
3240 ;; Match "/hostname:"
3241 ((and (string-match tramp-file-name-regexp pattern)
3242 (setq cur-method (match-string 1 pattern))
3243 (and cur-method (not (member cur-method methods))))
3244 (setq tramp-name (anything-create-tramp-name
3245 (match-string 0 pattern)))
3246 (replace-match tramp-name nil t pattern))
3247 ;; Match "/method:" in this case don't try to connect.
3248 ((and (not (string-match reg pattern))
3249 (string-match tramp-file-name-regexp pattern)
3250 (member (match-string 1 pattern) methods))
3251 "Invalid tramp file name") ; Write in anything-buffer.
3252 ;; PATTERN is a directory, end it with "/".
3253 ;; This will make PATTERN not ending yet with "/"
3254 ;; candidate for `anything-ff-default-directory',
3255 ;; allowing `anything-ff-retrieve-last-expanded' to retrieve it
3256 ;; when descending level.
3257 ((file-directory-p pattern)
3258 (file-name-as-directory pattern))
3259 ;; Return PATTERN unchanged.
3260 (t pattern))))
3262 ;; Internal.
3263 (defvar anything-ff-default-directory nil)
3264 (defvar anything-ff-history nil)
3266 (defun anything-find-files-get-candidates ()
3267 "Create candidate list for `anything-c-source-find-files'."
3268 (let* ((path (anything-ff-set-pattern anything-pattern))
3269 (path-name-dir (file-name-directory path))
3270 (tramp-verbose anything-tramp-verbose)) ; No tramp message when 0.
3271 (set-text-properties 0 (length path) nil path)
3272 (setq anything-pattern (anything-ff-transform-fname-for-completion path))
3273 (setq anything-ff-default-directory
3274 (if (string= anything-pattern "")
3275 (if (eq system-type 'windows-nt) "c:/" "/")
3276 (unless (string-match ffap-url-regexp path)
3277 path-name-dir)))
3278 (cond ((or (string= path "Invalid tramp file name")
3279 (file-regular-p path)
3280 (and (not (file-exists-p path)) (string-match "/$" path))
3281 (and ffap-url-regexp (string-match ffap-url-regexp path)))
3282 (list path))
3283 ((string= path "") (directory-files "/" t))
3284 ((and (file-directory-p path) (not (file-readable-p path)))
3285 (list (format "Opening directory: access denied, `%s'" path)))
3286 ((file-directory-p path) (directory-files path t))
3288 (append
3289 (list path)
3290 (directory-files (file-name-directory path) t))))))
3292 (defun anything-ff-transform-fname-for-completion (fname)
3293 "Return FNAME with it's basename modified as a regexp.
3294 e.g foo => f.*o.*o .
3295 If basename contain one or more space or FNAME is a valid directory name
3296 return FNAME unchanged."
3297 (let ((bn (anything-c-basename fname)))
3298 (if (or (not anything-ff-smart-completion)
3299 (string-match "\\s-" bn)
3300 (string-match "/$" fname) ; Allow mkdir.
3301 (file-directory-p fname))
3302 fname ; Fall back to match-plugin.
3303 (setq bn (if (> (length bn) 2) ; Normal completion on first 2 char.
3304 (mapconcat 'identity (split-string bn "" t) ".*") bn))
3305 (concat (file-name-directory fname) bn))))
3307 (defun anything-ff-save-history ()
3308 "Store the last value of `anything-ff-default-directory' \
3309 in `anything-ff-history'."
3310 (when (and anything-ff-default-directory
3311 (anything-file-completion-source-p))
3312 (push anything-ff-default-directory anything-ff-history)))
3313 (add-hook 'anything-cleanup-hook 'anything-ff-save-history)
3315 (defun anything-ff-valid-symlink-p (file)
3316 (file-exists-p (file-truename file)))
3318 (defun anything-ff-properties (candidate)
3319 "Show file properties of CANDIDATE in a tooltip or message."
3320 (let ((type (anything-ff-attributes candidate :type t))
3321 (dired-line (anything-ff-attributes candidate :dired t :human-size t)))
3322 (if (window-system)
3323 (tooltip-show
3324 (concat
3325 (anything-c-basename candidate) ": \n"
3326 "Type: " type "\n"
3327 (when (string= type "symlink")
3328 (format "True name: '%s'\n"
3329 (cond ((string-match "^\.#" (anything-c-basename candidate))
3330 "Autosave symlink")
3331 ((anything-ff-valid-symlink-p candidate)
3332 (file-truename candidate))
3333 (t "Invalid Symlink"))))
3334 dired-line))
3335 (message dired-line) (sit-for 5))))
3337 ;;;###autoload
3338 (defun anything-ff-properties-persistent ()
3339 "Show properties without quitting anything."
3340 (interactive)
3341 (anything-execute-persistent-action 'properties-action))
3343 (defun anything-ff-kill-buffer-fname (candidate)
3344 (let* ((buf (get-file-buffer candidate))
3345 (buf-name (buffer-name buf)))
3346 (if buf
3347 (progn
3348 (kill-buffer buf) (message "Buffer `%s' killed" buf))
3349 (message "No buffer to kill"))))
3351 (defun anything-ff-kill-or-find-buffer-fname (candidate)
3352 "Find file CANDIDATE or kill it's buffer if it is visible.
3353 Never kill `anything-current-buffer'.
3354 Never kill buffer modified.
3355 This is called normally on third hit of \
3356 \\<anything-map>\\[anything-execute-persistent-action]
3357 in `anything-find-files-persistent-action'."
3358 (let* ((buf (get-file-buffer candidate))
3359 (buf-name (buffer-name buf)))
3360 (if (and buf (get-buffer-window buf)
3361 (not (eq buf (get-buffer anything-current-buffer)))
3362 (not (buffer-modified-p buf)))
3363 (progn
3364 (kill-buffer buf) (message "Buffer `%s' killed" buf-name))
3365 (find-file candidate))))
3367 ;;;###autoload
3368 (defun anything-ff-run-kill-buffer-persistent ()
3369 "Execute `anything-ff-kill-buffer-fname' whitout quitting."
3370 (interactive)
3371 (anything-execute-persistent-action 'kill-buffer-fname))
3373 (defun anything-ff-human-size (size)
3374 "Return a string showing SIZE of a file in human readable form.
3375 SIZE can be an integer or a float depending it's value.
3376 `file-attributes' will take care of that to avoid overflow error.
3377 KBSIZE if a floating point number, default value is 1024.0."
3378 (let ((M (cons "M" (/ size (expt anything-ff-default-kbsize 2))))
3379 (G (cons "G" (/ size (expt anything-ff-default-kbsize 3))))
3380 (K (cons "K" (/ size anything-ff-default-kbsize)))
3381 (B (cons "B" size)))
3382 (loop with result = B
3383 for (a . b) in
3384 (loop for (x . y) in (list M G K B)
3385 unless (< y 1) collect (cons x y))
3386 when (< b (cdr result)) do (setq result (cons a b))
3387 finally return (if (string= (car result) "B")
3388 (format "%s" size)
3389 (format "%.1f%s" (cdr result) (car result))))))
3391 (defun* anything-ff-attributes
3392 (file &key type links uid gid access-time modif-time
3393 status size mode gid-change inode device-num dired human-size)
3394 "Easy interface for `file-attributes'."
3395 (let ((all (destructuring-bind
3396 (type links uid gid access-time modif-time
3397 status size mode gid-change inode device-num)
3398 (file-attributes file 'string)
3399 (list :type type
3400 :links links
3401 :uid uid
3402 :gid gid
3403 :access-time access-time
3404 :modif-time modif-time
3405 :status status
3406 :size size
3407 :mode mode
3408 :gid-change gid-change
3409 :inode inode
3410 :device-num device-num))))
3411 (cond (type
3412 (let ((result (getf all :type)))
3413 (cond ((stringp result)
3414 "symlink")
3415 (result "directory")
3416 (t "file"))))
3417 (links (getf all :links))
3418 (uid (getf all :uid))
3419 (gid (getf all :gid))
3420 (access-time
3421 (format-time-string "%Y-%m-%d %R" (getf all :access-time)))
3422 (modif-time
3423 (format-time-string "%Y-%m-%d %R" (getf all :modif-time)))
3424 (status
3425 (format-time-string "%Y-%m-%d %R" (getf all :status)))
3426 (size (if human-size (anything-ff-human-size (getf all :size))
3427 (getf all :size)))
3428 (mode (getf all :mode))
3429 (gid-change (getf all :gid-change))
3430 (inode (getf all :inode))
3431 (device-num (getf all :device-num))
3432 (dired
3433 (concat
3434 (getf all :mode) " "
3435 (number-to-string (getf all :links)) " "
3436 (getf all :uid) ":"
3437 (getf all :gid) " "
3438 (if human-size (anything-ff-human-size (getf all :size))
3439 (int-to-string (getf all :size))) " "
3440 (format-time-string "%Y-%m-%d %R" (getf all :modif-time))))
3441 (t all))))
3444 (defun anything-c-prefix-filename (fname &optional image file-or-symlinkp)
3445 "Return fname FNAME prefixed with icon IMAGE."
3446 (let* ((img-name (and image (expand-file-name
3447 image anything-c-find-files-icons-directory)))
3448 (img (and image (create-image img-name)))
3449 (prefix-img (and image (propertize " " 'display img)))
3450 (prefix-new (propertize
3451 " " 'display
3452 (propertize "[?]" 'face 'anything-ff-prefix)))
3453 (prefix-url (propertize
3454 " " 'display
3455 (propertize "[@]" 'face 'anything-ff-prefix))))
3456 (cond ((or file-or-symlinkp
3457 (file-exists-p fname)
3458 (file-symlink-p fname))
3459 (if image (concat prefix-img fname) fname))
3460 ((string-match ffap-url-regexp fname) (concat prefix-url " " fname))
3461 (t (concat prefix-new " " fname)))))
3463 (defun anything-c-find-files-transformer (files sources)
3464 "Selector of transformer to use for `anything-c-source-find-files'."
3465 (if (and (string-match tramp-file-name-regexp anything-pattern)
3466 anything-ff-tramp-not-fancy)
3467 files
3468 (if (and (window-system) anything-c-find-files-show-icons)
3469 (anything-c-highlight-ffiles1 files sources)
3470 (anything-c-highlight-ffiles files sources))))
3472 (defun anything-c-highlight-ffiles (files sources)
3473 "Candidate transformer for `anything-c-source-find-files' without icons."
3474 (loop for i in files collect
3475 (cond ((and (stringp (car (file-attributes i)))
3476 (not (anything-ff-valid-symlink-p i))
3477 (not (string-match "^\.#" (anything-c-basename i))))
3478 (cons (anything-c-prefix-filename
3479 (propertize i 'face 'anything-ff-invalid-symlink) nil t)
3481 ((stringp (car (file-attributes i)))
3482 (cons (anything-c-prefix-filename
3483 (propertize i 'face 'anything-ff-symlink) nil t)
3485 ((eq t (car (file-attributes i)))
3486 (cons (anything-c-prefix-filename
3487 (propertize i 'face 'anything-ff-directory) nil t)
3489 ((file-executable-p i)
3490 (cons (anything-c-prefix-filename
3491 (propertize i 'face 'anything-ff-executable) nil t)
3494 (cons (anything-c-prefix-filename
3495 (propertize i 'face 'anything-ff-file))
3496 i)))))
3498 (defun anything-c-highlight-ffiles1 (files sources)
3499 "Candidate transformer for `anything-c-source-find-files' that show icons."
3500 (loop for i in files
3501 for af = (file-name-nondirectory i)
3502 collect (cond ( ;; Files.
3503 (eq nil (car (file-attributes i)))
3504 (let ((face (if (file-executable-p i)
3505 'anything-ff-executable
3506 'anything-ff-file)))
3507 (cons (anything-c-prefix-filename
3508 (propertize i 'face face) "leaf.xpm")
3509 i)))
3510 ( ;; Empty directories.
3511 (and (eq t (car (file-attributes i)))
3512 ;; Be sure to have permission to list content.
3513 (file-readable-p i)
3514 (eq 0 (length
3515 (directory-files
3516 i nil directory-files-no-dot-files-regexp t))))
3517 (cons (anything-c-prefix-filename
3518 (propertize
3519 i 'face 'anything-ff-directory)
3520 "empty.xpm")
3522 ( ;; Open directories.
3523 (and (eq t (car (file-attributes i))) (get-buffer af))
3524 (cons (anything-c-prefix-filename
3525 (propertize
3526 i 'face 'anything-ff-directory)
3527 "open.xpm")
3529 ( ;; Closed directories.
3530 (eq t (car (file-attributes i)))
3531 (cons (anything-c-prefix-filename
3532 (propertize
3533 i 'face 'anything-ff-directory)
3534 "close.xpm")
3536 ( ;; Open Symlinks directories.
3537 (and (stringp (car (file-attributes i)))
3538 (file-directory-p i) (get-buffer af))
3539 (cons (anything-c-prefix-filename
3540 (propertize i 'face 'anything-ff-symlink))
3542 ( ;; Closed Symlinks directories.
3543 (and (stringp (car (file-attributes i)))
3544 (file-directory-p i))
3545 (cons (anything-c-prefix-filename
3546 (propertize i 'face 'anything-ff-symlink))
3548 ( ;; Invalid Symlinks
3549 (and (stringp (car (file-attributes i)))
3550 (not (anything-ff-valid-symlink-p i))
3551 (not (string-match "^\.#" (anything-c-basename i))))
3552 (cons (anything-c-prefix-filename
3553 (propertize i 'face 'anything-ff-invalid-symlink)
3554 "leaf.xpm")
3556 ( ;; Files symlinks.
3557 (stringp (car (file-attributes i)))
3558 (cons (anything-c-prefix-filename
3559 (propertize i 'face 'anything-ff-symlink)
3560 "leaf.xpm")
3561 i)))))
3563 (defun anything-find-files-action-transformer (actions candidate)
3564 "Action transformer for `anything-c-source-find-files'."
3565 (cond ((with-current-buffer anything-current-buffer
3566 (eq major-mode 'message-mode))
3567 (append (subseq actions 0 4)
3568 '(("Gnus attach file(s)" . anything-ff-gnus-attach-files))
3569 (subseq actions 4)))
3570 ((string-match (image-file-name-regexp) candidate)
3571 (append (subseq actions 0 4)
3572 '(("Rotate image right `M-r'" . anything-ff-rotate-image-right)
3573 ("Rotate image left `M-l'" . anything-ff-rotate-image-left))
3574 (subseq actions 4)))
3575 ((string-match "\.el$" (anything-aif (anything-marked-candidates)
3576 (car it) candidate))
3577 (append (subseq actions 0 4)
3578 '(("Byte compile lisp file(s) `M-B, C-u to load'"
3579 . anything-find-files-byte-compile)
3580 ("Load File(s) `M-L'" . anything-find-files-load-files))
3581 (subseq actions 4)))
3582 ((and (string-match "\.html?$" candidate)
3583 (file-exists-p candidate))
3584 (append (subseq actions 0 4)
3585 '(("Browse url file" . browse-url-of-file))
3586 (subseq actions 5)))
3587 ((or (string= (file-name-extension candidate) "pdf")
3588 (string= (file-name-extension candidate) "PDF"))
3589 (append (subseq actions 0 4)
3590 '(("Pdfgrep File(s)" . anything-ff-pdfgrep))
3591 (subseq actions 5)))
3592 (t actions)))
3594 (defun anything-ff-gnus-attach-files (candidate)
3595 "Run `gnus-dired-attach' on `anything-marked-candidates' or CANDIDATE."
3596 (let ((flist (anything-marked-candidates)))
3597 (gnus-dired-attach flist)))
3599 (defun anything-ff-rotate-current-image1 (file &optional num-arg)
3600 "Rotate current image at NUM-ARG degrees.
3601 This is a destructive operation on FILE made by external tool mogrify."
3602 (setq file (file-truename file)) ; For symlinked images.
3603 ;; When FILE is not an image-file, do nothing.
3604 (when (string-match (image-file-name-regexp) file)
3605 (if (executable-find "mogrify")
3606 (progn
3607 (shell-command (format "mogrify -rotate %s %s" (or num-arg 90) file))
3608 (when (buffer-live-p image-dired-display-image-buffer)
3609 (kill-buffer image-dired-display-image-buffer))
3610 (image-dired-display-image file)
3611 (message nil)
3612 (display-buffer (get-buffer image-dired-display-image-buffer)))
3613 (error "mogrify not found"))))
3615 (defun anything-ff-rotate-image-left (candidate)
3616 "Rotate image file CANDIDATE left.
3617 This affect directly file CANDIDATE."
3618 (anything-ff-rotate-current-image1 candidate -90))
3620 (defun anything-ff-rotate-image-right (candidate)
3621 "Rotate image file CANDIDATE right.
3622 This affect directly file CANDIDATE."
3623 (anything-ff-rotate-current-image1 candidate))
3625 (defun anything-ff-rotate-left-persistent ()
3626 "Rotate image left without quitting anything."
3627 (interactive)
3628 (anything-execute-persistent-action 'image-action1))
3630 (defun anything-ff-rotate-right-persistent ()
3631 "Rotate image right without quitting anything."
3632 (interactive)
3633 (anything-execute-persistent-action 'image-action2))
3635 (defun anything-ff-exif-data (candidate)
3636 "Extract exif data from file CANDIDATE using `anything-ff-exif-data-program'."
3637 (if (and anything-ff-exif-data-program
3638 (executable-find anything-ff-exif-data-program))
3639 (shell-command-to-string (format "%s %s %s"
3640 anything-ff-exif-data-program
3641 anything-ff-exif-data-program-args
3642 candidate))
3643 (format "No program %s found to extract exif"
3644 anything-ff-exif-data-program)))
3646 (defun anything-find-files-persistent-action (candidate)
3647 "Open subtree CANDIDATE without quitting anything.
3648 If CANDIDATE is not a directory expand CANDIDATE filename.
3649 If CANDIDATE is alone, open file CANDIDATE filename.
3650 That's mean:
3651 First hit on C-z expand CANDIDATE second hit open file.
3652 If a prefix arg is given or `anything-follow-mode' is on open file."
3653 (let ((follow (buffer-local-value
3654 'anything-follow-mode
3655 (get-buffer-create anything-buffer)))
3656 (new-pattern (anything-get-selection))
3657 (num-lines-buf (with-current-buffer anything-buffer
3658 (count-lines (point-min) (point-max)))))
3659 (flet ((insert-in-minibuffer (fname)
3660 (with-selected-window (minibuffer-window)
3661 (unless follow
3662 (delete-minibuffer-contents)
3663 (set-text-properties 0 (length fname) nil fname)
3664 (insert fname)))))
3665 (cond (;; A symlink directory, expand it's truename.
3666 (and (file-directory-p candidate) (file-symlink-p candidate))
3667 (insert-in-minibuffer (file-name-as-directory
3668 (file-truename
3669 (expand-file-name candidate)))))
3670 ;; A directory, open it.
3671 ((file-directory-p candidate)
3672 (when (string= (anything-c-basename candidate) "..")
3673 (setq anything-ff-last-expanded anything-ff-default-directory))
3674 (insert-in-minibuffer (file-name-as-directory
3675 (expand-file-name candidate))))
3676 ;; A symlink file, expand to it's true name. (first hit)
3677 ((and (file-symlink-p candidate) (not current-prefix-arg) (not follow))
3678 (insert-in-minibuffer (file-truename candidate)))
3679 ;; A regular file, expand it, (first hit)
3680 ((and (>= num-lines-buf 3) (not current-prefix-arg) (not follow))
3681 (insert-in-minibuffer new-pattern))
3682 ;; An image file and it is the second hit on C-z,
3683 ;; show the file in `image-dired'.
3684 ((string-match (image-file-name-regexp) candidate)
3685 (when (buffer-live-p image-dired-display-image-buffer)
3686 (kill-buffer image-dired-display-image-buffer))
3687 (image-dired-display-image candidate)
3688 (message nil)
3689 (anything-c-switch-to-buffer image-dired-display-image-buffer)
3690 (with-current-buffer image-dired-display-image-buffer
3691 (let ((exif-data (anything-ff-exif-data candidate)))
3692 (image-dired-update-property 'help-echo exif-data))))
3693 ;; Allow browsing archive on avfs fs.
3694 ;; Assume volume is already mounted with mountavfs.
3695 ((and anything-ff-avfs-directory
3696 (string-match
3697 (regexp-quote (expand-file-name anything-ff-avfs-directory))
3698 (file-name-directory candidate))
3699 (anything-ff-file-compressed-p candidate))
3700 (insert-in-minibuffer (concat candidate "#")))
3701 ;; On second hit we open file.
3702 ;; On Third hit we kill it's buffer maybe.
3704 (anything-ff-kill-or-find-buffer-fname candidate))))))
3706 (defvar anything-ff-avfs-directory nil
3707 "*The default avfs directory, usually '.avfs'.
3708 When this is set you will be able to expand archive filenames with `C-z'
3709 inside an avfs directory mounted with mountavfs.
3710 See <http://sourceforge.net/projects/avf/>.")
3711 (defvar anything-ff-file-compressed-list '("gz" "bz2" "zip" "7z")
3712 "*Minimal list of compressed files extension.")
3713 (defun anything-ff-file-compressed-p (candidate)
3714 "Whether CANDIDATE is a compressed file or not."
3715 (member (file-name-extension candidate)
3716 anything-ff-file-compressed-list))
3718 (defun anything-c-insert-file-name-completion-at-point (candidate)
3719 "Insert file name completion at point."
3720 (if buffer-read-only
3721 (error "Error: Buffer `%s' is read-only" (buffer-name))
3722 (let* ((end (point))
3723 (guess (substring-no-properties (thing-at-point 'filename)))
3724 (beg (- (point) (length guess)))
3725 (full-path-p (or (string-match-p (concat "^" (getenv "HOME")) guess)
3726 (string-match-p "^[^\~]" guess))))
3727 (set-text-properties 0 (length candidate) nil candidate)
3728 (if (and guess (not (string= guess "")) (string-match-p "^~\\|/.*" guess))
3729 (progn
3730 (delete-region beg end)
3731 (insert (if full-path-p
3732 (expand-file-name candidate)
3733 (abbreviate-file-name candidate))))
3734 (error "Aborting completion: No valid file name at point")))))
3736 (defun* anything-find-files-history (&key (comp-read t))
3737 "The `anything-find-files' history.
3738 Show the first `anything-ff-history-max-length' elements of `anything-ff-history'
3739 in an `anything-comp-read'."
3740 (let ((history (when anything-ff-history
3741 (loop with dup for i in anything-ff-history
3742 ;; Remove duplicate and not existing files.
3743 ;; Keep remote files.
3744 unless (or (member i dup)
3745 (and (not (file-remote-p i))
3746 (not (file-exists-p i))))
3747 collect i into dup
3748 finally return dup)))) ; Remove dups.
3749 (when history
3750 (setq anything-ff-history
3751 (if (>= (length history) anything-ff-history-max-length)
3752 (subseq history 0 anything-ff-history-max-length)
3753 history))
3754 (if comp-read
3755 (anything-comp-read
3756 "Switch to Directory: "
3757 anything-ff-history
3758 :name "Anything Find Files History"
3759 :must-match t)
3760 anything-ff-history))))
3762 ;;;###autoload
3763 (defun anything-find-files (arg)
3764 "Preconfigured `anything' for anything implementation of `find-file'.
3765 Called with a prefix arg show history if some.
3766 Don't call it from programs, use `anything-find-files-1' instead.
3767 This is the starting point for nearly all actions you can do on files."
3768 (interactive "P")
3769 (let ((any-input (if (and arg anything-ff-history)
3770 (anything-find-files-history)
3771 (anything-find-files-initial-input))))
3772 (when (and (eq major-mode 'org-agenda-mode)
3773 org-directory
3774 (not any-input))
3775 (setq any-input (expand-file-name org-directory)))
3776 (set-text-properties 0 (length any-input) nil any-input)
3777 (if any-input
3778 ;; [Emacs-bug work around]
3779 ;; auto-expanding on a partial directory name as input
3780 ;; yield indefinitely this directory name in minibuffer
3781 ;; for unknow reasons, so disable auto-expansion for now
3782 ;; when any-input is an incomplete file/dir name.
3783 (let* ((anything-ff-auto-update-initial-value
3784 (and anything-ff-auto-update-initial-value
3785 (file-exists-p any-input)))
3786 (anything-ff-auto-update-flag
3787 anything-ff-auto-update-initial-value))
3788 (anything-find-files-1 any-input))
3789 (setq any-input (expand-file-name (anything-c-current-directory)))
3790 (anything-find-files-1 any-input (buffer-file-name (current-buffer))))))
3793 (defun anything-find-files-1 (fname &optional preselect)
3794 "Find FNAME with `anything' completion.
3795 Like `find-file' but with `anything' support.
3796 Use it for non--interactive calls of `anything-find-files'."
3797 (when (get-buffer anything-action-buffer)
3798 (kill-buffer anything-action-buffer))
3799 (let ((anything-mp-highlight-delay nil))
3800 (anything :sources 'anything-c-source-find-files
3801 :input fname
3802 :preselect preselect
3803 :keymap anything-find-files-map
3804 :prompt "Find Files or Url: "
3805 :buffer "*Anything Find Files*")))
3808 (defun anything-find-files-initial-input (&optional input)
3809 "Return INPUT if present, otherwise try to guess it."
3810 (or (and input (expand-file-name input))
3811 (anything-find-files-input
3812 (ffap-guesser)
3813 (thing-at-point 'filename))))
3815 (defun anything-find-files-input (fap tap)
3816 "Default input of `anything-find-files'."
3817 (let* ((def-dir (anything-c-current-directory))
3818 (lib (anything-find-library-at-point))
3819 (url (anything-ff-find-url-at-point))
3820 (file-p (and fap (not (string= fap ""))
3821 (file-exists-p fap)
3822 tap (not (string= tap ""))
3823 (file-exists-p
3824 (file-name-directory (expand-file-name tap def-dir))))))
3825 (cond (lib) ; e.g we are inside a require sexp.
3826 (url) ; String at point is an hyperlink.
3827 (file-p (expand-file-name tap def-dir))
3828 (t (and (not (string= fap "")) fap)))))
3830 (defun anything-c-current-directory ()
3831 "Return current-directory name at point.
3832 Useful in dired buffers when there is inserted subdirs."
3833 (if (eq major-mode 'dired-mode)
3834 (dired-current-directory)
3835 default-directory))
3837 (defun anything-ff-find-url-at-point ()
3838 "Try to find link to an url in text-property at point."
3839 (let* ((he (get-text-property (point) 'help-echo))
3840 (ov (overlays-at (point)))
3841 (ov-he (and ov (overlay-get
3842 (car (overlays-at (point))) 'help-echo)))
3843 (w3m-l (get-text-property (point) 'w3m-href-anchor))
3844 (nt-prop (get-text-property (point) 'nt-link)))
3845 ;; Org link.
3846 (when (and (stringp he) (string-match "^LINK: " he))
3847 (setq he (replace-match "" t t he)))
3848 (loop for i in (list he ov-he w3m-l nt-prop)
3849 thereis (and (stringp i) (string-match ffap-url-regexp i) i))))
3851 (defun anything-find-library-at-point ()
3852 "Try to find library path at point.
3853 Find inside `require' and `declare-function' sexp."
3854 (require 'find-func)
3855 (let* ((beg-sexp (save-excursion (search-backward "(" (point-at-bol) t)))
3856 (end-sexp (save-excursion (search-forward ")" (point-at-eol) t)))
3857 (sexp (and beg-sexp end-sexp
3858 (buffer-substring-no-properties
3859 (1+ beg-sexp) (1- end-sexp)))))
3860 (ignore-errors
3861 (cond ((and sexp (string-match "require \'.+[^)]" sexp))
3862 (find-library-name
3863 (replace-regexp-in-string
3864 "'\\|\)\\|\(" ""
3865 ;; If require use third arg, ignore it,
3866 ;; always use library path found in `load-path'.
3867 (second (split-string (match-string 0 sexp))))))
3868 ((and sexp (string-match-p "^declare-function" sexp))
3869 (find-library-name
3870 (replace-regexp-in-string
3871 "\"\\|ext:" ""
3872 (third (split-string sexp)))))
3873 (t nil)))))
3875 ;;; Anything completion for `write-file'.==> C-x C-w
3876 (defvar anything-c-source-write-file
3877 `((name . "Write File")
3878 (header-name . (lambda (name)
3879 (concat name anything-c-find-files-doc-header)))
3880 ;; It is needed for filenames with capital letters
3881 (disable-shortcuts)
3882 (candidates . anything-find-files-get-candidates)
3883 (filtered-candidate-transformer anything-c-find-files-transformer)
3884 (persistent-action . anything-find-files-persistent-action)
3885 (persistent-help . "Expand Candidate")
3886 (volatile)
3887 (action .
3888 (("Write File" . (lambda (candidate)
3889 (write-file candidate 'confirm)))))))
3891 ;;;###autoload
3892 (defun anything-write-file ()
3893 "Preconfigured `anything' providing completion for `write-file'."
3894 (interactive)
3895 (let ((anything-mp-highlight-delay nil))
3896 (anything :sources 'anything-c-source-write-file
3897 :input (expand-file-name default-directory)
3898 :prompt "Write buffer to file: "
3899 :buffer "*Anything write file*")))
3901 ;;; Anything completion for `insert-file'.==> C-x i
3902 (defvar anything-c-source-insert-file
3903 `((name . "Insert File")
3904 (header-name . (lambda (name)
3905 (concat name anything-c-find-files-doc-header)))
3906 ;; It is needed for filenames with capital letters
3907 (disable-shortcuts)
3908 (candidates . anything-find-files-get-candidates)
3909 (filtered-candidate-transformer anything-c-find-files-transformer)
3910 (persistent-action . anything-find-files-persistent-action)
3911 (persistent-help . "Expand Candidate")
3912 (volatile)
3913 (action .
3914 (("Insert File" . (lambda (candidate)
3915 (when (y-or-n-p (format "Really insert %s in %s "
3916 candidate anything-current-buffer))
3917 (insert-file-contents candidate))))))))
3919 ;;;###autoload
3920 (defun anything-insert-file ()
3921 "Preconfigured `anything' providing completion for `insert-file'."
3922 (interactive)
3923 (let ((anything-mp-highlight-delay nil))
3924 (anything :sources 'anything-c-source-insert-file
3925 :input (expand-file-name default-directory)
3926 :prompt "Insert file: "
3927 :buffer "*Anything insert file*")))
3929 ;;; Anything completion for copy, rename and (rel)sym/hard/link files from dired.
3930 (defvar anything-c-source-copy-files
3931 `((name . "Copy Files")
3932 (header-name . (lambda (name)
3933 (concat name anything-c-find-files-doc-header)))
3934 ;; It is needed for filenames with capital letters
3935 (disable-shortcuts)
3936 (candidates . anything-find-files-get-candidates)
3937 (filtered-candidate-transformer anything-c-find-files-transformer)
3938 (persistent-action . anything-find-files-persistent-action)
3939 (persistent-help . "Expand Candidate")
3940 (volatile)
3941 (action .
3942 (("Copy File"
3943 . (lambda (candidate)
3944 (anything-dired-action candidate :action 'copy)))
3945 ("Copy and Follow"
3946 . (lambda (candidate)
3947 (anything-dired-action candidate :action 'copy :follow t)))))))
3950 (defvar anything-c-source-rename-files
3951 `((name . "Rename Files")
3952 (header-name . (lambda (name)
3953 (concat name anything-c-find-files-doc-header)))
3954 ;; It is needed for filenames with capital letters
3955 (disable-shortcuts)
3956 (candidates . anything-find-files-get-candidates)
3957 (filtered-candidate-transformer anything-c-find-files-transformer)
3958 (persistent-action . anything-find-files-persistent-action)
3959 (persistent-help . "Expand Candidate")
3960 (volatile)
3961 (action .
3962 (("Rename File"
3963 . (lambda (candidate)
3964 (anything-dired-action candidate :action 'rename)))
3965 ("Rename and Follow"
3966 . (lambda (candidate)
3967 (anything-dired-action candidate :action 'rename :follow t)))))))
3969 (defvar anything-c-source-symlink-files
3970 `((name . "Symlink Files")
3971 (header-name . (lambda (name)
3972 (concat name anything-c-find-files-doc-header)))
3973 ;; It is needed for filenames with capital letters
3974 (disable-shortcuts)
3975 (candidates . anything-find-files-get-candidates)
3976 (filtered-candidate-transformer anything-c-find-files-transformer)
3977 (persistent-action . anything-find-files-persistent-action)
3978 (persistent-help . "Expand Candidate")
3979 (volatile)
3980 (action
3981 . (("Symlink File"
3982 . (lambda (candidate)
3983 (anything-dired-action candidate :action 'symlink)))
3984 ("RelSymlink File"
3985 . (lambda (candidate)
3986 (anything-dired-action candidate :action 'relsymlink)))))))
3989 (defvar anything-c-source-hardlink-files
3990 `((name . "Hardlink Files")
3991 (header-name . (lambda (name)
3992 (concat name anything-c-find-files-doc-header)))
3993 ;; It is needed for filenames with capital letters
3994 (disable-shortcuts)
3995 (candidates . anything-find-files-get-candidates)
3996 (filtered-candidate-transformer anything-c-find-files-transformer)
3997 (persistent-action . anything-find-files-persistent-action)
3998 (persistent-help . "Expand Candidate")
3999 (volatile)
4000 (action
4001 . (("Hardlink File"
4002 . (lambda (candidate)
4003 (anything-dired-action candidate :action 'hardlink)))))))
4005 (defun* anything-dired-action (candidate &key action follow (files (dired-get-marked-files)))
4006 "Copy, rename or symlink file at point or marked files in dired to CANDIDATE.
4007 ACTION is a key that can be one of 'copy, 'rename, 'symlink, 'relsymlink."
4008 (when (get-buffer dired-log-buffer) (kill-buffer dired-log-buffer))
4009 (let ((fn (case action
4010 ('copy 'dired-copy-file)
4011 ('rename 'dired-rename-file)
4012 ('symlink 'make-symbolic-link)
4013 ('relsymlink 'dired-make-relative-symlink)
4014 ('hardlink 'dired-hardlink)))
4015 (marker (case action
4016 ((copy rename) dired-keep-marker-copy)
4017 ('symlink dired-keep-marker-symlink)
4018 ('relsymlink dired-keep-marker-relsymlink)
4019 ('hardlink dired-keep-marker-hardlink)))
4020 (dirflag (and (= (length files) 1)
4021 (file-directory-p (car files))
4022 (not (file-directory-p candidate)))))
4023 (dired-create-files
4024 fn (symbol-name action) files
4025 ;; CANDIDATE is the destination.
4026 (if (file-directory-p candidate)
4027 ;; When CANDIDATE is a directory, build file-name in this directory.
4028 ;; Else we use CANDIDATE.
4029 #'(lambda (from)
4030 (expand-file-name (file-name-nondirectory from) candidate))
4031 #'(lambda (from) candidate))
4032 marker)
4033 (when (and follow (not (get-buffer dired-log-buffer)))
4034 (let ((moved-flist (anything-get-dest-fnames-from-list files candidate dirflag))
4035 (target (directory-file-name candidate)))
4036 (unwind-protect
4037 (progn
4038 (setq anything-ff-cand-to-mark moved-flist)
4039 (if (and dirflag (eq action 'rename))
4040 (anything-find-files-1 (file-name-directory target) target)
4041 (anything-find-files-1 (expand-file-name candidate))))
4042 (setq anything-ff-cand-to-mark nil))))))
4044 ;; Internal
4045 (defvar anything-ff-cand-to-mark nil)
4047 (defun anything-c-basename (fname)
4048 "Resolve basename of file or directory named FNAME."
4049 (file-name-nondirectory (directory-file-name fname)))
4051 (defun anything-get-dest-fnames-from-list (flist dest-cand rename-dir-flag)
4052 "Transform filenames of FLIST to abs of DEST-CAND."
4053 ;; At this point files have been renamed/copied at destination.
4054 ;; That's mean DEST-CAND exists.
4055 (loop
4056 with dest = (expand-file-name dest-cand)
4057 for src in flist
4058 for basename-src = (anything-c-basename src)
4059 for fname = (cond (rename-dir-flag (directory-file-name dest))
4060 ((file-directory-p dest)
4061 (concat (file-name-as-directory dest) basename-src))
4062 (t dest))
4063 when (file-exists-p fname)
4064 collect fname into tmp-list
4065 finally return (sort tmp-list 'string<)))
4067 (defun anything-c-maybe-mark-candidates ()
4068 "Mark all candidates of list `anything-ff-cand-to-mark'."
4069 (when (and (string= (assoc-default 'name (anything-get-current-source))
4070 (assoc-default 'name anything-c-source-find-files))
4071 anything-ff-cand-to-mark)
4072 (with-anything-window
4073 (while anything-ff-cand-to-mark
4074 (if (search-forward (car anything-ff-cand-to-mark) (point-at-eol) t)
4075 (progn
4076 (anything-mark-current-line)
4077 (anything-make-visible-mark)
4078 (forward-line 1)
4079 (setq anything-ff-cand-to-mark (cdr anything-ff-cand-to-mark)))
4080 (forward-line 1)))
4081 (unless (anything-this-visible-mark)
4082 (anything-prev-visible-mark)))))
4084 (add-hook 'anything-after-update-hook #'anything-c-maybe-mark-candidates)
4086 (defun* anything-dired-do-action-on-file (&key action)
4087 (let* ((files (dired-get-marked-files))
4088 (len (length files))
4089 (fname (if (> len 1)
4090 (format "* %d Files" len)
4091 (car files)))
4092 (source (case action
4093 ('copy 'anything-c-source-copy-files)
4094 ('rename 'anything-c-source-rename-files)
4095 ('symlink 'anything-c-source-symlink-files)
4096 ('hardlink 'anything-c-source-hardlink-files)))
4097 (prompt-fm (case action
4098 ('copy "Copy %s to: ")
4099 ('rename "Rename %s to: ")
4100 ('symlink "Symlink %s to: ")
4101 ('hardlink "Hardlink %s to: ")))
4102 (buffer (case action
4103 ('copy "*Anything Copy Files*")
4104 ('rename "*Anything Rename Files*")
4105 ('symlink "*Anything Symlink Files*")
4106 ('hardlink "*Anything Hardlink Files*")))
4107 (anything-mp-highlight-delay nil))
4108 (anything :sources source
4109 :input (or (dired-dwim-target-directory)
4110 (expand-file-name (anything-c-current-directory)))
4111 :preselect (dired-get-filename)
4112 :prompt (format prompt-fm fname)
4113 :keymap anything-c-read-file-map
4114 :buffer buffer)))
4116 ;;;###autoload
4117 (defun anything-dired-rename-file ()
4118 "Preconfigured `anything' to rename files from dired."
4119 (interactive)
4120 (anything-dired-do-action-on-file :action 'rename))
4122 ;;;###autoload
4123 (defun anything-dired-copy-file ()
4124 "Preconfigured `anything' to copy files from dired."
4125 (interactive)
4126 (anything-dired-do-action-on-file :action 'copy))
4128 ;;;###autoload
4129 (defun anything-dired-symlink-file ()
4130 "Preconfigured `anything' to symlink files from dired."
4131 (interactive)
4132 (anything-dired-do-action-on-file :action 'symlink))
4134 ;;;###autoload
4135 (defun anything-dired-hardlink-file ()
4136 "Preconfigured `anything' to hardlink files from dired."
4137 (interactive)
4138 (anything-dired-do-action-on-file :action 'hardlink))
4140 ;;;###autoload
4141 (define-minor-mode anything-dired-mode ()
4142 "Enable anything completion in Dired functions.
4143 Bindings affected are C, R, S, H."
4144 :group 'anything-config
4145 :global t
4146 (if anything-dired-mode
4147 (progn
4148 (substitute-key-definition
4149 'dired-do-copy 'anything-dired-copy-file dired-mode-map)
4150 (substitute-key-definition
4151 'dired-do-rename 'anything-dired-rename-file dired-mode-map)
4152 (substitute-key-definition
4153 'dired-do-symlink 'anything-dired-symlink-file dired-mode-map)
4154 (substitute-key-definition
4155 'dired-do-hardlink 'anything-dired-hardlink-file dired-mode-map))
4156 (substitute-key-definition
4157 'anything-dired-copy-file 'dired-do-copy dired-mode-map)
4158 (substitute-key-definition
4159 'anything-dired-rename-file 'dired-do-rename dired-mode-map)
4160 (substitute-key-definition
4161 'anything-dired-symlink-file 'dired-do-symlink dired-mode-map)
4162 (substitute-key-definition
4163 'anything-dired-hardlink-file 'dired-do-hardlink dired-mode-map)))
4165 (defalias 'anything-dired-bindings 'anything-dired-mode)
4167 (defvar anything-c-read-file-map
4168 (let ((map (copy-keymap anything-map)))
4169 (define-key map (kbd "C-.") 'anything-find-files-down-one-level)
4170 (define-key map (kbd "C-l") 'anything-find-files-down-one-level)
4171 (define-key map (kbd "C-<backspace>") 'anything-ff-run-toggle-auto-update)
4172 (when anything-ff-lynx-style-map
4173 (define-key map (kbd "<left>") 'anything-find-files-down-one-level)
4174 (define-key map (kbd "<right>") 'anything-execute-persistent-action)
4175 (define-key map (kbd "<M-left>") 'anything-previous-source)
4176 (define-key map (kbd "<M-right>") 'anything-next-source))
4177 (delq nil map))
4178 "Keymap for `anything-c-read-file-name'.")
4180 (defun* anything-c-read-file-name (prompt
4181 &key
4182 (initial-input (expand-file-name default-directory))
4183 (buffer "*Anything Completions*")
4184 test
4185 (preselect nil)
4186 must-match
4187 (history nil)
4188 (marked-candidates nil)
4189 (alistp t)
4190 (persistent-action 'anything-find-files-persistent-action)
4191 (persistent-help "Hit1 Expand Candidate, Hit2 or (C-u) Find file"))
4192 "Anything `read-file-name' emulation.
4193 INITIAL-INPUT is a valid path, TEST is a predicate that take one arg."
4194 (when (get-buffer anything-action-buffer)
4195 (kill-buffer anything-action-buffer))
4196 (let* ((anything-mp-highlight-delay nil)
4197 (anything-ff-auto-update-initial-value
4198 (and anything-ff-auto-update-initial-value
4199 (file-exists-p initial-input)))
4200 (anything-ff-auto-update-flag
4201 anything-ff-auto-update-initial-value))
4202 (flet ((action-fn (candidate)
4203 (if marked-candidates
4204 (anything-marked-candidates)
4205 (identity candidate))))
4206 (or (anything
4207 :sources
4208 `(((name . "Read File Name History")
4209 (header-name . (lambda (name)
4210 (concat name anything-c-find-files-doc-header)))
4211 (disable-shortcuts)
4212 (candidates . (lambda ()
4213 (anything-comp-read-get-candidates history nil nil alistp)))
4214 (persistent-action . ,persistent-action)
4215 (persistent-help . ,persistent-help)
4216 (action . ,'action-fn))
4217 ((name . "Read file name")
4218 (header-name . (lambda (name)
4219 (concat name anything-c-find-files-doc-header)))
4220 ;; It is needed for filenames with capital letters
4221 (disable-shortcuts)
4222 (candidates . (lambda ()
4223 (let ((seq (anything-find-files-get-candidates)))
4224 (if test
4225 (loop
4226 for fname in seq when (funcall test fname)
4227 collect fname into ls
4228 finally return
4229 (if must-match ls
4230 (append (list anything-pattern) ls)))
4231 (if must-match
4232 (if (file-exists-p (car seq)) seq (cdr seq))
4233 seq)))))
4234 (filtered-candidate-transformer anything-c-find-files-transformer)
4235 (persistent-action . ,persistent-action)
4236 (candidate-number-limit . 9999)
4237 (toggle-auto-update . anything-ff-toggle-auto-update)
4238 (persistent-help . ,persistent-help)
4239 (volatile)
4240 (action . ,'action-fn)))
4241 :input initial-input
4242 :prompt prompt
4243 :keymap anything-c-read-file-map
4244 :resume 'noresume
4245 :buffer buffer
4246 :preselect preselect)
4247 (keyboard-quit)))))
4249 ;;; File Cache
4250 (defvar anything-c-file-cache-initialized-p nil)
4252 (defvar anything-c-file-cache-files nil)
4254 (defvar anything-c-source-file-cache
4255 '((name . "File Cache")
4256 (init
4257 . (lambda ()
4258 (require 'filecache nil t)
4259 (unless anything-c-file-cache-initialized-p
4260 (setq anything-c-file-cache-files
4261 (loop for item in file-cache-alist append
4262 (destructuring-bind (base &rest dirs) item
4263 (loop for dir in dirs collect
4264 (concat dir base)))))
4265 (defadvice file-cache-add-file (after file-cache-list activate)
4266 (add-to-list 'anything-c-file-cache-files (expand-file-name file)))
4267 (setq anything-c-file-cache-initialized-p t))))
4268 (candidates . anything-c-file-cache-files)
4269 (match anything-c-match-on-file-name
4270 anything-c-match-on-directory-name)
4271 (type . file)))
4272 ;; (anything 'anything-c-source-file-cache)
4274 ;;; Locate
4275 ;; NOTE for WINDOZE users:
4276 ;; You have to install Everything with his command line interface here:
4277 ;; http://www.voidtools.com/download.php
4279 (defvar anything-c-locate-command
4280 (case system-type
4281 ('gnu/linux "locate -i -r %s")
4282 ('berkeley-unix "locate -i %s")
4283 ('windows-nt "es -i -r %s")
4284 (t "locate %s"))
4285 "A list of arguments for locate program.
4286 The \"-r\" option must be the last option.")
4288 (defvar anything-locate-db-file-regexp "m?locate\.db$"
4289 "Default regexp to match locate database.
4290 If nil Search in all files.")
4292 (defun anything-locate-with-db (&optional db)
4293 "Run locate -d DB.
4294 If DB is not given or nil use locate without -d option.
4295 DB can be given as a string or list of db files.
4296 See also `anything-locate'."
4297 (when (and db (stringp db)) (setq db (list db)))
4298 (let ((anything-c-locate-command
4299 (if db
4300 (replace-regexp-in-string
4301 "locate"
4302 (format "locate -d %s"
4303 (mapconcat 'identity
4304 ;; Remove eventually marked directories by error.
4305 (loop for i in db unless
4306 (file-directory-p i) collect i) ":"))
4307 anything-c-locate-command)
4308 anything-c-locate-command)))
4309 (anything :sources 'anything-c-source-locate
4310 :buffer "*anything locate*"
4311 :keymap anything-generic-files-map)))
4312 ;; (anything-locate-with-db "~/locate.db")
4314 (defun anything-c-locate-init ()
4315 "Initialize async locate process for `anything-c-source-locate'."
4316 (setq mode-line-format
4317 '(" " mode-line-buffer-identification " "
4318 (line-number-mode "%l") " "
4319 (:eval (propertize "(Locate Process Running) "
4320 'face '((:foreground "red"))))))
4321 (prog1
4322 (start-process-shell-command "locate-process" nil
4323 (format anything-c-locate-command
4324 anything-pattern))
4325 (set-process-sentinel (get-process "locate-process")
4326 #'(lambda (process event)
4327 (when (string= event "finished\n")
4328 (with-anything-window
4329 (force-mode-line-update nil)
4330 (anything-update-move-first-line)))))))
4332 (defvar anything-c-source-locate
4333 '((name . "Locate")
4334 (candidates . anything-c-locate-init)
4335 (type . file)
4336 (properties-action . anything-ff-properties)
4337 (requires-pattern . 3)
4338 (mode-line . anything-generic-file-mode-line-string)
4339 (delayed))
4340 "Find files matching the current input pattern with locate.")
4341 ;; (anything 'anything-c-source-locate)
4343 (defvar anything-generic-file-mode-line-string
4344 "\\<anything-generic-files-map>\
4345 \\[anything-generic-file-help]:Help, \
4346 \\<anything-map>\
4347 \\[anything-select-action]:Acts,\
4348 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
4349 \\[anything-select-3rd-action]:NthAct,\
4350 \\[anything-send-bug-report-from-anything]:BugReport."
4351 "String displayed in mode-line in `anything-c-source-find-files'")
4353 (defun anything-generic-file-help ()
4354 (interactive)
4355 (let ((anything-help-message "== Anything Generic files Map ==\
4356 \nSpecific commands for anything locate and others files sources:
4357 \\<anything-generic-files-map>
4358 \\[anything-ff-run-grep]\t\t->Run grep (C-u recurse).
4359 \\[anything-ff-run-pdfgrep]\t\t->Run Pdfgrep on marked files.
4360 \\[anything-ff-run-delete-file]\t\t->Delete file.
4361 \\[anything-ff-run-switch-other-window]\t\t->Switch other window.
4362 \\[anything-ff-properties-persistent]\t\t->Show file properties.
4363 \\[anything-yank-text-at-point]\t\t->Yank text at point.
4364 \\[anything-ff-run-open-file-externally]\t\t->Open file with external program (C-u to choose).
4365 \nLocate tips:
4366 You can add after writing search pattern any of the locate command line options.
4367 e.g -b, -e, -n <number>...etc.
4368 See Man locate for more infos.
4369 \n== Anything Map ==
4370 \\{anything-map}"))
4371 (anything-help)))
4373 (defvar anything-generic-files-map
4374 (let ((map (copy-keymap anything-map)))
4375 (define-key map (kbd "M-g s") 'anything-ff-run-grep)
4376 (define-key map (kbd "M-g p") 'anything-ff-run-pdfgrep)
4377 (define-key map (kbd "M-D") 'anything-ff-run-delete-file)
4378 (define-key map (kbd "C-o") 'anything-ff-run-switch-other-window)
4379 (define-key map (kbd "M-i") 'anything-ff-properties-persistent)
4380 (define-key map (kbd "C-c C-x") 'anything-ff-run-open-file-externally)
4381 (define-key map (kbd "C-w") 'anything-yank-text-at-point)
4382 (define-key map (kbd "C-c ?") 'anything-generic-file-help)
4383 map)
4384 "Generic Keymap for files.")
4386 ;;; Anything Incremental Grep.
4389 ;; Allow to grep incrementally with anything interface.
4390 ;; It allow also to Grep files recursively without using 'find' shell command.
4391 ;; On Windows you will need at least Grep version 2.5.4 of Gnuwin32.
4392 (defvar anything-c-grep-default-command
4393 "grep -d skip %e -niH -e %p %f"
4394 "Default grep format command for `anything-do-grep-1'.
4395 Where:
4396 '%e' format spec is for --exclude or --include grep options.
4397 '%p' format spec is for pattern.
4398 '%f' format spec is for filenames.")
4400 (defvar anything-c-grep-default-recurse-command
4401 "grep -d recurse %e -niH -e %p %f"
4402 "Default recursive grep format command for `anything-do-grep-1'.
4403 See `anything-c-grep-default-command' for format specs.")
4405 (defvar anything-c-default-zgrep-command "zgrep -niH -e %p %f")
4407 (defvar anything-c-rzgrep-cache (make-hash-table :test 'equal))
4409 (defvar anything-c-grep-default-function 'anything-c-grep-init)
4411 (defvar anything-c-grep-debug-command-line nil
4412 "Turn on anything grep command-line debugging when non--nil.")
4414 (defvar anything-c-zgrep-recurse-flag nil)
4416 (defvar anything-grep-mode-line-string
4417 "\\<anything-c-grep-map>\
4418 \\[anything-grep-help]:Help,\
4419 \\<anything-map>\
4420 \\[anything-select-action]:Acts,\
4421 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
4422 \\[anything-select-3rd-action]:NthAct,\
4423 \\[anything-send-bug-report-from-anything]:BugReport."
4424 "String displayed in mode-line in `anything-do-grep'.")
4425 (defvar anything-c-grep-history nil)
4427 (defvar anything-c-grep-max-length-history 100
4428 "*Max number of elements to save in `anything-c-grep-history'.")
4430 (defun anything-c-grep-prepare-candidates (candidates)
4431 "Prepare filenames and directories CANDIDATES for grep command line."
4432 ;; If one or more candidate is a directory, search in all files
4433 ;; of this candidate (e.g /home/user/directory/*).
4434 ;; If r option is enabled search also in subdidrectories.
4435 ;; We need here to expand wildcards to support crap windows filenames
4436 ;; as grep don't accept quoted wildcards (e.g "dir/*.el").
4437 (if anything-c-zgrep-recurse-flag
4438 (mapconcat 'shell-quote-argument candidates " ")
4439 (loop for i in candidates append
4440 (cond ( ;; Candidate is a directory and we use recursion.
4441 (and (file-directory-p i)
4442 (anything-c-grep-recurse-p))
4443 (list (expand-file-name i)))
4444 ;; Candidate is a directory, search in all files.
4445 ((file-directory-p i)
4446 (file-expand-wildcards
4447 (concat (file-name-as-directory (expand-file-name i)) "*") t))
4448 ;; Candidate is a file or wildcard and we use recursion, use the
4449 ;; current directory instead of candidate.
4450 ((and (or (file-exists-p i) (string-match "\*" i))
4451 (anything-c-grep-recurse-p))
4452 (list (expand-file-name
4453 (directory-file-name ; Needed for windoze.
4454 (file-name-directory (directory-file-name i))))))
4455 ;; Candidate use wildcard.
4456 ((string-match "^\*" (anything-c-basename i))
4457 (file-expand-wildcards i t))
4458 ;; Else should be one or more file.
4459 (t (list i))) into all-files
4460 finally return
4461 (mapconcat 'shell-quote-argument all-files " "))))
4463 (defun anything-c-grep-recurse-p ()
4464 "Check if `anything-do-grep-1' have switched to recursive."
4465 (let ((args (replace-regexp-in-string
4466 "grep" "" anything-c-grep-default-command)))
4467 (string-match-p "r\\|recurse" args)))
4469 (defun anything-c-grep-init (only-files &optional include zgrep)
4470 "Start an asynchronous grep process in ONLY-FILES list."
4471 (let* ((fnargs (anything-c-grep-prepare-candidates
4472 (if (file-remote-p anything-ff-default-directory)
4473 (mapcar #'(lambda (x)
4474 (file-remote-p x 'localname))
4475 only-files)
4476 only-files)))
4477 (ignored-files (mapconcat
4478 #'(lambda (x)
4479 (concat "--exclude=" (shell-quote-argument x)))
4480 grep-find-ignored-files " "))
4481 (ignored-dirs (mapconcat
4482 ;; Need grep version 2.5.4 of Gnuwin32 on windoze.
4483 #'(lambda (x)
4484 (concat "--exclude-dir=" (shell-quote-argument x)))
4485 grep-find-ignored-directories " "))
4486 (exclude (if (anything-c-grep-recurse-p)
4487 (concat (or include ignored-files) " " ignored-dirs)
4488 ignored-files))
4489 (cmd-line (format-spec
4490 anything-c-grep-default-command
4491 (delq nil
4492 (list (unless zgrep (cons ?e exclude))
4493 (cons ?p (shell-quote-argument anything-pattern))
4494 (cons ?f fnargs))))))
4495 (when anything-c-grep-debug-command-line
4496 (with-current-buffer (get-buffer-create "*any grep debug*")
4497 (goto-char (point-max))
4498 (insert (concat ">>> " cmd-line "\n\n"))))
4499 (setq mode-line-format
4500 '(" " mode-line-buffer-identification " "
4501 (line-number-mode "%l") " "
4502 (:eval (when (get-process "grep-process")
4503 (propertize "[Grep Process Running] "
4504 'face 'anything-grep-running)))))
4505 (force-mode-line-update nil)
4506 (prog1
4507 (let ((default-directory anything-ff-default-directory))
4508 (start-file-process-shell-command "grep-process" nil cmd-line))
4509 (message nil)
4510 (set-process-sentinel
4511 (get-process "grep-process")
4512 #'(lambda (process event)
4513 (when (string= event "finished\n")
4514 (with-anything-window
4515 (anything-update-move-first-line)
4516 (setq mode-line-format
4517 '(" " mode-line-buffer-identification " "
4518 (line-number-mode "%l") " "
4519 (:eval (propertize
4520 (format "[Grep Process Finished - (%s results)] "
4521 (let ((nlines (1- (count-lines
4522 (point-min)
4523 (point-max)))))
4524 (if (> nlines 0) nlines 0)))
4525 'face 'anything-grep-finish))))
4526 (force-mode-line-update nil))))))))
4528 (defun anything-c-grep-action (candidate &optional where mark)
4529 "Define a default action for `anything-do-grep' on CANDIDATE.
4530 WHERE can be one of other-window, elscreen, other-frame."
4531 (let* ((split (anything-c-grep-split-line candidate))
4532 (lineno (string-to-number (nth 1 split)))
4533 (loc-fname (car split))
4534 (tramp-method (file-remote-p anything-ff-default-directory 'method))
4535 (tramp-host (file-remote-p anything-ff-default-directory 'host))
4536 (tramp-prefix (concat "/" tramp-method ":" tramp-host ":"))
4537 (fname (if tramp-host
4538 (concat tramp-prefix loc-fname) loc-fname)))
4539 (case where
4540 (other-window (find-file-other-window fname))
4541 (elscreen (anything-elscreen-find-file fname))
4542 (other-frame (find-file-other-frame fname))
4543 (t (find-file fname)))
4544 (anything-goto-line lineno)
4545 (when mark
4546 (set-marker (mark-marker) (point))
4547 (push-mark (point) 'nomsg))
4548 ;; Save history
4549 (unless (or anything-in-persistent-action
4550 (string= anything-pattern ""))
4551 (setq anything-c-grep-history
4552 (cons anything-pattern
4553 (delete anything-pattern anything-c-grep-history)))
4554 (when (> (length anything-c-grep-history)
4555 anything-c-grep-max-length-history)
4556 (setq anything-c-grep-history
4557 (delete (car (last anything-c-grep-history))
4558 anything-c-grep-history))))))
4560 (defun anything-c-grep-other-window (candidate)
4561 "Jump to result in other window from anything grep."
4562 (anything-c-grep-action candidate 'other-window))
4564 (defun anything-c-grep-other-frame (candidate)
4565 "Jump to result in other frame from anything grep."
4566 (anything-c-grep-action candidate 'other-frame))
4568 (defun anything-c-grep-jump-elscreen (candidate)
4569 "Jump to result in elscreen from anything grep."
4570 (anything-c-grep-action candidate 'elscreen))
4572 (defun anything-c-grep-save-results (candidate)
4573 "Save anything grep result in a `grep-mode' buffer."
4574 (let ((buf "*grep*")
4575 new-buf)
4576 (when (get-buffer buf)
4577 (setq new-buf (read-string "GrepBufferName: " buf))
4578 (loop for b in (anything-c-buffer-list)
4579 when (and (string= new-buf b)
4580 (not (y-or-n-p
4581 (format "Buffer `%s' already exists overwrite? "
4582 new-buf))))
4583 do (setq new-buf (read-string "GrepBufferName: " "*grep ")))
4584 (setq buf new-buf))
4585 (with-current-buffer (get-buffer-create buf)
4586 (let ((inhibit-read-only t))
4587 (erase-buffer)
4588 (insert "-*- mode: grep -*-\n\n"
4589 (format "Grep Results for `%s':\n\n" anything-pattern))
4590 (save-excursion
4591 (insert (with-current-buffer anything-buffer
4592 (forward-line 1)
4593 (buffer-substring (point) (point-max))))
4594 (grep-mode))))
4595 (message "Anything Grep Results saved in `%s' buffer" buf)))
4597 (defun anything-c-grep-persistent-action (candidate)
4598 "Persistent action for `anything-do-grep'.
4599 With a prefix arg record CANDIDATE in `mark-ring'."
4600 (if current-prefix-arg
4601 (anything-c-grep-action candidate nil 'mark)
4602 (anything-c-grep-action candidate))
4603 (anything-match-line-color-current-line))
4605 (defun anything-c-grep-guess-extensions (files)
4606 "Try to guess file extensions in FILES list when using grep recurse.
4607 These extensions will be added to command line with --include arg of grep."
4608 (loop
4609 with glob-list = nil
4610 with lst = (if (file-directory-p (car files))
4611 (directory-files
4612 (car files) nil
4613 directory-files-no-dot-files-regexp)
4614 files)
4615 for i in lst
4616 for ext = (file-name-extension i t)
4617 for glob = (and ext (not (string= ext ""))
4618 (concat "*" ext))
4619 unless (or (not glob)
4620 (member glob glob-list)
4621 (member glob grep-find-ignored-files))
4622 collect glob into glob-list
4623 finally return glob-list))
4625 (defun anything-do-grep-1 (only &optional recurse zgrep)
4626 "Launch grep with a list of ONLY files.
4627 When RECURSE is given use -r option of grep and prompt user
4628 to set the --include args of grep.
4629 You can give more than one arg separated by space.
4630 e.g *.el *.py *.tex.
4631 If it's empty --exclude `grep-find-ignored-files' is used instead."
4632 (let* ((anything-compile-source-functions
4633 ;; rule out anything-match-plugin because the input is one regexp.
4634 (delq 'anything-compile-source--match-plugin
4635 (copy-sequence anything-compile-source-functions)))
4636 (exts (anything-c-grep-guess-extensions only))
4637 (globs (and (not zgrep) (mapconcat 'identity exts " ")))
4638 (include-files (and recurse (not zgrep)
4639 (read-string "OnlyExt(*.[ext]): "
4640 globs)))
4641 ;; Set `minibuffer-history' AFTER includes-files
4642 ;; to avoid storing wild-cards here.
4643 (minibuffer-history anything-c-grep-history)
4644 (anything-c-grep-default-command (cond ((and recurse zgrep) anything-c-default-zgrep-command)
4645 (recurse anything-c-grep-default-recurse-command)
4646 (zgrep anything-c-default-zgrep-command)
4647 (t anything-c-grep-default-command)))
4648 ;; Disable match-plugin and use here own highlighting.
4649 (anything-mp-highlight-delay nil))
4650 (when include-files
4651 (setq include-files
4652 (and (not (string= include-files ""))
4653 (mapconcat #'(lambda (x)
4654 (concat "--include=" (shell-quote-argument x)))
4655 (split-string include-files) " "))))
4656 ;; When called as action from an other source e.g *-find-files
4657 ;; we have to kill action buffer.
4658 (when (get-buffer anything-action-buffer)
4659 (kill-buffer anything-action-buffer))
4660 ;; `anything-find-files' haven't already started,
4661 ;; give a default value to `anything-ff-default-directory'.
4662 (setq anything-ff-default-directory (or anything-ff-default-directory
4663 default-directory))
4664 (anything
4665 :sources
4666 `(((name . "Grep (C-c ? Help)")
4667 (candidates
4668 . (lambda ()
4669 (funcall anything-c-grep-default-function only include-files zgrep)))
4670 (filtered-candidate-transformer anything-c-grep-cand-transformer)
4671 (candidate-number-limit . 9999)
4672 (mode-line . anything-grep-mode-line-string)
4673 (jump-persistent . anything-c-grep-persistent-action)
4674 (action . ,(delq
4676 `(("Find File" . anything-c-grep-action)
4677 ("Find file other frame" . anything-c-grep-other-frame)
4678 ,(and (locate-library "elscreen")
4679 '("Find file in Elscreen"
4680 . anything-c-grep-jump-elscreen))
4681 ("Save results in grep buffer" . anything-c-grep-save-results)
4682 ("Find file other window" . anything-c-grep-other-window))))
4683 (persistent-action . anything-c-grep-persistent-action)
4684 (persistent-help . "Jump to line (`C-u' Record in mark ring)")
4685 (requires-pattern . 3)
4686 (delayed)))
4687 :keymap anything-c-grep-map
4688 :buffer "*anything grep*")))
4690 ;;;###autoload
4691 (defun anything-do-grep ()
4692 "Preconfigured anything for grep.
4693 Contrarily to Emacs `grep' no default directory is given, but
4694 the full path of candidates in ONLY.
4695 That allow to grep different files not only in `default-directory' but anywhere
4696 by marking them (C-<SPACE>). If one or more directory is selected
4697 grep will search in all files of these directories.
4698 You can use also wildcard in the base name of candidate.
4699 If a prefix arg is given use the -r option of grep.
4700 The prefix arg can be passed before or after start.
4701 See also `anything-do-grep-1'."
4702 (interactive)
4703 (let ((only (anything-c-read-file-name
4704 "Search in file(s): "
4705 :marked-candidates t
4706 :preselect (or (dired-get-filename nil t)
4707 (buffer-file-name (current-buffer)))))
4708 (prefarg (or current-prefix-arg anything-current-prefix-arg)))
4709 (anything-do-grep-1 only prefarg)))
4711 (defmacro* anything-c-walk-directory (directory &key (path 'basename) (directories t) match)
4712 "Walk through DIRECTORY tree.
4713 PATH can be one of basename, relative, or full.
4714 DIRECTORIES when non--nil (default) return also directories names, otherwise
4715 skip directories names.
4716 MATCH match only filenames matching regexp MATCH."
4717 `(let (result
4718 (fn (case ,path
4719 (basename 'file-name-nondirectory)
4720 (relative 'file-relative-name)
4721 (full 'identity)
4722 (t (error "Error: Invalid path spec `%s', must be one of basename, relative or full." ,path)))))
4723 (labels ((ls-R (dir)
4724 (loop with ls = (directory-files dir t directory-files-no-dot-files-regexp)
4725 for f in ls
4726 if (file-directory-p f)
4727 do (progn (when ,directories
4728 (push (funcall fn f) result))
4729 ;; Don't recurse in directory symlink.
4730 (unless (file-symlink-p f)
4731 (ls-R f)))
4732 else do
4733 (unless (and ,match (not (string-match ,match (file-name-nondirectory f))))
4734 (push (funcall fn f) result)))))
4735 (ls-R ,directory)
4736 (nreverse result))))
4738 (defun anything-ff-zgrep-1 (flist recursive)
4739 (unwind-protect
4740 (let* ((def-dir (or anything-ff-default-directory
4741 default-directory))
4742 (only (if recursive
4743 (or (gethash def-dir anything-c-rzgrep-cache)
4744 (puthash
4745 def-dir
4746 (anything-c-walk-directory
4747 def-dir
4748 :directories nil
4749 :path 'full
4750 :match ".*\\(\.gz\\|\.bz\\|\.xz\\|\.lzma\\)$")
4751 anything-c-rzgrep-cache))
4752 flist)))
4753 (when recursive (setq anything-c-zgrep-recurse-flag t))
4754 (anything-do-grep-1 only recursive 'zgrep))
4755 (setq anything-c-zgrep-recurse-flag nil)))
4757 ;;;###autoload
4758 (defun anything-do-zgrep (candidate)
4759 "Preconfigured anything for zgrep."
4760 (let ((prefarg (or current-prefix-arg anything-current-prefix-arg))
4761 (ls (anything-c-read-file-name
4762 "Search in file(s): "
4763 :marked-candidates t
4764 :preselect (or (dired-get-filename nil t)
4765 (buffer-file-name (current-buffer))))))
4766 (anything-ff-zgrep-1 ls prefarg)))
4768 (defun anything-c-grep-split-line (line)
4769 "Split a grep output line."
4770 (let (beg fname lineno str)
4771 ;; Don't print until grep line is valid.
4772 (when (string-match "\\(.*\\)\\(:[0-9]+:\\)\\(.*\\)" line)
4773 (with-temp-buffer
4774 (insert line)
4775 (goto-char (point-min))
4776 (setq beg (point))
4777 (forward-char 2)
4778 (re-search-forward ":" nil t)
4779 (setq fname (buffer-substring-no-properties beg (1- (point))))
4780 (setq beg (point))
4781 (re-search-forward ":" nil t)
4782 (setq lineno (buffer-substring-no-properties beg (1- (point))))
4783 (setq str (buffer-substring-no-properties (point) (point-at-eol))))
4784 (list fname lineno str))))
4786 (defun anything-c-grep-cand-transformer (candidates sources)
4787 "Filtered candidate transformer function for `anything-do-grep'."
4788 (loop for i in candidates
4789 for split = (and i (anything-c-grep-split-line i))
4790 for fname = (car split)
4791 for lineno = (nth 1 split)
4792 for str = (nth 2 split)
4793 when (and fname lineno str)
4794 collect
4795 (cons (concat (propertize (file-name-nondirectory fname)
4796 'face 'anything-grep-file
4797 'help-echo fname) ":"
4798 (propertize lineno 'face 'anything-grep-lineno) ":"
4799 (anything-c-grep-highlight-match str))
4800 i)))
4802 (defun anything-c-grep-highlight-match (str)
4803 "Highlight in string STR all occurences matching `anything-pattern'."
4804 (condition-case nil
4805 (with-temp-buffer
4806 (insert str)
4807 (goto-char (point-min))
4808 (while (and (re-search-forward anything-pattern nil t)
4809 (> (- (match-end 0) (match-beginning 0)) 0))
4810 (add-text-properties
4811 (match-beginning 0) (match-end 0)
4812 '(face anything-grep-match)))
4813 (buffer-string))
4814 (error nil)))
4816 ;; Go to next or precedent file (common to etags and grep).
4817 (defun anything-c-goto-next-or-prec-file (n)
4818 "Go to next or precedent candidate file in anything grep/etags buffers.
4819 If N is positive go forward otherwise go backward."
4820 (with-anything-window
4821 (let* ((current-line-list (split-string
4822 (buffer-substring
4823 (point-at-bol)
4824 (point-at-eol)) ":"))
4825 (current-fname (nth 0 current-line-list))
4826 (fn-b-o-f (if (eq n 1) 'eobp 'bobp)))
4827 (catch 'break
4828 (while (not (funcall fn-b-o-f))
4829 (forward-line n) ; Go forward or backward depending of n value.
4830 (unless (search-forward current-fname (point-at-eol) t)
4831 (anything-mark-current-line)
4832 (throw 'break nil))))
4833 (cond ((and (eq n 1) (eobp))
4834 (re-search-backward ".")
4835 (forward-line 0)
4836 (anything-mark-current-line))
4837 ((and (< n 1) (bobp))
4838 (forward-line 1)
4839 (anything-mark-current-line))))))
4841 ;;;###autoload
4842 (defun anything-c-goto-precedent-file ()
4843 "Go to precedent file in anything grep/etags buffers."
4844 (interactive)
4845 (anything-c-goto-next-or-prec-file -1))
4847 ;;;###autoload
4848 (defun anything-c-goto-next-file ()
4849 "Go to precedent file in anything grep/etags buffers."
4850 (interactive)
4851 (anything-c-goto-next-or-prec-file 1))
4853 ;;;###autoload
4854 (defun anything-grep-help ()
4855 (interactive)
4856 (let ((anything-help-message "== Anything Grep Map ==\
4857 \nSpecific commands for Grep and Etags:
4858 \\<anything-c-grep-map>
4859 \\[anything-c-goto-next-file]\t->Next File.
4860 \\[anything-c-goto-precedent-file]\t\t->Precedent File.
4861 \\[anything-yank-text-at-point]\t\t->Yank Text at point in minibuffer.
4862 \\[anything-c-grep-run-other-window-action]\t\t->Jump other window.
4863 \\[anything-c-grep-run-persistent-action]\t\t->Run persistent action (Same as `C-z').
4864 \\[anything-c-grep-run-default-action]\t\t->Run default action (Same as RET).
4865 \\[anything-grep-help]\t\t->Show this help.
4866 \n== Anything Map ==
4867 \\{anything-map}"))
4868 (anything-help)))
4870 (defvar anything-c-grep-map
4871 (let ((map (copy-keymap anything-map)))
4872 (define-key map (kbd "M-<down>") 'anything-c-goto-next-file)
4873 (define-key map (kbd "M-<up>") 'anything-c-goto-precedent-file)
4874 (define-key map (kbd "C-o") 'anything-c-grep-run-other-window-action)
4875 (define-key map (kbd "C-w") 'anything-yank-text-at-point)
4876 (define-key map (kbd "C-x C-s") 'anything-c-grep-run-save-buffer)
4877 (when anything-c-grep-use-ioccur-style-keys
4878 (define-key map (kbd "<right>") 'anything-c-grep-run-persistent-action)
4879 (define-key map (kbd "<left>") 'anything-c-grep-run-default-action))
4880 (define-key map (kbd "C-c ?") 'anything-grep-help)
4881 (delq nil map))
4882 "Keymap used in Grep sources.")
4884 (defun anything-c-grep-run-persistent-action ()
4885 "Run grep persistent action from `anything-do-grep-1'."
4886 (interactive)
4887 (anything-execute-persistent-action 'jump-persistent))
4889 (defun anything-c-grep-run-default-action ()
4890 "Run grep default action from `anything-do-grep-1'."
4891 (interactive)
4892 (anything-c-quit-and-execute-action 'anything-c-grep-action))
4894 (defun anything-c-grep-run-other-window-action ()
4895 "Run grep goto other window action from `anything-do-grep-1'."
4896 (interactive)
4897 (anything-c-quit-and-execute-action 'anything-c-grep-other-window))
4899 (defun anything-c-grep-run-save-buffer ()
4900 "Run grep save results action from `anything-do-grep-1'."
4901 (interactive)
4902 (anything-c-quit-and-execute-action 'anything-c-grep-save-results))
4904 ;; Grep buffers
4905 (defun anything-c-grep-buffers-1 (candidate &optional zgrep)
4906 "Run grep on all file--buffers or CANDIDATE if it is a file--buffer.
4907 If one of selected buffers is not a file--buffer,
4908 it is ignored and grep will run on all others file--buffers.
4909 If only one candidate is selected and it is not a file--buffer,
4910 switch to this buffer and run `anything-occur'.
4911 If a prefix arg is given run grep on all buffers ignoring non--file-buffers."
4912 (let* ((prefarg (or current-prefix-arg anything-current-prefix-arg))
4913 (cands (if prefarg
4914 (buffer-list)
4915 (anything-marked-candidates)))
4916 (win-conf (current-window-configuration))
4917 ;; Non--fname buffers are ignored.
4918 (bufs (loop for buf in cands
4919 for fname = (buffer-file-name (get-buffer buf))
4920 when fname
4921 collect (expand-file-name fname))))
4922 (if bufs
4923 (if zgrep
4924 (anything-do-grep-1 bufs nil 'zgrep)
4925 (anything-do-grep-1 bufs))
4926 ;; bufs is empty, thats mean we have only CANDIDATE
4927 ;; and it is not a buffer-filename, fallback to occur.
4928 (anything-c-switch-to-buffer candidate)
4929 (when (get-buffer anything-action-buffer)
4930 (kill-buffer anything-action-buffer))
4931 (anything-occur)
4932 (when (eq anything-exit-status 1)
4933 (set-window-configuration win-conf)))))
4935 (defun anything-c-grep-buffers (candidate)
4936 "Action to grep buffers."
4937 (anything-c-grep-buffers-1 candidate))
4939 (defun anything-c-zgrep-buffers (candidate)
4940 "Action to zgrep buffers."
4941 (anything-c-grep-buffers-1 candidate 'zgrep))
4943 ;;; Anything interface for pdfgrep
4944 ;; pdfgrep program <http://pdfgrep.sourceforge.net/>
4945 ;; and a pdf-reader (e.g xpdf) are needed.
4947 (defvar anything-c-pdfgrep-default-command "pdfgrep --color never -niH %s %s")
4948 (defvar anything-c-pdfgrep-default-function 'anything-c-pdfgrep-init)
4949 (defvar anything-c-pdfgrep-debug-command-line nil)
4951 (defun anything-c-pdfgrep-init (only-files)
4952 "Start an asynchronous pdfgrep process in ONLY-FILES list."
4953 (let* ((fnargs (anything-c-grep-prepare-candidates
4954 (if (file-remote-p anything-ff-default-directory)
4955 (mapcar #'(lambda (x)
4956 (file-remote-p x 'localname))
4957 only-files)
4958 only-files)))
4959 (cmd-line (format anything-c-pdfgrep-default-command
4960 anything-pattern
4961 fnargs)))
4962 (when anything-c-pdfgrep-debug-command-line
4963 (with-current-buffer (get-buffer-create "*any pdfgrep debug*")
4964 (goto-char (point-max))
4965 (insert (concat ">>> " cmd-line "\n\n"))))
4966 (setq mode-line-format
4967 '(" " mode-line-buffer-identification " "
4968 (line-number-mode "%l") " "
4969 (:eval (propertize "(Pdfgrep Process Running) "
4970 'face '((:foreground "red"))))))
4971 (prog1
4972 (let ((default-directory anything-ff-default-directory))
4973 (start-file-process-shell-command "pdfgrep-process" nil cmd-line))
4974 (message nil)
4975 (set-process-sentinel
4976 (get-process "pdfgrep-process")
4977 #'(lambda (process event)
4978 (when (string= event "finished\n")
4979 (with-anything-window
4980 (anything-update-move-first-line))
4981 (force-mode-line-update nil)))))))
4984 (defun anything-do-pdfgrep-1 (only)
4985 "Launch pdfgrep with a list of ONLY files."
4986 (unless (executable-find "pdfgrep")
4987 (error "Error: No such program `pdfgrep'."))
4988 (let* ((anything-compile-source-functions
4989 ;; rule out anything-match-plugin because the input is one regexp.
4990 (delq 'anything-compile-source--match-plugin
4991 (copy-sequence anything-compile-source-functions)))
4992 ;; Disable match-plugin and use here own highlighting.
4993 (anything-mp-highlight-delay nil))
4994 ;; When called as action from an other source e.g *-find-files
4995 ;; we have to kill action buffer.
4996 (when (get-buffer anything-action-buffer)
4997 (kill-buffer anything-action-buffer))
4998 ;; If `anything-find-files' haven't already started,
4999 ;; give a default value to `anything-ff-default-directory'.
5000 (setq anything-ff-default-directory (or anything-ff-default-directory
5001 default-directory))
5002 (anything
5003 :sources
5004 `(((name . "PdfGrep")
5005 (candidates
5006 . (lambda ()
5007 (funcall anything-c-pdfgrep-default-function only)))
5008 (filtered-candidate-transformer anything-c-grep-cand-transformer)
5009 (candidate-number-limit . 9999)
5010 (mode-line . anything-pdfgrep-mode-line-string)
5011 (action . anything-c-pdfgrep-action)
5012 (persistent-help . "Jump to PDF Page")
5013 (requires-pattern . 3)
5014 (delayed)))
5015 :keymap anything-c-pdfgrep-map
5016 :buffer "*anything grep*")))
5018 (defvar anything-pdfgrep-mode-line-string
5019 "\\<anything-c-pdfgrep-map>\
5020 \\[anything-pdfgrep-help]:Help,\
5021 \\<anything-map>\
5022 \\[anything-select-action]:Acts,\
5023 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
5024 \\[anything-select-3rd-action]:NthAct,\
5025 \\[anything-send-bug-report-from-anything]:BugReport."
5026 "String displayed in mode-line in `anything-do-pdfgrep'.")
5028 ;;;###autoload
5029 (defun anything-pdfgrep-help ()
5030 (interactive)
5031 (let ((anything-help-message "== Anything PdfGrep Map ==\
5032 \nSpecific commands for Pdf Grep:
5033 \\<anything-c-pdfgrep-map>
5034 \\[anything-c-goto-next-file]\t->Next File.
5035 \\[anything-c-goto-precedent-file]\t\t->Precedent File.
5036 \\[anything-yank-text-at-point]\t\t->Yank Text at point in minibuffer.
5037 \\[anything-pdfgrep-help]\t\t->Show this help.
5038 \n== Anything Map ==
5039 \\{anything-map}"))
5040 (anything-help)))
5042 (defvar anything-c-pdfgrep-map
5043 (let ((map (copy-keymap anything-map)))
5044 (define-key map (kbd "M-<down>") 'anything-c-goto-next-file)
5045 (define-key map (kbd "M-<up>") 'anything-c-goto-precedent-file)
5046 (define-key map (kbd "C-w") 'anything-yank-text-at-point)
5047 (define-key map (kbd "C-c ?") 'anything-pdfgrep-help)
5048 map)
5049 "Keymap used in pdfgrep.")
5051 (defun anything-c-pdfgrep-action (candidate)
5052 (let* ((split (anything-c-grep-split-line candidate))
5053 (pageno (nth 1 split))
5054 (fname (car split)))
5055 (start-file-process-shell-command
5056 "pdf-reader" nil
5057 (format-spec anything-c-pdfgrep-default-read-command
5058 (list (cons ?f fname) (cons ?p pageno))))))
5060 (defun anything-do-pdfgrep ()
5061 (interactive)
5062 (let ((only (anything-c-read-file-name
5063 "Search in file(s): "
5064 :marked-candidates t
5065 :test #'(lambda (file)
5066 (or (string= (file-name-extension file) "pdf")
5067 (string= (file-name-extension file) "PDF")
5068 (file-directory-p file)))
5069 :preselect (or (dired-get-filename nil t)
5070 (buffer-file-name (current-buffer)))))
5071 (anything-c-grep-default-function 'anything-c-pdfgrep-init))
5072 (anything-do-pdfgrep-1 only)))
5075 ;; Yank text at point.
5078 ;; Internal
5079 (defvar anything-yank-point nil)
5081 ;;;###autoload
5082 (defun anything-yank-text-at-point ()
5083 "Yank text at point in minibuffer."
5084 (interactive)
5085 (let (input)
5086 (flet ((insert-in-minibuffer (word)
5087 (with-selected-window (minibuffer-window)
5088 (let ((str anything-pattern))
5089 (delete-minibuffer-contents)
5090 (set-text-properties 0 (length word) nil word)
5091 (insert (concat str word))))))
5092 (with-current-buffer anything-current-buffer
5093 ;; Start to initial point if C-w have never been hit.
5094 (unless anything-yank-point (setq anything-yank-point (point)))
5095 (and anything-yank-point (goto-char anything-yank-point))
5096 (forward-word 1)
5097 (setq input (buffer-substring-no-properties anything-yank-point (point)))
5098 (setq anything-yank-point (point))) ; End of last forward-word
5099 (insert-in-minibuffer input))))
5101 (defun anything-reset-yank-point ()
5102 (setq anything-yank-point nil))
5104 (add-hook 'anything-after-persistent-action-hook 'anything-reset-yank-point)
5105 (add-hook 'anything-cleanup-hook 'anything-reset-yank-point)
5106 (define-key anything-map (kbd "C-w") 'anything-yank-text-at-point)
5108 ;;; Etags
5111 ;; anything-etags.el is deprecated, if this file is found,
5112 ;; warn user at compile time.
5113 (eval-when-compile
5114 (when (locate-library "anything-etags.el")
5115 (display-warning
5116 '(anything-config)
5117 "You are using obsolete library `anything-etags.el' and should remove it."
5118 :warning)))
5120 ;;;###autoload
5121 (defun anything-etags-help ()
5122 "The help function for etags."
5123 (interactive)
5124 (let ((anything-help-message "== Anything Etags Map ==\
5125 \nSpecific commands for Etags:
5126 \\<anything-c-etags-map>
5127 \\[anything-c-goto-next-file]\t->Next File.
5128 \\[anything-c-goto-precedent-file]\t\t->Precedent File.
5129 \\[anything-yank-text-at-point]\t\t->Yank Text at point in minibuffer.
5130 \\[anything-etags-help]\t\t->Show this help.
5131 \n== Anything Map ==
5132 \\{anything-map}"))
5133 (anything-help)))
5135 (defvar anything-c-etags-map
5136 (let ((map (copy-keymap anything-map)))
5137 (define-key map (kbd "M-<down>") 'anything-c-goto-next-file)
5138 (define-key map (kbd "M-<up>") 'anything-c-goto-precedent-file)
5139 (define-key map (kbd "C-w") 'anything-yank-text-at-point)
5140 (define-key map (kbd "C-c ?") 'anything-etags-help)
5141 map)
5142 "Keymap used in Etags.")
5144 (defvar anything-c-etags-tag-file-dir nil
5145 "Etags file directory.")
5146 (defvar anything-c-etags-mtime-alist nil
5147 "Store the last modification time of etags files here.")
5148 (defvar anything-c-etags-cache (make-hash-table :test 'equal)
5149 "Cache content of etags files used here for faster access.")
5151 (defvar anything-etags-mode-line-string
5152 "\\<anything-c-etags-map>\
5153 \\[anything-etags-help]:Help,\
5154 \\<anything-map>\
5155 \\[anything-select-action]:Acts,\
5156 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
5157 \\[anything-select-3rd-action]:NthAct,\
5158 \\[anything-send-bug-report-from-anything]:BugReport."
5159 "String displayed in mode-line in `anything-c-etags-select'.")
5161 (defun anything-c-etags-get-tag-file (&optional directory)
5162 "Return the path of etags file if found."
5163 ;; Get tag file from `default-directory' or upper directory.
5164 (let ((current-dir (anything-c-etags-find-tag-file-directory
5165 (or directory default-directory))))
5166 ;; Return nil if not find tag file.
5167 (when current-dir
5168 ;; Set tag file directory.
5169 (setq anything-c-etags-tag-file-dir current-dir)
5170 (expand-file-name anything-c-etags-tag-file-name current-dir))))
5172 (defun anything-c-etags-find-tag-file-directory (current-dir)
5173 "Try to find the directory containing tag file.
5174 If not found in CURRENT-DIR search in upper directory."
5175 (flet ((file-exists? (dir)
5176 (let ((tag-path (expand-file-name
5177 anything-c-etags-tag-file-name dir)))
5178 (and (stringp tag-path)
5179 (file-exists-p tag-path)
5180 (file-readable-p tag-path)))))
5181 (loop with count = 0
5182 until (file-exists? current-dir)
5183 ;; Return nil if outside the value of
5184 ;; `anything-c-etags-tag-file-search-limit'.
5185 if (= count anything-c-etags-tag-file-search-limit)
5186 do (return nil)
5187 ;; Or search upper directories.
5188 else
5189 do (incf count)
5190 (setq current-dir (expand-file-name (concat current-dir "../")))
5191 finally return current-dir)))
5193 (defun anything-c-source-etags-header-name (x)
5194 "Create header name for this anything etags session."
5195 (concat "Etags in "
5196 (with-current-buffer anything-current-buffer
5197 (anything-c-etags-get-tag-file))))
5199 (defmacro anything-c-etags-create-buffer (file)
5200 "Create the `anything-buffer' based on contents of etags tag FILE."
5201 `(let* ((tag-fname ,file)
5203 (split (with-current-buffer (find-file-noselect tag-fname)
5204 (prog1
5205 (split-string (buffer-string) "\n" 'omit-nulls)
5206 (setq max (line-number-at-pos (point-max)))
5207 (kill-buffer))))
5208 (progress-reporter (make-progress-reporter "Loading tag file..." 0 max)))
5209 (loop
5210 with fname
5211 with cand
5212 for i in split for count from 0
5213 for elm = (unless (string-match "^\x0c" i)
5214 (anything-aif (string-match "\177" i)
5215 (substring i 0 it)
5217 do (cond ((and elm (string-match "^\\(.+\\),[0-9]+" elm))
5218 (setq fname (match-string 1 elm)))
5219 (elm (setq cand (concat fname ": " elm)))
5220 (t (setq cand nil)))
5221 when cand do (progn
5222 (insert (concat cand "\n"))
5223 (progress-reporter-update progress-reporter count)))))
5225 (defun anything-c-etags-init ()
5226 "Feed `anything-buffer' using `anything-c-etags-cache' or tag file.
5227 If no entry in cache, create one."
5228 (let ((tagfile (anything-c-etags-get-tag-file)))
5229 (when tagfile
5230 (with-current-buffer (anything-candidate-buffer 'global)
5231 (anything-aif (gethash tagfile anything-c-etags-cache)
5232 ;; An entry is present in cache, insert it.
5233 (insert it)
5234 ;; No entry, create a new buffer using content of tag file (slower).
5235 (anything-c-etags-create-buffer tagfile)
5236 ;; Store content of buffer in cache.
5237 (puthash tagfile (buffer-string) anything-c-etags-cache)
5238 ;; Store or set the last modification of tag file.
5239 (anything-aif (assoc tagfile anything-c-etags-mtime-alist)
5240 ;; If an entry exists modify it.
5241 (setcdr it (anything-c-etags-mtime tagfile))
5242 ;; No entry create a new one.
5243 (add-to-list 'anything-c-etags-mtime-alist
5244 (cons tagfile (anything-c-etags-mtime tagfile)))))))))
5246 (defvar anything-c-source-etags-select
5247 '((name . "Etags")
5248 (header-name . anything-c-source-etags-header-name)
5249 (init . anything-c-etags-init)
5250 (candidates-in-buffer)
5251 (mode-line . anything-etags-mode-line-string)
5252 (action . anything-c-etags-default-action)
5253 (persistent-action . (lambda (candidate)
5254 (anything-c-etags-default-action candidate)
5255 (anything-match-line-color-current-line))))
5256 "Anything source for Etags.")
5258 (defun anything-c-etags-default-action (candidate)
5259 "Anything default action to jump to an etags entry."
5260 (let* ((split (split-string candidate ": "))
5261 (fname (expand-file-name
5262 (car split) anything-c-etags-tag-file-dir))
5263 (elm (cadr split)))
5264 (find-file fname)
5265 (goto-char (point-min))
5266 (search-forward elm nil t)
5267 (goto-char (match-beginning 0))))
5269 (defun anything-c-etags-select (arg)
5270 "Preconfigured anything for etags.
5271 Called with one prefix arg use symbol at point as initial input.
5272 Called with two prefix arg reinitialize cache.
5273 If tag file have been modified reinitialize cache."
5274 (interactive "P")
5275 (let ((tag (anything-c-etags-get-tag-file))
5276 (init (and (equal arg '(4)) (thing-at-point 'symbol)))
5277 (anything-quit-if-no-candidate t)
5278 (anything-execute-action-at-once-if-one t))
5279 (when (or (equal arg '(16))
5280 (and anything-c-etags-mtime-alist
5281 (anything-c-etags-file-modified-p tag)))
5282 (remhash tag anything-c-etags-cache))
5283 (if (and tag (file-exists-p tag))
5284 (anything :sources 'anything-c-source-etags-select
5285 :keymap anything-c-etags-map
5286 :input init
5287 :buffer "*anything etags*")
5288 (message "Error: No tag file found, please create one with etags shell command."))))
5290 (defun anything-c-etags-mtime (file)
5291 "Last modification time of etags tag FILE."
5292 (cadr (nth 5 (file-attributes file))))
5294 (defun anything-c-etags-file-modified-p (file)
5295 "Check if tag FILE have been modified in this session.
5296 If FILE is nil return nil."
5297 (let ((last-modif (and file
5298 (assoc-default file anything-c-etags-mtime-alist))))
5299 (and last-modif
5300 (/= last-modif (anything-c-etags-mtime file)))))
5302 ;;; Recentf files
5305 (defvar anything-c-source-recentf
5306 '((name . "Recentf")
5307 (init . (lambda ()
5308 (require 'recentf)
5309 (or recentf-mode (recentf-mode 1))
5310 ;; Big value empowers anything/recentf
5311 (when (and (numberp recentf-max-saved-items)
5312 (<= recentf-max-saved-items 20))
5313 (setq recentf-max-saved-items 500))))
5314 (candidates . recentf-list)
5315 (match anything-c-match-on-file-name
5316 anything-c-match-on-directory-name)
5317 (type . file))
5318 "See (info \"(emacs)File Conveniences\").
5319 if `recentf-max-saved-items' is too small, set it to 500.")
5320 ;; (anything 'anything-c-source-recentf)
5322 ;;; ffap
5323 (eval-when-compile (require 'ffap))
5324 (defvar anything-c-source-ffap-guesser
5325 '((name . "File at point")
5326 (init . (lambda () (require 'ffap)))
5327 (candidates . (lambda ()
5328 (anything-aif
5329 (with-current-buffer anything-current-buffer
5330 (ffap-guesser))
5331 (list it))))
5332 (type . file)))
5333 ;; (anything 'anything-c-source-ffap-guesser)
5335 ;;; ffap with line number
5336 (defun anything-c-ffap-file-line-at-point ()
5337 "Get (FILENAME . LINENO) at point."
5338 (anything-aif (let (ffap-alist) (ffap-file-at-point))
5339 (save-excursion
5340 (beginning-of-line)
5341 (when (and (search-forward it nil t)
5342 (looking-at ":\\([0-9]+\\)"))
5343 (cons it (string-to-number (match-string 1)))))))
5345 (defvar anything-c-ffap-line-location nil
5346 "(FILENAME . LINENO) used by `anything-c-source-ffap-line'.
5347 It is cleared after jumping line.")
5349 (defun anything-c-ffap-line-candidates ()
5350 (with-current-buffer anything-current-buffer
5351 (setq anything-c-ffap-line-location (anything-c-ffap-file-line-at-point)))
5352 (when anything-c-ffap-line-location
5353 (destructuring-bind (file . line) anything-c-ffap-line-location
5354 (list (cons (format "%s (line %d)" file line) file)))))
5356 ;;; Goto line after opening file by `anything-c-source-ffap-line'.
5357 (defun anything-c-ffap-line-goto-line ()
5358 (when (car anything-c-ffap-line-location)
5359 (unwind-protect
5360 (ignore-errors
5361 (with-selected-window
5362 (get-buffer-window
5363 (get-file-buffer (car anything-c-ffap-line-location)))
5364 (anything-goto-line (cdr anything-c-ffap-line-location)))))))
5365 (add-hook 'anything-after-action-hook 'anything-c-ffap-line-goto-line)
5366 (add-hook 'anything-after-persistent-action-hook 'anything-c-ffap-line-goto-line)
5368 (defvar anything-c-source-ffap-line
5369 '((name . "File/Lineno at point")
5370 (init . (lambda () (require 'ffap)))
5371 (candidates . anything-c-ffap-line-candidates)
5372 (type . file)))
5373 ;; (anything 'anything-c-source-ffap-line)
5375 ;;; list of files gleaned from every dired buffer
5376 (defun anything-c-files-in-all-dired-candidates ()
5377 (save-excursion
5378 (mapcan
5379 (lambda (dir)
5380 (cond ((listp dir) ;filelist
5381 dir)
5382 ((equal "" (file-name-nondirectory dir)) ;dir
5383 (directory-files dir t))
5384 (t ;wildcard
5385 (file-expand-wildcards dir t))))
5386 (delq nil
5387 (mapcar (lambda (buf)
5388 (set-buffer buf)
5389 (when (eq major-mode 'dired-mode)
5390 (if (consp dired-directory)
5391 (cdr dired-directory) ;filelist
5392 dired-directory))) ;dir or wildcard
5393 (buffer-list))))))
5394 ;; (dired '("~/" "~/.emacs-custom.el" "~/.emacs.bmk"))
5396 (defvar anything-c-source-files-in-all-dired
5397 '((name . "Files in all dired buffer.")
5398 (candidates . anything-c-files-in-all-dired-candidates)
5399 (type . file)))
5400 ;; (anything 'anything-c-source-files-in-all-dired)
5402 (defvar anything-c-source-filelist
5403 '((name . "FileList")
5404 (grep-candidates . anything-c-filelist-file-name)
5405 (candidate-number-limit . 200)
5406 (requires-pattern . 4)
5407 (type . file))
5408 "Source to find files instantly.
5409 See `anything-c-filelist-file-name' docstring for usage.")
5411 ;;;###autoload
5412 (defun anything-filelist ()
5413 "Preconfigured `anything' to open files instantly.
5415 See `anything-c-filelist-file-name' docstring for usage."
5416 (interactive)
5417 (anything-other-buffer 'anything-c-source-filelist "*anything file list*"))
5419 ;;;###autoload
5420 (defun anything-filelist+ ()
5421 "Preconfigured `anything' to open files/buffers/bookmarks instantly.
5423 This is a replacement for `anything-for-files'.
5424 See `anything-c-filelist-file-name' docstring for usage."
5425 (interactive)
5426 (anything-other-buffer
5427 '(anything-c-source-ffap-line
5428 anything-c-source-ffap-guesser
5429 anything-c-source-buffers-list
5430 anything-c-source-recentf
5431 anything-c-source-bookmarks
5432 anything-c-source-file-cache
5433 anything-c-source-filelist)
5434 "*anything file list*"))
5437 ;;;; <info>
5438 ;;; Info pages
5439 (defvar anything-c-info-pages nil
5440 "All info pages on system.
5441 Will be calculated the first time you invoke anything with this
5442 source.")
5444 (defvar anything-c-source-info-pages
5445 `((name . "Info Pages")
5446 (candidates
5447 . (lambda ()
5448 (if anything-c-info-pages
5449 anything-c-info-pages
5450 (setq anything-c-info-pages
5451 (save-window-excursion
5452 (save-excursion
5453 (require 'info)
5454 (Info-find-node "dir" "top")
5455 (goto-char (point-min))
5456 (let ((info-topic-regexp "\\* +\\([^:]+: ([^)]+)[^.]*\\)\\.")
5457 topics)
5458 (while (re-search-forward info-topic-regexp nil t)
5459 (add-to-list 'topics (match-string-no-properties 1)))
5460 (goto-char (point-min))
5461 (Info-exit)
5462 topics)))))))
5463 (action . (("Show with Info" .(lambda (node-str)
5464 (info (replace-regexp-in-string
5465 "^[^:]+: " "" node-str))))))
5466 (requires-pattern . 2)))
5467 ;; (anything 'anything-c-source-info-pages)
5470 ;; FIXME should be merged in anything.el with `anything-describe-anything-attribute'.
5471 (defun anything-c-describe-attributes (anything-attribute)
5472 "Display the full documentation of ANYTHING-ATTRIBUTE (a symbol).
5473 Same as `anything-describe-anything-attribute' but with anything completion."
5474 (interactive (list (intern
5475 (anything-comp-read
5476 "Describe anything attribute: "
5477 (mapcar 'symbol-name anything-additional-attributes)
5478 :must-match t
5479 :persistent-action
5480 #'(lambda (candidate)
5481 (with-output-to-temp-buffer "*Help*"
5482 (princ (get (intern candidate) 'anything-attrdoc))))))))
5483 (with-output-to-temp-buffer "*Help*"
5484 (princ (get anything-attribute 'anything-attrdoc))))
5486 ;;; Use info-index plug-in.
5489 ;; Note that `name' attribute is not needed since
5490 ;; `anything-c-insert-summary' have been removed.
5491 ;; Info Elisp
5492 (defvar anything-c-source-info-elisp
5493 '((name . "Info index: elisp")
5494 (info-index . "elisp")))
5495 ;; (anything 'anything-c-source-info-elisp)
5497 ;; Info-Common-Lisp
5498 (defvar anything-c-source-info-cl
5499 '((name . "Info index: cl")
5500 (info-index . "cl")))
5501 ;; (anything 'anything-c-source-info-cl)
5503 ;; Info Index org
5504 (defvar anything-c-source-info-org
5505 '((name . "Info index: org")
5506 (info-index . "org")))
5507 ;; (anything 'anything-c-source-info-org)
5509 ;; Info Index gnus
5510 (defvar anything-c-source-info-gnus
5511 '((name . "Info index: Gnus")
5512 (info-index . "gnus")))
5514 ;; Info Index ratpoison
5515 (defvar anything-c-source-info-ratpoison
5516 '((name . "Info index: ratpoison")
5517 (info-index . "ratpoison")))
5518 ;; (anything 'anything-c-source-info-ratpoison)
5520 ;; Info Index zsh
5521 (defvar anything-c-source-info-zsh
5522 '((name . "Info index: zsh")
5523 (info-index . "zsh")))
5524 ;; (anything 'anything-c-source-info-zsh)
5526 ;; Info Index bash
5527 (defvar anything-c-source-info-bash
5528 '((name . "Info index: bash")
5529 (info-index . "bash")))
5530 ;; (anything 'anything-c-source-info-bash)
5532 ;; Info Index coreutils
5533 (defvar anything-c-source-info-coreutils
5534 '((name . "Info index: coreutils")
5535 (info-index . "coreutils")))
5536 ;; (anything 'anything-c-source-info-coreutils)
5538 ;; Info Index fileutils
5539 (defvar anything-c-source-info-fileutils
5540 '((name . "Info index: fileutils")
5541 (info-index . "fileutils")))
5542 ;; (anything 'anything-c-source-info-fileutils)
5544 ;; Info Index find
5545 (defvar anything-c-source-info-find
5546 '((name . "Info index: find")
5547 (info-index . "find")))
5548 ;; (anything 'anything-c-source-info-find)
5550 ;; Info Index sh-utils
5551 (defvar anything-c-source-info-sh-utils
5552 '((name . "Info index: sh-utils")
5553 (info-index . "sh-utils")))
5554 ;; (anything 'anything-c-source-info-sh-utils)
5556 ;; Info Index textutils
5557 (defvar anything-c-source-info-textutils
5558 '((name . "Info index: textutils")
5559 (info-index . "textutils")))
5560 ;; (anything 'anything-c-source-info-textutils)
5562 ;; Info Index libc
5563 (defvar anything-c-source-info-libc
5564 '((name . "Info index: libc")
5565 (info-index . "libc")))
5566 ;; (anything 'anything-c-source-info-libc)
5568 ;; Info Index make
5569 (defvar anything-c-source-info-make
5570 '((name . "Info index: make")
5571 (info-index . "make")))
5572 ;; (anything 'anything-c-source-info-make)
5574 ;; Info Index automake
5575 (defvar anything-c-source-info-automake
5576 '((name . "Info index: automake")
5577 (info-index . "automake")))
5578 ;; (anything 'anything-c-source-info-automake)
5580 ;; Info Index autoconf
5581 (defvar anything-c-source-info-autoconf
5582 '((name . "Info index: autoconf")
5583 (info-index . "autoconf")))
5584 ;; (anything 'anything-c-source-info-autoconf)
5586 ;; Info Index emacs-lisp-intro
5587 (defvar anything-c-source-info-emacs-lisp-intro
5588 '((name . "Info index: emacs-lisp-intro")
5589 (info-index . "emacs-lisp-intro")))
5590 ;; (anything 'anything-c-source-info-emacs-lisp-intro)
5592 ;; Info Index emacs
5593 (defvar anything-c-source-info-emacs
5594 '((name . "Info index: emacs")
5595 (info-index . "emacs")))
5596 ;; (anything 'anything-c-source-info-emacs)
5598 ;; Info Index elib
5599 (defvar anything-c-source-info-elib
5600 '((name . "Info index: elib")
5601 (info-index . "elib")))
5602 ;; (anything 'anything-c-source-info-elib)
5604 ;; Info Index eieio
5605 (defvar anything-c-source-info-eieio
5606 '((name . "Info index: eieio")
5607 (info-index . "eieio")))
5608 ;; (anything 'anything-c-source-info-eieio)
5610 ;; Info Index gauche-refe
5611 (defvar anything-c-source-info-gauche-refe
5612 '((name . "Info index: gauche")
5613 (info-index . "gauche-refe")))
5614 ;; (anything 'anything-c-source-info-gauche-refe)
5616 ;; Info Index guile
5617 (defvar anything-c-source-info-guile
5618 '((name . "Info index: guile")
5619 (info-index . "guile")))
5620 ;; (anything 'anything-c-source-info-guile)
5622 ;; Info Index guile-tut
5623 (defvar anything-c-source-info-guile-tut
5624 '((name . "Info index: guile-tut")
5625 (info-index . "guile-tut")))
5626 ;; (anything 'anything-c-source-info-guile-tut)
5628 ;; Info Index goops
5629 (defvar anything-c-source-info-goops
5630 '((name . "Info index: goops")
5631 (info-index . "goops")))
5632 ;; (anything 'anything-c-source-info-goops)
5634 ;; Info Index screen
5635 (defvar anything-c-source-info-screen
5636 '((name . "Info index: screen")
5637 (info-index . "screen")
5638 (index-nodes "Concept Index" "Command Index" "Keystroke Index")))
5639 ;; (anything 'anything-c-source-info-screen)
5641 ;; Info Index latex
5642 (defvar anything-c-source-info-latex
5643 '((name . "Info index: latex")
5644 (info-index . "latex")))
5645 ;; (anything 'anything-c-source-info-latex)
5647 ;; Info Index gawk
5648 (defvar anything-c-source-info-gawk
5649 '((name . "Info index: gawk")
5650 (info-index . "gawk")))
5651 ;; (anything 'anything-c-source-info-gawk)
5653 ;; Info Index sed
5654 (defvar anything-c-source-info-sed
5655 '((name . "Info index: sed")
5656 (info-index . "sed")))
5657 ;; (anything 'anything-c-source-info-sed)
5659 ;; Info Index m4
5660 (defvar anything-c-source-info-m4
5661 '((name . "Info index: m4")
5662 (info-index . "m4")))
5663 ;; (anything 'anything-c-source-info-m4)
5665 ;; Info Index wget
5666 (defvar anything-c-source-info-wget
5667 '((name . "Info index: wget")
5668 (info-index . "wget")))
5669 ;; (anything 'anything-c-source-info-wget)
5671 ;; Info Index binutils
5672 (defvar anything-c-source-info-binutils
5673 '((name . "Info index: binutils")
5674 (info-index . "binutils")))
5675 ;; (anything 'anything-c-source-info-binutils)
5677 ;; Info Index as
5678 (defvar anything-c-source-info-as
5679 '((name . "Info index: as")
5680 (info-index . "as")))
5681 ;; (anything 'anything-c-source-info-as)
5683 ;; Info Index bfd
5684 (defvar anything-c-source-info-bfd
5685 '((name . "Info index: bfd")
5686 (info-index . "bfd")))
5687 ;; (anything 'anything-c-source-info-bfd)
5689 ;; Info Index gprof
5690 (defvar anything-c-source-info-gprof
5691 '((name . "Info index: gprof")
5692 (info-index . "gprof")))
5693 ;; (anything 'anything-c-source-info-gprof)
5695 ;; Info Index ld
5696 (defvar anything-c-source-info-ld
5697 '((name . "Info index: ld")
5698 (info-index . "ld")))
5699 ;; (anything 'anything-c-source-info-ld)
5701 ;; Info Index diff
5702 (defvar anything-c-source-info-diff
5703 '((name . "Info index: diff")
5704 (info-index . "diff")))
5705 ;; (anything 'anything-c-source-info-diff)
5707 ;; Info Index flex
5708 (defvar anything-c-source-info-flex
5709 '((name . "Info index: flex")
5710 (info-index . "flex")))
5711 ;; (anything 'anything-c-source-info-flex)
5713 ;; Info Index grep
5714 (defvar anything-c-source-info-grep
5715 '((name . "Info index: grep")
5716 (info-index . "grep")))
5717 ;; (anything 'anything-c-source-info-grep)
5719 ;; Info Index gzip
5720 (defvar anything-c-source-info-gzip
5721 '((name . "Info index: gzip")
5722 (info-index . "gzip")))
5723 ;; (anything 'anything-c-source-info-gzip)
5725 ;; Info Index libtool
5726 (defvar anything-c-source-info-libtool
5727 '((name . "Info index: libtool")
5728 (info-index . "libtool")))
5729 ;; (anything 'anything-c-source-info-libtool)
5731 ;; Info Index texinfo
5732 (defvar anything-c-source-info-texinfo
5733 '((name . "Info index: texinfo")
5734 (info-index . "texinfo")))
5735 ;; (anything 'anything-c-source-info-texinfo)
5737 ;; Info Index info
5738 (defvar anything-c-source-info-info
5739 '((name . "Info index: info")
5740 (info-index . "info")))
5741 ;; (anything 'anything-c-source-info-info)
5743 ;; Info Index gdb
5744 (defvar anything-c-source-info-gdb
5745 '((name . "Info index: gdb")
5746 (info-index . "gdb")))
5747 ;; (anything 'anything-c-source-info-gdb)
5749 ;; Info Index stabs
5750 (defvar anything-c-source-info-stabs
5751 '((name . "Info index: stabs")
5752 (info-index . "stabs")))
5753 ;; (anything 'anything-c-source-info-stabs)
5755 ;; Info Index cvsbook
5756 (defvar anything-c-source-info-cvsbook
5757 '((name . "Info index: cvsbook")
5758 (info-index . "cvsbook")))
5759 ;; (anything 'anything-c-source-info-cvsbook)
5761 ;; Info Index cvs
5762 (defvar anything-c-source-info-cvs
5763 '((name . "Info index: cvs")
5764 (info-index . "cvs")))
5765 ;; (anything 'anything-c-source-info-cvs)
5767 ;; Info Index bison
5768 (defvar anything-c-source-info-bison
5769 '((name . "Info index: bison")
5770 (info-index . "bison")))
5771 ;; (anything 'anything-c-source-info-bison)
5773 ;; Info Index id-utils
5774 (defvar anything-c-source-info-id-utils
5775 '((name . "Info index: id-utils")
5776 (info-index . "id-utils")))
5777 ;; (anything 'anything-c-source-info-id-utils)
5779 ;; Info Index global
5780 (defvar anything-c-source-info-global
5781 '((name . "Info index: global")
5782 (info-index . "global")))
5783 ;; (anything 'anything-c-source-info-global)
5785 ;;;; <Help>
5786 ;;; Man Pages
5787 (defvar anything-c-man-pages nil
5788 "All man pages on system.
5789 Will be calculated the first time you invoke anything with this
5790 source.")
5792 (defun anything-c-man-default-action (candidate)
5793 "Default action for jumping to a woman or man page from anything."
5794 (let ((wfiles (woman-file-name-all-completions candidate)))
5795 (condition-case err
5796 (if (> (length wfiles) 1)
5797 (woman-find-file
5798 (anything-comp-read
5799 "ManFile: " wfiles :must-match t))
5800 (woman candidate))
5801 ;; If woman is unable to format correctly
5802 ;; use man instead.
5803 (error (kill-buffer) ; Kill woman buffer.
5804 (let ((Man-notify-method 'meek))
5805 (Man-getpage-in-background candidate))))))
5807 (defvar anything-c-source-man-pages
5808 `((name . "Manual Pages")
5809 (candidates . (lambda ()
5810 (if anything-c-man-pages
5811 anything-c-man-pages
5812 ;; XEmacs doesn't have a woman :)
5813 (setq anything-c-man-pages
5814 (ignore-errors
5815 (require 'woman)
5816 (woman-file-name "")
5817 (sort (mapcar 'car woman-topic-all-completions)
5818 'string-lessp))))))
5819 (action ("Show with Woman" . anything-c-man-default-action))
5820 ;; Woman does not work OS X
5821 ;; http://xahlee.org/emacs/modernization_man_page.html
5822 (action-transformer . (lambda (actions candidate)
5823 (if (eq system-type 'darwin)
5824 '(("Show with Man" . man))
5825 actions)))
5826 (requires-pattern . 2)))
5827 ;; (anything 'anything-c-source-man-pages)
5829 ;;;; <Command>
5830 ;;; Complex command history
5831 (defvar anything-c-source-complex-command-history
5832 '((name . "Complex Command History")
5833 (candidates . (lambda () (mapcar 'prin1-to-string command-history)))
5834 (type . sexp)))
5835 ;; (anything 'anything-c-source-complex-command-history)
5837 ;;; M-x history
5838 (defvar anything-c-source-extended-command-history
5839 '((name . "Emacs Commands History")
5840 (candidates . extended-command-history)
5841 (type . command)))
5842 ;; (anything 'anything-c-source-extended-command-history)
5844 ;;; Emacs commands
5845 (defvar anything-c-source-emacs-commands
5846 '((name . "Emacs Commands")
5847 (candidates . (lambda ()
5848 (let (commands)
5849 (mapatoms (lambda (a)
5850 (if (commandp a)
5851 (push (symbol-name a)
5852 commands))))
5853 (sort commands 'string-lessp))))
5854 (type . command)
5855 (requires-pattern . 2))
5856 "Source for completing and invoking Emacs commands.
5857 A command is a function with interactive spec that can
5858 be invoked with `M-x'.
5860 To get non-interactive functions listed, use
5861 `anything-c-source-emacs-functions'.")
5862 ;; (anything 'anything-c-source-emacs-commands)
5864 ;;; Anything M-x
5866 ;; Another replacement of `M-x' that act exactly like the
5867 ;; vanilla Emacs one, no problem of windows configuration, prefix args
5868 ;; can be passed before calling `M-x' (e.g C-u M-x..) but also during
5869 ;; anything invocation.
5870 ;;;###autoload
5871 (defun anything-M-x ()
5872 "Preconfigured `anything' for Emacs commands.
5873 It is `anything' replacement of regular `M-x' `execute-extended-command'."
5874 (interactive)
5875 (let* (in-help
5876 help-cand
5877 anything-persistent-action-use-special-display
5878 (history (loop with hist
5879 for i in extended-command-history
5880 for com = (intern i)
5881 when (and (fboundp com) (not (member i hist)))
5882 collect i into hist finally return hist))
5883 (command (anything-comp-read
5884 "M-x " obarray
5885 :test 'commandp
5886 :must-match t
5887 :requires-pattern 2
5888 :name "Emacs Commands"
5889 :persistent-action
5890 #'(lambda (candidate)
5891 (let ((hbuf (get-buffer (help-buffer))))
5892 (if (and in-help (string= candidate help-cand))
5893 (progn
5894 ;; When M-x is started from a help buffer,
5895 ;; Don't kill it as it is anything-current-buffer.
5896 (unless (equal hbuf anything-current-buffer)
5897 (kill-buffer hbuf))
5898 (setq in-help nil))
5899 ;; Be sure anything-current-buffer have not a dedicated window.
5900 (set-window-dedicated-p
5901 (get-buffer-window anything-current-buffer) nil)
5902 (describe-function (intern candidate))
5903 (message nil) ; Erase the new stupid message Type "q"[...]
5904 (setq in-help t))
5905 (setq help-cand candidate)))
5906 :persistent-help "Describe this command"
5907 :history history
5908 :sort 'string-lessp
5909 :fc-transformer 'anything-M-x-transformer)))
5910 (unless current-prefix-arg (setq current-prefix-arg anything-current-prefix-arg))
5911 (call-interactively (intern command))
5912 (setq extended-command-history (cons command (delete command history)))))
5914 (defun* anything-M-x-get-major-mode-command-alist (mode-map)
5915 "Return alist of MODE-MAP."
5916 (loop for key being the key-seqs of mode-map using (key-bindings com)
5917 for str-key = (key-description key)
5918 for ismenu = (string-match "<menu-bar>" str-key)
5919 unless ismenu collect (cons str-key com)))
5921 (defun anything-get-mode-map-from-mode (mode)
5922 "Guess the mode-map name according to MODE.
5923 Some modes don't use conventional mode-map name
5924 so we need to guess mode-map name. e.g python-mode ==> py-mode-map.
5925 Return nil if no mode-map found."
5926 (loop
5927 ;; Start with a conventional mode-map name.
5928 with mode-map = (intern-soft (format "%s-map" mode))
5929 with mode-string = (symbol-name mode)
5930 with mode-name = (replace-regexp-in-string "-mode" "" mode-string)
5931 while (not mode-map)
5932 for count downfrom (length mode-name)
5933 ;; Return when no result after parsing entire string.
5934 when (eq count 0) return nil
5935 for sub-name = (substring mode-name 0 count)
5936 do (setq mode-map (intern-soft (format "%s-map" (concat sub-name "-mode"))))
5937 finally return mode-map))
5939 (defun anything-M-x-current-mode-map-alist ()
5940 "Return mode-map alist of current `major-mode'."
5941 (let ((map (anything-get-mode-map-from-mode major-mode)))
5942 (when (and map (boundp map))
5943 (anything-M-x-get-major-mode-command-alist (symbol-value map)))))
5946 (defun anything-M-x-transformer (candidates sources)
5947 "filtered-candidate-transformer to show bindings in emacs commands.
5948 Show global bindings and local bindings according to current `major-mode'."
5949 (with-current-buffer anything-current-buffer
5950 (loop
5951 with local-map = (anything-M-x-current-mode-map-alist)
5952 for cand in candidates
5953 for local-key = (car (rassq cand local-map))
5954 for key = (substitute-command-keys (format "\\[%s]" cand))
5955 collect
5956 (cons (cond ((and (string-match "^M-x" key) local-key)
5957 (format "%s (%s)"
5958 cand (propertize
5959 local-key
5960 'face 'anything-M-x-key-face)))
5961 ((string-match "^M-x" key) cand)
5962 (t (format "%s (%s)"
5963 cand (propertize
5965 'face 'anything-M-x-key-face)))) cand))))
5967 ;;; LaCarte
5968 (defvar anything-c-source-lacarte
5969 '((name . "Lacarte")
5970 (init . (lambda () (require 'lacarte )))
5971 (candidates . (lambda () (delete '(nil) (lacarte-get-overall-menu-item-alist))))
5972 (candidate-number-limit . 9999)
5973 (action . anything-c-call-interactively))
5974 "Needs lacarte.el.
5976 http://www.emacswiki.org/cgi-bin/wiki/download/lacarte.el")
5977 ;; (anything 'anything-c-source-lacarte)
5979 ;;;; <Function>
5980 ;;; Emacs functions
5981 (defvar anything-c-source-emacs-functions
5982 '((name . "Emacs Functions")
5983 (candidates . (lambda ()
5984 (let (commands)
5985 (mapatoms (lambda (a)
5986 (if (functionp a)
5987 (push (symbol-name a) commands))))
5988 (sort commands 'string-lessp))))
5989 (type . function)
5990 (requires-pattern . 2))
5991 "Source for completing Emacs functions.")
5992 ;; (anything 'anything-c-source-emacs-functions)
5994 ;;; With abbrev expansion
5995 ;;; Similar to my exec-abbrev-cmd.el
5996 ;;; See http://www.tsdh.de/cgi-bin/wiki.pl/exec-abbrev-cmd.el
5997 (defvar anything-c-function-abbrev-regexp nil
5998 "The regexp for `anything-c-source-emacs-functions-with-abbrevs'.
5999 Regexp built from the current `anything-pattern' interpreting it
6000 as abbreviation.
6001 Only for internal use.")
6003 (defun anything-c-match-function-by-abbrev (candidate)
6004 "Return non-nil if `anything-pattern' is an abbreviation of the function CANDIDATE.
6006 Abbreviations are made by taking the first character from each
6007 word in the function's name, e.g. \"bb\" is an abbrev for
6008 `bury-buffer', \"stb\" is an abbrev for `anything-c-switch-to-buffer'."
6009 (string-match anything-c-function-abbrev-regexp candidate))
6011 (defvar anything-c-source-emacs-functions-with-abbrevs
6012 (append anything-c-source-emacs-functions
6013 '((match anything-c-match-function-by-abbrev
6014 anything-c-string-match))
6015 '((init
6016 . (lambda ()
6017 (defadvice anything-update
6018 (before anything-c-update-function-abbrev-regexp activate)
6019 (let ((char-list (append anything-pattern nil))
6020 (str "^"))
6021 (dolist (c char-list)
6022 (setq str (concat str (list c) "[^-]*-")))
6023 (setq str (concat (substring str 0 (1- (length str))) "$"))
6024 (setq anything-c-function-abbrev-regexp str))))))))
6025 ;; (anything 'anything-c-source-emacs-functions-with-abbrevs)
6027 (defvar anything-c-source-advice
6028 '((name . "Function Advice")
6029 (candidates . anything-c-advice-candidates)
6030 (action ("Toggle Enable/Disable" . anything-c-advice-toggle))
6031 ;; (real-to-display . anything-c-advice-real-to-display)
6032 (persistent-action . anything-c-advice-persistent-action)
6033 (persistent-help . "Describe function / C-u C-z: Toggle advice")))
6034 ;; (anything 'anything-c-source-advice)
6035 ;; (let ((debug-on-signal t))(anything 'anything-c-source-advice))
6036 ;; (testadvice)
6038 (defun anything-c-advice-candidates ()
6039 (require 'advice)
6040 (loop for (fname) in ad-advised-functions
6041 for function = (intern fname)
6042 append
6043 (loop for class in ad-advice-classes append
6044 (loop for advice in (ad-get-advice-info-field function class)
6045 for enabled = (ad-advice-enabled advice)
6046 collect
6047 (cons (format
6048 "%s %s %s"
6049 (if enabled "Enabled " "Disabled")
6050 (propertize fname 'face 'font-lock-function-name-face)
6051 (ad-make-single-advice-docstring advice class nil))
6052 (list function class advice))))))
6054 (defun anything-c-advice-persistent-action (func-class-advice)
6055 (if current-prefix-arg
6056 (anything-c-advice-toggle func-class-advice)
6057 (describe-function (car func-class-advice))))
6059 (defun anything-c-advice-toggle (func-class-advice)
6060 (destructuring-bind (function class advice) func-class-advice
6061 (cond ((ad-advice-enabled advice)
6062 (ad-advice-set-enabled advice nil)
6063 (message "Disabled"))
6064 (t ;disabled
6065 (ad-advice-set-enabled advice t)
6066 (message "Enabled")))
6067 (ad-activate function)
6068 (and anything-in-persistent-action
6069 (anything-c-advice-update-current-display-string))))
6071 (defun anything-c-advice-update-current-display-string ()
6072 (anything-edit-current-selection
6073 (let ((newword (cond ((looking-at "Disabled") "Enabled")
6074 ((looking-at "Enabled") "Disabled")))
6075 realvalue)
6076 (when newword
6077 (delete-region (point) (progn (forward-word 1) (point)))
6078 (insert newword)))))
6080 ;;;###autoload
6081 (defun anything-manage-advice ()
6082 "Preconfigured `anything' to disable/enable function advices."
6083 (interactive)
6084 (anything-other-buffer 'anything-c-source-advice "*anything advice*"))
6086 ;;;; <Variable>
6087 ;;; Emacs variables
6088 (defvar anything-c-source-emacs-variables
6089 '((name . "Emacs Variables")
6090 (candidates . (lambda ()
6091 (sort (all-completions "" obarray 'boundp) 'string-lessp)))
6092 (type . variable)
6093 (requires-pattern . 2))
6094 "Source for completing Emacs variables.")
6095 ;; (anything 'anything-c-source-emacs-variables)
6097 ;;;; <Bookmark>
6098 ;;; Bookmarks
6099 (eval-when-compile (require 'bookmark))
6100 (defvar anything-c-source-bookmarks
6101 '((name . "Bookmarks")
6102 (init . (lambda ()
6103 (require 'bookmark)))
6104 (candidates . bookmark-all-names)
6105 (type . bookmark))
6106 "See (info \"(emacs)Bookmarks\").")
6107 ;; (anything 'anything-c-source-bookmarks)
6109 ;;; bookmark-set
6110 (defvar anything-c-source-bookmark-set
6111 '((name . "Set Bookmark")
6112 (dummy)
6113 (action . bookmark-set))
6114 "See (info \"(emacs)Bookmarks\").")
6115 ;; (anything 'anything-c-source-bookmark-set)
6117 ;;; Visible Bookmarks
6118 ;; (install-elisp "http://cvs.savannah.gnu.org/viewvc/*checkout*/bm/bm/bm.el")
6121 ;; http://d.hatena.ne.jp/grandVin/20080911/1221114327
6122 (defvar anything-c-source-bm
6123 '((name . "Visible Bookmarks")
6124 (init . anything-c-bm-init)
6125 (candidates-in-buffer)
6126 (type . line))
6127 "Needs bm.el.
6129 http://www.nongnu.org/bm/")
6131 (defun anything-c-bm-init ()
6132 "Init function for `anything-c-source-bm'."
6133 (when (require 'bm nil t)
6134 (with-no-warnings
6135 (let ((bookmarks (bm-lists))
6136 (buf (anything-candidate-buffer 'global)))
6137 (dolist (bm (sort* (append (car bookmarks) (cdr bookmarks))
6138 '< :key 'overlay-start))
6139 (let ((start (overlay-start bm))
6140 (end (overlay-end bm))
6141 (annotation (or (overlay-get bm 'annotation) "")))
6142 (unless (< (- end start) 1) ; org => (if (< (- end start) 2)
6143 (let ((str (format "%5d: [%s]: %s\n"
6144 (line-number-at-pos start)
6145 annotation
6146 (buffer-substring start (1- end)))))
6147 (with-current-buffer buf (insert str))))))))))
6149 ;;; Special bookmarks
6150 (defvar anything-c-source-bookmarks-ssh
6151 '((name . "Bookmarks-ssh")
6152 (init . (lambda ()
6153 (require 'bookmark)))
6154 (candidates . (lambda () (anything-c-collect-bookmarks :ssh t)))
6155 (type . bookmark))
6156 "See (info \"(emacs)Bookmarks\").")
6157 ;; (anything 'anything-c-source-bookmarks-ssh)
6159 (defvar anything-c-source-bookmarks-su
6160 '((name . "Bookmarks-root")
6161 (init . (lambda ()
6162 (require 'bookmark)))
6163 (candidates . (lambda () (anything-c-collect-bookmarks :su t)))
6164 (filtered-candidate-transformer anything-c-highlight-bookmark-su)
6166 (type . bookmark))
6167 "See (info \"(emacs)Bookmarks\").")
6168 ;; (anything 'anything-c-source-bookmarks-su)
6170 (defvar anything-c-source-bookmarks-local
6171 '((name . "Bookmarks-Local")
6172 (init . (lambda ()
6173 (require 'bookmark)))
6174 (candidates . (lambda () (anything-c-collect-bookmarks :local t)))
6175 (filtered-candidate-transformer
6176 anything-c-adaptive-sort
6177 anything-c-highlight-bookmark)
6178 (type . bookmark))
6179 "See (info \"(emacs)Bookmarks\").")
6180 ;; (anything 'anything-c-source-bookmarks-local)
6182 (defun* anything-c-collect-bookmarks (&key local su sudo ssh)
6183 (let* ((lis-all (bookmark-all-names))
6184 (lis-loc (cond (local (loop for i in lis-all
6185 unless (string-match "^(ssh)\\|^(su)" i)
6186 collect i))
6187 (su (loop for i in lis-all
6188 when (string-match "^(su)" i)
6189 collect i))
6190 (sudo (loop for i in lis-all
6191 when (string-match "^(sudo)" i)
6192 collect i))
6193 (ssh (loop for i in lis-all
6194 when (string-match "^(ssh)" i)
6195 collect i)))))
6196 (sort lis-loc 'string-lessp)))
6198 (defun anything-c-bookmark-root-logged-p ()
6199 (catch 'break
6200 (dolist (i (mapcar #'buffer-name (buffer-list)))
6201 (when (string-match (format "*tramp/%s ." anything-su-or-sudo) i)
6202 (throw 'break t)))))
6204 (defun anything-c-highlight-bookmark-su (files source)
6205 (if (anything-c-bookmark-root-logged-p)
6206 (anything-c-highlight-bookmark files source)
6207 (anything-c-highlight-not-logged files source)))
6209 (defun anything-c-highlight-not-logged (files source)
6210 (loop for i in files
6211 collect (propertize i 'face anything-c-bookmarks-face3)))
6213 (defun anything-c-highlight-bookmark (bookmarks source)
6214 "Used as `candidate-transformer' to colorize bookmarks.
6215 Work both with standard Emacs bookmarks and bookmark-extensions.el."
6216 (loop for i in bookmarks
6217 for isfile = (bookmark-get-filename i)
6218 for bufp = (and (fboundp 'bmkext-get-buffer-name)
6219 (bmkext-get-buffer-name i))
6220 for handlerp = (and (fboundp 'bookmark-get-handler)
6221 (bookmark-get-handler i))
6222 for isw3m = (and (fboundp 'bmkext-w3m-bookmark-p)
6223 (bmkext-w3m-bookmark-p i))
6224 for isgnus = (and (fboundp 'bmkext-gnus-bookmark-p)
6225 (bmkext-gnus-bookmark-p i))
6226 for isman = (and (fboundp 'bmkext-man-bookmark-p) ; Man
6227 (bmkext-man-bookmark-p i))
6228 for iswoman = (and (fboundp 'bmkext-woman-bookmark-p) ; Woman
6229 (bmkext-woman-bookmark-p i))
6230 for handlerp = (bookmark-get-handler i)
6231 for isannotation = (bookmark-get-annotation i)
6232 for isabook = (string= (bookmark-prop-get i 'type) "addressbook")
6233 for isinfo = (eq handlerp 'Info-bookmark-jump)
6234 ;; Add a * if bookmark have annotation
6235 if (and isannotation (not (string-equal isannotation "")))
6236 do (setq i (concat "*" i))
6237 collect (cond (;; info buffers
6238 isinfo
6239 (propertize i 'face 'anything-bmkext-info 'help-echo isfile))
6240 (;; w3m buffers
6241 isw3m
6242 (propertize i 'face 'anything-bmkext-w3m 'help-echo isfile))
6243 (;; gnus buffers
6244 isgnus
6245 (propertize i 'face 'anything-bmkext-gnus 'help-echo isfile))
6246 (;; Man Woman
6247 (or iswoman isman)
6248 (propertize i 'face 'anything-bmkext-man 'help-echo isfile))
6249 (;; Addressbook
6250 isabook
6251 (propertize i 'face '((:foreground "Tomato"))))
6252 (;; directories
6253 (and isfile (file-directory-p isfile))
6254 (propertize i 'face anything-c-bookmarks-face1 'help-echo isfile))
6255 (;; regular files
6257 (propertize i 'face 'anything-bmkext-file 'help-echo isfile)))))
6259 ;; Bind some faces for bookmarks.
6260 (defvar anything-c-bookmarks-face1 'anything-ff-directory)
6261 (defvar anything-c-bookmarks-face2 'anything-ff-file)
6262 (defvar anything-c-bookmarks-face3 'anything-bookmarks-su-face)
6264 ;;; Sources to filter bookmark-extensions bookmarks.
6267 ;; Dependency: http://mercurial.intuxication.org/hg/emacs-bookmark-extension
6268 ;; If you want to enable google-maps in addressbook you will need
6269 ;; Julien Danjou google-maps-el package available here:
6270 ;; http://julien.danjou.info/google-maps-el.html
6272 (defun anything-c-bmkext-filter-setup-alist (fn &rest args)
6273 "Return a filtered `bookmark-alist' sorted alphabetically."
6274 (loop
6275 with alist = (if args
6276 (apply #'(lambda (x) (funcall fn x)) args)
6277 (funcall fn))
6278 for i in alist
6279 for b = (car i)
6280 collect b into sa
6281 finally return (sort sa 'string-lessp)))
6283 ;;; Addressbook.
6286 (defvar anything-c-source-bmkext-addressbook
6287 '((name . "Bookmark Addressbook")
6288 (init . (lambda ()
6289 (require 'bookmark-extensions)
6290 (bookmark-maybe-load-default-file)))
6291 (candidates . anything-c-bmkext-addressbook-setup-alist)
6292 (persistent-action
6293 . (lambda (candidate)
6294 (let ((bmk (anything-bookmark-get-bookmark-from-name
6295 candidate)))
6296 (bookmark--jump-via bmk 'pop-to-buffer))))
6297 (persistent-help . "Show contact - Prefix with C-u to append")
6298 (filtered-candidate-transformer
6299 anything-c-adaptive-sort
6300 anything-c-highlight-bookmark)
6301 (action . (("Show Contact(s)"
6302 . (lambda (candidate)
6303 (let* ((contacts (anything-marked-candidates))
6304 (current-prefix-arg (or anything-current-prefix-arg
6305 (> (length contacts) 1))))
6306 (bookmark-jump
6307 (anything-bookmark-get-bookmark-from-name (car contacts)))
6308 (anything-aif (cdr contacts)
6309 (loop for bmk in it do
6310 (bookmark-jump
6311 (anything-bookmark-get-bookmark-from-name bmk)))))))
6312 ("Send Mail"
6313 . (lambda (candidate)
6314 (let* ((contacts (anything-marked-candidates))
6315 (bmk (anything-bookmark-get-bookmark-from-name
6316 (car contacts)))
6317 (append (message-buffers)))
6318 (if append
6319 (addressbook-set-mail-buffer1 bmk 'append)
6320 (addressbook-set-mail-buffer1 bmk))
6321 (setq contacts (cdr contacts))
6322 (when contacts
6323 (loop for bmk in contacts do
6324 (addressbook-set-mail-buffer1 bmk 'append))))))
6325 ("Edit Bookmark"
6326 . (lambda (candidate)
6327 (let ((bmk (anything-bookmark-get-bookmark-from-name
6328 candidate)))
6329 (addressbook-bookmark-edit
6330 (assoc bmk bookmark-alist)))))
6331 ("Insert Email at point"
6332 . (lambda (candidate)
6333 (let* ((bmk (anything-bookmark-get-bookmark-from-name
6334 candidate))
6335 (mlist (split-string
6336 (assoc-default
6337 'email (assoc bmk bookmark-alist))
6338 ", ")))
6339 (insert
6340 (if (> (length mlist) 1)
6341 (anything-comp-read
6342 "Insert Mail Address: " mlist :must-match t)
6343 (car mlist))))))
6344 ("Show annotation"
6345 . (lambda (candidate)
6346 (let ((bmk (anything-bookmark-get-bookmark-from-name
6347 candidate)))
6348 (bookmark-show-annotation bmk))))
6349 ("Edit annotation"
6350 . (lambda (candidate)
6351 (let ((bmk (anything-bookmark-get-bookmark-from-name
6352 candidate)))
6353 (bookmark-edit-annotation bmk))))
6354 ("Show Google map"
6355 . (lambda (candidate)
6356 (let* ((bmk (anything-bookmark-get-bookmark-from-name
6357 candidate))
6358 (full-bmk (assoc bmk bookmark-alist)))
6359 (addressbook-google-map full-bmk))))))))
6362 (defun anything-c-bmkext-addressbook-setup-alist ()
6363 "Specialized filter function for bookmarks w3m."
6364 (anything-c-bmkext-filter-setup-alist 'bmkext-addressbook-alist-only))
6366 ;; W3m bookmarks from bookmark-extensions.
6367 (defvar anything-c-source-bookmark-w3m
6368 '((name . "Bookmark W3m")
6369 (init . (lambda ()
6370 (require 'bookmark-extensions)
6371 (bookmark-maybe-load-default-file)))
6372 (candidates . anything-c-bookmark-w3m-setup-alist)
6373 (filtered-candidate-transformer
6374 anything-c-adaptive-sort
6375 anything-c-highlight-bookmark)
6376 (type . bookmark)))
6377 ;; (anything 'anything-c-source-bookmark-w3m)
6379 (defun anything-c-bookmark-w3m-setup-alist ()
6380 "Specialized filter function for bookmarks w3m."
6381 (anything-c-bmkext-filter-setup-alist 'bmkext-w3m-alist-only))
6383 ;; Images
6384 (defvar anything-c-source-bookmark-images
6385 '((name . "Bookmark Images")
6386 (init . (lambda ()
6387 (require 'bookmark-extensions)
6388 (bookmark-maybe-load-default-file)))
6389 (candidates . anything-c-bookmark-images-setup-alist)
6390 (filtered-candidate-transformer
6391 anything-c-adaptive-sort
6392 anything-c-highlight-bookmark)
6393 (type . bookmark)))
6394 ;; (anything 'anything-c-source-bookmark-images)
6396 (defun anything-c-bookmark-images-setup-alist ()
6397 "Specialized filter function for images bookmarks."
6398 (anything-c-bmkext-filter-setup-alist 'bmkext-image-file-alist-only))
6400 ;; Woman Man
6401 (defvar anything-c-source-bookmark-man
6402 '((name . "Bookmark Woman&Man")
6403 (init . (lambda ()
6404 (require 'bookmark-extensions)
6405 (bookmark-maybe-load-default-file)))
6406 (candidates . anything-c-bookmark-man-setup-alist)
6407 (filtered-candidate-transformer
6408 anything-c-adaptive-sort
6409 anything-c-highlight-bookmark)
6410 (type . bookmark)))
6411 ;; (anything 'anything-c-source-bookmark-man)
6413 (defun anything-c-bookmark-man-setup-alist ()
6414 "Specialized filter function for bookmarks w3m."
6415 (append (anything-c-bmkext-filter-setup-alist 'bmkext-man-alist-only)
6416 (anything-c-bmkext-filter-setup-alist 'bmkext-woman-alist-only)))
6418 ;; Gnus
6419 (defvar anything-c-source-bookmark-gnus
6420 '((name . "Bookmark Gnus")
6421 (init . (lambda ()
6422 (require 'bookmark-extensions)
6423 (bookmark-maybe-load-default-file)))
6424 (candidates . anything-c-bookmark-gnus-setup-alist)
6425 (filtered-candidate-transformer
6426 anything-c-adaptive-sort
6427 anything-c-highlight-bookmark)
6428 (type . bookmark)))
6429 ;; (anything 'anything-c-source-bookmark-gnus)
6431 (defun anything-c-bookmark-gnus-setup-alist ()
6432 "Specialized filter function for bookmarks gnus."
6433 (anything-c-bmkext-filter-setup-alist 'bmkext-gnus-alist-only))
6435 ;; Info
6436 (defvar anything-c-source-bookmark-info
6437 '((name . "Bookmark Info")
6438 (init . (lambda ()
6439 (require 'bookmark-extensions)
6440 (bookmark-maybe-load-default-file)))
6441 (candidates . anything-c-bookmark-info-setup-alist)
6442 (filtered-candidate-transformer
6443 anything-c-adaptive-sort
6444 anything-c-highlight-bookmark)
6445 (type . bookmark)))
6446 ;; (anything 'anything-c-source-bookmark-info)
6448 (defun anything-c-bookmark-info-setup-alist ()
6449 "Specialized filter function for bookmarks info."
6450 (anything-c-bmkext-filter-setup-alist 'bmkext-info-alist-only))
6452 ;; Local Files&directories
6453 (defvar anything-c-source-bookmark-files&dirs
6454 '((name . "Bookmark Files&Directories")
6455 (init . (lambda ()
6456 (require 'bookmark-extensions)
6457 (bookmark-maybe-load-default-file)))
6458 (candidates . anything-c-bookmark-local-files-setup-alist)
6459 (filtered-candidate-transformer
6460 anything-c-adaptive-sort
6461 anything-c-highlight-bookmark)
6462 (type . bookmark)))
6463 ;; (anything 'anything-c-source-bookmark-files&dirs)
6465 (defun anything-c-bookmark-local-files-setup-alist ()
6466 "Specialized filter function for bookmarks locals files."
6467 (anything-c-bmkext-filter-setup-alist 'bmkext-local-file-alist-only))
6469 ;; Su Files&directories
6470 (defvar anything-c-source-bookmark-su-files&dirs
6471 '((name . "Bookmark Root-Files&Directories")
6472 (init . (lambda ()
6473 (require 'bookmark-extensions)
6474 (bookmark-maybe-load-default-file)))
6475 (candidates . anything-c-bookmark-su-files-setup-alist)
6476 (filtered-candidate-transformer
6477 anything-c-adaptive-sort
6478 anything-c-highlight-bookmark-su)
6479 (type . bookmark)))
6480 ;; (anything 'anything-c-source-bookmark-su-files&dirs)
6482 (defun anything-c-bookmark-su-files-setup-alist ()
6483 "Specialized filter function for bookmarks su/sudo files."
6484 (loop
6485 with l = (anything-c-bmkext-filter-setup-alist 'bmkext-remote-file-alist-only)
6486 for i in l
6487 for isfile = (bookmark-get-filename i)
6488 for istramp = (and isfile (boundp 'tramp-file-name-regexp)
6489 (save-match-data
6490 (string-match tramp-file-name-regexp isfile)))
6491 for issu = (and istramp
6492 (string-match bmkext-su-or-sudo-regexp isfile))
6493 if issu
6494 collect i))
6496 ;; Ssh Files&directories
6497 (defvar anything-c-source-bookmark-ssh-files&dirs
6498 '((name . "Bookmark Ssh-Files&Directories")
6499 (init . (lambda ()
6500 (require 'bookmark-extensions)
6501 (bookmark-maybe-load-default-file)))
6502 (candidates . anything-c-bookmark-ssh-files-setup-alist)
6503 (filtered-candidate-transformer . anything-c-adaptive-sort)
6504 (type . bookmark)))
6505 ;; (anything 'anything-c-source-bookmark-ssh-files&dirs)
6507 (defun anything-c-bookmark-ssh-files-setup-alist ()
6508 "Specialized filter function for bookmarks ssh files."
6509 (loop
6510 with l = (anything-c-bmkext-filter-setup-alist 'bmkext-remote-file-alist-only)
6511 for i in l
6512 for isfile = (bookmark-get-filename i)
6513 for istramp = (and isfile (boundp 'tramp-file-name-regexp)
6514 (save-match-data
6515 (string-match tramp-file-name-regexp isfile)))
6516 for isssh = (and istramp
6517 (string-match "/ssh:" isfile))
6518 if isssh
6519 collect i))
6522 ;; All bookmark-extensions sources.
6523 ;;;###autoload
6524 (defun anything-bookmark-ext ()
6525 "Preconfigured `anything' for bookmark-extensions sources.
6526 Needs bookmark-ext.el:
6527 <http://mercurial.intuxication.org/hg/emacs-bookmark-extension>.
6528 Contain also `anything-c-source-google-suggest'."
6529 (interactive)
6530 (anything
6531 :sources
6532 '(anything-c-source-bookmark-files&dirs
6533 anything-c-source-bookmark-w3m
6534 anything-c-source-google-suggest
6535 anything-c-source-bmkext-addressbook
6536 anything-c-source-bookmark-gnus
6537 anything-c-source-bookmark-info
6538 anything-c-source-bookmark-man
6539 anything-c-source-bookmark-images
6540 anything-c-source-bookmark-su-files&dirs
6541 anything-c-source-bookmark-ssh-files&dirs)
6542 :prompt "SearchBookmark: "
6543 :buffer "*anything bmkext*"))
6546 ;;; Firefox bookmarks
6549 ;; You will have to set firefox to import bookmarks in his html file bookmarks.html.
6550 ;; (only for firefox versions >=3)
6551 ;; To achieve that, open about:config in firefox and double click on this line to enable value
6552 ;; to true:
6553 ;; user_pref("browser.bookmarks.autoExportHTML", false);
6554 ;; You should have now:
6555 ;; user_pref("browser.bookmarks.autoExportHTML", true);
6557 (defvar anything-firefox-bookmark-url-regexp "\\(https\\|http\\|ftp\\|about\\|file\\)://[^ \"]*")
6558 (defvar anything-firefox-bookmarks-regexp ">\\([^><]+.[^</a>]\\)")
6560 (defun anything-get-firefox-user-init-dir ()
6561 "Guess the default Firefox user directory name."
6562 (let* ((moz-dir (concat (getenv "HOME") "/.mozilla/firefox/"))
6563 (moz-user-dir
6564 (with-current-buffer (find-file-noselect (concat moz-dir "profiles.ini"))
6565 (goto-char (point-min))
6566 (prog1
6567 (when (search-forward "Path=" nil t)
6568 (buffer-substring-no-properties (point) (point-at-eol)))
6569 (kill-buffer)))))
6570 (file-name-as-directory (concat moz-dir moz-user-dir))))
6572 (defun anything-guess-firefox-bookmark-file ()
6573 "Return the path of the Firefox bookmarks file."
6574 (concat (anything-get-firefox-user-init-dir) "bookmarks.html"))
6576 (defun anything-html-bookmarks-to-alist (file url-regexp bmk-regexp)
6577 "Parse html bookmark FILE and return an alist with (title . url) as elements."
6578 (let (bookmarks-alist url title)
6579 (with-temp-buffer
6580 (insert-file-contents file)
6581 (goto-char (point-min))
6582 (while (re-search-forward "href=\\|^ *<DT><A HREF=" nil t)
6583 (forward-line 0)
6584 (when (re-search-forward url-regexp nil t)
6585 (setq url (match-string 0)))
6586 (when (re-search-forward bmk-regexp nil t)
6587 (setq title (match-string 1)))
6588 (push (cons title url) bookmarks-alist)
6589 (forward-line)))
6590 (nreverse bookmarks-alist)))
6592 (defvar anything-c-firefox-bookmarks-alist nil)
6593 (defvar anything-c-source-firefox-bookmarks
6594 '((name . "Firefox Bookmarks")
6595 (init . (lambda ()
6596 (setq anything-c-firefox-bookmarks-alist
6597 (anything-html-bookmarks-to-alist
6598 (anything-guess-firefox-bookmark-file)
6599 anything-firefox-bookmark-url-regexp
6600 anything-firefox-bookmarks-regexp))))
6601 (candidates . (lambda ()
6602 (mapcar #'car anything-c-firefox-bookmarks-alist)))
6603 (filtered-candidate-transformer
6604 anything-c-adaptive-sort
6605 anything-c-highlight-firefox-bookmarks)
6606 (action . (("Browse Url Firefox"
6607 . (lambda (candidate)
6608 (browse-url-firefox
6609 (anything-c-firefox-bookmarks-get-value candidate))))
6610 ("Browse Url w3m"
6611 . (lambda (candidate)
6612 (w3m-browse-url
6613 (anything-c-firefox-bookmarks-get-value candidate))))
6614 ("Copy Url"
6615 . (lambda (elm)
6616 (kill-new (anything-c-w3m-bookmarks-get-value elm))))))))
6618 ;; (anything 'anything-c-source-firefox-bookmarks)
6620 (defun anything-c-firefox-bookmarks-get-value (elm)
6621 (assoc-default elm anything-c-firefox-bookmarks-alist))
6623 (defun anything-c-highlight-firefox-bookmarks (bookmarks source)
6624 (loop for i in bookmarks
6625 collect (propertize
6626 i 'face '((:foreground "YellowGreen"))
6627 'help-echo (anything-c-firefox-bookmarks-get-value i))))
6629 ;;; W3m bookmark - anything interface.
6632 ;; Some users have the emacs-w3m library in load-path
6633 ;; without having the w3m executable :-;
6634 ;; So check if w3m program is present before trying to load
6635 ;; emacs-w3m.
6636 (eval-when-compile
6637 (when (executable-find "w3m")
6638 (require 'w3m-bookmark nil t)))
6640 (defvar w3m-bookmark-file "~/.w3m/bookmark.html")
6641 (defvar anything-w3m-bookmarks-regexp ">\\([^><]+.[^</a>]\\)")
6642 (defvar anything-w3m-bookmark-url-regexp "\\(https\\|http\\|ftp\\|file\\)://[^>]*")
6643 (defvar anything-c-w3m-bookmarks-alist nil)
6644 (defvar anything-c-source-w3m-bookmarks
6645 '((name . "W3m Bookmarks")
6646 (init . (lambda ()
6647 (setq anything-c-w3m-bookmarks-alist
6648 (anything-html-bookmarks-to-alist
6649 w3m-bookmark-file
6650 anything-w3m-bookmark-url-regexp
6651 anything-w3m-bookmarks-regexp))))
6652 (candidates . (lambda ()
6653 (mapcar #'car anything-c-w3m-bookmarks-alist)))
6654 (filtered-candidate-transformer
6655 anything-c-adaptive-sort
6656 anything-c-highlight-w3m-bookmarks)
6657 (action . (("Browse Url"
6658 . (lambda (candidate)
6659 (anything-c-w3m-browse-bookmark candidate)))
6660 ("Copy Url"
6661 . (lambda (elm)
6662 (kill-new (anything-c-w3m-bookmarks-get-value elm))))
6663 ("Browse Url Firefox"
6664 . (lambda (candidate)
6665 (anything-c-w3m-browse-bookmark candidate t)))
6666 ("Delete Bookmark"
6667 . (lambda (candidate)
6668 (anything-c-w3m-delete-bookmark candidate)))
6669 ("Rename Bookmark"
6670 . (lambda (candidate)
6671 (anything-c-w3m-rename-bookmark candidate)))))
6672 (persistent-action . (lambda (candidate)
6673 (if current-prefix-arg
6674 (anything-c-w3m-browse-bookmark candidate t)
6675 (anything-c-w3m-browse-bookmark candidate nil t))))
6676 (persistent-help . "Open URL with emacs-w3m in new tab / \
6677 C-u \\[anything-execute-persistent-action]: Open URL with Firefox"))
6678 "Needs w3m and emacs-w3m.
6680 http://w3m.sourceforge.net/
6681 http://emacs-w3m.namazu.org/")
6683 ;; (anything 'anything-c-source-w3m-bookmarks)
6685 (defun anything-c-w3m-bookmarks-get-value (elm)
6686 (replace-regexp-in-string
6687 "\"" "" (cdr (assoc elm anything-c-w3m-bookmarks-alist))))
6689 (defun anything-c-w3m-browse-bookmark (elm &optional use-firefox new-tab)
6690 (let* ((fn (if use-firefox 'browse-url-firefox 'w3m-browse-url))
6691 (arg (and (eq fn 'w3m-browse-url) new-tab)))
6692 (funcall fn (anything-c-w3m-bookmarks-get-value elm) arg)))
6694 (defun anything-c-highlight-w3m-bookmarks (bookmarks source)
6695 (loop for i in bookmarks
6696 collect (propertize
6697 i 'face 'anything-w3m-bookmarks-face
6698 'help-echo (anything-c-w3m-bookmarks-get-value i))))
6701 (defun anything-c-w3m-delete-bookmark (elm)
6702 "Delete w3m bookmark from `w3m-bookmark-file'."
6703 (with-current-buffer
6704 (find-file-literally w3m-bookmark-file)
6705 (goto-char (point-min))
6706 (when (re-search-forward elm nil t)
6707 (beginning-of-line)
6708 (delete-region (point)
6709 (line-end-position))
6710 (delete-blank-lines))
6711 (save-buffer)
6712 (kill-buffer)))
6714 (defun anything-c-w3m-rename-bookmark (elm)
6715 "Rename w3m bookmark in `w3m-bookmark-file'."
6716 (let* ((old-title (replace-regexp-in-string ">" "" elm))
6717 (new-title (read-string "NewTitle: " old-title)))
6718 (with-current-buffer
6719 (find-file-literally w3m-bookmark-file)
6720 (goto-char (point-min))
6721 (when (re-search-forward (concat elm "<") nil t)
6722 (goto-char (1- (point)))
6723 (delete-char (- (length old-title)))
6724 (insert new-title))
6725 (save-buffer)
6726 (kill-buffer))))
6728 ;;;; <Library>
6729 ;;; Elisp library scan
6730 (defvar anything-c-source-elisp-library-scan
6731 '((name . "Elisp libraries (Scan)")
6732 (init . (anything-c-elisp-library-scan-init))
6733 (candidates-in-buffer)
6734 (action ("Find library"
6735 . (lambda (candidate) (find-file (find-library-name candidate))))
6736 ("Find library other window"
6737 . (lambda (candidate)
6738 (find-file-other-window (find-library-name candidate))))
6739 ("Load library"
6740 . (lambda (candidate) (load-library candidate))))))
6741 ;; (anything 'anything-c-source-elisp-library-scan)
6743 (defun anything-c-elisp-library-scan-init ()
6744 "Init anything buffer status."
6745 (let ((anything-buffer (anything-candidate-buffer 'global))
6746 (library-list (anything-c-elisp-library-scan-list)))
6747 (with-current-buffer anything-buffer
6748 (dolist (library library-list)
6749 (insert (format "%s\n" library))))))
6751 (defun anything-c-elisp-library-scan-list (&optional dirs string)
6752 "Do completion for file names passed to `locate-file'.
6753 DIRS is directory to search path.
6754 STRING is string to match."
6755 ;; Use `load-path' as path when ignore `dirs'.
6756 (or dirs (setq dirs load-path))
6757 ;; Init with blank when ignore `string'.
6758 (or string (setq string ""))
6759 ;; Get library list.
6760 (let ((string-dir (file-name-directory string))
6761 ;; File regexp that suffix match `load-file-rep-suffixes'.
6762 (match-regexp (format "^.*\\.el%s$" (regexp-opt load-file-rep-suffixes)))
6763 name
6764 names)
6765 (dolist (dir dirs)
6766 (unless dir
6767 (setq dir default-directory))
6768 (if string-dir
6769 (setq dir (expand-file-name string-dir dir)))
6770 (when (file-directory-p dir)
6771 (dolist (file (file-name-all-completions
6772 (file-name-nondirectory string) dir))
6773 ;; Suffixes match `load-file-rep-suffixes'.
6774 (setq name (if string-dir (concat string-dir file) file))
6775 (if (string-match match-regexp name)
6776 (add-to-list 'names name)))))
6777 names))
6779 ;;;; <Programming>
6783 ;;; Imenu
6786 (defvar anything-c-imenu-delimiter " / ")
6788 (defvar anything-c-imenu-index-filter nil)
6789 (make-variable-buffer-local 'anything-c-imenu-index-filter)
6791 (defvar anything-c-cached-imenu-alist nil)
6792 (make-variable-buffer-local 'anything-c-cached-imenu-alist)
6794 (defvar anything-c-cached-imenu-candidates nil)
6795 (make-variable-buffer-local 'anything-c-cached-imenu-candidates)
6797 (defvar anything-c-cached-imenu-tick nil)
6798 (make-variable-buffer-local 'anything-c-cached-imenu-tick)
6800 (eval-when-compile (require 'imenu))
6801 (setq imenu-auto-rescan t)
6803 (defun anything-imenu-create-candidates (entry)
6804 "Create candidates with ENTRY."
6805 (if (listp (cdr entry))
6806 (mapcan
6807 (lambda (sub)
6808 (if (consp (cdr sub))
6809 (mapcar
6810 (lambda (subentry)
6811 (concat (car entry) anything-c-imenu-delimiter subentry))
6812 (anything-imenu-create-candidates sub))
6813 (list (concat (car entry) anything-c-imenu-delimiter (car sub)))))
6814 (cdr entry))
6815 (list entry)))
6817 (defvar anything-c-source-imenu
6818 '((name . "Imenu")
6819 (init . (lambda () (require 'imenu)))
6820 (candidates . anything-c-imenu-candidates)
6821 (persistent-action . (lambda (elm)
6822 (anything-c-imenu-default-action elm)
6823 (unless (fboundp 'semantic-imenu-tag-overlay)
6824 (anything-match-line-color-current-line))))
6825 (persistent-help . "Show this entry")
6826 (action . anything-c-imenu-default-action))
6827 "See (info \"(emacs)Imenu\")")
6829 ;; (anything 'anything-c-source-imenu)
6831 (defun anything-c-imenu-candidates ()
6832 (with-current-buffer anything-current-buffer
6833 (let ((tick (buffer-modified-tick)))
6834 (if (eq anything-c-cached-imenu-tick tick)
6835 anything-c-cached-imenu-candidates
6836 (setq imenu--index-alist nil)
6837 (setq anything-c-cached-imenu-tick tick
6838 anything-c-cached-imenu-candidates
6839 (ignore-errors
6840 (mapcan
6841 'anything-imenu-create-candidates
6842 (setq anything-c-cached-imenu-alist
6843 (let ((index (imenu--make-index-alist)))
6844 (if anything-c-imenu-index-filter
6845 (funcall anything-c-imenu-index-filter index)
6846 index))))))
6847 (setq anything-c-cached-imenu-candidates
6848 (mapcar #'(lambda (x)
6849 (if (stringp x)
6851 (car x)))
6852 anything-c-cached-imenu-candidates))))))
6854 (setq imenu-default-goto-function 'imenu-default-goto-function)
6855 (defun anything-c-imenu-default-action (elm)
6856 "The default action for `anything-c-source-imenu'."
6857 (let ((path (split-string elm anything-c-imenu-delimiter))
6858 (alist anything-c-cached-imenu-alist))
6859 (dolist (elm path)
6860 (setq alist (assoc elm alist)))
6861 (imenu alist)))
6863 ;;; Ctags
6866 (defvar anything-c-ctags-modes
6867 '( c-mode c++-mode awk-mode csharp-mode java-mode javascript-mode lua-mode
6868 makefile-mode pascal-mode perl-mode cperl-mode php-mode python-mode
6869 scheme-mode sh-mode slang-mode sql-mode tcl-mode ))
6871 (defun anything-c-source-ctags-init ()
6872 (when (and buffer-file-name
6873 (memq major-mode anything-c-ctags-modes)
6874 (anything-current-buffer-is-modified))
6875 (with-current-buffer (anything-candidate-buffer 'local)
6876 (call-process-shell-command
6877 (if (string-match "\\.el\\.gz$" anything-buffer-file-name)
6878 (format "ctags -e -u -f- --language-force=lisp --fields=n =(zcat %s) "
6879 anything-buffer-file-name)
6880 (format "ctags -e -u -f- --fields=n %s " anything-buffer-file-name))
6881 nil (current-buffer))
6882 (goto-char (point-min))
6883 (forward-line 2)
6884 (delete-region (point-min) (point))
6885 (loop while (and (not (eobp)) (search-forward "\001" (point-at-eol) t))
6886 for lineno-start = (point)
6887 for lineno = (buffer-substring
6888 lineno-start
6889 (1- (search-forward "," (point-at-eol) t)))
6891 (beginning-of-line)
6892 (insert (format "%5s:" lineno))
6893 (search-forward "\177" (point-at-eol) t)
6894 (delete-region (1- (point)) (point-at-eol))
6895 (forward-line 1)))))
6897 (defvar anything-c-source-ctags
6898 '((name . "Exuberant ctags")
6899 (init . anything-c-source-ctags-init)
6900 (candidates-in-buffer)
6901 (adjust)
6902 (type . line))
6903 "Needs Exuberant Ctags.
6905 http://ctags.sourceforge.net/")
6906 ;; (anything 'anything-c-source-ctags)
6908 ;;; Semantic
6911 (eval-when-compile (require 'semantic nil t))
6912 (declare-function semantic-format-tag-summarize "ext:format.el" (tag &optional parent color) t)
6913 (declare-function semantic-tag-components "ext:tag.el" (tag) t)
6914 (declare-function semantic-go-to-tag "ext:tag-file.el" (tag) t)
6915 (declare-function semantic-tag-type "ext:tag-file.el" (tag) t)
6916 (declare-function semantic-tag-class "ext:tag-file.el" (tag) t)
6917 (defvar anything-semantic-candidates nil)
6919 (defun anything-semantic-construct-candidates (tags depth)
6920 (when (require 'semantic nil t)
6921 (apply
6922 'append
6923 (mapcar
6924 (lambda (tag)
6925 (if (listp tag)
6926 (let ((type (semantic-tag-type tag))
6927 (class (semantic-tag-class tag)))
6928 (if (or (and (stringp type)
6929 (or (string= type "class")
6930 (string= type "namespace")))
6931 (eq class 'function)
6932 (eq class 'variable))
6933 (cons (cons (concat (make-string (* depth 2) ?\s)
6934 (semantic-format-tag-summarize tag nil t))
6935 tag)
6936 (anything-semantic-construct-candidates
6937 (semantic-tag-components tag) (1+ depth)))))))
6938 tags))))
6940 (defun anything-semantic-default-action (candidate)
6941 (let ((tag (cdr (assoc candidate anything-semantic-candidates))))
6942 (semantic-go-to-tag tag)))
6944 (defvar anything-c-source-semantic
6945 '((name . "Semantic Tags")
6946 (init . (lambda ()
6947 (setq anything-semantic-candidates
6948 (ignore-errors (anything-semantic-construct-candidates
6949 (semantic-fetch-tags) 0)))))
6950 (candidates . (lambda ()
6951 (if anything-semantic-candidates
6952 (mapcar 'car anything-semantic-candidates))))
6953 (persistent-action . (lambda (elm)
6954 (anything-semantic-default-action elm)
6955 (anything-match-line-color-current-line)))
6956 (persistent-help . "Show this entry")
6957 (action . anything-semantic-default-action)
6958 "Needs semantic in CEDET.
6960 http://cedet.sourceforge.net/semantic.shtml
6961 http://cedet.sourceforge.net/"))
6963 ;; (anything 'anything-c-source-semantic)
6965 ;;; Function is called by
6966 ;;;###autoload
6967 (defun anything-simple-call-tree ()
6968 "Preconfigured `anything' for simple-call-tree. List function relationships.
6970 Needs simple-call-tree.el.
6971 http://www.emacswiki.org/cgi-bin/wiki/download/simple-call-tree.el"
6972 (interactive)
6973 (anything-other-buffer
6974 '(anything-c-source-simple-call-tree-functions-callers
6975 anything-c-source-simple-call-tree-callers-functions)
6976 "*anything simple-call-tree*"))
6978 (defvar anything-c-source-simple-call-tree-functions-callers
6979 '((name . "Function is called by")
6980 (init . anything-c-simple-call-tree-functions-callers-init)
6981 (multiline)
6982 (candidates . anything-c-simple-call-tree-candidates)
6983 (persistent-action . anything-c-simple-call-tree-persistent-action)
6984 (persistent-help . "Show function definitions by rotation")
6985 (action ("Find definition selected by persistent-action" .
6986 anything-c-simple-call-tree-find-definition)))
6987 "Needs simple-call-tree.el.
6988 http://www.emacswiki.org/cgi-bin/wiki/download/simple-call-tree.el")
6990 (defvar anything-c-simple-call-tree-tick nil)
6991 (make-variable-buffer-local 'anything-c-simple-call-tree-tick)
6992 (defun anything-c-simple-call-tree-analyze-maybe ()
6993 (unless (eq (buffer-chars-modified-tick) anything-c-simple-call-tree-tick)
6994 (simple-call-tree-analyze)
6995 (setq anything-c-simple-call-tree-tick (buffer-chars-modified-tick))))
6997 (defun anything-c-simple-call-tree-init-base (function message)
6998 (require 'simple-call-tree)
6999 (with-no-warnings
7000 (when (anything-current-buffer-is-modified)
7001 (anything-c-simple-call-tree-analyze-maybe)
7002 (let ((list (funcall function simple-call-tree-alist)))
7003 (with-current-buffer (anything-candidate-buffer 'local)
7004 (dolist (entry list)
7005 (let ((funcs (concat " " (mapconcat #'identity (cdr entry) "\n "))))
7006 (insert (car entry) message
7007 (if (string= funcs " ")
7008 " no functions."
7009 funcs)
7010 "\n\n"))))))))
7012 (defun anything-c-simple-call-tree-functions-callers-init ()
7013 (anything-c-simple-call-tree-init-base 'simple-call-tree-invert
7014 " is called by\n"))
7016 (defun anything-c-simple-call-tree-candidates ()
7017 (with-current-buffer (anything-candidate-buffer)
7018 (split-string (buffer-string) "\n\n")))
7020 (defvar anything-c-simple-call-tree-related-functions nil)
7021 (defvar anything-c-simple-call-tree-function-index 0)
7022 (defun anything-c-simple-call-tree-persistent-action (candidate)
7023 (unless (eq last-command 'anything-execute-persistent-action)
7024 (setq anything-c-simple-call-tree-related-functions
7025 (delete "no functions."
7026 (split-string
7027 (replace-regexp-in-string " \\| is called by\\| calls "
7028 "" candidate)
7029 "\n")))
7030 (setq anything-c-simple-call-tree-function-index -1))
7031 (incf anything-c-simple-call-tree-function-index)
7032 (anything-c-simple-call-tree-find-definition candidate))
7034 (defun anything-c-simple-call-tree-find-definition (candidate)
7035 (find-function
7036 (intern
7037 (nth (mod anything-c-simple-call-tree-function-index
7038 (length anything-c-simple-call-tree-related-functions))
7039 anything-c-simple-call-tree-related-functions))))
7041 ;; (anything 'anything-c-source-simple-call-tree-functions-callers)
7043 ;;; Function calls
7044 (defvar anything-c-source-simple-call-tree-callers-functions
7045 '((name . "Function calls")
7046 (init . anything-c-simple-call-tree-callers-functions-init)
7047 (multiline)
7048 (candidates . anything-c-simple-call-tree-candidates)
7049 (persistent-action . anything-c-simple-call-tree-persistent-action)
7050 (persistent-help . "Show function definitions by rotation")
7051 (action ("Find definition selected by persistent-action" .
7052 anything-c-simple-call-tree-find-definition)))
7053 "Needs simple-call-tree.el.
7054 http://www.emacswiki.org/cgi-bin/wiki/download/simple-call-tree.el")
7056 (defun anything-c-simple-call-tree-callers-functions-init ()
7057 (anything-c-simple-call-tree-init-base 'identity " calls \n"))
7059 ;; (anything 'anything-c-source-simple-call-tree-callers-functions)
7061 ;;; Commands/Options with doc
7062 (defvar anything-c-auto-document-data nil)
7063 (make-variable-buffer-local 'anything-c-auto-document-data)
7064 (defvar anything-c-source-commands-and-options-in-file
7065 '((name . "Commands/Options in file")
7066 (header-name
7067 . (lambda (x) (format "Commands/Options in %s"
7068 (buffer-local-value 'buffer-file-name
7069 anything-current-buffer))))
7070 (candidates . anything-command-and-options-candidates)
7071 (multiline)
7072 (action . imenu))
7073 "List Commands and Options with doc. It needs auto-document.el .
7075 http://www.emacswiki.org/cgi-bin/wiki/download/auto-document.el")
7077 (eval-when-compile (require 'auto-document nil t))
7078 (defun anything-command-and-options-candidates ()
7079 (with-current-buffer anything-current-buffer
7080 (when (and (require 'auto-document nil t)
7081 (eq major-mode 'emacs-lisp-mode)
7082 (or (anything-current-buffer-is-modified)
7083 (not anything-c-auto-document-data)))
7084 (or imenu--index-alist (imenu--make-index-alist t))
7085 (setq anything-c-auto-document-data
7086 (destructuring-bind (commands options)
7087 (adoc-construct anything-current-buffer)
7088 (append
7089 (loop for (command . doc) in commands
7090 for cmdname = (symbol-name command)
7091 collect
7092 (cons
7093 (format "Command: %s\n %s"
7094 (propertize cmdname 'face font-lock-function-name-face)
7095 (adoc-first-line doc))
7096 (assoc cmdname imenu--index-alist)))
7097 (loop with var-alist = (cdr (assoc "Variables" imenu--index-alist))
7098 for (option doc default) in options
7099 for optname = (symbol-name option)
7100 collect
7101 (cons
7102 (format "Option: %s\n %s\n default = %s"
7103 (propertize optname 'face font-lock-variable-name-face)
7104 (adoc-first-line doc)
7105 (adoc-prin1-to-string default))
7106 (assoc optname
7107 var-alist)))))))
7108 anything-c-auto-document-data))
7110 ;; (anything 'anything-c-source-commands-and-options-in-file)
7112 ;;;; <Color and Face>
7113 ;;; Customize Face
7114 (defvar anything-c-source-customize-face
7115 '((name . "Customize Face")
7116 (init . (lambda ()
7117 (unless (anything-candidate-buffer)
7118 (save-window-excursion (list-faces-display))
7119 (anything-candidate-buffer (get-buffer "*Faces*")))))
7120 (candidates-in-buffer)
7121 (get-line . buffer-substring)
7122 (action . (lambda (line)
7123 (customize-face (intern (car (split-string line))))))
7124 (requires-pattern . 3))
7125 "See (info \"(emacs)Faces\")")
7126 ;; (anything 'anything-c-source-customize-face)
7128 ;; Color
7129 (defvar anything-c-source-colors
7130 '((name . "Colors")
7131 (init . (lambda () (unless (anything-candidate-buffer)
7132 (save-window-excursion (list-colors-display))
7133 (anything-candidate-buffer (get-buffer "*Colors*")))))
7134 (candidates-in-buffer)
7135 (get-line . buffer-substring)
7136 (action
7137 ("Copy Name" . (lambda (candidate)
7138 (kill-new (anything-c-colors-get-name candidate))))
7139 ("Copy RGB" . (lambda (candidate)
7140 (kill-new (anything-c-colors-get-rgb candidate))))
7141 ("Insert Name" . (lambda (candidate)
7142 (with-current-buffer anything-current-buffer
7143 (insert (anything-c-colors-get-name candidate)))))
7144 ("Insert RGB" . (lambda (candidate)
7145 (with-current-buffer anything-current-buffer
7146 (insert (anything-c-colors-get-rgb candidate))))))))
7147 ;; (anything 'anything-c-source-colors)
7149 (defun anything-c-colors-get-name (candidate)
7150 "Get color name."
7151 (replace-regexp-in-string
7152 " " ""
7153 (with-temp-buffer
7154 (insert (capitalize candidate))
7155 (goto-char (point-min))
7156 (search-forward-regexp "\\s-\\{2,\\}")
7157 (delete-region (point) (point-max))
7158 (buffer-string))))
7160 (defun anything-c-colors-get-rgb (candidate)
7161 "Get color RGB."
7162 (replace-regexp-in-string
7163 " " ""
7164 (with-temp-buffer
7165 (insert (capitalize candidate))
7166 (goto-char (point-max))
7167 (search-backward-regexp "\\s-\\{2,\\}")
7168 (delete-region (point) (point-min))
7169 (buffer-string))))
7171 ;;;; <Search Engine>
7172 ;;; Tracker desktop search
7173 (defvar anything-c-source-tracker-search
7174 '((name . "Tracker Search")
7175 (candidates . (lambda ()
7176 (start-process "tracker-search-process" nil
7177 "tracker-search"
7178 anything-pattern)))
7179 (type . file)
7180 (requires-pattern . 3)
7181 (delayed))
7182 "Source for retrieving files matching the current input pattern
7183 with the tracker desktop search.")
7184 ;; (anything 'anything-c-source-tracker-search)
7186 ;;; Spotlight (MacOS X desktop search)
7187 (defvar anything-c-source-mac-spotlight
7188 '((name . "mdfind")
7189 (candidates
7190 . (lambda () (start-process "mdfind-process" nil "mdfind" anything-pattern)))
7191 (type . file)
7192 (requires-pattern . 3)
7193 (delayed))
7194 "Source for retrieving files via Spotlight's command line
7195 utility mdfind.")
7196 ;; (anything 'anything-c-source-mac-spotlight)
7199 ;;;; <Kill ring>
7200 ;;; Kill ring
7201 (defvar anything-c-source-kill-ring
7202 '((name . "Kill Ring")
7203 (init . (lambda () (anything-attrset 'last-command last-command)))
7204 (candidates . anything-c-kill-ring-candidates)
7205 (action . anything-c-kill-ring-action)
7206 (last-command)
7207 (migemo)
7208 (multiline))
7209 "Source for browse and insert contents of kill-ring.")
7211 (defun anything-c-kill-ring-candidates ()
7212 (loop for kill in kill-ring
7213 unless (or (< (length kill) anything-kill-ring-threshold)
7214 (string-match "^[\\s\\t]+$" kill))
7215 collect kill))
7217 (defun anything-c-kill-ring-action (str)
7218 "Insert STR in `kill-ring' and set STR to the head.
7219 If this action is executed just after `yank',
7220 replace with STR as yanked string."
7221 (setq kill-ring (delete str kill-ring))
7222 (if (not (eq (anything-attr 'last-command) 'yank))
7223 (insert-for-yank str)
7224 ;; from `yank-pop'
7225 (let ((inhibit-read-only t)
7226 (before (< (point) (mark t))))
7227 (if before
7228 (funcall (or yank-undo-function 'delete-region) (point) (mark t))
7229 (funcall (or yank-undo-function 'delete-region) (mark t) (point)))
7230 (setq yank-undo-function nil)
7231 (set-marker (mark-marker) (point) (current-buffer))
7232 (insert-for-yank str)
7233 ;; Set the window start back where it was in the yank command,
7234 ;; if possible.
7235 (set-window-start (selected-window) yank-window-start t)
7236 (if before
7237 ;; This is like exchange-point-and-mark, but doesn't activate the mark.
7238 ;; It is cleaner to avoid activation, even though the command
7239 ;; loop would deactivate the mark because we inserted text.
7240 (goto-char (prog1 (mark t)
7241 (set-marker (mark-marker) (point) (current-buffer)))))))
7242 (kill-new str))
7244 ;; (anything 'anything-c-source-kill-ring)
7246 ;;;; <Mark ring>
7247 ;; DO NOT include these sources in `anything-sources' use
7248 ;; the commands `anything-mark-ring', `anything-global-mark-ring' or
7249 ;; `anything-all-mark-rings' instead.
7251 (defun anything-c-source-mark-ring-candidates ()
7252 (flet ((get-marks (pos)
7253 (save-excursion
7254 (goto-char pos)
7255 (beginning-of-line)
7256 (let ((line (car (split-string (thing-at-point 'line) "[\n\r]"))))
7257 (when (string= "" line)
7258 (setq line "<EMPTY LINE>"))
7259 (format "%7d: %s" (line-number-at-pos) line)))))
7260 (with-current-buffer anything-current-buffer
7261 (loop
7262 with marks = (if (mark) (cons (mark-marker) mark-ring) mark-ring)
7263 with recip = nil
7264 for i in marks
7265 for m = (get-marks i)
7266 unless (member m recip)
7267 collect m into recip
7268 finally return recip))))
7270 (defvar anything-mark-ring-cache nil)
7271 (defvar anything-c-source-mark-ring
7272 '((name . "mark-ring")
7273 (init . (lambda ()
7274 (setq anything-mark-ring-cache
7275 (ignore-errors (anything-c-source-mark-ring-candidates)))))
7276 (candidates . (lambda ()
7277 (anything-aif anything-mark-ring-cache
7278 it)))
7279 (action . (("Goto line"
7280 . (lambda (candidate)
7281 (anything-goto-line (string-to-number candidate))))))
7282 (persistent-action . (lambda (candidate)
7283 (anything-goto-line (string-to-number candidate))
7284 (anything-match-line-color-current-line)))
7285 (persistent-help . "Show this line")))
7287 ;; (anything 'anything-c-source-mark-ring)
7289 ;;;###autoload
7290 (defun anything-mark-ring ()
7291 "Preconfigured `anything' for `anything-c-source-mark-ring'."
7292 (interactive)
7293 (anything 'anything-c-source-mark-ring))
7295 ;;; Global-mark-ring
7296 (defvar anything-c-source-global-mark-ring
7297 '((name . "global-mark-ring")
7298 (candidates . anything-c-source-global-mark-ring-candidates)
7299 (action . (("Goto line"
7300 . (lambda (candidate)
7301 (let ((items (split-string candidate ":")))
7302 (anything-c-switch-to-buffer (second items))
7303 (anything-goto-line (string-to-number (car items))))))))
7304 (persistent-action . (lambda (candidate)
7305 (let ((items (split-string candidate ":")))
7306 (anything-c-switch-to-buffer (second items))
7307 (anything-goto-line (string-to-number (car items)))
7308 (anything-match-line-color-current-line))))
7309 (persistent-help . "Show this line")))
7311 (defun anything-c-source-global-mark-ring-candidates ()
7312 (flet ((buf-fn (m)
7313 (with-current-buffer (marker-buffer m)
7314 (goto-char m)
7315 (beginning-of-line)
7316 (let (line)
7317 (if (string= "" line)
7318 (setq line "<EMPTY LINE>")
7319 (setq line (car (split-string (thing-at-point 'line)
7320 "[\n\r]"))))
7321 (format "%7d:%s: %s"
7322 (line-number-at-pos) (marker-buffer m) line)))))
7323 (loop
7324 with marks = global-mark-ring
7325 with recip = nil
7326 for i in marks
7327 for gm = (unless (or (string-match
7328 "^ " (format "%s" (marker-buffer i)))
7329 (null (marker-buffer i)))
7330 (buf-fn i))
7331 when (and gm (not (member gm recip)))
7332 collect gm into recip
7333 finally return recip)))
7335 ;; (anything 'anything-c-source-global-mark-ring)
7337 ;;;###autoload
7338 (defun anything-global-mark-ring ()
7339 "Preconfigured `anything' for `anything-c-source-global-mark-ring'."
7340 (interactive)
7341 (anything 'anything-c-source-global-mark-ring))
7343 ;;;###autoload
7344 (defun anything-all-mark-rings ()
7345 "Preconfigured `anything' for `anything-c-source-global-mark-ring' and \
7346 `anything-c-source-mark-ring'."
7347 (interactive)
7348 (anything '(anything-c-source-mark-ring
7349 anything-c-source-global-mark-ring)))
7351 ;;;; <Register>
7352 ;;; Insert from register
7353 (defvar anything-c-source-register
7354 '((name . "Registers")
7355 (candidates . anything-c-register-candidates)
7356 (action-transformer . anything-c-register-action-transformer)
7357 (multiline)
7358 (action))
7359 "See (info \"(emacs)Registers\")")
7361 (defun anything-c-register-candidates ()
7362 "Collecting register contents and appropriate commands."
7363 (loop for (char . val) in register-alist
7364 for key = (single-key-description char)
7365 for string-actions =
7366 (cond
7367 ((numberp val)
7368 (list (int-to-string val)
7369 'insert-register
7370 'increment-register))
7371 ((markerp val)
7372 (let ((buf (marker-buffer val)))
7373 (if (null buf)
7374 (list "a marker in no buffer")
7375 (list (concat
7376 "a buffer position:"
7377 (buffer-name buf)
7378 ", position "
7379 (int-to-string (marker-position val)))
7380 'jump-to-register
7381 'insert-register))))
7382 ((and (consp val) (window-configuration-p (car val)))
7383 (list "window configuration."
7384 'jump-to-register))
7385 ((and (consp val) (frame-configuration-p (car val)))
7386 (list "frame configuration."
7387 'jump-to-register))
7388 ((and (consp val) (eq (car val) 'file))
7389 (list (concat "file:"
7390 (prin1-to-string (cdr val))
7391 ".")
7392 'jump-to-register))
7393 ((and (consp val) (eq (car val) 'file-query))
7394 (list (concat "file:a file-query reference: file "
7395 (car (cdr val))
7396 ", position "
7397 (int-to-string (car (cdr (cdr val))))
7398 ".")
7399 'jump-to-register))
7400 ((consp val)
7401 (let ((lines (format "%4d" (length val))))
7402 (list (format "%s: %s\n" lines
7403 (truncate-string-to-width
7404 (mapconcat 'identity (list (car val))
7405 ;; (mapconcat (lambda (y) y) val
7406 "^J") (- (window-width) 15)))
7407 'insert-register)))
7408 ((stringp val)
7409 (list ;; without properties
7410 (substring-no-properties val)
7411 'insert-register
7412 'append-to-register
7413 'prepend-to-register))
7415 "GARBAGE!"))
7416 collect (cons (format "register %3s: %s" key (car string-actions))
7417 (cons char (cdr string-actions)))))
7419 (defun anything-c-register-action-transformer (actions register-and-functions)
7420 "Decide actions by the contents of register."
7421 (loop with func-actions =
7422 '((insert-register
7423 "Insert Register" .
7424 (lambda (c) (insert-register (car c))))
7425 (jump-to-register
7426 "Jump to Register" .
7427 (lambda (c) (jump-to-register (car c))))
7428 (append-to-register
7429 "Append Region to Register" .
7430 (lambda (c) (append-to-register
7431 (car c) (region-beginning) (region-end))))
7432 (prepend-to-register
7433 "Prepend Region to Register" .
7434 (lambda (c) (prepend-to-register
7435 (car c) (region-beginning) (region-end))))
7436 (increment-register
7437 "Increment Prefix Arg to Register" .
7438 (lambda (c) (increment-register
7439 anything-current-prefix-arg (car c)))))
7440 for func in (cdr register-and-functions)
7441 for cell = (assq func func-actions)
7442 when cell
7443 collect (cdr cell)))
7445 ;; (anything 'anything-c-source-register)
7447 ;;; Latex completion
7448 (defun anything-c-latex-math-candidates ()
7449 "Collect candidates for latex math completion."
7450 (loop for i in (cddr LaTeX-math-menu)
7451 for elm = (loop for s in i when (vectorp s)
7452 collect (cons (aref s 0) (aref s 1)))
7453 append elm))
7455 (defvar anything-c-source-latex-math
7456 '((name . "Latex Math Menu")
7457 (init . (lambda ()
7458 (with-current-buffer anything-current-buffer
7459 (LaTeX-math-mode 1))))
7460 (candidate-number-limit . 9999)
7461 (candidates . anything-c-latex-math-candidates)
7462 (action . (lambda (candidate)
7463 (call-interactively candidate)))))
7465 ;;;; <Headline Extraction>
7466 (defvar anything-c-source-fixme
7467 '((name . "TODO/FIXME/DRY comments")
7468 (headline . "^.*\\<\\(TODO\\|FIXME\\|DRY\\)\\>.*$")
7469 (adjust)
7470 (recenter))
7471 "Show TODO/FIXME/DRY comments in current file.")
7472 ;; (anything 'anything-c-source-fixme)
7474 (defvar anything-c-source-rd-headline
7475 '((name . "RD HeadLine")
7476 (headline "^= \\(.+\\)$" "^== \\(.+\\)$" "^=== \\(.+\\)$" "^==== \\(.+\\)$")
7477 (condition . (memq major-mode '(rdgrep-mode rd-mode)))
7478 (migemo)
7479 (subexp . 1))
7480 "Show RD headlines.
7482 RD is Ruby's POD.
7483 http://en.wikipedia.org/wiki/Ruby_Document_format")
7484 ;; (anything 'anything-c-source-rd-headline)
7486 (defvar anything-c-source-oddmuse-headline
7487 '((name . "Oddmuse HeadLine")
7488 (headline "^= \\(.+\\) =$" "^== \\(.+\\) ==$"
7489 "^=== \\(.+\\) ===$" "^==== \\(.+\\) ====$")
7490 (condition . (memq major-mode '(oddmuse-mode yaoddmuse-mode)))
7491 (migemo)
7492 (subexp . 1))
7493 "Show Oddmuse headlines, such as EmacsWiki.")
7494 ;; (anything 'anything-c-source-oddmuse-headline)
7496 (defvar anything-c-source-emacs-source-defun
7497 '((name . "Emacs Source DEFUN")
7498 (headline . "DEFUN\\|DEFVAR")
7499 (condition . (string-match "/emacs2[0-9].+/src/.+c$"
7500 (or buffer-file-name ""))))
7501 "Show DEFUN/DEFVAR in Emacs C source file.")
7502 ;; (anything 'anything-c-source-emacs-source-defun)
7504 (defvar anything-c-source-emacs-lisp-expectations
7505 '((name . "Emacs Lisp Expectations")
7506 (headline . "(desc[ ]\\|(expectations")
7507 (condition . (eq major-mode 'emacs-lisp-mode)))
7508 "Show descriptions (desc) in Emacs Lisp Expectations.
7510 http://www.emacswiki.org/cgi-bin/wiki/download/el-expectations.el")
7511 ;; (anything 'anything-c-source-emacs-lisp-expectations)
7513 (defvar anything-c-source-emacs-lisp-toplevels
7514 '((name . "Emacs Lisp Toplevel / Level 4 Comment / Linkd Star")
7515 (headline . "^(\\|(@\\*\\|^;;;;")
7516 (get-line . buffer-substring)
7517 (condition . (eq major-mode 'emacs-lisp-mode))
7518 (adjust))
7519 "Show top-level forms, level 4 comments and linkd stars (optional) in Emacs Lisp.
7520 linkd.el is optional because linkd stars are extracted by regexp.
7521 http://www.emacswiki.org/cgi-bin/wiki/download/linkd.el")
7522 ;; (anything 'anything-c-source-emacs-lisp-toplevels)
7524 (defvar anything-c-source-org-headline
7525 '((name . "Org HeadLine")
7526 (headline
7527 "^\\* \\(.+?\\)\\([ \t]*:[a-zA-Z0-9_@:]+:\\)?[ \t]*$"
7528 "^\\*\\* \\(.+?\\)\\([ \t]*:[a-zA-Z0-9_@:]+:\\)?[ \t]*$"
7529 "^\\*\\*\\* \\(.+?\\)\\([ \t]*:[a-zA-Z0-9_@:]+:\\)?[ \t]*$"
7530 "^\\*\\*\\*\\* \\(.+?\\)\\([ \t]*:[a-zA-Z0-9_@:]+:\\)?[ \t]*$"
7531 "^\\*\\*\\*\\*\\* \\(.+?\\)\\([ \t]*:[a-zA-Z0-9_@:]+:\\)?[ \t]*$"
7532 "^\\*\\*\\*\\*\\*\\* \\(.+?\\)\\([ \t]*:[a-zA-Z0-9_@:]+:\\)?[ \t]*$"
7533 "^\\*\\*\\*\\*\\*\\*\\* \\(.+?\\)\\([ \t]*:[a-zA-Z0-9_@:]+:\\)?[ \t]*$"
7534 "^\\*\\*\\*\\*\\*\\*\\*\\* \\(.+?\\)\\([ \t]*:[a-zA-Z0-9_@:]+:\\)?[ \t]*$")
7535 (condition . (eq major-mode 'org-mode))
7536 (migemo)
7537 (subexp . 1)
7538 (persistent-action . (lambda (elm)
7539 (anything-c-action-line-goto elm)
7540 (org-cycle)))
7541 (action-transformer
7542 . (lambda (actions candidate)
7543 '(("Go to Line" . anything-c-action-line-goto)
7544 ("Insert Link to This Headline" . anything-c-org-headline-insert-link-to-headline)))))
7545 "Show Org headlines.
7546 org-mode is very very much extended text-mode/outline-mode.
7548 See (find-library \"org.el\")
7549 See http://orgmode.org for the latest version.")
7551 (defun anything-c-org-headline-insert-link-to-headline (lineno-and-content)
7552 (insert
7553 (save-excursion
7554 (anything-goto-line (car lineno-and-content))
7555 (and (looking-at org-complex-heading-regexp)
7556 (org-make-link-string (concat "*" (match-string 4)))))))
7558 ;; (anything 'anything-c-source-org-headline)
7560 ;;; Anything yaoddmuse
7561 ;; Be sure to have yaoddmuse.el installed
7562 ;; install-elisp may be required if you want to install elisp file from here.
7563 (defvar anything-yaoddmuse-use-cache-file nil)
7564 (defvar anything-c-yaoddmuse-cache-file "~/.emacs.d/yaoddmuse-cache.el")
7565 (defvar anything-c-yaoddmuse-ew-cache nil)
7566 (defvar anything-c-source-yaoddmuse-emacswiki-edit-or-view
7567 '((name . "Yaoddmuse Edit or View (EmacsWiki)")
7568 (candidates . (lambda ()
7569 (if anything-yaoddmuse-use-cache-file
7570 (ignore-errors
7571 (unless anything-c-yaoddmuse-ew-cache
7572 (load anything-c-yaoddmuse-cache-file)
7573 (setq anything-c-yaoddmuse-ew-cache
7574 (gethash "EmacsWiki" yaoddmuse-pages-hash)))
7575 anything-c-yaoddmuse-ew-cache)
7576 (yaoddmuse-update-pagename t)
7577 (gethash "EmacsWiki" yaoddmuse-pages-hash))))
7578 (action . (("Edit page" . (lambda (candidate)
7579 (yaoddmuse-edit "EmacsWiki" candidate)))
7580 ("Browse page" . (lambda (candidate)
7581 (yaoddmuse-browse-page "EmacsWiki" candidate)))
7582 ("Browse page other window" . (lambda (candidate)
7583 (if (one-window-p)
7584 (split-window-vertically))
7585 (yaoddmuse-browse-page "EmacsWiki" candidate)))
7586 ("Browse diff" . (lambda (candidate)
7587 (yaoddmuse-browse-page-diff "EmacsWiki" candidate)))
7588 ("Copy URL" . (lambda (candidate)
7589 (kill-new (yaoddmuse-url "EmacsWiki" candidate))
7590 (message "Have copy page %s's URL to yank." candidate)))
7591 ("Create page" . (lambda (candidate)
7592 (yaoddmuse-edit "EmacsWiki" anything-input)))
7593 ("Update cache" . (lambda (candidate)
7594 (if anything-yaoddmuse-use-cache-file
7595 (progn
7596 (anything-yaoddmuse-cache-pages t)
7597 (setq anything-c-yaoddmuse-ew-cache
7598 (gethash "EmacsWiki" yaoddmuse-pages-hash)))
7599 (yaoddmuse-update-pagename))))))
7600 (action-transformer anything-c-yaoddmuse-action-transformer))
7601 "Needs yaoddmuse.el.
7603 http://www.emacswiki.org/emacs/download/yaoddmuse.el")
7605 ;; (anything 'anything-c-source-yaoddmuse-emacswiki-edit-or-view)
7607 (defvar anything-c-source-yaoddmuse-emacswiki-post-library
7608 '((name . "Yaoddmuse Post library (EmacsWiki)")
7609 (init . (anything-yaoddmuse-init))
7610 (candidates-in-buffer)
7611 (action . (("Post library and Browse" . (lambda (candidate)
7612 (yaoddmuse-post-file (find-library-name candidate)
7613 "EmacsWiki"
7614 (file-name-nondirectory (find-library-name candidate))
7615 nil t)))
7616 ("Post library" . (lambda (candidate)
7617 (yaoddmuse-post-file (find-library-name candidate)
7618 "EmacsWiki"
7619 (file-name-nondirectory (find-library-name candidate))))))))
7620 "Needs yaoddmuse.el.
7622 http://www.emacswiki.org/emacs/download/yaoddmuse.el")
7624 ;; (anything 'anything-c-source-yaoddmuse-emacswiki-post-library)
7626 (defun anything-c-yaoddmuse-action-transformer (actions candidate)
7627 "Allow the use of `install-elisp' only on elisp files."
7628 (if (string-match "\.el$" candidate)
7629 (append actions '(("Install Elisp" . (lambda (elm)
7630 (install-elisp-from-emacswiki elm)))))
7631 actions))
7633 ;;;###autoload
7634 (defun anything-yaoddmuse-cache-pages (&optional load)
7635 "Fetch the list of files on emacswiki and create cache file.
7636 If load is non--nil load the file and feed `yaoddmuse-pages-hash'."
7637 (interactive)
7638 (yaoddmuse-update-pagename)
7639 (save-excursion
7640 (find-file anything-c-yaoddmuse-cache-file)
7641 (erase-buffer)
7642 (insert "(puthash \"EmacsWiki\" '(")
7643 (loop for i in (gethash "EmacsWiki" yaoddmuse-pages-hash)
7645 (insert (concat "(\"" (car i) "\") ")))
7646 (insert ") yaoddmuse-pages-hash)\n")
7647 (save-buffer)
7648 (kill-buffer (current-buffer))
7649 (when (or current-prefix-arg
7650 load)
7651 (load anything-c-yaoddmuse-cache-file))))
7653 ;;;###autoload
7654 (defun anything-yaoddmuse-emacswiki-edit-or-view ()
7655 "Preconfigured `anything' to edit or view EmacsWiki page.
7657 Needs yaoddmuse.el.
7659 http://www.emacswiki.org/emacs/download/yaoddmuse.el"
7660 (interactive)
7661 (anything 'anything-c-source-yaoddmuse-emacswiki-edit-or-view))
7663 ;;;###autoload
7664 (defun anything-yaoddmuse-emacswiki-post-library ()
7665 "Preconfigured `anything' to post library to EmacsWiki.
7667 Needs yaoddmuse.el.
7669 http://www.emacswiki.org/emacs/download/yaoddmuse.el"
7670 (interactive)
7671 (anything 'anything-c-source-yaoddmuse-emacswiki-post-library))
7673 (defun anything-yaoddmuse-init ()
7674 "Init anything buffer status."
7675 (let ((anything-buffer (anything-candidate-buffer 'global))
7676 (library-list (yaoddmuse-get-library-list)))
7677 (with-current-buffer anything-buffer
7678 ;; Insert library name.
7679 (dolist (library library-list)
7680 (insert (format "%s\n" library)))
7681 ;; Sort lines.
7682 (sort-lines nil (point-min) (point-max)))))
7684 ;;; Eev anchors
7685 (defvar anything-c-source-eev-anchor
7686 '((name . "Anchors")
7687 (candidates
7688 . (lambda ()
7689 (ignore-errors
7690 (with-current-buffer anything-current-buffer
7691 (loop initially (goto-char (point-min))
7692 while (re-search-forward (format ee-anchor-format "\\([^\.].+\\)") nil t)
7693 for anchor = (match-string-no-properties 1)
7694 collect (cons (format "%5d:%s"
7695 (line-number-at-pos (match-beginning 0))
7696 (format ee-anchor-format anchor)) anchor))))))
7697 (persistent-action . (lambda (item)
7698 (ee-to item)
7699 (anything-match-line-color-current-line)))
7700 (persistent-help . "Show this entry")
7701 (action . (("Goto link" . ee-to)))))
7702 ;; (anything 'anything-c-source-eev-anchor)
7704 ;;;; <Misc>
7705 ;;; Org keywords
7706 (defvar anything-c-source-org-keywords
7707 '((name . "Org Keywords")
7708 (init . anything-c-org-keywords-init)
7709 (candidates . anything-c-org-keywords-candidates)
7710 (action . anything-c-org-keywords-insert)
7711 (persistent-action . anything-c-org-keywords-show-help)
7712 (persistent-help . "Show an example and info page to describe this keyword.")
7713 (keywords-examples)
7714 (keywords)))
7715 ;; (anything 'anything-c-source-org-keywords)
7716 (defvar anything-c-org-keywords-info-location
7717 '(("#+TITLE:" . "(org)Export options")
7718 ("#+AUTHOR:" . "(org)Export options")
7719 ("#+DATE:" . "(org)Export options")
7720 ("#+EMAIL:" . "(org)Export options")
7721 ("#+DESCRIPTION:" . "(org)Export options")
7722 ("#+KEYWORDS:" . "(org)Export options")
7723 ("#+LANGUAGE:" . "(org)Export options")
7724 ("#+TEXT:" . "(org)Export options")
7725 ("#+TEXT:" . "(org)Export options")
7726 ("#+OPTIONS:" . "(org)Export options")
7727 ("#+BIND:" . "(org)Export options")
7728 ("#+LINK_UP:" . "(org)Export options")
7729 ("#+LINK_HOME:" . "(org)Export options")
7730 ("#+LATEX_HEADER:" . "(org)Export options")
7731 ("#+EXPORT_SELECT_TAGS:" . "(org)Export options")
7732 ("#+EXPORT_EXCLUDE_TAGS:" . "(org)Export options")
7733 ("#+INFOJS_OPT" . "(org)Javascript support")
7734 ("#+BEGIN_HTML" . "(org)Quoting HTML tags")
7735 ("#+BEGIN_LaTeX" . "(org)Quoting LaTeX code")
7736 ("#+ORGTBL" . "(org)Radio tables")
7737 ("#+HTML:" . "(org)Quoting HTML tags")
7738 ("#+LaTeX:" . "(org)Quoting LaTeX code")
7739 ("#+BEGIN:" . "(org)Dynamic blocks") ;clocktable columnview
7740 ("#+BEGIN_EXAMPLE" . "(org)Literal examples")
7741 ("#+BEGIN_QUOTE" . "(org)Paragraphs")
7742 ("#+BEGIN_VERSE" . "(org)Paragraphs")
7743 ("#+BEGIN_SRC" . "(org)Literal examples")
7744 ("#+CAPTION" . "(org)Tables in HTML export")
7745 ("#+LABEL" . "(org)Tables in LaTeX export")
7746 ("#+ATTR_HTML" . "(org)Links")
7747 ("#+ATTR_LaTeX" . "(org)Images in LaTeX export")))
7749 (defun anything-c-org-keywords-init ()
7750 (unless (anything-attr 'keywords-examples)
7751 (require 'org)
7752 (anything-attrset 'keywords-examples
7753 (append
7754 (mapcar
7755 (lambda (x)
7756 (string-match "^#\\+\\(\\([A-Z_]+:?\\).*\\)" x)
7757 (cons (match-string 2 x) (match-string 1 x)))
7758 (org-split-string (org-get-current-options) "\n"))
7759 (mapcar 'list org-additional-option-like-keywords)))
7760 (anything-attrset 'keywords (mapcar 'car (anything-attr 'keywords-examples)))))
7762 (defun anything-c-org-keywords-candidates ()
7763 (and (or (eq (buffer-local-value 'major-mode anything-current-buffer) 'org-mode)
7764 (eq (buffer-local-value 'major-mode anything-current-buffer) 'message-mode))
7765 (anything-attr 'keywords)))
7767 (defun anything-c-org-keywords-insert (keyword)
7768 (cond ((and (string-match "BEGIN" keyword)
7769 (anything-region-active-p))
7770 (let ((beg (region-beginning))
7771 (end (region-end)))
7772 (goto-char end)
7773 (insert "\n#+" (replace-regexp-in-string
7774 "BEGIN" "END" keyword) "\n")
7775 (goto-char beg)
7776 (insert "#+" keyword " ")
7777 (save-excursion (insert "\n"))))
7778 ((string-match "BEGIN" keyword)
7779 (insert "#+" keyword " ")
7780 (save-excursion
7781 (insert "\n#+" (replace-regexp-in-string
7782 "BEGIN" "END" keyword) "\n")))
7783 (t (insert "#+" keyword " "))))
7785 (defun anything-c-org-keywords-show-help (keyword)
7786 (info (or (assoc-default (concat "#+" keyword) anything-c-org-keywords-info-location)
7787 "(org)In-buffer settings"))
7788 (search-forward (concat "#+" keyword) nil t)
7789 (anything-persistent-highlight-point)
7790 (message "%s" (or (cdr (assoc keyword (anything-attr 'keywords-examples))) "")))
7793 ;;; Picklist
7794 (defvar anything-c-source-picklist
7795 '((name . "Picklist")
7796 (candidates . (lambda () (mapcar 'car picklist-list)))
7797 (type . file)))
7798 ;; (anything 'anything-c-source-picklist)
7800 ;;; BBDB
7801 (defvar bbdb-records)
7802 (defvar bbdb-buffer-name)
7803 (declare-function bbdb "ext:bbdb-com")
7804 (declare-function bbdb-current-record "ext:bbdb-com")
7805 (declare-function bbdb-redisplay-one-record "ext:bbdb-com")
7806 (declare-function bbdb-record-net "ext:bbdb-com" (string) t)
7807 (declare-function bbdb-current-record "ext:bbdb-com")
7808 (declare-function bbdb-dwim-net-address "ext:bbdb-com")
7809 (declare-function bbdb-records "ext:bbdb-com"
7810 (&optional dont-check-disk already-in-db-buffer))
7812 (defun anything-c-bbdb-candidates ()
7813 "Return a list of all names in the bbdb database. The format
7814 is \"Firstname Lastname\"."
7815 (mapcar (lambda (bbdb-record)
7816 (replace-regexp-in-string
7817 "\\s-+$" ""
7818 (concat (aref bbdb-record 0) " " (aref bbdb-record 1))))
7819 (bbdb-records)))
7821 (defun anything-c-bbdb-create-contact (actions candidate)
7822 "Action transformer that returns only an entry to add the
7823 current `anything-pattern' as new contact. All other actions are
7824 removed."
7825 (if (string= candidate "*Add to contacts*")
7826 '(("Add to contacts" . (lambda (actions)
7827 (bbdb-create-internal
7828 (read-from-minibuffer "Name: " anything-c-bbdb-name)
7829 (read-from-minibuffer "Company: ")
7830 (read-from-minibuffer "Email: ")
7833 (read-from-minibuffer "Note: ")))))
7834 actions))
7836 (defun anything-c-bbdb-get-record (candidate)
7837 "Return record that match CANDIDATE."
7838 (bbdb candidate nil)
7839 (set-buffer "*BBDB*")
7840 (bbdb-current-record))
7842 (defvar anything-c-bbdb-name nil
7843 "Only for internal use.")
7845 (defvar anything-c-source-bbdb
7846 '((name . "BBDB")
7847 (candidates . anything-c-bbdb-candidates)
7848 (action ("Send a mail" . anything-c-bbdb-compose-mail)
7849 ("View person's data" . anything-c-bbdb-view-person-action))
7850 (filtered-candidate-transformer . (lambda (candidates source)
7851 (setq anything-c-bbdb-name anything-pattern)
7852 (if (not candidates)
7853 (list "*Add to contacts*")
7854 candidates)))
7855 (action-transformer . (lambda (actions candidate)
7856 (anything-c-bbdb-create-contact actions candidate))))
7857 "Needs BBDB.
7859 http://bbdb.sourceforge.net/")
7860 ;; (anything 'anything-c-source-bbdb)
7862 (defun anything-c-bbdb-view-person-action (candidate)
7863 "View BBDB data of single CANDIDATE or marked candidates."
7864 (anything-aif (anything-marked-candidates)
7865 (let ((bbdb-append-records (length it)))
7866 (dolist (i it)
7867 (bbdb-redisplay-one-record (anything-c-bbdb-get-record i))))
7868 (bbdb-redisplay-one-record (anything-c-bbdb-get-record candidate))))
7870 (defun anything-c-bbdb-collect-mail-addresses ()
7871 "Return a list of all mail addresses of records in bbdb buffer."
7872 (with-current-buffer bbdb-buffer-name
7873 (loop for i in bbdb-records
7874 if (bbdb-record-net (car i))
7875 collect (bbdb-dwim-net-address (car i)))))
7877 (defun anything-c-bbdb-compose-mail (candidate)
7878 "Compose a mail with all records of bbdb buffer."
7879 (anything-c-bbdb-view-person-action candidate)
7880 (let* ((address-list (anything-c-bbdb-collect-mail-addresses))
7881 (address-str (mapconcat 'identity address-list ",\n ")))
7882 (compose-mail address-str)))
7884 ;;; Evaluation Result
7885 (defvar anything-c-source-evaluation-result
7886 '((name . "Evaluation Result")
7887 (disable-shortcuts)
7888 (dummy)
7889 (multiline)
7890 (mode-line . "C-RET: nl-and-indent, tab: reindent, C-tab:complete, C-p/n: next/prec-line.")
7891 (filtered-candidate-transformer . (lambda (candidates source)
7892 (list
7893 (condition-case nil
7894 (with-current-buffer anything-current-buffer
7895 (pp-to-string
7896 (eval (read anything-pattern))))
7897 (error "Error")))))
7898 (action . (("Copy result to kill-ring" . (lambda (candidate)
7899 (with-current-buffer anything-buffer
7900 (let ((end (save-excursion
7901 (goto-char (point-max))
7902 (search-backward "\n")
7903 (point))))
7904 (kill-region (point) end)))))
7905 ("copy sexp to kill-ring" . (lambda (candidate)
7906 (kill-new anything-input)))))))
7907 ;; (anything 'anything-c-source-evaluation-result)
7909 ;;;###autoload
7910 (defun anything-eval-expression (arg)
7911 "Preconfigured anything for `anything-c-source-evaluation-result'."
7912 (interactive "P")
7913 (anything :sources 'anything-c-source-evaluation-result
7914 :input (when arg (thing-at-point 'sexp))
7915 :buffer "*anything eval*"
7916 :keymap anything-eval-expression-map))
7918 (defun anything-eval-new-line-and-indent ()
7919 (interactive)
7920 (newline) (lisp-indent-line))
7922 (defvar anything-eval-expression-map
7923 (let ((map (copy-keymap anything-map)))
7924 (define-key map (kbd "<C-return>") 'anything-eval-new-line-and-indent)
7925 (define-key map (kbd "<tab>") 'lisp-indent-line)
7926 (define-key map (kbd "<C-tab>") 'lisp-complete-symbol)
7927 (define-key map (kbd "C-p") 'previous-line)
7928 (define-key map (kbd "C-n") 'next-line)
7929 (define-key map (kbd "<up>") 'previous-line)
7930 (define-key map (kbd "<down>") 'next-line)
7931 (define-key map (kbd "<right>") 'forward-char)
7932 (define-key map (kbd "<left>") 'backward-char)
7933 map))
7935 (defvar anything-eldoc-active-minibuffers-list nil)
7936 (defun anything-eldoc-store-minibuffer ()
7937 "Store minibuffer buffer name in `anything-eldoc-active-minibuffers-list'."
7938 (with-selected-window (minibuffer-window)
7939 (push (buffer-name) anything-eldoc-active-minibuffers-list)))
7941 ;;;###autoload
7942 (defun anything-eval-expression-with-eldoc ()
7943 "Preconfigured anything for `anything-c-source-evaluation-result' with `eldoc' support. "
7944 (interactive)
7945 (let ((timer (run-with-idle-timer eldoc-idle-delay
7946 'repeat 'anything-eldoc-show-in-eval))
7947 (minibuffer-completing-symbol t) ; Enable lisp completion.
7948 (completion-cycle-threshold t)) ; Always cycle, no pesty completion buffer (emacs24 only).
7949 (unwind-protect
7950 (minibuffer-with-setup-hook
7951 'anything-eldoc-store-minibuffer
7952 (call-interactively 'anything-eval-expression))
7953 (and timer (cancel-timer timer))
7954 (setq anything-eldoc-active-minibuffers-list
7955 (cdr anything-eldoc-active-minibuffers-list)))))
7957 (defun anything-eldoc-show-in-eval ()
7958 "Return eldoc in mode-line for current minibuffer input."
7959 (let ((buf (with-selected-window (minibuffer-window)
7960 (buffer-name))))
7961 (when (member buf anything-eldoc-active-minibuffers-list)
7962 (let* ((str-all (with-current-buffer buf
7963 (minibuffer-completion-contents)))
7964 (sym (when str-all
7965 (with-temp-buffer
7966 (insert str-all)
7967 (goto-char (point-max))
7968 (unless (looking-back ")\\|\"") (forward-char -1))
7969 (eldoc-current-symbol))))
7970 (info-fn (eldoc-fnsym-in-current-sexp))
7971 (doc (or (eldoc-get-var-docstring sym)
7972 (eldoc-get-fnsym-args-string
7973 (car info-fn) (cadr info-fn)))))
7974 (when doc (funcall anything-c-eldoc-in-minibuffer-show-fn doc))))))
7976 (defvar anything-c-eldoc-show-in-mode-line-delay 12)
7977 (defun anything-c-eldoc-show-in-mode-line (str)
7978 "Show string STR in mode-line."
7979 (save-window-excursion
7980 (with-current-buffer anything-buffer
7981 (let ((mode-line-format (concat " " str)))
7982 (force-mode-line-update)
7983 (sit-for anything-c-eldoc-show-in-mode-line-delay))
7984 (force-mode-line-update))))
7986 ;;; Calculation Result
7987 (defvar anything-c-source-calculation-result
7988 '((name . "Calculation Result")
7989 (dummy)
7990 (filtered-candidate-transformer . (lambda (candidates source)
7991 (list
7992 (condition-case nil
7993 (calc-eval anything-pattern)
7994 (error "error")))))
7995 (action ("Copy result to kill-ring" . kill-new))))
7996 ;; (anything 'anything-c-source-calculation-result)
7998 ;;;###autoload
7999 (defun anything-calcul-expression ()
8000 "Preconfigured anything for `anything-c-source-calculation-result'."
8001 (interactive)
8002 (anything-other-buffer 'anything-c-source-calculation-result "*anything calcul*"))
8004 ;;; Google Suggestions
8005 (defvar anything-ggs-max-length-real-flag 0)
8006 (defvar anything-ggs-max-length-num-flag 0)
8007 (defun anything-c-google-suggest-fetch (input)
8008 "Fetch suggestions for INPUT from XML buffer.
8009 Return an alist with elements like (data . number_results)."
8010 (setq anything-ggs-max-length-real-flag 0
8011 anything-ggs-max-length-num-flag 0)
8012 (let ((request (concat anything-c-google-suggest-url
8013 (url-hexify-string input))))
8014 (flet ((fetch ()
8015 (loop
8016 with result-alist = (xml-get-children
8017 (car (xml-parse-region
8018 (point-min) (point-max)))
8019 'CompleteSuggestion)
8020 for i in result-alist
8021 for data = (cdr (caadr (assoc 'suggestion i)))
8022 for nqueries = (cdr (caadr (assoc 'num_queries i)))
8023 for lqueries = (length (anything-c-ggs-set-number-result
8024 nqueries))
8025 for ldata = (length data)
8027 (progn
8028 (when (> ldata anything-ggs-max-length-real-flag)
8029 (setq anything-ggs-max-length-real-flag ldata))
8030 (when (> lqueries anything-ggs-max-length-num-flag)
8031 (setq anything-ggs-max-length-num-flag lqueries)))
8032 collect (cons data nqueries) into cont
8033 finally return cont)))
8034 (if anything-google-suggest-use-curl-p
8035 (with-temp-buffer
8036 (call-process "curl" nil t nil request)
8037 (fetch))
8038 (with-current-buffer
8039 (url-retrieve-synchronously request)
8040 (fetch))))))
8042 (defun anything-c-google-suggest-set-candidates (&optional request-prefix)
8043 "Set candidates with result and number of google results found."
8044 (let ((suggestions
8045 (loop with suggested-results = (anything-c-google-suggest-fetch
8046 (or (and request-prefix
8047 (concat request-prefix " " anything-pattern))
8048 anything-pattern))
8049 for (real . numresult) in suggested-results
8050 ;; Prepare number of results with ","
8051 for fnumresult = (anything-c-ggs-set-number-result numresult)
8052 ;; Calculate number of spaces to add before fnumresult
8053 ;; if it is smaller than longest result
8054 ;; `anything-ggs-max-length-num-flag'.
8055 ;; e.g 1,234,567
8056 ;; 345,678
8057 ;; To be sure it is aligned properly.
8058 for nspaces = (if (< (length fnumresult) anything-ggs-max-length-num-flag)
8059 (- anything-ggs-max-length-num-flag (length fnumresult))
8061 ;; Add now the spaces before fnumresult.
8062 for align-fnumresult = (concat (make-string nspaces ? ) fnumresult)
8063 for interval = (- anything-ggs-max-length-real-flag (length real))
8064 for spaces = (make-string (+ 2 interval) ? )
8065 for display = (format "%s%s(%s results)" real spaces align-fnumresult)
8066 collect (cons display real))))
8067 (if (loop for (disp . dat) in suggestions
8068 thereis (equal dat anything-pattern))
8069 suggestions
8070 ;; if there is no suggestion exactly matching the input then
8071 ;; prepend a Search on Google item to the list
8072 (append
8073 suggestions
8074 (list (cons (concat "Search for " "'" anything-input "'" " on Google")
8075 anything-input))))))
8077 (defun anything-c-ggs-set-number-result (num)
8078 (if num
8079 (progn
8080 (and (numberp num) (setq num (number-to-string num)))
8081 (loop for i in (reverse (split-string num "" t))
8082 for count from 1
8083 append (list i) into C
8084 when (= count 3)
8085 append (list ",") into C
8086 and do (setq count 0)
8087 finally return
8088 (replace-regexp-in-string
8089 "^," "" (mapconcat 'identity (reverse C) ""))))
8090 "?"))
8092 (defvar anything-c-google-suggest-default-browser-function nil
8093 "*The browse url function you prefer to use with google suggest.
8094 When nil, use the first browser function available
8095 See `anything-browse-url-default-browser-alist'.")
8097 (defun anything-c-google-suggest-action (candidate)
8098 "Default action to jump to a google suggested candidate."
8099 (let ((arg (concat anything-c-google-suggest-search-url
8100 (url-hexify-string candidate))))
8101 (anything-aif anything-c-google-suggest-default-browser-function
8102 (funcall it arg)
8103 (anything-c-browse-url arg))))
8105 (defvar anything-c-google-suggest-default-function
8106 'anything-c-google-suggest-set-candidates
8107 "Default function to use in anything google suggest.")
8109 (defvar anything-c-source-google-suggest
8110 '((name . "Google Suggest")
8111 (candidates . (lambda ()
8112 (funcall anything-c-google-suggest-default-function)))
8113 (action . (("Google Search" . anything-c-google-suggest-action)))
8114 (volatile)
8115 (requires-pattern . 3)
8116 (delayed)))
8118 (defun anything-c-google-suggest-emacs-lisp ()
8119 "Try to emacs lisp complete with google suggestions."
8120 (anything-c-google-suggest-set-candidates "emacs lisp"))
8122 ;; (anything 'anything-c-source-google-suggest)
8124 ;;; Yahoo suggestions
8126 (defun anything-c-yahoo-suggest-fetch (input)
8127 "Fetch Yahoo suggestions for INPUT from XML buffer.
8128 Return an alist with elements like (data . number_results)."
8129 (let ((request (concat anything-c-yahoo-suggest-url
8130 (url-hexify-string input))))
8131 (flet ((fetch ()
8132 (loop
8133 with result-alist = (xml-get-children
8134 (car (xml-parse-region (point-min) (point-max)))
8135 'Result)
8136 for i in result-alist
8137 collect (caddr i))))
8138 (with-current-buffer
8139 (url-retrieve-synchronously request)
8140 (fetch)))))
8142 (defun anything-c-yahoo-suggest-set-candidates ()
8143 "Set candidates with Yahoo results found."
8144 (let ((suggestions (anything-c-yahoo-suggest-fetch anything-input)))
8145 (or suggestions
8146 (append
8147 suggestions
8148 (list (cons (concat "Search for " "'" anything-input "'" " on Yahoo")
8149 anything-input))))))
8151 (defun anything-c-yahoo-suggest-action (candidate)
8152 "Default action to jump to a Yahoo suggested candidate."
8153 (anything-c-browse-url (concat anything-c-yahoo-suggest-search-url
8154 (url-hexify-string candidate))))
8156 (defvar anything-c-source-yahoo-suggest
8157 '((name . "Yahoo Suggest")
8158 (candidates . anything-c-yahoo-suggest-set-candidates)
8159 (action . (("Yahoo Search" . anything-c-yahoo-suggest-action)))
8160 (volatile)
8161 (requires-pattern . 3)
8162 (delayed)))
8164 ;; (anything 'anything-c-source-yahoo-suggest)
8166 ;;; Surfraw
8167 ;;; Need external program surfraw.
8168 ;;; http://surfraw.alioth.debian.org/
8169 ;; user variables
8170 (require 'browse-url)
8171 ;; If default setting of `w3m-command' is not
8172 ;; what you want you and you modify it, you will have to reeval
8173 ;; also `anything-browse-url-default-browser-alist'.
8174 (defvar w3m-command "/usr/bin/w3m")
8175 (defvar anything-c-home-url "http://www.google.fr"
8176 "*Default url to use as home url.")
8178 (defvar browse-url-chromium-program "chromium-browser")
8179 (defvar browse-url-uzbl-program "uzbl-browser")
8180 (defvar anything-browse-url-default-browser-alist
8181 `((,w3m-command . w3m-browse-url)
8182 (,browse-url-firefox-program . browse-url-firefox)
8183 (,browse-url-chromium-program . browse-url-chromium)
8184 (,browse-url-uzbl-program . browse-url-uzbl)
8185 (,browse-url-kde-program . browse-url-kde)
8186 (,browse-url-gnome-moz-program . browse-url-gnome-moz)
8187 (,browse-url-mozilla-program . browse-url-mozilla)
8188 (,browse-url-galeon-program . browse-url-galeon)
8189 (,browse-url-netscape-program . browse-url-netscape)
8190 (,browse-url-mosaic-program . browse-url-mosaic)
8191 (,browse-url-xterm-program . browse-url-text-xterm))
8192 "*Alist of (executable . function) to try to find a suitable url browser.")
8194 (defun* anything-c-generic-browser (url name &rest args)
8195 "Browse URL with NAME browser."
8196 (let ((proc (concat name " " url)))
8197 (message "Starting %s..." name)
8198 (apply 'start-process proc nil name
8199 (append args (list url)))
8200 (set-process-sentinel
8201 (get-process proc)
8202 #'(lambda (process event)
8203 (when (string= event "finished\n")
8204 (message "%s process %s" process event))))))
8206 (defun browse-url-chromium (url)
8207 "Browse URL with google chrome browser."
8208 (interactive "sURL: ")
8209 (anything-c-generic-browser
8210 url browse-url-chromium-program))
8212 (defun browse-url-uzbl (url &optional ignore)
8213 "Browse URL with uzbl browser."
8214 (interactive "sURL: ")
8215 (anything-c-generic-browser url browse-url-uzbl-program "-u"))
8217 (defun anything-browse-url-default-browser (url &rest args)
8218 "Find the first available browser and ask it to load URL."
8219 (let ((default-browser-fn
8220 (loop for (exe . fn) in anything-browse-url-default-browser-alist
8221 thereis (and exe (executable-find exe) fn))))
8222 (if default-browser-fn
8223 (apply default-browser-fn url args)
8224 (error "No usable browser found"))))
8226 (defun* anything-c-browse-url (&optional (url anything-c-home-url))
8227 "Default command to browse URL."
8228 (if browse-url-browser-function
8229 (browse-url url)
8230 (anything-browse-url-default-browser url)))
8232 (defun anything-c-build-elvi-list ()
8233 "Return list of all engines and descriptions handled by surfraw."
8234 (cdr
8235 (with-temp-buffer
8236 (call-process "surfraw" nil t nil
8237 "-elvi")
8238 (split-string (buffer-string) "\n"))))
8240 (defvar anything-surfraw-default-browser-function nil
8241 "*The browse url function you prefer to use with surfraw.
8242 When nil, fallback to `browse-url-browser-function'.")
8243 (defvar anything-surfraw-engines-history nil)
8244 ;;;###autoload
8245 (defun anything-surfraw (pattern engine)
8246 "Preconfigured `anything' to search PATTERN with search ENGINE."
8247 (interactive (list (read-string "SearchFor: ")
8248 (anything-comp-read
8249 "Engine: "
8250 (anything-c-build-elvi-list)
8251 :must-match t
8252 :name "Surfraw Search Engines"
8253 :history anything-surfraw-engines-history)))
8254 (let* ((engine-nodesc (car (split-string engine)))
8255 (url (shell-command-to-string
8256 (format "surfraw %s -p %s"
8257 engine-nodesc pattern)))
8258 (browse-url-browser-function (or anything-surfraw-default-browser-function
8259 browse-url-browser-function)))
8260 (if (string= engine-nodesc "W")
8261 (anything-c-browse-url)
8262 (anything-c-browse-url url)
8263 (setq anything-surfraw-engines-history
8264 (cons engine (delete engine anything-surfraw-engines-history))))))
8266 ;;; Emms
8268 (defun anything-emms-stream-edit-bookmark (elm)
8269 "Change the information of current emms-stream bookmark from anything."
8270 (let* ((cur-buf anything-current-buffer)
8271 (bookmark (assoc elm emms-stream-list))
8272 (name (read-from-minibuffer "Description: "
8273 (nth 0 bookmark)))
8274 (url (read-from-minibuffer "URL: "
8275 (nth 1 bookmark)))
8276 (fd (read-from-minibuffer "Feed Descriptor: "
8277 (int-to-string (nth 2 bookmark))))
8278 (type (read-from-minibuffer "Type (url, streamlist, or lastfm): "
8279 (format "%s" (car (last bookmark))))))
8280 (save-excursion
8281 (emms-streams)
8282 (when (re-search-forward (concat "^" name) nil t)
8283 (beginning-of-line)
8284 (emms-stream-delete-bookmark)
8285 (emms-stream-add-bookmark name url (string-to-number fd) type)
8286 (emms-stream-save-bookmarks-file)
8287 (emms-stream-quit)
8288 (anything-c-switch-to-buffer cur-buf)))))
8290 (defun anything-emms-stream-delete-bookmark (elm)
8291 "Delete an emms-stream bookmark from anything."
8292 (let* ((cur-buf anything-current-buffer)
8293 (bookmark (assoc elm emms-stream-list))
8294 (name (nth 0 bookmark)))
8295 (save-excursion
8296 (emms-streams)
8297 (when (re-search-forward (concat "^" name) nil t)
8298 (beginning-of-line)
8299 (emms-stream-delete-bookmark)
8300 (emms-stream-save-bookmarks-file)
8301 (emms-stream-quit)
8302 (anything-c-switch-to-buffer cur-buf)))))
8304 (defvar anything-c-source-emms-streams
8305 '((name . "Emms Streams")
8306 (init . (lambda ()
8307 (emms-stream-init)))
8308 (candidates . (lambda ()
8309 (mapcar 'car emms-stream-list)))
8310 (action . (("Play" . (lambda (elm)
8311 (let* ((stream (assoc elm emms-stream-list))
8312 (fn (intern (concat "emms-play-" (symbol-name (car (last stream))))))
8313 (url (second stream)))
8314 (funcall fn url))))
8315 ("Delete" . anything-emms-stream-delete-bookmark)
8316 ("Edit" . anything-emms-stream-edit-bookmark)))
8317 (filtered-candidate-transformer . anything-c-adaptive-sort)))
8318 ;; (anything 'anything-c-source-emms-streams)
8320 ;; Don't forget to set `emms-source-file-default-directory'
8321 (defvar anything-c-source-emms-dired
8322 '((name . "Music Directory")
8323 (candidates . (lambda ()
8324 (cddr (directory-files emms-source-file-default-directory))))
8325 (action .
8326 (("Play Directory" . (lambda (item)
8327 (emms-play-directory
8328 (expand-file-name
8329 item
8330 emms-source-file-default-directory))))
8331 ("Open dired in file's directory" . (lambda (item)
8332 (anything-c-open-dired
8333 (expand-file-name
8334 item
8335 emms-source-file-default-directory))))))
8336 (filtered-candidate-transformer . anything-c-adaptive-sort)))
8337 ;; (anything 'anything-c-source-emms-dired)
8340 (defun anything-c-emms-files-modifier (candidates source)
8341 (let ((current-playlist (with-current-emms-playlist
8342 (loop
8343 with cur-list = (emms-playlist-tracks-in-region
8344 (point-min) (point-max))
8345 for i in cur-list
8346 collect (assoc-default 'name i)))))
8347 (loop for i in candidates
8348 if (member (cdr i) current-playlist)
8349 collect (cons (propertize (car i)
8350 'face 'anything-emms-playlist)
8351 (cdr i)) into lis
8352 else collect i into lis
8353 finally return lis)))
8355 (defun anything-c-emms-play-current-playlist ()
8356 "Play current playlist."
8357 (with-current-emms-playlist
8358 (emms-playlist-first)
8359 (emms-playlist-mode-play-smart)))
8361 (defvar anything-c-source-emms-files
8362 '((name . "Emms files")
8363 (candidates . (lambda ()
8364 (loop for v being the hash-values in emms-cache-db
8365 for name = (assoc-default 'name v)
8366 for artist = (or (assoc-default 'info-artist v) "unknown")
8367 for genre = (or (assoc-default 'info-genre v) "unknown")
8368 for tracknum = (or (assoc-default 'info-tracknumber v) "unknown")
8369 for song = (or (assoc-default 'info-title v) "unknown")
8370 for info = (concat artist " - " genre " - " tracknum ": " song)
8371 unless (string-match "^http:" name) collect (cons info name))))
8372 (filtered-candidate-transformer . anything-c-emms-files-modifier)
8373 (action . (("Play file" . emms-play-file)
8374 ("Add to Playlist and play (C-u clear current)"
8375 . (lambda (candidate)
8376 (when anything-current-prefix-arg
8377 (emms-playlist-current-clear))
8378 (emms-playlist-new)
8379 (mapc 'emms-add-playlist-file (anything-marked-candidates))
8380 (unless emms-player-playing-p
8381 (anything-c-emms-play-current-playlist))))))))
8383 ;; (anything 'anything-c-source-emms-files)
8385 ;;; Jabber Contacts (jabber.el)
8386 (defun anything-c-jabber-online-contacts ()
8387 "List online Jabber contacts."
8388 (with-no-warnings
8389 (let (jids)
8390 (dolist (item (jabber-concat-rosters) jids)
8391 (when (get item 'connected)
8392 (push (if (get item 'name)
8393 (cons (get item 'name) item)
8394 (cons (symbol-name item) item)) jids))))))
8396 (defvar anything-c-source-jabber-contacts
8397 '((name . "Jabber Contacts")
8398 (init . (lambda () (require 'jabber)))
8399 (candidates . (lambda () (mapcar 'car (anything-c-jabber-online-contacts))))
8400 (action . (lambda (x)
8401 (jabber-chat-with
8402 (jabber-read-account)
8403 (symbol-name
8404 (cdr (assoc x (anything-c-jabber-online-contacts)))))))))
8405 ;; (anything 'anything-c-source-jabber-contacts)
8408 ;;; Call source.
8409 (defvar anything-source-select-buffer "*anything source select*")
8410 (defvar anything-c-source-call-source
8411 `((name . "Call anything source")
8412 (candidate-number-limit)
8413 (candidates . (lambda ()
8414 (loop for vname in (all-completions "anything-c-source-" obarray)
8415 for var = (intern vname)
8416 for name = (ignore-errors (assoc-default 'name (symbol-value var)))
8417 if name collect (cons (format "%s `%s'"
8418 name (propertize vname 'face 'font-lock-variable-name-face))
8419 var))))
8420 (action . (("Invoke anything with selected source" .
8421 (lambda (candidate)
8422 (setq anything-candidate-number-limit 9999)
8423 (anything candidate nil nil nil nil
8424 anything-source-select-buffer)))
8425 ("Describe variable" . describe-variable)
8426 ("Find variable" . find-variable)))
8427 (persistent-action . describe-variable)
8428 (persistent-help . "Show description of this source")))
8429 ;; (anything 'anything-c-source-call-source)
8431 ;;;###autoload
8432 (defun anything-call-source ()
8433 "Preconfigured `anything' to call anything source."
8434 (interactive)
8435 (anything 'anything-c-source-call-source nil nil nil nil
8436 anything-source-select-buffer))
8438 (defun anything-call-source-from-anything ()
8439 "Call anything source within `anything' session."
8440 (interactive)
8441 (setq anything-input-idle-delay 0)
8442 (anything-set-sources '(anything-c-source-call-source)))
8444 ;;; Execute Preconfigured anything.
8445 (defvar anything-c-source-anything-commands
8446 '((name . "Preconfigured Anything")
8447 (candidates . anything-c-anything-commands-candidates)
8448 (type . command)
8449 (candidate-number-limit)))
8450 ;; (anything 'anything-c-source-anything-commands)
8452 (defun anything-c-anything-commands-candidates ()
8453 (loop for (cmd . desc) in (anything-c-list-preconfigured-anything)
8454 collect (cons (if (where-is-internal cmd nil t)
8455 (substitute-command-keys (format "M-x %s (\\[%s]) : %s" cmd cmd desc))
8456 (substitute-command-keys (format "\\[%s] : %s" cmd desc)))
8457 cmd)))
8459 ;;;###autoload
8460 (defun anything-execute-anything-command ()
8461 "Preconfigured `anything' to execute preconfigured `anything'."
8462 (interactive)
8463 (anything-other-buffer 'anything-c-source-anything-commands
8464 "*anything commands*"))
8466 ;;; Occur
8469 (defun anything-c-occur-init ()
8470 "Create the initial anything occur buffer.
8471 If region is active use region as buffer contents
8472 instead of whole buffer."
8473 (with-current-buffer (anything-candidate-buffer 'global)
8474 (erase-buffer)
8475 (let ((buf-contents
8476 (with-current-buffer anything-current-buffer
8477 (if (anything-region-active-p)
8478 (buffer-substring (region-beginning) (region-end))
8479 (buffer-substring (point-min) (point-max))))))
8480 (insert buf-contents))))
8482 (defun anything-c-occur-get-line (s e)
8483 (format "%7d:%s" (line-number-at-pos (1- s)) (buffer-substring s e)))
8485 (defun anything-c-occur-query-replace-regexp (candidate)
8486 "Query replace regexp starting from CANDIDATE.
8487 If region is active ignore CANDIDATE and replace only in region.
8488 With a prefix arg replace only matches surrounded by word boundaries,
8489 i.e Don't replace inside a word, regexp is surrounded with \\bregexp\\b."
8490 (let ((regexp anything-input))
8491 (unless (anything-region-active-p)
8492 (anything-c-action-line-goto candidate))
8493 (apply 'query-replace-regexp
8494 (anything-c-query-replace-args regexp))))
8496 (defvar anything-c-source-occur
8497 '((name . "Occur")
8498 (init . anything-c-occur-init)
8499 (candidates-in-buffer)
8500 (migemo)
8501 (get-line . anything-c-occur-get-line)
8502 (display-to-real . anything-c-display-to-real-line)
8503 (action . (("Go to Line" . anything-c-action-line-goto)
8504 ("Query replace regexp (C-u Not inside word.)"
8505 . anything-c-occur-query-replace-regexp)))
8506 (recenter)
8507 (requires-pattern . 1)
8508 (delayed)
8509 (volatile)))
8510 ;; (anything 'anything-c-source-occur)
8512 ;;; Anything browse code.
8513 (defun anything-c-browse-code-get-line (beg end)
8514 "Select line if it match the regexp corresponding to current `major-mode'.
8515 Line is parsed for BEG position to END position."
8516 (let ((str-line (buffer-substring beg end))
8517 (regexp (assoc-default major-mode
8518 anything-c-browse-code-regexp-alist))
8519 (num-line (if (string= anything-pattern "") beg (1- beg))))
8520 (when (and regexp (string-match regexp str-line))
8521 (format "%4d:%s" (line-number-at-pos num-line) str-line))))
8524 (defvar anything-c-source-browse-code
8525 '((name . "Browse code")
8526 (init . (lambda ()
8527 (anything-candidate-buffer anything-current-buffer)
8528 (with-current-buffer anything-current-buffer
8529 (jit-lock-fontify-now))))
8530 (candidate-number-limit . 9999)
8531 (candidates-in-buffer)
8532 (get-line . anything-c-browse-code-get-line)
8533 (type . line)
8534 (recenter)))
8536 ;; Do many actions for input
8537 (defvar anything-c-source-create
8538 '((name . "Create")
8539 (dummy)
8540 (action)
8541 (action-transformer . anything-create--actions))
8542 "Do many create actions from `anything-pattern'.
8543 See also `anything-create--actions'.")
8544 ;; (anything 'anything-c-source-create)
8546 (defun anything-create-from-anything ()
8547 "Run `anything-create' from `anything' as a fallback."
8548 (interactive)
8549 (anything-run-after-quit 'anything-create nil anything-pattern))
8551 ;;;###autoload
8552 (defun anything-create (&optional string initial-input)
8553 "Preconfigured `anything' to do many create actions from STRING.
8554 See also `anything-create--actions'."
8555 (interactive)
8556 (setq string (or string (read-string "Create Anything: " initial-input)))
8557 (anything '(((name . "Anything Create")
8558 (header-name . (lambda (_) (format "Action for \"%s\"" string)))
8559 (candidates . anything-create--actions)
8560 (candidate-number-limit)
8561 (action . (lambda (func) (funcall func string)))))))
8563 (defun anything-create--actions (&rest ignored)
8564 "Default actions for `anything-create' / `anything-c-source-create'."
8565 (remove-if-not
8566 (lambda (pair) (and (consp pair) (functionp (cdr pair))))
8567 (append anything-create--actions-private
8568 '(("find-file" . find-file)
8569 ("find-file other window" . find-file-other-window)
8570 ("New buffer" . anything-c-switch-to-buffer)
8571 ("New buffer other window" . switch-to-buffer-other-window)
8572 ("Bookmark Set" . bookmark-set)
8573 ("Set Register" .
8574 (lambda (x) (set-register (read-char "Register: ") x)))
8575 ("Insert Linkd star" . linkd-insert-star)
8576 ("Insert Linkd Tag" . linkd-insert-tag)
8577 ("Insert Linkd Link" . linkd-insert-link)
8578 ("Insert Linkd Lisp" . linkd-insert-lisp)
8579 ("Insert Linkd Wiki" . linkd-insert-wiki)
8580 ("Google Search" . google)))))
8582 ;; Minibuffer History
8583 (defvar anything-c-source-minibuffer-history
8584 '((name . "Minibuffer History")
8585 (header-name . (lambda (name) (format "%s (%s)" name minibuffer-history-variable)))
8586 (candidates
8587 . (lambda ()
8588 (let ((history (loop
8589 for i in (symbol-value minibuffer-history-variable)
8590 unless (string= "" i) collect i)))
8591 (if (consp (car history))
8592 (mapcar 'prin1-to-string history)
8593 history))))
8594 (migemo)
8595 (action . insert)))
8596 ;; (anything 'anything-c-source-minibuffer-history)
8598 ;; elscreen
8599 (defvar anything-c-source-elscreen
8600 '((name . "Elscreen")
8601 (candidates . (lambda ()
8602 (if (cdr (elscreen-get-screen-to-name-alist))
8603 (sort
8604 (loop for sname in (elscreen-get-screen-to-name-alist)
8605 append (list (format "[%d] %s" (car sname) (cdr sname))) into lst
8606 finally (return lst))
8607 #'(lambda (a b) (compare-strings a nil nil b nil nil))))))
8608 (action . (("Change Screen".
8609 (lambda (candidate)
8610 (elscreen-goto (- (aref candidate 1) (aref "0" 0)))))
8611 ("Kill Screen(s)".
8612 (lambda (candidate)
8613 (dolist (i (anything-marked-candidates))
8614 (elscreen-goto (- (aref i 1) (aref "0" 0)))
8615 (elscreen-kill))))
8616 ("Only Screen".
8617 (lambda (candidate)
8618 (elscreen-goto (- (aref candidate 1) (aref "0" 0)))
8619 (elscreen-kill-others)))))))
8620 ;; (anything 'anything-c-source-elscreen)
8622 ;;;; <System>
8624 ;;; Top (process)
8625 (defvar anything-c-top-command "COLUMNS=%s top -b -n 1"
8626 "Top command (batch mode). %s is replaced with `frame-width'.")
8627 (defvar anything-c-source-top
8628 '((name . "Top (Press C-c C-u to refresh)")
8629 (init . anything-c-top-init)
8630 (candidates-in-buffer)
8631 (display-to-real . anything-c-top-display-to-real)
8632 (update . anything-c-top-update)
8633 (persistent-action . anything-c-top-sh-persistent-action)
8634 (persistent-help . "SIGTERM")
8635 (action
8636 ("kill (TERM)" . (lambda (pid) (anything-c-top-sh (format "kill -TERM %s" pid))))
8637 ("kill (KILL)" . (lambda (pid) (anything-c-top-sh (format "kill -KILL %s" pid))))
8638 ("Copy PID" . (lambda (pid) (kill-new pid))))))
8639 ;; (anything 'anything-c-source-top)
8641 (defun anything-c-top-sh (cmd)
8642 (message "Executed %s\n%s" cmd (shell-command-to-string cmd)))
8644 (defun anything-c-top-sh-persistent-action (pid)
8645 (delete-other-windows)
8646 (anything-c-top-sh (format "kill -TERM %s" pid))
8647 (anything-force-update))
8649 (defun anything-c-top-init ()
8650 (with-current-buffer (anything-candidate-buffer 'global)
8651 (call-process-shell-command
8652 (format anything-c-top-command
8653 (- (frame-width) (if anything-enable-digit-shortcuts 4 0)))
8654 nil (current-buffer))))
8656 (defun anything-c-top-display-to-real (line)
8657 (car (split-string line)))
8659 (defun anything-c-top-update ()
8660 (let ((anything-source-name (assoc-default 'name anything-c-source-top))) ;UGLY HACK
8661 (anything-c-top-init)))
8663 ;;;###autoload
8664 (defun anything-top ()
8665 "Preconfigured `anything' for top command."
8666 (interactive)
8667 (let ((anything-samewindow t)
8668 (anything-enable-shortcuts)
8669 (anything-display-function 'anything-default-display-buffer)
8670 (anything-candidate-number-limit 9999))
8671 (save-window-excursion
8672 (delete-other-windows)
8673 (anything-other-buffer 'anything-c-source-top "*anything top*"))))
8675 ;;; Timers
8676 (defvar anything-c-source-absolute-time-timers
8677 '((name . "Absolute Time Timers")
8678 (candidates . timer-list)
8679 (type . timer)))
8680 ;; (anything 'anything-c-source-absolute-time-timers)
8682 (defvar anything-c-source-idle-time-timers
8683 '((name . "Idle Time Timers")
8684 (candidates . timer-idle-list)
8685 (type . timer)))
8686 ;; (anything 'anything-c-source-idle-time-timers)
8688 (defun anything-c-timer-real-to-display (timer)
8689 (destructuring-bind (triggered t1 t2 t3 repeat-delay func args idle-delay)
8690 (append timer nil) ;use `append' to convert vector->list
8691 (format "%s repeat=%5S %s(%s)"
8692 (let ((time (list t1 t2 t3)))
8693 (if idle-delay
8694 (format-time-string "idle-for=%5s" time)
8695 (format-time-string "%m/%d %T" time)))
8696 repeat-delay
8697 func
8698 (mapconcat 'prin1-to-string args " "))))
8700 ;;; X RandR resolution change
8701 ;;; FIXME I do not care multi-display.
8702 (defvar anything-c-xrandr-output "VGA")
8703 (defvar anything-c-xrandr-screen "0")
8704 (defvar anything-c-source-xrandr-change-resolution
8705 '((name . "Change Resolution")
8706 (candidates
8707 . (lambda ()
8708 (with-temp-buffer
8709 (call-process "xrandr" nil (current-buffer) nil
8710 "--screen" anything-c-xrandr-screen "-q")
8711 (goto-char 1)
8712 (loop while (re-search-forward " \\([0-9]+x[0-9]+\\)" nil t)
8713 collect (match-string 1)))))
8714 (action
8715 ("Change Resolution" . (lambda (mode)
8716 (call-process "xrandr" nil nil nil
8717 "--screen" anything-c-xrandr-screen
8718 "--output" anything-c-xrandr-output
8719 "--mode" mode))))))
8720 ;; (anything 'anything-c-source-xrandr-change-resolution)
8722 ;;; Xfont selection
8725 (defun anything-c-persistent-xfont-action (elm)
8726 "Show current font temporarily"
8727 (let ((current-font (cdr (assoc 'font (frame-parameters))))
8728 (default-font elm))
8729 (unwind-protect
8730 (progn (set-frame-font default-font 'keep-size) (sit-for 2))
8731 (set-frame-font current-font))))
8733 (defvar anything-c-xfonts-cache nil)
8734 (defvar anything-c-source-xfonts
8735 '((name . "X Fonts")
8736 (init . (lambda ()
8737 (unless anything-c-xfonts-cache
8738 (setq anything-c-xfonts-cache
8739 (x-list-fonts "*")))))
8740 (candidates . anything-c-xfonts-cache)
8741 (action . (("Copy to kill ring" . (lambda (elm)
8742 (kill-new elm)))
8743 ("Set Font" . (lambda (elm)
8744 (kill-new elm)
8745 (set-frame-font elm 'keep-size)
8746 (message "New font have been copied to kill ring")))))
8747 (persistent-action . anything-c-persistent-xfont-action)
8748 (persistent-help . "Switch to this font temporarily")))
8750 ;;;###autoload
8751 (defun anything-select-xfont ()
8752 "Preconfigured `anything' to select Xfont."
8753 (interactive)
8754 (anything-other-buffer 'anything-c-source-xfonts "*anything select* xfont"))
8756 ;; (anything 'anything-c-source-xfonts)
8758 ;;; World time
8761 (defvar anything-c-source-time-world
8762 '((name . "Time World List")
8763 (init . (lambda ()
8764 (let ((anything-buffer (anything-candidate-buffer 'global)))
8765 (with-current-buffer anything-buffer
8766 (display-time-world-display display-time-world-list)))))
8767 (candidates-in-buffer)))
8769 ;;;###autoload
8770 (defun anything-world-time ()
8771 "Preconfigured `anything' to show world time."
8772 (interactive)
8773 (anything-other-buffer 'anything-c-source-time-world "*anything world time*"))
8775 ;;; Anything interface for Debian/Ubuntu packages (apt-*)
8778 (defvar anything-c-source-apt
8779 '((name . "APT")
8780 (init . anything-c-apt-init)
8781 (candidates-in-buffer)
8782 (candidate-transformer anything-c-apt-candidate-transformer)
8783 (display-to-real . anything-c-apt-display-to-real)
8784 (requires-pattern . 2)
8785 (delayed)
8786 (action
8787 ("Show package description" . anything-c-apt-cache-show)
8788 ("Install package" . anything-c-apt-install)
8789 ("Remove package" . anything-c-apt-uninstall)
8790 ("Purge package" . anything-c-apt-purge))
8791 (persistent-action . anything-c-apt-persistent-action)
8792 (persistent-help . "Show - C-u Refresh")))
8793 ;; (anything 'anything-c-source-apt)
8795 (defvar anything-c-apt-query "emacs")
8796 (defvar anything-c-apt-search-command "apt-cache search '%s'")
8797 (defvar anything-c-apt-show-command "apt-cache show '%s'")
8798 (defvar anything-c-apt-installed-packages nil)
8799 (defvar anything-c-apt-all-packages nil)
8802 (defun anything-c-apt-refresh ()
8803 "Refresh installed candidates list."
8804 (setq anything-c-apt-installed-packages nil)
8805 (setq anything-c-apt-all-packages nil)
8806 (anything-force-update))
8808 (defun anything-c-apt-persistent-action (candidate)
8809 "Persistent action for APT source."
8810 (if current-prefix-arg
8811 (anything-c-apt-refresh)
8812 (anything-c-apt-cache-show candidate)))
8814 ;;;###autoload
8815 (defun anything-apt (arg query)
8816 "Preconfigured `anything' : frontend of APT package manager.
8817 With a prefix arg reload cache."
8818 (interactive "P\nsSearch Package: ")
8819 (when arg
8820 (setq anything-c-apt-installed-packages nil)
8821 (setq anything-c-apt-all-packages nil))
8822 (anything :sources 'anything-c-source-apt
8823 :prompt "Search Package: " :input query))
8825 (defun anything-c-apt-candidate-transformer (candidates)
8826 "Show installed candidates in a different color."
8827 (loop
8828 with all
8829 for cand in candidates
8830 for name = (anything-c-apt-display-to-real cand)
8831 if (member name anything-c-apt-installed-packages)
8832 collect (propertize cand 'face 'anything-apt-installed) into all
8833 else collect cand into all finally return all))
8835 (defun anything-c-apt-init ()
8836 "Initialize list of debian packages."
8837 (let ((query ""))
8838 (unless (and anything-c-apt-installed-packages
8839 anything-c-apt-all-packages)
8840 (message "Loading package list...")
8841 (setq anything-c-apt-installed-packages
8842 (with-temp-buffer
8843 (call-process-shell-command "dpkg --get-selections"
8844 nil (current-buffer))
8845 (loop for i in (split-string (buffer-string) "\n" t)
8846 collect (car (split-string i)))))
8847 (setq anything-c-apt-all-packages
8848 (with-current-buffer
8849 (anything-candidate-buffer
8850 (get-buffer-create (format "*anything-apt*")))
8851 (erase-buffer)
8852 (call-process-shell-command
8853 (format anything-c-apt-search-command query)
8854 nil (current-buffer))))
8855 (message "Loading package list done")
8856 (sit-for 0.5))))
8858 (defun anything-c-apt-display-to-real (line)
8859 "Return only name of a debian package.
8860 LINE is displayed like:
8861 package name - description."
8862 (car (split-string line " - ")))
8864 (defun anything-c-shell-command-if-needed (command)
8865 "Run shell command COMMAND to describe package.
8866 If a buffer named COMMAND already exists, just switch to it."
8867 (let ((buf (get-buffer command)))
8868 (anything-c-switch-to-buffer (get-buffer-create command))
8869 (unless buf (insert (shell-command-to-string command)))))
8871 (defun anything-c-apt-cache-show (package)
8872 "Show information on apt package PACKAGE."
8873 (anything-c-shell-command-if-needed
8874 (format anything-c-apt-show-command package)))
8876 (defun anything-c-apt-install (package)
8877 "Run 'apt-get install' shell command on PACKAGE."
8878 (anything-c-apt-generic-action :action 'install))
8880 (defun anything-c-apt-uninstall (package)
8881 "Run 'apt-get remove' shell command on PACKAGE."
8882 (anything-c-apt-generic-action :action 'uninstall))
8884 (defun anything-c-apt-purge (package)
8885 "Run 'apt-get purge' shell command on PACKAGE."
8886 (anything-c-apt-generic-action :action 'purge))
8888 (defun* anything-c-apt-generic-action (&key action)
8889 "Run 'apt-get ACTION'.
8890 Support install, remove and purge actions."
8891 (ansi-term (getenv "SHELL") "anything apt")
8892 (term-line-mode)
8893 (let ((command (case action
8894 ('install "sudo apt-get install ")
8895 ('uninstall "sudo apt-get remove ")
8896 ('purge "sudo apt-get purge ")
8897 (t (error "Unknow action"))))
8898 (beg (point))
8900 (cand-list (mapconcat #'(lambda (x) (format "'%s'" x))
8901 (anything-marked-candidates) " ")))
8902 (goto-char (point-max))
8903 (insert (concat command cand-list))
8904 (setq end (point))
8905 (if (y-or-n-p (format "%s package" (symbol-name action)))
8906 (progn
8907 (setq anything-c-external-commands-list nil)
8908 (setq anything-c-apt-installed-packages nil)
8909 (term-char-mode) (term-send-input))
8910 (delete-region beg end) (term-send-eof) (kill-buffer))))
8912 ;; (anything-c-apt-install "jed")
8914 ;;; Sources for gentoo users
8915 (defvar anything-c-gentoo-use-flags nil)
8916 (defvar anything-c-gentoo-buffer "*anything-gentoo-output*")
8917 (defvar anything-c-cache-gentoo nil)
8918 (defvar anything-c-cache-world nil)
8919 (defvar anything-c-source-gentoo
8920 '((name . "Portage sources")
8921 (init . (lambda ()
8922 (get-buffer-create anything-c-gentoo-buffer)
8923 (unless anything-c-cache-gentoo
8924 (anything-c-gentoo-setup-cache))
8925 (unless anything-c-cache-world
8926 (setq anything-c-cache-world (anything-c-gentoo-get-world)))
8927 (anything-c-gentoo-init-list)))
8928 (candidates-in-buffer)
8929 (match . identity)
8930 (candidate-transformer anything-c-highlight-world)
8931 (action . (("Show package" . (lambda (elm)
8932 (anything-c-gentoo-eshell-action elm "eix")))
8933 ("Show history" . (lambda (elm)
8934 (if (member elm anything-c-cache-world)
8935 (anything-c-gentoo-eshell-action elm "genlop -qe")
8936 (message "No infos on packages not yet installed"))))
8937 ("Copy in kill-ring" . kill-new)
8938 ("insert at point" . insert)
8939 ("Browse HomePage" . (lambda (elm)
8940 (let ((urls (anything-c-gentoo-get-url elm)))
8941 (browse-url (anything-comp-read "Url: " urls :must-match t)))))
8942 ("Show extra infos" . (lambda (elm)
8943 (if (member elm anything-c-cache-world)
8944 (anything-c-gentoo-eshell-action elm "genlop -qi")
8945 (message "No infos on packages not yet installed"))))
8946 ("Show use flags" . (lambda (elm)
8947 (anything-c-gentoo-default-action elm "equery" "-C" "u")
8948 (font-lock-add-keywords nil '(("^\+.*" . font-lock-variable-name-face)))
8949 (font-lock-mode 1)))
8950 ("Run emerge pretend" . (lambda (elm)
8951 (anything-c-gentoo-eshell-action elm "emerge -p")))
8952 ("Emerge" . (lambda (elm)
8953 (anything-gentoo-install elm :action 'install)))
8954 ("Unmerge" . (lambda (elm)
8955 (anything-gentoo-install elm :action 'uninstall)))
8956 ("Show dependencies" . (lambda (elm)
8957 (anything-c-gentoo-default-action elm "equery" "-C" "d")))
8958 ("Show related files" . (lambda (elm)
8959 (anything-c-gentoo-default-action elm "equery" "files")))
8960 ("Refresh" . (lambda (elm)
8961 (anything-c-gentoo-setup-cache)
8962 (setq anything-c-cache-world (anything-c-gentoo-get-world))))))))
8964 ;; (anything 'anything-c-source-gentoo)
8966 (defun* anything-gentoo-install (candidate &key action)
8967 (setq anything-c-external-commands-list nil)
8968 (ansi-term (getenv "SHELL") "Gentoo emerge")
8969 (term-line-mode)
8970 (let ((command (case action
8971 ('install "sudo emerge -av ")
8972 ('uninstall "sudo emerge -avC ")
8973 (t (error "Unknow action"))))
8974 (elms (mapconcat 'identity (anything-marked-candidates) " "))
8975 (beg (point)) end)
8976 (goto-char (point-max))
8977 (insert (concat command elms))
8978 (setq end (point))
8979 (term-char-mode) (term-send-input)))
8981 (defun anything-c-gentoo-default-action (elm command &rest args)
8982 "Gentoo default action that use `anything-c-gentoo-buffer'."
8983 (if (member elm anything-c-cache-world)
8984 (progn
8985 (anything-c-switch-to-buffer anything-c-gentoo-buffer)
8986 (erase-buffer)
8987 (let ((com-list (append args (list elm))))
8988 (apply #'call-process command nil t nil
8989 com-list)))
8990 (message "No infos on packages not yet installed")))
8992 (defvar anything-c-source-use-flags
8993 '((name . "Use Flags")
8994 (init . (lambda ()
8995 (unless anything-c-gentoo-use-flags
8996 (anything-c-gentoo-setup-use-flags-cache))
8997 (anything-c-gentoo-get-use)))
8998 (candidates-in-buffer)
8999 (match . identity)
9000 (candidate-transformer anything-c-highlight-local-use)
9001 (action . (("Description"
9002 . (lambda (elm)
9003 (anything-c-switch-to-buffer anything-c-gentoo-buffer)
9004 (erase-buffer)
9005 (apply #'call-process "euse" nil t nil
9006 `("-i"
9007 ,elm))
9008 (font-lock-add-keywords nil `((,elm . font-lock-variable-name-face)))
9009 (font-lock-mode 1)))
9010 ("Enable"
9011 . (lambda (elm)
9012 (anything-c-gentoo-eshell-action elm "*sudo -p Password: euse -E")))
9013 ("Disable"
9014 . (lambda (elm)
9015 (anything-c-gentoo-eshell-action elm "*sudo -p Password: euse -D")))
9016 ("Remove"
9017 . (lambda (elm)
9018 (anything-c-gentoo-eshell-action elm "*sudo -p Password: euse -P")))
9019 ("Show which dep use this flag"
9020 . (lambda (elm)
9021 (anything-c-switch-to-buffer anything-c-gentoo-buffer)
9022 (erase-buffer)
9023 (apply #'call-process "equery" nil t nil
9024 `("-C"
9026 ,elm))))))))
9029 ;; (anything 'anything-c-source-use-flags)
9031 (defun anything-c-gentoo-init-list ()
9032 "Initialize buffer with all packages in Portage."
9033 (let* ((portage-buf (get-buffer-create "*anything-gentoo*"))
9034 (buf (anything-candidate-buffer 'portage-buf)))
9035 (with-current-buffer buf
9036 (dolist (i anything-c-cache-gentoo)
9037 (insert (concat i "\n"))))))
9039 (defun anything-c-gentoo-setup-cache ()
9040 "Set up `anything-c-cache-gentoo'"
9041 (setq anything-c-cache-gentoo
9042 (split-string (with-temp-buffer
9043 (call-process "eix" nil t nil
9044 "--only-names")
9045 (buffer-string)))))
9047 (defun anything-c-gentoo-eshell-action (elm command)
9048 (when (get-buffer "*EShell Command Output*")
9049 (kill-buffer "*EShell Command Output*"))
9050 (message "Wait searching...")
9051 (let ((buf-fname (buffer-file-name anything-current-buffer)))
9052 (if (and buf-fname (string-match tramp-file-name-regexp buf-fname))
9053 (progn
9054 (save-window-excursion
9055 (pop-to-buffer "*scratch*")
9056 (eshell-command (format "%s %s" command elm)))
9057 (pop-to-buffer "*EShell Command Output*"))
9058 (eshell-command (format "%s %s" command elm)))))
9060 (defun anything-c-gentoo-get-use ()
9061 "Initialize buffer with all use flags."
9062 (let* ((use-buf (get-buffer-create "*anything-gentoo-use*"))
9063 (buf (anything-candidate-buffer 'use-buf)))
9064 (with-current-buffer buf
9065 (dolist (i anything-c-gentoo-use-flags)
9066 (insert (concat i "\n"))))))
9069 (defun anything-c-gentoo-setup-use-flags-cache ()
9070 "Setup `anything-c-gentoo-use-flags'"
9071 (setq anything-c-gentoo-use-flags
9072 (split-string (with-temp-buffer
9073 (call-process "eix" nil t nil
9074 "--print-all-useflags")
9075 (buffer-string)))))
9077 (defun anything-c-gentoo-get-url (elm)
9078 "Return a list of urls from eix output."
9079 (loop
9080 with url-list = (split-string
9081 (with-temp-buffer
9082 (call-process "eix" nil t nil
9083 elm "--format" "<homepage>\n")
9084 (buffer-string)))
9085 with all
9086 for i in url-list
9087 when (and (string-match "^http://.*" i)
9088 (not (member i all)))
9089 collect i into all
9090 finally return all))
9092 (defun anything-c-gentoo-get-world ()
9093 "Return list of all installed package on your system."
9094 (split-string (with-temp-buffer
9095 (call-process "qlist" nil t nil
9096 "-I")
9097 (buffer-string))))
9099 (defun anything-c-gentoo-get-local-use ()
9100 (split-string (with-temp-buffer
9101 (call-process "portageq" nil t nil
9102 "envvar"
9103 "USE")
9104 (buffer-string))))
9107 (defun anything-c-highlight-world (eix)
9108 "Highlight all installed package."
9109 (loop for i in eix
9110 if (member i anything-c-cache-world)
9111 collect (propertize i 'face 'anything-gentoo-match-face)
9112 else
9113 collect i))
9115 (defun anything-c-highlight-local-use (use-flags)
9116 (let ((local-uses (anything-c-gentoo-get-local-use)))
9117 (loop for i in use-flags
9118 if (member i local-uses)
9119 collect (propertize i 'face 'anything-gentoo-match-face)
9120 else
9121 collect i)))
9123 (defvar anything-c-source-emacs-process
9124 '((name . "Emacs Process")
9125 (candidates . (lambda () (mapcar #'process-name (process-list))))
9126 (persistent-action . (lambda (elm)
9127 (delete-process (get-process elm))
9128 (anything-delete-current-selection)))
9129 (persistent-help . "Kill Process")
9130 (action ("Kill Process" . (lambda (elm)
9131 (delete-process (get-process elm)))))))
9133 ;; (anything 'anything-c-source-emacs-process)
9135 ;;; Anything `completing-read' replacement
9138 (defun anything-comp-read-get-candidates (collection &optional test sort-fn alistp)
9139 "Convert COLLECTION to list removing elements that don't match TEST.
9140 SORT-FN is a predicate to sort COLLECTION.
9141 ALISTP is a flag to not use `all-completions' which doesn't handle alists correctly\
9142 for anything.
9143 If collection is an `obarray', a TEST is needed. See `obarray'."
9144 (let ((cands
9145 (cond ((and (eq collection obarray) test)
9146 (all-completions "" collection test))
9147 ((and (vectorp collection) test)
9148 (loop for i across collection when (funcall test i) collect i))
9149 ((vectorp collection)
9150 (loop for i across collection collect i))
9151 ((and alistp test)
9152 (loop for i in collection when (funcall test i) collect i))
9153 (alistp collection)
9154 ((and collection test)
9155 (all-completions "" collection test))
9156 (t (all-completions "" collection)))))
9157 (if sort-fn (sort cands sort-fn) cands)))
9159 (defun anything-cr-default-transformer (candidates source)
9160 "Default filter candidate function for `anything-comp-read'.
9161 Do nothing, just return candidate list unmodified."
9162 candidates)
9164 (defun* anything-comp-read (prompt collection
9165 &key
9166 test
9167 initial-input
9168 (buffer "*Anything Completions*")
9169 must-match
9170 (requires-pattern 0)
9171 (history nil)
9172 (persistent-action nil)
9173 (persistent-help "DoNothing")
9174 (name "Anything Completions")
9175 (volatile t)
9176 sort
9177 (fc-transformer 'anything-cr-default-transformer)
9178 (marked-candidates nil)
9179 (alistp t))
9180 "Anything `completing-read' emulation.
9181 PROMPT is the prompt name to use.
9182 COLLECTION can be a list, vector, obarray or hash-table.
9183 Keys:
9185 TEST: A predicate called with one arg i.e candidate.
9186 INITIAL-INPUT: Same as initial-input arg in `anything'.
9187 BUFFER: Name of anything-buffer.
9188 MUST-MATCH: Candidate selected must be one of COLLECTION.
9189 REQUIRES-PATTERN: Same as anything attribute, default is 0.
9190 HISTORY: A list containing specific history, default is nil.
9191 When it is non--nil, all elements of HISTORY are displayed in
9192 anything-buffer before COLLECTION.
9193 PERSISTENT-ACTION: A function called with one arg i.e candidate.
9194 PERSISTENT-HELP: A string to document PERSISTENT-ACTION.
9195 NAME: The name related to this local source.
9196 VOLATILE: Use volatile attribute.
9197 SORT: A predicate to give to `sort' e.g `string-lessp'.
9198 FC-TRANSFORMER: A `filtered-candidate-transformer' function.
9199 MARKED-CANDIDATES: If non--nil return candidate or marked candidates as a list.
9200 ALISTP: when non--nil \(default\) cdr of alist is returned otherwise it is the car.
9202 Any prefix args passed during `anything-comp-read' invocation will be recorded
9203 in `anything-current-prefix-arg', otherwise if prefix args where given before
9204 `anything-comp-read' invocation, the value of `current-prefix-arg' will be used.
9205 That's mean you can pass prefix arg before or after calling
9206 a command that use `anything-comp-read'.
9207 It support now also a function as argument, See `all-completions' for more details."
9208 (when (get-buffer anything-action-buffer)
9209 (kill-buffer anything-action-buffer))
9210 (flet ((action-fn (candidate)
9211 (if marked-candidates
9212 (anything-marked-candidates)
9213 (identity candidate))))
9214 (let ((hist `((name . ,(format "%s History" name))
9215 (candidates . (lambda ()
9216 (anything-comp-read-get-candidates
9217 history nil nil ,alistp)))
9218 (persistent-action . ,persistent-action)
9219 (persistent-help . ,persistent-help)
9220 (action . ,'action-fn)))
9221 (src `((name . ,name)
9222 (candidates
9223 . (lambda ()
9224 (let ((cands (anything-comp-read-get-candidates
9225 collection test sort alistp)))
9226 (if (or must-match (string= anything-pattern ""))
9227 cands (append (list anything-pattern) cands)))))
9228 (filtered-candidate-transformer ,fc-transformer)
9229 (requires-pattern . ,requires-pattern)
9230 (persistent-action . ,persistent-action)
9231 (persistent-help . ,persistent-help)
9232 (action . ,'action-fn))))
9233 (when volatile (setq src (append src '((volatile)))))
9234 (or (anything
9235 :sources `(,hist ,src)
9236 :input initial-input
9237 :prompt prompt
9238 :resume 'noresume
9239 :buffer buffer)
9240 (keyboard-quit)))))
9242 ;; Generic completing-read
9244 ;; Support also function as collection.
9245 ;; e.g M-x man is supported.
9246 ;; Support hash-table and vectors as collection.
9247 ;; NOTE:
9248 ;; Some crap emacs functions may not be supported
9249 ;; like ffap-alternate-file (bad use of completing-read)
9250 ;; and maybe others.
9251 ;; Provide a mode `anything-completion-mode' which turn on
9252 ;; anything in all `completing-read' and `read-file-name' in Emacs.
9254 (defun anything-completing-read-default
9255 (prompt collection &optional
9256 predicate require-match
9257 initial-input hist def
9258 inherit-input-method)
9259 "An anything replacement of `completing-read'.
9261 Don't use it directly, use instead `anything-comp-read' in your programs \
9262 which is more powerful.
9264 See documentation of `completing-read' and `all-completions' for details."
9265 (let ((init (or def initial-input)))
9266 (anything-comp-read
9267 prompt collection
9268 :test predicate
9269 :fc-transformer #'(lambda (candidates source)
9270 (loop for i in candidates
9271 if (consp i) collect (car i)
9272 else collect i))
9273 :history (eval (or (car-safe hist) hist))
9274 :must-match require-match
9275 :alistp nil
9276 :initial-input init)))
9278 (defun anything-generic-read-file-name
9279 (prompt &optional dir default-filename mustmatch initial predicate)
9280 "An anything replacement of `read-file-name'."
9281 (let* ((default (and default-filename
9282 (if (listp default-filename)
9283 (car default-filename)
9284 default-filename)))
9285 (init (or default initial dir default-directory))
9286 (ini-input (and init (expand-file-name init))))
9287 (anything-c-read-file-name prompt
9288 :initial-input init
9289 :alistp nil
9290 :must-match mustmatch
9291 :test predicate)))
9293 (defvar anything-completion-mode-string " AC")
9294 ;;;###autoload
9295 (define-minor-mode anything-completion-mode
9296 "Toggle generic anything completion."
9297 :group 'anything
9298 :global t
9299 :lighter anything-completion-mode-string
9300 (if anything-completion-mode
9301 (progn
9302 (setq completing-read-function 'anything-completing-read-default
9303 read-file-name-function 'anything-generic-read-file-name)
9304 (message "Anything completion enabled"))
9305 (setq completing-read-function 'completing-read-default
9306 read-file-name-function 'read-file-name-default)
9307 (message "Anything completion disabled")))
9309 ;;; Eshell completion.
9311 ;; Enable like this in .emacs:
9313 ;; (add-hook 'eshell-mode-hook
9314 ;; #'(lambda ()
9315 ;; (define-key eshell-mode-map [remap pcomplete] 'anything-esh-pcomplete)))
9317 (defvar anything-c-source-esh
9318 '((name . "Eshell completions")
9319 (init . (lambda ()
9320 (setq pcomplete-current-completions nil
9321 pcomplete-last-completion-raw nil)))
9322 (candidates . anything-esh-get-candidates)
9323 (action . anything-ec-insert))
9324 "Anything source for Eshell completion.")
9326 ;; Internal.
9327 (defvar anything-ec-target "")
9328 (defun anything-ec-insert (candidate)
9329 "Insert CANDIDATE at point.
9330 This is the same as `ac-insert', just inlined here for compatibility."
9331 (let ((pt (point)))
9332 (when (and anything-ec-target
9333 (search-backward anything-ec-target nil t)
9334 (string= (buffer-substring (point) pt) anything-ec-target))
9335 (delete-region (point) pt)))
9336 (insert candidate))
9338 (defun anything-esh-get-candidates ()
9339 "Get candidates for eshell completion using `pcomplete'."
9340 (catch 'pcompleted
9341 (let* ((pcomplete-stub)
9342 pcomplete-seen pcomplete-norm-func
9343 pcomplete-args pcomplete-last pcomplete-index
9344 (pcomplete-autolist pcomplete-autolist)
9345 (pcomplete-suffix-list pcomplete-suffix-list))
9346 (with-current-buffer anything-current-buffer
9347 (loop
9348 with table = (pcomplete-completions)
9349 with entry = (condition-case nil
9350 ;; For Emacs24
9351 (funcall (pcomplete-entries) anything-pattern nil nil)
9352 ;; Fall back to this in Emacs23 as pcomplete-entries seem broken.
9353 (error
9355 (let ((fc (car (last (pcomplete-parse-arguments)))))
9356 ;; Check if last arg require fname completion.
9357 (and (file-name-directory fc) fc))))
9358 for i in (if (listp table) table ; Emacs23 or commands.
9359 (all-completions pcomplete-stub table)) ; Emacs24
9360 for file-cand = (and entry (expand-file-name i (file-name-directory entry)))
9361 if (and file-cand (file-exists-p file-cand)) collect file-cand into ls
9362 else collect i into ls
9363 finally return
9364 (if (and entry (not (string= entry "")) (file-exists-p entry))
9365 (append (list (expand-file-name entry default-directory)) ls) ls))))))
9367 ;;;###autoload
9368 (defun anything-esh-pcomplete ()
9369 "Preconfigured anything to provide anything completion in eshell."
9370 (interactive)
9371 (let* ((anything-quit-if-no-candidate t)
9372 (anything-execute-action-at-once-if-one t)
9373 (target (thing-at-point 'symbol))
9374 (end (point))
9375 (beg (or (and target (- end (length target)))
9376 ;; Nothing at point.
9377 (progn (insert " ") (point)))))
9378 (setq anything-ec-target (or target " "))
9379 (with-anything-show-completion beg end
9380 (anything :sources 'anything-c-source-esh
9381 :input (anything-ff-set-pattern ; Handle tramp filenames.
9382 (car (last (ignore-errors ; Needed in lisp symbols completion.
9383 (pcomplete-parse-arguments)))))))))
9385 ;;; Eshell history.
9388 (defvar anything-c-source-eshell-history
9389 '((name . "Eshell history")
9390 (init . (lambda ()
9391 (with-current-buffer (anything-candidate-buffer 'global)
9392 (insert-file-contents eshell-history-file-name))))
9393 (candidates-in-buffer)
9394 (action . (lambda (candidate)
9395 (insert candidate))))
9396 "Anything source for Eshell history.")
9398 ;;;###autoload
9399 (defun anything-eshell-history ()
9400 "Preconfigured anything for eshell history."
9401 (interactive)
9402 (let* ((end (point))
9403 (beg (progn (save-excursion (insert " ") (point)))))
9404 (with-anything-show-completion beg end
9405 (anything-other-buffer anything-c-source-eshell-history "*Eshell history*"))))
9407 ;;; Show completion - an alternative of anything-show-completion.el.
9409 ;; Provide show completion with macro `with-anything-show-completion'.
9412 ;; Internal
9413 (defvar anything-c-show-completion-overlay nil)
9415 ;; Called each time cursor move in anything-buffer.
9416 (defun anything-c-show-completion ()
9417 (overlay-put anything-c-show-completion-overlay
9418 'display (anything-get-selection)))
9420 (defun anything-c-completion-init-overlay (beg end)
9421 (and anything-c-turn-on-show-completion
9422 (setq anything-c-show-completion-overlay (make-overlay beg end))
9423 (overlay-put anything-c-show-completion-overlay
9424 'face 'anything-lisp-show-completion)))
9426 (defmacro with-anything-show-completion (beg end &rest body)
9427 "Show anything candidate in an overlay at point.
9428 BEG and END are the beginning and end position of the current completion
9429 in `anything-current-buffer'.
9430 BODY is an anything call where we want to enable show completion.
9431 If `anything-c-turn-on-show-completion' is nil just do nothing."
9432 (declare (indent 2) (debug t))
9433 `(let ((anything-move-selection-after-hook
9434 (and anything-c-turn-on-show-completion
9435 (append (list 'anything-c-show-completion)
9436 anything-move-selection-after-hook))))
9437 (unwind-protect
9438 (progn (anything-c-completion-init-overlay ,beg ,end)
9439 ,@body)
9440 (and anything-c-turn-on-show-completion
9441 (delete-overlay anything-c-show-completion-overlay)))))
9443 ;;; Lisp symbol completion.
9447 ;;;###autoload
9448 (defun anything-lisp-completion-at-point ()
9449 "Anything lisp symbol completion at point."
9450 (interactive)
9451 (let* ((data (lisp-completion-at-point))
9452 (beg (car data))
9453 (end (point)) ; 'cadr data' is wrong when no space after point.
9454 (plist (nthcdr 3 data))
9455 (pred (plist-get plist :predicate))
9456 (lgst-len 0)
9457 (target (and beg end (buffer-substring-no-properties beg end)))
9458 (candidates (all-completions target (nth 2 data) pred))
9459 (anything-quit-if-no-candidate t)
9460 (anything-execute-action-at-once-if-one t)
9461 (anything-match-plugin-enabled
9462 (member 'anything-compile-source--match-plugin
9463 anything-compile-source-functions)))
9464 (if candidates
9465 (with-anything-show-completion beg end
9466 ;; Overlay is initialized now in anything-current-buffer.
9467 (anything
9468 :sources
9469 '((name . "Lisp completion")
9470 (init . (lambda ()
9471 (with-current-buffer (anything-candidate-buffer 'global)
9472 (loop for sym in candidates
9473 for len = (length sym)
9474 when (> len lgst-len) do (setq lgst-len len)
9475 do (insert (concat sym "\n"))))))
9476 (candidates-in-buffer)
9477 (persistent-action . (lambda (candidate)
9478 (let ((cursor-in-echo-area t)
9479 mode-line-in-non-selected-windows)
9480 (anything-c-eldoc-show-in-mode-line
9481 (propertize
9482 (anything-c-get-first-line-documentation
9483 (intern candidate))
9484 'face 'anything-lisp-completion-info)))))
9485 (persistent-help . "Show brief doc in mode-line")
9486 (filtered-candidate-transformer anything-lisp-completion-transformer)
9487 (action . (lambda (candidate)
9488 (delete-region beg end)
9489 (insert candidate))))
9490 :input (if anything-match-plugin-enabled (concat target " ") target)))
9491 (message "[No Match]"))))
9493 (defun anything-lisp-completion-transformer (candidates source)
9494 "Anything candidates transformer for lisp completion."
9495 (declare (special lgst-len))
9496 (loop for c in candidates
9497 for sym = (intern c)
9498 for annot = (cond ((commandp sym) " (Com)")
9499 ((fboundp sym) " (Fun)")
9500 ((boundp sym) " (Var)")
9501 ((facep sym) " (Face)"))
9502 for spaces = (make-string (- lgst-len (length c)) ? )
9503 collect (cons (concat c spaces annot) c)))
9505 (defun anything-c-get-first-line-documentation (sym)
9506 "Return first line documentation of symbol SYM.
9507 If SYM is not documented, return \"Not documented\"."
9508 (let ((doc (cond ((fboundp sym)
9509 (documentation sym t))
9510 ((boundp sym)
9511 (documentation-property sym 'variable-documentation t))
9512 ((facep sym)
9513 (face-documentation sym))
9514 (t nil))))
9515 (if (and doc (not (string= doc ""))
9516 ;; `documentation' return "\n\n(args...)"
9517 ;; for CL-style functions.
9518 (not (string-match-p "^\n\n" doc)))
9519 (car (split-string doc "\n"))
9520 "Not documented")))
9522 ;;; File completion.
9524 ;; Complete file name at point.
9526 ;;;###autoload
9527 (defun anything-c-complete-file-name-at-point ()
9528 "Complete file name at point."
9529 (interactive)
9530 (let* ((init (substring-no-properties (thing-at-point 'filename)))
9531 (end (point))
9532 (beg (- (point) (length init)))
9533 (anything-quit-if-no-candidate t)
9534 (anything-execute-action-at-once-if-one t)
9535 completion)
9536 (with-anything-show-completion beg end
9537 (setq completion (anything-c-read-file-name "FileName: "
9538 :initial-input init
9539 :must-match t)))
9540 (anything-c-insert-file-name-completion-at-point completion)))
9542 ;; Internal
9543 (defvar anything-lisp-completion-counter 0)
9544 ;;;###autoload
9545 (defun anything-lisp-completion-at-point-or-indent (arg)
9546 "First call indent and second call complete lisp symbol.
9547 The second call should happen before `anything-lisp-completion-or-indent-delay',
9548 after this delay, next call will indent again.
9549 After completion, next call is always indent.
9550 See that like click and double mouse click.
9551 One hit indent, two quick hits maybe indent and complete."
9552 (interactive "P")
9553 ;; Be sure `indent-for-tab-command' will not try
9554 ;; to use `completion-at-point'.
9555 (let ((tab-always-indent (if (eq tab-always-indent 'complete)
9556 t tab-always-indent)))
9557 (incf anything-lisp-completion-counter)
9558 (unwind-protect
9559 (if (> anything-lisp-completion-counter 1)
9560 (anything-lisp-completion-or-file-name-at-point)
9561 (indent-for-tab-command arg))
9562 ;; After `anything-lisp-completion-or-indent-delay' seconds
9563 ;; reset to 0.
9564 (run-with-timer anything-lisp-completion-or-indent-delay nil
9565 #'(lambda ()
9566 (setq anything-lisp-completion-counter 0)))
9567 ;; Always reset to 0 at second hit.
9568 (when (eq anything-lisp-completion-counter 2)
9569 (setq anything-lisp-completion-counter 0)))))
9571 ;;;###autoload
9572 (defun anything-lisp-completion-or-file-name-at-point ()
9573 "Complete lisp symbol or filename at point.
9574 Filename completion happen if filename is started in
9575 or between double quotes."
9576 (interactive)
9577 (let ((tap (thing-at-point 'filename)))
9578 (if (and tap (string-match "^\\(~/\\|/\\|[a-zA-Z]\:/\\).*" tap)
9579 (save-excursion (search-backward "\"" (point-at-bol) t)))
9580 (anything-c-complete-file-name-at-point)
9581 (anything-lisp-completion-at-point))))
9583 ;;; Run Externals commands within Emacs with anything completion
9585 (defun anything-c-get-pid-from-process-name (process-name)
9586 "Get pid from running process PROCESS-NAME."
9587 (loop with process-list = (list-system-processes)
9588 for pid in process-list
9589 for process = (assoc-default 'comm (process-attributes pid))
9590 when (and process (string-match process-name process))
9591 return pid))
9594 (defun anything-run-or-raise (exe &optional file)
9595 "Generic command that run asynchronously EXE.
9596 If EXE is already running just jump to his window if `anything-raise-command'
9597 is non--nil.
9598 When FILE argument is provided run EXE with FILE.
9599 In this case EXE must be provided as \"EXE %s\"."
9600 (lexical-let* ((real-com (car (split-string (replace-regexp-in-string
9601 "'%s'" "" exe))))
9602 (proc (if file (concat real-com " " file) real-com)))
9603 (if (get-process proc)
9604 (if anything-raise-command
9605 (shell-command (format anything-raise-command real-com))
9606 (error "Error: %s is already running" real-com))
9607 (when (loop for i in anything-c-external-commands-list thereis real-com)
9608 (message "Starting %s..." real-com)
9609 (if file
9610 (start-process-shell-command proc nil (format exe file))
9611 (start-process-shell-command proc nil real-com))
9612 (set-process-sentinel
9613 (get-process proc)
9614 #'(lambda (process event)
9615 (when (and (string= event "finished\n")
9616 anything-raise-command
9617 (not (anything-c-get-pid-from-process-name real-com)))
9618 (shell-command (format anything-raise-command "emacs")))
9619 (message "%s process...Finished." process))))
9620 (setq anything-c-external-commands-list
9621 (cons real-com
9622 (delete real-com anything-c-external-commands-list))))))
9625 (defvar anything-external-command-history nil)
9626 ;;;###autoload
9627 (defun anything-c-run-external-command (program)
9628 "Preconfigured `anything' to run External PROGRAM asyncronously from Emacs.
9629 If program is already running exit with error.
9630 You can set your own list of commands with
9631 `anything-c-external-commands-list'."
9632 (interactive (list
9633 (anything-comp-read
9634 "RunProgram: "
9635 (anything-c-external-commands-list-1 'sort)
9636 :must-match t
9637 :name "External Commands"
9638 :history anything-external-command-history)))
9639 (anything-run-or-raise program)
9640 (setq anything-external-command-history
9641 (cons program (delete program
9642 (loop for i in anything-external-command-history
9643 when (executable-find i) collect i)))))
9645 (defsubst* anything-c-position (item seq &key (test 'eq))
9646 "A simple and faster replacement of CL `position'."
9647 (loop for i in seq for index from 0
9648 when (funcall test i item) return index))
9650 (defvar anything-c-source-ratpoison-commands
9651 '((name . "Ratpoison Commands")
9652 (init . anything-c-ratpoison-commands-init)
9653 (candidates-in-buffer)
9654 (action ("Execute the command" . anything-c-ratpoison-commands-execute))
9655 (display-to-real . anything-c-ratpoison-commands-display-to-real)
9656 (candidate-number-limit)))
9657 ;; (anything 'anything-c-source-ratpoison-commands)
9659 (defun anything-c-ratpoison-commands-init ()
9660 (unless (anything-candidate-buffer)
9661 (with-current-buffer (anything-candidate-buffer 'global)
9662 ;; with ratpoison prefix key
9663 (save-excursion
9664 (call-process "ratpoison" nil (current-buffer) nil "-c" "help"))
9665 (while (re-search-forward "^\\([^ ]+\\) \\(.+\\)$" nil t)
9666 (replace-match "<ratpoison> \\1: \\2"))
9667 (goto-char (point-max))
9668 ;; direct binding
9669 (save-excursion
9670 (call-process "ratpoison" nil (current-buffer) nil "-c" "help top"))
9671 (while (re-search-forward "^\\([^ ]+\\) \\(.+\\)$" nil t)
9672 (replace-match "\\1: \\2")))))
9674 (defun anything-c-ratpoison-commands-display-to-real (display)
9675 (and (string-match ": " display)
9676 (substring display (match-end 0))))
9678 (defun anything-c-ratpoison-commands-execute (candidate)
9679 (call-process "ratpoison" nil nil nil "-ic" candidate))
9681 ;;;###autoload
9682 (defun anything-ratpoison-commands ()
9683 "Preconfigured `anything' to execute ratpoison commands."
9684 (interactive)
9685 (anything-other-buffer 'anything-c-source-ratpoison-commands
9686 "*anything ratpoison commands*"))
9688 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Action Helpers ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
9689 ;;; Files
9690 (defvar anything-c-external-commands-list nil
9691 "A list of all external commands the user can execute. If this
9692 variable is not set by the user, it will be calculated
9693 automatically.")
9695 (defun anything-c-external-commands-list-1 (&optional sort)
9696 "Returns a list of all external commands the user can execute.
9697 If `anything-c-external-commands-list' is non-nil it will
9698 return its contents. Else it calculates all external commands
9699 and sets `anything-c-external-commands-list'."
9700 (if anything-c-external-commands-list
9701 anything-c-external-commands-list
9702 (setq anything-c-external-commands-list
9703 (loop
9704 with paths = (split-string (getenv "PATH") path-separator)
9705 with completions = ()
9706 for dir in paths
9707 when (and (file-exists-p dir) (file-accessible-directory-p dir))
9708 for lsdir = (loop for i in (directory-files dir t)
9709 for bn = (file-name-nondirectory i)
9710 when (and (not (member bn completions))
9711 (not (file-directory-p i))
9712 (file-executable-p i))
9713 collect bn)
9714 append lsdir into completions
9715 finally return (if sort (sort completions 'string-lessp) completions)))))
9718 (defun anything-c-file-buffers (filename)
9719 "Returns a list of buffer names corresponding to FILENAME."
9720 (let ((name (expand-file-name filename))
9721 (buf-list ()))
9722 (dolist (buf (buffer-list) buf-list)
9723 (let ((bfn (buffer-file-name buf)))
9724 (when (and bfn (string= name bfn))
9725 (push (buffer-name buf) buf-list))))))
9728 (defun anything-c-delete-file (file)
9729 "Delete the given file after querying the user.
9730 Ask to kill buffers associated with that file, too."
9731 (let ((buffers (anything-c-file-buffers file)))
9732 (if (< emacs-major-version 24)
9733 ;; `dired-delete-file' in Emacs versions < 24
9734 ;; doesn't support delete-by-moving-to-trash
9735 ;; so use `delete-directory' and `delete-file'
9736 ;; that handle it.
9737 (cond ((and (not (file-symlink-p file))
9738 (file-directory-p file)
9739 (directory-files file t dired-re-no-dot))
9740 (when (y-or-n-p (format "Recursive delete of `%s'? " file))
9741 (delete-directory file 'recursive)))
9742 ((and (not (file-symlink-p file))
9743 (file-directory-p file))
9744 (delete-directory file))
9745 (t (delete-file file)))
9746 (dired-delete-file
9747 file 'dired-recursive-deletes delete-by-moving-to-trash))
9748 (when buffers
9749 (dolist (buf buffers)
9750 (when (y-or-n-p (format "Kill buffer %s, too? " buf))
9751 (kill-buffer buf))))))
9753 (defun anything-get-mailcap-for-file (filename)
9754 "Get the command to use for FILENAME from mailcap files.
9755 The command is like <command %s> and is meant to use with `format'."
9756 (mailcap-parse-mailcaps)
9757 (let* ((ext (file-name-extension filename))
9758 (mime (when ext (mailcap-extension-to-mime ext)))
9759 (result (when mime (mailcap-mime-info mime))))
9760 ;; If elisp file have no associations in .mailcap
9761 ;; `mailcap-maybe-eval' is returned, in this case just return nil.
9762 (when (stringp result) result)))
9764 (defun anything-get-default-program-for-file (filename)
9765 "Try to find a default program to open FILENAME.
9766 Try first in `anything-c-external-programs-associations' and then in mailcap file
9767 if nothing found return nil."
9768 (let* ((ext (file-name-extension filename))
9769 (def-prog (assoc-default ext anything-c-external-programs-associations)))
9770 (cond ((and def-prog (not (string= def-prog "")))
9771 (concat def-prog " %s"))
9772 ((and anything-c-default-external-file-browser
9773 (file-directory-p filename))
9774 (concat anything-c-default-external-file-browser " %s"))
9775 (t (anything-get-mailcap-for-file filename)))))
9777 (defun anything-c-open-file-externally (file)
9778 "Open FILE with an external program.
9779 Try to guess which program to use with `anything-get-default-program-for-file'.
9780 If not found or a prefix arg is given query the user which tool to use."
9781 (let* ((fname (expand-file-name file))
9782 (collection (anything-c-external-commands-list-1 'sort))
9783 (def-prog (anything-get-default-program-for-file fname))
9784 (real-prog-name (if (or anything-current-prefix-arg (not def-prog))
9785 ;; Prefix arg or no default program.
9786 (prog1
9787 (anything-comp-read
9788 "Program: " collection
9789 :must-match t
9790 :name "Open file Externally"
9791 :history anything-external-command-history)
9792 ;; Always prompt to set this program as default.
9793 (setq def-prog nil))
9794 ;; No prefix arg or default program exists.
9795 (replace-regexp-in-string " %s\\| '%s'" "" def-prog)))
9796 (program (concat real-prog-name " '%s'")))
9797 (unless (or def-prog ; Association exists, no need to record it.
9798 ;; Don't try to record non--filenames associations (e.g urls).
9799 (not (file-exists-p fname)))
9800 (when
9801 (y-or-n-p
9802 (format
9803 "Do you want to make `%s' the default program for this kind of files? "
9804 real-prog-name))
9805 (anything-aif (assoc (file-name-extension fname)
9806 anything-c-external-programs-associations)
9807 (setq anything-c-external-programs-associations
9808 (delete it anything-c-external-programs-associations)))
9809 (push (cons (file-name-extension fname)
9810 (read-string
9811 "Program (Add args maybe and confirm): " real-prog-name))
9812 anything-c-external-programs-associations)
9813 (customize-save-variable 'anything-c-external-programs-associations
9814 anything-c-external-programs-associations)))
9815 (anything-run-or-raise program file)
9816 (setq anything-external-command-history
9817 (cons real-prog-name
9818 (delete real-prog-name
9819 (loop for i in anything-external-command-history
9820 when (executable-find i) collect i))))))
9823 ;;;###autoload
9824 (defun w32-shell-execute-open-file (file)
9825 (interactive "fOpen file:")
9826 (with-no-warnings
9827 (w32-shell-execute "open" (replace-regexp-in-string ;for UNC paths
9828 "/" "\\"
9829 (replace-regexp-in-string ; strip cygdrive paths
9830 "/cygdrive/\\(.\\)" "\\1:"
9831 file nil nil) nil t))))
9833 (defun anything-c-open-file-with-default-tool (file)
9834 "Open FILE with the default tool on this platform."
9835 (if (eq system-type 'windows-nt)
9836 (w32-shell-execute-open-file file)
9837 (start-process "anything-c-open-file-with-default-tool"
9839 (cond ((eq system-type 'gnu/linux)
9840 "xdg-open")
9841 ((or (eq system-type 'darwin) ;; Mac OS X
9842 (eq system-type 'macos)) ;; Mac OS 9
9843 "open"))
9844 file)))
9846 (defun anything-c-open-dired (file)
9847 "Opens a dired buffer in FILE's directory. If FILE is a
9848 directory, open this directory."
9849 (if (file-directory-p file)
9850 (dired file)
9851 (dired (file-name-directory file))
9852 (dired-goto-file file)))
9854 (defun anything-c-display-to-real-line (candidate)
9855 (if (string-match "^ *\\([0-9]+\\):\\(.*\\)$" candidate)
9856 (list (string-to-number (match-string 1 candidate)) (match-string 2 candidate))
9857 (error "Line number not found")))
9859 (defun anything-c-action-line-goto (lineno-and-content)
9860 (apply #'anything-goto-file-line (anything-interpret-value (anything-attr 'target-file))
9861 (append lineno-and-content
9862 (list (if (and (anything-attr-defined 'target-file)
9863 (not anything-in-persistent-action))
9864 'find-file-other-window
9865 'find-file)))))
9867 (defun* anything-c-action-file-line-goto (file-line-content &optional (find-file-function #'find-file))
9868 (apply #'anything-goto-file-line
9869 (if (stringp file-line-content)
9870 ;; Case: filtered-candidate-transformer is skipped
9871 (cdr (anything-c-filtered-candidate-transformer-file-line-1 file-line-content))
9872 file-line-content)))
9874 (require 'compile)
9875 (defun anything-c-filtered-candidate-transformer-file-line (candidates source)
9876 (delq nil (mapcar 'anything-c-filtered-candidate-transformer-file-line-1 candidates)))
9878 (defun anything-c-filtered-candidate-transformer-file-line-1 (candidate)
9879 (when (string-match "^\\(.+?\\):\\([0-9]+\\):\\(.*\\)$" candidate)
9880 (let ((filename (match-string 1 candidate))
9881 (lineno (match-string 2 candidate))
9882 (content (match-string 3 candidate)))
9883 (cons (format "%s:%s\n %s"
9884 (propertize filename 'face compilation-info-face)
9885 (propertize lineno 'face compilation-line-face)
9886 content)
9887 (list (expand-file-name
9888 filename
9889 (or (anything-interpret-value (anything-attr 'default-directory))
9890 (and (anything-candidate-buffer)
9891 (buffer-local-value
9892 'default-directory (anything-candidate-buffer)))))
9893 (string-to-number lineno) content)))))
9895 (defun* anything-goto-file-line (file lineno content &optional (find-file-function #'find-file))
9896 (anything-aif (anything-attr 'before-jump-hook)
9897 (funcall it))
9898 (when file (funcall find-file-function file))
9899 (if (anything-attr-defined 'adjust)
9900 (anything-c-goto-line-with-adjustment lineno content)
9901 (anything-goto-line lineno))
9902 (unless (anything-attr-defined 'recenter)
9903 (set-window-start (get-buffer-window anything-current-buffer) (point)))
9904 (anything-aif (anything-attr 'after-jump-hook)
9905 (funcall it))
9906 (when anything-in-persistent-action
9907 (anything-match-line-color-current-line)))
9909 (defun anything-find-file-as-root (candidate)
9910 (find-file (concat "/" anything-su-or-sudo "::" (expand-file-name candidate))))
9912 (defun anything-find-many-files (ignore)
9913 (mapc 'find-file (anything-marked-candidates)))
9915 ;; borrowed from etags.el
9916 ;; (anything-c-goto-line-with-adjustment (line-number-at-pos) ";; borrowed from etags.el")
9917 (defun anything-c-goto-line-with-adjustment (line line-content)
9918 (let ((startpos)
9919 offset found pat)
9920 ;; This constant is 1/2 the initial search window.
9921 ;; There is no sense in making it too small,
9922 ;; since just going around the loop once probably
9923 ;; costs about as much as searching 2000 chars.
9924 (setq offset 1000
9925 found nil
9926 pat (concat (if (eq selective-display t)
9927 "\\(^\\|\^m\\) *" "^ *") ;allow indent
9928 (regexp-quote line-content)))
9929 ;; If no char pos was given, try the given line number.
9930 (setq startpos (progn (anything-goto-line line) (point)))
9931 (or startpos (setq startpos (point-min)))
9932 ;; First see if the tag is right at the specified location.
9933 (goto-char startpos)
9934 (setq found (looking-at pat))
9935 (while (and (not found)
9936 (progn
9937 (goto-char (- startpos offset))
9938 (not (bobp))))
9939 (setq found
9940 (re-search-forward pat (+ startpos offset) t)
9941 offset (* 3 offset))) ; expand search window
9942 (or found
9943 (re-search-forward pat nil t)
9944 (error "not found")))
9945 ;; Position point at the right place
9946 ;; if the search string matched an extra Ctrl-m at the beginning.
9947 (and (eq selective-display t)
9948 (looking-at "\^m")
9949 (forward-char 1))
9950 (beginning-of-line))
9952 (anything-document-attribute 'default-directory "type . file-line"
9953 "`default-directory' to interpret file.")
9954 (anything-document-attribute 'before-jump-hook "type . file-line / line"
9955 "Function to call before jumping to the target location.")
9956 (anything-document-attribute 'after-jump-hook "type . file-line / line"
9957 "Function to call after jumping to the target location.")
9958 (anything-document-attribute 'adjust "type . file-line"
9959 "Search around line matching line contents.")
9960 (anything-document-attribute 'recenter "type . file-line / line"
9961 "`recenter' after jumping.")
9962 (anything-document-attribute 'target-file "type . line"
9963 "Goto line of target-file.")
9965 ;;;###autoload
9966 (defun anything-c-call-interactively (cmd-or-name)
9967 "Execute CMD-OR-NAME as Emacs command.
9968 It is added to `extended-command-history'.
9969 `anything-current-prefix-arg' is used as the command's prefix argument."
9970 (setq extended-command-history
9971 (cons (anything-c-stringify cmd-or-name)
9972 (delete (anything-c-stringify cmd-or-name) extended-command-history)))
9973 (let ((current-prefix-arg anything-current-prefix-arg)
9974 (cmd (anything-c-symbolify cmd-or-name)))
9975 (if (stringp (symbol-function cmd))
9976 (execute-kbd-macro (symbol-function cmd))
9977 (setq this-command cmd)
9978 (call-interactively cmd))))
9980 ;;;###autoload
9981 (defun anything-c-set-variable (var)
9982 "Set value to VAR interactively."
9983 (interactive)
9984 (let ((sym (anything-c-symbolify var)))
9985 (set sym (eval-minibuffer (format "Set %s: " var)
9986 (prin1-to-string (symbol-value sym))))))
9987 ;; (setq hh 12)
9988 ;; (anything-c-set-variable 'hh)
9990 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Persistent Action Helpers ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
9991 (defvar anything-match-line-overlay-face nil)
9992 (defvar anything-match-line-overlay nil)
9994 (defun anything-match-line-color-current-line (&optional start end buf face rec)
9995 "Highlight and underline current position"
9996 (let ((args (list (or start (line-beginning-position))
9997 (or end (1+ (line-end-position)))
9998 buf)))
9999 (if (not anything-match-line-overlay)
10000 (setq anything-match-line-overlay (apply 'make-overlay args))
10001 (apply 'move-overlay anything-match-line-overlay args)))
10002 (overlay-put anything-match-line-overlay
10003 'face (or face anything-match-line-overlay-face))
10004 (when rec
10005 (goto-char start)
10006 (recenter)))
10008 (defalias 'anything-persistent-highlight-point 'anything-match-line-color-current-line)
10011 (setq anything-match-line-overlay-face 'anything-overlay-line-face)
10013 (defun anything-match-line-cleanup ()
10014 (when anything-match-line-overlay
10015 (delete-overlay anything-match-line-overlay)
10016 (setq anything-match-line-overlay nil)))
10018 (defun anything-match-line-update ()
10019 (when anything-match-line-overlay
10020 (delete-overlay anything-match-line-overlay)
10021 (anything-match-line-color-current-line)))
10023 (add-hook 'anything-cleanup-hook 'anything-match-line-cleanup)
10024 (add-hook 'anything-after-persistent-action-hook 'anything-match-line-update)
10026 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Actions Transformers ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10027 ;;; Files
10028 (defun anything-c-transform-file-load-el (actions candidate)
10029 "Add action to load the file CANDIDATE if it is an emacs lisp
10030 file. Else return ACTIONS unmodified."
10031 (if (member (file-name-extension candidate) '("el" "elc"))
10032 (append actions '(("Load Emacs Lisp File" . load-file)))
10033 actions))
10035 (defun anything-c-transform-file-browse-url (actions candidate)
10036 "Add an action to browse the file CANDIDATE if it in a html
10037 file or URL. Else return ACTIONS unmodified."
10038 (let ((browse-action '("Browse with Browser" . browse-url)))
10039 (cond ((string-match "^http\\|^ftp" candidate)
10040 (cons browse-action actions))
10041 ((string-match "\\.html?$" candidate)
10042 (append actions (list browse-action)))
10043 (t actions))))
10045 ;;;; Function
10046 (defun anything-c-transform-function-call-interactively (actions candidate)
10047 "Add an action to call the function CANDIDATE interactively if
10048 it is a command. Else return ACTIONS unmodified."
10049 (if (commandp (intern-soft candidate))
10050 (append actions '(("Call Interactively"
10052 anything-c-call-interactively)))
10053 actions))
10055 ;;;; S-Expressions
10056 (defun anything-c-transform-sexp-eval-command-sexp (actions candidate)
10057 "If CANDIDATE's `car' is a command, then add an action to
10058 evaluate it and put it onto the `command-history'."
10059 (if (commandp (car (read candidate)))
10060 ;; Make it first entry
10061 (cons '("Eval and put onto command-history" .
10062 (lambda (sexp)
10063 (let ((sym (read sexp)))
10064 (eval sym)
10065 (setq command-history
10066 (cons sym command-history)))))
10067 actions)
10068 actions))
10070 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Candidate Transformers ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10071 ;;; Buffers
10072 (defun anything-c-skip-boring-buffers (buffers)
10073 (anything-c-skip-entries buffers anything-c-boring-buffer-regexp))
10075 (defun anything-c-skip-current-buffer (buffers)
10076 (if anything-allow-skipping-current-buffer
10077 (remove (buffer-name anything-current-buffer) buffers)
10078 buffers))
10080 (defun anything-c-shadow-boring-buffers (buffers)
10081 "Buffers matching `anything-c-boring-buffer-regexp' will be
10082 displayed with the `file-name-shadow' face if available."
10083 (anything-c-shadow-entries buffers anything-c-boring-buffer-regexp))
10085 (defvar anything-c-buffer-display-string-functions
10086 '(anything-c-buffer-display-string--compilation
10087 anything-c-buffer-display-string--shell
10088 anything-c-buffer-display-string--eshell)
10089 "Functions to setup display string for buffer.
10091 Function has one argument, buffer name.
10092 If it returns string, use it.
10093 If it returns nil, display buffer name.
10094 See `anything-c-buffer-display-string--compilation' for example.")
10096 (defun anything-c-transform-buffer-display-string (buffers)
10097 "Setup display string for buffer candidates
10098 using `anything-c-buffer-display-string-functions'."
10099 (loop for buf in buffers
10100 if (consp buf)
10101 collect buf
10102 else
10103 for disp = (progn (set-buffer buf)
10104 (run-hook-with-args-until-success
10105 'anything-c-buffer-display-string-functions buf))
10106 collect (if disp (cons disp buf) buf)))
10108 (defun anything-c-buffer-display-string--compilation (buf)
10109 (anything-aif (car compilation-arguments)
10110 (format "%s: %s [%s]" buf it default-directory)))
10111 (defun anything-c-buffer-display-string--eshell (buf)
10112 (when (eq major-mode 'eshell-mode)
10113 (format "%s: %s [%s]" buf
10114 (ignore-errors (ring-ref eshell-history-ring 0))
10115 default-directory)))
10116 (defun anything-c-buffer-display-string--shell (buf)
10117 (when (eq major-mode 'shell-mode)
10118 (format "%s: %s [%s]" buf
10119 (ignore-errors (ring-ref comint-input-ring 0))
10120 default-directory)))
10122 ;;; Files
10123 (defun anything-c-shadow-boring-files (files)
10124 "Files matching `anything-c-boring-file-regexp' will be
10125 displayed with the `file-name-shadow' face if available."
10126 (anything-c-shadow-entries files anything-c-boring-file-regexp))
10128 (defun anything-c-skip-boring-files (files)
10129 "Files matching `anything-c-boring-file-regexp' will be skipped."
10130 (anything-c-skip-entries files anything-c-boring-file-regexp))
10131 ;; (anything-c-skip-boring-files '("README" "/src/.svn/hoge"))
10133 (defun anything-c-skip-current-file (files)
10134 "Current file will be skipped."
10135 (remove (buffer-file-name anything-current-buffer) files))
10137 (defun anything-c-w32-pathname-transformer (args)
10138 "Change undesirable features of windows pathnames to ones more acceptable to
10139 other candidate transformers."
10140 (if (eq system-type 'windows-nt)
10141 (mapcar (lambda (x)
10142 (replace-regexp-in-string "/cygdrive/\\(.\\)" "\\1:" x))
10143 (mapcar (lambda (y)
10144 (replace-regexp-in-string "\\\\" "/" y)) args))
10145 args))
10147 (defun anything-c-shorten-home-path (files)
10148 "Replaces /home/user with ~."
10149 (let ((home (replace-regexp-in-string "\\\\" "/" ; stupid Windows...
10150 (getenv "HOME"))))
10151 (mapcar (lambda (file)
10152 (if (and (stringp file) (string-match home file))
10153 (cons (replace-match "~" nil nil file) file)
10154 file))
10155 files)))
10157 ;;; Functions
10158 (defun anything-c-mark-interactive-functions (functions)
10159 "Mark interactive functions (commands) with (i) after the function name."
10160 (let (list)
10161 (loop for function in functions
10162 do (push (cons (concat function
10163 (when (commandp (intern-soft function)) " (i)"))
10164 function)
10165 list)
10166 finally (return (nreverse list)))))
10168 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Adaptive Sorting of Candidates ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10170 ;; Internal
10171 (defvar anything-c-adaptive-done nil
10172 "nil if history information is not yet stored for the current
10173 selection.")
10175 (defvar anything-c-adaptive-history nil
10176 "Contains the stored history information.
10177 Format: ((SOURCE-NAME (SELECTED-CANDIDATE (PATTERN . NUMBER-OF-USE) ...) ...) ...)")
10179 (defadvice anything-initialize (before anything-c-adaptive-initialize activate)
10180 "Advise `anything-initialize' to reset `anything-c-adaptive-done'
10181 when anything is started."
10182 (when anything-c-use-adaptative-sorting
10183 (setq anything-c-adaptive-done nil)))
10185 (defadvice anything-exit-minibuffer (before anything-c-adaptive-exit-minibuffer activate)
10186 "Advise `anything-exit-minibuffer' to store history information
10187 when a candidate is selected with RET."
10188 (when anything-c-use-adaptative-sorting
10189 (anything-c-adaptive-store-selection)))
10191 (defadvice anything-select-action (before anything-c-adaptive-select-action activate)
10192 "Advise `anything-select-action' to store history information
10193 when the user goes to the action list with TAB."
10194 (when anything-c-use-adaptative-sorting
10195 (anything-c-adaptive-store-selection)))
10197 (defun anything-c-source-use-adaptative-p (&optional source-name)
10198 "Return current source only if it use adaptative history, nil otherwise."
10199 (when anything-c-use-adaptative-sorting
10200 (let* ((source (or source-name (anything-get-current-source)))
10201 (adapt-source (or (assoc-default 'filtered-candidate-transformer
10202 (assoc (assoc-default 'type source)
10203 anything-type-attributes))
10204 (assoc-default 'candidate-transformer
10205 (assoc (assoc-default 'type source)
10206 anything-type-attributes))
10207 (assoc-default 'filtered-candidate-transformer source)
10208 (assoc-default 'candidate-transformer source))))
10209 (if (listp adapt-source)
10210 (when (member 'anything-c-adaptive-sort adapt-source) source)
10211 (when (eq adapt-source 'anything-c-adaptive-sort) source)))))
10213 (defun anything-c-adaptive-store-selection ()
10214 "Store history information for the selected candidate."
10215 (unless anything-c-adaptive-done
10216 (setq anything-c-adaptive-done t)
10217 (let ((source (anything-c-source-use-adaptative-p)))
10218 (when source
10219 (let* ((source-name (or (assoc-default 'type source)
10220 (assoc-default 'name source)))
10221 (source-info (or (assoc source-name anything-c-adaptive-history)
10222 (progn
10223 (push (list source-name) anything-c-adaptive-history)
10224 (car anything-c-adaptive-history))))
10225 (selection (anything-get-selection))
10226 (selection-info (progn
10227 (setcdr source-info
10228 (cons
10229 (let ((found (assoc selection (cdr source-info))))
10230 (if (not found)
10231 ;; new entry
10232 (list selection)
10234 ;; move entry to the beginning of the
10235 ;; list, so that it doesn't get
10236 ;; trimmed when the history is
10237 ;; truncated
10238 (setcdr source-info
10239 (delete found (cdr source-info)))
10240 found))
10241 (cdr source-info)))
10242 (cadr source-info)))
10243 (pattern-info (progn
10244 (setcdr selection-info
10245 (cons
10246 (let ((found (assoc anything-pattern (cdr selection-info))))
10247 (if (not found)
10248 ;; new entry
10249 (cons anything-pattern 0)
10251 ;; move entry to the beginning of the
10252 ;; list, so if two patterns used the
10253 ;; same number of times then the one
10254 ;; used last appears first in the list
10255 (setcdr selection-info
10256 (delete found (cdr selection-info)))
10257 found))
10258 (cdr selection-info)))
10259 (cadr selection-info))))
10261 ;; increase usage count
10262 (setcdr pattern-info (1+ (cdr pattern-info)))
10264 ;; truncate history if needed
10265 (if (> (length (cdr selection-info)) anything-c-adaptive-history-length)
10266 (setcdr selection-info
10267 (subseq (cdr selection-info) 0 anything-c-adaptive-history-length))))))))
10269 (defun anything-c-adaptative-maybe-load-history ()
10270 (when (and anything-c-use-adaptative-sorting
10271 (file-readable-p anything-c-adaptive-history-file))
10272 (load-file anything-c-adaptive-history-file)))
10274 (add-hook 'emacs-startup-hook 'anything-c-adaptative-maybe-load-history)
10275 (add-hook 'kill-emacs-hook 'anything-c-adaptive-save-history)
10277 (defun anything-c-adaptive-save-history ()
10278 "Save history information to file given by `anything-c-adaptive-history-file'."
10279 (interactive)
10280 (when anything-c-use-adaptative-sorting
10281 (with-temp-buffer
10282 (insert
10283 ";; -*- mode: emacs-lisp -*-\n"
10284 ";; History entries used for anything adaptive display.\n")
10285 (prin1 `(setq anything-c-adaptive-history ',anything-c-adaptive-history)
10286 (current-buffer))
10287 (insert ?\n)
10288 (write-region (point-min) (point-max) anything-c-adaptive-history-file nil
10289 (unless (interactive-p) 'quiet)))))
10291 (defun anything-c-adaptive-sort (candidates source)
10292 "Sort the CANDIDATES for SOURCE by usage frequency.
10293 This is a filtered candidate transformer you can use for the
10294 attribute `filtered-candidate-transformer' of a source in
10295 `anything-sources' or a type in `anything-type-attributes'."
10296 (let* ((source-name (or (assoc-default 'type source)
10297 (assoc-default 'name source)))
10298 (source-info (assoc source-name anything-c-adaptive-history)))
10299 (if source-info
10300 (let ((usage
10301 ;; ... assemble a list containing the (CANIDATE . USAGE-COUNT)
10302 ;; pairs
10303 (mapcar (lambda (candidate-info)
10304 (let ((count 0))
10305 (dolist (pattern-info (cdr candidate-info))
10306 (if (not (equal (car pattern-info)
10307 anything-pattern))
10308 (incf count (cdr pattern-info))
10310 ;; if current pattern is equal to the previously
10311 ;; used one then this candidate has priority
10312 ;; (that's why its count is boosted by 10000) and
10313 ;; it only has to compete with other candidates
10314 ;; which were also selected with the same pattern
10315 (setq count (+ 10000 (cdr pattern-info)))
10316 (return)))
10317 (cons (car candidate-info) count)))
10318 (cdr source-info)))
10319 sorted)
10320 (if (and usage (consp usage))
10321 ;; sort the list in descending order, so candidates with highest
10322 ;; priorty come first
10323 (progn
10324 (setq usage (sort usage (lambda (first second)
10325 (> (cdr first) (cdr second)))))
10327 ;; put those candidates first which have the highest usage count
10328 (dolist (info usage)
10329 (when (member* (car info) candidates
10330 :test 'anything-c-adaptive-compare)
10331 (push (car info) sorted)
10332 (setq candidates (remove* (car info) candidates
10333 :test 'anything-c-adaptive-compare))))
10335 ;; and append the rest
10336 (append (reverse sorted) candidates nil))
10337 (message "Your `%s' is maybe corrupted or too old, \
10338 you should reinitialize it with `anything-c-reset-adaptative-history'"
10339 anything-c-adaptive-history-file)
10340 (sit-for 1)
10341 candidates))
10342 ;; if there is no information stored for this source then do nothing
10343 candidates)))
10345 ;;;###autoload
10346 (defun anything-c-reset-adaptative-history ()
10347 "Delete all `anything-c-adaptive-history' and his file.
10348 Useful when you have a old or corrupted `anything-c-adaptive-history-file'."
10349 (interactive)
10350 (when (y-or-n-p "Really delete all your `anything-c-adaptive-history'? ")
10351 (setq anything-c-adaptive-history nil)
10352 (delete-file anything-c-adaptive-history-file)))
10354 (defun anything-c-adaptive-compare (x y)
10355 "Compare candidates X and Y taking into account that the
10356 candidate can be in (DISPLAY . REAL) format."
10357 (equal (if (listp x)
10358 (cdr x)
10360 (if (listp y)
10361 (cdr y)
10362 y)))
10364 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Outliner ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10365 (defvar anything-outline-goto-near-line-flag t)
10366 (defvar anything-outline-using nil)
10367 (defun anything-after-update-hook--outline ()
10368 (if (and (eq anything-outline-using t)
10369 (eq anything-outline-goto-near-line-flag t))
10370 (anything-outline-goto-near-line)))
10371 (add-hook 'anything-after-update-hook 'anything-after-update-hook--outline)
10373 (defun anything-outline-goto-near-line ()
10374 (with-anything-window
10375 ;; TODO need consideration whether to update position by every input.
10376 (when t ; (equal anything-pattern "")
10377 (anything-goto-line 2)
10378 (let ((lineno (with-current-buffer anything-current-buffer
10379 (line-number-at-pos (car anything-current-position)))))
10380 (block exit
10381 (while (<= (progn (skip-chars-forward " ")
10382 (or (number-at-point) lineno))
10383 lineno)
10384 (forward-line 1)
10385 (when (eobp)
10386 (forward-line -1)
10387 (return-from exit))))
10388 (forward-line -1)
10389 (and (bobp) (forward-line 1))
10390 (and (anything-pos-header-line-p) (forward-line -2))
10391 (anything-mark-current-line)))))
10393 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Plug-in ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10394 ;; Plug-in: info-index
10395 (defun* anything-c-info-init (&optional (file (anything-attr 'info-file)))
10396 (let (result)
10397 (unless (anything-candidate-buffer)
10398 (save-window-excursion
10399 (info file)
10400 (let (Info-history
10401 (tobuf (anything-candidate-buffer 'global))
10402 (infobuf (current-buffer))
10403 s e)
10404 (dolist (node (or (anything-attr 'index-nodes) (Info-index-nodes)))
10405 (Info-goto-node node)
10406 (goto-char (point-min))
10407 (while (search-forward "\n* " nil t)
10408 (unless (search-forward "Menu:\n" (1+ (point-at-eol)) t)
10409 '(save-current-buffer (buffer-substring-no-properties (point-at-bol) (point-at-eol)) result)
10410 (setq s (point-at-bol)
10411 e (point-at-eol))
10412 (with-current-buffer tobuf
10413 (insert-buffer-substring infobuf s e)
10414 (insert "\n"))))))))))
10416 (defun anything-c-info-goto (node-line)
10417 (Info-goto-node (car node-line))
10418 (anything-goto-line (cdr node-line)))
10420 (defun anything-c-info-display-to-real (line)
10421 (and (string-match
10422 ;; This regexp is stolen from Info-apropos-matches
10423 "\\* +\\([^\n]*.+[^\n]*\\):[ \t]+\\([^\n]*\\)\\.\\(?:[ \t\n]*(line +\\([0-9]+\\))\\)?" line)
10424 (cons (format "(%s)%s" (anything-attr 'info-file) (match-string 2 line))
10425 (string-to-number (or (match-string 3 line) "1")))))
10427 (defun anything-c-make-info-source (source file)
10428 `(,@source
10429 (name . ,(concat "Info Index: " file))
10430 (info-file . ,file)
10431 (init . anything-c-info-init)
10432 (display-to-real . anything-c-info-display-to-real)
10433 (get-line . buffer-substring)
10434 (candidates-in-buffer)
10435 (action ("Goto node" . anything-c-info-goto))))
10437 (defun anything-compile-source--info-index (source)
10438 (anything-aif (anything-interpret-value (assoc-default 'info-index source))
10439 (anything-c-make-info-source source it)
10440 source))
10441 (add-to-list 'anything-compile-source-functions 'anything-compile-source--info-index)
10443 (anything-document-attribute 'info-index "info-index plugin"
10444 "Create a source of info index very easily.
10446 ex. (defvar anything-c-source-info-wget '((info-index . \"wget\"))")
10448 (anything-document-attribute 'index-nodes "info-index plugin (optional)"
10449 "Index nodes of info file.
10451 If it is omitted, `Info-index-nodes' is used to collect index nodes.
10452 Some info files are missing index specification.
10454 ex. See `anything-c-source-info-screen'.")
10456 ;; Plug-in: candidates-file
10457 (defun anything-compile-source--candidates-file (source)
10458 (if (assoc-default 'candidates-file source)
10459 `((init anything-p-candidats-file-init
10460 ,@(let ((orig-init (assoc-default 'init source)))
10461 (cond ((null orig-init) nil)
10462 ((functionp orig-init) (list orig-init))
10463 (t orig-init))))
10464 (candidates-in-buffer)
10465 ,@source)
10466 source))
10467 (add-to-list 'anything-compile-source-functions 'anything-compile-source--candidates-file)
10469 (defun anything-p-candidats-file-init ()
10470 (destructuring-bind (file &optional updating)
10471 (anything-mklist (anything-attr 'candidates-file))
10472 (setq file (anything-interpret-value file))
10473 (with-current-buffer (anything-candidate-buffer (find-file-noselect file))
10474 (when updating
10475 (buffer-disable-undo)
10476 (font-lock-mode -1)
10477 (auto-revert-mode 1)))))
10479 (anything-document-attribute 'candidates-file "candidates-file plugin"
10480 "Use a file as the candidates buffer.
10482 1st argument is a filename, string or function name or variable name.
10483 If optional 2nd argument is non-nil, the file opened with `auto-revert-mode'.")
10485 ;; Plug-in: headline
10486 (defun anything-compile-source--anything-headline (source)
10487 (if (assoc-default 'headline source)
10488 (append '((init . anything-headline-init)
10489 (get-line . buffer-substring)
10490 (type . line))
10491 source
10492 '((candidates-in-buffer)
10493 (persistent-help . "Show this line")))
10494 source))
10495 (add-to-list 'anything-compile-source-functions 'anything-compile-source--anything-headline)
10497 (defun anything-headline-init ()
10498 (when (and (anything-current-buffer-is-modified)
10499 (with-current-buffer anything-current-buffer
10500 (eval (or (anything-attr 'condition) t))))
10501 (anything-headline-make-candidate-buffer
10502 (anything-interpret-value (anything-attr 'headline))
10503 (anything-interpret-value (anything-attr 'subexp)))))
10505 (anything-document-attribute 'headline "Headline plug-in"
10506 "Regexp string for anything-headline to scan.")
10507 (anything-document-attribute 'condition "Headline plug-in"
10508 "A sexp representing the condition to use anything-headline.")
10509 (anything-document-attribute 'subexp "Headline plug-in"
10510 "Display (match-string-no-properties subexp).")
10513 (defun anything-headline-get-candidates (regexp subexp)
10514 (with-current-buffer anything-current-buffer
10515 (save-excursion
10516 (goto-char (point-min))
10517 (if (functionp regexp) (setq regexp (funcall regexp)))
10518 (let (hierarchy curhead)
10519 (flet ((matched ()
10520 (if (numberp subexp)
10521 (cons (match-string-no-properties subexp) (match-beginning subexp))
10522 (cons (buffer-substring (point-at-bol) (point-at-eol))
10523 (point-at-bol))))
10524 (hierarchies (headlines)
10525 (1+ (loop for (_ . hierarchy) in headlines
10526 maximize hierarchy)))
10527 (vector-0-n (v n)
10528 (loop for i from 0 to hierarchy
10529 collecting (aref curhead i)))
10530 (arrange (headlines)
10531 (unless (null headlines) ; FIX headlines empty bug!
10532 (loop with curhead = (make-vector (hierarchies headlines) "")
10533 for ((str . pt) . hierarchy) in headlines
10534 do (aset curhead hierarchy str)
10535 collecting
10536 (cons
10537 (format "H%d:%s" (1+ hierarchy)
10538 (mapconcat 'identity (vector-0-n curhead hierarchy) " / "))
10539 pt)))))
10540 (if (listp regexp)
10541 (arrange
10542 (sort
10543 (loop for re in regexp
10544 for hierarchy from 0
10545 do (goto-char (point-min))
10546 appending
10547 (loop
10548 while (re-search-forward re nil t)
10549 collect (cons (matched) hierarchy)))
10550 (lambda (a b) (> (cdar b) (cdar a)))))
10551 (loop while (re-search-forward regexp nil t)
10552 collect (matched))))))))
10555 (defun anything-headline-make-candidate-buffer (regexp subexp)
10556 (with-current-buffer (anything-candidate-buffer 'local)
10557 (loop for (content . pos) in (anything-headline-get-candidates regexp subexp)
10558 do (insert
10559 (format "%5d:%s\n"
10560 (with-current-buffer anything-current-buffer
10561 (line-number-at-pos pos))
10562 content)))))
10564 (defun anything-headline-goto-position (pos recenter)
10565 (goto-char pos)
10566 (unless recenter
10567 (set-window-start (get-buffer-window anything-current-buffer) (point))))
10569 (defun anything-revert-buffer (candidate)
10570 (with-current-buffer candidate
10571 (when (or (buffer-modified-p)
10572 (not (verify-visited-file-modtime
10573 (get-buffer candidate))))
10574 (revert-buffer t t))))
10576 (defun anything-revert-marked-buffers (ignore)
10577 (mapc 'anything-revert-buffer (anything-marked-candidates)))
10579 (defun anything-kill-marked-buffers (ignore)
10580 (mapc 'kill-buffer (anything-marked-candidates)))
10582 ;; Plug-in: persistent-help
10583 (defun anything-compile-source--persistent-help (source)
10584 (append source '((header-line . anything-persistent-help-string))))
10585 (add-to-list 'anything-compile-source-functions 'anything-compile-source--persistent-help)
10587 (defun anything-persistent-help-string ()
10588 (substitute-command-keys
10589 (concat "\\<anything-map>\\[anything-execute-persistent-action]: "
10590 (or (anything-interpret-value (anything-attr 'persistent-help))
10591 (anything-aif (or (assoc-default 'persistent-action
10592 (anything-get-current-source))
10593 (assoc-default 'action
10594 (anything-get-current-source)))
10595 (cond ((symbolp it) (symbol-name it))
10596 ((listp it) (or (ignore-errors (caar it)) ""))))
10598 " (keeping session)")))
10600 (anything-document-attribute 'persistent-help "persistent-help plug-in"
10601 "A string to explain persistent-action of this source.
10602 It also accepts a function or a variable name.")
10604 ;;; (anything '(((name . "persistent-help test")(candidates "a")(persistent-help . "TEST"))))
10606 ;; Plug-in: Type customize
10607 (defun anything-c-uniq-list (lst)
10608 "Like `remove-duplicates' in CL.
10609 But cut deeper duplicates and test by `equal'. "
10610 (reverse (remove-duplicates (reverse lst) :test 'equal)))
10611 (defvar anything-additional-type-attributes nil)
10612 (defun anything-c-arrange-type-attribute (type spec)
10613 "Override type attributes by `define-anything-type-attribute'.
10615 The SPEC is like source. The symbol `REST' is replaced with original attribute value.
10617 Example: Set `play-sound-file' as default action
10618 (anything-c-arrange-type-attribute 'file
10619 '((action (\"Play sound\" . play-sound-file)
10620 REST ;; Rest of actions (find-file, find-file-other-window, ...)
10623 (add-to-list 'anything-additional-type-attributes
10624 (cons type
10625 (loop with typeattr = (assoc-default type anything-type-attributes)
10626 for (attr . value) in spec
10627 if (listp value)
10628 collect (cons attr
10629 (anything-c-uniq-list
10630 (loop for v in value
10631 if (eq v 'REST)
10632 append (assoc-default attr typeattr)
10633 else
10634 collect v)))
10635 else
10636 collect (cons attr value)))))
10637 (put 'anything-c-arrange-type-attribute 'lisp-indent-function 1)
10639 (defun anything-compile-source--type-customize (source)
10640 (anything-aif (assoc-default (assoc-default 'type source) anything-additional-type-attributes)
10641 (append it source)
10642 source))
10643 (add-to-list 'anything-compile-source-functions 'anything-compile-source--type-customize t)
10645 ;; Plug-in: default-action
10646 (defun anything-compile-source--default-action (source)
10647 (anything-aif (assoc-default 'default-action source)
10648 (append `((action ,it ,@(remove it (assoc-default 'action source))))
10649 source)
10650 source))
10651 (add-to-list 'anything-compile-source-functions 'anything-compile-source--default-action t)
10652 (anything-document-attribute 'default-action "default-action plug-in"
10653 "Default action.")
10655 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10657 (defun anything-c-find-file-or-marked (candidate)
10658 "Open file CANDIDATE or open anything marked files in background."
10659 (let ((marked (anything-marked-candidates))
10660 (ffap-newfile-prompt anything-ff-newfile-prompt-p)
10661 (find-file-wildcards nil))
10662 (if (> (length marked) 1)
10663 ;; Open all marked files in background and display
10664 ;; the first one.
10665 (progn (mapc 'find-file-noselect (cdr marked))
10666 (find-file (car marked)))
10667 (if (and (not (file-exists-p candidate))
10668 (and ffap-url-regexp
10669 (not (string-match ffap-url-regexp candidate)))
10670 (string-match "/$" candidate))
10671 ;; A a non--existing filename ending with /
10672 ;; Create a directory and jump to it.
10673 (when (y-or-n-p (format "Create directory `%s'? " candidate))
10674 (let ((dirfname (directory-file-name candidate)))
10675 (if (file-exists-p dirfname)
10676 (error "Mkdir: Unable to create directory `%s': file exists."
10677 (anything-c-basename dirfname))
10678 (make-directory candidate 'parent)))
10679 (anything-find-files-1 candidate))
10680 ;; A non--existing filename NOT ending with / or
10681 ;; an existing filename, create or jump to it.
10682 (find-file-at-point (car marked))))))
10684 (defun anything-delete-marked-files (ignore)
10685 (let* ((files (anything-marked-candidates))
10686 (len (length files)))
10687 (if (not (y-or-n-p
10688 (format "Delete *%s File(s):\n%s"
10690 (mapconcat (lambda (f) (format "- %s\n" f)) files ""))))
10691 (message "(No deletions performed)")
10692 (dolist (i files)
10693 (set-text-properties 0 (length i) nil i)
10694 (anything-c-delete-file i))
10695 (message "%s File(s) deleted" len))))
10697 (defun anything-ediff-marked-buffers (candidate &optional merge)
10698 "Ediff 2 marked buffers or 1 marked buffer and current-buffer.
10699 With optional arg `merge' call `ediff-merge-buffers'."
10700 (let ((lg-lst (length (anything-marked-candidates)))
10701 buf1 buf2)
10702 (case lg-lst
10704 (error "Error:You have to mark at least 1 buffer"))
10706 (setq buf1 anything-current-buffer
10707 buf2 (first (anything-marked-candidates))))
10709 (setq buf1 (first (anything-marked-candidates))
10710 buf2 (second (anything-marked-candidates))))
10712 (error "Error:To much buffers marked!")))
10713 (if merge
10714 (ediff-merge-buffers buf1 buf2)
10715 (ediff-buffers buf1 buf2))))
10717 (defun anything-bookmark-get-bookmark-from-name (bmk)
10718 "Return bookmark name even if it is a bookmark with annotation.
10719 e.g prepended with *.
10720 Return nil if bmk is not a valid bookmark."
10721 (let ((bookmark (replace-regexp-in-string "\*" "" bmk)))
10722 (if (assoc bookmark bookmark-alist)
10723 bookmark
10724 (when (assoc bmk bookmark-alist)
10725 bmk))))
10727 (defun anything-delete-marked-bookmarks (ignore)
10728 "Delete this bookmark or all marked bookmarks."
10729 (dolist (i (anything-marked-candidates))
10730 (bookmark-delete (anything-bookmark-get-bookmark-from-name i)
10731 'batch)))
10733 (defun anything-require-or-error (feature function)
10734 (or (require feature nil t)
10735 (error "Need %s to use `%s'." feature function)))
10737 (defun anything-find-buffer-on-elscreen (candidate)
10738 "Open buffer in new screen, if marked buffers open all in elscreens."
10739 (anything-require-or-error 'elscreen 'anything-find-buffer-on-elscreen)
10740 (anything-aif (anything-marked-candidates)
10741 (dolist (i it)
10742 (let ((target-screen (elscreen-find-screen-by-buffer
10743 (get-buffer i) 'create)))
10744 (elscreen-goto target-screen)))
10745 (let ((target-screen (elscreen-find-screen-by-buffer
10746 (get-buffer candidate) 'create)))
10747 (elscreen-goto target-screen))))
10749 (defun anything-elscreen-find-file (file)
10750 (anything-require-or-error 'elscreen 'anything-elscreen-find-file)
10751 (elscreen-find-file file))
10753 ;; Toggle anything-match-plugin
10754 (defvar anything-mp-initial-highlight-delay nil)
10755 (defun anything-c-toggle-match-plugin ()
10756 "Toggle anything-match-plugin."
10757 (interactive)
10758 (let ((anything-match-plugin-enabled
10759 (member 'anything-compile-source--match-plugin
10760 anything-compile-source-functions)))
10761 (flet ((disable-match-plugin ()
10762 (setq anything-compile-source-functions
10763 (delq 'anything-compile-source--match-plugin
10764 anything-compile-source-functions))
10765 (setq anything-mp-initial-highlight-delay
10766 anything-mp-highlight-delay)
10767 (setq anything-mp-highlight-delay nil))
10768 (enable-match-plugin ()
10769 (require 'anything-match-plugin)
10770 (unless anything-mp-initial-highlight-delay
10771 (setq anything-mp-initial-highlight-delay
10772 anything-mp-highlight-delay))
10773 (setq anything-compile-source-functions
10774 (cons 'anything-compile-source--match-plugin
10775 anything-compile-source-functions))
10776 (unless anything-mp-highlight-delay
10777 (setq anything-mp-highlight-delay
10778 anything-mp-initial-highlight-delay))))
10779 (if anything-match-plugin-enabled
10780 (when (y-or-n-p "Really disable match-plugin? ")
10781 (disable-match-plugin)
10782 (message "Anything-match-plugin disabled"))
10783 (when (y-or-n-p "Really enable match-plugin? ")
10784 (enable-match-plugin)
10785 (message "Anything-match-plugin enabled"))))))
10787 ;; anything switch to buffer
10788 ;; Shut up byte compiler in emacs24.
10790 (defun anything-c-switch-to-buffer (buffer-or-name)
10791 "Same as `switch-to-buffer' whithout warnings at compile time."
10792 (with-no-warnings
10793 (switch-to-buffer buffer-or-name)))
10795 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Setup ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10797 ;;;; Type Attributes
10798 (define-anything-type-attribute 'buffer
10799 `((action
10800 ("Switch to buffer" . anything-c-switch-to-buffer)
10801 ,(and (locate-library "popwin") '("Switch to buffer in popup window" . popwin:popup-buffer))
10802 ("Switch to buffer other window" . switch-to-buffer-other-window)
10803 ("Switch to buffer other frame" . switch-to-buffer-other-frame)
10804 ,(and (locate-library "elscreen") '("Display buffer in Elscreen" . anything-find-buffer-on-elscreen))
10805 ("Query replace regexp" . anything-c-buffer-query-replace-regexp)
10806 ("View buffer" . view-buffer)
10807 ("Display buffer" . display-buffer)
10808 ("Grep buffers (C-u grep all buffers)" . anything-c-grep-buffers)
10809 ("Revert buffer(s)" . anything-revert-marked-buffers)
10810 ("Insert buffer" . insert-buffer)
10811 ("Kill buffer(s)" . anything-kill-marked-buffers)
10812 ("Diff with file" . diff-buffer-with-file)
10813 ("Ediff Marked buffers" . anything-ediff-marked-buffers)
10814 ("Ediff Merge marked buffers" . (lambda (candidate)
10815 (anything-ediff-marked-buffers candidate t))))
10816 (persistent-help . "Show this buffer")
10817 (candidate-transformer anything-c-skip-current-buffer
10818 anything-c-skip-boring-buffers
10819 anything-c-transform-buffer-display-string))
10820 "Buffer or buffer name.")
10822 (define-anything-type-attribute 'file
10823 `((action
10824 ("Find file" . anything-find-many-files)
10825 ,(and (locate-library "popwin") '("Find file in popup window" . popwin:find-file))
10826 ("Find file as root" . anything-find-file-as-root)
10827 ("Find file other window" . find-file-other-window)
10828 ("Find file other frame" . find-file-other-frame)
10829 ("Open dired in file's directory" . anything-c-open-dired)
10830 ("Grep File(s) `C-u recurse'" . anything-find-files-grep)
10831 ("Pdfgrep File(s)" . anything-ff-pdfgrep)
10832 ("View file" . view-file)
10833 ("Insert file" . insert-file)
10834 ("Delete file(s)" . anything-delete-marked-files)
10835 ("Open file externally (C-u to choose)" . anything-c-open-file-externally)
10836 ("Open file with default tool" . anything-c-open-file-with-default-tool)
10837 ("Find file in hex dump" . hexl-find-file))
10838 (persistent-help . "Show this file")
10839 (action-transformer anything-c-transform-file-load-el
10840 anything-c-transform-file-browse-url)
10841 (candidate-transformer anything-c-w32-pathname-transformer
10842 anything-c-skip-current-file
10843 anything-c-skip-boring-files
10844 anything-c-shorten-home-path))
10845 "File name.")
10847 (let ((actions '(("Describe command" . describe-function)
10848 ("Add command to kill ring" . anything-c-kill-new)
10849 ("Go to command's definition" . find-function)
10850 ("Debug on entry" . debug-on-entry)
10851 ("Cancel debug on entry" . cancel-debug-on-entry)
10852 ("Trace function" . trace-function)
10853 ("Trace function (background)" . trace-function-background)
10854 ("Untrace function" . untrace-function))))
10855 (define-anything-type-attribute 'command
10856 `((action ("Call interactively" . anything-c-call-interactively)
10857 ,@actions)
10858 ;; Sort commands according to their usage count.
10859 ;(filtered-candidate-transformer . anything-c-adaptive-sort)
10860 (coerce . anything-c-symbolify)
10861 (persistent-action . describe-function))
10862 "Command. (string or symbol)")
10864 (define-anything-type-attribute 'function
10865 `((action . ,actions)
10866 (action-transformer anything-c-transform-function-call-interactively)
10867 (candidate-transformer anything-c-mark-interactive-functions)
10868 (coerce . anything-c-symbolify))
10869 "Function. (string or symbol)"))
10871 (define-anything-type-attribute 'variable
10872 '((action ("Describe variable" . describe-variable)
10873 ("Add variable to kill ring" . anything-c-kill-new)
10874 ("Go to variable's definition" . find-variable)
10875 ("Set variable" . anything-c-set-variable))
10876 (coerce . anything-c-symbolify))
10877 "Variable.")
10879 (define-anything-type-attribute 'sexp
10880 '((action ("Eval s-expression" . (lambda (c) (eval (read c))))
10881 ("Add s-expression to kill ring" . kill-new))
10882 (action-transformer anything-c-transform-sexp-eval-command-sexp))
10883 "String representing S-Expressions.")
10885 (define-anything-type-attribute 'bookmark
10886 `((coerce . anything-bookmark-get-bookmark-from-name)
10887 (action
10888 ("Jump to bookmark" . (lambda (bookmark)
10889 (let ((current-prefix-arg anything-current-prefix-arg))
10890 (bookmark-jump bookmark))
10891 (anything-update)))
10892 ("Jump to BM other window" . (lambda (bookmark)
10893 (bookmark-jump-other-window bookmark)
10894 (anything-update)))
10895 ("Bookmark edit annotation" . bookmark-edit-annotation)
10896 ("Bookmark show annotation" . bookmark-show-annotation)
10897 ("Delete bookmark(s)" . anything-delete-marked-bookmarks)
10898 ,@(and (locate-library "bookmark-extensions")
10899 `(("Edit Bookmark" . bmkext-edit-bookmark)))
10900 ("Rename bookmark" . bookmark-rename)
10901 ("Relocate bookmark" . bookmark-relocate)))
10902 "Bookmark name.")
10904 (define-anything-type-attribute 'line
10905 '((display-to-real . anything-c-display-to-real-line)
10906 (action ("Go to Line" . anything-c-action-line-goto)))
10907 "LINENO:CONTENT string, eg. \" 16:foo\".
10909 Optional `target-file' attribute is a name of target file.
10911 Optional `before-jump-hook' attribute is a function with no
10912 arguments which is called before jumping to position.
10914 Optional `after-jump-hook' attribute is a function with no
10915 arguments which is called after jumping to position.
10917 If `adjust' attribute is specified, searches the line whose
10918 content is CONTENT near the LINENO.
10920 If `recenter' attribute is specified, the line is displayed at
10921 the center of window, otherwise at the top of window.
10924 (define-anything-type-attribute 'file-line
10925 `((filtered-candidate-transformer anything-c-filtered-candidate-transformer-file-line)
10926 (multiline)
10927 (action ("Go to" . anything-c-action-file-line-goto)))
10928 "FILENAME:LINENO:CONTENT string, eg. \"~/.emacs:16:;; comment\".
10930 Optional `default-directory' attribute is a default-directory
10931 FILENAME is interpreted.
10933 Optional `before-jump-hook' attribute is a function with no
10934 arguments which is called before jumping to position.
10936 Optional `after-jump-hook' attribute is a function with no
10937 arguments which is called after jumping to position.
10939 If `adjust' attribute is specified, searches the line whose
10940 content is CONTENT near the LINENO.
10942 If `recenter' attribute is specified, the line is displayed at
10943 the center of window, otherwise at the top of window.
10946 (define-anything-type-attribute 'timer
10947 '((real-to-display . anything-c-timer-real-to-display)
10948 (action ("Cancel Timer" . cancel-timer)
10949 ("Describe Function" . (lambda (tm) (describe-function (timer--function tm))))
10950 ("Find Function" . (lambda (tm) (find-function (timer--function tm)))))
10951 (persistent-action . (lambda (tm) (describe-function (timer--function tm))))
10952 (persistent-help . "Describe Function"))
10953 "Timer.")
10955 ;;;; Default `anything-sources'
10956 ;; Setting `anything-sources' is DEPRECATED, but it seems that newbies
10957 ;; tend to invoke M-x anything directly. So I offer default setting.
10958 (setq anything-sources
10959 '(anything-c-source-buffers-list
10960 anything-c-source-recentf
10961 anything-c-source-files-in-current-dir+))
10963 ;; Unit tests are now in ../developer-tools/unit-test-anything-config.el.
10965 (provide 'anything-config)
10967 ;;; Local Variables:
10968 ;;; time-stamp-format: "%:y-%02m-%02d %02H:%02M:%02S (%Z) %u"
10969 ;;; End:
10971 ;; How to save (DO NOT REMOVE!!)
10972 ;; (progn (magit-push) (emacswiki-post "anything-config.el"))
10973 ;;; anything-config.el ends here
10975 ;;; LocalWords: Tassilo Patrovics Vagn Johansen Dahl Clementson infos
10976 ;;; LocalWords: Kamphausen informations McBrayer Volpiatto bbdb bb
10977 ;;; LocalWords: iswitchb imenu Recentf sym samewindow pos bol eol
10978 ;;; LocalWords: aif str lst func attrib recentf lessp prin mapatoms commandp
10979 ;;; LocalWords: cmd stb Picklist picklist mapcan subentry destructuring dirs
10980 ;;; LocalWords: darwin locat MacOS mdfind Firstname Lastname calc prepend jids
10981 ;;; LocalWords: dotimes Thierry online vname
10982 ;;; LocalWords: csharp javascript lua makefile cperl zcat lineno buf
10983 ;;; LocalWords: multiline href fn cand NewTitle cwd filepath thru ret
10984 ;;; LocalWords: bfn fOpen UNC cygdrive nt xdg macos FILE's elc rx svn hg
10985 ;;; LocalWords: CANDIDATE's darcs facep pathname args pathnames subseq priorty
10986 ;;; LocalWords: Vokes rfind berkeley JST ffap lacarte bos
10987 ;;; LocalWords: Lacarte Minibuf epp LaCarte bm attrset migemo attr conf mklist
10988 ;;; LocalWords: startpos noselect dont desc