* anything-config.el: keep removing obsolete stuff.
[anything-config.git] / anything-config.el
blob3212cdcb4fcbfc8510257e455e0b9d6c32b40313
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+'
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-grep1'.
270 ;; `anything-c-grep-run-default-action'
271 ;; Run grep default action from `anything-do-grep1'.
272 ;; `anything-c-grep-run-other-window-action'
273 ;; Run grep goto other window action from `anything-do-grep1'.
274 ;; `anything-c-grep-run-save-buffer'
275 ;; Run grep save results action from `anything-do-grep1'.
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+' (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.
671 ;;; Code:
673 ;; version check
674 (let ((version "1.263"))
675 (when (and (string= "1." (substring version 0 2))
676 (string-match "1\.\\([0-9]+\\)" anything-version)
677 (< (string-to-number (match-string 1 anything-version))
678 (string-to-number (substring version 2))))
679 (error "Please update anything.el!!
681 http://www.emacswiki.org/cgi-bin/wiki/download/anything.el
683 or M-x install-elisp-from-emacswiki anything.el")))
685 ;; compatibility
686 (unless (fboundp 'window-system)
687 (defun window-system (&optional arg)
688 window-system))
690 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Customize ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
691 (defgroup anything-config nil
692 "Predefined configurations for `anything.el'."
693 :group 'anything)
695 (defcustom anything-c-use-standard-keys nil
696 "Whether use standard keybindings. (no effect)
698 Key definitions in anything-config.el are removed because
699 anything.el uses Emacs-standard keys by default. e.g. M-p/M-n for
700 minibuffer history, C-s for isearch, etc.
702 If you use `iswitchb' with `anything',
703 evaluate (anything-iswitchb-setup) . Then some bindings that
704 conflict with `iswitchb', e.g. C-p/C-n for the minibuffer
705 history, are removed from `anything-map'. "
706 :type 'boolean
707 :group 'anything-config)
709 (defcustom anything-c-adaptive-history-file "~/.emacs.d/anything-c-adaptive-history"
710 "Path of file where history information is stored."
711 :type 'string
712 :group 'anything-config)
714 (defcustom anything-c-adaptive-history-length 50
715 "Maximum number of candidates stored for a source."
716 :type 'number
717 :group 'anything-config)
719 (defcustom anything-c-google-suggest-url
720 "http://google.com/complete/search?output=toolbar&q="
721 "URL used for looking up Google suggestions."
722 :type 'string
723 :group 'anything-config)
725 (defcustom anything-c-google-suggest-search-url
726 "http://www.google.com/search?ie=utf-8&oe=utf-8&q="
727 "URL used for Google searching."
728 :type 'string
729 :group 'anything-config)
731 (defcustom anything-google-suggest-use-curl-p nil
732 "*When non--nil use CURL to get info from `anything-c-google-suggest-url'.
733 Otherwise `url-retrieve-synchronously' is used."
734 :type 'boolean
735 :group 'anything-config)
737 (defcustom anything-c-yahoo-suggest-url
738 "http://search.yahooapis.com/WebSearchService/V1/relatedSuggestion?appid=Generic&query="
739 "Url used for looking up Yahoo suggestions."
740 :type 'string
741 :group 'anything-config)
743 (defcustom anything-c-yahoo-suggest-search-url
744 "http://search.yahoo.com/search?&ei=UTF-8&fr&h=c&p="
745 "Url used for Yahoo searching."
746 :type 'string
747 :group 'anything-config)
749 (defcustom anything-c-boring-buffer-regexp
750 (rx (or
751 (group bos " ")
752 ;; anything-buffer
753 "*anything"
754 ;; echo area
755 " *Echo Area" " *Minibuf"))
756 "The regexp that match boring buffers.
757 Buffer candidates matching this regular expression will be
758 filtered from the list of candidates if the
759 `anything-c-skip-boring-buffers' candidate transformer is used, or
760 they will be displayed with face `file-name-shadow' if
761 `anything-c-shadow-boring-buffers' is used."
762 :type 'string
763 :group 'anything-config)
764 ;; (string-match anything-c-boring-buffer-regexp "buf")
765 ;; (string-match anything-c-boring-buffer-regexp " hidden")
766 ;; (string-match anything-c-boring-buffer-regexp " *Minibuf-1*")
768 (defcustom anything-c-boring-file-regexp
769 (rx (or
770 ;; Boring directories
771 (and "/" (or ".svn" "CVS" "_darcs" ".git" ".hg") (or "/" eol))
772 ;; Boring files
773 (and line-start ".#")
774 (and (or ".class" ".la" ".o" "~") eol)))
775 "The regexp that match boring files.
776 File candidates matching this regular expression will be
777 filtered from the list of candidates if the
778 `anything-c-skip-boring-files' candidate transformer is used, or
779 they will be displayed with face `file-name-shadow' if
780 `anything-c-shadow-boring-files' is used."
781 :type 'string
782 :group 'anything-config)
784 (defcustom anything-kill-ring-threshold 10
785 "*Minimum length to be listed by `anything-c-source-kill-ring'."
786 :type 'integer
787 :group 'anything-config)
789 (defcustom anything-su-or-sudo "su"
790 "What command to use for root access."
791 :type 'string
792 :group 'anything-config)
794 (defcustom anything-for-files-prefered-list
795 '(anything-c-source-ffap-line
796 anything-c-source-ffap-guesser
797 anything-c-source-buffers+
798 anything-c-source-recentf
799 anything-c-source-bookmarks
800 anything-c-source-file-cache
801 anything-c-source-files-in-current-dir+
802 anything-c-source-locate)
803 "Your prefered sources to find files."
804 :type 'list
805 :group 'anything-config)
807 (defcustom anything-create--actions-private nil
808 "User defined actions for `anything-create' / `anything-c-source-create'.
809 It is a list of (DISPLAY . FUNCTION) pairs like `action'
810 attribute of `anything-sources'.
812 It is prepended to predefined pairs."
813 :type 'list
814 :group 'anything-config)
816 (defcustom anything-allow-skipping-current-buffer t
817 "Show current buffer or not in anything buffer"
818 :type 'boolean
819 :group 'anything-config)
821 (defcustom anything-c-enable-eval-defun-hack t
822 "*If non-nil, execute `anything' using the source at point when C-M-x is pressed.
823 This hack is invoked when pressing C-M-x in the form \
824 (defvar anything-c-source-XXX ...) or (setq anything-c-source-XXX ...)."
825 :type 'boolean
826 :group 'anything-config)
828 (defcustom anything-tramp-verbose 0
829 "*Just like `tramp-verbose' but specific to anything.
830 When set to 0 don't show tramp messages in anything.
831 If you want to have the default tramp messages set it to 3."
832 :type 'integer
833 :group 'anything-config)
835 (defcustom anything-raise-command nil
836 "*A shell command to jump to a window running specific program.
837 Need external program wmctrl.
838 This will be use with `format', so use something like \"wmctrl -xa %s\"."
839 :type 'string
840 :group 'anything-config)
842 (defun anything-set-anything-command-map-prefix-key (var key)
843 (when (boundp 'anything-command-map-prefix-key)
844 (global-unset-key (read-kbd-macro anything-command-map-prefix-key)))
845 (setq anything-command-map-prefix-key key)
846 (global-set-key (read-kbd-macro anything-command-map-prefix-key)
847 'anything-command-map))
849 (defcustom anything-command-map-prefix-key "<f5> a"
850 "*The prefix key for all `anything-command-map' commands.
852 !!WARNING!!
853 This default value is very likely to be changed,
854 because it is under discussion."
855 :type 'string
856 :set 'anything-set-anything-command-map-prefix-key
857 :group 'anything-config)
859 (defcustom anything-c-find-files-show-icons nil
860 "*Whether show or hide icons in `anything-find-files'."
861 :type 'boolean
862 :group 'anything-config)
864 (defcustom anything-c-find-files-icons-directory
865 (and (window-system)
866 (dolist (i image-load-path)
867 (if (file-directory-p (expand-file-name "tree-widget/default" (eval i)))
868 (return (expand-file-name "tree-widget/default" (eval i))))))
869 "*Default path where to find files and directory icons."
870 :type 'string
871 :group 'anything-config)
873 (defcustom anything-c-browse-code-regexp-lisp
874 "^ *\(def\\(un\\|subst\\|macro\\|face\\|alias\\|advice\\|struct\\|\
875 type\\|theme\\|var\\|group\\|custom\\|const\\|method\\|class\\)"
876 "*Regexp used to parse lisp buffer when browsing code."
877 :type 'string
878 :group 'anything-config)
880 (defcustom anything-c-browse-code-regexp-python
881 "\\<def\\>\\|\\<class\\>"
882 "*Regexp used to parse python buffer when browsing code."
883 :type 'string
884 :group 'anything-config)
886 (defcustom anything-c-browse-code-regexp-alist
887 `((lisp-interaction-mode . ,anything-c-browse-code-regexp-lisp)
888 (emacs-lisp-mode . ,anything-c-browse-code-regexp-lisp)
889 (lisp-mode . ,anything-c-browse-code-regexp-lisp)
890 (python-mode . ,anything-c-browse-code-regexp-python))
891 "*Alist to store regexps for browsing code corresponding \
892 to a specific `major-mode'."
893 :type 'list
894 :group 'anything-config)
896 (defcustom anything-c-external-programs-associations nil
897 "*Alist to store externals programs associated with file extension.
898 This variable overhide setting in .mailcap file.
899 e.g : '\(\(\"jpg\" . \"gqview\"\) (\"pdf\" . \"xpdf\"\)\) "
900 :type 'list
901 :group 'anything-config)
903 (defcustom anything-ff-auto-update-initial-value t
904 "Auto update when only one candidate directory is matched.
905 This is the default value when starting `anything-find-files'."
906 :group 'anything-config
907 :type 'boolean)
909 (defcustom anything-c-copy-async-prefered-emacs "emacs"
910 "Path to the emacs you want to use for copying async.
911 Emacs versions < 24 fail to copy directory due to a bug not fixed
912 in `copy-directory'."
913 :group 'anything-config
914 :type 'string)
916 (defcustom anything-ff-lynx-style-map t
917 "Use arrow keys to navigate with `anything-find-files'."
918 :group 'anything-config
919 :type 'boolean)
921 (defcustom anything-ff-history-max-length 100
922 "*Number of elements shown in `anything-find-files' history."
923 :group 'anything-config
924 :type 'integer)
926 (defcustom anything-ff-smart-completion t
927 "Try to complete filenames smarter when non--nil.
928 See `anything-ff-transform-fname-for-completion' for more info."
929 :group 'anything-config
930 :type 'boolean)
932 (defcustom anything-ff-default-kbsize 1024.0
933 "Default Kbsize to use for showing files size.
934 It is a float, usually 1024.0 but could be 1000.0 on some systems."
935 :group 'anything-config
936 :type 'float)
938 (defcustom anything-ff-tramp-not-fancy t
939 "No colors when listing remote files when set to non--nil.
940 This make listing much faster, specially on slow machines."
941 :group 'anything-config
942 :type 'boolean)
944 (defcustom anything-ff-exif-data-program "exiftran"
945 "*Program used to extract exif data of an image file."
946 :group 'anything-config
947 :type 'string)
949 (defcustom anything-ff-exif-data-program-args "-d"
950 "*Arguments used for `anything-ff-exif-data-program'."
951 :group 'anything-config
952 :type 'string)
954 (defcustom anything-c-grep-use-ioccur-style-keys t
955 "Use Arrow keys to jump to occurences."
956 :group 'anything-config
957 :type 'boolean)
959 (defcustom anything-c-pdfgrep-default-read-command "xpdf '%f' %p"
960 "Default command to read pdf files from pdfgrep.
961 Where '%f' format spec is filename and '%p' is page number"
962 :group 'anything-config
963 :type 'string)
965 (defcustom anything-c-etags-tag-file-name "TAGS"
966 "Etags tag file name."
967 :type 'string
968 :group 'anything-config)
970 (defcustom anything-c-etags-tag-file-search-limit 10
971 "The limit level of directory to search tag file.
972 Don't search tag file deeply if outside this value."
973 :type 'number
974 :group 'anything-config)
976 (defcustom anything-c-filelist-file-name nil
977 "*Filename of file list.
978 Accept a list of string for multiple files.
980 This file tend to be very large (> 100MB) and recommend to be in ramdisk for speed.
981 File list is created by make-filelist.rb script.
983 Usage:
984 ruby make-filelist.rb > /tmp/all.filelist
986 Then
987 ;; Assume that /tmp is ramdisk or tmpfs
988 (setq anything-grep-candidates-fast-directory-regexp \"^/tmp/\")
989 (setq anything-c-filelist-file-name \"/tmp/all.filelist\")
991 :type 'string
992 :group 'anything-config)
994 (defcustom anything-c-eldoc-in-minibuffer-show-fn 'anything-c-eldoc-show-in-mode-line
995 "A function to display eldoc info.
996 Should take one arg: the string to display."
997 :group 'anything-config
998 :type 'symbol)
1000 (defcustom anything-c-turn-on-show-completion t
1001 "Display candidate in buffer while moving selection when non--nil."
1002 :group 'anything-config
1003 :type 'boolean)
1005 (defcustom anything-lisp-completion-or-indent-delay 0.6
1006 "After this delay `anything-lisp-completion-counter' is reset to 0.
1007 This allow to indent again without completing lisp symbol after this delay.
1008 Default is 0.6 seconds."
1009 :group 'anything-config
1010 :type 'number)
1012 (defcustom anything-c-default-external-file-browser "nautilus"
1013 "Default external file browser for your system.
1014 Directories will be opened externally with it.
1015 Set to nil if you do not have external file browser
1016 or do not want to use it."
1017 :group 'anything-config
1018 :type 'string)
1020 (defcustom anything-c-use-adaptative-sorting nil
1021 "*Wheter to use or not adaptative sorting.
1022 Even if a source use it, it will have no effect when set to nil."
1023 :type 'boolean
1024 :group 'anything-config)
1026 (defcustom anything-ff-newfile-prompt-p t
1027 "Whether Prompt or not when creating new file.
1028 This set `ffap-newfile-prompt'."
1029 :type 'boolean
1030 :group 'anything-config)
1033 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Prefix argument in action ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1034 ;; TODO: This should be integrated in anything.el instead of having
1035 ;; a defadvice here.
1037 (defvar anything-current-prefix-arg nil
1038 "Record `current-prefix-arg' when exiting minibuffer.
1039 It will be cleared at start of next `anything' call when \
1040 `anything-before-initialize-hook' is called.")
1042 (defadvice anything-exit-minibuffer (before anything-current-prefix-arg activate)
1043 (unless anything-current-prefix-arg
1044 (setq anything-current-prefix-arg current-prefix-arg)))
1046 ;; using this hook instead of `anything-after-action-hook'
1047 ;; allow to record the prefix args and keep their values
1048 ;; when using `anything-comp-read'.
1049 ;; i.e when quitting `anything-comp-read' prefix args are preserved
1050 ;; for the following action.
1051 (add-hook 'anything-before-initialize-hook
1052 (lambda () (setq anything-current-prefix-arg nil)))
1054 ;;;###autoload
1055 (defun anything-configuration ()
1056 "Customize `anything'."
1057 (interactive)
1058 (customize-group "anything-config"))
1060 ;;; Anything-command-map
1061 ;;;###autoload
1062 (defvar anything-command-map)
1063 (define-prefix-command 'anything-command-map)
1065 ;; rubikitch: Please change it freely because it is in discussion. I'll track from git.
1066 (define-key anything-command-map (kbd "<SPC>") 'anything-execute-anything-command)
1067 (define-key anything-command-map (kbd "e") 'anything-c-etags-select)
1068 (define-key anything-command-map (kbd "l") 'anything-locate)
1069 (define-key anything-command-map (kbd "s") 'anything-surfraw)
1070 (define-key anything-command-map (kbd "r") 'anything-regexp)
1071 (define-key anything-command-map (kbd "w") 'anything-w3m-bookmarks)
1072 (define-key anything-command-map (kbd "x") 'anything-firefox-bookmarks)
1073 (define-key anything-command-map (kbd "#") 'anything-emms)
1074 (define-key anything-command-map (kbd "m") 'anything-man-woman)
1075 (define-key anything-command-map (kbd "t") 'anything-top)
1076 (define-key anything-command-map (kbd "i") 'anything-imenu)
1077 (define-key anything-command-map (kbd "<tab>") 'anything-lisp-completion-at-point)
1078 (define-key anything-command-map (kbd "p") 'anything-list-emacs-process)
1079 (define-key anything-command-map (kbd "C-x r b") 'anything-c-pp-bookmarks)
1080 (define-key anything-command-map (kbd "M-y") 'anything-show-kill-ring)
1081 (define-key anything-command-map (kbd "C-c <SPC>") 'anything-all-mark-rings)
1082 (define-key anything-command-map (kbd "C-x C-f") 'anything-find-files)
1083 (define-key anything-command-map (kbd "f") 'anything-for-files)
1084 (define-key anything-command-map (kbd "C-:") 'anything-eval-expression-with-eldoc)
1085 (define-key anything-command-map (kbd "C-,") 'anything-calcul-expression)
1086 (define-key anything-command-map (kbd "M-x") 'anything-M-x)
1087 (define-key anything-command-map (kbd "C-x C-w") 'anything-write-file)
1088 (define-key anything-command-map (kbd "C-x i") 'anything-insert-file)
1089 (define-key anything-command-map (kbd "M-s o") 'anything-occur)
1090 (define-key anything-command-map (kbd "M-g s") 'anything-do-grep)
1091 (define-key anything-command-map (kbd "c") 'anything-colors)
1092 (define-key anything-command-map (kbd "F") 'anything-select-xfont)
1093 (define-key anything-command-map (kbd "C-c f") 'anything-recentf)
1094 (define-key anything-command-map (kbd "C-c g") 'anything-google-suggest)
1095 (define-key anything-command-map (kbd "h i") 'anything-info-at-point)
1096 (define-key anything-command-map (kbd "h r") 'anything-info-emacs)
1097 (define-key anything-command-map (kbd "h g") 'anything-info-gnus)
1098 (define-key anything-command-map (kbd "C-x C-b") 'anything-buffers+)
1099 (define-key anything-command-map (kbd "C-c C-b") 'anything-browse-code)
1100 (define-key anything-command-map (kbd "C-x r i") 'anything-register)
1101 (define-key anything-command-map (kbd "C-c C-x") 'anything-c-run-external-command)
1103 ;; In Emacs 23.1.50, minibuffer-local-must-match-filename-map was renamed to
1104 ;; minibuffer-local-filename-must-match-map.
1105 (defvar minibuffer-local-filename-must-match-map (make-sparse-keymap)) ;; Emacs 23.1.+
1106 (defvar minibuffer-local-must-match-filename-map (make-sparse-keymap)) ;; Older Emacsen
1107 (dolist (map (list minibuffer-local-filename-completion-map
1108 minibuffer-local-completion-map
1109 minibuffer-local-must-match-filename-map
1110 minibuffer-local-filename-must-match-map
1111 minibuffer-local-map
1112 minibuffer-local-isearch-map
1113 minibuffer-local-must-match-map
1114 minibuffer-local-ns-map))
1115 (define-key map "\C-r" 'anything-minibuffer-history))
1117 ;;; Menu
1118 (easy-menu-define nil global-map
1119 "`anything' menu"
1120 '("Anything"
1121 ["All anything commands" anything-execute-anything-command t]
1122 ["Find any Files/Buffers" anything-for-files t]
1123 "----"
1124 ("Files:"
1125 ["Find files" anything-find-files t]
1126 ["Recent Files" anything-recentf t]
1127 ["Locate" anything-locate t]
1128 ["Bookmarks" anything-c-pp-bookmarks t])
1129 ("Buffers:"
1130 ["Find buffers" anything-buffers+ t])
1131 ("Commands:"
1132 ["Emacs Commands" anything-M-x t]
1133 ["Externals Commands" anything-c-run-external-command t])
1134 ("Info:"
1135 ["Info at point" anything-info-at-point t]
1136 ["Emacs Manual index" anything-info-emacs t]
1137 ["Gnus Manual index" anything-info-gnus t])
1138 ("Org:"
1139 ["Org keywords" anything-org-keywords t]
1140 ["Org headlines" anything-org-headlines t])
1141 ("Tools:"
1142 ["Occur" anything-occur t]
1143 ["Grep" anything-do-grep t]
1144 ["Etags" anything-c-etags-select t]
1145 ["Lisp complete at point" anything-lisp-completion-at-point t]
1146 ["Browse Kill ring" anything-show-kill-ring t]
1147 ["Browse register" anything-register t]
1148 ["Browse code" anything-browse-code t]
1149 ["Mark Ring" anything-all-mark-rings t]
1150 ["Regexp handler" anything-regexp t]
1151 ["Colors & Faces" anything-colors t]
1152 ["Show xfonts" anything-select-xfont t]
1153 ["Imenu" anything-imenu t]
1154 ["Google Suggest" anything-google-suggest t]
1155 ["Eval expression" anything-eval-expression-with-eldoc t]
1156 ["Calcul expression" anything-calcul-expression t]
1157 ["Man pages" anything-man-woman t]
1158 ["Top externals process" anything-top t]
1159 ["Emacs internals process" anything-list-emacs-process t])
1160 "----"
1161 ["Prefered Options" anything-configuration t]))
1164 ;;; Documentation
1167 ;; Help message
1168 (defun anything-c-list-preconfigured-anything ()
1169 (loop with doc
1170 with sym
1171 for entry in (cdr (assoc
1172 (file-truename (locate-library "anything-config"))
1173 load-history))
1174 if (and (consp entry)
1175 (eq (car entry) 'defun)
1176 (string-match "^Preconfigured.+$"
1177 (setq doc (or (documentation (setq sym (cdr entry)))
1178 ""))))
1179 collect (cons sym (match-string 0 doc))))
1181 (defun anything-c-format-preconfigured-anything ()
1182 (mapcar (lambda (x) (format "\\[%s] : %s\n" (car x) (cdr x)))
1183 (anything-c-list-preconfigured-anything)))
1185 (setq anything-help-message
1186 (lambda ()
1187 (concat
1188 "\\<anything-map>"
1189 "`anything' is QuickSilver-like candidate-selection framework.
1191 Narrow the list by typing some pattern,
1192 Multiple patterns are allowed by splitting by space.
1193 Select with natural Emacs operations, choose with RET.
1195 If you have any problems, press C-c C-x C-b!!
1196 Feel free to send bug reports. I'll fix them.
1197 The steps are described in the beginning of anything.el file.
1199 == Basic Operations ==
1200 C-p, Up: Previous Line
1201 C-n, Down : Next Line
1202 M-v, PageUp : Previous Page
1203 C-v, PageDown : Next Page
1204 Enter : Execute first (default) action / Select
1205 M-< : First Line
1206 M-> : Last Line
1207 M-PageUp, C-M-S-v, C-M-y : Previous Page (other-window)
1208 M-PageDown, C-M-v : Next Page (other-window)
1210 Tab, C-i : Show action list
1211 Left : Previous Source
1212 Right, C-o : Next Source
1213 C-k : Delete pattern
1214 C-z : Persistent Action (Execute action with anything session kept)
1215 C-c C-x C-b: Send a bug report
1217 == Shortcuts For 2nd/3rd Action ==
1218 \\[anything-select-2nd-action-or-end-of-line] : Execute 2nd Action (if the minibuffer cursor is at end of line)
1219 \\[anything-select-3rd-action] : Execute 3rd Action
1221 == Visible Marks ==
1222 Visible marks store candidate. Some actions uses marked candidates.
1224 \\[anything-toggle-visible-mark] : Toggle Visible Mark
1225 \\[anything-prev-visible-mark] : Previous Mark
1226 \\[anything-next-visible-mark] : Next Mark
1228 == Miscellaneous Commands ==
1229 \\[anything-toggle-resplit-window] : Toggle vertical/horizontal split anything window
1230 \\[anything-quit-and-find-file] : Drop into `find-file'
1231 \\[anything-delete-current-selection] : Delete Selected Item (visually)
1232 \\[anything-kill-selection-and-quit] : Set Item Into the kill-ring And Quit
1233 \\[anything-yank-selection] : Yank Selected Item Into Pattern
1234 \\[anything-follow-mode] : Toggle Automatical Execution Of Persistent Action
1235 \\[anything-force-update] : Recalculate And Redisplay Candidates
1237 == Global Commands ==
1238 \\<global-map>\\[anything-resume] revives last `anything' session.
1239 It is very useful, so you should bind any key.
1241 Single source is executed by \\[anything-call-source].
1243 == Preconfigured `anything' ==
1244 Preconfigured `anything' is commands that uses `anything' interface.
1245 You can use them without configuration.
1248 (apply 'concat (anything-c-format-preconfigured-anything))
1250 Enjoy!")))
1252 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Preconfigured Anything ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1253 ;;;###autoload
1254 (defun anything-mini ()
1255 "Preconfigured `anything' lightweight version (buffer -> recentf)."
1256 (interactive)
1257 (anything-other-buffer '(anything-c-source-buffers+ anything-c-source-recentf)
1258 "*anything mini*"))
1259 ;;;###autoload
1260 (defun anything-for-files ()
1261 "Preconfigured `anything' for opening files.
1262 ffap -> recentf -> buffer -> bookmark -> file-cache -> files-in-current-dir -> locate"
1263 (interactive)
1264 (anything-other-buffer anything-for-files-prefered-list "*anything for files*"))
1266 ;;;###autoload
1267 (defun anything-recentf ()
1268 "Preconfigured `anything' for `recentf'."
1269 (interactive)
1270 (anything-other-buffer 'anything-c-source-recentf "*anything recentf*"))
1272 ;;;###autoload
1273 (defun anything-info-at-point (arg)
1274 "Preconfigured `anything' for searching info at point.
1275 With a prefix-arg insert symbol at point."
1276 (interactive "P")
1277 (let ((anything-c-google-suggest-default-function
1278 'anything-c-google-suggest-emacs-lisp))
1279 (anything :sources'(anything-c-source-info-elisp
1280 anything-c-source-info-cl
1281 anything-c-source-info-pages
1282 anything-c-source-google-suggest)
1283 :input (and arg (thing-at-point 'symbol))
1284 :buffer "*anything info*")))
1286 ;;;###autoload
1287 (defun anything-info-emacs ()
1288 "Preconfigured anything for Emacs manual index."
1289 (interactive)
1290 (anything-other-buffer 'anything-c-source-info-emacs "*info emacs*"))
1292 ;;;###autoload
1293 (defun anything-show-kill-ring ()
1294 "Preconfigured `anything' for `kill-ring'.
1295 It is drop-in replacement of `yank-pop'.
1296 You may bind this command to M-y.
1297 First call open the kill-ring browser, next calls move to next line."
1298 (interactive)
1299 (let ((buf "*anything kill-ring*"))
1300 (if (get-buffer-window buf)
1301 (with-anything-window
1302 (if (eq (point) (save-excursion
1303 (anything-end-of-buffer) (point)))
1304 (anything-beginning-of-buffer)
1305 (anything-next-line)))
1306 (anything-other-buffer 'anything-c-source-kill-ring buf))))
1308 ;;;###autoload
1309 (defun anything-minibuffer-history ()
1310 "Preconfigured `anything' for `minibuffer-history'."
1311 (interactive)
1312 (let ((enable-recursive-minibuffers t))
1313 (anything-other-buffer 'anything-c-source-minibuffer-history
1314 "*anything minibuffer-history*")))
1316 ;;;###autoload
1317 (defun anything-gentoo ()
1318 "Preconfigured `anything' for gentoo linux."
1319 (interactive)
1320 (anything-other-buffer '(anything-c-source-gentoo
1321 anything-c-source-use-flags)
1322 "*anything gentoo*"))
1324 ;;;###autoload
1325 (defun anything-imenu ()
1326 "Preconfigured `anything' for `imenu'."
1327 (interactive)
1328 (anything 'anything-c-source-imenu nil nil nil nil "*anything imenu*"))
1330 ;;;###autoload
1331 (defun anything-google-suggest ()
1332 "Preconfigured `anything' for google search with google suggest."
1333 (interactive)
1334 (anything-other-buffer 'anything-c-source-google-suggest "*anything google*"))
1336 ;;;###autoload
1337 (defun anything-yahoo-suggest ()
1338 "Preconfigured `anything' for Yahoo searching with Yahoo suggest."
1339 (interactive)
1340 (anything-other-buffer 'anything-c-source-yahoo-suggest "*anything yahoo*"))
1342 ;;; Converted from anything-show-*-only
1343 ;;;###autoload
1344 (defun anything-for-buffers ()
1345 "Preconfigured `anything' for buffer."
1346 (interactive)
1347 (anything-other-buffer 'anything-c-source-buffers "*anything for buffers*"))
1349 ;;;###autoload
1350 (defun anything-buffers+ ()
1351 "Enhanced preconfigured `anything' for buffer."
1352 (interactive)
1353 (anything :sources '(anything-c-source-buffers+
1354 anything-c-source-buffer-not-found)
1355 :buffer "*anything buffers*" :keymap anything-c-buffer-map))
1357 ;;;###autoload
1358 (defun anything-bbdb ()
1359 "Preconfigured `anything' for BBDB.
1361 Needs BBDB.
1363 http://bbdb.sourceforge.net/"
1364 (interactive)
1365 (anything-other-buffer 'anything-c-source-bbdb "*anything bbdb*"))
1367 ;;;###autoload
1368 (defun anything-locate (arg)
1369 "Preconfigured `anything' for Locate.
1370 Note: you can add locate options after entering pattern.
1371 See 'man locate' for valid options.
1373 You can specify a specific database with prefix argument ARG \(C-u\).
1374 Many databases can be used: navigate and mark them.
1375 See also `anything-locate-with-db'.
1377 To create a user specific db, use
1378 \"updatedb -l 0 -o db_path -U directory\".
1379 Where db_path is a filename matched by
1380 `anything-locate-db-file-regexp'."
1381 (interactive "P")
1382 (let* ((db (and arg
1383 (anything-c-read-file-name
1384 "LocateDBFiles: "
1385 :marked-candidates t
1386 :preselect anything-locate-db-file-regexp
1387 :test #'(lambda (x)
1388 (if anything-locate-db-file-regexp
1389 ;; Select only locate db files and directories
1390 ;; to allow navigation.
1391 (or (string-match
1392 anything-locate-db-file-regexp x)
1393 (file-directory-p x))
1394 x))))))
1395 (anything-locate-with-db db)))
1397 ;;;###autoload
1398 (defun anything-w3m-bookmarks ()
1399 "Preconfigured `anything' for w3m bookmark.
1401 Needs w3m and emacs-w3m.
1403 http://w3m.sourceforge.net/
1404 http://emacs-w3m.namazu.org/"
1405 (interactive)
1406 (anything-other-buffer 'anything-c-source-w3m-bookmarks
1407 "*anything w3m bookmarks*"))
1409 ;;;###autoload
1410 (defun anything-firefox-bookmarks ()
1411 "Preconfigured `anything' for firefox bookmark.
1412 You will have to enable html bookmarks in firefox:
1413 open about:config in firefox and double click on this line to enable value \
1414 to true:
1416 user_pref(\"browser.bookmarks.autoExportHTML\", false);
1418 You should have now:
1420 user_pref(\"browser.bookmarks.autoExportHTML\", true);
1422 After closing firefox, you will be able to browse you bookmarks.
1424 (interactive)
1425 (anything-other-buffer 'anything-c-source-firefox-bookmarks
1426 "*Anything Firefox*"))
1428 ;;;###autoload
1429 (defun anything-colors ()
1430 "Preconfigured `anything' for color."
1431 (interactive)
1432 (anything-other-buffer
1433 '(anything-c-source-colors anything-c-source-customize-face)
1434 "*anything colors*"))
1436 ;;;###autoload
1437 (defun anything-bookmarks ()
1438 "Preconfigured `anything' for bookmarks."
1439 (interactive)
1440 (anything-other-buffer 'anything-c-source-bookmarks "*anything bookmarks*"))
1442 ;;;###autoload
1443 (defun anything-c-pp-bookmarks ()
1444 "Preconfigured `anything' for bookmarks (pretty-printed)."
1445 (interactive)
1446 (anything-other-buffer '(anything-c-source-bookmarks-local
1447 anything-c-source-bookmarks-su
1448 anything-c-source-bookmarks-ssh)
1449 "*anything pp bookmarks*"))
1451 ;;;###autoload
1452 (defun anything-c-insert-latex-math ()
1453 "Preconfigured anything for latex math symbols completion."
1454 (interactive)
1455 (anything-other-buffer 'anything-c-source-latex-math "*anything latex*"))
1457 ;;;###autoload
1458 (defun anything-register ()
1459 "Preconfigured `anything' for Emacs registers."
1460 (interactive)
1461 (anything-other-buffer 'anything-c-source-register "*anything register*"))
1463 ;;;###autoload
1464 (defun anything-man-woman ()
1465 "Preconfigured `anything' for Man and Woman pages."
1466 (interactive)
1467 (anything-other-buffer 'anything-c-source-man-pages "*Anything man woman*"))
1469 ;;;###autoload
1470 (defun anything-org-keywords ()
1471 "Preconfigured `anything' for org keywords."
1472 (interactive)
1473 (anything-other-buffer 'anything-c-source-org-keywords "*org keywords*"))
1475 ;;;###autoload
1476 (defun anything-emms ()
1477 "Preconfigured `anything' for emms sources."
1478 (interactive)
1479 (anything '(anything-c-source-emms-streams
1480 anything-c-source-emms-files
1481 anything-c-source-emms-dired)
1482 nil nil nil nil
1483 "*Anything Emms*"))
1485 ;;;###autoload
1486 (defun anything-eev-anchors ()
1487 "Preconfigured `anything' for eev anchors."
1488 (interactive)
1489 (anything-other-buffer 'anything-c-source-eev-anchor "*Anything eev anchors*"))
1491 ;;;###autoload
1492 (defun anything-bm-list ()
1493 "Preconfigured `anything' for visible bookmarks.
1495 Needs bm.el
1497 http://cvs.savannah.gnu.org/viewvc/*checkout*/bm/bm/bm.el"
1498 (interactive)
1499 (let ((anything-outline-using t))
1500 (anything-other-buffer 'anything-c-source-bm "*anything bm list*")))
1502 ;;;###autoload
1503 (defun anything-timers ()
1504 "Preconfigured `anything' for timers."
1505 (interactive)
1506 (anything-other-buffer '(anything-c-source-absolute-time-timers
1507 anything-c-source-idle-time-timers)
1508 "*anything timers*"))
1510 ;;;###autoload
1511 (defun anything-list-emacs-process ()
1512 "Preconfigured `anything' for emacs process."
1513 (interactive)
1514 (anything-other-buffer 'anything-c-source-emacs-process "*anything process*"))
1516 ;;;###autoload
1517 (defun anything-occur ()
1518 "Preconfigured Anything for Occur source."
1519 (interactive)
1520 (let ((anything-compile-source-functions
1521 ;; rule out anything-match-plugin because the input is one regexp.
1522 (delq 'anything-compile-source--match-plugin
1523 (copy-sequence anything-compile-source-functions))))
1524 (anything-other-buffer 'anything-c-source-occur "*Anything Occur*")))
1526 ;;;###autoload
1527 (defun anything-browse-code ()
1528 "Preconfigured anything to browse code."
1529 (interactive)
1530 (anything-other-buffer 'anything-c-source-browse-code "*Browse code*"))
1532 ;;;###autoload
1533 (defun anything-org-headlines ()
1534 "Preconfigured anything to show org headlines."
1535 (interactive)
1536 (anything-other-buffer 'anything-c-source-org-headline "*org headlines*"))
1538 ;;;###autoload
1539 (defun anything-info-gnus ()
1540 "Preconfigured anything to browse Gnus Manual."
1541 (interactive)
1542 (anything-other-buffer 'anything-c-source-info-gnus "*info Gnus*"))
1544 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Anything Applications ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1546 ;;; Anything regexp.
1549 (defun anything-c-query-replace-regexp (candidate)
1550 (let ((regexp (funcall (anything-attr 'regexp))))
1551 (apply 'query-replace-regexp
1552 (anything-c-query-replace-args regexp))))
1554 (defun anything-c-kill-regexp-as-sexp (candidate)
1555 (anything-c-regexp-kill-new
1556 (prin1-to-string (funcall (anything-attr 'regexp)))))
1558 (defun anything-c-kill-regexp (candidate)
1559 (anything-c-regexp-kill-new (funcall (anything-attr 'regexp))))
1561 (defun anything-c-query-replace-args (regexp)
1562 "create arguments of `query-replace-regexp' action in `anything-regexp'."
1563 (let ((region-only (anything-region-active-p)))
1564 (list
1565 regexp
1566 (query-replace-read-to regexp
1567 (format "Query replace %s regexp %s"
1568 (if anything-current-prefix-arg "word " "")
1569 (if region-only "in region " ""))
1571 anything-current-prefix-arg
1572 (when region-only (region-beginning))
1573 (when region-only (region-end)))))
1575 (defvar anything-c-source-regexp
1576 '((name . "Regexp Builder")
1577 (init . (lambda ()
1578 (anything-candidate-buffer anything-current-buffer)))
1579 (candidates-in-buffer)
1580 (get-line . anything-c-regexp-get-line)
1581 (persistent-action . anything-c-regexp-persistent-action)
1582 (persistent-help . "Show this line")
1583 (multiline)
1584 (delayed)
1585 (requires-pattern . 2)
1586 (mode-line . "Press TAB to select action.")
1587 (regexp . (lambda () anything-input))
1588 (action . (("Kill Regexp as sexp" . anything-c-kill-regexp-as-sexp)
1589 ("Query Replace Regexp" . anything-c-query-replace-regexp)
1590 ("Kill Regexp" . anything-c-kill-regexp)))))
1592 (defun anything-c-regexp-get-line (s e)
1593 (propertize
1594 (apply 'concat
1595 ;; Line contents
1596 (format "%5d: %s" (line-number-at-pos (1- s)) (buffer-substring s e))
1597 ;; subexps
1598 (loop for i from 0 to (1- (/ (length (match-data)) 2))
1599 collect (format "\n %s'%s'"
1600 (if (zerop i) "Group 0: " (format "Group %d: " i))
1601 (match-string i))))
1602 ;; match beginning
1603 ;; KLUDGE: point of anything-candidate-buffer is +1 than that of anything-current-buffer.
1604 ;; It is implementation problem of candidates-in-buffer.
1605 'anything-realvalue
1606 (1- s)))
1608 (defun anything-goto-line (lineno)
1609 "Goto LINENO opening only outline headline if needed."
1610 (goto-char (point-min)) (forward-line (1- lineno))
1611 (when (or (eq major-mode 'org-mode) outline-minor-mode)
1612 (org-reveal))
1613 (anything-match-line-color-current-line) (sit-for 0.3)
1614 (anything-match-line-cleanup))
1616 (defun anything-c-regexp-persistent-action (pt)
1617 (goto-char pt)
1618 (anything-persistent-highlight-point))
1620 (defun anything-c-regexp-kill-new (input)
1621 (kill-new input)
1622 (message "Killed: %s" input))
1624 (defun anything-region-active-p ()
1625 (and transient-mark-mode mark-active (/= (mark) (point))))
1627 (defun* anything-current-buffer-narrowed-p (&optional
1628 (buffer anything-current-buffer))
1629 "Check if BUFFER is narrowed.
1630 Default is `anything-current-buffer'."
1631 (with-current-buffer buffer
1632 (let ((beg (point-min))
1633 (end (point-max))
1634 (total (buffer-size)))
1635 (or (/= beg 1) (/= end (1+ total))))))
1637 ;;;###autoload
1638 (defun anything-regexp ()
1639 "Preconfigured anything to build regexps and run query-replace-regexp \
1640 against."
1641 (interactive)
1642 (save-restriction
1643 (let ((anything-compile-source-functions
1644 ;; rule out anything-match-plugin because the input is one regexp.
1645 (delq 'anything-compile-source--match-plugin
1646 (copy-sequence anything-compile-source-functions))))
1647 (when (and (anything-region-active-p)
1648 ;; Don't narrow to region if buffer is already narrowed.
1649 (not (anything-current-buffer-narrowed-p)))
1650 (narrow-to-region (region-beginning) (region-end)))
1651 (anything :sources
1652 anything-c-source-regexp
1653 :buffer "*anything regexp*"
1654 :prompt "Regexp: "))))
1657 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Utilities Functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1659 (defun anything-test-sources ()
1660 "List all anything sources for test.
1661 The output is sexps which are evaluated by \\[eval-last-sexp]."
1662 (interactive)
1663 (with-output-to-temp-buffer "*Anything Test Sources*"
1664 (mapc (lambda (s) (princ (format ";; (anything '%s)\n" s)))
1665 (apropos-internal "^anything-c-source" #'boundp))
1666 (pop-to-buffer standard-output)))
1668 ;;; For compatibility
1669 (unless (fboundp 'region-active-p)
1670 (defun region-active-p ()
1671 "Return t if Transient Mark mode is enabled and the mark is active.
1673 Most commands that act on the region if it is active and
1674 Transient Mark mode is enabled, and on the text near point
1675 otherwise, should use `use-region-p' instead. That function
1676 checks the value of `use-empty-active-region' as well."
1677 (and transient-mark-mode mark-active)))
1679 (defun anything-nest (&rest same-as-anything)
1680 "Nested `anything'. If you use `anything' within `anything', use it."
1681 (with-selected-window (anything-window)
1682 (let (anything-current-position
1683 anything-current-buffer
1684 (orig-anything-buffer anything-buffer)
1685 anything-pattern
1686 anything-buffer
1687 anything-sources
1688 anything-compiled-sources
1689 anything-buffer-chars-modified-tick
1690 (anything-samewindow t)
1691 (enable-recursive-minibuffers t))
1692 (unwind-protect
1693 (apply #'anything same-as-anything)
1694 (anything-initialize-overlays orig-anything-buffer)
1695 (add-hook 'post-command-hook 'anything-check-minibuffer-input)))))
1697 (defun anything-displaying-source-names ()
1698 "Display sources name."
1699 (with-current-buffer anything-buffer
1700 (goto-char (point-min))
1701 (loop with pos
1702 while (setq pos (next-single-property-change (point) 'anything-header))
1703 do (goto-char pos)
1704 collect (buffer-substring-no-properties (point-at-bol)(point-at-eol))
1705 do (forward-line 1))))
1707 (defun anything-select-source ()
1708 "Select source."
1709 (interactive)
1710 (let ((default (assoc-default 'name (anything-get-current-source)))
1711 (source-names (anything-displaying-source-names))
1712 (all-source-names (mapcar (lambda (s) (assoc-default 'name s))
1713 (anything-get-sources))))
1714 (setq anything-candidate-number-limit 9999)
1715 (anything-aif
1716 (let (anything-source-filter)
1717 (anything-nest '(((name . "Anything Source")
1718 (candidates . source-names)
1719 (action . identity))
1720 ((name . "Anything Source (ALL)")
1721 (candidates . all-source-names)
1722 (action . identity)))
1723 nil "Source: " nil
1724 default "*anything select source*"))
1725 (anything-set-source-filter (list it))
1726 (anything-set-source-filter nil))))
1728 (defun anything-c-match-on-file-name (candidate)
1729 "Return non-nil if `anything-pattern' match basename of filename CANDIDATE."
1730 (string-match anything-pattern (file-name-nondirectory candidate)))
1732 (defun anything-c-match-on-directory-name (candidate)
1733 "Return non-nil if `anything-pattern' match directory part of CANDIDATE."
1734 (anything-aif (file-name-directory candidate)
1735 (string-match anything-pattern it)))
1737 (defun anything-c-string-match (candidate)
1738 "Return non-nil if `anything-pattern' match CANDIDATE.
1739 The match is done with `string-match'."
1740 (string-match anything-pattern candidate))
1742 ;; `anything-c-compose' is no more needed, it is for compatibility.
1743 (defalias 'anything-c-compose 'anything-compose)
1745 (defun anything-c-skip-entries (list regexp)
1746 "Remove entries which matches REGEXP from LIST."
1747 (remove-if (lambda (x) (and (stringp x) (string-match regexp x)))
1748 list))
1750 (defun anything-c-shadow-entries (list regexp)
1751 "Display elements of LIST matching REGEXP with the `file-name-shadow' face."
1752 (mapcar (lambda (file)
1753 ;; Add shadow face property to boring files.
1754 (let ((face (if (facep 'file-name-shadow)
1755 'file-name-shadow
1756 ;; fall back to default on XEmacs
1757 'default)))
1758 (if (string-match regexp file)
1759 (setq file (propertize file 'face face))))
1760 file)
1761 list))
1763 (defsubst anything-c-stringify (str-or-sym)
1764 "Get string of STR-OR-SYM."
1765 (if (stringp str-or-sym)
1766 str-or-sym
1767 (symbol-name str-or-sym)))
1769 (defsubst anything-c-symbolify (str-or-sym)
1770 "Get symbol of STR-OR-SYM."
1771 (if (symbolp str-or-sym)
1772 str-or-sym
1773 (intern str-or-sym)))
1775 (defun anything-c-describe-function (func)
1776 "FUNC is symbol or string."
1777 (describe-function (anything-c-symbolify func)))
1779 (defun anything-c-describe-variable (var)
1780 "VAR is symbol or string."
1781 (describe-variable (anything-c-symbolify var)))
1783 (defun anything-c-find-function (func)
1784 "FUNC is symbol or string."
1785 (find-function (anything-c-symbolify func)))
1787 (defun anything-c-find-variable (var)
1788 "VAR is symbol or string."
1789 (find-variable (anything-c-symbolify var)))
1791 (defun anything-c-kill-new (string &optional replace yank-handler)
1792 "STRING is symbol or string."
1793 (kill-new (anything-c-stringify string) replace yank-handler))
1795 ;;; Toggle all marks.
1798 ;;;###autoload
1799 (defun anything-mark-all ()
1800 "Mark all visible unmarked candidates in current source."
1801 (interactive)
1802 (with-anything-window
1803 (save-excursion
1804 (goto-char (anything-get-previous-header-pos))
1805 (anything-next-line)
1806 (let* ((next-head (anything-get-next-header-pos))
1807 (end (and next-head
1808 (save-excursion
1809 (goto-char next-head)
1810 (forward-line -2)
1811 (point))))
1812 (maxpoint (or end (point-max))))
1813 (while (< (point) maxpoint)
1814 (anything-mark-current-line)
1815 (let ((prefix (get-text-property (point-at-bol) 'display))
1816 (bn (anything-c-basename (anything-get-selection)))
1817 (src (assoc-default 'name (anything-get-current-source))))
1818 (when (and (not (anything-this-visible-mark))
1819 (not (or (string= prefix "[?]")
1820 (string= prefix "[@]"))))
1821 ;; Don't mark possibles directories ending with . or ..
1822 ;; and also autosave files/links.
1823 (unless
1824 (and (or (anything-file-completion-source-p)
1825 (equal src "Files from Current Directory"))
1826 (string-match "^\\.#.*\\|^#.*#$\\|\\.$" bn))
1827 (anything-make-visible-mark))))
1828 (forward-line 1) (end-of-line))))
1829 (anything-mark-current-line)
1830 (message "%s candidates marked" (length anything-marked-candidates))))
1832 ;;;###autoload
1833 (defun anything-unmark-all ()
1834 "Unmark all candidates in all sources of current anything session."
1835 (interactive)
1836 (with-anything-window
1837 (let ((len (length anything-marked-candidates)))
1838 (save-excursion
1839 (anything-clear-visible-mark))
1840 (setq anything-marked-candidates nil)
1841 (anything-mark-current-line)
1842 (message "%s candidates unmarked" len))))
1844 ;;;###autoload
1845 (defun anything-toggle-all-marks ()
1846 "Toggle all marks.
1847 Mark all visible candidates of current source or unmark all candidates
1848 visible or invisible in all sources of current anything session"
1849 (interactive)
1850 (let ((marked (anything-marked-candidates)))
1851 (if (and (>= (length marked) 1)
1852 (with-anything-window anything-visible-mark-overlays))
1853 (anything-unmark-all)
1854 (anything-mark-all))))
1856 (define-key anything-map (kbd "M-m") 'anything-toggle-all-marks)
1858 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Hacks ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1859 (defadvice eval-defun (after anything-source-hack activate)
1860 "See `anything-c-enable-eval-defun-hack'."
1861 (when anything-c-enable-eval-defun-hack
1862 (let ((varsym (save-excursion
1863 (beginning-of-defun)
1864 (forward-char 1)
1865 (when (memq (read (current-buffer)) '(defvar setq))
1866 (read (current-buffer))))))
1867 (when (string-match "^anything-c-source-" (symbol-name varsym))
1868 (anything varsym)))))
1869 ;; (progn (ad-disable-advice 'eval-defun 'after 'anything-source-hack) (ad-update 'eval-defun))
1872 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Anything Sources ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1873 ;;;; <Buffer>
1874 (defun anything-c-buffer-list ()
1875 "Return the list of names of buffers with boring buffers filtered out.
1876 Boring buffers is specified by `anything-c-boring-buffer-regexp'.
1877 The first buffer in the list will be the last recently used
1878 buffer that is not the current buffer."
1879 (let ((buffers (mapcar 'buffer-name (buffer-list))))
1880 (append (cdr buffers) (list (car buffers)))))
1882 (defvar anything-c-source-buffers
1883 '((name . "Buffers")
1884 (candidates . anything-c-buffer-list)
1885 (type . buffer)))
1886 ;; (anything 'anything-c-source-buffers)
1888 (defvar anything-c-source-buffer-not-found
1889 '((name . "Create buffer")
1890 (dummy)
1891 (filtered-candidate-transformer (lambda (cands source)
1892 (list anything-pattern)))
1893 (action . (lambda (candidate)
1894 (anything-c-switch-to-buffer (get-buffer-create candidate))))))
1895 ;; (anything 'anything-c-source-buffer-not-found)
1897 ;;; Buffers+
1899 (defface anything-buffer-saved-out
1900 '((t (:foreground "red")))
1901 "*Face used for buffer files modified outside of emacs."
1902 :group 'anything-config)
1904 (defface anything-buffer-not-saved
1905 '((t (:foreground "Indianred2")))
1906 "*Face used for buffer files not already saved on disk."
1907 :group 'anything-config)
1909 (eval-when-compile (require 'dired))
1911 (defun anything-c-highlight-buffers (buffers)
1912 (loop for i in buffers
1913 for buf = (get-buffer i)
1914 for bfname = (buffer-file-name buf)
1915 collect
1916 (cond (;; A dired buffer.
1917 (rassoc buf dired-buffers)
1918 (propertize i 'face 'anything-ff-directory
1919 'help-echo (car (rassoc buf dired-buffers))))
1920 ;; A buffer file modified somewhere outside of emacs.
1921 ((and bfname (not (file-remote-p bfname))
1922 (file-exists-p bfname)
1923 (not (verify-visited-file-modtime buf)))
1924 (propertize i 'face 'anything-buffer-saved-out
1925 'help-echo bfname))
1926 ;; A new buffer file not already saved on disk.
1927 ((and bfname (not (file-remote-p bfname))
1928 (not (verify-visited-file-modtime buf)))
1929 (propertize i 'face 'anything-buffer-not-saved
1930 'help-echo bfname))
1931 ;; A Remote buffer file modified and not saved on disk.
1932 ((and bfname (file-remote-p bfname) (buffer-modified-p buf))
1933 (let ((prefix (propertize
1934 " " 'display
1935 (propertize "@ " 'face 'anything-ff-prefix))))
1936 (cons (concat prefix (propertize i 'face 'anything-ff-symlink
1937 'help-echo bfname)) i)))
1938 ;; A buffer file modified and not saved on disk.
1939 ((and bfname (buffer-modified-p buf))
1940 (propertize i 'face 'anything-ff-symlink
1941 'help-echo bfname))
1942 ;; A remote buffer file not modified and saved on disk.
1943 ((and bfname (file-remote-p bfname))
1944 (let ((prefix (propertize
1945 " " 'display
1946 (propertize "@ " 'face 'anything-ff-prefix))))
1947 (cons (concat prefix (propertize i 'face 'font-lock-type-face
1948 'help-echo bfname)) i)))
1949 ;; A buffer file not modified and saved on disk.
1950 (bfname
1951 (propertize i 'face 'font-lock-type-face
1952 'help-echo bfname))
1953 ;; Any non--file buffer.
1954 (t (propertize i 'face 'italic)))))
1956 (defvar anything-buffer-mode-line-string
1957 '("Buffer(s)"
1958 "\\<anything-c-buffer-map>\
1959 \\[anything-c-buffer-help]:Help, \
1960 \\<anything-map>\
1961 \\[anything-select-action]:Acts,\
1962 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
1963 \\[anything-select-3rd-action]:NthAct,\
1964 \\[anything-send-bug-report-from-anything]:BugReport."
1965 "String displayed in mode-line in `anything-c-source-buffers+'"))
1967 (defvar anything-c-source-buffers+
1968 '((name . "Buffers")
1969 (candidates . anything-c-buffer-list)
1970 (type . buffer)
1971 (match anything-c-buffer-match-major-mode)
1972 (diff-action . anything-buffer-toggle-diff)
1973 (revert-action . anything-buffer-revert-and-update)
1974 (save-action . anything-buffer-save-and-update)
1975 (candidate-transformer anything-c-skip-current-buffer
1976 anything-c-skip-boring-buffers
1977 anything-c-highlight-buffers)
1978 (persistent-action . anything-c-buffers+-persistent-action)
1979 (volatile)
1980 (mode-line . anything-buffer-mode-line-string)
1981 (persistent-help . "Show this buffer / C-u \\[anything-execute-persistent-action]: Kill this buffer")))
1983 (defun anything-c-buffer-match-major-mode (candidate)
1984 "Match maybe buffer by major-mode.
1985 If you give a major-mode or partial major-mode,
1986 it will list all buffers of this major-mode and/or buffers with name
1987 matching this major-mode.
1988 If you add a space after major-mode and then a space,
1989 it will match all buffers of the major-mode
1990 before space matching pattern after space.
1991 If you give a pattern which doesn't match a major-mode, it will search buffer
1992 with name matching pattern."
1993 (let* ((cand (replace-regexp-in-string "^\\s-\\{1\\}" "" candidate))
1994 (buf (get-buffer cand)))
1995 (when buf
1996 (with-current-buffer buf
1997 (let ((mjm (symbol-name major-mode))
1998 (split (split-string anything-pattern)))
1999 (cond ((string-match "\\s-$" anything-pattern)
2000 (string-match (car split) mjm))
2001 ((string-match "\\s-" anything-pattern)
2002 (and (string-match (car split) mjm)
2003 (string-match (cadr split) cand)))
2004 (t (or (string-match anything-pattern mjm)
2005 (string-match anything-pattern cand)))))))))
2007 (defun anything-c-buffer-query-replace-1 (&optional regexp-flag)
2008 "Query replace in marked buffers.
2009 If REGEXP-FLAG is given use `query-replace-regexp'."
2010 (let ((fn (if regexp-flag 'query-replace-regexp 'query-replace))
2011 (prompt (if regexp-flag "Query replace regexp" "Query replace"))
2012 (bufs (anything-marked-candidates)))
2013 (loop
2014 with replace = (query-replace-read-from prompt regexp-flag)
2015 with tostring = (unless (consp replace)
2016 (query-replace-read-to
2017 replace prompt regexp-flag))
2018 for buf in bufs
2020 (save-window-excursion
2021 (anything-c-switch-to-buffer buf)
2022 (save-excursion
2023 (let ((case-fold-search t))
2024 (goto-char (point-min))
2025 (if (consp replace)
2026 (apply fn (list (car replace) (cdr replace)))
2027 (apply fn (list replace tostring)))))))))
2029 (defun anything-c-buffer-query-replace-regexp (candidate)
2030 (anything-c-buffer-query-replace-1 'regexp))
2032 (defun anything-c-buffer-query-replace (candidate)
2033 (anything-c-buffer-query-replace-1))
2035 (defun anything-c-buffer-help ()
2036 "Help command for anything buffers."
2037 (interactive)
2038 (let ((anything-help-message "== Anything Buffer ==
2039 \nTips:
2040 You can enter a partial name of major-mode (e.g lisp, sh) to narrow down buffers.
2041 Enter then a space and a pattern to narrow down to buffers matching this pattern.
2042 \nSpecific commands for `anything-buffer+':
2043 \\<anything-c-buffer-map>
2044 \\[anything-buffer-run-grep]\t\t->Grep Buffer(s) (C-u grep all buffers linked to a file).
2045 \\[anything-buffer-run-zgrep]\t\t->Zgrep Buffer(s) (C-u grep all buffers linked to a file).
2046 \\[anything-buffer-switch-other-window]\t\t->Switch other window.
2047 \\[anything-buffer-switch-other-frame]\t\t->Switch other frame.
2048 \\[anything-buffer-run-query-replace-regexp]\t\t->Query replace regexp in marked buffers.
2049 \\[anything-buffer-run-query-replace]\t\t->Query replace in marked buffers.
2050 \\[anything-buffer-switch-to-elscreen]\t\t->Find buffer in Elscreen.
2051 \\[anything-buffer-diff-persistent]\t\t->Toggle Diff buffer without quitting.
2052 \\[anything-buffer-revert-persistent]\t\t->Revert buffer without quitting.
2053 \\[anything-buffer-save-persistent]\t\t->Save buffer without quitting.
2054 \\[anything-buffer-run-kill-buffers]\t\t->Delete marked buffers and quit.
2055 \\[anything-c-buffer-help]\t\t->Display this help.
2056 \n== Anything Map ==
2057 \\{anything-map}
2059 (anything-help)))
2061 (defvar anything-c-buffer-map
2062 (let ((map (copy-keymap anything-map)))
2063 (define-key map (kbd "C-c ?") 'anything-c-buffer-help)
2064 (define-key map (kbd "M-g s") 'anything-buffer-run-grep)
2065 (define-key map (kbd "M-g z") 'anything-buffer-run-zgrep)
2066 (define-key map (kbd "C-o") 'anything-buffer-switch-other-window)
2067 (define-key map (kbd "C-c C-o") 'anything-buffer-switch-other-frame)
2068 (define-key map (kbd "C-=") 'anything-buffer-diff-persistent)
2069 (define-key map (kbd "M-U") 'anything-buffer-revert-persistent)
2070 (define-key map (kbd "M-D") 'anything-buffer-run-kill-buffers)
2071 (define-key map (kbd "C-x C-s") 'anything-buffer-save-persistent)
2072 (define-key map (kbd "C-M-%") 'anything-buffer-run-query-replace-regexp)
2073 (define-key map (kbd "M-%") 'anything-buffer-run-query-replace)
2074 (when (locate-library "elscreen")
2075 (define-key map (kbd "<C-tab>") 'anything-buffer-switch-to-elscreen))
2076 (delq nil map))
2077 "Keymap for buffer sources in anything.")
2079 (defun anything-buffer-toggle-diff (candidate)
2080 "Toggle diff buffer CANDIDATE with it's file."
2081 (if (get-buffer-window "*Diff*")
2082 (kill-buffer "*Diff*")
2083 (diff-buffer-with-file (get-buffer candidate))))
2085 ;;;###autoload
2086 (defun anything-buffer-diff-persistent ()
2087 "Toggle diff buffer without quitting anything."
2088 (interactive)
2089 (anything-execute-persistent-action 'diff-action))
2091 (defun anything-buffer-revert-and-update (candidate)
2092 (let ((marked (anything-marked-candidates)))
2093 (loop for buf in marked do (anything-revert-buffer buf))
2094 (anything-force-update)
2095 (anything-c-recenter-window)))
2097 ;;;###autoload
2098 (defun anything-buffer-revert-persistent ()
2099 "Revert buffer without quitting anything."
2100 (interactive)
2101 (anything-execute-persistent-action 'revert-action))
2103 (defun anything-buffer-save-and-update (candidate)
2104 (let ((marked (anything-marked-candidates))
2105 (enable-recursive-minibuffers t))
2106 (loop for buf in marked do
2107 (with-current-buffer (get-buffer buf)
2108 (save-buffer)))
2109 (anything-force-update)
2110 (anything-c-recenter-window)))
2112 ;;;###autoload
2113 (defun anything-buffer-save-persistent ()
2114 "Save buffer without quitting anything."
2115 (interactive)
2116 (anything-execute-persistent-action 'save-action))
2118 ;;;###autoload
2119 (defun anything-buffer-run-kill-buffers ()
2120 "Run kill buffer action from `anything-c-source-buffer+'."
2121 (interactive)
2122 (anything-c-quit-and-execute-action 'anything-kill-marked-buffers))
2124 ;;;###autoload
2125 (defun anything-buffer-run-grep ()
2126 "Run Grep action from `anything-c-source-buffer+'."
2127 (interactive)
2128 (anything-c-quit-and-execute-action 'anything-c-grep-buffers))
2130 ;;;###autoload
2131 (defun anything-buffer-run-zgrep ()
2132 "Run Grep action from `anything-c-source-buffer+'."
2133 (interactive)
2134 (anything-c-quit-and-execute-action 'anything-c-zgrep-buffers))
2136 ;;;###autoload
2137 (defun anything-buffer-run-query-replace-regexp ()
2138 "Run Query replace regexp action from `anything-c-source-buffer+'."
2139 (interactive)
2140 (anything-c-quit-and-execute-action 'anything-c-buffer-query-replace-regexp))
2142 ;;;###autoload
2143 (defun anything-buffer-run-query-replace ()
2144 "Run Query replace action from `anything-c-source-buffer+'."
2145 (interactive)
2146 (anything-c-quit-and-execute-action 'anything-c-buffer-query-replace))
2148 ;;;###autoload
2149 (defun anything-buffer-switch-other-window ()
2150 "Run switch to other window action from `anything-c-source-buffer+'."
2151 (interactive)
2152 (anything-c-quit-and-execute-action 'switch-to-buffer-other-window))
2154 ;;;###autoload
2155 (defun anything-buffer-switch-other-frame ()
2156 "Run switch to other frame action from `anything-c-source-buffer+'."
2157 (interactive)
2158 (anything-c-quit-and-execute-action 'switch-to-buffer-other-frame))
2160 ;;;###autoload
2161 (defun anything-buffer-switch-to-elscreen ()
2162 "Run switch to elscreen action from `anything-c-source-buffer+'."
2163 (interactive)
2164 (anything-c-quit-and-execute-action 'anything-find-buffer-on-elscreen))
2166 (defun anything-c-buffers-persistent-kill (buffer)
2167 "Persistent action to kill buffer."
2168 (with-current-buffer (get-buffer buffer)
2169 (if (and (buffer-modified-p)
2170 (buffer-file-name (current-buffer)))
2171 (progn
2172 (save-buffer)
2173 (kill-buffer buffer))
2174 (kill-buffer buffer)))
2175 (anything-delete-current-selection))
2177 (defun anything-c-recenter-window ()
2178 "Make visible current selection by recentering anything window."
2179 (with-anything-window (recenter)))
2181 (defun anything-c-buffers+-persistent-action (candidate)
2182 (if current-prefix-arg
2183 (anything-c-buffers-persistent-kill candidate)
2184 (anything-c-switch-to-buffer candidate)))
2186 ;; (anything 'anything-c-source-buffers+)
2188 (defadvice anything-quit-and-find-file (around use-anything-find-files activate)
2189 "Let `anything-quit-and-find-file' take advantage of `anything-find-files'."
2190 (interactive)
2191 (anything-run-after-quit
2192 (lambda (f)
2193 (anything-find-files1 f))
2194 (anything-aif (get-buffer (anything-get-selection))
2195 (or (buffer-file-name it)
2196 (car (rassoc it dired-buffers))
2197 (and (with-current-buffer it
2198 (eq major-mode 'org-agenda-mode))
2199 org-directory
2200 (expand-file-name org-directory))
2201 default-directory)
2202 (let ((sel (anything-get-selection)))
2203 (if (file-exists-p sel)
2204 (expand-file-name sel)
2205 default-directory)))))
2207 ;;;; <File>
2208 ;;; File name history
2209 (defvar anything-c-source-file-name-history
2210 '((name . "File Name History")
2211 (candidates . file-name-history)
2212 (match anything-c-match-on-file-name
2213 anything-c-match-on-directory-name)
2214 (type . file)))
2215 ;; (anything 'anything-c-source-file-name-history)
2217 ;;; Files in current dir
2218 (defvar anything-c-source-files-in-current-dir
2219 '((name . "Files from Current Directory")
2220 (candidates . (lambda ()
2221 (with-current-buffer anything-current-buffer
2222 (directory-files (anything-c-current-directory)))))
2223 ;; volatile is not needed, I think.
2224 (type . file)))
2225 ;; (anything 'anything-c-source-files-in-current-dir)
2227 (defun anything-c-highlight-files (files)
2228 (loop for i in files
2229 if (file-directory-p i)
2230 collect (propertize (file-name-nondirectory i)
2231 'face 'anything-ff-directory
2232 'help-echo (expand-file-name i))
2233 else
2234 collect (propertize (file-name-nondirectory i)
2235 'face 'anything-ff-file
2236 'help-echo (expand-file-name i))))
2238 (defvar anything-c-source-files-in-current-dir+
2239 '((name . "Files from Current Directory")
2240 (candidates . (lambda ()
2241 (with-current-buffer anything-current-buffer
2242 (directory-files (anything-c-current-directory) t))))
2243 (candidate-transformer anything-c-highlight-files)
2244 ;; volatile is not needed, I think.
2245 (type . file)))
2247 ;; (anything 'anything-c-source-files-in-current-dir+)
2249 ;;;;;;;;;;;;;;;;;;;;;;;;
2250 ;;; Anything-find-files
2252 ;;; Anything replacement of file name completion for `find-file' and friends.
2254 (defface anything-ff-prefix
2255 '((t (:background "yellow" :foreground "black")))
2256 "*Face used to prefix new file or url paths in `anything-find-files'."
2257 :group 'anything-config)
2259 (defface anything-ff-executable
2260 '((t (:foreground "green")))
2261 "*Face used for executable files in `anything-find-files'."
2262 :group 'anything-config)
2264 (defface anything-ff-directory
2265 '((t (:foreground "DarkRed" :background "LightGray")))
2266 "*Face used for directories in `anything-find-files'."
2267 :group 'anything-config)
2269 (defface anything-ff-symlink
2270 '((t (:foreground "DarkOrange")))
2271 "*Face used for symlinks in `anything-find-files'."
2272 :group 'anything-config)
2275 (defface anything-ff-invalid-symlink
2276 '((t (:foreground "black" :background "red")))
2277 "*Face used for invalid symlinks in `anything-find-files'."
2278 :group 'anything-config)
2280 (defface anything-ff-file
2281 '((t (:foreground "CadetBlue" :underline t)))
2282 "*Face used for file names in `anything-find-files'."
2283 :group 'anything-config)
2285 (defvar anything-c-find-files-doc-header (format " (`%s':Go to precedent level)"
2286 (if window-system "C-." "C-l"))
2287 "*The doc that is inserted in the Name header of a find-files or dired source.")
2289 (defvar anything-ff-mode-line-string
2290 "\\<anything-find-files-map>\
2291 \\[anything-ff-help]:Help, \
2292 \\[anything-send-bug-report-from-anything]:BugReport, \
2293 \\<anything-map>\
2294 \\[anything-select-action]:Acts, \
2295 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
2296 \\[anything-select-3rd-action]:NthAct"
2298 "String displayed in mode-line in `anything-c-source-find-files'")
2300 (defvar anything-ff-auto-update-flag anything-ff-auto-update-initial-value
2301 "Internal, flag to turn on/off auto-update in `anything-find-files'.
2302 Don't set it directly, use instead `anything-ff-auto-update-initial-value'.")
2304 (defvar anything-c-source-find-files
2305 `((name . ,(concat "Find Files" anything-c-find-files-doc-header))
2306 ;; It is needed for filenames with capital letters
2307 (disable-shortcuts)
2308 (init . (lambda ()
2309 (setq anything-ff-auto-update-flag anything-ff-auto-update-initial-value)))
2310 (candidates . anything-find-files-get-candidates)
2311 (filtered-candidate-transformer anything-c-find-files-transformer)
2312 (image-action1 . anything-ff-rotate-image-left)
2313 (image-action2 . anything-ff-rotate-image-right)
2314 (properties-action . anything-ff-properties)
2315 (toggle-auto-update . anything-ff-toggle-auto-update)
2316 (kill-buffer-fname . anything-ff-kill-buffer-fname)
2317 (persistent-action . anything-find-files-persistent-action)
2318 (persistent-help . "Hit1 Expand Candidate, Hit2 or (C-u) Find file")
2319 (mode-line . anything-ff-mode-line-string)
2320 (volatile)
2321 (candidate-number-limit . 9999)
2322 (action-transformer . anything-find-files-action-transformer)
2323 (action
2324 . ,(delq
2326 `(("Find File" . anything-c-find-file-or-marked)
2327 ("Find file in Dired" . anything-c-point-file-in-dired)
2328 ,(and (locate-library "elscreen")
2329 '("Find file in Elscreen" . anything-elscreen-find-file))
2330 ,(and (locate-library "popwin")
2331 '("Find file in popup window" . popwin:find-file))
2332 ("Complete at point `M-tab'"
2333 . anything-c-insert-file-name-completion-at-point)
2334 ("Open file externally `C-c C-x, C-u to choose'"
2335 . anything-c-open-file-externally)
2336 ("Grep File(s) `M-g s, C-u Recurse'" . anything-find-files-grep)
2337 ("Zgrep File(s) `M-g z, C-u Recurse'" . anything-ff-zgrep)
2338 ("Switch to Eshell `M-e'" . anything-ff-switch-to-eshell)
2339 ("Etags `M-., C-u tap, C-u C-u reload tag file'" . anything-ff-etags-select)
2340 ("Eshell command on file(s) `M-!, C-u run on all marked at once.'"
2341 . anything-find-files-eshell-command-on-file)
2342 ("Find file as root" . anything-find-file-as-root)
2343 ("Find file in hex dump" . hexl-find-file)
2344 ("Ediff File `C-='" . anything-find-files-ediff-files)
2345 ("Ediff Merge File `C-c ='" . anything-find-files-ediff-merge-files)
2346 ("Delete File(s) `M-D'" . anything-delete-marked-files)
2347 ("Copy file(s) `M-C, C-u to follow'" . anything-find-files-copy)
2348 ("Copy file(s) Async" . anything-ff-copy-async)
2349 ("Rename file(s) `M-R, C-u to follow'" . anything-find-files-rename)
2350 ("Serial rename files" . anything-ff-serial-rename)
2351 ("Serial rename by symlinking files" . anything-ff-serial-rename-by-symlink)
2352 ("Serial rename by copying files" . anything-ff-serial-rename-by-copying)
2353 ("Symlink files(s) `M-S, C-u to follow'" . anything-find-files-symlink)
2354 ("Relsymlink file(s) `C-u to follow'" . anything-find-files-relsymlink)
2355 ("Hardlink file(s) `C-u to follow'" . anything-find-files-hardlink)
2356 ("Find file other window `C-o'" . find-file-other-window)
2357 ("Switch to history `M-p'" . anything-find-files-switch-to-hist)
2358 ("Find file other frame `C-c C-o'" . find-file-other-frame)
2359 ("Print File `C-c p'" . anything-ff-print))))))
2360 ;; (anything 'anything-c-source-find-files)
2362 (defun anything-find-files-set-prompt-for-action (prompt files)
2363 "Set prompt for action in `anything-find-files'."
2364 (let ((len (length files)))
2365 (if (> len 1)
2366 (format "%s * %d Files to: " prompt len)
2367 (format "%s %s to: " prompt (car files)))))
2369 (defun anything-find-files-do-action (action)
2370 "Generic function for creating action from `anything-c-source-find-files'.
2371 ACTION must be an action supported by `anything-dired-action'."
2372 (let* ((ifiles (anything-marked-candidates))
2373 (cand (anything-get-selection))
2374 (prompt (anything-find-files-set-prompt-for-action
2375 (capitalize (symbol-name action)) ifiles))
2376 (parg anything-current-prefix-arg)
2377 (dest (anything-c-read-file-name
2378 prompt
2379 :preselect cand
2380 :initial-input (car anything-ff-history)
2381 :history (anything-find-files-history :comp-read nil)))
2382 (win-conf (current-window-configuration)))
2383 (unwind-protect
2384 (let ((default-directory anything-ff-default-directory))
2385 (anything-dired-action
2386 dest :files ifiles :action action :follow parg))
2387 ;; Don't reset win-conf when following.
2388 (unless parg (set-window-configuration win-conf)))))
2390 (defun anything-find-files-copy (candidate)
2391 "Copy files from `anything-find-files'."
2392 (anything-find-files-do-action 'copy))
2394 (defun anything-find-files-rename (candidate)
2395 "Rename files from `anything-find-files'."
2396 (anything-find-files-do-action 'rename))
2398 (defun anything-find-files-symlink (candidate)
2399 "Symlink files from `anything-find-files'."
2400 (anything-find-files-do-action 'symlink))
2402 (defun anything-find-files-relsymlink (candidate)
2403 "Relsymlink files from `anything-find-files'."
2404 (anything-find-files-do-action 'relsymlink))
2406 (defun anything-find-files-hardlink (candidate)
2407 "Hardlink files from `anything-find-files'."
2408 (anything-find-files-do-action 'hardlink))
2410 (defun anything-find-files-byte-compile (candidate)
2411 "Byte compile elisp files from `anything-find-files'."
2412 (let ((files (anything-marked-candidates))
2413 (parg anything-current-prefix-arg))
2414 (loop for fname in files
2415 do (byte-compile-file fname parg))))
2417 (defun anything-find-files-load-files (candidate)
2418 "Load elisp files from `anything-find-files'."
2419 (let ((files (anything-marked-candidates)))
2420 (loop for fname in files
2421 do (load fname))))
2423 (defun anything-find-files-ediff-files (candidate)
2424 "Default action to ediff files in `anything-find-files'."
2425 (ediff-files
2426 candidate
2427 (anything-c-read-file-name
2428 (format "Ediff `%s' With File: " (file-name-nondirectory candidate)))))
2430 (defun anything-find-files-ediff-merge-files (candidate)
2431 "Default action to ediff merge files in `anything-find-files'."
2432 (ediff-merge-files
2433 candidate
2434 (anything-c-read-file-name
2435 (format "Ediff Merge `%s' With File: "
2436 (file-name-nondirectory candidate)))))
2438 (defun anything-find-files-grep (candidate)
2439 "Default action to grep files from `anything-find-files'."
2440 (anything-do-grep1 (anything-marked-candidates)
2441 anything-current-prefix-arg))
2443 (defun anything-ff-zgrep (candidate)
2444 "Default action to zgrep files from `anything-find-files'."
2445 (let ((prefarg anything-current-prefix-arg)
2446 (ls (anything-marked-candidates)))
2447 (anything-ff-zgrep-1 ls prefarg)))
2449 (defun anything-ff-pdfgrep (candidate)
2450 "Default action to pdfgrep files from `anything-find-files'."
2451 (let ((cands (loop for file in (anything-marked-candidates)
2452 if (or (string= (file-name-extension file) "pdf")
2453 (string= (file-name-extension file) "PDF"))
2454 collect file))
2455 (anything-c-pdfgrep-default-function 'anything-c-pdfgrep-init))
2456 (when cands
2457 (anything-do-pdfgrep-1 cands))))
2459 (defun anything-ff-etags-select (candidate)
2460 "Default action to jump to etags from `anything-find-files'."
2461 (when (get-buffer anything-action-buffer)
2462 (kill-buffer anything-action-buffer))
2463 (let ((default-directory anything-ff-default-directory))
2464 (anything-c-etags-select anything-current-prefix-arg)))
2466 (defun anything-find-files-switch-to-hist (candidate)
2467 "Switch to anything-find-files history."
2468 (anything-find-files t))
2470 ;;; Asynchronous copy of files.
2473 (defvar anything-c-copy-files-async-log-file "/tmp/dired.log")
2474 (defun anything-c-copy-files-async-1 (flist dest)
2475 "Copy a list of Files FLIST to DEST asynchronously.
2476 It use another emacs process to do the job.
2477 Communication with background emacs is done with temp file
2478 `anything-c-copy-files-async-log-file'."
2479 (start-file-process "emacs-batch" nil anything-c-copy-async-prefered-emacs
2480 "-Q" "--batch" "--eval"
2481 (format "(progn
2482 (require 'dired) (require 'cl)
2483 (let ((dired-recursive-copies 'always)
2484 failures success
2485 (ovw-count 0)
2486 (cpf-count 0))
2487 (dolist (f '%S)
2488 (condition-case err
2489 (let ((file-exists (file-exists-p
2490 (expand-file-name
2491 (file-name-nondirectory (directory-file-name f))
2492 (file-name-directory
2493 (file-name-as-directory \"%s\"))))))
2494 (dired-copy-file f \"%s\" t)
2495 (if file-exists
2496 (progn (push (cons \"Overwriting\" f) success)
2497 (incf ovw-count))
2498 (push (cons \"Copying\" f) success)
2499 (incf cpf-count)))
2500 (file-error
2501 (push (dired-make-relative
2502 (expand-file-name
2503 (file-name-nondirectory (directory-file-name f))
2504 (file-name-directory \"%s\")))
2505 failures))))
2506 (with-current-buffer (find-file-noselect \"%s\")
2507 (erase-buffer)
2508 (when failures
2509 (dolist (fail (reverse failures))
2510 (insert (concat \"Failed to copy \" fail \"\n\"))))
2511 (when success
2512 (loop for (a . s) in (reverse success) do
2513 (insert (concat a \" \" s \" to %s done\n\"))))
2514 (and (/= cpf-count 0) (insert (concat (int-to-string cpf-count) \" File(s) Copied\n\")))
2515 (and (/= ovw-count 0) (insert (concat (int-to-string ovw-count) \" File(s) Overwrited\n\")))
2516 (and failures (insert (concat (int-to-string (length failures)) \" File(s) Failed to copy\n\")))
2517 (save-buffer))))"
2518 flist dest dest dest anything-c-copy-files-async-log-file dest)))
2520 (defun anything-c-copy-async-with-log (flist dest)
2521 "Copy file list FLIST to DEST showing log.
2522 Log is send to `anything-c-copy-files-async-log-file'.
2523 Copying is done asynchronously with `anything-c-copy-files-async-1'."
2524 (declare (special auto-revert-interval))
2525 (pop-to-buffer (find-file-noselect anything-c-copy-files-async-log-file))
2526 (set (make-local-variable 'auto-revert-interval) 1)
2527 (erase-buffer)
2528 (insert "Wait copying files...\n")
2529 (sit-for 0.5) (save-buffer)
2530 (goto-char (point-max))
2531 (auto-revert-mode 1)
2532 (anything-c-copy-files-async-1 flist dest))
2534 (defun anything-ff-copy-async (candidate)
2535 "Anything find files action to copy files async.
2536 Copying is done asynchronously with `anything-c-copy-files-async-1'."
2537 (let ((flist (anything-marked-candidates))
2538 (dest (anything-c-read-file-name
2539 "Copy File(s) async To: "
2540 :preselect candidate
2541 :initial-input (car anything-ff-history)
2542 :history (anything-find-files-history :comp-read nil))))
2543 (anything-c-copy-async-with-log flist dest)))
2545 (defun anything-c-copy-files-async ()
2546 "Preconfigured anything to copy file list FLIST to DEST asynchronously."
2547 (interactive)
2548 (let* ((flist (anything-c-read-file-name
2549 "Copy File async: "
2550 :marked-candidates t))
2551 (dest (anything-c-read-file-name
2552 "Copy File async To: "
2553 :preselect (car flist)
2554 :initial-input (car anything-ff-history)
2555 :history (anything-find-files-history :comp-read nil))))
2556 (anything-c-copy-async-with-log flist dest)))
2558 (defvar eshell-command-aliases-list nil)
2559 (declare-function eshell-read-aliases-list "em-alias")
2560 (defun anything-find-files-eshell-command-on-file-1 (candidate &optional map)
2561 "Run `eshell-command' on CANDIDATE or marked candidates possibly with an eshell alias.
2563 Basename of CANDIDATE can be a wild-card.
2564 If MAP is given run `eshell-command' on all marked files at once,
2565 Otherwise, run `eshell-command' on each marked files.
2567 If `eshell' or `eshell-command' have not been run once, or if you have no eshell aliases
2568 `eshell-command-aliases-list' will not be loaded first time you use this."
2569 (when (or eshell-command-aliases-list
2570 (y-or-n-p "Eshell is not loaded, run eshell-command without alias anyway? "))
2571 (and eshell-command-aliases-list (eshell-read-aliases-list))
2572 (let* ((cand-list (anything-marked-candidates))
2573 (default-directory (or anything-ff-default-directory
2574 ;; If candidate is an url *-ff-default-directory is nil
2575 ;; so keep value of default-directory.
2576 default-directory))
2577 (command (anything-comp-read
2578 "Command: "
2579 (loop for (a . c) in eshell-command-aliases-list
2580 when (string-match "\\(\\$1\\|\\$\\*\\)$" (car c))
2581 collect (propertize a 'help-echo (car c)) into ls
2582 finally return (sort ls 'string<))))
2583 (com-value (car (assoc-default command eshell-command-aliases-list))))
2584 (if (and (or map (and com-value (string-match "\\$\\*$" com-value)))
2585 (> (length cand-list) 1))
2586 ;; Run eshell-command with ALL marked files as arguments.
2587 (let ((mapfiles (mapconcat 'shell-quote-argument cand-list " ")))
2588 (eshell-command (format "%s %s" command mapfiles)))
2589 ;; Run eshell-command on EACH marked files.
2590 (loop
2591 for i in cand-list
2592 for bn = (anything-c-basename i)
2593 for files = (if (and bn (string-match "^\*" bn))
2594 ;; Assume if fname is a wildcard
2595 ;; cand-list have a length of 1.
2596 (mapconcat
2597 'shell-quote-argument
2598 (file-expand-wildcards i t) " ")
2599 (format "'%s'" i))
2600 for com = (if (string-match "'%s'\\|\"%s\"\\|%s" command)
2601 ;; This allow to enter other args AFTER filename
2602 ;; i.e <command %s some_more_args>
2603 (format command files)
2604 (format "%s %s" command files))
2605 do (eshell-command com))))))
2607 (defun anything-find-files-eshell-command-on-file (candidate)
2608 "Run `eshell-command' on CANDIDATE or marked candidates.
2609 See `anything-find-files-eshell-command-on-file-1' for more info."
2610 (anything-find-files-eshell-command-on-file-1
2611 candidate anything-current-prefix-arg))
2613 (declare-function eshell-send-input "esh-mode" (&optional use-region queue-p no-newline))
2614 (defun anything-ff-switch-to-eshell (candidate)
2615 "Switch to eshell and cd to `anything-ff-default-directory'."
2616 (flet ((cd-eshell ()
2617 (goto-char (point-max))
2618 (insert
2619 (format "cd '%s'" anything-ff-default-directory))
2620 (eshell-send-input)))
2621 (if (get-buffer "*eshell*")
2622 (progn
2623 (anything-c-switch-to-buffer "*eshell*")
2624 (cd-eshell))
2625 (call-interactively 'eshell)
2626 (cd-eshell))))
2628 (defun anything-ff-serial-rename-action (method)
2629 "Rename all marked files to `anything-ff-default-directory' with METHOD.
2630 See `anything-ff-serial-rename-1'."
2631 (let ((cands (anything-marked-candidates))
2632 (name (read-string "NewName: "))
2633 (start (read-number "StartAtNumber: "))
2634 (dir (expand-file-name
2635 (anything-c-read-file-name
2636 "Serial Rename to directory: " :initial-input
2637 (expand-file-name anything-ff-default-directory)))))
2638 (when (y-or-n-p (format "Serial Rename %s *files to `%s' with prefix `%s'? "
2639 (length cands) dir name))
2640 (anything-ff-serial-rename-1 dir cands name start :method method)
2641 (anything-find-files1 dir))))
2643 (defun anything-ff-member-directory-p (file directory)
2644 (let ((dir-file (expand-file-name (file-name-as-directory (file-name-directory file))))
2645 (cur-dir (expand-file-name (file-name-as-directory directory))))
2646 (string= dir-file cur-dir)))
2648 (defun* anything-ff-serial-rename-1
2649 (directory collection new-name start-at-num &key (method 'rename))
2650 "rename files in COLLECTION to DIRECTORY with the prefix name NEW-NAME.
2651 Rename start at number START-AT-NUM - ex: prefixname-01.jpg.
2652 METHOD can be one of rename, copy or symlink.
2653 Files will be renamed if they are files of current directory, otherwise they
2654 will be treated with METHOD.
2655 Default METHOD is rename."
2656 ;; Maybe remove directories selected by error in collection.
2657 (setq collection (remove-if 'file-directory-p collection))
2658 (flet ((symlink-file (file dest)
2659 (let ((flist (list file)))
2660 (anything-dired-action
2661 dest :action 'symlink :files flist))))
2663 (let* ((tmp-dir (file-name-as-directory
2664 (concat (file-name-as-directory directory)
2665 (symbol-name (gensym "tmp")))))
2666 (fn (case method
2667 (copy 'copy-file)
2668 (symlink 'symlink-file)
2669 (rename 'rename-file)
2670 (t (error "Error: Unknow method %s" method)))))
2671 (make-directory tmp-dir)
2672 (loop for i in collection
2673 for count from start-at-num
2674 for fnum = (if (< count 10) "0%s" "%s")
2675 for nname = (concat tmp-dir new-name (format fnum count)
2676 (file-name-extension i 'dot))
2677 do (if (anything-ff-member-directory-p i directory)
2678 (rename-file i nname)
2679 (funcall fn i nname)))
2680 (loop with dirlist = (directory-files
2681 tmp-dir t directory-files-no-dot-files-regexp)
2682 for f in dirlist do
2683 (if (file-symlink-p f)
2684 (symlink-file (file-truename f)
2685 (concat (file-name-as-directory directory)
2686 (anything-c-basename f)))
2687 (rename-file f directory)))
2688 (delete-directory tmp-dir t))))
2690 (defun anything-ff-serial-rename (candidate)
2691 "Serial rename all marked files to `anything-ff-default-directory'.
2692 Rename only file of current directory, and symlink files coming from
2693 other directories.
2694 See `anything-ff-serial-rename-1'."
2695 (anything-ff-serial-rename-action 'rename))
2697 (defun anything-ff-serial-rename-by-symlink (candidate)
2698 "Serial rename all marked files to `anything-ff-default-directory'.
2699 Rename only file of current directory, and symlink files coming from
2700 other directories.
2701 See `anything-ff-serial-rename-1'."
2702 (anything-ff-serial-rename-action 'symlink))
2704 (defun anything-ff-serial-rename-by-copying (candidate)
2705 "Serial rename all marked files to `anything-ff-default-directory'.
2706 Rename only file of current directory, and copy files coming from
2707 other directories.
2708 See `anything-ff-serial-rename-1'."
2709 (anything-ff-serial-rename-action 'copy))
2711 (defun anything-ff-help ()
2712 "Help command for `anything-find-files'."
2713 (interactive)
2714 (let ((anything-help-message "== Anything Find Files ==
2715 \nTips:
2716 \nEnter \"~/\" at anytime to reach home directory.
2717 Enter \"/\" at anytime to reach root of your file system.
2718 You can complete with partial basename \(e.g \"fb\" will complete \"foobar\"\).
2719 \nSpecific commands for `anything-find-files':
2720 \\<anything-find-files-map>
2721 \\[anything-ff-run-grep]\t\t->Run Grep (C-u Recursive).
2722 \\[anything-ff-run-pdfgrep]\t\t->Run Pdfgrep on marked files.
2723 \\[anything-ff-run-zgrep]\t\t->Run zgrep (C-u Recursive).
2724 \\[anything-ff-run-etags]\t\t->Run Etags (C-u use thing-at-point `C-u C-u' reload cache)
2725 \\[anything-ff-run-rename-file]\t\t->Rename File (C-u Follow).
2726 \\[anything-ff-run-copy-file]\t\t->Copy File (C-u Follow).
2727 \\[anything-ff-run-byte-compile-file]\t\t->Byte Compile File (C-u Load).
2728 \\[anything-ff-run-load-file]\t\t->Load File.
2729 \\[anything-ff-run-symlink-file]\t\t->Symlink File.
2730 \\[anything-ff-run-delete-file]\t\t->Delete File.
2731 \\[anything-ff-run-kill-buffer-persistent]\t\t->Kill buffer candidate without quitting.
2732 \\[anything-ff-run-switch-to-eshell]\t\t->Switch to Eshell.
2733 \\[anything-ff-run-eshell-command-on-file]\t\t->Eshell command on file (C-u Run on all marked files at once).
2734 \\[anything-ff-run-ediff-file]\t\t->Ediff file.
2735 \\[anything-ff-run-ediff-merge-file]\t\t->Ediff merge file.
2736 \\[anything-ff-run-complete-fn-at-point]\t\t->Complete file name at point.
2737 \\[anything-ff-run-switch-other-window]\t\t->Switch other window.
2738 \\[anything-ff-run-switch-other-frame]\t\t->Switch other frame.
2739 \\[anything-ff-run-open-file-externally]\t\t->Open file with external program (C-u to choose).
2740 \\[anything-ff-rotate-left-persistent]\t\t->Rotate Image Left.
2741 \\[anything-ff-rotate-right-persistent]\t\t->Rotate Image Right.
2742 \\[anything-find-files-down-one-level]\t\t->Go down precedent directory.
2743 \\[anything-ff-run-switch-to-history]\t\t->Switch to anything find-files history.
2744 \\[anything-ff-properties-persistent]\t\t->Show file properties in a tooltip.
2745 \\[anything-mark-all]\t\t->Mark all visibles candidates.
2746 \\[anything-ff-run-toggle-auto-update]\t->Toggle auto expansion of directories.
2747 \\[anything-unmark-all]\t\t->Unmark all candidates, visibles and invisibles.
2748 \\[anything-ff-run-gnus-attach-files]\t\t->Gnus attach files to message buffer.
2749 \\[anything-ff-run-print-file]\t\t->Print file with default printer.
2750 \\[anything-send-bug-report-from-anything]\t\t->Send Bug report.
2751 \\[anything-ff-help]\t\t->Display this help info.
2752 \n== Anything Map ==
2753 \\{anything-map}
2755 (anything-help)))
2757 (defvar anything-find-files-map
2758 (let ((map (copy-keymap anything-map)))
2759 (define-key map (kbd "M-g s") 'anything-ff-run-grep)
2760 (define-key map (kbd "M-g p") 'anything-ff-run-pdfgrep)
2761 (define-key map (kbd "M-g z") 'anything-ff-run-zgrep)
2762 (define-key map (kbd "M-.") 'anything-ff-run-etags)
2763 (define-key map (kbd "M-R") 'anything-ff-run-rename-file)
2764 (define-key map (kbd "M-C") 'anything-ff-run-copy-file)
2765 (define-key map (kbd "M-B") 'anything-ff-run-byte-compile-file)
2766 (define-key map (kbd "M-L") 'anything-ff-run-load-file)
2767 (define-key map (kbd "M-S") 'anything-ff-run-symlink-file)
2768 (define-key map (kbd "M-D") 'anything-ff-run-delete-file)
2769 (define-key map (kbd "M-K") 'anything-ff-run-kill-buffer-persistent)
2770 (define-key map (kbd "M-e") 'anything-ff-run-switch-to-eshell)
2771 (define-key map (kbd "<M-tab>") 'anything-ff-run-complete-fn-at-point)
2772 (define-key map (kbd "C-o") 'anything-ff-run-switch-other-window)
2773 (define-key map (kbd "C-c C-o") 'anything-ff-run-switch-other-frame)
2774 (define-key map (kbd "C-c C-x") 'anything-ff-run-open-file-externally)
2775 (define-key map (kbd "M-!") 'anything-ff-run-eshell-command-on-file)
2776 (define-key map (kbd "C-=") 'anything-ff-run-ediff-file)
2777 (define-key map (kbd "C-c =") 'anything-ff-run-ediff-merge-file)
2778 (define-key map (kbd "M-p") 'anything-ff-run-switch-to-history)
2779 (define-key map (kbd "M-i") 'anything-ff-properties-persistent)
2780 (define-key map (kbd "C-c ?") 'anything-ff-help)
2781 (define-key map (kbd "C-<backspace>") 'anything-ff-run-toggle-auto-update)
2782 (define-key map (kbd "M-a") 'anything-mark-all)
2783 (define-key map (kbd "M-u") 'anything-unmark-all)
2784 (define-key map (kbd "C-c C-a") 'anything-ff-run-gnus-attach-files)
2785 (define-key map (kbd "C-c p") 'anything-ff-run-print-file)
2786 ;; Next 2 have no effect if candidate is not an image file.
2787 (define-key map (kbd "M-l") 'anything-ff-rotate-left-persistent)
2788 (define-key map (kbd "M-r") 'anything-ff-rotate-right-persistent)
2789 (define-key map (kbd "C-.") 'anything-find-files-down-one-level)
2790 (define-key map (kbd "C-l") 'anything-find-files-down-one-level)
2791 (define-key map (kbd "C-h C-b") 'anything-send-bug-report-from-anything)
2792 (when anything-ff-lynx-style-map
2793 (define-key map (kbd "<left>") 'anything-find-files-down-one-level)
2794 (define-key map (kbd "<right>") 'anything-execute-persistent-action))
2795 (delq nil map))
2796 "Keymap for `anything-find-files'.")
2798 (defun anything-c-quit-and-execute-action (action)
2799 "Quit current anything session and execute ACTION."
2800 (setq anything-saved-action action)
2801 (anything-exit-minibuffer))
2803 (defun anything-ff-toggle-auto-update (candidate)
2804 (setq anything-ff-auto-update-flag (not anything-ff-auto-update-flag))
2805 (message "[Auto expansion %s]"
2806 (if anything-ff-auto-update-flag "enabled" "disabled")))
2808 ;;;###autoload
2809 (defun anything-ff-run-toggle-auto-update ()
2810 (interactive)
2811 (anything-execute-persistent-action 'toggle-auto-update))
2813 ;;;###autoload
2814 (defun anything-ff-run-switch-to-history ()
2815 "Run Switch to history action from `anything-c-source-find-files'."
2816 (interactive)
2817 (anything-c-quit-and-execute-action 'anything-find-files-switch-to-hist))
2819 ;;;###autoload
2820 (defun anything-ff-run-grep ()
2821 "Run Grep action from `anything-c-source-find-files'."
2822 (interactive)
2823 (anything-c-quit-and-execute-action 'anything-find-files-grep))
2825 ;;;###autoload
2826 (defun anything-ff-run-pdfgrep ()
2827 "Run Pdfgrep action from `anything-c-source-find-files'."
2828 (interactive)
2829 (anything-c-quit-and-execute-action 'anything-ff-pdfgrep))
2831 ;;;###autoload
2832 (defun anything-ff-run-zgrep ()
2833 "Run Grep action from `anything-c-source-find-files'."
2834 (interactive)
2835 (anything-c-quit-and-execute-action 'anything-ff-zgrep))
2837 ;;;###autoload
2838 (defun anything-ff-run-copy-file ()
2839 "Run Copy file action from `anything-c-source-find-files'."
2840 (interactive)
2841 (anything-c-quit-and-execute-action 'anything-find-files-copy))
2843 ;;;###autoload
2844 (defun anything-ff-run-rename-file ()
2845 "Run Rename file action from `anything-c-source-find-files'."
2846 (interactive)
2847 (anything-c-quit-and-execute-action 'anything-find-files-rename))
2849 ;;;###autoload
2850 (defun anything-ff-run-byte-compile-file ()
2851 "Run Byte compile file action from `anything-c-source-find-files'."
2852 (interactive)
2853 (anything-c-quit-and-execute-action 'anything-find-files-byte-compile))
2855 ;;;###autoload
2856 (defun anything-ff-run-load-file ()
2857 "Run Load file action from `anything-c-source-find-files'."
2858 (interactive)
2859 (anything-c-quit-and-execute-action 'anything-find-files-load-files))
2861 ;;;###autoload
2862 (defun anything-ff-run-eshell-command-on-file ()
2863 "Run eshell command on file action from `anything-c-source-find-files'."
2864 (interactive)
2865 (anything-c-quit-and-execute-action 'anything-find-files-eshell-command-on-file))
2867 ;;;###autoload
2868 (defun anything-ff-run-ediff-file ()
2869 "Run Ediff file action from `anything-c-source-find-files'."
2870 (interactive)
2871 (anything-c-quit-and-execute-action 'anything-find-files-ediff-files))
2873 ;;;###autoload
2874 (defun anything-ff-run-ediff-merge-file ()
2875 "Run Ediff merge file action from `anything-c-source-find-files'."
2876 (interactive)
2877 (anything-c-quit-and-execute-action 'anything-find-files-ediff-merge-files))
2879 ;;;###autoload
2880 (defun anything-ff-run-symlink-file ()
2881 "Run Symlink file action from `anything-c-source-find-files'."
2882 (interactive)
2883 (anything-c-quit-and-execute-action 'anything-find-files-symlink))
2885 ;;;###autoload
2886 (defun anything-ff-run-delete-file ()
2887 "Run Delete file action from `anything-c-source-find-files'."
2888 (interactive)
2889 (anything-c-quit-and-execute-action 'anything-delete-marked-files))
2891 ;;;###autoload
2892 (defun anything-ff-run-complete-fn-at-point ()
2893 "Run complete file name action from `anything-c-source-find-files'."
2894 (interactive)
2895 (anything-c-quit-and-execute-action
2896 'anything-c-insert-file-name-completion-at-point))
2898 ;;;###autoload
2899 (defun anything-ff-run-switch-to-eshell ()
2900 "Run switch to eshell action from `anything-c-source-find-files'."
2901 (interactive)
2902 (anything-c-quit-and-execute-action 'anything-ff-switch-to-eshell))
2904 ;;;###autoload
2905 (defun anything-ff-run-switch-other-window ()
2906 "Run switch to other window action from `anything-c-source-find-files'."
2907 (interactive)
2908 (anything-c-quit-and-execute-action 'find-file-other-window))
2910 ;;;###autoload
2911 (defun anything-ff-run-switch-other-frame ()
2912 "Run switch to other frame action from `anything-c-source-find-files'."
2913 (interactive)
2914 (anything-c-quit-and-execute-action 'find-file-other-frame))
2916 ;;;###autoload
2917 (defun anything-ff-run-open-file-externally ()
2918 "Run open file externally command action from `anything-c-source-find-files'."
2919 (interactive)
2920 (anything-c-quit-and-execute-action 'anything-c-open-file-externally))
2922 ;;;###autoload
2923 (defun anything-ff-run-gnus-attach-files ()
2924 "Run gnus attach files command action from `anything-c-source-find-files'."
2925 (interactive)
2926 (anything-c-quit-and-execute-action 'anything-ff-gnus-attach-files))
2928 ;;;###autoload
2929 (defun anything-ff-run-etags ()
2930 "Run Etags command action from `anything-c-source-find-files'."
2931 (interactive)
2932 (anything-c-quit-and-execute-action 'anything-ff-etags-select))
2934 (defun anything-ff-print (candidate)
2935 "Print marked files.
2936 Uses the shell command coming from variables `lpr-command' and
2937 `lpr-switches' as default.
2938 Same as `dired-do-print' but for anything."
2939 (let* ((file-list (anything-marked-candidates))
2940 (command (read-string
2941 "Print %s with: "
2942 (mapconcat 'identity
2943 (cons lpr-command
2944 (if (stringp lpr-switches)
2945 (list lpr-switches)
2946 lpr-switches))
2947 " ")))
2948 (file-args (mapconcat #'(lambda (x)
2949 (format "'%s'" x))
2950 file-list " "))
2951 (cmd-line (concat command " " file-args)))
2952 (start-process-shell-command "anything-print" nil cmd-line)))
2954 ;;;###autoload
2955 (defun anything-ff-run-print-file ()
2956 "Run Print file action from `anything-c-source-find-files'."
2957 (interactive)
2958 (anything-c-quit-and-execute-action 'anything-ff-print))
2960 (defun* anything-reduce-file-name (fname level &key unix-close expand)
2961 "Reduce FNAME by LEVEL from end or beginning depending LEVEL value.
2962 If LEVEL is positive reduce from end else from beginning.
2963 If UNIX-CLOSE is non--nil close filename with /.
2964 If EXPAND is non--nil expand-file-name."
2965 (let* ((exp-fname (expand-file-name fname))
2966 (fname-list (split-string (if (or (string= fname "~/") expand)
2967 exp-fname fname) "/" t))
2968 (len (length fname-list))
2969 (pop-list (if (< level 0)
2970 (subseq fname-list (* level -1))
2971 (subseq fname-list 0 (- len level))))
2972 (result (mapconcat 'identity pop-list "/"))
2973 (empty (string= result "")))
2974 (when unix-close (setq result (concat result "/")))
2975 (if (string-match "^~" result)
2976 (if (string= result "~/") "~/" result)
2977 (if (< level 0)
2978 (if empty "../" (concat "../" result))
2979 (cond ((eq system-type 'windows-nt)
2980 (if empty "c:/" result))
2981 (empty "/")
2983 (concat "/" result)))))))
2985 (defun anything-file-completion-source-p ()
2986 "Test if current source is a dired or find-files source."
2987 (let ((ff-sources '("Find Files" "Copy Files"
2988 "Read File Name History"
2989 "Rename Files" "Symlink Files"
2990 "Hardlink Files" "Write File"
2991 "Insert File" "Read file name"))
2992 (cur-source (cdr (assoc 'name (anything-get-current-source)))))
2993 (loop for i in ff-sources
2994 thereis (string= cur-source (concat i anything-c-find-files-doc-header)))))
2996 ;; Internal.
2997 (defvar anything-ff-last-expanded nil
2998 "Store last expanded directory or file in `anything-find-files'.")
3000 (defun anything-find-files-down-one-level (arg)
3001 "Go down one level like unix command `cd ..'.
3002 If prefix numeric arg is given go ARG level down."
3003 (interactive "p")
3004 (with-anything-window
3005 (setq anything-follow-mode nil))
3006 ;; When going to precedent level we want to be at the line
3007 ;; corresponding to actual directory, so store this info
3008 ;; in `anything-ff-last-expanded'.
3009 (if (and (not (file-directory-p anything-pattern))
3010 (file-exists-p anything-pattern))
3011 (setq anything-ff-last-expanded anything-pattern)
3012 (setq anything-ff-last-expanded anything-ff-default-directory))
3013 (when (anything-file-completion-source-p)
3014 (let ((new-pattern (anything-reduce-file-name anything-pattern arg
3015 :unix-close t :expand t)))
3016 (with-selected-window (minibuffer-window)
3017 (delete-minibuffer-contents)
3018 (insert new-pattern)))))
3020 (defun anything-ff-retrieve-last-expanded ()
3021 "Move overlay to last visited directory `anything-ff-last-expanded'.
3022 This happen after using `anything-find-files-down-one-level',
3023 or hitting C-z on \"..\"."
3024 (when (and anything-ff-last-expanded
3025 (anything-file-completion-source-p))
3026 (let ((dirname (directory-file-name anything-ff-last-expanded)))
3027 (with-anything-window
3028 (when (or (re-search-forward (concat dirname "$") nil t)
3029 (re-search-forward
3030 (concat anything-ff-last-expanded "$") nil t))
3031 (forward-line 0)
3032 (anything-mark-current-line)))
3033 (setq anything-ff-last-expanded nil))))
3034 (add-hook 'anything-after-update-hook 'anything-ff-retrieve-last-expanded)
3036 ;; Auto-update: anything-find-files auto expansion of directories.
3037 ;; Internal
3038 (defun anything-ff-update-when-only-one-matched ()
3039 "Expand to directory when sole completion.
3040 When only one cndidate is remaining and it is a directory,
3041 expand to this directory."
3042 (when (and (anything-file-completion-source-p)
3043 anything-ff-auto-update-flag
3044 (<= (anything-approximate-candidate-number) 2)
3045 (>= (length (anything-c-basename anything-pattern)) 2))
3046 (with-anything-window
3047 (anything-next-line)
3048 (let ((cur-cand (anything-get-selection)))
3049 (when (and (file-directory-p cur-cand)
3050 (not (string-match "^.*[.]\\{1,2\\}$" cur-cand)))
3051 (anything-set-pattern (file-name-as-directory cur-cand))
3052 (anything-check-minibuffer-input-1))))))
3053 (add-hook 'anything-after-update-hook 'anything-ff-update-when-only-one-matched)
3055 ;; Allow expanding to home directory or root
3056 ;; when entering respectively "~/" or "//" at end of pattern.
3057 ;; e.g /home/thierry/labo/anything-config-qp/~/
3058 ;; will expand to "~/"
3059 ;; and /home/thierry/labo/anything-config-qp//
3060 ;; will expand to "/"
3061 (defun anything-ff-auto-expand-to-home-or-root ()
3062 (when (and (anything-file-completion-source-p)
3063 (string-match ".*\\(/~/\\|/\\{2\\}\\)$" anything-pattern))
3064 (let ((match (match-string 1 anything-pattern)))
3065 (cond ((string= match "//")
3066 (if (eq system-type 'windows-nt)
3067 (setq anything-pattern "c:/")
3068 (setq anything-pattern "/")))
3069 ((string= match "/~/")
3070 (if (eq system-type 'windows-nt)
3071 (setq anything-pattern (replace-regexp-in-string
3072 "\\\\" "/" (getenv "HOME")))
3073 (setq anything-pattern "~/")))))
3074 (setq anything-ff-default-directory anything-pattern)
3075 (with-current-buffer (window-buffer (minibuffer-window))
3076 (delete-minibuffer-contents)
3077 (insert anything-pattern))))
3078 (add-hook 'anything-after-update-hook 'anything-ff-auto-expand-to-home-or-root)
3080 (defun anything-c-point-file-in-dired (file)
3081 "Put point on filename FILE in dired buffer."
3082 (dired (file-name-directory file))
3083 (dired-goto-file file))
3085 (defun anything-create-tramp-name (fname)
3086 "Build filename for `anything-pattern' like /su:: or /sudo::."
3087 (apply #'tramp-make-tramp-file-name
3088 (loop with v = (tramp-dissect-file-name fname)
3089 for i across v collect i)))
3091 (defun anything-ff-set-pattern (pattern)
3092 "Handle tramp filenames in `anything-pattern'."
3093 (let ((methods (mapcar 'car tramp-methods))
3094 (reg "\\`/\\([^[/:]+\\|[^/]+]\\):.*:")
3095 cur-method tramp-name)
3096 (cond ((string= pattern "") "")
3097 ((string-match ".*\\(~//\\|//\\)$" pattern)
3098 (if (eq system-type 'windows-nt) "c:/" "/"))
3099 ((string-match "^~\\|.*/~/$" pattern)
3100 (let* ((home (getenv "HOME"))
3101 (replace (if (eq system-type 'windows-nt)
3102 (replace-regexp-in-string
3103 "\\\\" "/" home)
3104 home)))
3105 (replace-match replace nil t pattern)))
3106 ;; Match "/method:maybe_hostname:"
3107 ((and (string-match reg pattern)
3108 (setq cur-method (match-string 1 pattern))
3109 (member cur-method methods))
3110 (setq tramp-name (anything-create-tramp-name
3111 (match-string 0 pattern)))
3112 (replace-match tramp-name nil t pattern))
3113 ;; Match "/hostname:"
3114 ((and (string-match tramp-file-name-regexp pattern)
3115 (setq cur-method (match-string 1 pattern))
3116 (and cur-method (not (member cur-method methods))))
3117 (setq tramp-name (anything-create-tramp-name
3118 (match-string 0 pattern)))
3119 (replace-match tramp-name nil t pattern))
3120 ;; Match "/method:" in this case don't try to connect.
3121 ((and (not (string-match reg pattern))
3122 (string-match tramp-file-name-regexp pattern)
3123 (member (match-string 1 pattern) methods))
3124 "Invalid tramp file name") ; Write in anything-buffer.
3125 ;; PATTERN is a directory, end it with "/".
3126 ;; This will make PATTERN not ending yet with "/"
3127 ;; candidate for `anything-ff-default-directory',
3128 ;; allowing `anything-ff-retrieve-last-expanded' to retrieve it
3129 ;; when descending level.
3130 ((file-directory-p pattern)
3131 (file-name-as-directory pattern))
3132 ;; Return PATTERN unchanged.
3133 (t pattern))))
3135 ;; Internal.
3136 (defvar anything-ff-default-directory nil)
3137 (defvar anything-ff-history nil)
3139 (defun anything-find-files-get-candidates ()
3140 "Create candidate list for `anything-c-source-find-files'."
3141 (let* ((path (anything-ff-set-pattern anything-pattern))
3142 (path-name-dir (file-name-directory path))
3143 (tramp-verbose anything-tramp-verbose)) ; No tramp message when 0.
3144 (set-text-properties 0 (length path) nil path)
3145 (setq anything-pattern (anything-ff-transform-fname-for-completion path))
3146 (setq anything-ff-default-directory
3147 (if (string= anything-pattern "")
3148 (if (eq system-type 'windows-nt) "c:/" "/")
3149 (unless (string-match ffap-url-regexp path)
3150 path-name-dir)))
3151 (cond ((or (string= path "Invalid tramp file name")
3152 (file-regular-p path)
3153 (and (not (file-exists-p path)) (string-match "/$" path))
3154 (and ffap-url-regexp (string-match ffap-url-regexp path)))
3155 (list path))
3156 ((string= path "") (directory-files "/" t))
3157 ((and (file-directory-p path) (not (file-readable-p path)))
3158 (list (format "Opening directory: access denied, `%s'" path)))
3159 ((file-directory-p path) (directory-files path t))
3161 (append
3162 (list path)
3163 (directory-files (file-name-directory path) t))))))
3165 (defun anything-ff-transform-fname-for-completion (fname)
3166 "Return FNAME with it's basename modified as a regexp.
3167 e.g foo => f.*o.*o .
3168 If basename contain one or more space or FNAME is a valid directory name
3169 return FNAME unchanged."
3170 (let ((bn (anything-c-basename fname)))
3171 (if (or (not anything-ff-smart-completion)
3172 (string-match "\\s-" bn)
3173 (string-match "/$" fname) ; Allow mkdir.
3174 (file-directory-p fname))
3175 fname ; Fall back to match-plugin.
3176 (setq bn (if (> (length bn) 2) ; Normal completion on first 2 char.
3177 (mapconcat 'identity (split-string bn "" t) ".*") bn))
3178 (concat (file-name-directory fname) bn))))
3180 (defun anything-ff-save-history ()
3181 "Store the last value of `anything-ff-default-directory' \
3182 in `anything-ff-history'."
3183 (when (and anything-ff-default-directory
3184 (anything-file-completion-source-p))
3185 (push anything-ff-default-directory anything-ff-history)))
3186 (add-hook 'anything-cleanup-hook 'anything-ff-save-history)
3188 (defun anything-ff-valid-symlink-p (file)
3189 (file-exists-p (file-truename file)))
3191 (defun anything-ff-properties (candidate)
3192 "Show file properties of CANDIDATE in a tooltip or message."
3193 (let ((type (anything-ff-attributes candidate :type t))
3194 (dired-line (anything-ff-attributes candidate :dired t :human-size t)))
3195 (if (window-system)
3196 (tooltip-show
3197 (concat
3198 (anything-c-basename candidate) ": \n"
3199 "Type: " type "\n"
3200 (when (string= type "symlink")
3201 (format "True name: '%s'\n"
3202 (cond ((string-match "^\.#" (anything-c-basename candidate))
3203 "Autosave symlink")
3204 ((anything-ff-valid-symlink-p candidate)
3205 (file-truename candidate))
3206 (t "Invalid Symlink"))))
3207 dired-line))
3208 (message dired-line) (sit-for 5))))
3210 ;;;###autoload
3211 (defun anything-ff-properties-persistent ()
3212 "Show properties without quitting anything."
3213 (interactive)
3214 (anything-execute-persistent-action 'properties-action))
3216 (defun anything-ff-kill-buffer-fname (candidate)
3217 (let* ((buf (get-file-buffer candidate))
3218 (buf-name (buffer-name buf)))
3219 (if buf
3220 (progn
3221 (kill-buffer buf) (message "Buffer `%s' killed" buf))
3222 (message "No buffer to kill"))))
3224 (defun anything-ff-kill-or-find-buffer-fname (candidate)
3225 "Find file CANDIDATE or kill it's buffer if it is visible.
3226 Never kill `anything-current-buffer'.
3227 Never kill buffer modified.
3228 This is called normally on third hit of \
3229 \\<anything-map>\\[anything-execute-persistent-action]
3230 in `anything-find-files-persistent-action'."
3231 (let* ((buf (get-file-buffer candidate))
3232 (buf-name (buffer-name buf)))
3233 (if (and buf (get-buffer-window buf)
3234 (not (eq buf (get-buffer anything-current-buffer)))
3235 (not (buffer-modified-p buf)))
3236 (progn
3237 (kill-buffer buf) (message "Buffer `%s' killed" buf-name))
3238 (find-file candidate))))
3240 ;;;###autoload
3241 (defun anything-ff-run-kill-buffer-persistent ()
3242 "Execute `anything-ff-kill-buffer-fname' whitout quitting."
3243 (interactive)
3244 (anything-execute-persistent-action 'kill-buffer-fname))
3246 (defun anything-ff-human-size (size)
3247 "Return a string showing SIZE of a file in human readable form.
3248 SIZE can be an integer or a float depending it's value.
3249 `file-attributes' will take care of that to avoid overflow error.
3250 KBSIZE if a floating point number, default value is 1024.0."
3251 (let ((M (cons "M" (/ size (expt anything-ff-default-kbsize 2))))
3252 (G (cons "G" (/ size (expt anything-ff-default-kbsize 3))))
3253 (K (cons "K" (/ size anything-ff-default-kbsize)))
3254 (B (cons "B" size)))
3255 (loop with result = B
3256 for (a . b) in
3257 (loop for (x . y) in (list M G K B)
3258 unless (< y 1) collect (cons x y))
3259 when (< b (cdr result)) do (setq result (cons a b))
3260 finally return (if (string= (car result) "B")
3261 (format "%s" size)
3262 (format "%.1f%s" (cdr result) (car result))))))
3264 (defun* anything-ff-attributes
3265 (file &key type links uid gid access-time modif-time
3266 status size mode gid-change inode device-num dired human-size)
3267 "Easy interface for `file-attributes'."
3268 (let ((all (destructuring-bind
3269 (type links uid gid access-time modif-time
3270 status size mode gid-change inode device-num)
3271 (file-attributes file 'string)
3272 (list :type type
3273 :links links
3274 :uid uid
3275 :gid gid
3276 :access-time access-time
3277 :modif-time modif-time
3278 :status status
3279 :size size
3280 :mode mode
3281 :gid-change gid-change
3282 :inode inode
3283 :device-num device-num))))
3284 (cond (type
3285 (let ((result (getf all :type)))
3286 (cond ((stringp result)
3287 "symlink")
3288 (result "directory")
3289 (t "file"))))
3290 (links (getf all :links))
3291 (uid (getf all :uid))
3292 (gid (getf all :gid))
3293 (access-time
3294 (format-time-string "%Y-%m-%d %R" (getf all :access-time)))
3295 (modif-time
3296 (format-time-string "%Y-%m-%d %R" (getf all :modif-time)))
3297 (status
3298 (format-time-string "%Y-%m-%d %R" (getf all :status)))
3299 (size (if human-size (anything-ff-human-size (getf all :size))
3300 (getf all :size)))
3301 (mode (getf all :mode))
3302 (gid-change (getf all :gid-change))
3303 (inode (getf all :inode))
3304 (device-num (getf all :device-num))
3305 (dired
3306 (concat
3307 (getf all :mode) " "
3308 (number-to-string (getf all :links)) " "
3309 (getf all :uid) ":"
3310 (getf all :gid) " "
3311 (if human-size (anything-ff-human-size (getf all :size))
3312 (int-to-string (getf all :size))) " "
3313 (format-time-string "%Y-%m-%d %R" (getf all :modif-time))))
3314 (t all))))
3317 (defun anything-c-prefix-filename (fname &optional image file-or-symlinkp)
3318 "Return fname FNAME prefixed with icon IMAGE."
3319 (let* ((img-name (and image (expand-file-name
3320 image anything-c-find-files-icons-directory)))
3321 (img (and image (create-image img-name)))
3322 (prefix-img (and image (propertize " " 'display img)))
3323 (prefix-new (propertize
3324 " " 'display
3325 (propertize "[?]" 'face 'anything-ff-prefix)))
3326 (prefix-url (propertize
3327 " " 'display
3328 (propertize "[@]" 'face 'anything-ff-prefix))))
3329 (cond ((or file-or-symlinkp
3330 (file-exists-p fname)
3331 (file-symlink-p fname))
3332 (if image (concat prefix-img fname) fname))
3333 ((string-match ffap-url-regexp fname) (concat prefix-url " " fname))
3334 (t (concat prefix-new " " fname)))))
3336 (defun anything-c-find-files-transformer (files sources)
3337 "Selector of transformer to use for `anything-c-source-find-files'."
3338 (if (and (string-match tramp-file-name-regexp anything-pattern)
3339 anything-ff-tramp-not-fancy)
3340 files
3341 (if (and (window-system) anything-c-find-files-show-icons)
3342 (anything-c-highlight-ffiles1 files sources)
3343 (anything-c-highlight-ffiles files sources))))
3345 (defun anything-c-highlight-ffiles (files sources)
3346 "Candidate transformer for `anything-c-source-find-files' without icons."
3347 (loop for i in files collect
3348 (cond ((and (stringp (car (file-attributes i)))
3349 (not (anything-ff-valid-symlink-p i))
3350 (not (string-match "^\.#" (anything-c-basename i))))
3351 (cons (anything-c-prefix-filename
3352 (propertize i 'face 'anything-ff-invalid-symlink) nil t)
3354 ((stringp (car (file-attributes i)))
3355 (cons (anything-c-prefix-filename
3356 (propertize i 'face 'anything-ff-symlink) nil t)
3358 ((eq t (car (file-attributes i)))
3359 (cons (anything-c-prefix-filename
3360 (propertize i 'face 'anything-ff-directory) nil t)
3362 ((file-executable-p i)
3363 (cons (anything-c-prefix-filename
3364 (propertize i 'face 'anything-ff-executable) nil t)
3367 (cons (anything-c-prefix-filename
3368 (propertize i 'face 'anything-ff-file))
3369 i)))))
3371 (defun anything-c-highlight-ffiles1 (files sources)
3372 "Candidate transformer for `anything-c-source-find-files' that show icons."
3373 (loop for i in files
3374 for af = (file-name-nondirectory i)
3375 collect (cond ( ;; Files.
3376 (eq nil (car (file-attributes i)))
3377 (let ((face (if (file-executable-p i)
3378 'anything-ff-executable
3379 'anything-ff-file)))
3380 (cons (anything-c-prefix-filename
3381 (propertize i 'face face) "leaf.xpm")
3382 i)))
3383 ( ;; Empty directories.
3384 (and (eq t (car (file-attributes i)))
3385 ;; Be sure to have permission to list content.
3386 (file-readable-p i)
3387 (eq 0 (length
3388 (directory-files
3389 i nil directory-files-no-dot-files-regexp t))))
3390 (cons (anything-c-prefix-filename
3391 (propertize
3392 i 'face 'anything-ff-directory)
3393 "empty.xpm")
3395 ( ;; Open directories.
3396 (and (eq t (car (file-attributes i))) (get-buffer af))
3397 (cons (anything-c-prefix-filename
3398 (propertize
3399 i 'face 'anything-ff-directory)
3400 "open.xpm")
3402 ( ;; Closed directories.
3403 (eq t (car (file-attributes i)))
3404 (cons (anything-c-prefix-filename
3405 (propertize
3406 i 'face 'anything-ff-directory)
3407 "close.xpm")
3409 ( ;; Open Symlinks directories.
3410 (and (stringp (car (file-attributes i)))
3411 (file-directory-p i) (get-buffer af))
3412 (cons (anything-c-prefix-filename
3413 (propertize i 'face 'anything-ff-symlink))
3415 ( ;; Closed Symlinks directories.
3416 (and (stringp (car (file-attributes i)))
3417 (file-directory-p i))
3418 (cons (anything-c-prefix-filename
3419 (propertize i 'face 'anything-ff-symlink))
3421 ( ;; Invalid Symlinks
3422 (and (stringp (car (file-attributes i)))
3423 (not (anything-ff-valid-symlink-p i))
3424 (not (string-match "^\.#" (anything-c-basename i))))
3425 (cons (anything-c-prefix-filename
3426 (propertize i 'face 'anything-ff-invalid-symlink)
3427 "leaf.xpm")
3429 ( ;; Files symlinks.
3430 (stringp (car (file-attributes i)))
3431 (cons (anything-c-prefix-filename
3432 (propertize i 'face 'anything-ff-symlink)
3433 "leaf.xpm")
3434 i)))))
3436 (defun anything-find-files-action-transformer (actions candidate)
3437 "Action transformer for `anything-c-source-find-files'."
3438 (cond ((with-current-buffer anything-current-buffer
3439 (eq major-mode 'message-mode))
3440 (append (subseq actions 0 4)
3441 '(("Gnus attach file(s)" . anything-ff-gnus-attach-files))
3442 (subseq actions 4)))
3443 ((string-match (image-file-name-regexp) candidate)
3444 (append (subseq actions 0 4)
3445 '(("Rotate image right `M-r'" . anything-ff-rotate-image-right)
3446 ("Rotate image left `M-l'" . anything-ff-rotate-image-left))
3447 (subseq actions 4)))
3448 ((string-match "\.el$" (anything-aif (anything-marked-candidates)
3449 (car it) candidate))
3450 (append (subseq actions 0 4)
3451 '(("Byte compile lisp file(s) `M-B, C-u to load'"
3452 . anything-find-files-byte-compile)
3453 ("Load File(s) `M-L'" . anything-find-files-load-files))
3454 (subseq actions 4)))
3455 ((and (string-match "\.html?$" candidate)
3456 (file-exists-p candidate))
3457 (append (subseq actions 0 4)
3458 '(("Browse url file" . browse-url-of-file))
3459 (subseq actions 5)))
3460 ((or (string= (file-name-extension candidate) "pdf")
3461 (string= (file-name-extension candidate) "PDF"))
3462 (append (subseq actions 0 4)
3463 '(("Pdfgrep File(s)" . anything-ff-pdfgrep))
3464 (subseq actions 5)))
3465 (t actions)))
3467 (defun anything-ff-gnus-attach-files (candidate)
3468 "Run `gnus-dired-attach' on `anything-marked-candidates' or CANDIDATE."
3469 (let ((flist (anything-marked-candidates)))
3470 (gnus-dired-attach flist)))
3472 (defun anything-ff-rotate-current-image1 (file &optional num-arg)
3473 "Rotate current image at NUM-ARG degrees.
3474 This is a destructive operation on FILE made by external tool mogrify."
3475 (setq file (file-truename file)) ; For symlinked images.
3476 ;; When FILE is not an image-file, do nothing.
3477 (when (string-match (image-file-name-regexp) file)
3478 (if (executable-find "mogrify")
3479 (progn
3480 (shell-command (format "mogrify -rotate %s %s" (or num-arg 90) file))
3481 (when (buffer-live-p image-dired-display-image-buffer)
3482 (kill-buffer image-dired-display-image-buffer))
3483 (image-dired-display-image file)
3484 (message nil)
3485 (display-buffer (get-buffer image-dired-display-image-buffer)))
3486 (error "mogrify not found"))))
3488 (defun anything-ff-rotate-image-left (candidate)
3489 "Rotate image file CANDIDATE left.
3490 This affect directly file CANDIDATE."
3491 (anything-ff-rotate-current-image1 candidate -90))
3493 (defun anything-ff-rotate-image-right (candidate)
3494 "Rotate image file CANDIDATE right.
3495 This affect directly file CANDIDATE."
3496 (anything-ff-rotate-current-image1 candidate))
3498 (defun anything-ff-rotate-left-persistent ()
3499 "Rotate image left without quitting anything."
3500 (interactive)
3501 (anything-execute-persistent-action 'image-action1))
3503 (defun anything-ff-rotate-right-persistent ()
3504 "Rotate image right without quitting anything."
3505 (interactive)
3506 (anything-execute-persistent-action 'image-action2))
3508 (defun anything-ff-exif-data (candidate)
3509 "Extract exif data from file CANDIDATE using `anything-ff-exif-data-program'."
3510 (if (and anything-ff-exif-data-program
3511 (executable-find anything-ff-exif-data-program))
3512 (shell-command-to-string (format "%s %s %s"
3513 anything-ff-exif-data-program
3514 anything-ff-exif-data-program-args
3515 candidate))
3516 (format "No program %s found to extract exif"
3517 anything-ff-exif-data-program)))
3519 (defun anything-find-files-persistent-action (candidate)
3520 "Open subtree CANDIDATE without quitting anything.
3521 If CANDIDATE is not a directory expand CANDIDATE filename.
3522 If CANDIDATE is alone, open file CANDIDATE filename.
3523 That's mean:
3524 First hit on C-z expand CANDIDATE second hit open file.
3525 If a prefix arg is given or `anything-follow-mode' is on open file."
3526 (let ((follow (buffer-local-value
3527 'anything-follow-mode
3528 (get-buffer-create anything-buffer)))
3529 (new-pattern (anything-get-selection))
3530 (num-lines-buf (with-current-buffer anything-buffer
3531 (count-lines (point-min) (point-max)))))
3532 (flet ((insert-in-minibuffer (fname)
3533 (with-selected-window (minibuffer-window)
3534 (unless follow
3535 (delete-minibuffer-contents)
3536 (set-text-properties 0 (length fname) nil fname)
3537 (insert fname)))))
3538 (cond (;; A symlink directory, expand it's truename.
3539 (and (file-directory-p candidate) (file-symlink-p candidate))
3540 (insert-in-minibuffer (file-name-as-directory
3541 (file-truename
3542 (expand-file-name candidate)))))
3543 ;; A directory, open it.
3544 ((file-directory-p candidate)
3545 (when (string= (anything-c-basename candidate) "..")
3546 (setq anything-ff-last-expanded anything-ff-default-directory))
3547 (insert-in-minibuffer (file-name-as-directory
3548 (expand-file-name candidate))))
3549 ;; A symlink file, expand to it's true name. (first hit)
3550 ((and (file-symlink-p candidate) (not current-prefix-arg) (not follow))
3551 (insert-in-minibuffer (file-truename candidate)))
3552 ;; A regular file, expand it, (first hit)
3553 ((and (>= num-lines-buf 3) (not current-prefix-arg) (not follow))
3554 (insert-in-minibuffer new-pattern))
3555 ;; An image file and it is the second hit on C-z,
3556 ;; show the file in `image-dired'.
3557 ((string-match (image-file-name-regexp) candidate)
3558 (when (buffer-live-p image-dired-display-image-buffer)
3559 (kill-buffer image-dired-display-image-buffer))
3560 (image-dired-display-image candidate)
3561 (message nil)
3562 (anything-c-switch-to-buffer image-dired-display-image-buffer)
3563 (with-current-buffer image-dired-display-image-buffer
3564 (let ((exif-data (anything-ff-exif-data candidate)))
3565 (image-dired-update-property 'help-echo exif-data))))
3566 ;; Allow browsing archive on avfs fs.
3567 ;; Assume volume is already mounted with mountavfs.
3568 ((and anything-ff-avfs-directory
3569 (string-match
3570 (regexp-quote (expand-file-name anything-ff-avfs-directory))
3571 (file-name-directory candidate))
3572 (anything-ff-file-compressed-p candidate))
3573 (insert-in-minibuffer (concat candidate "#")))
3574 ;; On second hit we open file.
3575 ;; On Third hit we kill it's buffer maybe.
3577 (anything-ff-kill-or-find-buffer-fname candidate))))))
3579 (defvar anything-ff-avfs-directory nil
3580 "*The default avfs directory, usually '.avfs'.
3581 When this is set you will be able to expand archive filenames with `C-z'
3582 inside an avfs directory mounted with mountavfs.
3583 See <http://sourceforge.net/projects/avf/>.")
3584 (defvar anything-ff-file-compressed-list '("gz" "bz2" "zip" "7z")
3585 "*Minimal list of compressed files extension.")
3586 (defun anything-ff-file-compressed-p (candidate)
3587 "Whether CANDIDATE is a compressed file or not."
3588 (member (file-name-extension candidate)
3589 anything-ff-file-compressed-list))
3591 (defun anything-c-insert-file-name-completion-at-point (candidate)
3592 "Insert file name completion at point."
3593 (if buffer-read-only
3594 (error "Error: Buffer `%s' is read-only" (buffer-name))
3595 (let* ((end (point))
3596 (guess (substring-no-properties (thing-at-point 'filename)))
3597 (beg (- (point) (length guess)))
3598 (full-path-p (or (string-match-p (concat "^" (getenv "HOME")) guess)
3599 (string-match-p "^[^\~]" guess))))
3600 (set-text-properties 0 (length candidate) nil candidate)
3601 (if (and guess (not (string= guess "")) (string-match-p "^~\\|/.*" guess))
3602 (progn
3603 (delete-region beg end)
3604 (insert (if full-path-p
3605 (expand-file-name candidate)
3606 (abbreviate-file-name candidate))))
3607 (error "Aborting completion: No valid file name at point")))))
3609 (defun* anything-find-files-history (&key (comp-read t))
3610 "The `anything-find-files' history.
3611 Show the first `anything-ff-history-max-length' elements of `anything-ff-history'
3612 in an `anything-comp-read'."
3613 (let ((history (when anything-ff-history
3614 (loop with dup for i in anything-ff-history
3615 ;; Remove duplicate and not existing files.
3616 ;; Keep remote files.
3617 unless (or (member i dup)
3618 (and (not (file-remote-p i))
3619 (not (file-exists-p i))))
3620 collect i into dup
3621 finally return dup)))) ; Remove dups.
3622 (when history
3623 (setq anything-ff-history
3624 (if (>= (length history) anything-ff-history-max-length)
3625 (subseq history 0 anything-ff-history-max-length)
3626 history))
3627 (if comp-read
3628 (anything-comp-read
3629 "Switch to Directory: "
3630 anything-ff-history
3631 :name "Anything Find Files History"
3632 :must-match t)
3633 anything-ff-history))))
3635 ;;;###autoload
3636 (defun anything-find-files (arg)
3637 "Preconfigured `anything' for anything implementation of `find-file'.
3638 Called with a prefix arg show history if some.
3639 Don't call it from programs, use `anything-find-files1' instead.
3640 This is the starting point for nearly all actions you can do on files."
3641 (interactive "P")
3642 (let ((any-input (if (and arg anything-ff-history)
3643 (anything-find-files-history)
3644 (anything-find-files-initial-input))))
3645 (when (and (eq major-mode 'org-agenda-mode)
3646 org-directory
3647 (not any-input))
3648 (setq any-input (expand-file-name org-directory)))
3649 (set-text-properties 0 (length any-input) nil any-input)
3650 (if any-input
3651 ;; [Emacs-bug work around]
3652 ;; auto-expanding on a partial directory name as input
3653 ;; yield indefinitely this directory name in minibuffer
3654 ;; for unknow reasons, so disable auto-expansion for now
3655 ;; when any-input is an incomplete file/dir name.
3656 (let* ((anything-ff-auto-update-initial-value
3657 (and anything-ff-auto-update-initial-value
3658 (file-exists-p any-input)))
3659 (anything-ff-auto-update-flag
3660 anything-ff-auto-update-initial-value))
3661 (anything-find-files1 any-input))
3662 (setq any-input (expand-file-name (anything-c-current-directory)))
3663 (anything-find-files1 any-input (buffer-file-name (current-buffer))))))
3666 (defun anything-find-files1 (fname &optional preselect)
3667 "Find FNAME with `anything' completion.
3668 Like `find-file' but with `anything' support.
3669 Use it for non--interactive calls of `anything-find-files'."
3670 (when (get-buffer anything-action-buffer)
3671 (kill-buffer anything-action-buffer))
3672 (let ((anything-mp-highlight-delay nil))
3673 (anything :sources 'anything-c-source-find-files
3674 :input fname
3675 :preselect preselect
3676 :keymap anything-find-files-map
3677 :prompt "Find Files or Url: "
3678 :buffer "*Anything Find Files*")))
3681 (defun anything-find-files-initial-input (&optional input)
3682 "Return INPUT if present, otherwise try to guess it."
3683 (or (and input (expand-file-name input))
3684 (anything-find-files-input
3685 (ffap-guesser)
3686 (thing-at-point 'filename))))
3688 (defun anything-find-files-input (fap tap)
3689 "Default input of `anything-find-files'."
3690 (let* ((def-dir (anything-c-current-directory))
3691 (lib (anything-find-library-at-point))
3692 (url (anything-ff-find-url-at-point))
3693 (file-p (and fap (not (string= fap ""))
3694 (file-exists-p fap)
3695 tap (not (string= tap ""))
3696 (file-exists-p
3697 (file-name-directory (expand-file-name tap def-dir))))))
3698 (cond (lib) ; e.g we are inside a require sexp.
3699 (url) ; String at point is an hyperlink.
3700 (file-p (expand-file-name tap def-dir))
3701 (t (and (not (string= fap "")) fap)))))
3703 (defun anything-c-current-directory ()
3704 "Return current-directory name at point.
3705 Useful in dired buffers when there is inserted subdirs."
3706 (if (eq major-mode 'dired-mode)
3707 (dired-current-directory)
3708 default-directory))
3710 (defun anything-ff-find-url-at-point ()
3711 "Try to find link to an url in text-property at point."
3712 (let* ((he (get-text-property (point) 'help-echo))
3713 (ov (overlays-at (point)))
3714 (ov-he (and ov (overlay-get
3715 (car (overlays-at (point))) 'help-echo)))
3716 (w3m-l (get-text-property (point) 'w3m-href-anchor))
3717 (nt-prop (get-text-property (point) 'nt-link)))
3718 ;; Org link.
3719 (when (and (stringp he) (string-match "^LINK: " he))
3720 (setq he (replace-match "" t t he)))
3721 (loop for i in (list he ov-he w3m-l nt-prop)
3722 thereis (and (stringp i) (string-match ffap-url-regexp i) i))))
3724 (defun anything-find-library-at-point ()
3725 "Try to find library path at point.
3726 Find inside `require' and `declare-function' sexp."
3727 (require 'find-func)
3728 (let* ((beg-sexp (save-excursion (search-backward "(" (point-at-bol) t)))
3729 (end-sexp (save-excursion (search-forward ")" (point-at-eol) t)))
3730 (sexp (and beg-sexp end-sexp
3731 (buffer-substring-no-properties
3732 (1+ beg-sexp) (1- end-sexp)))))
3733 (ignore-errors
3734 (cond ((and sexp (string-match "require \'.+[^)]" sexp))
3735 (find-library-name
3736 (replace-regexp-in-string
3737 "'\\|\)\\|\(" ""
3738 ;; If require use third arg, ignore it,
3739 ;; always use library path found in `load-path'.
3740 (second (split-string (match-string 0 sexp))))))
3741 ((and sexp (string-match-p "^declare-function" sexp))
3742 (find-library-name
3743 (replace-regexp-in-string
3744 "\"\\|ext:" ""
3745 (third (split-string sexp)))))
3746 (t nil)))))
3748 ;;; Anything completion for `write-file'.==> C-x C-w
3749 (defvar anything-c-source-write-file
3750 `((name . ,(concat "Write File" anything-c-find-files-doc-header))
3751 ;; It is needed for filenames with capital letters
3752 (disable-shortcuts)
3753 (candidates . anything-find-files-get-candidates)
3754 (filtered-candidate-transformer anything-c-find-files-transformer)
3755 (persistent-action . anything-find-files-persistent-action)
3756 (persistent-help . "Expand Candidate")
3757 (volatile)
3758 (action .
3759 (("Write File" . (lambda (candidate)
3760 (write-file candidate 'confirm)))))))
3762 ;;;###autoload
3763 (defun anything-write-file ()
3764 "Preconfigured `anything' providing completion for `write-file'."
3765 (interactive)
3766 (let ((anything-mp-highlight-delay nil))
3767 (anything :sources 'anything-c-source-write-file
3768 :input (expand-file-name default-directory)
3769 :prompt "Write buffer to file: "
3770 :buffer "*Anything write file*")))
3772 ;;; Anything completion for `insert-file'.==> C-x i
3773 (defvar anything-c-source-insert-file
3774 `((name . ,(concat "Insert File" anything-c-find-files-doc-header))
3775 ;; It is needed for filenames with capital letters
3776 (disable-shortcuts)
3777 (candidates . anything-find-files-get-candidates)
3778 (filtered-candidate-transformer anything-c-find-files-transformer)
3779 (persistent-action . anything-find-files-persistent-action)
3780 (persistent-help . "Expand Candidate")
3781 (volatile)
3782 (action .
3783 (("Insert File" . (lambda (candidate)
3784 (when (y-or-n-p (format "Really insert %s in %s "
3785 candidate anything-current-buffer))
3786 (insert-file-contents candidate))))))))
3788 ;;;###autoload
3789 (defun anything-insert-file ()
3790 "Preconfigured `anything' providing completion for `insert-file'."
3791 (interactive)
3792 (let ((anything-mp-highlight-delay nil))
3793 (anything :sources 'anything-c-source-insert-file
3794 :input (expand-file-name default-directory)
3795 :prompt "Insert file: "
3796 :buffer "*Anything insert file*")))
3798 ;;; Anything completion for copy, rename and (rel)sym/hard/link files from dired.
3799 (defvar anything-c-source-copy-files
3800 `((name . ,(concat "Copy Files" anything-c-find-files-doc-header))
3801 ;; It is needed for filenames with capital letters
3802 (disable-shortcuts)
3803 (candidates . anything-find-files-get-candidates)
3804 (filtered-candidate-transformer anything-c-find-files-transformer)
3805 (persistent-action . anything-find-files-persistent-action)
3806 (persistent-help . "Expand Candidate")
3807 (volatile)
3808 (action .
3809 (("Copy File"
3810 . (lambda (candidate)
3811 (anything-dired-action candidate :action 'copy)))
3812 ("Copy and Follow"
3813 . (lambda (candidate)
3814 (anything-dired-action candidate :action 'copy :follow t)))))))
3817 (defvar anything-c-source-rename-files
3818 `((name . ,(concat "Rename Files" anything-c-find-files-doc-header))
3819 ;; It is needed for filenames with capital letters
3820 (disable-shortcuts)
3821 (candidates . anything-find-files-get-candidates)
3822 (filtered-candidate-transformer anything-c-find-files-transformer)
3823 (persistent-action . anything-find-files-persistent-action)
3824 (persistent-help . "Expand Candidate")
3825 (volatile)
3826 (action .
3827 (("Rename File"
3828 . (lambda (candidate)
3829 (anything-dired-action candidate :action 'rename)))
3830 ("Rename and Follow"
3831 . (lambda (candidate)
3832 (anything-dired-action candidate :action 'rename :follow t)))))))
3834 (defvar anything-c-source-symlink-files
3835 `((name . ,(concat "Symlink Files" anything-c-find-files-doc-header))
3836 ;; It is needed for filenames with capital letters
3837 (disable-shortcuts)
3838 (candidates . anything-find-files-get-candidates)
3839 (filtered-candidate-transformer anything-c-find-files-transformer)
3840 (persistent-action . anything-find-files-persistent-action)
3841 (persistent-help . "Expand Candidate")
3842 (volatile)
3843 (action
3844 . (("Symlink File"
3845 . (lambda (candidate)
3846 (anything-dired-action candidate :action 'symlink)))
3847 ("RelSymlink File"
3848 . (lambda (candidate)
3849 (anything-dired-action candidate :action 'relsymlink)))))))
3852 (defvar anything-c-source-hardlink-files
3853 `((name . ,(concat "Hardlink Files" anything-c-find-files-doc-header))
3854 ;; It is needed for filenames with capital letters
3855 (disable-shortcuts)
3856 (candidates . anything-find-files-get-candidates)
3857 (filtered-candidate-transformer anything-c-find-files-transformer)
3858 (persistent-action . anything-find-files-persistent-action)
3859 (persistent-help . "Expand Candidate")
3860 (volatile)
3861 (action
3862 . (("Hardlink File"
3863 . (lambda (candidate)
3864 (anything-dired-action candidate :action 'hardlink)))))))
3866 (defun* anything-dired-action (candidate &key action follow (files (dired-get-marked-files)))
3867 "Copy, rename or symlink file at point or marked files in dired to CANDIDATE.
3868 ACTION is a key that can be one of 'copy, 'rename, 'symlink, 'relsymlink."
3869 (when (get-buffer dired-log-buffer) (kill-buffer dired-log-buffer))
3870 (let ((fn (case action
3871 ('copy 'dired-copy-file)
3872 ('rename 'dired-rename-file)
3873 ('symlink 'make-symbolic-link)
3874 ('relsymlink 'dired-make-relative-symlink)
3875 ('hardlink 'dired-hardlink)))
3876 (marker (case action
3877 ((copy rename) dired-keep-marker-copy)
3878 ('symlink dired-keep-marker-symlink)
3879 ('relsymlink dired-keep-marker-relsymlink)
3880 ('hardlink dired-keep-marker-hardlink)))
3881 (dirflag (and (= (length files) 1)
3882 (file-directory-p (car files))
3883 (not (file-directory-p candidate)))))
3884 (dired-create-files
3885 fn (symbol-name action) files
3886 ;; CANDIDATE is the destination.
3887 (if (file-directory-p candidate)
3888 ;; When CANDIDATE is a directory, build file-name in this directory.
3889 ;; Else we use CANDIDATE.
3890 #'(lambda (from)
3891 (expand-file-name (file-name-nondirectory from) candidate))
3892 #'(lambda (from) candidate))
3893 marker)
3894 (when (and follow (not (get-buffer dired-log-buffer)))
3895 (let ((moved-flist (anything-get-dest-fnames-from-list files candidate dirflag))
3896 (target (directory-file-name candidate)))
3897 (unwind-protect
3898 (progn
3899 (setq anything-ff-cand-to-mark moved-flist)
3900 (if (and dirflag (eq action 'rename))
3901 (anything-find-files1 (file-name-directory target) target)
3902 (anything-find-files1 (expand-file-name candidate))))
3903 (setq anything-ff-cand-to-mark nil))))))
3905 ;; Internal
3906 (defvar anything-ff-cand-to-mark nil)
3908 (defun anything-c-basename (fname)
3909 "Resolve basename of file or directory named FNAME."
3910 (file-name-nondirectory (directory-file-name fname)))
3912 (defun anything-get-dest-fnames-from-list (flist dest-cand rename-dir-flag)
3913 "Transform filenames of FLIST to abs of DEST-CAND."
3914 ;; At this point files have been renamed/copied at destination.
3915 ;; That's mean DEST-CAND exists.
3916 (loop
3917 with dest = (expand-file-name dest-cand)
3918 for src in flist
3919 for basename-src = (anything-c-basename src)
3920 for fname = (cond (rename-dir-flag (directory-file-name dest))
3921 ((file-directory-p dest)
3922 (concat (file-name-as-directory dest) basename-src))
3923 (t dest))
3924 when (file-exists-p fname)
3925 collect fname into tmp-list
3926 finally return (sort tmp-list 'string<)))
3928 (defun anything-c-maybe-mark-candidates ()
3929 "Mark all candidates of list `anything-ff-cand-to-mark'."
3930 (when (and (string= (assoc-default 'name (anything-get-current-source))
3931 (assoc-default 'name anything-c-source-find-files))
3932 anything-ff-cand-to-mark)
3933 (with-anything-window
3934 (while anything-ff-cand-to-mark
3935 (if (search-forward (car anything-ff-cand-to-mark) (point-at-eol) t)
3936 (progn
3937 (anything-mark-current-line)
3938 (anything-make-visible-mark)
3939 (forward-line 1)
3940 (setq anything-ff-cand-to-mark (cdr anything-ff-cand-to-mark)))
3941 (forward-line 1)))
3942 (unless (anything-this-visible-mark)
3943 (anything-prev-visible-mark)))))
3945 (add-hook 'anything-after-update-hook #'anything-c-maybe-mark-candidates)
3947 (defun* anything-dired-do-action-on-file (&key action)
3948 (let* ((files (dired-get-marked-files))
3949 (len (length files))
3950 (fname (if (> len 1)
3951 (format "* %d Files" len)
3952 (car files)))
3953 (source (case action
3954 ('copy 'anything-c-source-copy-files)
3955 ('rename 'anything-c-source-rename-files)
3956 ('symlink 'anything-c-source-symlink-files)
3957 ('hardlink 'anything-c-source-hardlink-files)))
3958 (prompt-fm (case action
3959 ('copy "Copy %s to: ")
3960 ('rename "Rename %s to: ")
3961 ('symlink "Symlink %s to: ")
3962 ('hardlink "Hardlink %s to: ")))
3963 (buffer (case action
3964 ('copy "*Anything Copy Files*")
3965 ('rename "*Anything Rename Files*")
3966 ('symlink "*Anything Symlink Files*")
3967 ('hardlink "*Anything Hardlink Files*")))
3968 (anything-mp-highlight-delay nil))
3969 (anything :sources source
3970 :input (or (dired-dwim-target-directory)
3971 (expand-file-name (anything-c-current-directory)))
3972 :preselect (dired-get-filename)
3973 :prompt (format prompt-fm fname)
3974 :keymap anything-c-read-file-map
3975 :buffer buffer)))
3977 ;;;###autoload
3978 (defun anything-dired-rename-file ()
3979 "Preconfigured `anything' to rename files from dired."
3980 (interactive)
3981 (anything-dired-do-action-on-file :action 'rename))
3983 ;;;###autoload
3984 (defun anything-dired-copy-file ()
3985 "Preconfigured `anything' to copy files from dired."
3986 (interactive)
3987 (anything-dired-do-action-on-file :action 'copy))
3989 ;;;###autoload
3990 (defun anything-dired-symlink-file ()
3991 "Preconfigured `anything' to symlink files from dired."
3992 (interactive)
3993 (anything-dired-do-action-on-file :action 'symlink))
3995 ;;;###autoload
3996 (defun anything-dired-hardlink-file ()
3997 "Preconfigured `anything' to hardlink files from dired."
3998 (interactive)
3999 (anything-dired-do-action-on-file :action 'hardlink))
4001 ;;;###autoload
4002 (define-minor-mode anything-dired-mode ()
4003 "Enable anything completion in Dired functions.
4004 Bindings affected are C, R, S, H."
4005 :group 'anything-config
4006 :global t
4007 (if anything-dired-mode
4008 (progn
4009 (substitute-key-definition
4010 'dired-do-copy 'anything-dired-copy-file dired-mode-map)
4011 (substitute-key-definition
4012 'dired-do-rename 'anything-dired-rename-file dired-mode-map)
4013 (substitute-key-definition
4014 'dired-do-symlink 'anything-dired-symlink-file dired-mode-map)
4015 (substitute-key-definition
4016 'dired-do-hardlink 'anything-dired-hardlink-file dired-mode-map))
4017 (substitute-key-definition
4018 'anything-dired-copy-file 'dired-do-copy dired-mode-map)
4019 (substitute-key-definition
4020 'anything-dired-rename-file 'dired-do-rename dired-mode-map)
4021 (substitute-key-definition
4022 'anything-dired-symlink-file 'dired-do-symlink dired-mode-map)
4023 (substitute-key-definition
4024 'anything-dired-hardlink-file 'dired-do-hardlink dired-mode-map)))
4026 (defalias 'anything-dired-bindings 'anything-dired-mode)
4028 (defvar anything-c-read-file-map
4029 (let ((map (copy-keymap anything-map)))
4030 (define-key map (kbd "C-.") 'anything-find-files-down-one-level)
4031 (define-key map (kbd "C-l") 'anything-find-files-down-one-level)
4032 (when anything-ff-lynx-style-map
4033 (define-key map (kbd "<left>") 'anything-find-files-down-one-level)
4034 (define-key map (kbd "<right>") 'anything-execute-persistent-action)
4035 (define-key map (kbd "<M-left>") 'anything-previous-source)
4036 (define-key map (kbd "<M-right>") 'anything-next-source))
4037 (delq nil map))
4038 "Keymap for `anything-c-read-file-name'.")
4040 (defun* anything-c-read-file-name (prompt
4041 &key
4042 (initial-input (expand-file-name default-directory))
4043 (buffer "*Anything Completions*")
4044 test
4045 (preselect nil)
4046 must-match
4047 (history nil)
4048 (marked-candidates nil)
4049 (alistp t)
4050 (persistent-action 'anything-find-files-persistent-action)
4051 (persistent-help "Hit1 Expand Candidate, Hit2 or (C-u) Find file"))
4052 "Anything `read-file-name' emulation.
4053 INITIAL-INPUT is a valid path, TEST is a predicate that take one arg."
4054 (when (get-buffer anything-action-buffer)
4055 (kill-buffer anything-action-buffer))
4056 (let* ((anything-mp-highlight-delay nil)
4057 (anything-ff-auto-update-initial-value
4058 (and anything-ff-auto-update-initial-value
4059 (file-exists-p initial-input)))
4060 (anything-ff-auto-update-flag
4061 anything-ff-auto-update-initial-value))
4062 (flet ((action-fn (candidate)
4063 (if marked-candidates
4064 (anything-marked-candidates)
4065 (identity candidate))))
4066 (or (anything
4067 :sources
4068 `(((name . ,(concat "Read File Name History" anything-c-find-files-doc-header))
4069 (disable-shortcuts)
4070 (candidates . (lambda ()
4071 (anything-comp-read-get-candidates history nil nil alistp)))
4072 (persistent-action . ,persistent-action)
4073 (persistent-help . ,persistent-help)
4074 (action . ,'action-fn))
4075 ((name . ,(concat "Read file name" anything-c-find-files-doc-header))
4076 ;; It is needed for filenames with capital letters
4077 (disable-shortcuts)
4078 (candidates . (lambda ()
4079 (let ((seq (anything-find-files-get-candidates)))
4080 (if test
4081 (loop
4082 for fname in seq when (funcall test fname)
4083 collect fname into ls
4084 finally return
4085 (if must-match ls
4086 (append (list anything-pattern) ls)))
4087 (if must-match (cdr seq) seq)))))
4088 (filtered-candidate-transformer anything-c-find-files-transformer)
4089 (persistent-action . ,persistent-action)
4090 (candidate-number-limit . 9999)
4091 (persistent-help . ,persistent-help)
4092 (volatile)
4093 (action . ,'action-fn)))
4094 :input initial-input
4095 :prompt prompt
4096 :keymap anything-c-read-file-map
4097 :resume 'noresume
4098 :buffer buffer
4099 :preselect preselect)
4100 (keyboard-quit)))))
4102 ;;; File Cache
4103 (defvar anything-c-file-cache-initialized-p nil)
4105 (defvar anything-c-file-cache-files nil)
4107 (defvar anything-c-source-file-cache
4108 '((name . "File Cache")
4109 (init
4110 . (lambda ()
4111 (require 'filecache nil t)
4112 (unless anything-c-file-cache-initialized-p
4113 (setq anything-c-file-cache-files
4114 (loop for item in file-cache-alist append
4115 (destructuring-bind (base &rest dirs) item
4116 (loop for dir in dirs collect
4117 (concat dir base)))))
4118 (defadvice file-cache-add-file (after file-cache-list activate)
4119 (add-to-list 'anything-c-file-cache-files (expand-file-name file)))
4120 (setq anything-c-file-cache-initialized-p t))))
4121 (candidates . anything-c-file-cache-files)
4122 (match anything-c-match-on-file-name
4123 anything-c-match-on-directory-name)
4124 (type . file)))
4125 ;; (anything 'anything-c-source-file-cache)
4127 ;;; Locate
4128 ;; NOTE for WINDOZE users:
4129 ;; You have to install Everything with his command line interface here:
4130 ;; http://www.voidtools.com/download.php
4132 (defvar anything-c-locate-command
4133 (case system-type
4134 ('gnu/linux "locate -i -r %s")
4135 ('berkeley-unix "locate -i %s")
4136 ('windows-nt "es -i -r %s")
4137 (t "locate %s"))
4138 "A list of arguments for locate program.
4139 The \"-r\" option must be the last option.")
4141 (defvar anything-locate-db-file-regexp "m?locate\.db$"
4142 "Default regexp to match locate database.
4143 If nil Search in all files.")
4145 (defun anything-locate-with-db (&optional db)
4146 "Run locate -d DB.
4147 If DB is not given or nil use locate without -d option.
4148 DB can be given as a string or list of db files.
4149 See also `anything-locate'."
4150 (when (and db (stringp db)) (setq db (list db)))
4151 (let ((anything-c-locate-command
4152 (if db
4153 (replace-regexp-in-string
4154 "locate"
4155 (format "locate -d %s"
4156 (mapconcat 'identity
4157 ;; Remove eventually marked directories by error.
4158 (loop for i in db unless
4159 (file-directory-p i) collect i) ":"))
4160 anything-c-locate-command)
4161 anything-c-locate-command)))
4162 (anything :sources 'anything-c-source-locate
4163 :buffer "*anything locate*"
4164 :keymap anything-generic-files-map)))
4165 ;; (anything-locate-with-db "~/locate.db")
4167 (defun anything-c-locate-init ()
4168 "Initialize async locate process for `anything-c-source-locate'."
4169 (setq mode-line-format
4170 '(" " mode-line-buffer-identification " "
4171 (line-number-mode "%l") " "
4172 (:eval (propertize "(Locate Process Running) "
4173 'face '((:foreground "red"))))))
4174 (prog1
4175 (start-process-shell-command "locate-process" nil
4176 (format anything-c-locate-command
4177 anything-pattern))
4178 (set-process-sentinel (get-process "locate-process")
4179 #'(lambda (process event)
4180 (when (string= event "finished\n")
4181 (with-anything-window
4182 (force-mode-line-update nil)
4183 (anything-update-move-first-line)))))))
4185 (defvar anything-c-source-locate
4186 '((name . "Locate")
4187 (candidates . anything-c-locate-init)
4188 (type . file)
4189 (properties-action . anything-ff-properties)
4190 (requires-pattern . 3)
4191 (mode-line . anything-generic-file-mode-line-string)
4192 (delayed))
4193 "Find files matching the current input pattern with locate.")
4194 ;; (anything 'anything-c-source-locate)
4196 (defvar anything-generic-file-mode-line-string
4197 "\\<anything-generic-files-map>\
4198 \\[anything-generic-file-help]:Help, \
4199 \\<anything-map>\
4200 \\[anything-select-action]:Acts,\
4201 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
4202 \\[anything-select-3rd-action]:NthAct,\
4203 \\[anything-send-bug-report-from-anything]:BugReport."
4204 "String displayed in mode-line in `anything-c-source-find-files'")
4206 (defun anything-generic-file-help ()
4207 (interactive)
4208 (let ((anything-help-message "== Anything Generic files Map ==\
4209 \nSpecific commands for anything locate and others files sources:
4210 \\<anything-generic-files-map>
4211 \\[anything-ff-run-grep]\t\t->Run grep (C-u recurse).
4212 \\[anything-ff-run-pdfgrep]\t\t->Run Pdfgrep on marked files.
4213 \\[anything-ff-run-delete-file]\t\t->Delete file.
4214 \\[anything-ff-run-switch-other-window]\t\t->Switch other window.
4215 \\[anything-ff-properties-persistent]\t\t->Show file properties.
4216 \\[anything-yank-text-at-point]\t\t->Yank text at point.
4217 \\[anything-ff-run-open-file-externally]\t\t->Open file with external program (C-u to choose).
4218 \nLocate tips:
4219 You can add after writing search pattern any of the locate command line options.
4220 e.g -b, -e, -n <number>...etc.
4221 See Man locate for more infos.
4222 \n== Anything Map ==
4223 \\{anything-map}"))
4224 (anything-help)))
4226 (defvar anything-generic-files-map
4227 (let ((map (copy-keymap anything-map)))
4228 (define-key map (kbd "M-g s") 'anything-ff-run-grep)
4229 (define-key map (kbd "M-g p") 'anything-ff-run-pdfgrep)
4230 (define-key map (kbd "M-D") 'anything-ff-run-delete-file)
4231 (define-key map (kbd "C-o") 'anything-ff-run-switch-other-window)
4232 (define-key map (kbd "M-i") 'anything-ff-properties-persistent)
4233 (define-key map (kbd "C-c C-x") 'anything-ff-run-open-file-externally)
4234 (define-key map (kbd "C-w") 'anything-yank-text-at-point)
4235 (define-key map (kbd "C-c ?") 'anything-generic-file-help)
4236 map)
4237 "Generic Keymap for files.")
4239 ;;; Anything Incremental Grep.
4240 ;; This allow to grep incrementally with anything interface.
4241 ;; It allow also to Grep files recursively without using 'find' shell command.
4242 ;; On Windows you will need at least Grep version 2.5.4 of Gnuwin32.
4245 (defvar anything-c-grep-default-command
4246 "grep -d skip %e -niH -e %p %f"
4247 "Default grep format command for `anything-do-grep1'.
4248 Where:
4249 '%e' format spec is for --exclude or --include grep options.
4250 '%p' format spec is for pattern.
4251 '%f' format spec is for filenames.")
4253 (defvar anything-c-grep-default-recurse-command
4254 "grep -d recurse %e -niH -e %p %f"
4255 "Default recursive grep format command for `anything-do-grep1'.
4256 See `anything-c-grep-default-command' for format specs.")
4258 (defvar anything-c-default-zgrep-command "zgrep -niH -e %p %f")
4260 (defvar anything-c-rzgrep-cache (make-hash-table :test 'equal))
4262 (defvar anything-c-grep-default-function 'anything-c-grep-init)
4264 (defvar anything-c-grep-debug-command-line nil
4265 "Turn on anything grep command-line debugging when non--nil.")
4267 (defvar anything-c-zgrep-recurse-flag nil)
4269 (defvar anything-grep-mode-line-string
4270 "\\<anything-c-grep-map>\
4271 \\[anything-grep-help]:Help,\
4272 \\<anything-map>\
4273 \\[anything-select-action]:Acts,\
4274 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
4275 \\[anything-select-3rd-action]:NthAct,\
4276 \\[anything-send-bug-report-from-anything]:BugReport."
4277 "String displayed in mode-line in `anything-do-grep'.")
4278 (defvar anything-c-grep-history nil)
4280 (defvar anything-c-grep-max-length-history 100
4281 "*Max number of elements to save in `anything-c-grep-history'.")
4283 (defface anything-grep-match
4284 '((t (:inherit match)))
4285 "Face used to highlight grep matches."
4286 :group 'anything-config)
4288 (defface anything-grep-file
4289 '((t (:foreground "BlueViolet" :underline t)))
4290 "Face used to highlight grep results filenames."
4291 :group 'anything-config)
4293 (defface anything-grep-lineno
4294 '((t (:foreground "Darkorange1")))
4295 "Face used to highlight grep number lines."
4296 :group 'anything-config)
4298 (defface anything-grep-running
4299 '((t (:foreground "Red")))
4300 "Face used in mode line when grep is running."
4301 :group 'anything-config)
4303 (defface anything-grep-finish
4304 '((t (:foreground "Green")))
4305 "Face used in mode line when grep is finish."
4306 :group 'anything-config)
4308 (defun anything-c-grep-prepare-candidates (candidates)
4309 "Prepare filenames and directories CANDIDATES for grep command line."
4310 ;; If one or more candidate is a directory, search in all files
4311 ;; of this candidate (e.g /home/user/directory/*).
4312 ;; If r option is enabled search also in subdidrectories.
4313 ;; We need here to expand wildcards to support crap windows filenames
4314 ;; as grep don't accept quoted wildcards (e.g "dir/*.el").
4315 (if anything-c-zgrep-recurse-flag
4316 (mapconcat 'shell-quote-argument candidates " ")
4317 (loop for i in candidates append
4318 (cond ( ;; Candidate is a directory and we use recursion.
4319 (and (file-directory-p i)
4320 (anything-c-grep-recurse-p))
4321 (list (expand-file-name i)))
4322 ;; Candidate is a directory, search in all files.
4323 ((file-directory-p i)
4324 (file-expand-wildcards
4325 (concat (file-name-as-directory (expand-file-name i)) "*") t))
4326 ;; Candidate is a file or wildcard and we use recursion, use the
4327 ;; current directory instead of candidate.
4328 ((and (or (file-exists-p i) (string-match "\*" i))
4329 (anything-c-grep-recurse-p))
4330 (list (directory-file-name ; Needed for windoze.
4331 (file-name-directory (directory-file-name i)))))
4332 ;; Candidate use wildcard.
4333 ((string-match "^\*" (anything-c-basename i))
4334 (file-expand-wildcards i t))
4335 ;; Else should be one or more file.
4336 (t (list i))) into all-files
4337 finally return
4338 (mapconcat 'shell-quote-argument all-files " "))))
4340 (defun anything-c-grep-recurse-p ()
4341 "Check if `anything-do-grep1' have switched to recursive."
4342 (let ((args (replace-regexp-in-string
4343 "grep" "" anything-c-grep-default-command)))
4344 (string-match-p "r\\|recurse" args)))
4346 (defun anything-c-grep-init (only-files &optional include zgrep)
4347 "Start an asynchronous grep process in ONLY-FILES list."
4348 (let* ((fnargs (anything-c-grep-prepare-candidates
4349 (if (file-remote-p anything-ff-default-directory)
4350 (mapcar #'(lambda (x)
4351 (file-remote-p x 'localname))
4352 only-files)
4353 only-files)))
4354 (ignored-files (mapconcat
4355 #'(lambda (x)
4356 (concat "--exclude=" (shell-quote-argument x)))
4357 grep-find-ignored-files " "))
4358 (ignored-dirs (mapconcat
4359 ;; Need grep version 2.5.4 of Gnuwin32 on windoze.
4360 #'(lambda (x)
4361 (concat "--exclude-dir=" (shell-quote-argument x)))
4362 grep-find-ignored-directories " "))
4363 (exclude (if (anything-c-grep-recurse-p)
4364 (concat (or include ignored-files) " " ignored-dirs)
4365 ignored-files))
4366 (cmd-line (format-spec
4367 anything-c-grep-default-command
4368 (delq nil
4369 (list (unless zgrep (cons ?e exclude))
4370 (cons ?p (shell-quote-argument anything-pattern))
4371 (cons ?f fnargs))))))
4372 (when anything-c-grep-debug-command-line
4373 (with-current-buffer (get-buffer-create "*any grep debug*")
4374 (goto-char (point-max))
4375 (insert (concat ">>> " cmd-line "\n\n"))))
4376 (setq mode-line-format
4377 '(" " mode-line-buffer-identification " "
4378 (line-number-mode "%l") " "
4379 (:eval (when (get-process "grep-process")
4380 (propertize "[Grep Process Running] "
4381 'face 'anything-grep-running)))))
4382 (force-mode-line-update nil)
4383 (prog1
4384 (let ((default-directory anything-ff-default-directory))
4385 (start-file-process-shell-command "grep-process" nil cmd-line))
4386 (message nil)
4387 (set-process-sentinel
4388 (get-process "grep-process")
4389 #'(lambda (process event)
4390 (when (string= event "finished\n")
4391 (with-anything-window
4392 (anything-update-move-first-line)
4393 (setq mode-line-format
4394 '(" " mode-line-buffer-identification " "
4395 (line-number-mode "%l") " "
4396 (:eval (propertize
4397 (format "[Grep Process Finished - (%s results)] "
4398 (let ((nlines (1- (count-lines
4399 (point-min)
4400 (point-max)))))
4401 (if (> nlines 0) nlines 0)))
4402 'face 'anything-grep-finish))))
4403 (force-mode-line-update nil))))))))
4405 (defun anything-c-grep-action (candidate &optional where mark)
4406 "Define a default action for `anything-do-grep' on CANDIDATE.
4407 WHERE can be one of other-window, elscreen, other-frame."
4408 (let* ((split (anything-c-grep-split-line candidate))
4409 (lineno (string-to-number (nth 1 split)))
4410 (loc-fname (car split))
4411 (tramp-method (file-remote-p anything-ff-default-directory 'method))
4412 (tramp-host (file-remote-p anything-ff-default-directory 'host))
4413 (tramp-prefix (concat "/" tramp-method ":" tramp-host ":"))
4414 (fname (if tramp-host
4415 (concat tramp-prefix loc-fname) loc-fname)))
4416 (case where
4417 (other-window (find-file-other-window fname))
4418 (elscreen (anything-elscreen-find-file fname))
4419 (other-frame (find-file-other-frame fname))
4420 (t (find-file fname)))
4421 (anything-goto-line lineno)
4422 (when mark
4423 (set-marker (mark-marker) (point))
4424 (push-mark (point) 'nomsg))
4425 ;; Save history
4426 (unless (or anything-in-persistent-action
4427 (string= anything-pattern ""))
4428 (setq anything-c-grep-history
4429 (cons anything-pattern
4430 (delete anything-pattern anything-c-grep-history)))
4431 (when (> (length anything-c-grep-history)
4432 anything-c-grep-max-length-history)
4433 (setq anything-c-grep-history
4434 (delete (car (last anything-c-grep-history))
4435 anything-c-grep-history))))))
4437 (defun anything-c-grep-other-window (candidate)
4438 "Jump to result in other window from anything grep."
4439 (anything-c-grep-action candidate 'other-window))
4441 (defun anything-c-grep-other-frame (candidate)
4442 "Jump to result in other frame from anything grep."
4443 (anything-c-grep-action candidate 'other-frame))
4445 (defun anything-c-grep-jump-elscreen (candidate)
4446 "Jump to result in elscreen from anything grep."
4447 (anything-c-grep-action candidate 'elscreen))
4449 (defun anything-c-grep-save-results (candidate)
4450 "Save anything grep result in a `grep-mode' buffer."
4451 (let ((buf "*grep*")
4452 new-buf)
4453 (when (get-buffer buf)
4454 (setq new-buf (read-string "GrepBufferName: " buf))
4455 (loop for b in (anything-c-buffer-list)
4456 when (and (string= new-buf b)
4457 (not (y-or-n-p
4458 (format "Buffer `%s' already exists overwrite? "
4459 new-buf))))
4460 do (setq new-buf (read-string "GrepBufferName: " "*grep ")))
4461 (setq buf new-buf))
4462 (with-current-buffer (get-buffer-create buf)
4463 (let ((inhibit-read-only t))
4464 (erase-buffer)
4465 (insert "-*- mode: grep -*-\n\n"
4466 (format "Grep Results for `%s':\n\n" anything-pattern))
4467 (save-excursion
4468 (insert (with-current-buffer anything-buffer
4469 (forward-line 1)
4470 (buffer-substring (point) (point-max))))
4471 (grep-mode))))
4472 (message "Anything Grep Results saved in `%s' buffer" buf)))
4474 (defun anything-c-grep-persistent-action (candidate)
4475 "Persistent action for `anything-do-grep'.
4476 With a prefix arg record CANDIDATE in `mark-ring'."
4477 (if current-prefix-arg
4478 (anything-c-grep-action candidate nil 'mark)
4479 (anything-c-grep-action candidate))
4480 (anything-match-line-color-current-line))
4482 (defun anything-c-grep-guess-extensions (files)
4483 "Try to guess file extensions in FILES list when using grep recurse.
4484 These extensions will be added to command line with --include arg of grep."
4485 (loop
4486 with glob-list = nil
4487 with lst = (if (file-directory-p (car files))
4488 (directory-files
4489 (car files) nil
4490 directory-files-no-dot-files-regexp)
4491 files)
4492 for i in lst
4493 for ext = (file-name-extension i t)
4494 for glob = (and ext (not (string= ext ""))
4495 (concat "*" ext))
4496 unless (or (not glob)
4497 (member glob glob-list)
4498 (member glob grep-find-ignored-files))
4499 collect glob into glob-list
4500 finally return glob-list))
4502 (defun anything-do-grep1 (only &optional recurse zgrep)
4503 "Launch grep with a list of ONLY files.
4504 When RECURSE is given use -r option of grep and prompt user
4505 to set the --include args of grep.
4506 You can give more than one arg separated by space.
4507 e.g *.el *.py *.tex.
4508 If it's empty --exclude `grep-find-ignored-files' is used instead."
4509 (let* ((anything-compile-source-functions
4510 ;; rule out anything-match-plugin because the input is one regexp.
4511 (delq 'anything-compile-source--match-plugin
4512 (copy-sequence anything-compile-source-functions)))
4513 (exts (anything-c-grep-guess-extensions only))
4514 (globs (and (not zgrep) (mapconcat 'identity exts " ")))
4515 (include-files (and recurse (not zgrep)
4516 (read-string "OnlyExt(*.[ext]): "
4517 globs)))
4518 ;; Set `minibuffer-history' AFTER includes-files
4519 ;; to avoid storing wild-cards here.
4520 (minibuffer-history anything-c-grep-history)
4521 (anything-c-grep-default-command (cond ((and recurse zgrep) anything-c-default-zgrep-command)
4522 (recurse anything-c-grep-default-recurse-command)
4523 (zgrep anything-c-default-zgrep-command)
4524 (t anything-c-grep-default-command)))
4525 ;; Disable match-plugin and use here own highlighting.
4526 (anything-mp-highlight-delay nil))
4527 (when include-files
4528 (setq include-files
4529 (and (not (string= include-files ""))
4530 (mapconcat #'(lambda (x)
4531 (concat "--include=" (shell-quote-argument x)))
4532 (split-string include-files) " "))))
4533 ;; When called as action from an other source e.g *-find-files
4534 ;; we have to kill action buffer.
4535 (when (get-buffer anything-action-buffer)
4536 (kill-buffer anything-action-buffer))
4537 ;; `anything-find-files' haven't already started,
4538 ;; give a default value to `anything-ff-default-directory'.
4539 (setq anything-ff-default-directory (or anything-ff-default-directory
4540 default-directory))
4541 (anything
4542 :sources
4543 `(((name . "Grep (C-c ? Help)")
4544 (candidates
4545 . (lambda ()
4546 (funcall anything-c-grep-default-function only include-files zgrep)))
4547 (filtered-candidate-transformer anything-c-grep-cand-transformer)
4548 (candidate-number-limit . 9999)
4549 (mode-line . anything-grep-mode-line-string)
4550 (jump-persistent . anything-c-grep-persistent-action)
4551 (action . ,(delq
4553 `(("Find File" . anything-c-grep-action)
4554 ("Find file other frame" . anything-c-grep-other-frame)
4555 ,(and (locate-library "elscreen")
4556 '("Find file in Elscreen"
4557 . anything-c-grep-jump-elscreen))
4558 ("Save results in grep buffer" . anything-c-grep-save-results)
4559 ("Find file other window" . anything-c-grep-other-window))))
4560 (persistent-action . anything-c-grep-persistent-action)
4561 (persistent-help . "Jump to line (`C-u' Record in mark ring)")
4562 (requires-pattern . 3)
4563 (delayed)))
4564 :keymap anything-c-grep-map
4565 :buffer "*anything grep*")))
4567 ;;;###autoload
4568 (defun anything-do-grep ()
4569 "Preconfigured anything for grep.
4570 Contrarily to Emacs `grep' no default directory is given, but
4571 the full path of candidates in ONLY.
4572 That allow to grep different files not only in `default-directory' but anywhere
4573 by marking them (C-<SPACE>). If one or more directory is selected
4574 grep will search in all files of these directories.
4575 You can use also wildcard in the base name of candidate.
4576 If a prefix arg is given use the -r option of grep.
4577 The prefix arg can be passed before or after start.
4578 See also `anything-do-grep1'."
4579 (interactive)
4580 (let ((only (anything-c-read-file-name
4581 "Search in file(s): "
4582 :marked-candidates t
4583 :preselect (or (dired-get-filename nil t)
4584 (buffer-file-name (current-buffer)))))
4585 (prefarg (or current-prefix-arg anything-current-prefix-arg)))
4586 (anything-do-grep1 only prefarg)))
4588 (defmacro* anything-c-walk-directory (directory &key (path 'basename) (directories t) match)
4589 "Walk through DIRECTORY tree.
4590 PATH can be one of basename, relative, or full.
4591 DIRECTORIES when non--nil (default) return also directories names, otherwise
4592 skip directories names.
4593 MATCH match only filenames matching regexp MATCH."
4594 `(let (result
4595 (fn (case ,path
4596 (basename 'file-name-nondirectory)
4597 (relative 'file-relative-name)
4598 (full 'identity)
4599 (t (error "Error: Invalid path spec `%s', must be one of basename, relative or full." ,path)))))
4600 (labels ((ls-R (dir)
4601 (loop with ls = (directory-files dir t directory-files-no-dot-files-regexp)
4602 for f in ls
4603 if (file-directory-p f)
4604 do (progn (when ,directories
4605 (push (funcall fn f) result))
4606 ;; Don't recurse in directory symlink.
4607 (unless (file-symlink-p f)
4608 (ls-R f)))
4609 else do
4610 (unless (and ,match (not (string-match ,match (file-name-nondirectory f))))
4611 (push (funcall fn f) result)))))
4612 (ls-R ,directory)
4613 (nreverse result))))
4615 (defun anything-ff-zgrep-1 (flist recursive)
4616 (unwind-protect
4617 (let* ((def-dir (or anything-ff-default-directory
4618 default-directory))
4619 (only (if recursive
4620 (or (gethash def-dir anything-c-rzgrep-cache)
4621 (puthash
4622 def-dir
4623 (anything-c-walk-directory
4624 def-dir
4625 :directories nil
4626 :path 'full
4627 :match ".*\\(\.gz\\|\.bz\\|\.xz\\|\.lzma\\)$")
4628 anything-c-rzgrep-cache))
4629 flist)))
4630 (when recursive (setq anything-c-zgrep-recurse-flag t))
4631 (anything-do-grep1 only recursive 'zgrep))
4632 (setq anything-c-zgrep-recurse-flag nil)))
4634 ;;;###autoload
4635 (defun anything-do-zgrep (candidate)
4636 "Preconfigured anything for zgrep."
4637 (let ((prefarg (or current-prefix-arg anything-current-prefix-arg))
4638 (ls (anything-c-read-file-name
4639 "Search in file(s): "
4640 :marked-candidates t
4641 :preselect (or (dired-get-filename nil t)
4642 (buffer-file-name (current-buffer))))))
4643 (anything-ff-zgrep-1 ls prefarg)))
4645 (defun anything-c-grep-split-line (line)
4646 "Split a grep output line."
4647 (let (beg fname lineno str)
4648 ;; Don't print until grep line is valid.
4649 (when (string-match "\\(.*\\)\\(:[0-9]+:\\)\\(.*\\)" line)
4650 (with-temp-buffer
4651 (insert line)
4652 (goto-char (point-min))
4653 (setq beg (point))
4654 (forward-char 2)
4655 (re-search-forward ":" nil t)
4656 (setq fname (buffer-substring-no-properties beg (1- (point))))
4657 (setq beg (point))
4658 (re-search-forward ":" nil t)
4659 (setq lineno (buffer-substring-no-properties beg (1- (point))))
4660 (setq str (buffer-substring-no-properties (point) (point-at-eol))))
4661 (list fname lineno str))))
4663 (defun anything-c-grep-cand-transformer (candidates sources)
4664 "Filtered candidate transformer function for `anything-do-grep'."
4665 (loop for i in candidates
4666 for split = (and i (anything-c-grep-split-line i))
4667 for fname = (car split)
4668 for lineno = (nth 1 split)
4669 for str = (nth 2 split)
4670 when (and fname lineno str)
4671 collect
4672 (cons (concat (propertize (file-name-nondirectory fname)
4673 'face 'anything-grep-file
4674 'help-echo fname) ":"
4675 (propertize lineno 'face 'anything-grep-lineno) ":"
4676 (anything-c-grep-highlight-match str))
4677 i)))
4679 (defun anything-c-grep-highlight-match (str)
4680 "Highlight in string STR all occurences matching `anything-pattern'."
4681 (condition-case nil
4682 (with-temp-buffer
4683 (insert str)
4684 (goto-char (point-min))
4685 (while (and (re-search-forward anything-pattern nil t)
4686 (> (- (match-end 0) (match-beginning 0)) 0))
4687 (add-text-properties
4688 (match-beginning 0) (match-end 0)
4689 '(face anything-grep-match)))
4690 (buffer-string))
4691 (error nil)))
4693 ;; Go to next or precedent file (common to etags and grep).
4694 (defun anything-c-goto-next-or-prec-file (n)
4695 "Go to next or precedent candidate file in anything grep/etags buffers.
4696 If N is positive go forward otherwise go backward."
4697 (with-anything-window
4698 (let* ((current-line-list (split-string
4699 (buffer-substring
4700 (point-at-bol)
4701 (point-at-eol)) ":"))
4702 (current-fname (nth 0 current-line-list))
4703 (fn-b-o-f (if (eq n 1) 'eobp 'bobp)))
4704 (catch 'break
4705 (while (not (funcall fn-b-o-f))
4706 (forward-line n) ; Go forward or backward depending of n value.
4707 (unless (search-forward current-fname (point-at-eol) t)
4708 (anything-mark-current-line)
4709 (throw 'break nil))))
4710 (cond ((and (eq n 1) (eobp))
4711 (re-search-backward ".")
4712 (forward-line 0)
4713 (anything-mark-current-line))
4714 ((and (< n 1) (bobp))
4715 (forward-line 1)
4716 (anything-mark-current-line))))))
4718 ;;;###autoload
4719 (defun anything-c-goto-precedent-file ()
4720 "Go to precedent file in anything grep/etags buffers."
4721 (interactive)
4722 (anything-c-goto-next-or-prec-file -1))
4724 ;;;###autoload
4725 (defun anything-c-goto-next-file ()
4726 "Go to precedent file in anything grep/etags buffers."
4727 (interactive)
4728 (anything-c-goto-next-or-prec-file 1))
4730 ;;;###autoload
4731 (defun anything-grep-help ()
4732 (interactive)
4733 (let ((anything-help-message "== Anything Grep Map ==\
4734 \nSpecific commands for Grep and Etags:
4735 \\<anything-c-grep-map>
4736 \\[anything-c-goto-next-file]\t->Next File.
4737 \\[anything-c-goto-precedent-file]\t\t->Precedent File.
4738 \\[anything-yank-text-at-point]\t\t->Yank Text at point in minibuffer.
4739 \\[anything-c-grep-run-other-window-action]\t\t->Jump other window.
4740 \\[anything-c-grep-run-persistent-action]\t\t->Run persistent action (Same as `C-z').
4741 \\[anything-c-grep-run-default-action]\t\t->Run default action (Same as RET).
4742 \\[anything-grep-help]\t\t->Show this help.
4743 \n== Anything Map ==
4744 \\{anything-map}"))
4745 (anything-help)))
4747 (defvar anything-c-grep-map
4748 (let ((map (copy-keymap anything-map)))
4749 (define-key map (kbd "M-<down>") 'anything-c-goto-next-file)
4750 (define-key map (kbd "M-<up>") 'anything-c-goto-precedent-file)
4751 (define-key map (kbd "C-o") 'anything-c-grep-run-other-window-action)
4752 (define-key map (kbd "C-w") 'anything-yank-text-at-point)
4753 (define-key map (kbd "C-x C-s") 'anything-c-grep-run-save-buffer)
4754 (when anything-c-grep-use-ioccur-style-keys
4755 (define-key map (kbd "<right>") 'anything-c-grep-run-persistent-action)
4756 (define-key map (kbd "<left>") 'anything-c-grep-run-default-action))
4757 (define-key map (kbd "C-c ?") 'anything-grep-help)
4758 (delq nil map))
4759 "Keymap used in Grep sources.")
4761 (defun anything-c-grep-run-persistent-action ()
4762 "Run grep persistent action from `anything-do-grep1'."
4763 (interactive)
4764 (anything-execute-persistent-action 'jump-persistent))
4766 (defun anything-c-grep-run-default-action ()
4767 "Run grep default action from `anything-do-grep1'."
4768 (interactive)
4769 (anything-c-quit-and-execute-action 'anything-c-grep-action))
4771 (defun anything-c-grep-run-other-window-action ()
4772 "Run grep goto other window action from `anything-do-grep1'."
4773 (interactive)
4774 (anything-c-quit-and-execute-action 'anything-c-grep-other-window))
4776 (defun anything-c-grep-run-save-buffer ()
4777 "Run grep save results action from `anything-do-grep1'."
4778 (interactive)
4779 (anything-c-quit-and-execute-action 'anything-c-grep-save-results))
4781 ;; Grep buffers
4782 (defun anything-c-grep-buffers-1 (candidate &optional zgrep)
4783 "Run grep on all file--buffers or CANDIDATE if it is a file--buffer.
4784 If one of selected buffers is not a file--buffer,
4785 it is ignored and grep will run on all others file--buffers.
4786 If only one candidate is selected and it is not a file--buffer,
4787 switch to this buffer and run `anything-occur'.
4788 If a prefix arg is given run grep on all buffers ignoring non--file-buffers."
4789 (let* ((prefarg (or current-prefix-arg anything-current-prefix-arg))
4790 (cands (if prefarg
4791 (buffer-list)
4792 (anything-marked-candidates)))
4793 (bufs (loop for buf in cands
4794 for fname = (buffer-file-name (get-buffer buf))
4795 when fname
4796 collect (expand-file-name fname))))
4797 (if bufs
4798 (if zgrep
4799 (anything-do-grep1 bufs nil 'zgrep)
4800 (anything-do-grep1 bufs))
4801 ;; bufs is empty, thats mean we have only CANDIDATE
4802 ;; and it is not a buffer-filename, fallback to occur.
4803 (anything-c-switch-to-buffer candidate)
4804 (when (get-buffer anything-action-buffer)
4805 (kill-buffer anything-action-buffer))
4806 (anything-occur))))
4808 (defun anything-c-grep-buffers (candidate)
4809 "Action to grep buffers."
4810 (anything-c-grep-buffers-1 candidate))
4812 (defun anything-c-zgrep-buffers (candidate)
4813 "Action to zgrep buffers."
4814 (anything-c-grep-buffers-1 candidate 'zgrep))
4816 ;;; Anything interface for pdfgrep
4817 ;; pdfgrep program <http://pdfgrep.sourceforge.net/>
4818 ;; and a pdf-reader (e.g xpdf) are needed.
4820 (defvar anything-c-pdfgrep-default-command "pdfgrep --color never -niH %s %s")
4821 (defvar anything-c-pdfgrep-default-function 'anything-c-pdfgrep-init)
4822 (defvar anything-c-pdfgrep-debug-command-line nil)
4824 (defun anything-c-pdfgrep-init (only-files)
4825 "Start an asynchronous pdfgrep process in ONLY-FILES list."
4826 (let* ((fnargs (anything-c-grep-prepare-candidates
4827 (if (file-remote-p anything-ff-default-directory)
4828 (mapcar #'(lambda (x)
4829 (file-remote-p x 'localname))
4830 only-files)
4831 only-files)))
4832 (cmd-line (format anything-c-pdfgrep-default-command
4833 anything-pattern
4834 fnargs)))
4835 (when anything-c-pdfgrep-debug-command-line
4836 (with-current-buffer (get-buffer-create "*any pdfgrep debug*")
4837 (goto-char (point-max))
4838 (insert (concat ">>> " cmd-line "\n\n"))))
4839 (setq mode-line-format
4840 '(" " mode-line-buffer-identification " "
4841 (line-number-mode "%l") " "
4842 (:eval (propertize "(Pdfgrep Process Running) "
4843 'face '((:foreground "red"))))))
4844 (prog1
4845 (let ((default-directory anything-ff-default-directory))
4846 (start-file-process-shell-command "pdfgrep-process" nil cmd-line))
4847 (message nil)
4848 (set-process-sentinel
4849 (get-process "pdfgrep-process")
4850 #'(lambda (process event)
4851 (when (string= event "finished\n")
4852 (with-anything-window
4853 (anything-update-move-first-line))
4854 (force-mode-line-update nil)))))))
4857 (defun anything-do-pdfgrep-1 (only)
4858 "Launch pdfgrep with a list of ONLY files."
4859 (unless (executable-find "pdfgrep")
4860 (error "Error: No such program `pdfgrep'."))
4861 (let* ((anything-compile-source-functions
4862 ;; rule out anything-match-plugin because the input is one regexp.
4863 (delq 'anything-compile-source--match-plugin
4864 (copy-sequence anything-compile-source-functions)))
4865 ;; Disable match-plugin and use here own highlighting.
4866 (anything-mp-highlight-delay nil))
4867 ;; When called as action from an other source e.g *-find-files
4868 ;; we have to kill action buffer.
4869 (when (get-buffer anything-action-buffer)
4870 (kill-buffer anything-action-buffer))
4871 ;; If `anything-find-files' haven't already started,
4872 ;; give a default value to `anything-ff-default-directory'.
4873 (setq anything-ff-default-directory (or anything-ff-default-directory
4874 default-directory))
4875 (anything
4876 :sources
4877 `(((name . "PdfGrep")
4878 (candidates
4879 . (lambda ()
4880 (funcall anything-c-pdfgrep-default-function only)))
4881 (filtered-candidate-transformer anything-c-grep-cand-transformer)
4882 (candidate-number-limit . 9999)
4883 (mode-line . anything-pdfgrep-mode-line-string)
4884 (action . anything-c-pdfgrep-action)
4885 (persistent-help . "Jump to PDF Page")
4886 (requires-pattern . 3)
4887 (delayed)))
4888 :keymap anything-c-pdfgrep-map
4889 :buffer "*anything grep*")))
4891 (defvar anything-pdfgrep-mode-line-string
4892 "\\<anything-c-pdfgrep-map>\
4893 \\[anything-pdfgrep-help]:Help,\
4894 \\<anything-map>\
4895 \\[anything-select-action]:Acts,\
4896 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
4897 \\[anything-select-3rd-action]:NthAct,\
4898 \\[anything-send-bug-report-from-anything]:BugReport."
4899 "String displayed in mode-line in `anything-do-pdfgrep'.")
4901 ;;;###autoload
4902 (defun anything-pdfgrep-help ()
4903 (interactive)
4904 (let ((anything-help-message "== Anything PdfGrep Map ==\
4905 \nSpecific commands for Pdf Grep:
4906 \\<anything-c-pdfgrep-map>
4907 \\[anything-c-goto-next-file]\t->Next File.
4908 \\[anything-c-goto-precedent-file]\t\t->Precedent File.
4909 \\[anything-yank-text-at-point]\t\t->Yank Text at point in minibuffer.
4910 \\[anything-pdfgrep-help]\t\t->Show this help.
4911 \n== Anything Map ==
4912 \\{anything-map}"))
4913 (anything-help)))
4915 (defvar anything-c-pdfgrep-map
4916 (let ((map (copy-keymap anything-map)))
4917 (define-key map (kbd "M-<down>") 'anything-c-goto-next-file)
4918 (define-key map (kbd "M-<up>") 'anything-c-goto-precedent-file)
4919 (define-key map (kbd "C-w") 'anything-yank-text-at-point)
4920 (define-key map (kbd "C-c ?") 'anything-pdfgrep-help)
4921 map)
4922 "Keymap used in pdfgrep.")
4924 (defun anything-c-pdfgrep-action (candidate)
4925 (let* ((split (anything-c-grep-split-line candidate))
4926 (pageno (nth 1 split))
4927 (fname (car split)))
4928 (start-file-process-shell-command
4929 "pdf-reader" nil
4930 (format-spec anything-c-pdfgrep-default-read-command
4931 (list (cons ?f fname) (cons ?p pageno))))))
4933 (defun anything-do-pdfgrep ()
4934 (interactive)
4935 (let ((only (anything-c-read-file-name
4936 "Search in file(s): "
4937 :marked-candidates t
4938 :test #'(lambda (file)
4939 (or (string= (file-name-extension file) "pdf")
4940 (string= (file-name-extension file) "PDF")
4941 (file-directory-p file)))
4942 :preselect (or (dired-get-filename nil t)
4943 (buffer-file-name (current-buffer)))))
4944 (anything-c-grep-default-function 'anything-c-pdfgrep-init))
4945 (anything-do-pdfgrep-1 only)))
4948 ;; Yank text at point.
4951 ;; Internal
4952 (defvar anything-yank-point nil)
4954 ;;;###autoload
4955 (defun anything-yank-text-at-point ()
4956 "Yank text at point in minibuffer."
4957 (interactive)
4958 (let (input)
4959 (flet ((insert-in-minibuffer (word)
4960 (with-selected-window (minibuffer-window)
4961 (let ((str anything-pattern))
4962 (delete-minibuffer-contents)
4963 (set-text-properties 0 (length word) nil word)
4964 (insert (concat str word))))))
4965 (with-current-buffer anything-current-buffer
4966 ;; Start to initial point if C-w have never been hit.
4967 (unless anything-yank-point (setq anything-yank-point (point)))
4968 (and anything-yank-point (goto-char anything-yank-point))
4969 (forward-word 1)
4970 (setq input (buffer-substring-no-properties anything-yank-point (point)))
4971 (setq anything-yank-point (point))) ; End of last forward-word
4972 (insert-in-minibuffer input))))
4974 (defun anything-reset-yank-point ()
4975 (setq anything-yank-point nil))
4977 (add-hook 'anything-after-persistent-action-hook 'anything-reset-yank-point)
4978 (add-hook 'anything-cleanup-hook 'anything-reset-yank-point)
4979 (define-key anything-map (kbd "C-w") 'anything-yank-text-at-point)
4981 ;;; Etags
4984 ;; anything-etags.el is deprecated, if this file is found,
4985 ;; warn user at compile time.
4986 (eval-when-compile
4987 (when (locate-library "anything-etags.el")
4988 (display-warning
4989 '(anything-config)
4990 "You are using obsolete library `anything-etags.el' and should remove it."
4991 :warning)))
4993 ;;;###autoload
4994 (defun anything-etags-help ()
4995 "The help function for etags."
4996 (interactive)
4997 (let ((anything-help-message "== Anything Etags Map ==\
4998 \nSpecific commands for Etags:
4999 \\<anything-c-etags-map>
5000 \\[anything-c-goto-next-file]\t->Next File.
5001 \\[anything-c-goto-precedent-file]\t\t->Precedent File.
5002 \\[anything-yank-text-at-point]\t\t->Yank Text at point in minibuffer.
5003 \\[anything-etags-help]\t\t->Show this help.
5004 \n== Anything Map ==
5005 \\{anything-map}"))
5006 (anything-help)))
5008 (defvar anything-c-etags-map
5009 (let ((map (copy-keymap anything-map)))
5010 (define-key map (kbd "M-<down>") 'anything-c-goto-next-file)
5011 (define-key map (kbd "M-<up>") 'anything-c-goto-precedent-file)
5012 (define-key map (kbd "C-w") 'anything-yank-text-at-point)
5013 (define-key map (kbd "C-c ?") 'anything-etags-help)
5014 map)
5015 "Keymap used in Etags.")
5017 (defvar anything-c-etags-tag-file-dir nil
5018 "Etags file directory.")
5019 (defvar anything-c-etags-mtime-alist nil
5020 "Store the last modification time of etags files here.")
5021 (defvar anything-c-etags-cache (make-hash-table :test 'equal)
5022 "Cache content of etags files used here for faster access.")
5024 (defvar anything-etags-mode-line-string
5025 "\\<anything-c-etags-map>\
5026 \\[anything-etags-help]:Help,\
5027 \\<anything-map>\
5028 \\[anything-select-action]:Acts,\
5029 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
5030 \\[anything-select-3rd-action]:NthAct,\
5031 \\[anything-send-bug-report-from-anything]:BugReport."
5032 "String displayed in mode-line in `anything-c-etags-select'.")
5034 (defun anything-c-etags-get-tag-file (&optional directory)
5035 "Return the path of etags file if found."
5036 ;; Get tag file from `default-directory' or upper directory.
5037 (let ((current-dir (anything-c-etags-find-tag-file-directory
5038 (or directory default-directory))))
5039 ;; Return nil if not find tag file.
5040 (when current-dir
5041 ;; Set tag file directory.
5042 (setq anything-c-etags-tag-file-dir current-dir)
5043 (expand-file-name anything-c-etags-tag-file-name current-dir))))
5045 (defun anything-c-etags-find-tag-file-directory (current-dir)
5046 "Try to find the directory containing tag file.
5047 If not found in CURRENT-DIR search in upper directory."
5048 (flet ((file-exists? (dir)
5049 (let ((tag-path (expand-file-name
5050 anything-c-etags-tag-file-name dir)))
5051 (and (stringp tag-path)
5052 (file-exists-p tag-path)
5053 (file-readable-p tag-path)))))
5054 (loop with count = 0
5055 until (file-exists? current-dir)
5056 ;; Return nil if outside the value of
5057 ;; `anything-c-etags-tag-file-search-limit'.
5058 if (= count anything-c-etags-tag-file-search-limit)
5059 do (return nil)
5060 ;; Or search upper directories.
5061 else
5062 do (incf count)
5063 (setq current-dir (expand-file-name (concat current-dir "../")))
5064 finally return current-dir)))
5066 (defun anything-c-source-etags-header-name (x)
5067 "Create header name for this anything etags session."
5068 (concat "Etags in "
5069 (with-current-buffer anything-current-buffer
5070 (anything-c-etags-get-tag-file))))
5072 (defmacro anything-c-etags-create-buffer (file)
5073 "Create the `anything-buffer' based on contents of etags tag FILE."
5074 `(let* ((tag-fname ,file)
5076 (split (with-current-buffer (find-file-noselect tag-fname)
5077 (prog1
5078 (split-string (buffer-string) "\n" 'omit-nulls)
5079 (setq max (line-number-at-pos (point-max)))
5080 (kill-buffer))))
5081 (progress-reporter (make-progress-reporter "Loading tag file..." 0 max)))
5082 (loop
5083 with fname
5084 with cand
5085 for i in split for count from 0
5086 for elm = (unless (string-match "^\x0c" i)
5087 (anything-aif (string-match "\177" i)
5088 (substring i 0 it)
5090 do (cond ((and elm (string-match "^\\(.+\\),[0-9]+" elm))
5091 (setq fname (match-string 1 elm)))
5092 (elm (setq cand (concat fname ": " elm)))
5093 (t (setq cand nil)))
5094 when cand do (progn
5095 (insert (concat cand "\n"))
5096 (progress-reporter-update progress-reporter count)))))
5098 (defun anything-c-etags-init ()
5099 "Feed `anything-buffer' using `anything-c-etags-cache' or tag file.
5100 If no entry in cache, create one."
5101 (let ((tagfile (anything-c-etags-get-tag-file)))
5102 (when tagfile
5103 (with-current-buffer (anything-candidate-buffer 'global)
5104 (anything-aif (gethash tagfile anything-c-etags-cache)
5105 ;; An entry is present in cache, insert it.
5106 (insert it)
5107 ;; No entry, create a new buffer using content of tag file (slower).
5108 (anything-c-etags-create-buffer tagfile)
5109 ;; Store content of buffer in cache.
5110 (puthash tagfile (buffer-string) anything-c-etags-cache)
5111 ;; Store or set the last modification of tag file.
5112 (anything-aif (assoc tagfile anything-c-etags-mtime-alist)
5113 ;; If an entry exists modify it.
5114 (setcdr it (anything-c-etags-mtime tagfile))
5115 ;; No entry create a new one.
5116 (add-to-list 'anything-c-etags-mtime-alist
5117 (cons tagfile (anything-c-etags-mtime tagfile)))))))))
5119 (defvar anything-c-source-etags-select
5120 '((name . "Etags")
5121 (header-name . anything-c-source-etags-header-name)
5122 (init . anything-c-etags-init)
5123 (candidates-in-buffer)
5124 (mode-line . anything-etags-mode-line-string)
5125 (action . anything-c-etags-default-action)
5126 (persistent-action . (lambda (candidate)
5127 (anything-c-etags-default-action candidate)
5128 (anything-match-line-color-current-line))))
5129 "Anything source for Etags.")
5131 (defun anything-c-etags-default-action (candidate)
5132 "Anything default action to jump to an etags entry."
5133 (let* ((split (split-string candidate ": "))
5134 (fname (expand-file-name
5135 (car split) anything-c-etags-tag-file-dir))
5136 (elm (cadr split)))
5137 (find-file fname)
5138 (goto-char (point-min))
5139 (search-forward elm nil t)
5140 (goto-char (match-beginning 0))))
5142 (defun anything-c-etags-select (arg)
5143 "Preconfigured anything for etags.
5144 Called with one prefix arg use symbol at point as initial input.
5145 Called with two prefix arg reinitialize cache.
5146 If tag file have been modified reinitialize cache."
5147 (interactive "P")
5148 (let ((tag (anything-c-etags-get-tag-file))
5149 (init (and (equal arg '(4)) (thing-at-point 'symbol)))
5150 (anything-quit-if-no-candidate t)
5151 (anything-execute-action-at-once-if-one t))
5152 (when (or (equal arg '(16))
5153 (and anything-c-etags-mtime-alist
5154 (anything-c-etags-file-modified-p tag)))
5155 (remhash tag anything-c-etags-cache))
5156 (if (and tag (file-exists-p tag))
5157 (anything :sources 'anything-c-source-etags-select
5158 :keymap anything-c-etags-map
5159 :input init
5160 :buffer "*anything etags*")
5161 (message "Error: No tag file found, please create one with etags shell command."))))
5163 (defun anything-c-etags-mtime (file)
5164 "Last modification time of etags tag FILE."
5165 (cadr (nth 5 (file-attributes file))))
5167 (defun anything-c-etags-file-modified-p (file)
5168 "Check if tag FILE have been modified in this session.
5169 If FILE is nil return nil."
5170 (let ((last-modif (and file
5171 (assoc-default file anything-c-etags-mtime-alist))))
5172 (and last-modif
5173 (/= last-modif (anything-c-etags-mtime file)))))
5175 ;;; Recentf files
5178 (defvar anything-c-source-recentf
5179 '((name . "Recentf")
5180 (init . (lambda ()
5181 (require 'recentf)
5182 (or recentf-mode (recentf-mode 1))
5183 ;; Big value empowers anything/recentf
5184 (when (and (numberp recentf-max-saved-items)
5185 (<= recentf-max-saved-items 20))
5186 (setq recentf-max-saved-items 500))))
5187 (candidates . recentf-list)
5188 (match anything-c-match-on-file-name
5189 anything-c-match-on-directory-name)
5190 (type . file))
5191 "See (info \"(emacs)File Conveniences\").
5192 if `recentf-max-saved-items' is too small, set it to 500.")
5193 ;; (anything 'anything-c-source-recentf)
5195 ;;; ffap
5196 (eval-when-compile (require 'ffap))
5197 (defvar anything-c-source-ffap-guesser
5198 '((name . "File at point")
5199 (init . (lambda () (require 'ffap)))
5200 (candidates . (lambda ()
5201 (anything-aif
5202 (with-current-buffer anything-current-buffer
5203 (ffap-guesser))
5204 (list it))))
5205 (type . file)))
5206 ;; (anything 'anything-c-source-ffap-guesser)
5208 ;;; ffap with line number
5209 (defun anything-c-ffap-file-line-at-point ()
5210 "Get (FILENAME . LINENO) at point."
5211 (anything-aif (let (ffap-alist) (ffap-file-at-point))
5212 (save-excursion
5213 (beginning-of-line)
5214 (when (and (search-forward it nil t)
5215 (looking-at ":\\([0-9]+\\)"))
5216 (cons it (string-to-number (match-string 1)))))))
5218 (defvar anything-c-ffap-line-location nil
5219 "(FILENAME . LINENO) used by `anything-c-source-ffap-line'.
5220 It is cleared after jumping line.")
5222 (defun anything-c-ffap-line-candidates ()
5223 (with-current-buffer anything-current-buffer
5224 (setq anything-c-ffap-line-location (anything-c-ffap-file-line-at-point)))
5225 (when anything-c-ffap-line-location
5226 (destructuring-bind (file . line) anything-c-ffap-line-location
5227 (list (cons (format "%s (line %d)" file line) file)))))
5229 ;;; Goto line after opening file by `anything-c-source-ffap-line'.
5230 (defun anything-c-ffap-line-goto-line ()
5231 (when (car anything-c-ffap-line-location)
5232 (unwind-protect
5233 (ignore-errors
5234 (with-selected-window
5235 (get-buffer-window
5236 (get-file-buffer (car anything-c-ffap-line-location)))
5237 (anything-goto-line (cdr anything-c-ffap-line-location)))))))
5238 (add-hook 'anything-after-action-hook 'anything-c-ffap-line-goto-line)
5239 (add-hook 'anything-after-persistent-action-hook 'anything-c-ffap-line-goto-line)
5241 (defvar anything-c-source-ffap-line
5242 '((name . "File/Lineno at point")
5243 (init . (lambda () (require 'ffap)))
5244 (candidates . anything-c-ffap-line-candidates)
5245 (type . file)))
5246 ;; (anything 'anything-c-source-ffap-line)
5248 ;;; list of files gleaned from every dired buffer
5249 (defun anything-c-files-in-all-dired-candidates ()
5250 (save-excursion
5251 (mapcan
5252 (lambda (dir)
5253 (cond ((listp dir) ;filelist
5254 dir)
5255 ((equal "" (file-name-nondirectory dir)) ;dir
5256 (directory-files dir t))
5257 (t ;wildcard
5258 (file-expand-wildcards dir t))))
5259 (delq nil
5260 (mapcar (lambda (buf)
5261 (set-buffer buf)
5262 (when (eq major-mode 'dired-mode)
5263 (if (consp dired-directory)
5264 (cdr dired-directory) ;filelist
5265 dired-directory))) ;dir or wildcard
5266 (buffer-list))))))
5267 ;; (dired '("~/" "~/.emacs-custom.el" "~/.emacs.bmk"))
5269 (defvar anything-c-source-files-in-all-dired
5270 '((name . "Files in all dired buffer.")
5271 (candidates . anything-c-files-in-all-dired-candidates)
5272 (type . file)))
5273 ;; (anything 'anything-c-source-files-in-all-dired)
5275 (defvar anything-c-source-filelist
5276 '((name . "FileList")
5277 (grep-candidates . anything-c-filelist-file-name)
5278 (candidate-number-limit . 200)
5279 (requires-pattern . 4)
5280 (type . file))
5281 "Source to find files instantly.
5282 See `anything-c-filelist-file-name' docstring for usage.")
5284 ;;;###autoload
5285 (defun anything-filelist ()
5286 "Preconfigured `anything' to open files instantly.
5288 See `anything-c-filelist-file-name' docstring for usage."
5289 (interactive)
5290 (anything-other-buffer 'anything-c-source-filelist "*anything file list*"))
5292 ;;;###autoload
5293 (defun anything-filelist+ ()
5294 "Preconfigured `anything' to open files/buffers/bookmarks instantly.
5296 This is a replacement for `anything-for-files'.
5297 See `anything-c-filelist-file-name' docstring for usage."
5298 (interactive)
5299 (anything-other-buffer
5300 '(anything-c-source-ffap-line
5301 anything-c-source-ffap-guesser
5302 anything-c-source-buffers+
5303 anything-c-source-recentf
5304 anything-c-source-bookmarks
5305 anything-c-source-file-cache
5306 anything-c-source-filelist)
5307 "*anything file list*"))
5310 ;;;; <info>
5311 ;;; Info pages
5312 (defvar anything-c-info-pages nil
5313 "All info pages on system.
5314 Will be calculated the first time you invoke anything with this
5315 source.")
5317 (defvar anything-c-source-info-pages
5318 `((name . "Info Pages")
5319 (candidates
5320 . (lambda ()
5321 (if anything-c-info-pages
5322 anything-c-info-pages
5323 (setq anything-c-info-pages
5324 (save-window-excursion
5325 (save-excursion
5326 (require 'info)
5327 (Info-find-node "dir" "top")
5328 (goto-char (point-min))
5329 (let ((info-topic-regexp "\\* +\\([^:]+: ([^)]+)[^.]*\\)\\.")
5330 topics)
5331 (while (re-search-forward info-topic-regexp nil t)
5332 (add-to-list 'topics (match-string-no-properties 1)))
5333 (goto-char (point-min))
5334 (Info-exit)
5335 topics)))))))
5336 (action . (("Show with Info" .(lambda (node-str)
5337 (info (replace-regexp-in-string
5338 "^[^:]+: " "" node-str))))))
5339 (requires-pattern . 2)))
5340 ;; (anything 'anything-c-source-info-pages)
5343 ;; FIXME should be merged in anything.el with `anything-describe-anything-attribute'.
5344 (defun anything-c-describe-attributes (anything-attribute)
5345 "Display the full documentation of ANYTHING-ATTRIBUTE (a symbol).
5346 Same as `anything-describe-anything-attribute' but with anything completion."
5347 (interactive (list (intern
5348 (anything-comp-read
5349 "Describe anything attribute: "
5350 (mapcar 'symbol-name anything-additional-attributes)
5351 :must-match t
5352 :persistent-action
5353 #'(lambda (candidate)
5354 (with-output-to-temp-buffer "*Help*"
5355 (princ (get (intern candidate) 'anything-attrdoc))))))))
5356 (with-output-to-temp-buffer "*Help*"
5357 (princ (get anything-attribute 'anything-attrdoc))))
5359 ;;; Use info-index plug-in.
5362 ;; Note that `name' attribute is not needed since
5363 ;; `anything-c-insert-summary' have been removed.
5364 ;; Info Elisp
5365 (defvar anything-c-source-info-elisp
5366 '((name . "Info index: elisp")
5367 (info-index . "elisp")))
5368 ;; (anything 'anything-c-source-info-elisp)
5370 ;; Info-Common-Lisp
5371 (defvar anything-c-source-info-cl
5372 '((name . "Info index: cl")
5373 (info-index . "cl")))
5374 ;; (anything 'anything-c-source-info-cl)
5376 ;; Info Index org
5377 (defvar anything-c-source-info-org
5378 '((name . "Info index: org")
5379 (info-index . "org")))
5380 ;; (anything 'anything-c-source-info-org)
5382 ;; Info Index ratpoison
5383 (defvar anything-c-source-info-ratpoison
5384 '((name . "Info index: ratpoison")
5385 (info-index . "ratpoison")))
5386 ;; (anything 'anything-c-source-info-ratpoison)
5388 ;; Info Index zsh
5389 (defvar anything-c-source-info-zsh
5390 '((name . "Info index: zsh")
5391 (info-index . "zsh")))
5392 ;; (anything 'anything-c-source-info-zsh)
5394 ;; Info Index bash
5395 (defvar anything-c-source-info-bash
5396 '((name . "Info index: bash")
5397 (info-index . "bash")))
5398 ;; (anything 'anything-c-source-info-bash)
5400 ;; Info Index coreutils
5401 (defvar anything-c-source-info-coreutils
5402 '((name . "Info index: coreutils")
5403 (info-index . "coreutils")))
5404 ;; (anything 'anything-c-source-info-coreutils)
5406 ;; Info Index fileutils
5407 (defvar anything-c-source-info-fileutils
5408 '((name . "Info index: fileutils")
5409 (info-index . "fileutils")))
5410 ;; (anything 'anything-c-source-info-fileutils)
5412 ;; Info Index find
5413 (defvar anything-c-source-info-find
5414 '((name . "Info index: find")
5415 (info-index . "find")))
5416 ;; (anything 'anything-c-source-info-find)
5418 ;; Info Index sh-utils
5419 (defvar anything-c-source-info-sh-utils
5420 '((name . "Info index: sh-utils")
5421 (info-index . "sh-utils")))
5422 ;; (anything 'anything-c-source-info-sh-utils)
5424 ;; Info Index textutils
5425 (defvar anything-c-source-info-textutils
5426 '((name . "Info index: textutils")
5427 (info-index . "textutils")))
5428 ;; (anything 'anything-c-source-info-textutils)
5430 ;; Info Index libc
5431 (defvar anything-c-source-info-libc
5432 '((name . "Info index: libc")
5433 (info-index . "libc")))
5434 ;; (anything 'anything-c-source-info-libc)
5436 ;; Info Index make
5437 (defvar anything-c-source-info-make
5438 '((name . "Info index: make")
5439 (info-index . "make")))
5440 ;; (anything 'anything-c-source-info-make)
5442 ;; Info Index automake
5443 (defvar anything-c-source-info-automake
5444 '((name . "Info index: automake")
5445 (info-index . "automake")))
5446 ;; (anything 'anything-c-source-info-automake)
5448 ;; Info Index autoconf
5449 (defvar anything-c-source-info-autoconf
5450 '((name . "Info index: autoconf")
5451 (info-index . "autoconf")))
5452 ;; (anything 'anything-c-source-info-autoconf)
5454 ;; Info Index emacs-lisp-intro
5455 (defvar anything-c-source-info-emacs-lisp-intro
5456 '((name . "Info index: emacs-lisp-intro")
5457 (info-index . "emacs-lisp-intro")))
5458 ;; (anything 'anything-c-source-info-emacs-lisp-intro)
5460 ;; Info Index emacs
5461 (defvar anything-c-source-info-emacs
5462 '((name . "Info index: emacs")
5463 (info-index . "emacs")))
5464 ;; (anything 'anything-c-source-info-emacs)
5466 ;; Info Index elib
5467 (defvar anything-c-source-info-elib
5468 '((name . "Info index: elib")
5469 (info-index . "elib")))
5470 ;; (anything 'anything-c-source-info-elib)
5472 ;; Info Index eieio
5473 (defvar anything-c-source-info-eieio
5474 '((name . "Info index: eieio")
5475 (info-index . "eieio")))
5476 ;; (anything 'anything-c-source-info-eieio)
5478 ;; Info Index gauche-refe
5479 (defvar anything-c-source-info-gauche-refe
5480 '((name . "Info index: gauche")
5481 (info-index . "gauche-refe")))
5482 ;; (anything 'anything-c-source-info-gauche-refe)
5484 ;; Info Index guile
5485 (defvar anything-c-source-info-guile
5486 '((name . "Info index: guile")
5487 (info-index . "guile")))
5488 ;; (anything 'anything-c-source-info-guile)
5490 ;; Info Index guile-tut
5491 (defvar anything-c-source-info-guile-tut
5492 '((name . "Info index: guile-tut")
5493 (info-index . "guile-tut")))
5494 ;; (anything 'anything-c-source-info-guile-tut)
5496 ;; Info Index goops
5497 (defvar anything-c-source-info-goops
5498 '((name . "Info index: goops")
5499 (info-index . "goops")))
5500 ;; (anything 'anything-c-source-info-goops)
5502 ;; Info Index screen
5503 (defvar anything-c-source-info-screen
5504 '((name . "Info index: screen")
5505 (info-index . "screen")
5506 (index-nodes "Concept Index" "Command Index" "Keystroke Index")))
5507 ;; (anything 'anything-c-source-info-screen)
5509 ;; Info Index latex
5510 (defvar anything-c-source-info-latex
5511 '((name . "Info index: latex")
5512 (info-index . "latex")))
5513 ;; (anything 'anything-c-source-info-latex)
5515 ;; Info Index gawk
5516 (defvar anything-c-source-info-gawk
5517 '((name . "Info index: gawk")
5518 (info-index . "gawk")))
5519 ;; (anything 'anything-c-source-info-gawk)
5521 ;; Info Index sed
5522 (defvar anything-c-source-info-sed
5523 '((name . "Info index: sed")
5524 (info-index . "sed")))
5525 ;; (anything 'anything-c-source-info-sed)
5527 ;; Info Index m4
5528 (defvar anything-c-source-info-m4
5529 '((name . "Info index: m4")
5530 (info-index . "m4")))
5531 ;; (anything 'anything-c-source-info-m4)
5533 ;; Info Index wget
5534 (defvar anything-c-source-info-wget
5535 '((name . "Info index: wget")
5536 (info-index . "wget")))
5537 ;; (anything 'anything-c-source-info-wget)
5539 ;; Info Index binutils
5540 (defvar anything-c-source-info-binutils
5541 '((name . "Info index: binutils")
5542 (info-index . "binutils")))
5543 ;; (anything 'anything-c-source-info-binutils)
5545 ;; Info Index as
5546 (defvar anything-c-source-info-as
5547 '((name . "Info index: as")
5548 (info-index . "as")))
5549 ;; (anything 'anything-c-source-info-as)
5551 ;; Info Index bfd
5552 (defvar anything-c-source-info-bfd
5553 '((name . "Info index: bfd")
5554 (info-index . "bfd")))
5555 ;; (anything 'anything-c-source-info-bfd)
5557 ;; Info Index gprof
5558 (defvar anything-c-source-info-gprof
5559 '((name . "Info index: gprof")
5560 (info-index . "gprof")))
5561 ;; (anything 'anything-c-source-info-gprof)
5563 ;; Info Index ld
5564 (defvar anything-c-source-info-ld
5565 '((name . "Info index: ld")
5566 (info-index . "ld")))
5567 ;; (anything 'anything-c-source-info-ld)
5569 ;; Info Index diff
5570 (defvar anything-c-source-info-diff
5571 '((name . "Info index: diff")
5572 (info-index . "diff")))
5573 ;; (anything 'anything-c-source-info-diff)
5575 ;; Info Index flex
5576 (defvar anything-c-source-info-flex
5577 '((name . "Info index: flex")
5578 (info-index . "flex")))
5579 ;; (anything 'anything-c-source-info-flex)
5581 ;; Info Index grep
5582 (defvar anything-c-source-info-grep
5583 '((name . "Info index: grep")
5584 (info-index . "grep")))
5585 ;; (anything 'anything-c-source-info-grep)
5587 ;; Info Index gzip
5588 (defvar anything-c-source-info-gzip
5589 '((name . "Info index: gzip")
5590 (info-index . "gzip")))
5591 ;; (anything 'anything-c-source-info-gzip)
5593 ;; Info Index libtool
5594 (defvar anything-c-source-info-libtool
5595 '((name . "Info index: libtool")
5596 (info-index . "libtool")))
5597 ;; (anything 'anything-c-source-info-libtool)
5599 ;; Info Index texinfo
5600 (defvar anything-c-source-info-texinfo
5601 '((name . "Info index: texinfo")
5602 (info-index . "texinfo")))
5603 ;; (anything 'anything-c-source-info-texinfo)
5605 ;; Info Index info
5606 (defvar anything-c-source-info-info
5607 '((name . "Info index: info")
5608 (info-index . "info")))
5609 ;; (anything 'anything-c-source-info-info)
5611 ;; Info Index gdb
5612 (defvar anything-c-source-info-gdb
5613 '((name . "Info index: gdb")
5614 (info-index . "gdb")))
5615 ;; (anything 'anything-c-source-info-gdb)
5617 ;; Info Index stabs
5618 (defvar anything-c-source-info-stabs
5619 '((name . "Info index: stabs")
5620 (info-index . "stabs")))
5621 ;; (anything 'anything-c-source-info-stabs)
5623 ;; Info Index cvsbook
5624 (defvar anything-c-source-info-cvsbook
5625 '((name . "Info index: cvsbook")
5626 (info-index . "cvsbook")))
5627 ;; (anything 'anything-c-source-info-cvsbook)
5629 ;; Info Index cvs
5630 (defvar anything-c-source-info-cvs
5631 '((name . "Info index: cvs")
5632 (info-index . "cvs")))
5633 ;; (anything 'anything-c-source-info-cvs)
5635 ;; Info Index bison
5636 (defvar anything-c-source-info-bison
5637 '((name . "Info index: bison")
5638 (info-index . "bison")))
5639 ;; (anything 'anything-c-source-info-bison)
5641 ;; Info Index id-utils
5642 (defvar anything-c-source-info-id-utils
5643 '((name . "Info index: id-utils")
5644 (info-index . "id-utils")))
5645 ;; (anything 'anything-c-source-info-id-utils)
5647 ;; Info Index global
5648 (defvar anything-c-source-info-global
5649 '((name . "Info index: global")
5650 (info-index . "global")))
5651 ;; (anything 'anything-c-source-info-global)
5653 ;;;; <Help>
5654 ;;; Man Pages
5655 (defvar anything-c-man-pages nil
5656 "All man pages on system.
5657 Will be calculated the first time you invoke anything with this
5658 source.")
5660 (defun anything-c-man-default-action (candidate)
5661 "Default action for jumping to a woman or man page from anything."
5662 (let ((wfiles (woman-file-name-all-completions candidate)))
5663 (condition-case err
5664 (if (> (length wfiles) 1)
5665 (woman-find-file
5666 (anything-comp-read
5667 "ManFile: " wfiles :must-match t))
5668 (woman candidate))
5669 ;; If woman is unable to format correctly
5670 ;; use man instead.
5671 (error (kill-buffer) ; Kill woman buffer.
5672 (let ((Man-notify-method 'meek))
5673 (Man-getpage-in-background candidate))))))
5675 (defvar anything-c-source-man-pages
5676 `((name . "Manual Pages")
5677 (candidates . (lambda ()
5678 (if anything-c-man-pages
5679 anything-c-man-pages
5680 ;; XEmacs doesn't have a woman :)
5681 (setq anything-c-man-pages
5682 (ignore-errors
5683 (require 'woman)
5684 (woman-file-name "")
5685 (sort (mapcar 'car woman-topic-all-completions)
5686 'string-lessp))))))
5687 (action ("Show with Woman" . anything-c-man-default-action))
5688 ;; Woman does not work OS X
5689 ;; http://xahlee.org/emacs/modernization_man_page.html
5690 (action-transformer . (lambda (actions candidate)
5691 (if (eq system-type 'darwin)
5692 '(("Show with Man" . man))
5693 actions)))
5694 (requires-pattern . 2)))
5695 ;; (anything 'anything-c-source-man-pages)
5697 ;;;; <Command>
5698 ;;; Complex command history
5699 (defvar anything-c-source-complex-command-history
5700 '((name . "Complex Command History")
5701 (candidates . (lambda () (mapcar 'prin1-to-string command-history)))
5702 (type . sexp)))
5703 ;; (anything 'anything-c-source-complex-command-history)
5705 ;;; M-x history
5706 (defvar anything-c-source-extended-command-history
5707 '((name . "Emacs Commands History")
5708 (candidates . extended-command-history)
5709 (type . command)))
5710 ;; (anything 'anything-c-source-extended-command-history)
5712 ;;; Emacs commands
5713 (defvar anything-c-source-emacs-commands
5714 '((name . "Emacs Commands")
5715 (candidates . (lambda ()
5716 (let (commands)
5717 (mapatoms (lambda (a)
5718 (if (commandp a)
5719 (push (symbol-name a)
5720 commands))))
5721 (sort commands 'string-lessp))))
5722 (type . command)
5723 (requires-pattern . 2))
5724 "Source for completing and invoking Emacs commands.
5725 A command is a function with interactive spec that can
5726 be invoked with `M-x'.
5728 To get non-interactive functions listed, use
5729 `anything-c-source-emacs-functions'.")
5730 ;; (anything 'anything-c-source-emacs-commands)
5732 ;;; Anything M-x
5734 ;; Another replacement of `M-x' that act exactly like the
5735 ;; vanilla Emacs one, no problem of windows configuration, prefix args
5736 ;; can be passed before calling `M-x' (e.g C-u M-x..) but also during
5737 ;; anything invocation.
5738 ;;;###autoload
5739 (defun anything-M-x ()
5740 "Preconfigured `anything' for Emacs commands.
5741 It is `anything' replacement of regular `M-x' `execute-extended-command'."
5742 (interactive)
5743 (let* (in-help
5744 help-cand
5745 anything-persistent-action-use-special-display
5746 (history (loop with hist
5747 for i in extended-command-history
5748 for com = (intern i)
5749 when (and (fboundp com) (not (member i hist)))
5750 collect i into hist finally return hist))
5751 (command (anything-comp-read
5752 "M-x " obarray
5753 :test 'commandp
5754 :must-match t
5755 :requires-pattern 2
5756 :name "Emacs Commands"
5757 :persistent-action
5758 #'(lambda (candidate)
5759 (let ((hbuf (get-buffer (help-buffer))))
5760 (if (and in-help (string= candidate help-cand))
5761 (progn
5762 ;; When M-x is started from a help buffer,
5763 ;; Don't kill it as it is anything-current-buffer.
5764 (unless (equal hbuf anything-current-buffer)
5765 (kill-buffer hbuf))
5766 (setq in-help nil))
5767 ;; Be sure anything-current-buffer have not a dedicated window.
5768 (set-window-dedicated-p
5769 (get-buffer-window anything-current-buffer) nil)
5770 (describe-function (intern candidate))
5771 (message nil) ; Erase the new stupid message Type "q"[...]
5772 (setq in-help t))
5773 (setq help-cand candidate)))
5774 :persistent-help "Describe this command"
5775 :history history
5776 :sort 'string-lessp
5777 :fc-transformer 'anything-M-x-transformer)))
5778 (unless current-prefix-arg (setq current-prefix-arg anything-current-prefix-arg))
5779 (call-interactively (intern command))
5780 (setq extended-command-history (cons command (delete command history)))))
5782 (defun* anything-M-x-get-major-mode-command-alist (mode-map)
5783 "Return alist of MODE-MAP."
5784 (loop for key being the key-seqs of mode-map using (key-bindings com)
5785 for str-key = (key-description key)
5786 for ismenu = (string-match "<menu-bar>" str-key)
5787 unless ismenu collect (cons str-key com)))
5789 (defun anything-get-mode-map-from-mode (mode)
5790 "Guess the mode-map name according to MODE.
5791 Some modes don't use conventional mode-map name
5792 so we need to guess mode-map name. e.g python-mode ==> py-mode-map.
5793 Return nil if no mode-map found."
5794 (loop
5795 ;; Start with a conventional mode-map name.
5796 with mode-map = (intern-soft (format "%s-map" mode))
5797 with mode-string = (symbol-name mode)
5798 with mode-name = (replace-regexp-in-string "-mode" "" mode-string)
5799 while (not mode-map)
5800 for count downfrom (length mode-name)
5801 ;; Return when no result after parsing entire string.
5802 when (eq count 0) return nil
5803 for sub-name = (substring mode-name 0 count)
5804 do (setq mode-map (intern-soft (format "%s-map" (concat sub-name "-mode"))))
5805 finally return mode-map))
5807 (defun anything-M-x-current-mode-map-alist ()
5808 "Return mode-map alist of current `major-mode'."
5809 (let ((map (anything-get-mode-map-from-mode major-mode)))
5810 (when (and map (boundp map))
5811 (anything-M-x-get-major-mode-command-alist (symbol-value map)))))
5813 (defface anything-M-x-key-face '((t (:foreground "orange" :underline t)))
5814 "*Face used in anything-M-x to show keybinding."
5815 :group 'anything)
5817 (defun anything-M-x-transformer (candidates sources)
5818 "filtered-candidate-transformer to show bindings in emacs commands.
5819 Show global bindings and local bindings according to current `major-mode'."
5820 (with-current-buffer anything-current-buffer
5821 (loop
5822 with local-map = (anything-M-x-current-mode-map-alist)
5823 for cand in candidates
5824 for local-key = (car (rassq cand local-map))
5825 for key = (substitute-command-keys (format "\\[%s]" cand))
5826 collect
5827 (cons (cond ((and (string-match "^M-x" key) local-key)
5828 (format "%s (%s)"
5829 cand (propertize
5830 local-key
5831 'face 'anything-M-x-key-face)))
5832 ((string-match "^M-x" key) cand)
5833 (t (format "%s (%s)"
5834 cand (propertize
5836 'face 'anything-M-x-key-face)))) cand))))
5838 ;;; LaCarte
5839 (defvar anything-c-source-lacarte
5840 '((name . "Lacarte")
5841 (init . (lambda () (require 'lacarte )))
5842 (candidates . (lambda () (delete '(nil) (lacarte-get-overall-menu-item-alist))))
5843 (candidate-number-limit . 9999)
5844 (action . anything-c-call-interactively))
5845 "Needs lacarte.el.
5847 http://www.emacswiki.org/cgi-bin/wiki/download/lacarte.el")
5848 ;; (anything 'anything-c-source-lacarte)
5850 ;;;; <Function>
5851 ;;; Emacs functions
5852 (defvar anything-c-source-emacs-functions
5853 '((name . "Emacs Functions")
5854 (candidates . (lambda ()
5855 (let (commands)
5856 (mapatoms (lambda (a)
5857 (if (functionp a)
5858 (push (symbol-name a) commands))))
5859 (sort commands 'string-lessp))))
5860 (type . function)
5861 (requires-pattern . 2))
5862 "Source for completing Emacs functions.")
5863 ;; (anything 'anything-c-source-emacs-functions)
5865 ;;; With abbrev expansion
5866 ;;; Similar to my exec-abbrev-cmd.el
5867 ;;; See http://www.tsdh.de/cgi-bin/wiki.pl/exec-abbrev-cmd.el
5868 (defvar anything-c-function-abbrev-regexp nil
5869 "The regexp for `anything-c-source-emacs-functions-with-abbrevs'.
5870 Regexp built from the current `anything-pattern' interpreting it
5871 as abbreviation.
5872 Only for internal use.")
5874 (defun anything-c-match-function-by-abbrev (candidate)
5875 "Return non-nil if `anything-pattern' is an abbreviation of the function CANDIDATE.
5877 Abbreviations are made by taking the first character from each
5878 word in the function's name, e.g. \"bb\" is an abbrev for
5879 `bury-buffer', \"stb\" is an abbrev for `anything-c-switch-to-buffer'."
5880 (string-match anything-c-function-abbrev-regexp candidate))
5882 (defvar anything-c-source-emacs-functions-with-abbrevs
5883 (append anything-c-source-emacs-functions
5884 '((match anything-c-match-function-by-abbrev
5885 anything-c-string-match))
5886 '((init
5887 . (lambda ()
5888 (defadvice anything-update
5889 (before anything-c-update-function-abbrev-regexp activate)
5890 (let ((char-list (append anything-pattern nil))
5891 (str "^"))
5892 (dolist (c char-list)
5893 (setq str (concat str (list c) "[^-]*-")))
5894 (setq str (concat (substring str 0 (1- (length str))) "$"))
5895 (setq anything-c-function-abbrev-regexp str))))))))
5896 ;; (anything 'anything-c-source-emacs-functions-with-abbrevs)
5898 (defvar anything-c-source-advice
5899 '((name . "Function Advice")
5900 (candidates . anything-c-advice-candidates)
5901 (action ("Toggle Enable/Disable" . anything-c-advice-toggle))
5902 ;; (real-to-display . anything-c-advice-real-to-display)
5903 (persistent-action . anything-c-advice-persistent-action)
5904 (persistent-help . "Describe function / C-u C-z: Toggle advice")))
5905 ;; (anything 'anything-c-source-advice)
5906 ;; (let ((debug-on-signal t))(anything 'anything-c-source-advice))
5907 ;; (testadvice)
5909 (defun anything-c-advice-candidates ()
5910 (require 'advice)
5911 (loop for (fname) in ad-advised-functions
5912 for function = (intern fname)
5913 append
5914 (loop for class in ad-advice-classes append
5915 (loop for advice in (ad-get-advice-info-field function class)
5916 for enabled = (ad-advice-enabled advice)
5917 collect
5918 (cons (format
5919 "%s %s %s"
5920 (if enabled "Enabled " "Disabled")
5921 (propertize fname 'face 'font-lock-function-name-face)
5922 (ad-make-single-advice-docstring advice class nil))
5923 (list function class advice))))))
5925 (defun anything-c-advice-persistent-action (func-class-advice)
5926 (if current-prefix-arg
5927 (anything-c-advice-toggle func-class-advice)
5928 (describe-function (car func-class-advice))))
5930 (defun anything-c-advice-toggle (func-class-advice)
5931 (destructuring-bind (function class advice) func-class-advice
5932 (cond ((ad-advice-enabled advice)
5933 (ad-advice-set-enabled advice nil)
5934 (message "Disabled"))
5935 (t ;disabled
5936 (ad-advice-set-enabled advice t)
5937 (message "Enabled")))
5938 (ad-activate function)
5939 (and anything-in-persistent-action
5940 (anything-c-advice-update-current-display-string))))
5942 (defun anything-c-advice-update-current-display-string ()
5943 (anything-edit-current-selection
5944 (let ((newword (cond ((looking-at "Disabled") "Enabled")
5945 ((looking-at "Enabled") "Disabled")))
5946 realvalue)
5947 (when newword
5948 (delete-region (point) (progn (forward-word 1) (point)))
5949 (insert newword)))))
5951 ;;;###autoload
5952 (defun anything-manage-advice ()
5953 "Preconfigured `anything' to disable/enable function advices."
5954 (interactive)
5955 (anything-other-buffer 'anything-c-source-advice "*anything advice*"))
5957 ;;;; <Variable>
5958 ;;; Emacs variables
5959 (defvar anything-c-source-emacs-variables
5960 '((name . "Emacs Variables")
5961 (candidates . (lambda ()
5962 (sort (all-completions "" obarray 'boundp) 'string-lessp)))
5963 (type . variable)
5964 (requires-pattern . 2))
5965 "Source for completing Emacs variables.")
5966 ;; (anything 'anything-c-source-emacs-variables)
5968 ;;;; <Bookmark>
5969 ;;; Bookmarks
5970 (eval-when-compile (require 'bookmark))
5971 (defvar anything-c-source-bookmarks
5972 '((name . "Bookmarks")
5973 (init . (lambda ()
5974 (require 'bookmark)))
5975 (candidates . bookmark-all-names)
5976 (type . bookmark))
5977 "See (info \"(emacs)Bookmarks\").")
5978 ;; (anything 'anything-c-source-bookmarks)
5980 ;;; bookmark-set
5981 (defvar anything-c-source-bookmark-set
5982 '((name . "Set Bookmark")
5983 (dummy)
5984 (action . bookmark-set))
5985 "See (info \"(emacs)Bookmarks\").")
5986 ;; (anything 'anything-c-source-bookmark-set)
5988 ;;; Visible Bookmarks
5989 ;; (install-elisp "http://cvs.savannah.gnu.org/viewvc/*checkout*/bm/bm/bm.el")
5992 ;; http://d.hatena.ne.jp/grandVin/20080911/1221114327
5993 (defvar anything-c-source-bm
5994 '((name . "Visible Bookmarks")
5995 (init . anything-c-bm-init)
5996 (candidates-in-buffer)
5997 (type . line))
5998 "Needs bm.el.
6000 http://www.nongnu.org/bm/")
6002 (defun anything-c-bm-init ()
6003 "Init function for `anything-c-source-bm'."
6004 (when (require 'bm nil t)
6005 (with-no-warnings
6006 (let ((bookmarks (bm-lists))
6007 (buf (anything-candidate-buffer 'global)))
6008 (dolist (bm (sort* (append (car bookmarks) (cdr bookmarks))
6009 '< :key 'overlay-start))
6010 (let ((start (overlay-start bm))
6011 (end (overlay-end bm))
6012 (annotation (or (overlay-get bm 'annotation) "")))
6013 (unless (< (- end start) 1) ; org => (if (< (- end start) 2)
6014 (let ((str (format "%5d: [%s]: %s\n"
6015 (line-number-at-pos start)
6016 annotation
6017 (buffer-substring start (1- end)))))
6018 (with-current-buffer buf (insert str))))))))))
6020 ;;; Special bookmarks
6021 (defvar anything-c-source-bookmarks-ssh
6022 '((name . "Bookmarks-ssh")
6023 (init . (lambda ()
6024 (require 'bookmark)))
6025 (candidates . (lambda () (anything-c-collect-bookmarks :ssh t)))
6026 (type . bookmark))
6027 "See (info \"(emacs)Bookmarks\").")
6028 ;; (anything 'anything-c-source-bookmarks-ssh)
6030 (defvar anything-c-source-bookmarks-su
6031 '((name . "Bookmarks-root")
6032 (init . (lambda ()
6033 (require 'bookmark)))
6034 (candidates . (lambda () (anything-c-collect-bookmarks :su t)))
6035 (filtered-candidate-transformer anything-c-highlight-bookmark-su)
6037 (type . bookmark))
6038 "See (info \"(emacs)Bookmarks\").")
6039 ;; (anything 'anything-c-source-bookmarks-su)
6041 (defvar anything-c-source-bookmarks-local
6042 '((name . "Bookmarks-Local")
6043 (init . (lambda ()
6044 (require 'bookmark)))
6045 (candidates . (lambda () (anything-c-collect-bookmarks :local t)))
6046 (filtered-candidate-transformer
6047 anything-c-adaptive-sort
6048 anything-c-highlight-bookmark)
6049 (type . bookmark))
6050 "See (info \"(emacs)Bookmarks\").")
6051 ;; (anything 'anything-c-source-bookmarks-local)
6053 (defun* anything-c-collect-bookmarks (&key local su sudo ssh)
6054 (let* ((lis-all (bookmark-all-names))
6055 (lis-loc (cond (local (loop for i in lis-all
6056 unless (string-match "^(ssh)\\|^(su)" i)
6057 collect i))
6058 (su (loop for i in lis-all
6059 when (string-match "^(su)" i)
6060 collect i))
6061 (sudo (loop for i in lis-all
6062 when (string-match "^(sudo)" i)
6063 collect i))
6064 (ssh (loop for i in lis-all
6065 when (string-match "^(ssh)" i)
6066 collect i)))))
6067 (sort lis-loc 'string-lessp)))
6069 (defun anything-c-bookmark-root-logged-p ()
6070 (catch 'break
6071 (dolist (i (mapcar #'buffer-name (buffer-list)))
6072 (when (string-match (format "*tramp/%s ." anything-su-or-sudo) i)
6073 (throw 'break t)))))
6075 (defun anything-c-highlight-bookmark-su (files source)
6076 (if (anything-c-bookmark-root-logged-p)
6077 (anything-c-highlight-bookmark files source)
6078 (anything-c-highlight-not-logged files source)))
6080 (defun anything-c-highlight-not-logged (files source)
6081 (loop for i in files
6082 collect (propertize i 'face anything-c-bookmarks-face3)))
6084 (defun anything-c-highlight-bookmark (bookmarks source)
6085 "Used as `candidate-transformer' to colorize bookmarks.
6086 Work both with standard Emacs bookmarks and bookmark-extensions.el."
6087 (loop for i in bookmarks
6088 for isfile = (bookmark-get-filename i)
6089 for bufp = (and (fboundp 'bmkext-get-buffer-name)
6090 (bmkext-get-buffer-name i))
6091 for handlerp = (and (fboundp 'bookmark-get-handler)
6092 (bookmark-get-handler i))
6093 for isw3m = (and (fboundp 'bmkext-w3m-bookmark-p)
6094 (bmkext-w3m-bookmark-p i))
6095 for isgnus = (and (fboundp 'bmkext-gnus-bookmark-p)
6096 (bmkext-gnus-bookmark-p i))
6097 for isman = (and (fboundp 'bmkext-man-bookmark-p) ; Man
6098 (bmkext-man-bookmark-p i))
6099 for iswoman = (and (fboundp 'bmkext-woman-bookmark-p) ; Woman
6100 (bmkext-woman-bookmark-p i))
6101 for handlerp = (bookmark-get-handler i)
6102 for isannotation = (bookmark-get-annotation i)
6103 for isabook = (string= (bookmark-prop-get i 'type) "addressbook")
6104 for isinfo = (eq handlerp 'Info-bookmark-jump)
6105 ;; Add a * if bookmark have annotation
6106 if (and isannotation (not (string-equal isannotation "")))
6107 do (setq i (concat "*" i))
6108 collect (cond (;; info buffers
6109 isinfo
6110 (propertize i 'face 'anything-bmkext-info 'help-echo isfile))
6111 (;; w3m buffers
6112 isw3m
6113 (propertize i 'face 'anything-bmkext-w3m 'help-echo isfile))
6114 (;; gnus buffers
6115 isgnus
6116 (propertize i 'face 'anything-bmkext-gnus 'help-echo isfile))
6117 (;; Man Woman
6118 (or iswoman isman)
6119 (propertize i 'face 'anything-bmkext-man 'help-echo isfile))
6120 (;; Addressbook
6121 isabook
6122 (propertize i 'face '((:foreground "Tomato"))))
6123 (;; directories
6124 (and isfile (file-directory-p isfile))
6125 (propertize i 'face anything-c-bookmarks-face1 'help-echo isfile))
6126 (;; regular files
6128 (propertize i 'face 'anything-bmkext-file 'help-echo isfile)))))
6131 ;;; Faces for bookmarks
6132 (defface anything-bmkext-info
6133 '((t (:foreground "green")))
6134 "*Face used for W3m Emacs bookmarks (not w3m bookmarks)."
6135 :group 'anything)
6137 (defface anything-bmkext-w3m
6138 '((t (:foreground "yellow")))
6139 "*Face used for W3m Emacs bookmarks (not w3m bookmarks)."
6140 :group 'anything)
6142 (defface anything-bmkext-gnus
6143 '((t (:foreground "magenta")))
6144 "*Face used for Gnus bookmarks."
6145 :group 'anything)
6147 (defface anything-bmkext-man
6148 '((t (:foreground "Orange4")))
6149 "*Face used for Woman/man bookmarks."
6150 :group 'anything)
6152 (defface anything-bmkext-no--file
6153 '((t (:foreground "grey")))
6154 "*Face used for non--file bookmarks."
6155 :group 'anything)
6157 (defface anything-bmkext-file
6158 '((t (:foreground "Deepskyblue2")))
6159 "*Face used for non--file bookmarks."
6160 :group 'anything)
6162 (defface anything-bookmarks-su-face '((t (:foreground "red")))
6163 "Face for su/sudo bookmarks."
6164 :group 'anything)
6166 (defvar anything-c-bookmarks-face1 'anything-ff-directory)
6167 (defvar anything-c-bookmarks-face2 'anything-ff-file)
6168 (defvar anything-c-bookmarks-face3 'anything-bookmarks-su-face)
6171 ;;; Sources to filter bookmark-extensions bookmarks.
6172 ;; Dependency: http://mercurial.intuxication.org/hg/emacs-bookmark-extension
6173 ;; If you want to enable google-maps in addressbook you will need
6174 ;; Julien Danjou google-maps-el package available here:
6175 ;; http://julien.danjou.info/google-maps-el.html
6177 (defun anything-c-bmkext-filter-setup-alist (fn &rest args)
6178 "Return a filtered `bookmark-alist' sorted alphabetically."
6179 (loop
6180 with alist = (if args
6181 (apply #'(lambda (x) (funcall fn x)) args)
6182 (funcall fn))
6183 for i in alist
6184 for b = (car i)
6185 collect b into sa
6186 finally return (sort sa 'string-lessp)))
6188 ;; Addressbook
6189 (defvar anything-c-source-bmkext-addressbook
6190 '((name . "Bookmark Addressbook")
6191 (init . (lambda ()
6192 (require 'bookmark-extensions)
6193 (bookmark-maybe-load-default-file)))
6194 (candidates . anything-c-bmkext-addressbook-setup-alist)
6195 (persistent-action
6196 . (lambda (candidate)
6197 (let ((bmk (anything-bookmark-get-bookmark-from-name
6198 candidate)))
6199 (bookmark--jump-via bmk 'pop-to-buffer))))
6200 (persistent-help . "Show contact - Prefix with C-u to append")
6201 (filtered-candidate-transformer
6202 anything-c-adaptive-sort
6203 anything-c-highlight-bookmark)
6204 (action . (("Show Contact(s)"
6205 . (lambda (candidate)
6206 (let* ((contacts (anything-marked-candidates))
6207 (current-prefix-arg (or anything-current-prefix-arg
6208 (> (length contacts) 1))))
6209 (bookmark-jump
6210 (anything-bookmark-get-bookmark-from-name (car contacts)))
6211 (anything-aif (cdr contacts)
6212 (loop for bmk in it do
6213 (bookmark-jump
6214 (anything-bookmark-get-bookmark-from-name bmk)))))))
6215 ("Send Mail"
6216 . (lambda (candidate)
6217 (let* ((contacts (anything-marked-candidates))
6218 (bmk (anything-bookmark-get-bookmark-from-name
6219 (car contacts)))
6220 (append (message-buffers)))
6221 (if append
6222 (addressbook-set-mail-buffer1 bmk 'append)
6223 (addressbook-set-mail-buffer1 bmk))
6224 (setq contacts (cdr contacts))
6225 (when contacts
6226 (loop for bmk in contacts do
6227 (addressbook-set-mail-buffer1 bmk 'append))))))
6228 ("Edit Bookmark"
6229 . (lambda (candidate)
6230 (let ((bmk (anything-bookmark-get-bookmark-from-name
6231 candidate)))
6232 (addressbook-bookmark-edit
6233 (assoc bmk bookmark-alist)))))
6234 ("Insert Email at point"
6235 . (lambda (candidate)
6236 (let* ((bmk (anything-bookmark-get-bookmark-from-name
6237 candidate))
6238 (mlist (split-string
6239 (assoc-default
6240 'email (assoc bmk bookmark-alist))
6241 ", ")))
6242 (insert
6243 (if (> (length mlist) 1)
6244 (anything-comp-read
6245 "Insert Mail Address: " mlist :must-match t)
6246 (car mlist))))))
6247 ("Show annotation"
6248 . (lambda (candidate)
6249 (let ((bmk (anything-bookmark-get-bookmark-from-name
6250 candidate)))
6251 (bookmark-show-annotation bmk))))
6252 ("Edit annotation"
6253 . (lambda (candidate)
6254 (let ((bmk (anything-bookmark-get-bookmark-from-name
6255 candidate)))
6256 (bookmark-edit-annotation bmk))))
6257 ("Show Google map"
6258 . (lambda (candidate)
6259 (let* ((bmk (anything-bookmark-get-bookmark-from-name
6260 candidate))
6261 (full-bmk (assoc bmk bookmark-alist)))
6262 (addressbook-google-map full-bmk))))))))
6265 (defun anything-c-bmkext-addressbook-setup-alist ()
6266 "Specialized filter function for bookmarks w3m."
6267 (anything-c-bmkext-filter-setup-alist 'bmkext-addressbook-alist-only))
6269 ;; W3m
6270 (defvar anything-c-source-bookmark-w3m
6271 '((name . "Bookmark W3m")
6272 (init . (lambda ()
6273 (require 'bookmark-extensions)
6274 (bookmark-maybe-load-default-file)))
6275 (candidates . anything-c-bookmark-w3m-setup-alist)
6276 (filtered-candidate-transformer
6277 anything-c-adaptive-sort
6278 anything-c-highlight-bookmark)
6279 (type . bookmark)))
6280 ;; (anything 'anything-c-source-bookmark-w3m)
6282 (defun anything-c-bookmark-w3m-setup-alist ()
6283 "Specialized filter function for bookmarks w3m."
6284 (anything-c-bmkext-filter-setup-alist 'bmkext-w3m-alist-only))
6286 ;; Images
6287 (defvar anything-c-source-bookmark-images
6288 '((name . "Bookmark Images")
6289 (init . (lambda ()
6290 (require 'bookmark-extensions)
6291 (bookmark-maybe-load-default-file)))
6292 (candidates . anything-c-bookmark-images-setup-alist)
6293 (filtered-candidate-transformer
6294 anything-c-adaptive-sort
6295 anything-c-highlight-bookmark)
6296 (type . bookmark)))
6297 ;; (anything 'anything-c-source-bookmark-images)
6299 (defun anything-c-bookmark-images-setup-alist ()
6300 "Specialized filter function for images bookmarks."
6301 (anything-c-bmkext-filter-setup-alist 'bmkext-image-file-alist-only))
6303 ;; Woman Man
6304 (defvar anything-c-source-bookmark-man
6305 '((name . "Bookmark Woman&Man")
6306 (init . (lambda ()
6307 (require 'bookmark-extensions)
6308 (bookmark-maybe-load-default-file)))
6309 (candidates . anything-c-bookmark-man-setup-alist)
6310 (filtered-candidate-transformer
6311 anything-c-adaptive-sort
6312 anything-c-highlight-bookmark)
6313 (type . bookmark)))
6314 ;; (anything 'anything-c-source-bookmark-man)
6316 (defun anything-c-bookmark-man-setup-alist ()
6317 "Specialized filter function for bookmarks w3m."
6318 (append (anything-c-bmkext-filter-setup-alist 'bmkext-man-alist-only)
6319 (anything-c-bmkext-filter-setup-alist 'bmkext-woman-alist-only)))
6321 ;; Gnus
6322 (defvar anything-c-source-bookmark-gnus
6323 '((name . "Bookmark Gnus")
6324 (init . (lambda ()
6325 (require 'bookmark-extensions)
6326 (bookmark-maybe-load-default-file)))
6327 (candidates . anything-c-bookmark-gnus-setup-alist)
6328 (filtered-candidate-transformer
6329 anything-c-adaptive-sort
6330 anything-c-highlight-bookmark)
6331 (type . bookmark)))
6332 ;; (anything 'anything-c-source-bookmark-gnus)
6334 (defun anything-c-bookmark-gnus-setup-alist ()
6335 "Specialized filter function for bookmarks gnus."
6336 (anything-c-bmkext-filter-setup-alist 'bmkext-gnus-alist-only))
6338 ;; Info
6339 (defvar anything-c-source-bookmark-info
6340 '((name . "Bookmark Info")
6341 (init . (lambda ()
6342 (require 'bookmark-extensions)
6343 (bookmark-maybe-load-default-file)))
6344 (candidates . anything-c-bookmark-info-setup-alist)
6345 (filtered-candidate-transformer
6346 anything-c-adaptive-sort
6347 anything-c-highlight-bookmark)
6348 (type . bookmark)))
6349 ;; (anything 'anything-c-source-bookmark-info)
6351 (defun anything-c-bookmark-info-setup-alist ()
6352 "Specialized filter function for bookmarks info."
6353 (anything-c-bmkext-filter-setup-alist 'bmkext-info-alist-only))
6355 ;; Local Files&directories
6356 (defvar anything-c-source-bookmark-files&dirs
6357 '((name . "Bookmark Files&Directories")
6358 (init . (lambda ()
6359 (require 'bookmark-extensions)
6360 (bookmark-maybe-load-default-file)))
6361 (candidates . anything-c-bookmark-local-files-setup-alist)
6362 (filtered-candidate-transformer
6363 anything-c-adaptive-sort
6364 anything-c-highlight-bookmark)
6365 (type . bookmark)))
6366 ;; (anything 'anything-c-source-bookmark-files&dirs)
6368 (defun anything-c-bookmark-local-files-setup-alist ()
6369 "Specialized filter function for bookmarks locals files."
6370 (anything-c-bmkext-filter-setup-alist 'bmkext-local-file-alist-only))
6372 ;; Su Files&directories
6373 (defvar anything-c-source-bookmark-su-files&dirs
6374 '((name . "Bookmark Root-Files&Directories")
6375 (init . (lambda ()
6376 (require 'bookmark-extensions)
6377 (bookmark-maybe-load-default-file)))
6378 (candidates . anything-c-bookmark-su-files-setup-alist)
6379 (filtered-candidate-transformer
6380 anything-c-adaptive-sort
6381 anything-c-highlight-bookmark-su)
6382 (type . bookmark)))
6383 ;; (anything 'anything-c-source-bookmark-su-files&dirs)
6385 (defun anything-c-bookmark-su-files-setup-alist ()
6386 "Specialized filter function for bookmarks su/sudo files."
6387 (loop
6388 with l = (anything-c-bmkext-filter-setup-alist 'bmkext-remote-file-alist-only)
6389 for i in l
6390 for isfile = (bookmark-get-filename i)
6391 for istramp = (and isfile (boundp 'tramp-file-name-regexp)
6392 (save-match-data
6393 (string-match tramp-file-name-regexp isfile)))
6394 for issu = (and istramp
6395 (string-match bmkext-su-or-sudo-regexp isfile))
6396 if issu
6397 collect i))
6399 ;; Ssh Files&directories
6400 (defvar anything-c-source-bookmark-ssh-files&dirs
6401 '((name . "Bookmark Ssh-Files&Directories")
6402 (init . (lambda ()
6403 (require 'bookmark-extensions)
6404 (bookmark-maybe-load-default-file)))
6405 (candidates . anything-c-bookmark-ssh-files-setup-alist)
6406 (filtered-candidate-transformer . anything-c-adaptive-sort)
6407 (type . bookmark)))
6408 ;; (anything 'anything-c-source-bookmark-ssh-files&dirs)
6410 (defun anything-c-bookmark-ssh-files-setup-alist ()
6411 "Specialized filter function for bookmarks ssh files."
6412 (loop
6413 with l = (anything-c-bmkext-filter-setup-alist 'bmkext-remote-file-alist-only)
6414 for i in l
6415 for isfile = (bookmark-get-filename i)
6416 for istramp = (and isfile (boundp 'tramp-file-name-regexp)
6417 (save-match-data
6418 (string-match tramp-file-name-regexp isfile)))
6419 for isssh = (and istramp
6420 (string-match "/ssh:" isfile))
6421 if isssh
6422 collect i))
6425 ;; All bookmark-extensions sources.
6426 ;;;###autoload
6427 (defun anything-bookmark-ext ()
6428 "Preconfigured `anything' for bookmark-extensions sources.
6429 Needs bookmark-ext.el:
6430 <http://mercurial.intuxication.org/hg/emacs-bookmark-extension>.
6431 Contain also `anything-c-source-google-suggest'."
6432 (interactive)
6433 (anything
6434 :sources
6435 '(anything-c-source-bookmark-files&dirs
6436 anything-c-source-bookmark-w3m
6437 anything-c-source-google-suggest
6438 anything-c-source-bmkext-addressbook
6439 anything-c-source-bookmark-gnus
6440 anything-c-source-bookmark-info
6441 anything-c-source-bookmark-man
6442 anything-c-source-bookmark-images
6443 anything-c-source-bookmark-su-files&dirs
6444 anything-c-source-bookmark-ssh-files&dirs)
6445 :prompt "SearchBookmark: "
6446 :buffer "*anything bmkext*"))
6449 ;; Firefox bookmarks
6450 ;; You will have to set firefox to import bookmarks in his html file bookmarks.html.
6451 ;; (only for firefox versions >=3)
6452 ;; To achieve that, open about:config in firefox and double click on this line to enable value
6453 ;; to true:
6454 ;; user_pref("browser.bookmarks.autoExportHTML", false);
6455 ;; You should have now:
6456 ;; user_pref("browser.bookmarks.autoExportHTML", true);
6458 (defvar anything-firefox-bookmark-url-regexp "\\(https\\|http\\|ftp\\|about\\|file\\)://[^ \"]*")
6459 (defvar anything-firefox-bookmarks-regexp ">\\([^><]+.[^</a>]\\)")
6461 (defun anything-get-firefox-user-init-dir ()
6462 "Guess the default Firefox user directory name."
6463 (let* ((moz-dir (concat (getenv "HOME") "/.mozilla/firefox/"))
6464 (moz-user-dir
6465 (with-current-buffer (find-file-noselect (concat moz-dir "profiles.ini"))
6466 (goto-char (point-min))
6467 (prog1
6468 (when (search-forward "Path=" nil t)
6469 (buffer-substring-no-properties (point) (point-at-eol)))
6470 (kill-buffer)))))
6471 (file-name-as-directory (concat moz-dir moz-user-dir))))
6473 (defun anything-guess-firefox-bookmark-file ()
6474 "Return the path of the Firefox bookmarks file."
6475 (concat (anything-get-firefox-user-init-dir) "bookmarks.html"))
6477 (defun anything-html-bookmarks-to-alist (file url-regexp bmk-regexp)
6478 "Parse html bookmark FILE and return an alist with (title . url) as elements."
6479 (let (bookmarks-alist url title)
6480 (with-temp-buffer
6481 (insert-file-contents file)
6482 (goto-char (point-min))
6483 (while (re-search-forward "href=\\|^ *<DT><A HREF=" nil t)
6484 (forward-line 0)
6485 (when (re-search-forward url-regexp nil t)
6486 (setq url (match-string 0)))
6487 (when (re-search-forward bmk-regexp nil t)
6488 (setq title (match-string 1)))
6489 (push (cons title url) bookmarks-alist)
6490 (forward-line)))
6491 (nreverse bookmarks-alist)))
6493 (defvar anything-c-firefox-bookmarks-alist nil)
6494 (defvar anything-c-source-firefox-bookmarks
6495 '((name . "Firefox Bookmarks")
6496 (init . (lambda ()
6497 (setq anything-c-firefox-bookmarks-alist
6498 (anything-html-bookmarks-to-alist
6499 (anything-guess-firefox-bookmark-file)
6500 anything-firefox-bookmark-url-regexp
6501 anything-firefox-bookmarks-regexp))))
6502 (candidates . (lambda ()
6503 (mapcar #'car anything-c-firefox-bookmarks-alist)))
6504 (filtered-candidate-transformer
6505 anything-c-adaptive-sort
6506 anything-c-highlight-firefox-bookmarks)
6507 (action . (("Browse Url Firefox"
6508 . (lambda (candidate)
6509 (browse-url-firefox
6510 (anything-c-firefox-bookmarks-get-value candidate))))
6511 ("Browse Url w3m"
6512 . (lambda (candidate)
6513 (w3m-browse-url
6514 (anything-c-firefox-bookmarks-get-value candidate))))
6515 ("Copy Url"
6516 . (lambda (elm)
6517 (kill-new (anything-c-w3m-bookmarks-get-value elm))))))))
6519 ;; (anything 'anything-c-source-firefox-bookmarks)
6521 (defun anything-c-firefox-bookmarks-get-value (elm)
6522 (assoc-default elm anything-c-firefox-bookmarks-alist))
6524 (defun anything-c-highlight-firefox-bookmarks (bookmarks source)
6525 (loop for i in bookmarks
6526 collect (propertize
6527 i 'face '((:foreground "YellowGreen"))
6528 'help-echo (anything-c-firefox-bookmarks-get-value i))))
6530 ;; W3m bookmark
6531 ;; Some users have the emacs-w3m library in load-path
6532 ;; without having the w3m executable :-;
6533 ;; So check if w3m program is present before trying to load
6534 ;; emacs-w3m.
6535 (eval-when-compile
6536 (when (executable-find "w3m")
6537 (require 'w3m-bookmark nil t)))
6539 (defvar w3m-bookmark-file "~/.w3m/bookmark.html")
6542 (defface anything-w3m-bookmarks-face '((t (:foreground "cyan1" :underline t)))
6543 "Face for w3m bookmarks" :group 'anything)
6545 (defvar anything-w3m-bookmarks-regexp ">\\([^><]+.[^</a>]\\)")
6546 (defvar anything-w3m-bookmark-url-regexp "\\(https\\|http\\|ftp\\|file\\)://[^>]*")
6547 (defvar anything-c-w3m-bookmarks-alist nil)
6548 (defvar anything-c-source-w3m-bookmarks
6549 '((name . "W3m Bookmarks")
6550 (init . (lambda ()
6551 (setq anything-c-w3m-bookmarks-alist
6552 (anything-html-bookmarks-to-alist
6553 w3m-bookmark-file
6554 anything-w3m-bookmark-url-regexp
6555 anything-w3m-bookmarks-regexp))))
6556 (candidates . (lambda ()
6557 (mapcar #'car anything-c-w3m-bookmarks-alist)))
6558 (filtered-candidate-transformer
6559 anything-c-adaptive-sort
6560 anything-c-highlight-w3m-bookmarks)
6561 (action . (("Browse Url"
6562 . (lambda (candidate)
6563 (anything-c-w3m-browse-bookmark candidate)))
6564 ("Copy Url"
6565 . (lambda (elm)
6566 (kill-new (anything-c-w3m-bookmarks-get-value elm))))
6567 ("Browse Url Firefox"
6568 . (lambda (candidate)
6569 (anything-c-w3m-browse-bookmark candidate t)))
6570 ("Delete Bookmark"
6571 . (lambda (candidate)
6572 (anything-c-w3m-delete-bookmark candidate)))
6573 ("Rename Bookmark"
6574 . (lambda (candidate)
6575 (anything-c-w3m-rename-bookmark candidate)))))
6576 (persistent-action . (lambda (candidate)
6577 (if current-prefix-arg
6578 (anything-c-w3m-browse-bookmark candidate t)
6579 (anything-c-w3m-browse-bookmark candidate nil t))))
6580 (persistent-help . "Open URL with emacs-w3m in new tab / \
6581 C-u \\[anything-execute-persistent-action]: Open URL with Firefox"))
6582 "Needs w3m and emacs-w3m.
6584 http://w3m.sourceforge.net/
6585 http://emacs-w3m.namazu.org/")
6587 ;; (anything 'anything-c-source-w3m-bookmarks)
6589 (defun anything-c-w3m-bookmarks-get-value (elm)
6590 (replace-regexp-in-string
6591 "\"" "" (cdr (assoc elm anything-c-w3m-bookmarks-alist))))
6593 (defun anything-c-w3m-browse-bookmark (elm &optional use-firefox new-tab)
6594 (let* ((fn (if use-firefox 'browse-url-firefox 'w3m-browse-url))
6595 (arg (and (eq fn 'w3m-browse-url) new-tab)))
6596 (funcall fn (anything-c-w3m-bookmarks-get-value elm) arg)))
6598 (defun anything-c-highlight-w3m-bookmarks (bookmarks source)
6599 (loop for i in bookmarks
6600 collect (propertize
6601 i 'face 'anything-w3m-bookmarks-face
6602 'help-echo (anything-c-w3m-bookmarks-get-value i))))
6605 (defun anything-c-w3m-delete-bookmark (elm)
6606 "Delete w3m bookmark from `w3m-bookmark-file'."
6607 (with-current-buffer
6608 (find-file-literally w3m-bookmark-file)
6609 (goto-char (point-min))
6610 (when (re-search-forward elm nil t)
6611 (beginning-of-line)
6612 (delete-region (point)
6613 (line-end-position))
6614 (delete-blank-lines))
6615 (save-buffer)
6616 (kill-buffer)))
6618 (defun anything-c-w3m-rename-bookmark (elm)
6619 "Rename w3m bookmark in `w3m-bookmark-file'."
6620 (let* ((old-title (replace-regexp-in-string ">" "" elm))
6621 (new-title (read-string "NewTitle: " old-title)))
6622 (with-current-buffer
6623 (find-file-literally w3m-bookmark-file)
6624 (goto-char (point-min))
6625 (when (re-search-forward (concat elm "<") nil t)
6626 (goto-char (1- (point)))
6627 (delete-char (- (length old-title)))
6628 (insert new-title))
6629 (save-buffer)
6630 (kill-buffer))))
6632 ;;;; <Library>
6633 ;;; Elisp library scan
6634 (defvar anything-c-source-elisp-library-scan
6635 '((name . "Elisp libraries (Scan)")
6636 (init . (anything-c-elisp-library-scan-init))
6637 (candidates-in-buffer)
6638 (action ("Find library"
6639 . (lambda (candidate) (find-file (find-library-name candidate))))
6640 ("Find library other window"
6641 . (lambda (candidate)
6642 (find-file-other-window (find-library-name candidate))))
6643 ("Load library"
6644 . (lambda (candidate) (load-library candidate))))))
6645 ;; (anything 'anything-c-source-elisp-library-scan)
6647 (defun anything-c-elisp-library-scan-init ()
6648 "Init anything buffer status."
6649 (let ((anything-buffer (anything-candidate-buffer 'global))
6650 (library-list (anything-c-elisp-library-scan-list)))
6651 (with-current-buffer anything-buffer
6652 (dolist (library library-list)
6653 (insert (format "%s\n" library))))))
6655 (defun anything-c-elisp-library-scan-list (&optional dirs string)
6656 "Do completion for file names passed to `locate-file'.
6657 DIRS is directory to search path.
6658 STRING is string to match."
6659 ;; Use `load-path' as path when ignore `dirs'.
6660 (or dirs (setq dirs load-path))
6661 ;; Init with blank when ignore `string'.
6662 (or string (setq string ""))
6663 ;; Get library list.
6664 (let ((string-dir (file-name-directory string))
6665 ;; File regexp that suffix match `load-file-rep-suffixes'.
6666 (match-regexp (format "^.*\\.el%s$" (regexp-opt load-file-rep-suffixes)))
6667 name
6668 names)
6669 (dolist (dir dirs)
6670 (unless dir
6671 (setq dir default-directory))
6672 (if string-dir
6673 (setq dir (expand-file-name string-dir dir)))
6674 (when (file-directory-p dir)
6675 (dolist (file (file-name-all-completions
6676 (file-name-nondirectory string) dir))
6677 ;; Suffixes match `load-file-rep-suffixes'.
6678 (setq name (if string-dir (concat string-dir file) file))
6679 (if (string-match match-regexp name)
6680 (add-to-list 'names name)))))
6681 names))
6683 ;;;; <Programming>
6684 ;;; Imenu
6685 (defvar anything-c-imenu-delimiter " / ")
6687 (defvar anything-c-imenu-index-filter nil)
6688 (make-variable-buffer-local 'anything-c-imenu-index-filter)
6690 (defvar anything-c-cached-imenu-alist nil)
6691 (make-variable-buffer-local 'anything-c-cached-imenu-alist)
6693 (defvar anything-c-cached-imenu-candidates nil)
6694 (make-variable-buffer-local 'anything-c-cached-imenu-candidates)
6696 (defvar anything-c-cached-imenu-tick nil)
6697 (make-variable-buffer-local 'anything-c-cached-imenu-tick)
6699 (eval-when-compile (require 'imenu))
6700 (setq imenu-auto-rescan t)
6702 (defun anything-imenu-create-candidates (entry)
6703 "Create candidates with ENTRY."
6704 (if (listp (cdr entry))
6705 (mapcan
6706 (lambda (sub)
6707 (if (consp (cdr sub))
6708 (mapcar
6709 (lambda (subentry)
6710 (concat (car entry) anything-c-imenu-delimiter subentry))
6711 (anything-imenu-create-candidates sub))
6712 (list (concat (car entry) anything-c-imenu-delimiter (car sub)))))
6713 (cdr entry))
6714 (list entry)))
6716 (defvar anything-c-source-imenu
6717 '((name . "Imenu")
6718 (init . (lambda () (require 'imenu)))
6719 (candidates . anything-c-imenu-candidates)
6720 (persistent-action . (lambda (elm)
6721 (anything-c-imenu-default-action elm)
6722 (unless (fboundp 'semantic-imenu-tag-overlay)
6723 (anything-match-line-color-current-line))))
6724 (persistent-help . "Show this entry")
6725 (action . anything-c-imenu-default-action))
6726 "See (info \"(emacs)Imenu\")")
6728 ;; (anything 'anything-c-source-imenu)
6730 (defun anything-c-imenu-candidates ()
6731 (with-current-buffer anything-current-buffer
6732 (let ((tick (buffer-modified-tick)))
6733 (if (eq anything-c-cached-imenu-tick tick)
6734 anything-c-cached-imenu-candidates
6735 (setq imenu--index-alist nil)
6736 (setq anything-c-cached-imenu-tick tick
6737 anything-c-cached-imenu-candidates
6738 (ignore-errors
6739 (mapcan
6740 'anything-imenu-create-candidates
6741 (setq anything-c-cached-imenu-alist
6742 (let ((index (imenu--make-index-alist)))
6743 (if anything-c-imenu-index-filter
6744 (funcall anything-c-imenu-index-filter index)
6745 index))))))
6746 (setq anything-c-cached-imenu-candidates
6747 (mapcar #'(lambda (x)
6748 (if (stringp x)
6750 (car x)))
6751 anything-c-cached-imenu-candidates))))))
6753 (setq imenu-default-goto-function 'imenu-default-goto-function)
6754 (defun anything-c-imenu-default-action (elm)
6755 "The default action for `anything-c-source-imenu'."
6756 (let ((path (split-string elm anything-c-imenu-delimiter))
6757 (alist anything-c-cached-imenu-alist))
6758 (dolist (elm path)
6759 (setq alist (assoc elm alist)))
6760 (imenu alist)))
6762 ;;; Ctags
6763 (defvar anything-c-ctags-modes
6764 '( c-mode c++-mode awk-mode csharp-mode java-mode javascript-mode lua-mode
6765 makefile-mode pascal-mode perl-mode cperl-mode php-mode python-mode
6766 scheme-mode sh-mode slang-mode sql-mode tcl-mode ))
6768 (defun anything-c-source-ctags-init ()
6769 (when (and buffer-file-name
6770 (memq major-mode anything-c-ctags-modes)
6771 (anything-current-buffer-is-modified))
6772 (with-current-buffer (anything-candidate-buffer 'local)
6773 (call-process-shell-command
6774 (if (string-match "\\.el\\.gz$" anything-buffer-file-name)
6775 (format "ctags -e -u -f- --language-force=lisp --fields=n =(zcat %s) "
6776 anything-buffer-file-name)
6777 (format "ctags -e -u -f- --fields=n %s " anything-buffer-file-name))
6778 nil (current-buffer))
6779 (goto-char (point-min))
6780 (forward-line 2)
6781 (delete-region (point-min) (point))
6782 (loop while (and (not (eobp)) (search-forward "\001" (point-at-eol) t))
6783 for lineno-start = (point)
6784 for lineno = (buffer-substring
6785 lineno-start
6786 (1- (search-forward "," (point-at-eol) t)))
6788 (beginning-of-line)
6789 (insert (format "%5s:" lineno))
6790 (search-forward "\177" (point-at-eol) t)
6791 (delete-region (1- (point)) (point-at-eol))
6792 (forward-line 1)))))
6794 (defvar anything-c-source-ctags
6795 '((name . "Exuberant ctags")
6796 (init . anything-c-source-ctags-init)
6797 (candidates-in-buffer)
6798 (adjust)
6799 (type . line))
6800 "Needs Exuberant Ctags.
6802 http://ctags.sourceforge.net/")
6803 ;; (anything 'anything-c-source-ctags)
6805 ;; Semantic
6806 (eval-when-compile (require 'semantic nil t))
6807 (declare-function semantic-format-tag-summarize "ext:format.el" (tag &optional parent color) t)
6808 (declare-function semantic-tag-components "ext:tag.el" (tag) t)
6809 (declare-function semantic-go-to-tag "ext:tag-file.el" (tag) t)
6810 (declare-function semantic-tag-type "ext:tag-file.el" (tag) t)
6811 (declare-function semantic-tag-class "ext:tag-file.el" (tag) t)
6812 (defvar anything-semantic-candidates nil)
6814 (defun anything-semantic-construct-candidates (tags depth)
6815 (when (require 'semantic nil t)
6816 (apply
6817 'append
6818 (mapcar
6819 (lambda (tag)
6820 (if (listp tag)
6821 (let ((type (semantic-tag-type tag))
6822 (class (semantic-tag-class tag)))
6823 (if (or (and (stringp type)
6824 (or (string= type "class")
6825 (string= type "namespace")))
6826 (eq class 'function)
6827 (eq class 'variable))
6828 (cons (cons (concat (make-string (* depth 2) ?\s)
6829 (semantic-format-tag-summarize tag nil t))
6830 tag)
6831 (anything-semantic-construct-candidates
6832 (semantic-tag-components tag) (1+ depth)))))))
6833 tags))))
6835 (defun anything-semantic-default-action (candidate)
6836 (let ((tag (cdr (assoc candidate anything-semantic-candidates))))
6837 (semantic-go-to-tag tag)))
6839 (defvar anything-c-source-semantic
6840 '((name . "Semantic Tags")
6841 (init . (lambda ()
6842 (setq anything-semantic-candidates
6843 (ignore-errors (anything-semantic-construct-candidates
6844 (semantic-fetch-tags) 0)))))
6845 (candidates . (lambda ()
6846 (if anything-semantic-candidates
6847 (mapcar 'car anything-semantic-candidates))))
6848 (persistent-action . (lambda (elm)
6849 (anything-semantic-default-action elm)
6850 (anything-match-line-color-current-line)))
6851 (persistent-help . "Show this entry")
6852 (action . anything-semantic-default-action)
6853 "Needs semantic in CEDET.
6855 http://cedet.sourceforge.net/semantic.shtml
6856 http://cedet.sourceforge.net/"))
6858 ;; (anything 'anything-c-source-semantic)
6860 ;;; Function is called by
6861 ;;;###autoload
6862 (defun anything-simple-call-tree ()
6863 "Preconfigured `anything' for simple-call-tree. List function relationships.
6865 Needs simple-call-tree.el.
6866 http://www.emacswiki.org/cgi-bin/wiki/download/simple-call-tree.el"
6867 (interactive)
6868 (anything-other-buffer
6869 '(anything-c-source-simple-call-tree-functions-callers
6870 anything-c-source-simple-call-tree-callers-functions)
6871 "*anything simple-call-tree*"))
6873 (defvar anything-c-source-simple-call-tree-functions-callers
6874 '((name . "Function is called by")
6875 (init . anything-c-simple-call-tree-functions-callers-init)
6876 (multiline)
6877 (candidates . anything-c-simple-call-tree-candidates)
6878 (persistent-action . anything-c-simple-call-tree-persistent-action)
6879 (persistent-help . "Show function definitions by rotation")
6880 (action ("Find definition selected by persistent-action" .
6881 anything-c-simple-call-tree-find-definition)))
6882 "Needs simple-call-tree.el.
6883 http://www.emacswiki.org/cgi-bin/wiki/download/simple-call-tree.el")
6885 (defvar anything-c-simple-call-tree-tick nil)
6886 (make-variable-buffer-local 'anything-c-simple-call-tree-tick)
6887 (defun anything-c-simple-call-tree-analyze-maybe ()
6888 (unless (eq (buffer-chars-modified-tick) anything-c-simple-call-tree-tick)
6889 (simple-call-tree-analyze)
6890 (setq anything-c-simple-call-tree-tick (buffer-chars-modified-tick))))
6892 (defun anything-c-simple-call-tree-init-base (function message)
6893 (require 'simple-call-tree)
6894 (with-no-warnings
6895 (when (anything-current-buffer-is-modified)
6896 (anything-c-simple-call-tree-analyze-maybe)
6897 (let ((list (funcall function simple-call-tree-alist)))
6898 (with-current-buffer (anything-candidate-buffer 'local)
6899 (dolist (entry list)
6900 (let ((funcs (concat " " (mapconcat #'identity (cdr entry) "\n "))))
6901 (insert (car entry) message
6902 (if (string= funcs " ")
6903 " no functions."
6904 funcs)
6905 "\n\n"))))))))
6907 (defun anything-c-simple-call-tree-functions-callers-init ()
6908 (anything-c-simple-call-tree-init-base 'simple-call-tree-invert
6909 " is called by\n"))
6911 (defun anything-c-simple-call-tree-candidates ()
6912 (with-current-buffer (anything-candidate-buffer)
6913 (split-string (buffer-string) "\n\n")))
6915 (defvar anything-c-simple-call-tree-related-functions nil)
6916 (defvar anything-c-simple-call-tree-function-index 0)
6917 (defun anything-c-simple-call-tree-persistent-action (candidate)
6918 (unless (eq last-command 'anything-execute-persistent-action)
6919 (setq anything-c-simple-call-tree-related-functions
6920 (delete "no functions."
6921 (split-string
6922 (replace-regexp-in-string " \\| is called by\\| calls "
6923 "" candidate)
6924 "\n")))
6925 (setq anything-c-simple-call-tree-function-index -1))
6926 (incf anything-c-simple-call-tree-function-index)
6927 (anything-c-simple-call-tree-find-definition candidate))
6929 (defun anything-c-simple-call-tree-find-definition (candidate)
6930 (find-function
6931 (intern
6932 (nth (mod anything-c-simple-call-tree-function-index
6933 (length anything-c-simple-call-tree-related-functions))
6934 anything-c-simple-call-tree-related-functions))))
6936 ;; (anything 'anything-c-source-simple-call-tree-functions-callers)
6938 ;;; Function calls
6939 (defvar anything-c-source-simple-call-tree-callers-functions
6940 '((name . "Function calls")
6941 (init . anything-c-simple-call-tree-callers-functions-init)
6942 (multiline)
6943 (candidates . anything-c-simple-call-tree-candidates)
6944 (persistent-action . anything-c-simple-call-tree-persistent-action)
6945 (persistent-help . "Show function definitions by rotation")
6946 (action ("Find definition selected by persistent-action" .
6947 anything-c-simple-call-tree-find-definition)))
6948 "Needs simple-call-tree.el.
6949 http://www.emacswiki.org/cgi-bin/wiki/download/simple-call-tree.el")
6951 (defun anything-c-simple-call-tree-callers-functions-init ()
6952 (anything-c-simple-call-tree-init-base 'identity " calls \n"))
6954 ;; (anything 'anything-c-source-simple-call-tree-callers-functions)
6956 ;;; Commands/Options with doc
6957 (defvar anything-c-auto-document-data nil)
6958 (make-variable-buffer-local 'anything-c-auto-document-data)
6959 (defvar anything-c-source-commands-and-options-in-file
6960 '((name . "Commands/Options in file")
6961 (header-name
6962 . (lambda (x) (format "Commands/Options in %s"
6963 (buffer-local-value 'buffer-file-name
6964 anything-current-buffer))))
6965 (candidates . anything-command-and-options-candidates)
6966 (multiline)
6967 (action . imenu))
6968 "List Commands and Options with doc. It needs auto-document.el .
6970 http://www.emacswiki.org/cgi-bin/wiki/download/auto-document.el")
6972 (eval-when-compile (require 'auto-document nil t))
6973 (defun anything-command-and-options-candidates ()
6974 (with-current-buffer anything-current-buffer
6975 (when (and (require 'auto-document nil t)
6976 (eq major-mode 'emacs-lisp-mode)
6977 (or (anything-current-buffer-is-modified)
6978 (not anything-c-auto-document-data)))
6979 (or imenu--index-alist (imenu--make-index-alist t))
6980 (setq anything-c-auto-document-data
6981 (destructuring-bind (commands options)
6982 (adoc-construct anything-current-buffer)
6983 (append
6984 (loop for (command . doc) in commands
6985 for cmdname = (symbol-name command)
6986 collect
6987 (cons
6988 (format "Command: %s\n %s"
6989 (propertize cmdname 'face font-lock-function-name-face)
6990 (adoc-first-line doc))
6991 (assoc cmdname imenu--index-alist)))
6992 (loop with var-alist = (cdr (assoc "Variables" imenu--index-alist))
6993 for (option doc default) in options
6994 for optname = (symbol-name option)
6995 collect
6996 (cons
6997 (format "Option: %s\n %s\n default = %s"
6998 (propertize optname 'face font-lock-variable-name-face)
6999 (adoc-first-line doc)
7000 (adoc-prin1-to-string default))
7001 (assoc optname
7002 var-alist)))))))
7003 anything-c-auto-document-data))
7005 ;; (anything 'anything-c-source-commands-and-options-in-file)
7007 ;;;; <Color and Face>
7008 ;;; Customize Face
7009 (defvar anything-c-source-customize-face
7010 '((name . "Customize Face")
7011 (init . (lambda ()
7012 (unless (anything-candidate-buffer)
7013 (save-window-excursion (list-faces-display))
7014 (anything-candidate-buffer (get-buffer "*Faces*")))))
7015 (candidates-in-buffer)
7016 (get-line . buffer-substring)
7017 (action . (lambda (line)
7018 (customize-face (intern (car (split-string line))))))
7019 (requires-pattern . 3))
7020 "See (info \"(emacs)Faces\")")
7021 ;; (anything 'anything-c-source-customize-face)
7023 ;; Color
7024 (defvar anything-c-source-colors
7025 '((name . "Colors")
7026 (init . (lambda () (unless (anything-candidate-buffer)
7027 (save-window-excursion (list-colors-display))
7028 (anything-candidate-buffer (get-buffer "*Colors*")))))
7029 (candidates-in-buffer)
7030 (get-line . buffer-substring)
7031 (action
7032 ("Copy Name" . (lambda (candidate)
7033 (kill-new (anything-c-colors-get-name candidate))))
7034 ("Copy RGB" . (lambda (candidate)
7035 (kill-new (anything-c-colors-get-rgb candidate))))
7036 ("Insert Name" . (lambda (candidate)
7037 (with-current-buffer anything-current-buffer
7038 (insert (anything-c-colors-get-name candidate)))))
7039 ("Insert RGB" . (lambda (candidate)
7040 (with-current-buffer anything-current-buffer
7041 (insert (anything-c-colors-get-rgb candidate))))))))
7042 ;; (anything 'anything-c-source-colors)
7044 (defun anything-c-colors-get-name (candidate)
7045 "Get color name."
7046 (replace-regexp-in-string
7047 " " ""
7048 (with-temp-buffer
7049 (insert (capitalize candidate))
7050 (goto-char (point-min))
7051 (search-forward-regexp "\\s-\\{2,\\}")
7052 (delete-region (point) (point-max))
7053 (buffer-string))))
7055 (defun anything-c-colors-get-rgb (candidate)
7056 "Get color RGB."
7057 (replace-regexp-in-string
7058 " " ""
7059 (with-temp-buffer
7060 (insert (capitalize candidate))
7061 (goto-char (point-max))
7062 (search-backward-regexp "\\s-\\{2,\\}")
7063 (delete-region (point) (point-min))
7064 (buffer-string))))
7066 ;;;; <Search Engine>
7067 ;;; Tracker desktop search
7068 (defvar anything-c-source-tracker-search
7069 '((name . "Tracker Search")
7070 (candidates . (lambda ()
7071 (start-process "tracker-search-process" nil
7072 "tracker-search"
7073 anything-pattern)))
7074 (type . file)
7075 (requires-pattern . 3)
7076 (delayed))
7077 "Source for retrieving files matching the current input pattern
7078 with the tracker desktop search.")
7079 ;; (anything 'anything-c-source-tracker-search)
7081 ;;; Spotlight (MacOS X desktop search)
7082 (defvar anything-c-source-mac-spotlight
7083 '((name . "mdfind")
7084 (candidates
7085 . (lambda () (start-process "mdfind-process" nil "mdfind" anything-pattern)))
7086 (type . file)
7087 (requires-pattern . 3)
7088 (delayed))
7089 "Source for retrieving files via Spotlight's command line
7090 utility mdfind.")
7091 ;; (anything 'anything-c-source-mac-spotlight)
7094 ;;;; <Kill ring>
7095 ;;; Kill ring
7096 (defvar anything-c-source-kill-ring
7097 '((name . "Kill Ring")
7098 (init . (lambda () (anything-attrset 'last-command last-command)))
7099 (candidates . anything-c-kill-ring-candidates)
7100 (action . anything-c-kill-ring-action)
7101 (last-command)
7102 (migemo)
7103 (multiline))
7104 "Source for browse and insert contents of kill-ring.")
7106 (defun anything-c-kill-ring-candidates ()
7107 (loop for kill in kill-ring
7108 unless (or (< (length kill) anything-kill-ring-threshold)
7109 (string-match "^[\\s\\t]+$" kill))
7110 collect kill))
7112 (defun anything-c-kill-ring-action (str)
7113 "Insert STR in `kill-ring' and set STR to the head.
7114 If this action is executed just after `yank',
7115 replace with STR as yanked string."
7116 (setq kill-ring (delete str kill-ring))
7117 (if (not (eq (anything-attr 'last-command) 'yank))
7118 (insert-for-yank str)
7119 ;; from `yank-pop'
7120 (let ((inhibit-read-only t)
7121 (before (< (point) (mark t))))
7122 (if before
7123 (funcall (or yank-undo-function 'delete-region) (point) (mark t))
7124 (funcall (or yank-undo-function 'delete-region) (mark t) (point)))
7125 (setq yank-undo-function nil)
7126 (set-marker (mark-marker) (point) (current-buffer))
7127 (insert-for-yank str)
7128 ;; Set the window start back where it was in the yank command,
7129 ;; if possible.
7130 (set-window-start (selected-window) yank-window-start t)
7131 (if before
7132 ;; This is like exchange-point-and-mark, but doesn't activate the mark.
7133 ;; It is cleaner to avoid activation, even though the command
7134 ;; loop would deactivate the mark because we inserted text.
7135 (goto-char (prog1 (mark t)
7136 (set-marker (mark-marker) (point) (current-buffer)))))))
7137 (kill-new str))
7139 ;; (anything 'anything-c-source-kill-ring)
7141 ;;;; <Mark ring>
7142 ;; DO NOT include these sources in `anything-sources' use
7143 ;; the commands `anything-mark-ring', `anything-global-mark-ring' or
7144 ;; `anything-all-mark-rings' instead.
7146 (defun anything-c-source-mark-ring-candidates ()
7147 (flet ((get-marks (pos)
7148 (save-excursion
7149 (goto-char pos)
7150 (beginning-of-line)
7151 (let ((line (car (split-string (thing-at-point 'line) "[\n\r]"))))
7152 (when (string= "" line)
7153 (setq line "<EMPTY LINE>"))
7154 (format "%7d: %s" (line-number-at-pos) line)))))
7155 (with-current-buffer anything-current-buffer
7156 (loop
7157 with marks = (if (mark) (cons (mark-marker) mark-ring) mark-ring)
7158 with recip = nil
7159 for i in marks
7160 for m = (get-marks i)
7161 unless (member m recip)
7162 collect m into recip
7163 finally return recip))))
7165 (defvar anything-mark-ring-cache nil)
7166 (defvar anything-c-source-mark-ring
7167 '((name . "mark-ring")
7168 (init . (lambda ()
7169 (setq anything-mark-ring-cache
7170 (ignore-errors (anything-c-source-mark-ring-candidates)))))
7171 (candidates . (lambda ()
7172 (anything-aif anything-mark-ring-cache
7173 it)))
7174 (action . (("Goto line"
7175 . (lambda (candidate)
7176 (anything-goto-line (string-to-number candidate))))))
7177 (persistent-action . (lambda (candidate)
7178 (anything-goto-line (string-to-number candidate))
7179 (anything-match-line-color-current-line)))
7180 (persistent-help . "Show this line")))
7182 ;; (anything 'anything-c-source-mark-ring)
7184 ;;;###autoload
7185 (defun anything-mark-ring ()
7186 "Preconfigured `anything' for `anything-c-source-mark-ring'."
7187 (interactive)
7188 (anything 'anything-c-source-mark-ring))
7190 ;;; Global-mark-ring
7191 (defvar anything-c-source-global-mark-ring
7192 '((name . "global-mark-ring")
7193 (candidates . anything-c-source-global-mark-ring-candidates)
7194 (action . (("Goto line"
7195 . (lambda (candidate)
7196 (let ((items (split-string candidate ":")))
7197 (anything-c-switch-to-buffer (second items))
7198 (anything-goto-line (string-to-number (car items))))))))
7199 (persistent-action . (lambda (candidate)
7200 (let ((items (split-string candidate ":")))
7201 (anything-c-switch-to-buffer (second items))
7202 (anything-goto-line (string-to-number (car items)))
7203 (anything-match-line-color-current-line))))
7204 (persistent-help . "Show this line")))
7206 (defun anything-c-source-global-mark-ring-candidates ()
7207 (flet ((buf-fn (m)
7208 (with-current-buffer (marker-buffer m)
7209 (goto-char m)
7210 (beginning-of-line)
7211 (let (line)
7212 (if (string= "" line)
7213 (setq line "<EMPTY LINE>")
7214 (setq line (car (split-string (thing-at-point 'line)
7215 "[\n\r]"))))
7216 (format "%7d:%s: %s"
7217 (line-number-at-pos) (marker-buffer m) line)))))
7218 (loop
7219 with marks = global-mark-ring
7220 with recip = nil
7221 for i in marks
7222 for gm = (unless (or (string-match
7223 "^ " (format "%s" (marker-buffer i)))
7224 (null (marker-buffer i)))
7225 (buf-fn i))
7226 when (and gm (not (member gm recip)))
7227 collect gm into recip
7228 finally return recip)))
7230 ;; (anything 'anything-c-source-global-mark-ring)
7232 ;;;###autoload
7233 (defun anything-global-mark-ring ()
7234 "Preconfigured `anything' for `anything-c-source-global-mark-ring'."
7235 (interactive)
7236 (anything 'anything-c-source-global-mark-ring))
7238 ;;;###autoload
7239 (defun anything-all-mark-rings ()
7240 "Preconfigured `anything' for `anything-c-source-global-mark-ring' and \
7241 `anything-c-source-mark-ring'."
7242 (interactive)
7243 (anything '(anything-c-source-mark-ring
7244 anything-c-source-global-mark-ring)))
7246 ;;;; <Register>
7247 ;;; Insert from register
7248 (defvar anything-c-source-register
7249 '((name . "Registers")
7250 (candidates . anything-c-register-candidates)
7251 (action-transformer . anything-c-register-action-transformer)
7252 (multiline)
7253 (action))
7254 "See (info \"(emacs)Registers\")")
7256 (defun anything-c-register-candidates ()
7257 "Collecting register contents and appropriate commands."
7258 (loop for (char . val) in register-alist
7259 for key = (single-key-description char)
7260 for string-actions =
7261 (cond
7262 ((numberp val)
7263 (list (int-to-string val)
7264 'insert-register
7265 'increment-register))
7266 ((markerp val)
7267 (let ((buf (marker-buffer val)))
7268 (if (null buf)
7269 (list "a marker in no buffer")
7270 (list (concat
7271 "a buffer position:"
7272 (buffer-name buf)
7273 ", position "
7274 (int-to-string (marker-position val)))
7275 'jump-to-register
7276 'insert-register))))
7277 ((and (consp val) (window-configuration-p (car val)))
7278 (list "window configuration."
7279 'jump-to-register))
7280 ((and (consp val) (frame-configuration-p (car val)))
7281 (list "frame configuration."
7282 'jump-to-register))
7283 ((and (consp val) (eq (car val) 'file))
7284 (list (concat "file:"
7285 (prin1-to-string (cdr val))
7286 ".")
7287 'jump-to-register))
7288 ((and (consp val) (eq (car val) 'file-query))
7289 (list (concat "file:a file-query reference: file "
7290 (car (cdr val))
7291 ", position "
7292 (int-to-string (car (cdr (cdr val))))
7293 ".")
7294 'jump-to-register))
7295 ((consp val)
7296 (let ((lines (format "%4d" (length val))))
7297 (list (format "%s: %s\n" lines
7298 (truncate-string-to-width
7299 (mapconcat 'identity (list (car val))
7300 ;; (mapconcat (lambda (y) y) val
7301 "^J") (- (window-width) 15)))
7302 'insert-register)))
7303 ((stringp val)
7304 (list ;; without properties
7305 (substring-no-properties val)
7306 'insert-register
7307 'append-to-register
7308 'prepend-to-register))
7310 "GARBAGE!"))
7311 collect (cons (format "register %3s: %s" key (car string-actions))
7312 (cons char (cdr string-actions)))))
7314 (defun anything-c-register-action-transformer (actions register-and-functions)
7315 "Decide actions by the contents of register."
7316 (loop with func-actions =
7317 '((insert-register
7318 "Insert Register" .
7319 (lambda (c) (insert-register (car c))))
7320 (jump-to-register
7321 "Jump to Register" .
7322 (lambda (c) (jump-to-register (car c))))
7323 (append-to-register
7324 "Append Region to Register" .
7325 (lambda (c) (append-to-register
7326 (car c) (region-beginning) (region-end))))
7327 (prepend-to-register
7328 "Prepend Region to Register" .
7329 (lambda (c) (prepend-to-register
7330 (car c) (region-beginning) (region-end))))
7331 (increment-register
7332 "Increment Prefix Arg to Register" .
7333 (lambda (c) (increment-register
7334 anything-current-prefix-arg (car c)))))
7335 for func in (cdr register-and-functions)
7336 for cell = (assq func func-actions)
7337 when cell
7338 collect (cdr cell)))
7340 ;; (anything 'anything-c-source-register)
7342 ;;; Latex completion
7343 (defun anything-c-latex-math-candidates ()
7344 "Collect candidates for latex math completion."
7345 (loop for i in (cddr LaTeX-math-menu)
7346 for elm = (loop for s in i when (vectorp s)
7347 collect (cons (aref s 0) (aref s 1)))
7348 append elm))
7350 (defvar anything-c-source-latex-math
7351 '((name . "Latex Math Menu")
7352 (init . (lambda ()
7353 (with-current-buffer anything-current-buffer
7354 (LaTeX-math-mode 1))))
7355 (candidate-number-limit . 9999)
7356 (candidates . anything-c-latex-math-candidates)
7357 (action . (lambda (candidate)
7358 (call-interactively candidate)))))
7360 ;;;; <Headline Extraction>
7361 (defvar anything-c-source-fixme
7362 '((name . "TODO/FIXME/DRY comments")
7363 (headline . "^.*\\<\\(TODO\\|FIXME\\|DRY\\)\\>.*$")
7364 (adjust)
7365 (recenter))
7366 "Show TODO/FIXME/DRY comments in current file.")
7367 ;; (anything 'anything-c-source-fixme)
7369 (defvar anything-c-source-rd-headline
7370 '((name . "RD HeadLine")
7371 (headline "^= \\(.+\\)$" "^== \\(.+\\)$" "^=== \\(.+\\)$" "^==== \\(.+\\)$")
7372 (condition . (memq major-mode '(rdgrep-mode rd-mode)))
7373 (migemo)
7374 (subexp . 1))
7375 "Show RD headlines.
7377 RD is Ruby's POD.
7378 http://en.wikipedia.org/wiki/Ruby_Document_format")
7379 ;; (anything 'anything-c-source-rd-headline)
7381 (defvar anything-c-source-oddmuse-headline
7382 '((name . "Oddmuse HeadLine")
7383 (headline "^= \\(.+\\) =$" "^== \\(.+\\) ==$"
7384 "^=== \\(.+\\) ===$" "^==== \\(.+\\) ====$")
7385 (condition . (memq major-mode '(oddmuse-mode yaoddmuse-mode)))
7386 (migemo)
7387 (subexp . 1))
7388 "Show Oddmuse headlines, such as EmacsWiki.")
7389 ;; (anything 'anything-c-source-oddmuse-headline)
7391 (defvar anything-c-source-emacs-source-defun
7392 '((name . "Emacs Source DEFUN")
7393 (headline . "DEFUN\\|DEFVAR")
7394 (condition . (string-match "/emacs2[0-9].+/src/.+c$"
7395 (or buffer-file-name ""))))
7396 "Show DEFUN/DEFVAR in Emacs C source file.")
7397 ;; (anything 'anything-c-source-emacs-source-defun)
7399 (defvar anything-c-source-emacs-lisp-expectations
7400 '((name . "Emacs Lisp Expectations")
7401 (headline . "(desc[ ]\\|(expectations")
7402 (condition . (eq major-mode 'emacs-lisp-mode)))
7403 "Show descriptions (desc) in Emacs Lisp Expectations.
7405 http://www.emacswiki.org/cgi-bin/wiki/download/el-expectations.el")
7406 ;; (anything 'anything-c-source-emacs-lisp-expectations)
7408 (defvar anything-c-source-emacs-lisp-toplevels
7409 '((name . "Emacs Lisp Toplevel / Level 4 Comment / Linkd Star")
7410 (headline . "^(\\|(@\\*\\|^;;;;")
7411 (get-line . buffer-substring)
7412 (condition . (eq major-mode 'emacs-lisp-mode))
7413 (adjust))
7414 "Show top-level forms, level 4 comments and linkd stars (optional) in Emacs Lisp.
7415 linkd.el is optional because linkd stars are extracted by regexp.
7416 http://www.emacswiki.org/cgi-bin/wiki/download/linkd.el")
7417 ;; (anything 'anything-c-source-emacs-lisp-toplevels)
7419 (defvar anything-c-source-org-headline
7420 '((name . "Org HeadLine")
7421 (headline
7422 "^\\* \\(.+?\\)\\([ \t]*:[a-zA-Z0-9_@:]+:\\)?[ \t]*$"
7423 "^\\*\\* \\(.+?\\)\\([ \t]*:[a-zA-Z0-9_@:]+:\\)?[ \t]*$"
7424 "^\\*\\*\\* \\(.+?\\)\\([ \t]*:[a-zA-Z0-9_@:]+:\\)?[ \t]*$"
7425 "^\\*\\*\\*\\* \\(.+?\\)\\([ \t]*:[a-zA-Z0-9_@:]+:\\)?[ \t]*$"
7426 "^\\*\\*\\*\\*\\* \\(.+?\\)\\([ \t]*:[a-zA-Z0-9_@:]+:\\)?[ \t]*$"
7427 "^\\*\\*\\*\\*\\*\\* \\(.+?\\)\\([ \t]*:[a-zA-Z0-9_@:]+:\\)?[ \t]*$"
7428 "^\\*\\*\\*\\*\\*\\*\\* \\(.+?\\)\\([ \t]*:[a-zA-Z0-9_@:]+:\\)?[ \t]*$"
7429 "^\\*\\*\\*\\*\\*\\*\\*\\* \\(.+?\\)\\([ \t]*:[a-zA-Z0-9_@:]+:\\)?[ \t]*$")
7430 (condition . (eq major-mode 'org-mode))
7431 (migemo)
7432 (subexp . 1)
7433 (persistent-action . (lambda (elm)
7434 (anything-c-action-line-goto elm)
7435 (org-cycle)))
7436 (action-transformer
7437 . (lambda (actions candidate)
7438 '(("Go to Line" . anything-c-action-line-goto)
7439 ("Insert Link to This Headline" . anything-c-org-headline-insert-link-to-headline)))))
7440 "Show Org headlines.
7441 org-mode is very very much extended text-mode/outline-mode.
7443 See (find-library \"org.el\")
7444 See http://orgmode.org for the latest version.")
7446 (defun anything-c-org-headline-insert-link-to-headline (lineno-and-content)
7447 (insert
7448 (save-excursion
7449 (anything-goto-line (car lineno-and-content))
7450 (and (looking-at org-complex-heading-regexp)
7451 (org-make-link-string (concat "*" (match-string 4)))))))
7453 ;; (anything 'anything-c-source-org-headline)
7455 ;;; Anything yaoddmuse
7456 ;; Be sure to have yaoddmuse.el installed
7457 ;; install-elisp may be required if you want to install elisp file from here.
7458 (defvar anything-yaoddmuse-use-cache-file nil)
7459 (defvar anything-c-yaoddmuse-cache-file "~/.emacs.d/yaoddmuse-cache.el")
7460 (defvar anything-c-yaoddmuse-ew-cache nil)
7461 (defvar anything-c-source-yaoddmuse-emacswiki-edit-or-view
7462 '((name . "Yaoddmuse Edit or View (EmacsWiki)")
7463 (candidates . (lambda ()
7464 (if anything-yaoddmuse-use-cache-file
7465 (ignore-errors
7466 (unless anything-c-yaoddmuse-ew-cache
7467 (load anything-c-yaoddmuse-cache-file)
7468 (setq anything-c-yaoddmuse-ew-cache
7469 (gethash "EmacsWiki" yaoddmuse-pages-hash)))
7470 anything-c-yaoddmuse-ew-cache)
7471 (yaoddmuse-update-pagename t)
7472 (gethash "EmacsWiki" yaoddmuse-pages-hash))))
7473 (action . (("Edit page" . (lambda (candidate)
7474 (yaoddmuse-edit "EmacsWiki" candidate)))
7475 ("Browse page" . (lambda (candidate)
7476 (yaoddmuse-browse-page "EmacsWiki" candidate)))
7477 ("Browse page other window" . (lambda (candidate)
7478 (if (one-window-p)
7479 (split-window-vertically))
7480 (yaoddmuse-browse-page "EmacsWiki" candidate)))
7481 ("Browse diff" . (lambda (candidate)
7482 (yaoddmuse-browse-page-diff "EmacsWiki" candidate)))
7483 ("Copy URL" . (lambda (candidate)
7484 (kill-new (yaoddmuse-url "EmacsWiki" candidate))
7485 (message "Have copy page %s's URL to yank." candidate)))
7486 ("Create page" . (lambda (candidate)
7487 (yaoddmuse-edit "EmacsWiki" anything-input)))
7488 ("Update cache" . (lambda (candidate)
7489 (if anything-yaoddmuse-use-cache-file
7490 (progn
7491 (anything-yaoddmuse-cache-pages t)
7492 (setq anything-c-yaoddmuse-ew-cache
7493 (gethash "EmacsWiki" yaoddmuse-pages-hash)))
7494 (yaoddmuse-update-pagename))))))
7495 (action-transformer anything-c-yaoddmuse-action-transformer))
7496 "Needs yaoddmuse.el.
7498 http://www.emacswiki.org/emacs/download/yaoddmuse.el")
7500 ;; (anything 'anything-c-source-yaoddmuse-emacswiki-edit-or-view)
7502 (defvar anything-c-source-yaoddmuse-emacswiki-post-library
7503 '((name . "Yaoddmuse Post library (EmacsWiki)")
7504 (init . (anything-yaoddmuse-init))
7505 (candidates-in-buffer)
7506 (action . (("Post library and Browse" . (lambda (candidate)
7507 (yaoddmuse-post-file (find-library-name candidate)
7508 "EmacsWiki"
7509 (file-name-nondirectory (find-library-name candidate))
7510 nil t)))
7511 ("Post library" . (lambda (candidate)
7512 (yaoddmuse-post-file (find-library-name candidate)
7513 "EmacsWiki"
7514 (file-name-nondirectory (find-library-name candidate))))))))
7515 "Needs yaoddmuse.el.
7517 http://www.emacswiki.org/emacs/download/yaoddmuse.el")
7519 ;; (anything 'anything-c-source-yaoddmuse-emacswiki-post-library)
7521 (defun anything-c-yaoddmuse-action-transformer (actions candidate)
7522 "Allow the use of `install-elisp' only on elisp files."
7523 (if (string-match "\.el$" candidate)
7524 (append actions '(("Install Elisp" . (lambda (elm)
7525 (install-elisp-from-emacswiki elm)))))
7526 actions))
7528 ;;;###autoload
7529 (defun anything-yaoddmuse-cache-pages (&optional load)
7530 "Fetch the list of files on emacswiki and create cache file.
7531 If load is non--nil load the file and feed `yaoddmuse-pages-hash'."
7532 (interactive)
7533 (yaoddmuse-update-pagename)
7534 (save-excursion
7535 (find-file anything-c-yaoddmuse-cache-file)
7536 (erase-buffer)
7537 (insert "(puthash \"EmacsWiki\" '(")
7538 (loop for i in (gethash "EmacsWiki" yaoddmuse-pages-hash)
7540 (insert (concat "(\"" (car i) "\") ")))
7541 (insert ") yaoddmuse-pages-hash)\n")
7542 (save-buffer)
7543 (kill-buffer (current-buffer))
7544 (when (or current-prefix-arg
7545 load)
7546 (load anything-c-yaoddmuse-cache-file))))
7548 ;;;###autoload
7549 (defun anything-yaoddmuse-emacswiki-edit-or-view ()
7550 "Preconfigured `anything' to edit or view EmacsWiki page.
7552 Needs yaoddmuse.el.
7554 http://www.emacswiki.org/emacs/download/yaoddmuse.el"
7555 (interactive)
7556 (anything 'anything-c-source-yaoddmuse-emacswiki-edit-or-view))
7558 ;;;###autoload
7559 (defun anything-yaoddmuse-emacswiki-post-library ()
7560 "Preconfigured `anything' to post library to EmacsWiki.
7562 Needs yaoddmuse.el.
7564 http://www.emacswiki.org/emacs/download/yaoddmuse.el"
7565 (interactive)
7566 (anything 'anything-c-source-yaoddmuse-emacswiki-post-library))
7568 (defun anything-yaoddmuse-init ()
7569 "Init anything buffer status."
7570 (let ((anything-buffer (anything-candidate-buffer 'global))
7571 (library-list (yaoddmuse-get-library-list)))
7572 (with-current-buffer anything-buffer
7573 ;; Insert library name.
7574 (dolist (library library-list)
7575 (insert (format "%s\n" library)))
7576 ;; Sort lines.
7577 (sort-lines nil (point-min) (point-max)))))
7579 ;;; Eev anchors
7580 (defvar anything-c-source-eev-anchor
7581 '((name . "Anchors")
7582 (candidates
7583 . (lambda ()
7584 (ignore-errors
7585 (with-current-buffer anything-current-buffer
7586 (loop initially (goto-char (point-min))
7587 while (re-search-forward (format ee-anchor-format "\\([^\.].+\\)") nil t)
7588 for anchor = (match-string-no-properties 1)
7589 collect (cons (format "%5d:%s"
7590 (line-number-at-pos (match-beginning 0))
7591 (format ee-anchor-format anchor)) anchor))))))
7592 (persistent-action . (lambda (item)
7593 (ee-to item)
7594 (anything-match-line-color-current-line)))
7595 (persistent-help . "Show this entry")
7596 (action . (("Goto link" . ee-to)))))
7597 ;; (anything 'anything-c-source-eev-anchor)
7599 ;;;; <Misc>
7600 ;;; Org keywords
7601 (defvar anything-c-source-org-keywords
7602 '((name . "Org Keywords")
7603 (init . anything-c-org-keywords-init)
7604 (candidates . anything-c-org-keywords-candidates)
7605 (action . anything-c-org-keywords-insert)
7606 (persistent-action . anything-c-org-keywords-show-help)
7607 (persistent-help . "Show an example and info page to describe this keyword.")
7608 (keywords-examples)
7609 (keywords)))
7610 ;; (anything 'anything-c-source-org-keywords)
7611 (defvar anything-c-org-keywords-info-location
7612 '(("#+TITLE:" . "(org)Export options")
7613 ("#+AUTHOR:" . "(org)Export options")
7614 ("#+DATE:" . "(org)Export options")
7615 ("#+EMAIL:" . "(org)Export options")
7616 ("#+DESCRIPTION:" . "(org)Export options")
7617 ("#+KEYWORDS:" . "(org)Export options")
7618 ("#+LANGUAGE:" . "(org)Export options")
7619 ("#+TEXT:" . "(org)Export options")
7620 ("#+TEXT:" . "(org)Export options")
7621 ("#+OPTIONS:" . "(org)Export options")
7622 ("#+BIND:" . "(org)Export options")
7623 ("#+LINK_UP:" . "(org)Export options")
7624 ("#+LINK_HOME:" . "(org)Export options")
7625 ("#+LATEX_HEADER:" . "(org)Export options")
7626 ("#+EXPORT_SELECT_TAGS:" . "(org)Export options")
7627 ("#+EXPORT_EXCLUDE_TAGS:" . "(org)Export options")
7628 ("#+INFOJS_OPT" . "(org)Javascript support")
7629 ("#+BEGIN_HTML" . "(org)Quoting HTML tags")
7630 ("#+BEGIN_LaTeX" . "(org)Quoting LaTeX code")
7631 ("#+ORGTBL" . "(org)Radio tables")
7632 ("#+HTML:" . "(org)Quoting HTML tags")
7633 ("#+LaTeX:" . "(org)Quoting LaTeX code")
7634 ("#+BEGIN:" . "(org)Dynamic blocks") ;clocktable columnview
7635 ("#+BEGIN_EXAMPLE" . "(org)Literal examples")
7636 ("#+BEGIN_QUOTE" . "(org)Paragraphs")
7637 ("#+BEGIN_VERSE" . "(org)Paragraphs")
7638 ("#+BEGIN_SRC" . "(org)Literal examples")
7639 ("#+CAPTION" . "(org)Tables in HTML export")
7640 ("#+LABEL" . "(org)Tables in LaTeX export")
7641 ("#+ATTR_HTML" . "(org)Links")
7642 ("#+ATTR_LaTeX" . "(org)Images in LaTeX export")))
7644 (defun anything-c-org-keywords-init ()
7645 (unless (anything-attr 'keywords-examples)
7646 (require 'org)
7647 (anything-attrset 'keywords-examples
7648 (append
7649 (mapcar
7650 (lambda (x)
7651 (string-match "^#\\+\\(\\([A-Z_]+:?\\).*\\)" x)
7652 (cons (match-string 2 x) (match-string 1 x)))
7653 (org-split-string (org-get-current-options) "\n"))
7654 (mapcar 'list org-additional-option-like-keywords)))
7655 (anything-attrset 'keywords (mapcar 'car (anything-attr 'keywords-examples)))))
7657 (defun anything-c-org-keywords-candidates ()
7658 (and (or (eq (buffer-local-value 'major-mode anything-current-buffer) 'org-mode)
7659 (eq (buffer-local-value 'major-mode anything-current-buffer) 'message-mode))
7660 (anything-attr 'keywords)))
7662 (defun anything-c-org-keywords-insert (keyword)
7663 (cond ((and (string-match "BEGIN" keyword)
7664 (anything-region-active-p))
7665 (let ((beg (region-beginning))
7666 (end (region-end)))
7667 (goto-char end)
7668 (insert "\n#+" (replace-regexp-in-string
7669 "BEGIN" "END" keyword) "\n")
7670 (goto-char beg)
7671 (insert "#+" keyword " ")
7672 (save-excursion (insert "\n"))))
7673 ((string-match "BEGIN" keyword)
7674 (insert "#+" keyword " ")
7675 (save-excursion
7676 (insert "\n#+" (replace-regexp-in-string
7677 "BEGIN" "END" keyword) "\n")))
7678 (t (insert "#+" keyword " "))))
7680 (defun anything-c-org-keywords-show-help (keyword)
7681 (info (or (assoc-default (concat "#+" keyword) anything-c-org-keywords-info-location)
7682 "(org)In-buffer settings"))
7683 (search-forward (concat "#+" keyword) nil t)
7684 (anything-persistent-highlight-point)
7685 (message "%s" (or (cdr (assoc keyword (anything-attr 'keywords-examples))) "")))
7688 ;;; Picklist
7689 (defvar anything-c-source-picklist
7690 '((name . "Picklist")
7691 (candidates . (lambda () (mapcar 'car picklist-list)))
7692 (type . file)))
7693 ;; (anything 'anything-c-source-picklist)
7695 ;;; BBDB
7696 (defvar bbdb-records)
7697 (defvar bbdb-buffer-name)
7698 (declare-function bbdb "ext:bbdb-com")
7699 (declare-function bbdb-current-record "ext:bbdb-com")
7700 (declare-function bbdb-redisplay-one-record "ext:bbdb-com")
7701 (declare-function bbdb-record-net "ext:bbdb-com" (string) t)
7702 (declare-function bbdb-current-record "ext:bbdb-com")
7703 (declare-function bbdb-dwim-net-address "ext:bbdb-com")
7704 (declare-function bbdb-records "ext:bbdb-com"
7705 (&optional dont-check-disk already-in-db-buffer))
7707 (defun anything-c-bbdb-candidates ()
7708 "Return a list of all names in the bbdb database. The format
7709 is \"Firstname Lastname\"."
7710 (mapcar (lambda (bbdb-record)
7711 (replace-regexp-in-string
7712 "\\s-+$" ""
7713 (concat (aref bbdb-record 0) " " (aref bbdb-record 1))))
7714 (bbdb-records)))
7716 (defun anything-c-bbdb-create-contact (actions candidate)
7717 "Action transformer that returns only an entry to add the
7718 current `anything-pattern' as new contact. All other actions are
7719 removed."
7720 (if (string= candidate "*Add to contacts*")
7721 '(("Add to contacts" . (lambda (actions)
7722 (bbdb-create-internal
7723 (read-from-minibuffer "Name: " anything-c-bbdb-name)
7724 (read-from-minibuffer "Company: ")
7725 (read-from-minibuffer "Email: ")
7728 (read-from-minibuffer "Note: ")))))
7729 actions))
7731 (defun anything-c-bbdb-get-record (candidate)
7732 "Return record that match CANDIDATE."
7733 (bbdb candidate nil)
7734 (set-buffer "*BBDB*")
7735 (bbdb-current-record))
7737 (defvar anything-c-bbdb-name nil
7738 "Only for internal use.")
7740 (defvar anything-c-source-bbdb
7741 '((name . "BBDB")
7742 (candidates . anything-c-bbdb-candidates)
7743 (action ("Send a mail" . anything-c-bbdb-compose-mail)
7744 ("View person's data" . anything-c-bbdb-view-person-action))
7745 (filtered-candidate-transformer . (lambda (candidates source)
7746 (setq anything-c-bbdb-name anything-pattern)
7747 (if (not candidates)
7748 (list "*Add to contacts*")
7749 candidates)))
7750 (action-transformer . (lambda (actions candidate)
7751 (anything-c-bbdb-create-contact actions candidate))))
7752 "Needs BBDB.
7754 http://bbdb.sourceforge.net/")
7755 ;; (anything 'anything-c-source-bbdb)
7757 (defun anything-c-bbdb-view-person-action (candidate)
7758 "View BBDB data of single CANDIDATE or marked candidates."
7759 (anything-aif (anything-marked-candidates)
7760 (let ((bbdb-append-records (length it)))
7761 (dolist (i it)
7762 (bbdb-redisplay-one-record (anything-c-bbdb-get-record i))))
7763 (bbdb-redisplay-one-record (anything-c-bbdb-get-record candidate))))
7765 (defun anything-c-bbdb-collect-mail-addresses ()
7766 "Return a list of all mail addresses of records in bbdb buffer."
7767 (with-current-buffer bbdb-buffer-name
7768 (loop for i in bbdb-records
7769 if (bbdb-record-net (car i))
7770 collect (bbdb-dwim-net-address (car i)))))
7772 (defun anything-c-bbdb-compose-mail (candidate)
7773 "Compose a mail with all records of bbdb buffer."
7774 (anything-c-bbdb-view-person-action candidate)
7775 (let* ((address-list (anything-c-bbdb-collect-mail-addresses))
7776 (address-str (mapconcat 'identity address-list ",\n ")))
7777 (compose-mail address-str)))
7779 ;;; Evaluation Result
7780 (defvar anything-c-source-evaluation-result
7781 '((name . "Evaluation Result")
7782 (disable-shortcuts)
7783 (dummy)
7784 (multiline)
7785 (mode-line . "C-RET: nl-and-indent, tab: reindent, C-tab:complete, C-p/n: next/prec-line.")
7786 (filtered-candidate-transformer . (lambda (candidates source)
7787 (list
7788 (condition-case nil
7789 (with-current-buffer anything-current-buffer
7790 (pp-to-string
7791 (eval (read anything-pattern))))
7792 (error "Error")))))
7793 (action . (("Copy result to kill-ring" . (lambda (candidate)
7794 (with-current-buffer anything-buffer
7795 (let ((end (save-excursion
7796 (goto-char (point-max))
7797 (search-backward "\n")
7798 (point))))
7799 (kill-region (point) end)))))
7800 ("copy sexp to kill-ring" . (lambda (candidate)
7801 (kill-new anything-input)))))))
7802 ;; (anything 'anything-c-source-evaluation-result)
7804 ;;;###autoload
7805 (defun anything-eval-expression (arg)
7806 "Preconfigured anything for `anything-c-source-evaluation-result'."
7807 (interactive "P")
7808 (anything :sources 'anything-c-source-evaluation-result
7809 :input (when arg (thing-at-point 'sexp))
7810 :buffer "*anything eval*"
7811 :keymap anything-eval-expression-map))
7813 (defun anything-eval-new-line-and-indent ()
7814 (interactive)
7815 (newline) (lisp-indent-line))
7817 (defvar anything-eval-expression-map
7818 (let ((map (copy-keymap anything-map)))
7819 (define-key map (kbd "<C-return>") 'anything-eval-new-line-and-indent)
7820 (define-key map (kbd "<tab>") 'lisp-indent-line)
7821 (define-key map (kbd "<C-tab>") 'lisp-complete-symbol)
7822 (define-key map (kbd "C-p") 'previous-line)
7823 (define-key map (kbd "C-n") 'next-line)
7824 (define-key map (kbd "<up>") 'previous-line)
7825 (define-key map (kbd "<down>") 'next-line)
7826 (define-key map (kbd "<right>") 'forward-char)
7827 (define-key map (kbd "<left>") 'backward-char)
7828 map))
7830 (defvar anything-eldoc-active-minibuffers-list nil)
7831 (defun anything-eldoc-store-minibuffer ()
7832 "Store minibuffer buffer name in `anything-eldoc-active-minibuffers-list'."
7833 (with-selected-window (minibuffer-window)
7834 (push (buffer-name) anything-eldoc-active-minibuffers-list)))
7836 ;;;###autoload
7837 (defun anything-eval-expression-with-eldoc ()
7838 "Preconfigured anything for `anything-c-source-evaluation-result' with `eldoc' support. "
7839 (interactive)
7840 (let ((timer (run-with-idle-timer eldoc-idle-delay
7841 'repeat 'anything-eldoc-show-in-eval))
7842 (minibuffer-completing-symbol t) ; Enable lisp completion.
7843 (completion-cycle-threshold t)) ; Always cycle, no pesty completion buffer (emacs24 only).
7844 (unwind-protect
7845 (minibuffer-with-setup-hook
7846 'anything-eldoc-store-minibuffer
7847 (call-interactively 'anything-eval-expression))
7848 (and timer (cancel-timer timer))
7849 (setq anything-eldoc-active-minibuffers-list
7850 (cdr anything-eldoc-active-minibuffers-list)))))
7852 (defun anything-eldoc-show-in-eval ()
7853 "Return eldoc in mode-line for current minibuffer input."
7854 (let ((buf (with-selected-window (minibuffer-window)
7855 (buffer-name))))
7856 (when (member buf anything-eldoc-active-minibuffers-list)
7857 (let* ((str-all (with-current-buffer buf
7858 (minibuffer-completion-contents)))
7859 (sym (when str-all
7860 (with-temp-buffer
7861 (insert str-all)
7862 (goto-char (point-max))
7863 (unless (looking-back ")\\|\"") (forward-char -1))
7864 (eldoc-current-symbol))))
7865 (info-fn (eldoc-fnsym-in-current-sexp))
7866 (doc (or (eldoc-get-var-docstring sym)
7867 (eldoc-get-fnsym-args-string
7868 (car info-fn) (cadr info-fn)))))
7869 (when doc (funcall anything-c-eldoc-in-minibuffer-show-fn doc))))))
7871 (defvar anything-c-eldoc-show-in-mode-line-delay 12)
7872 (defun anything-c-eldoc-show-in-mode-line (str)
7873 "Show string STR in mode-line."
7874 (save-window-excursion
7875 (with-current-buffer anything-buffer
7876 (let ((mode-line-format (concat " " str)))
7877 (force-mode-line-update)
7878 (sit-for anything-c-eldoc-show-in-mode-line-delay))
7879 (force-mode-line-update))))
7881 ;;; Calculation Result
7882 (defvar anything-c-source-calculation-result
7883 '((name . "Calculation Result")
7884 (dummy)
7885 (filtered-candidate-transformer . (lambda (candidates source)
7886 (list
7887 (condition-case nil
7888 (calc-eval anything-pattern)
7889 (error "error")))))
7890 (action ("Copy result to kill-ring" . kill-new))))
7891 ;; (anything 'anything-c-source-calculation-result)
7893 ;;;###autoload
7894 (defun anything-calcul-expression ()
7895 "Preconfigured anything for `anything-c-source-calculation-result'."
7896 (interactive)
7897 (anything-other-buffer 'anything-c-source-calculation-result "*anything calcul*"))
7899 ;;; Google Suggestions
7900 (defvar anything-ggs-max-length-real-flag 0)
7901 (defvar anything-ggs-max-length-num-flag 0)
7902 (defun anything-c-google-suggest-fetch (input)
7903 "Fetch suggestions for INPUT from XML buffer.
7904 Return an alist with elements like (data . number_results)."
7905 (setq anything-ggs-max-length-real-flag 0
7906 anything-ggs-max-length-num-flag 0)
7907 (let ((request (concat anything-c-google-suggest-url
7908 (url-hexify-string input))))
7909 (flet ((fetch ()
7910 (loop
7911 with result-alist = (xml-get-children
7912 (car (xml-parse-region
7913 (point-min) (point-max)))
7914 'CompleteSuggestion)
7915 for i in result-alist
7916 for data = (cdr (caadr (assoc 'suggestion i)))
7917 for nqueries = (cdr (caadr (assoc 'num_queries i)))
7918 for lqueries = (length (anything-c-ggs-set-number-result
7919 nqueries))
7920 for ldata = (length data)
7922 (progn
7923 (when (> ldata anything-ggs-max-length-real-flag)
7924 (setq anything-ggs-max-length-real-flag ldata))
7925 (when (> lqueries anything-ggs-max-length-num-flag)
7926 (setq anything-ggs-max-length-num-flag lqueries)))
7927 collect (cons data nqueries) into cont
7928 finally return cont)))
7929 (if anything-google-suggest-use-curl-p
7930 (with-temp-buffer
7931 (call-process "curl" nil t nil request)
7932 (fetch))
7933 (with-current-buffer
7934 (url-retrieve-synchronously request)
7935 (fetch))))))
7937 (defun anything-c-google-suggest-set-candidates (&optional request-prefix)
7938 "Set candidates with result and number of google results found."
7939 (let ((suggestions
7940 (loop with suggested-results = (anything-c-google-suggest-fetch
7941 (or (and request-prefix
7942 (concat request-prefix " " anything-pattern))
7943 anything-pattern))
7944 for (real . numresult) in suggested-results
7945 ;; Prepare number of results with ","
7946 for fnumresult = (anything-c-ggs-set-number-result numresult)
7947 ;; Calculate number of spaces to add before fnumresult
7948 ;; if it is smaller than longest result
7949 ;; `anything-ggs-max-length-num-flag'.
7950 ;; e.g 1,234,567
7951 ;; 345,678
7952 ;; To be sure it is aligned properly.
7953 for nspaces = (if (< (length fnumresult) anything-ggs-max-length-num-flag)
7954 (- anything-ggs-max-length-num-flag (length fnumresult))
7956 ;; Add now the spaces before fnumresult.
7957 for align-fnumresult = (concat (make-string nspaces ? ) fnumresult)
7958 for interval = (- anything-ggs-max-length-real-flag (length real))
7959 for spaces = (make-string (+ 2 interval) ? )
7960 for display = (format "%s%s(%s results)" real spaces align-fnumresult)
7961 collect (cons display real))))
7962 (if (loop for (disp . dat) in suggestions
7963 thereis (equal dat anything-pattern))
7964 suggestions
7965 ;; if there is no suggestion exactly matching the input then
7966 ;; prepend a Search on Google item to the list
7967 (append
7968 suggestions
7969 (list (cons (concat "Search for " "'" anything-input "'" " on Google")
7970 anything-input))))))
7972 (defun anything-c-ggs-set-number-result (num)
7973 (if num
7974 (progn
7975 (and (numberp num) (setq num (number-to-string num)))
7976 (loop for i in (reverse (split-string num "" t))
7977 for count from 1
7978 append (list i) into C
7979 when (= count 3)
7980 append (list ",") into C
7981 and do (setq count 0)
7982 finally return
7983 (replace-regexp-in-string
7984 "^," "" (mapconcat 'identity (reverse C) ""))))
7985 "?"))
7987 (defvar anything-c-google-suggest-default-browser-function nil
7988 "*The browse url function you prefer to use with google suggest.
7989 When nil, use the first browser function available
7990 See `anything-browse-url-default-browser-alist'.")
7992 (defun anything-c-google-suggest-action (candidate)
7993 "Default action to jump to a google suggested candidate."
7994 (let ((arg (concat anything-c-google-suggest-search-url
7995 (url-hexify-string candidate))))
7996 (anything-aif anything-c-google-suggest-default-browser-function
7997 (funcall it arg)
7998 (anything-c-browse-url arg))))
8000 (defvar anything-c-google-suggest-default-function
8001 'anything-c-google-suggest-set-candidates
8002 "Default function to use in anything google suggest.")
8004 (defvar anything-c-source-google-suggest
8005 '((name . "Google Suggest")
8006 (candidates . (lambda ()
8007 (funcall anything-c-google-suggest-default-function)))
8008 (action . (("Google Search" . anything-c-google-suggest-action)))
8009 (volatile)
8010 (requires-pattern . 3)
8011 (delayed)))
8013 (defun anything-c-google-suggest-emacs-lisp ()
8014 "Try to emacs lisp complete with google suggestions."
8015 (anything-c-google-suggest-set-candidates "emacs lisp"))
8017 ;; (anything 'anything-c-source-google-suggest)
8019 ;;; Yahoo suggestions
8021 (defun anything-c-yahoo-suggest-fetch (input)
8022 "Fetch Yahoo suggestions for INPUT from XML buffer.
8023 Return an alist with elements like (data . number_results)."
8024 (let ((request (concat anything-c-yahoo-suggest-url
8025 (url-hexify-string input))))
8026 (flet ((fetch ()
8027 (loop
8028 with result-alist = (xml-get-children
8029 (car (xml-parse-region (point-min) (point-max)))
8030 'Result)
8031 for i in result-alist
8032 collect (caddr i))))
8033 (with-current-buffer
8034 (url-retrieve-synchronously request)
8035 (fetch)))))
8037 (defun anything-c-yahoo-suggest-set-candidates ()
8038 "Set candidates with Yahoo results found."
8039 (let ((suggestions (anything-c-yahoo-suggest-fetch anything-input)))
8040 (or suggestions
8041 (append
8042 suggestions
8043 (list (cons (concat "Search for " "'" anything-input "'" " on Yahoo")
8044 anything-input))))))
8046 (defun anything-c-yahoo-suggest-action (candidate)
8047 "Default action to jump to a Yahoo suggested candidate."
8048 (anything-c-browse-url (concat anything-c-yahoo-suggest-search-url
8049 (url-hexify-string candidate))))
8051 (defvar anything-c-source-yahoo-suggest
8052 '((name . "Yahoo Suggest")
8053 (candidates . anything-c-yahoo-suggest-set-candidates)
8054 (action . (("Yahoo Search" . anything-c-yahoo-suggest-action)))
8055 (volatile)
8056 (requires-pattern . 3)
8057 (delayed)))
8059 ;; (anything 'anything-c-source-yahoo-suggest)
8061 ;;; Surfraw
8062 ;;; Need external program surfraw.
8063 ;;; http://surfraw.alioth.debian.org/
8064 ;; user variables
8065 (require 'browse-url)
8066 ;; If default setting of `w3m-command' is not
8067 ;; what you want you and you modify it, you will have to reeval
8068 ;; also `anything-browse-url-default-browser-alist'.
8069 (defvar w3m-command "/usr/bin/w3m")
8070 (defvar anything-c-home-url "http://www.google.fr"
8071 "*Default url to use as home url.")
8073 (defvar browse-url-chromium-program "chromium-browser")
8074 (defvar browse-url-uzbl-program "uzbl-browser")
8075 (defvar anything-browse-url-default-browser-alist
8076 `((,w3m-command . w3m-browse-url)
8077 (,browse-url-firefox-program . browse-url-firefox)
8078 (,browse-url-chromium-program . browse-url-chromium)
8079 (,browse-url-uzbl-program . browse-url-uzbl)
8080 (,browse-url-kde-program . browse-url-kde)
8081 (,browse-url-gnome-moz-program . browse-url-gnome-moz)
8082 (,browse-url-mozilla-program . browse-url-mozilla)
8083 (,browse-url-galeon-program . browse-url-galeon)
8084 (,browse-url-netscape-program . browse-url-netscape)
8085 (,browse-url-mosaic-program . browse-url-mosaic)
8086 (,browse-url-xterm-program . browse-url-text-xterm))
8087 "*Alist of (executable . function) to try to find a suitable url browser.")
8089 (defun* anything-c-generic-browser (url name &rest args)
8090 "Browse URL with NAME browser."
8091 (let ((proc (concat name " " url)))
8092 (message "Starting %s..." name)
8093 (apply 'start-process proc nil name
8094 (append args (list url)))
8095 (set-process-sentinel
8096 (get-process proc)
8097 #'(lambda (process event)
8098 (when (string= event "finished\n")
8099 (message "%s process %s" process event))))))
8101 (defun browse-url-chromium (url)
8102 "Browse URL with google chrome browser."
8103 (interactive "sURL: ")
8104 (anything-c-generic-browser
8105 url browse-url-chromium-program))
8107 (defun browse-url-uzbl (url &optional ignore)
8108 "Browse URL with uzbl browser."
8109 (interactive "sURL: ")
8110 (anything-c-generic-browser url browse-url-uzbl-program "-u"))
8112 (defun anything-browse-url-default-browser (url &rest args)
8113 "Find the first available browser and ask it to load URL."
8114 (let ((default-browser-fn
8115 (loop for (exe . fn) in anything-browse-url-default-browser-alist
8116 thereis (and exe (executable-find exe) fn))))
8117 (if default-browser-fn
8118 (apply default-browser-fn url args)
8119 (error "No usable browser found"))))
8121 (defun* anything-c-browse-url (&optional (url anything-c-home-url))
8122 "Default command to browse URL."
8123 (if browse-url-browser-function
8124 (browse-url url)
8125 (anything-browse-url-default-browser url)))
8127 (defun anything-c-build-elvi-list ()
8128 "Return list of all engines and descriptions handled by surfraw."
8129 (cdr
8130 (with-temp-buffer
8131 (call-process "surfraw" nil t nil
8132 "-elvi")
8133 (split-string (buffer-string) "\n"))))
8135 (defvar anything-surfraw-default-browser-function nil
8136 "*The browse url function you prefer to use with surfraw.
8137 When nil, fallback to `browse-url-browser-function'.")
8138 (defvar anything-surfraw-engines-history nil)
8139 ;;;###autoload
8140 (defun anything-surfraw (pattern engine)
8141 "Preconfigured `anything' to search PATTERN with search ENGINE."
8142 (interactive (list (read-string "SearchFor: ")
8143 (anything-comp-read
8144 "Engine: "
8145 (anything-c-build-elvi-list)
8146 :must-match t
8147 :name "Surfraw Search Engines"
8148 :history anything-surfraw-engines-history)))
8149 (let* ((engine-nodesc (car (split-string engine)))
8150 (url (shell-command-to-string
8151 (format "surfraw %s -p %s"
8152 engine-nodesc pattern)))
8153 (browse-url-browser-function (or anything-surfraw-default-browser-function
8154 browse-url-browser-function)))
8155 (if (string= engine-nodesc "W")
8156 (anything-c-browse-url)
8157 (anything-c-browse-url url)
8158 (setq anything-surfraw-engines-history
8159 (cons engine (delete engine anything-surfraw-engines-history))))))
8161 ;;; Emms
8163 (defun anything-emms-stream-edit-bookmark (elm)
8164 "Change the information of current emms-stream bookmark from anything."
8165 (let* ((cur-buf anything-current-buffer)
8166 (bookmark (assoc elm emms-stream-list))
8167 (name (read-from-minibuffer "Description: "
8168 (nth 0 bookmark)))
8169 (url (read-from-minibuffer "URL: "
8170 (nth 1 bookmark)))
8171 (fd (read-from-minibuffer "Feed Descriptor: "
8172 (int-to-string (nth 2 bookmark))))
8173 (type (read-from-minibuffer "Type (url, streamlist, or lastfm): "
8174 (format "%s" (car (last bookmark))))))
8175 (save-excursion
8176 (emms-streams)
8177 (when (re-search-forward (concat "^" name) nil t)
8178 (beginning-of-line)
8179 (emms-stream-delete-bookmark)
8180 (emms-stream-add-bookmark name url (string-to-number fd) type)
8181 (emms-stream-save-bookmarks-file)
8182 (emms-stream-quit)
8183 (anything-c-switch-to-buffer cur-buf)))))
8185 (defun anything-emms-stream-delete-bookmark (elm)
8186 "Delete an emms-stream bookmark from anything."
8187 (let* ((cur-buf anything-current-buffer)
8188 (bookmark (assoc elm emms-stream-list))
8189 (name (nth 0 bookmark)))
8190 (save-excursion
8191 (emms-streams)
8192 (when (re-search-forward (concat "^" name) nil t)
8193 (beginning-of-line)
8194 (emms-stream-delete-bookmark)
8195 (emms-stream-save-bookmarks-file)
8196 (emms-stream-quit)
8197 (anything-c-switch-to-buffer cur-buf)))))
8199 (defvar anything-c-source-emms-streams
8200 '((name . "Emms Streams")
8201 (init . (lambda ()
8202 (emms-stream-init)))
8203 (candidates . (lambda ()
8204 (mapcar 'car emms-stream-list)))
8205 (action . (("Play" . (lambda (elm)
8206 (let* ((stream (assoc elm emms-stream-list))
8207 (fn (intern (concat "emms-play-" (symbol-name (car (last stream))))))
8208 (url (second stream)))
8209 (funcall fn url))))
8210 ("Delete" . anything-emms-stream-delete-bookmark)
8211 ("Edit" . anything-emms-stream-edit-bookmark)))
8212 (filtered-candidate-transformer . anything-c-adaptive-sort)))
8213 ;; (anything 'anything-c-source-emms-streams)
8215 ;; Don't forget to set `emms-source-file-default-directory'
8216 (defvar anything-c-source-emms-dired
8217 '((name . "Music Directory")
8218 (candidates . (lambda ()
8219 (cddr (directory-files emms-source-file-default-directory))))
8220 (action .
8221 (("Play Directory" . (lambda (item)
8222 (emms-play-directory
8223 (expand-file-name
8224 item
8225 emms-source-file-default-directory))))
8226 ("Open dired in file's directory" . (lambda (item)
8227 (anything-c-open-dired
8228 (expand-file-name
8229 item
8230 emms-source-file-default-directory))))))
8231 (filtered-candidate-transformer . anything-c-adaptive-sort)))
8232 ;; (anything 'anything-c-source-emms-dired)
8234 (defface anything-emms-playlist
8235 '((t (:foreground "Springgreen4" :underline t)))
8236 "*Face used for tracks in current emms playlist."
8237 :group 'anything)
8239 (defun anything-c-emms-files-modifier (candidates source)
8240 (let ((current-playlist (with-current-emms-playlist
8241 (loop
8242 with cur-list = (emms-playlist-tracks-in-region
8243 (point-min) (point-max))
8244 for i in cur-list
8245 collect (assoc-default 'name i)))))
8246 (loop for i in candidates
8247 if (member (cdr i) current-playlist)
8248 collect (cons (propertize (car i)
8249 'face 'anything-emms-playlist)
8250 (cdr i)) into lis
8251 else collect i into lis
8252 finally return lis)))
8254 (defun anything-c-emms-play-current-playlist ()
8255 "Play current playlist."
8256 (with-current-emms-playlist
8257 (emms-playlist-first)
8258 (emms-playlist-mode-play-smart)))
8260 (defvar anything-c-source-emms-files
8261 '((name . "Emms files")
8262 (candidates . (lambda ()
8263 (loop for v being the hash-values in emms-cache-db
8264 for name = (assoc-default 'name v)
8265 for artist = (or (assoc-default 'info-artist v) "unknown")
8266 for genre = (or (assoc-default 'info-genre v) "unknown")
8267 for tracknum = (or (assoc-default 'info-tracknumber v) "unknown")
8268 for song = (or (assoc-default 'info-title v) "unknown")
8269 for info = (concat artist " - " genre " - " tracknum ": " song)
8270 unless (string-match "^http:" name) collect (cons info name))))
8271 (filtered-candidate-transformer . anything-c-emms-files-modifier)
8272 (action . (("Play file" . emms-play-file)
8273 ("Add to Playlist and play (C-u clear current)"
8274 . (lambda (candidate)
8275 (when anything-current-prefix-arg
8276 (emms-playlist-current-clear))
8277 (emms-playlist-new)
8278 (mapc 'emms-add-playlist-file (anything-marked-candidates))
8279 (unless emms-player-playing-p
8280 (anything-c-emms-play-current-playlist))))))))
8282 ;; (anything 'anything-c-source-emms-files)
8284 ;;; Jabber Contacts (jabber.el)
8285 (defun anything-c-jabber-online-contacts ()
8286 "List online Jabber contacts."
8287 (with-no-warnings
8288 (let (jids)
8289 (dolist (item (jabber-concat-rosters) jids)
8290 (when (get item 'connected)
8291 (push (if (get item 'name)
8292 (cons (get item 'name) item)
8293 (cons (symbol-name item) item)) jids))))))
8295 (defvar anything-c-source-jabber-contacts
8296 '((name . "Jabber Contacts")
8297 (init . (lambda () (require 'jabber)))
8298 (candidates . (lambda () (mapcar 'car (anything-c-jabber-online-contacts))))
8299 (action . (lambda (x)
8300 (jabber-chat-with
8301 (jabber-read-account)
8302 (symbol-name
8303 (cdr (assoc x (anything-c-jabber-online-contacts)))))))))
8304 ;; (anything 'anything-c-source-jabber-contacts)
8307 ;;; Call source.
8308 (defvar anything-source-select-buffer "*anything source select*")
8309 (defvar anything-c-source-call-source
8310 `((name . "Call anything source")
8311 (candidate-number-limit)
8312 (candidates . (lambda ()
8313 (loop for vname in (all-completions "anything-c-source-" obarray)
8314 for var = (intern vname)
8315 for name = (ignore-errors (assoc-default 'name (symbol-value var)))
8316 if name collect (cons (format "%s `%s'"
8317 name (propertize vname 'face 'font-lock-variable-name-face))
8318 var))))
8319 (action . (("Invoke anything with selected source" .
8320 (lambda (candidate)
8321 (setq anything-candidate-number-limit 9999)
8322 (anything candidate nil nil nil nil
8323 anything-source-select-buffer)))
8324 ("Describe variable" . describe-variable)
8325 ("Find variable" . find-variable)))
8326 (persistent-action . describe-variable)
8327 (persistent-help . "Show description of this source")))
8328 ;; (anything 'anything-c-source-call-source)
8330 ;;;###autoload
8331 (defun anything-call-source ()
8332 "Preconfigured `anything' to call anything source."
8333 (interactive)
8334 (anything 'anything-c-source-call-source nil nil nil nil
8335 anything-source-select-buffer))
8337 (defun anything-call-source-from-anything ()
8338 "Call anything source within `anything' session."
8339 (interactive)
8340 (setq anything-input-idle-delay 0)
8341 (anything-set-sources '(anything-c-source-call-source)))
8343 ;;; Execute Preconfigured anything.
8344 (defvar anything-c-source-anything-commands
8345 '((name . "Preconfigured Anything")
8346 (candidates . anything-c-anything-commands-candidates)
8347 (type . command)
8348 (candidate-number-limit)))
8349 ;; (anything 'anything-c-source-anything-commands)
8351 (defun anything-c-anything-commands-candidates ()
8352 (loop for (cmd . desc) in (anything-c-list-preconfigured-anything)
8353 collect (cons (if (where-is-internal cmd nil t)
8354 (substitute-command-keys (format "M-x %s (\\[%s]) : %s" cmd cmd desc))
8355 (substitute-command-keys (format "\\[%s] : %s" cmd desc)))
8356 cmd)))
8358 ;;;###autoload
8359 (defun anything-execute-anything-command ()
8360 "Preconfigured `anything' to execute preconfigured `anything'."
8361 (interactive)
8362 (anything-other-buffer 'anything-c-source-anything-commands
8363 "*anything commands*"))
8365 ;; Occur
8366 (defun anything-c-occur-init ()
8367 (anything-candidate-buffer anything-current-buffer))
8369 (defun anything-c-occur-get-line (s e)
8370 (format "%7d:%s" (line-number-at-pos (1- s)) (buffer-substring s e)))
8372 (defvar anything-c-source-occur
8373 '((name . "Occur")
8374 (init . anything-c-occur-init)
8375 (candidates-in-buffer)
8376 (migemo)
8377 (get-line . anything-c-occur-get-line)
8378 (type . line)
8379 (recenter)
8380 (requires-pattern . 1)
8381 (delayed)
8382 (volatile)))
8383 ;; (anything 'anything-c-source-occur)
8385 ;;; Anything browse code.
8386 (defun anything-c-browse-code-get-line (beg end)
8387 "Select line if it match the regexp corresponding to current `major-mode'.
8388 Line is parsed for BEG position to END position."
8389 (let ((str-line (buffer-substring beg end))
8390 (regexp (assoc-default major-mode
8391 anything-c-browse-code-regexp-alist))
8392 (num-line (if (string= anything-pattern "") beg (1- beg))))
8393 (when (and regexp (string-match regexp str-line))
8394 (format "%4d:%s" (line-number-at-pos num-line) str-line))))
8397 (defvar anything-c-source-browse-code
8398 '((name . "Browse code")
8399 (init . (lambda ()
8400 (anything-candidate-buffer anything-current-buffer)
8401 (with-current-buffer anything-current-buffer
8402 (jit-lock-fontify-now))))
8403 (candidate-number-limit . 9999)
8404 (candidates-in-buffer)
8405 (get-line . anything-c-browse-code-get-line)
8406 (type . line)
8407 (recenter)))
8409 ;; Do many actions for input
8410 (defvar anything-c-source-create
8411 '((name . "Create")
8412 (dummy)
8413 (action)
8414 (action-transformer . anything-create--actions))
8415 "Do many create actions from `anything-pattern'.
8416 See also `anything-create--actions'.")
8417 ;; (anything 'anything-c-source-create)
8419 (defun anything-create-from-anything ()
8420 "Run `anything-create' from `anything' as a fallback."
8421 (interactive)
8422 (anything-run-after-quit 'anything-create nil anything-pattern))
8424 ;;;###autoload
8425 (defun anything-create (&optional string initial-input)
8426 "Preconfigured `anything' to do many create actions from STRING.
8427 See also `anything-create--actions'."
8428 (interactive)
8429 (setq string (or string (read-string "Create Anything: " initial-input)))
8430 (anything '(((name . "Anything Create")
8431 (header-name . (lambda (_) (format "Action for \"%s\"" string)))
8432 (candidates . anything-create--actions)
8433 (candidate-number-limit)
8434 (action . (lambda (func) (funcall func string)))))))
8436 (defun anything-create--actions (&rest ignored)
8437 "Default actions for `anything-create' / `anything-c-source-create'."
8438 (remove-if-not
8439 (lambda (pair) (and (consp pair) (functionp (cdr pair))))
8440 (append anything-create--actions-private
8441 '(("find-file" . find-file)
8442 ("find-file other window" . find-file-other-window)
8443 ("New buffer" . anything-c-switch-to-buffer)
8444 ("New buffer other window" . switch-to-buffer-other-window)
8445 ("Bookmark Set" . bookmark-set)
8446 ("Set Register" .
8447 (lambda (x) (set-register (read-char "Register: ") x)))
8448 ("Insert Linkd star" . linkd-insert-star)
8449 ("Insert Linkd Tag" . linkd-insert-tag)
8450 ("Insert Linkd Link" . linkd-insert-link)
8451 ("Insert Linkd Lisp" . linkd-insert-lisp)
8452 ("Insert Linkd Wiki" . linkd-insert-wiki)
8453 ("Google Search" . google)))))
8455 ;; Minibuffer History
8456 (defvar anything-c-source-minibuffer-history
8457 '((name . "Minibuffer History")
8458 (header-name . (lambda (name) (format "%s (%s)" name minibuffer-history-variable)))
8459 (candidates
8460 . (lambda ()
8461 (let ((history (loop
8462 for i in (symbol-value minibuffer-history-variable)
8463 unless (string= "" i) collect i)))
8464 (if (consp (car history))
8465 (mapcar 'prin1-to-string history)
8466 history))))
8467 (migemo)
8468 (action . insert)))
8469 ;; (anything 'anything-c-source-minibuffer-history)
8471 ;; elscreen
8472 (defvar anything-c-source-elscreen
8473 '((name . "Elscreen")
8474 (candidates . (lambda ()
8475 (if (cdr (elscreen-get-screen-to-name-alist))
8476 (sort
8477 (loop for sname in (elscreen-get-screen-to-name-alist)
8478 append (list (format "[%d] %s" (car sname) (cdr sname))) into lst
8479 finally (return lst))
8480 #'(lambda (a b) (compare-strings a nil nil b nil nil))))))
8481 (action . (("Change Screen".
8482 (lambda (candidate)
8483 (elscreen-goto (- (aref candidate 1) (aref "0" 0)))))
8484 ("Kill Screen(s)".
8485 (lambda (candidate)
8486 (dolist (i (anything-marked-candidates))
8487 (elscreen-goto (- (aref i 1) (aref "0" 0)))
8488 (elscreen-kill))))
8489 ("Only Screen".
8490 (lambda (candidate)
8491 (elscreen-goto (- (aref candidate 1) (aref "0" 0)))
8492 (elscreen-kill-others)))))))
8493 ;; (anything 'anything-c-source-elscreen)
8495 ;;;; <System>
8497 ;;; Top (process)
8498 (defvar anything-c-top-command "COLUMNS=%s top -b -n 1"
8499 "Top command (batch mode). %s is replaced with `frame-width'.")
8500 (defvar anything-c-source-top
8501 '((name . "Top (Press C-c C-u to refresh)")
8502 (init . anything-c-top-init)
8503 (candidates-in-buffer)
8504 (display-to-real . anything-c-top-display-to-real)
8505 (update . anything-c-top-update)
8506 (persistent-action . anything-c-top-sh-persistent-action)
8507 (persistent-help . "SIGTERM")
8508 (action
8509 ("kill (TERM)" . (lambda (pid) (anything-c-top-sh (format "kill -TERM %s" pid))))
8510 ("kill (KILL)" . (lambda (pid) (anything-c-top-sh (format "kill -KILL %s" pid))))
8511 ("Copy PID" . (lambda (pid) (kill-new pid))))))
8512 ;; (anything 'anything-c-source-top)
8514 (defun anything-c-top-sh (cmd)
8515 (message "Executed %s\n%s" cmd (shell-command-to-string cmd)))
8517 (defun anything-c-top-sh-persistent-action (pid)
8518 (delete-other-windows)
8519 (anything-c-top-sh (format "kill -TERM %s" pid))
8520 (anything-force-update))
8522 (defun anything-c-top-init ()
8523 (with-current-buffer (anything-candidate-buffer 'global)
8524 (call-process-shell-command
8525 (format anything-c-top-command
8526 (- (frame-width) (if anything-enable-digit-shortcuts 4 0)))
8527 nil (current-buffer))))
8529 (defun anything-c-top-display-to-real (line)
8530 (car (split-string line)))
8532 (defun anything-c-top-update ()
8533 (let ((anything-source-name (assoc-default 'name anything-c-source-top))) ;UGLY HACK
8534 (anything-c-top-init)))
8536 ;;;###autoload
8537 (defun anything-top ()
8538 "Preconfigured `anything' for top command."
8539 (interactive)
8540 (let ((anything-samewindow t)
8541 (anything-enable-shortcuts)
8542 (anything-display-function 'anything-default-display-buffer)
8543 (anything-candidate-number-limit 9999))
8544 (save-window-excursion
8545 (delete-other-windows)
8546 (anything-other-buffer 'anything-c-source-top "*anything top*"))))
8548 ;;; Timers
8549 (defvar anything-c-source-absolute-time-timers
8550 '((name . "Absolute Time Timers")
8551 (candidates . timer-list)
8552 (type . timer)))
8553 ;; (anything 'anything-c-source-absolute-time-timers)
8555 (defvar anything-c-source-idle-time-timers
8556 '((name . "Idle Time Timers")
8557 (candidates . timer-idle-list)
8558 (type . timer)))
8559 ;; (anything 'anything-c-source-idle-time-timers)
8561 (defun anything-c-timer-real-to-display (timer)
8562 (destructuring-bind (triggered t1 t2 t3 repeat-delay func args idle-delay)
8563 (append timer nil) ;use `append' to convert vector->list
8564 (format "%s repeat=%5S %s(%s)"
8565 (let ((time (list t1 t2 t3)))
8566 (if idle-delay
8567 (format-time-string "idle-for=%5s" time)
8568 (format-time-string "%m/%d %T" time)))
8569 repeat-delay
8570 func
8571 (mapconcat 'prin1-to-string args " "))))
8573 ;;; X RandR resolution change
8574 ;;; FIXME I do not care multi-display.
8575 (defvar anything-c-xrandr-output "VGA")
8576 (defvar anything-c-xrandr-screen "0")
8577 (defvar anything-c-source-xrandr-change-resolution
8578 '((name . "Change Resolution")
8579 (candidates
8580 . (lambda ()
8581 (with-temp-buffer
8582 (call-process "xrandr" nil (current-buffer) nil
8583 "--screen" anything-c-xrandr-screen "-q")
8584 (goto-char 1)
8585 (loop while (re-search-forward " \\([0-9]+x[0-9]+\\)" nil t)
8586 collect (match-string 1)))))
8587 (action
8588 ("Change Resolution" . (lambda (mode)
8589 (call-process "xrandr" nil nil nil
8590 "--screen" anything-c-xrandr-screen
8591 "--output" anything-c-xrandr-output
8592 "--mode" mode))))))
8593 ;; (anything 'anything-c-source-xrandr-change-resolution)
8595 ;;; Xfont selection
8598 (defun anything-c-persistent-xfont-action (elm)
8599 "Show current font temporarily"
8600 (let ((current-font (cdr (assoc 'font (frame-parameters))))
8601 (default-font elm))
8602 (unwind-protect
8603 (progn (set-frame-font default-font 'keep-size) (sit-for 2))
8604 (set-frame-font current-font))))
8606 (defvar anything-c-xfonts-cache nil)
8607 (defvar anything-c-source-xfonts
8608 '((name . "X Fonts")
8609 (init . (lambda ()
8610 (unless anything-c-xfonts-cache
8611 (setq anything-c-xfonts-cache
8612 (x-list-fonts "*")))))
8613 (candidates . anything-c-xfonts-cache)
8614 (action . (("Copy to kill ring" . (lambda (elm)
8615 (kill-new elm)))
8616 ("Set Font" . (lambda (elm)
8617 (kill-new elm)
8618 (set-frame-font elm 'keep-size)
8619 (message "New font have been copied to kill ring")))))
8620 (persistent-action . anything-c-persistent-xfont-action)
8621 (persistent-help . "Switch to this font temporarily")))
8623 ;;;###autoload
8624 (defun anything-select-xfont ()
8625 "Preconfigured `anything' to select Xfont."
8626 (interactive)
8627 (anything-other-buffer 'anything-c-source-xfonts "*anything select* xfont"))
8629 ;; (anything 'anything-c-source-xfonts)
8631 ;;; World time
8634 (defvar anything-c-source-time-world
8635 '((name . "Time World List")
8636 (init . (lambda ()
8637 (let ((anything-buffer (anything-candidate-buffer 'global)))
8638 (with-current-buffer anything-buffer
8639 (display-time-world-display display-time-world-list)))))
8640 (candidates-in-buffer)))
8642 ;;;###autoload
8643 (defun anything-world-time ()
8644 "Preconfigured `anything' to show world time."
8645 (interactive)
8646 (anything-other-buffer 'anything-c-source-time-world "*anything world time*"))
8648 ;;; Anything interface for Debian/Ubuntu packages (apt-*)
8651 (defvar anything-c-source-apt
8652 '((name . "APT")
8653 (init . anything-c-apt-init)
8654 (candidates-in-buffer)
8655 (candidate-transformer anything-c-apt-candidate-transformer)
8656 (display-to-real . anything-c-apt-display-to-real)
8657 (requires-pattern . 2)
8658 (delayed)
8659 (action
8660 ("Show package description" . anything-c-apt-cache-show)
8661 ("Install package" . anything-c-apt-install)
8662 ("Remove package" . anything-c-apt-uninstall)
8663 ("Purge package" . anything-c-apt-purge))
8664 (persistent-action . anything-c-apt-persistent-action)
8665 (persistent-help . "Show - C-u Refresh")))
8666 ;; (anything 'anything-c-source-apt)
8668 (defvar anything-c-apt-query "emacs")
8669 (defvar anything-c-apt-search-command "apt-cache search '%s'")
8670 (defvar anything-c-apt-show-command "apt-cache show '%s'")
8671 (defvar anything-c-apt-installed-packages nil)
8672 (defvar anything-c-apt-all-packages nil)
8674 (defface anything-apt-installed
8675 '((t (:foreground "green")))
8676 "*Face used for apt installed candidates."
8677 :group 'anything)
8679 (defun anything-c-apt-refresh ()
8680 "Refresh installed candidates list."
8681 (setq anything-c-apt-installed-packages nil)
8682 (setq anything-c-apt-all-packages nil)
8683 (anything-force-update))
8685 (defun anything-c-apt-persistent-action (candidate)
8686 "Persistent action for APT source."
8687 (if current-prefix-arg
8688 (anything-c-apt-refresh)
8689 (anything-c-apt-cache-show candidate)))
8691 ;;;###autoload
8692 (defun anything-apt (arg query)
8693 "Preconfigured `anything' : frontend of APT package manager.
8694 With a prefix arg reload cache."
8695 (interactive "P\nsSearch Package: ")
8696 (when arg
8697 (setq anything-c-apt-installed-packages nil)
8698 (setq anything-c-apt-all-packages nil))
8699 (anything :sources 'anything-c-source-apt
8700 :prompt "Search Package: " :input query))
8702 (defun anything-c-apt-candidate-transformer (candidates)
8703 "Show installed candidates in a different color."
8704 (loop
8705 with all
8706 for cand in candidates
8707 for name = (anything-c-apt-display-to-real cand)
8708 if (member name anything-c-apt-installed-packages)
8709 collect (propertize cand 'face 'anything-apt-installed) into all
8710 else collect cand into all finally return all))
8712 (defun anything-c-apt-init ()
8713 "Initialize list of debian packages."
8714 (let ((query ""))
8715 (unless (and anything-c-apt-installed-packages
8716 anything-c-apt-all-packages)
8717 (message "Loading package list...")
8718 (setq anything-c-apt-installed-packages
8719 (with-temp-buffer
8720 (call-process-shell-command "dpkg --get-selections"
8721 nil (current-buffer))
8722 (loop for i in (split-string (buffer-string) "\n" t)
8723 collect (car (split-string i)))))
8724 (setq anything-c-apt-all-packages
8725 (with-current-buffer
8726 (anything-candidate-buffer
8727 (get-buffer-create (format "*anything-apt*")))
8728 (erase-buffer)
8729 (call-process-shell-command
8730 (format anything-c-apt-search-command query)
8731 nil (current-buffer))))
8732 (message "Loading package list done")
8733 (sit-for 0.5))))
8735 (defun anything-c-apt-display-to-real (line)
8736 "Return only name of a debian package.
8737 LINE is displayed like:
8738 package name - description."
8739 (car (split-string line " - ")))
8741 (defun anything-c-shell-command-if-needed (command)
8742 "Run shell command COMMAND to describe package.
8743 If a buffer named COMMAND already exists, just switch to it."
8744 (let ((buf (get-buffer command)))
8745 (anything-c-switch-to-buffer (get-buffer-create command))
8746 (unless buf (insert (shell-command-to-string command)))))
8748 (defun anything-c-apt-cache-show (package)
8749 "Show information on apt package PACKAGE."
8750 (anything-c-shell-command-if-needed
8751 (format anything-c-apt-show-command package)))
8753 (defun anything-c-apt-install (package)
8754 "Run 'apt-get install' shell command on PACKAGE."
8755 (anything-c-apt-generic-action :action 'install))
8757 (defun anything-c-apt-uninstall (package)
8758 "Run 'apt-get remove' shell command on PACKAGE."
8759 (anything-c-apt-generic-action :action 'uninstall))
8761 (defun anything-c-apt-purge (package)
8762 "Run 'apt-get purge' shell command on PACKAGE."
8763 (anything-c-apt-generic-action :action 'purge))
8765 (defun* anything-c-apt-generic-action (&key action)
8766 "Run 'apt-get ACTION'.
8767 Support install, remove and purge actions."
8768 (ansi-term (getenv "SHELL") "anything apt")
8769 (term-line-mode)
8770 (let ((command (case action
8771 ('install "sudo apt-get install ")
8772 ('uninstall "sudo apt-get remove ")
8773 ('purge "sudo apt-get purge ")
8774 (t (error "Unknow action"))))
8775 (beg (point))
8777 (cand-list (mapconcat #'(lambda (x) (format "'%s'" x))
8778 (anything-marked-candidates) " ")))
8779 (goto-char (point-max))
8780 (insert (concat command cand-list))
8781 (setq end (point))
8782 (if (y-or-n-p (format "%s package" (symbol-name action)))
8783 (progn
8784 (setq anything-c-external-commands-list nil)
8785 (setq anything-c-apt-installed-packages nil)
8786 (term-char-mode) (term-send-input))
8787 (delete-region beg end) (term-send-eof) (kill-buffer))))
8789 ;; (anything-c-apt-install "jed")
8791 ;;; Sources for gentoo users
8792 (defvar anything-c-gentoo-use-flags nil)
8793 (defvar anything-c-gentoo-buffer "*anything-gentoo-output*")
8794 (defvar anything-c-cache-gentoo nil)
8795 (defvar anything-c-cache-world nil)
8796 (defvar anything-c-source-gentoo
8797 '((name . "Portage sources")
8798 (init . (lambda ()
8799 (get-buffer-create anything-c-gentoo-buffer)
8800 (unless anything-c-cache-gentoo
8801 (anything-c-gentoo-setup-cache))
8802 (unless anything-c-cache-world
8803 (setq anything-c-cache-world (anything-c-gentoo-get-world)))
8804 (anything-c-gentoo-init-list)))
8805 (candidates-in-buffer)
8806 (match . identity)
8807 (candidate-transformer anything-c-highlight-world)
8808 (action . (("Show package" . (lambda (elm)
8809 (anything-c-gentoo-eshell-action elm "eix")))
8810 ("Show history" . (lambda (elm)
8811 (if (member elm anything-c-cache-world)
8812 (anything-c-gentoo-eshell-action elm "genlop -qe")
8813 (message "No infos on packages not yet installed"))))
8814 ("Copy in kill-ring" . kill-new)
8815 ("insert at point" . insert)
8816 ("Browse HomePage" . (lambda (elm)
8817 (let ((urls (anything-c-gentoo-get-url elm)))
8818 (browse-url (anything-comp-read "Url: " urls :must-match t)))))
8819 ("Show extra infos" . (lambda (elm)
8820 (if (member elm anything-c-cache-world)
8821 (anything-c-gentoo-eshell-action elm "genlop -qi")
8822 (message "No infos on packages not yet installed"))))
8823 ("Show use flags" . (lambda (elm)
8824 (anything-c-gentoo-default-action elm "equery" "-C" "u")
8825 (font-lock-add-keywords nil '(("^\+.*" . font-lock-variable-name-face)))
8826 (font-lock-mode 1)))
8827 ("Run emerge pretend" . (lambda (elm)
8828 (anything-c-gentoo-eshell-action elm "emerge -p")))
8829 ("Emerge" . (lambda (elm)
8830 (anything-gentoo-install elm :action 'install)))
8831 ("Unmerge" . (lambda (elm)
8832 (anything-gentoo-install elm :action 'uninstall)))
8833 ("Show dependencies" . (lambda (elm)
8834 (anything-c-gentoo-default-action elm "equery" "-C" "d")))
8835 ("Show related files" . (lambda (elm)
8836 (anything-c-gentoo-default-action elm "equery" "files")))
8837 ("Refresh" . (lambda (elm)
8838 (anything-c-gentoo-setup-cache)
8839 (setq anything-c-cache-world (anything-c-gentoo-get-world))))))))
8841 ;; (anything 'anything-c-source-gentoo)
8843 (defun* anything-gentoo-install (candidate &key action)
8844 (setq anything-c-external-commands-list nil)
8845 (ansi-term (getenv "SHELL") "Gentoo emerge")
8846 (term-line-mode)
8847 (let ((command (case action
8848 ('install "sudo emerge -av ")
8849 ('uninstall "sudo emerge -avC ")
8850 (t (error "Unknow action"))))
8851 (elms (mapconcat 'identity (anything-marked-candidates) " "))
8852 (beg (point)) end)
8853 (goto-char (point-max))
8854 (insert (concat command elms))
8855 (setq end (point))
8856 (term-char-mode) (term-send-input)))
8858 (defun anything-c-gentoo-default-action (elm command &rest args)
8859 "Gentoo default action that use `anything-c-gentoo-buffer'."
8860 (if (member elm anything-c-cache-world)
8861 (progn
8862 (anything-c-switch-to-buffer anything-c-gentoo-buffer)
8863 (erase-buffer)
8864 (let ((com-list (append args (list elm))))
8865 (apply #'call-process command nil t nil
8866 com-list)))
8867 (message "No infos on packages not yet installed")))
8869 (defvar anything-c-source-use-flags
8870 '((name . "Use Flags")
8871 (init . (lambda ()
8872 (unless anything-c-gentoo-use-flags
8873 (anything-c-gentoo-setup-use-flags-cache))
8874 (anything-c-gentoo-get-use)))
8875 (candidates-in-buffer)
8876 (match . identity)
8877 (candidate-transformer anything-c-highlight-local-use)
8878 (action . (("Description"
8879 . (lambda (elm)
8880 (anything-c-switch-to-buffer anything-c-gentoo-buffer)
8881 (erase-buffer)
8882 (apply #'call-process "euse" nil t nil
8883 `("-i"
8884 ,elm))
8885 (font-lock-add-keywords nil `((,elm . font-lock-variable-name-face)))
8886 (font-lock-mode 1)))
8887 ("Enable"
8888 . (lambda (elm)
8889 (anything-c-gentoo-eshell-action elm "*sudo -p Password: euse -E")))
8890 ("Disable"
8891 . (lambda (elm)
8892 (anything-c-gentoo-eshell-action elm "*sudo -p Password: euse -D")))
8893 ("Remove"
8894 . (lambda (elm)
8895 (anything-c-gentoo-eshell-action elm "*sudo -p Password: euse -P")))
8896 ("Show which dep use this flag"
8897 . (lambda (elm)
8898 (anything-c-switch-to-buffer anything-c-gentoo-buffer)
8899 (erase-buffer)
8900 (apply #'call-process "equery" nil t nil
8901 `("-C"
8903 ,elm))))))))
8906 ;; (anything 'anything-c-source-use-flags)
8908 (defun anything-c-gentoo-init-list ()
8909 "Initialize buffer with all packages in Portage."
8910 (let* ((portage-buf (get-buffer-create "*anything-gentoo*"))
8911 (buf (anything-candidate-buffer 'portage-buf)))
8912 (with-current-buffer buf
8913 (dolist (i anything-c-cache-gentoo)
8914 (insert (concat i "\n"))))))
8916 (defun anything-c-gentoo-setup-cache ()
8917 "Set up `anything-c-cache-gentoo'"
8918 (setq anything-c-cache-gentoo
8919 (split-string (with-temp-buffer
8920 (call-process "eix" nil t nil
8921 "--only-names")
8922 (buffer-string)))))
8924 (defun anything-c-gentoo-eshell-action (elm command)
8925 (when (get-buffer "*EShell Command Output*")
8926 (kill-buffer "*EShell Command Output*"))
8927 (message "Wait searching...")
8928 (let ((buf-fname (buffer-file-name anything-current-buffer)))
8929 (if (and buf-fname (string-match tramp-file-name-regexp buf-fname))
8930 (progn
8931 (save-window-excursion
8932 (pop-to-buffer "*scratch*")
8933 (eshell-command (format "%s %s" command elm)))
8934 (pop-to-buffer "*EShell Command Output*"))
8935 (eshell-command (format "%s %s" command elm)))))
8937 (defun anything-c-gentoo-get-use ()
8938 "Initialize buffer with all use flags."
8939 (let* ((use-buf (get-buffer-create "*anything-gentoo-use*"))
8940 (buf (anything-candidate-buffer 'use-buf)))
8941 (with-current-buffer buf
8942 (dolist (i anything-c-gentoo-use-flags)
8943 (insert (concat i "\n"))))))
8946 (defun anything-c-gentoo-setup-use-flags-cache ()
8947 "Setup `anything-c-gentoo-use-flags'"
8948 (setq anything-c-gentoo-use-flags
8949 (split-string (with-temp-buffer
8950 (call-process "eix" nil t nil
8951 "--print-all-useflags")
8952 (buffer-string)))))
8954 (defun anything-c-gentoo-get-url (elm)
8955 "Return a list of urls from eix output."
8956 (loop
8957 with url-list = (split-string
8958 (with-temp-buffer
8959 (call-process "eix" nil t nil
8960 elm "--format" "<homepage>\n")
8961 (buffer-string)))
8962 with all
8963 for i in url-list
8964 when (and (string-match "^http://.*" i)
8965 (not (member i all)))
8966 collect i into all
8967 finally return all))
8969 (defun anything-c-gentoo-get-world ()
8970 "Return list of all installed package on your system."
8971 (split-string (with-temp-buffer
8972 (call-process "qlist" nil t nil
8973 "-I")
8974 (buffer-string))))
8976 (defun anything-c-gentoo-get-local-use ()
8977 (split-string (with-temp-buffer
8978 (call-process "portageq" nil t nil
8979 "envvar"
8980 "USE")
8981 (buffer-string))))
8983 (defface anything-gentoo-match-face '((t (:foreground "red")))
8984 "Face for anything-gentoo installed packages."
8985 :group 'traverse-faces)
8987 (defun anything-c-highlight-world (eix)
8988 "Highlight all installed package."
8989 (loop for i in eix
8990 if (member i anything-c-cache-world)
8991 collect (propertize i 'face 'anything-gentoo-match-face)
8992 else
8993 collect i))
8995 (defun anything-c-highlight-local-use (use-flags)
8996 (let ((local-uses (anything-c-gentoo-get-local-use)))
8997 (loop for i in use-flags
8998 if (member i local-uses)
8999 collect (propertize i 'face 'anything-gentoo-match-face)
9000 else
9001 collect i)))
9003 (defvar anything-c-source-emacs-process
9004 '((name . "Emacs Process")
9005 (candidates . (lambda () (mapcar #'process-name (process-list))))
9006 (persistent-action . (lambda (elm)
9007 (delete-process (get-process elm))
9008 (anything-delete-current-selection)))
9009 (persistent-help . "Kill Process")
9010 (action ("Kill Process" . (lambda (elm)
9011 (delete-process (get-process elm)))))))
9013 ;; (anything 'anything-c-source-emacs-process)
9015 ;;; Anything `completing-read' replacement
9018 (defun anything-comp-read-get-candidates (collection &optional test sort-fn alistp)
9019 "Convert COLLECTION to list removing elements that don't match TEST.
9020 SORT-FN is a predicate to sort COLLECTION.
9021 ALISTP is a flag to not use `all-completions' which doesn't handle alists correctly\
9022 for anything.
9023 If collection is an `obarray', a TEST is needed. See `obarray'."
9024 (let ((cands
9025 (cond ((and (eq collection obarray) test)
9026 (all-completions "" collection test))
9027 ((and (vectorp collection) test)
9028 (loop for i across collection when (funcall test i) collect i))
9029 ((vectorp collection)
9030 (loop for i across collection collect i))
9031 ((and alistp test)
9032 (loop for i in collection when (funcall test i) collect i))
9033 (alistp collection)
9034 ((and collection test)
9035 (all-completions "" collection test))
9036 (t (all-completions "" collection)))))
9037 (if sort-fn (sort cands sort-fn) cands)))
9039 (defun anything-cr-default-transformer (candidates source)
9040 "Default filter candidate function for `anything-comp-read'.
9041 Do nothing, just return candidate list unmodified."
9042 candidates)
9044 (defun* anything-comp-read (prompt collection
9045 &key
9046 test
9047 initial-input
9048 (buffer "*Anything Completions*")
9049 must-match
9050 (requires-pattern 0)
9051 (history nil)
9052 (persistent-action nil)
9053 (persistent-help "DoNothing")
9054 (name "Anything Completions")
9055 (volatile t)
9056 sort
9057 (fc-transformer 'anything-cr-default-transformer)
9058 (marked-candidates nil)
9059 (alistp t))
9060 "Anything `completing-read' emulation.
9061 PROMPT is the prompt name to use.
9062 COLLECTION can be a list, vector, obarray or hash-table.
9063 Keys:
9065 TEST: A predicate called with one arg i.e candidate.
9066 INITIAL-INPUT: Same as initial-input arg in `anything'.
9067 BUFFER: Name of anything-buffer.
9068 MUST-MATCH: Candidate selected must be one of COLLECTION.
9069 REQUIRES-PATTERN: Same as anything attribute, default is 0.
9070 HISTORY: A list containing specific history, default is nil.
9071 When it is non--nil, all elements of HISTORY are displayed in
9072 anything-buffer before COLLECTION.
9073 PERSISTENT-ACTION: A function called with one arg i.e candidate.
9074 PERSISTENT-HELP: A string to document PERSISTENT-ACTION.
9075 NAME: The name related to this local source.
9076 VOLATILE: Use volatile attribute.
9077 SORT: A predicate to give to `sort' e.g `string-lessp'.
9078 FC-TRANSFORMER: A `filtered-candidate-transformer' function.
9079 MARKED-CANDIDATES: If non--nil return candidate or marked candidates as a list.
9080 ALISTP: when non--nil \(default\) cdr of alist is returned otherwise it is the car.
9082 Any prefix args passed during `anything-comp-read' invocation will be recorded
9083 in `anything-current-prefix-arg', otherwise if prefix args where given before
9084 `anything-comp-read' invocation, the value of `current-prefix-arg' will be used.
9085 That's mean you can pass prefix arg before or after calling
9086 a command that use `anything-comp-read'.
9087 It support now also a function as argument, See `all-completions' for more details."
9088 (when (get-buffer anything-action-buffer)
9089 (kill-buffer anything-action-buffer))
9090 (flet ((action-fn (candidate)
9091 (if marked-candidates
9092 (anything-marked-candidates)
9093 (identity candidate))))
9094 (let ((hist `((name . ,(format "%s History" name))
9095 (candidates . (lambda ()
9096 (anything-comp-read-get-candidates
9097 history nil nil ,alistp)))
9098 (persistent-action . ,persistent-action)
9099 (persistent-help . ,persistent-help)
9100 (action . ,'action-fn)))
9101 (src `((name . ,name)
9102 (candidates
9103 . (lambda ()
9104 (let ((cands (anything-comp-read-get-candidates
9105 collection test sort alistp)))
9106 (if (or must-match (string= anything-pattern ""))
9107 cands (append (list anything-pattern) cands)))))
9108 (filtered-candidate-transformer ,fc-transformer)
9109 (requires-pattern . ,requires-pattern)
9110 (persistent-action . ,persistent-action)
9111 (persistent-help . ,persistent-help)
9112 (action . ,'action-fn))))
9113 (when volatile (setq src (append src '((volatile)))))
9114 (or (anything
9115 :sources `(,hist ,src)
9116 :input initial-input
9117 :prompt prompt
9118 :resume 'noresume
9119 :buffer buffer)
9120 (keyboard-quit)))))
9122 ;; Generic completing-read
9124 ;; Support also function as collection.
9125 ;; e.g M-x man is supported.
9126 ;; Support hash-table and vectors as collection.
9127 ;; NOTE:
9128 ;; Some crap emacs functions may not be supported
9129 ;; like ffap-alternate-file (bad use of completing-read)
9130 ;; and maybe others.
9131 ;; Provide a mode `anything-completion-mode' which turn on
9132 ;; anything in all `completing-read' and `read-file-name' in Emacs.
9134 (defun anything-completing-read-default
9135 (prompt collection &optional
9136 predicate require-match
9137 initial-input hist def
9138 inherit-input-method)
9139 "An anything replacement of `completing-read'.
9141 Don't use it directly, use instead `anything-comp-read' in your programs \
9142 which is more powerful.
9144 See documentation of `completing-read' and `all-completions' for details."
9145 (let ((init (or def initial-input)))
9146 (anything-comp-read
9147 prompt collection
9148 :test predicate
9149 :fc-transformer #'(lambda (candidates source)
9150 (loop for i in candidates
9151 if (consp i) collect (car i)
9152 else collect i))
9153 :history (eval (or (car-safe hist) hist))
9154 :must-match require-match
9155 :alistp nil
9156 :initial-input init)))
9158 (defun anything-generic-read-file-name
9159 (prompt &optional dir default-filename mustmatch initial predicate)
9160 "An anything replacement of `read-file-name'."
9161 (let* ((default (and default-filename
9162 (if (listp default-filename)
9163 (car default-filename)
9164 default-filename)))
9165 (init (or default initial dir default-directory))
9166 (ini-input (and init (expand-file-name init))))
9167 (anything-c-read-file-name prompt
9168 :initial-input init
9169 :alistp nil
9170 :must-match mustmatch
9171 :test predicate)))
9173 (defvar anything-completion-mode-string " AC")
9174 ;;;###autoload
9175 (define-minor-mode anything-completion-mode
9176 "Toggle generic anything completion."
9177 :group 'anything
9178 :global t
9179 :lighter anything-completion-mode-string
9180 (if anything-completion-mode
9181 (progn
9182 (setq completing-read-function 'anything-completing-read-default
9183 read-file-name-function 'anything-generic-read-file-name)
9184 (message "Anything completion enabled"))
9185 (setq completing-read-function 'completing-read-default
9186 read-file-name-function 'read-file-name-default)
9187 (message "Anything completion disabled")))
9189 ;;; Eshell completion.
9191 ;; Enable like this in .emacs:
9193 ;; (add-hook 'eshell-mode-hook
9194 ;; #'(lambda ()
9195 ;; (define-key eshell-mode-map [remap pcomplete] 'anything-esh-pcomplete)))
9197 (defvar anything-c-source-esh
9198 '((name . "Eshell completions")
9199 (init . (lambda ()
9200 (setq pcomplete-current-completions nil
9201 pcomplete-last-completion-raw nil)))
9202 (candidates . anything-esh-get-candidates)
9203 (action . anything-ec-insert))
9204 "Anything source for Eshell completion.")
9206 ;; Internal.
9207 (defvar anything-ec-target "")
9208 (defun anything-ec-insert (candidate)
9209 "Insert CANDIDATE at point.
9210 This is the same as `ac-insert', just inlined here for compatibility."
9211 (let ((pt (point)))
9212 (when (and anything-ec-target
9213 (search-backward anything-ec-target nil t)
9214 (string= (buffer-substring (point) pt) anything-ec-target))
9215 (delete-region (point) pt)))
9216 (insert candidate))
9218 (defun anything-esh-get-candidates ()
9219 "Get candidates for eshell completion using `pcomplete'."
9220 (catch 'pcompleted
9221 (let* ((pcomplete-stub)
9222 pcomplete-seen pcomplete-norm-func
9223 pcomplete-args pcomplete-last pcomplete-index
9224 (pcomplete-autolist pcomplete-autolist)
9225 (pcomplete-suffix-list pcomplete-suffix-list))
9226 (with-current-buffer anything-current-buffer
9227 (loop
9228 with table = (pcomplete-completions)
9229 with entry = (condition-case nil
9230 ;; For Emacs24
9231 (funcall (pcomplete-entries) anything-pattern nil nil)
9232 ;; Fall back to this in Emacs23 as pcomplete-entries seem broken.
9233 (error
9235 (let ((fc (car (last (pcomplete-parse-arguments)))))
9236 ;; Check if last arg require fname completion.
9237 (and (file-name-directory fc) fc))))
9238 for i in (if (listp table) table ; Emacs23 or commands.
9239 (all-completions pcomplete-stub table)) ; Emacs24
9240 for file-cand = (and entry (expand-file-name i (file-name-directory entry)))
9241 if (and file-cand (file-exists-p file-cand)) collect file-cand into ls
9242 else collect i into ls
9243 finally return
9244 (if (and entry (not (string= entry "")) (file-exists-p entry))
9245 (append (list (expand-file-name entry default-directory)) ls) ls))))))
9247 ;;;###autoload
9248 (defun anything-esh-pcomplete ()
9249 "Preconfigured anything to provide anything completion in eshell."
9250 (interactive)
9251 (let* ((anything-quit-if-no-candidate t)
9252 (anything-execute-action-at-once-if-one t)
9253 (target (thing-at-point 'symbol))
9254 (end (point))
9255 (beg (or (and target (- end (length target)))
9256 ;; Nothing at point.
9257 (progn (insert " ") (point)))))
9258 (setq anything-ec-target (or target " "))
9259 (with-anything-show-completion beg end
9260 (anything :sources 'anything-c-source-esh
9261 :input (anything-ff-set-pattern ; Handle tramp filenames.
9262 (car (last (ignore-errors ; Needed in lisp symbols completion.
9263 (pcomplete-parse-arguments)))))))))
9265 ;;; Eshell history.
9268 (defvar anything-c-source-eshell-history
9269 '((name . "Eshell history")
9270 (init . (lambda ()
9271 (with-current-buffer (anything-candidate-buffer 'global)
9272 (insert-file-contents eshell-history-file-name))))
9273 (candidates-in-buffer)
9274 (action . (lambda (candidate)
9275 (insert candidate))))
9276 "Anything source for Eshell history.")
9278 ;;;###autoload
9279 (defun anything-eshell-history ()
9280 "Preconfigured anything for eshell history."
9281 (interactive)
9282 (let* ((end (point))
9283 (beg (progn (save-excursion (insert " ") (point)))))
9284 (with-anything-show-completion beg end
9285 (anything-other-buffer anything-c-source-eshell-history "*Eshell history*"))))
9287 ;;; Show completion - an alternative of anything-show-completion.el.
9289 ;; Provide show completion with macro `with-anything-show-completion'.
9291 (defface anything-lisp-show-completion
9292 '((t (:background "DarkSlateGray")))
9293 "*Face used for showing candidates in `anything-lisp-completion'."
9294 :group 'anything-config)
9296 ;; Internal
9297 (defvar anything-c-show-completion-overlay nil)
9299 ;; Called each time cursor move in anything-buffer.
9300 (defun anything-c-show-completion ()
9301 (overlay-put anything-c-show-completion-overlay
9302 'display (anything-get-selection)))
9304 (defun anything-c-completion-init-overlay (beg end)
9305 (and anything-c-turn-on-show-completion
9306 (setq anything-c-show-completion-overlay (make-overlay beg end))
9307 (overlay-put anything-c-show-completion-overlay
9308 'face 'anything-lisp-show-completion)))
9310 (defmacro with-anything-show-completion (beg end &rest body)
9311 "Show anything candidate in an overlay at point.
9312 BEG and END are the beginning and end position of the current completion
9313 in `anything-current-buffer'.
9314 BODY is an anything call where we want to enable show completion.
9315 If `anything-c-turn-on-show-completion' is nil just do nothing."
9316 (declare (indent 2) (debug t))
9317 `(let ((anything-move-selection-after-hook
9318 (and anything-c-turn-on-show-completion
9319 (append (list 'anything-c-show-completion)
9320 anything-move-selection-after-hook))))
9321 (unwind-protect
9322 (progn (anything-c-completion-init-overlay ,beg ,end)
9323 ,@body)
9324 (and anything-c-turn-on-show-completion
9325 (delete-overlay anything-c-show-completion-overlay)))))
9327 ;;; Lisp symbol completion.
9331 (defface anything-lisp-completion-info
9332 '((t (:foreground "red")))
9333 "*Face used for showing info in `anything-lisp-completion'."
9334 :group 'anything-config)
9336 ;;;###autoload
9337 (defun anything-lisp-completion-at-point ()
9338 "Anything lisp symbol completion at point."
9339 (interactive)
9340 (let* ((data (lisp-completion-at-point))
9341 (beg (car data))
9342 (end (point)) ; 'cadr data' is wrong when no space after point.
9343 (plist (nthcdr 3 data))
9344 (pred (plist-get plist :predicate))
9345 (lgst-len 0)
9346 (target (and beg end (buffer-substring-no-properties beg end)))
9347 (anything-quit-if-no-candidate t)
9348 (anything-execute-action-at-once-if-one t)
9349 (anything-match-plugin-enabled
9350 (member 'anything-compile-source--match-plugin
9351 anything-compile-source-functions)))
9352 (when data
9353 (with-anything-show-completion beg end
9354 ;; Overlay is initialized now in anything-current-buffer.
9355 (anything
9356 :sources
9357 '((name . "Lisp completion")
9358 (init . (lambda ()
9359 (with-current-buffer (anything-candidate-buffer 'global)
9360 (loop for sym in (all-completions target (nth 2 data) pred)
9361 for len = (length sym)
9362 when (> len lgst-len) do (setq lgst-len len)
9363 do (insert (concat sym "\n"))))))
9364 (candidates-in-buffer)
9365 (persistent-action . (lambda (candidate)
9366 (let ((cursor-in-echo-area t)
9367 mode-line-in-non-selected-windows)
9368 (anything-c-eldoc-show-in-mode-line
9369 (propertize
9370 (anything-c-get-first-line-documentation
9371 (intern candidate))
9372 'face 'anything-lisp-completion-info)))))
9373 (persistent-help . "Show brief doc in mode-line")
9374 (filtered-candidate-transformer anything-lisp-completion-transformer)
9375 (action . (lambda (candidate)
9376 (delete-region beg end)
9377 (insert candidate))))
9378 :input (if anything-match-plugin-enabled (concat target " ") target))))))
9380 (defun anything-lisp-completion-transformer (candidates source)
9381 "Anything candidates transformer for lisp completion."
9382 (declare (special lgst-len))
9383 (loop for c in candidates
9384 for sym = (intern c)
9385 for annot = (cond ((commandp sym) " (Com)")
9386 ((fboundp sym) " (Fun)")
9387 ((boundp sym) " (Var)")
9388 ((facep sym) " (Face)"))
9389 for spaces = (make-string (- lgst-len (length c)) ? )
9390 collect (cons (concat c spaces annot) c)))
9392 (defun anything-c-get-first-line-documentation (sym)
9393 "Return first line documentation of symbol SYM.
9394 If SYM is not documented, return \"Not documented\"."
9395 (let ((doc (cond ((fboundp sym)
9396 (documentation sym t))
9397 ((boundp sym)
9398 (documentation-property sym 'variable-documentation t))
9399 ((facep sym)
9400 (face-documentation sym))
9401 (t nil))))
9402 (if (and doc (not (string= doc ""))
9403 ;; `documentation' return "\n\n(args...)"
9404 ;; for CL-style functions.
9405 (not (string-match-p "^\n\n" doc)))
9406 (car (split-string doc "\n"))
9407 "Not documented")))
9409 ;; Internal
9410 (defvar anything-lisp-completion-counter 0)
9412 ;;;###autoload
9413 (defun anything-lisp-completion-at-point-or-indent (arg)
9414 "First call indent and second call complete lisp symbol.
9415 The second call should happen before `anything-lisp-completion-or-indent-delay',
9416 after this delay, next call will indent again.
9417 After completion, next call is always indent.
9418 See that like click and double mouse click.
9419 One hit indent, two quick hits maybe indent and complete."
9420 (interactive "P")
9421 ;; Be sure `indent-for-tab-command' will not try
9422 ;; to use `completion-at-point'.
9423 (let ((tab-always-indent (if (eq tab-always-indent 'complete)
9424 t tab-always-indent)))
9425 (incf anything-lisp-completion-counter)
9426 (unwind-protect
9427 (if (> anything-lisp-completion-counter 1)
9428 (anything-lisp-completion-at-point)
9429 (indent-for-tab-command arg))
9430 ;; After `anything-lisp-completion-or-indent-delay' seconds
9431 ;; reset to 0.
9432 (run-with-timer anything-lisp-completion-or-indent-delay nil
9433 #'(lambda ()
9434 (setq anything-lisp-completion-counter 0)))
9435 ;; Always reset to 0 at second hit.
9436 (when (eq anything-lisp-completion-counter 2)
9437 (setq anything-lisp-completion-counter 0)))))
9439 ;;; File completion.
9441 ;; Complete file name at point.
9443 ;;;###autoload
9444 (defun anything-c-complete-file-name-at-point ()
9445 "Complete file name at point."
9446 (interactive)
9447 (let* ((init (substring-no-properties (thing-at-point 'filename)))
9448 (end (point))
9449 (beg (- (point) (length init)))
9450 (anything-quit-if-no-candidate t)
9451 (anything-execute-action-at-once-if-one t)
9452 completion)
9453 (with-anything-show-completion beg end
9454 (setq completion (anything-c-read-file-name "FileName: "
9455 :initial-input init
9456 :must-match t)))
9457 (anything-c-insert-file-name-completion-at-point completion)))
9459 ;;; Run Externals commands within Emacs with anything completion
9461 (defun anything-c-get-pid-from-process-name (process-name)
9462 "Get pid from running process PROCESS-NAME."
9463 (loop with process-list = (list-system-processes)
9464 for pid in process-list
9465 for process = (assoc-default 'comm (process-attributes pid))
9466 when (and process (string-match process-name process))
9467 return pid))
9470 (defun anything-run-or-raise (exe &optional file)
9471 "Generic command that run asynchronously EXE.
9472 If EXE is already running just jump to his window if `anything-raise-command'
9473 is non--nil.
9474 When FILE argument is provided run EXE with FILE.
9475 In this case EXE must be provided as \"EXE %s\"."
9476 (lexical-let* ((real-com (car (split-string (replace-regexp-in-string
9477 "'%s'" "" exe))))
9478 (proc (if file (concat real-com " " file) real-com)))
9479 (if (get-process proc)
9480 (if anything-raise-command
9481 (shell-command (format anything-raise-command real-com))
9482 (error "Error: %s is already running" real-com))
9483 (when (loop for i in anything-c-external-commands-list thereis real-com)
9484 (message "Starting %s..." real-com)
9485 (if file
9486 (start-process-shell-command proc nil (format exe file))
9487 (start-process-shell-command proc nil real-com))
9488 (set-process-sentinel
9489 (get-process proc)
9490 #'(lambda (process event)
9491 (when (and (string= event "finished\n")
9492 anything-raise-command
9493 (not (anything-c-get-pid-from-process-name real-com)))
9494 (shell-command (format anything-raise-command "emacs")))
9495 (message "%s process...Finished." process))))
9496 (setq anything-c-external-commands-list
9497 (cons real-com
9498 (delete real-com anything-c-external-commands-list))))))
9501 (defvar anything-external-command-history nil)
9502 ;;;###autoload
9503 (defun anything-c-run-external-command (program)
9504 "Preconfigured `anything' to run External PROGRAM asyncronously from Emacs.
9505 If program is already running exit with error.
9506 You can set your own list of commands with
9507 `anything-c-external-commands-list'."
9508 (interactive (list
9509 (anything-comp-read
9510 "RunProgram: "
9511 (anything-c-external-commands-list-1 'sort)
9512 :must-match t
9513 :name "External Commands"
9514 :history anything-external-command-history)))
9515 (anything-run-or-raise program)
9516 (setq anything-external-command-history
9517 (cons program (delete program
9518 (loop for i in anything-external-command-history
9519 when (executable-find i) collect i)))))
9521 (defsubst* anything-c-position (item seq &key (test 'eq))
9522 "A simple and faster replacement of CL `position'."
9523 (loop for i in seq for index from 0
9524 when (funcall test i item) return index))
9526 (defvar anything-c-source-ratpoison-commands
9527 '((name . "Ratpoison Commands")
9528 (init . anything-c-ratpoison-commands-init)
9529 (candidates-in-buffer)
9530 (action ("Execute the command" . anything-c-ratpoison-commands-execute))
9531 (display-to-real . anything-c-ratpoison-commands-display-to-real)
9532 (candidate-number-limit)))
9533 ;; (anything 'anything-c-source-ratpoison-commands)
9535 (defun anything-c-ratpoison-commands-init ()
9536 (unless (anything-candidate-buffer)
9537 (with-current-buffer (anything-candidate-buffer 'global)
9538 ;; with ratpoison prefix key
9539 (save-excursion
9540 (call-process "ratpoison" nil (current-buffer) nil "-c" "help"))
9541 (while (re-search-forward "^\\([^ ]+\\) \\(.+\\)$" nil t)
9542 (replace-match "<ratpoison> \\1: \\2"))
9543 (goto-char (point-max))
9544 ;; direct binding
9545 (save-excursion
9546 (call-process "ratpoison" nil (current-buffer) nil "-c" "help top"))
9547 (while (re-search-forward "^\\([^ ]+\\) \\(.+\\)$" nil t)
9548 (replace-match "\\1: \\2")))))
9550 (defun anything-c-ratpoison-commands-display-to-real (display)
9551 (and (string-match ": " display)
9552 (substring display (match-end 0))))
9554 (defun anything-c-ratpoison-commands-execute (candidate)
9555 (call-process "ratpoison" nil nil nil "-ic" candidate))
9557 ;;;###autoload
9558 (defun anything-ratpoison-commands ()
9559 "Preconfigured `anything' to execute ratpoison commands."
9560 (interactive)
9561 (anything-other-buffer 'anything-c-source-ratpoison-commands
9562 "*anything ratpoison commands*"))
9564 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Action Helpers ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
9565 ;;; Files
9566 (defvar anything-c-external-commands-list nil
9567 "A list of all external commands the user can execute. If this
9568 variable is not set by the user, it will be calculated
9569 automatically.")
9571 (defun anything-c-external-commands-list-1 (&optional sort)
9572 "Returns a list of all external commands the user can execute.
9573 If `anything-c-external-commands-list' is non-nil it will
9574 return its contents. Else it calculates all external commands
9575 and sets `anything-c-external-commands-list'."
9576 (if anything-c-external-commands-list
9577 anything-c-external-commands-list
9578 (setq anything-c-external-commands-list
9579 (loop
9580 with paths = (split-string (getenv "PATH") path-separator)
9581 with completions = ()
9582 for dir in paths
9583 when (and (file-exists-p dir) (file-accessible-directory-p dir))
9584 for lsdir = (loop for i in (directory-files dir t)
9585 for bn = (file-name-nondirectory i)
9586 when (and (not (member bn completions))
9587 (not (file-directory-p i))
9588 (file-executable-p i))
9589 collect bn)
9590 append lsdir into completions
9591 finally return (if sort (sort completions 'string-lessp) completions)))))
9594 (defun anything-c-file-buffers (filename)
9595 "Returns a list of buffer names corresponding to FILENAME."
9596 (let ((name (expand-file-name filename))
9597 (buf-list ()))
9598 (dolist (buf (buffer-list) buf-list)
9599 (let ((bfn (buffer-file-name buf)))
9600 (when (and bfn (string= name bfn))
9601 (push (buffer-name buf) buf-list))))))
9604 (defun anything-c-delete-file (file)
9605 "Delete the given file after querying the user.
9606 Ask to kill buffers associated with that file, too."
9607 (let ((buffers (anything-c-file-buffers file)))
9608 (if (< emacs-major-version 24)
9609 ;; `dired-delete-file' in Emacs versions < 24
9610 ;; doesn't support delete-by-moving-to-trash
9611 ;; so use `delete-directory' and `delete-file'
9612 ;; that handle it.
9613 (cond ((and (not (file-symlink-p file))
9614 (file-directory-p file)
9615 (directory-files file t dired-re-no-dot))
9616 (when (y-or-n-p (format "Recursive delete of `%s'? " file))
9617 (delete-directory file 'recursive)))
9618 ((and (not (file-symlink-p file))
9619 (file-directory-p file))
9620 (delete-directory file))
9621 (t (delete-file file)))
9622 (dired-delete-file
9623 file 'dired-recursive-deletes delete-by-moving-to-trash))
9624 (when buffers
9625 (dolist (buf buffers)
9626 (when (y-or-n-p (format "Kill buffer %s, too? " buf))
9627 (kill-buffer buf))))))
9629 (defun anything-get-mailcap-for-file (filename)
9630 "Get the command to use for FILENAME from mailcap files.
9631 The command is like <command %s> and is meant to use with `format'."
9632 (mailcap-parse-mailcaps)
9633 (let* ((ext (file-name-extension filename))
9634 (mime (when ext (mailcap-extension-to-mime ext)))
9635 (result (when mime (mailcap-mime-info mime))))
9636 ;; If elisp file have no associations in .mailcap
9637 ;; `mailcap-maybe-eval' is returned, in this case just return nil.
9638 (when (stringp result) result)))
9640 (defun anything-get-default-program-for-file (filename)
9641 "Try to find a default program to open FILENAME.
9642 Try first in `anything-c-external-programs-associations' and then in mailcap file
9643 if nothing found return nil."
9644 (let* ((ext (file-name-extension filename))
9645 (def-prog (assoc-default ext anything-c-external-programs-associations)))
9646 (cond ((and def-prog (not (string= def-prog "")))
9647 (concat def-prog " %s"))
9648 ((and anything-c-default-external-file-browser
9649 (file-directory-p filename))
9650 (concat anything-c-default-external-file-browser " %s"))
9651 (t (anything-get-mailcap-for-file filename)))))
9653 (defun anything-c-open-file-externally (file)
9654 "Open FILE with an external program.
9655 Try to guess which program to use with `anything-get-default-program-for-file'.
9656 If not found or a prefix arg is given query the user which tool to use."
9657 (let* ((fname (expand-file-name file))
9658 (collection (anything-c-external-commands-list-1 'sort))
9659 (def-prog (anything-get-default-program-for-file fname))
9660 (real-prog-name (if (or anything-current-prefix-arg (not def-prog))
9661 ;; Prefix arg or no default program.
9662 (prog1
9663 (anything-comp-read
9664 "Program: " collection
9665 :must-match t
9666 :name "Open file Externally"
9667 :history anything-external-command-history)
9668 ;; Always prompt to set this program as default.
9669 (setq def-prog nil))
9670 ;; No prefix arg or default program exists.
9671 (replace-regexp-in-string " %s\\| '%s'" "" def-prog)))
9672 (program (concat real-prog-name " '%s'")))
9673 (unless (or def-prog ; Association exists, no need to record it.
9674 ;; Don't try to record non--filenames associations (e.g urls).
9675 (not (file-exists-p fname)))
9676 (when
9677 (y-or-n-p
9678 (format
9679 "Do you want to make `%s' the default program for this kind of files? "
9680 real-prog-name))
9681 (anything-aif (assoc (file-name-extension fname)
9682 anything-c-external-programs-associations)
9683 (setq anything-c-external-programs-associations
9684 (delete it anything-c-external-programs-associations)))
9685 (push (cons (file-name-extension fname)
9686 (read-string
9687 "Program (Add args maybe and confirm): " real-prog-name))
9688 anything-c-external-programs-associations)
9689 (customize-save-variable 'anything-c-external-programs-associations
9690 anything-c-external-programs-associations)))
9691 (anything-run-or-raise program file)
9692 (setq anything-external-command-history
9693 (cons real-prog-name
9694 (delete real-prog-name
9695 (loop for i in anything-external-command-history
9696 when (executable-find i) collect i))))))
9699 ;;;###autoload
9700 (defun w32-shell-execute-open-file (file)
9701 (interactive "fOpen file:")
9702 (with-no-warnings
9703 (w32-shell-execute "open" (replace-regexp-in-string ;for UNC paths
9704 "/" "\\"
9705 (replace-regexp-in-string ; strip cygdrive paths
9706 "/cygdrive/\\(.\\)" "\\1:"
9707 file nil nil) nil t))))
9709 (defun anything-c-open-file-with-default-tool (file)
9710 "Open FILE with the default tool on this platform."
9711 (if (eq system-type 'windows-nt)
9712 (w32-shell-execute-open-file file)
9713 (start-process "anything-c-open-file-with-default-tool"
9715 (cond ((eq system-type 'gnu/linux)
9716 "xdg-open")
9717 ((or (eq system-type 'darwin) ;; Mac OS X
9718 (eq system-type 'macos)) ;; Mac OS 9
9719 "open"))
9720 file)))
9722 (defun anything-c-open-dired (file)
9723 "Opens a dired buffer in FILE's directory. If FILE is a
9724 directory, open this directory."
9725 (if (file-directory-p file)
9726 (dired file)
9727 (dired (file-name-directory file))
9728 (dired-goto-file file)))
9730 (defun anything-c-display-to-real-line (candidate)
9731 (if (string-match "^ *\\([0-9]+\\):\\(.*\\)$" candidate)
9732 (list (string-to-number (match-string 1 candidate)) (match-string 2 candidate))
9733 (error "Line number not found")))
9735 (defun anything-c-action-line-goto (lineno-and-content)
9736 (apply #'anything-goto-file-line (anything-interpret-value (anything-attr 'target-file))
9737 (append lineno-and-content
9738 (list (if (and (anything-attr-defined 'target-file)
9739 (not anything-in-persistent-action))
9740 'find-file-other-window
9741 'find-file)))))
9743 (defun* anything-c-action-file-line-goto (file-line-content &optional (find-file-function #'find-file))
9744 (apply #'anything-goto-file-line
9745 (if (stringp file-line-content)
9746 ;; Case: filtered-candidate-transformer is skipped
9747 (cdr (anything-c-filtered-candidate-transformer-file-line-1 file-line-content))
9748 file-line-content)))
9750 (require 'compile)
9751 (defun anything-c-filtered-candidate-transformer-file-line (candidates source)
9752 (delq nil (mapcar 'anything-c-filtered-candidate-transformer-file-line-1 candidates)))
9754 (defun anything-c-filtered-candidate-transformer-file-line-1 (candidate)
9755 (when (string-match "^\\(.+?\\):\\([0-9]+\\):\\(.*\\)$" candidate)
9756 (let ((filename (match-string 1 candidate))
9757 (lineno (match-string 2 candidate))
9758 (content (match-string 3 candidate)))
9759 (cons (format "%s:%s\n %s"
9760 (propertize filename 'face compilation-info-face)
9761 (propertize lineno 'face compilation-line-face)
9762 content)
9763 (list (expand-file-name
9764 filename
9765 (or (anything-interpret-value (anything-attr 'default-directory))
9766 (and (anything-candidate-buffer)
9767 (buffer-local-value
9768 'default-directory (anything-candidate-buffer)))))
9769 (string-to-number lineno) content)))))
9771 (defun* anything-goto-file-line (file lineno content &optional (find-file-function #'find-file))
9772 (anything-aif (anything-attr 'before-jump-hook)
9773 (funcall it))
9774 (when file (funcall find-file-function file))
9775 (if (anything-attr-defined 'adjust)
9776 (anything-c-goto-line-with-adjustment lineno content)
9777 (anything-goto-line lineno))
9778 (unless (anything-attr-defined 'recenter)
9779 (set-window-start (get-buffer-window anything-current-buffer) (point)))
9780 (anything-aif (anything-attr 'after-jump-hook)
9781 (funcall it))
9782 (when anything-in-persistent-action
9783 (anything-match-line-color-current-line)))
9785 (defun anything-find-file-as-root (candidate)
9786 (find-file (concat "/" anything-su-or-sudo "::" (expand-file-name candidate))))
9788 (defun anything-find-many-files (ignore)
9789 (mapc 'find-file (anything-marked-candidates)))
9791 ;; borrowed from etags.el
9792 ;; (anything-c-goto-line-with-adjustment (line-number-at-pos) ";; borrowed from etags.el")
9793 (defun anything-c-goto-line-with-adjustment (line line-content)
9794 (let ((startpos)
9795 offset found pat)
9796 ;; This constant is 1/2 the initial search window.
9797 ;; There is no sense in making it too small,
9798 ;; since just going around the loop once probably
9799 ;; costs about as much as searching 2000 chars.
9800 (setq offset 1000
9801 found nil
9802 pat (concat (if (eq selective-display t)
9803 "\\(^\\|\^m\\) *" "^ *") ;allow indent
9804 (regexp-quote line-content)))
9805 ;; If no char pos was given, try the given line number.
9806 (setq startpos (progn (anything-goto-line line) (point)))
9807 (or startpos (setq startpos (point-min)))
9808 ;; First see if the tag is right at the specified location.
9809 (goto-char startpos)
9810 (setq found (looking-at pat))
9811 (while (and (not found)
9812 (progn
9813 (goto-char (- startpos offset))
9814 (not (bobp))))
9815 (setq found
9816 (re-search-forward pat (+ startpos offset) t)
9817 offset (* 3 offset))) ; expand search window
9818 (or found
9819 (re-search-forward pat nil t)
9820 (error "not found")))
9821 ;; Position point at the right place
9822 ;; if the search string matched an extra Ctrl-m at the beginning.
9823 (and (eq selective-display t)
9824 (looking-at "\^m")
9825 (forward-char 1))
9826 (beginning-of-line))
9828 (anything-document-attribute 'default-directory "type . file-line"
9829 "`default-directory' to interpret file.")
9830 (anything-document-attribute 'before-jump-hook "type . file-line / line"
9831 "Function to call before jumping to the target location.")
9832 (anything-document-attribute 'after-jump-hook "type . file-line / line"
9833 "Function to call after jumping to the target location.")
9834 (anything-document-attribute 'adjust "type . file-line"
9835 "Search around line matching line contents.")
9836 (anything-document-attribute 'recenter "type . file-line / line"
9837 "`recenter' after jumping.")
9838 (anything-document-attribute 'target-file "type . line"
9839 "Goto line of target-file.")
9841 ;;;###autoload
9842 (defun anything-c-call-interactively (cmd-or-name)
9843 "Execute CMD-OR-NAME as Emacs command.
9844 It is added to `extended-command-history'.
9845 `anything-current-prefix-arg' is used as the command's prefix argument."
9846 (setq extended-command-history
9847 (cons (anything-c-stringify cmd-or-name)
9848 (delete (anything-c-stringify cmd-or-name) extended-command-history)))
9849 (let ((current-prefix-arg anything-current-prefix-arg)
9850 (cmd (anything-c-symbolify cmd-or-name)))
9851 (if (stringp (symbol-function cmd))
9852 (execute-kbd-macro (symbol-function cmd))
9853 (setq this-command cmd)
9854 (call-interactively cmd))))
9856 ;;;###autoload
9857 (defun anything-c-set-variable (var)
9858 "Set value to VAR interactively."
9859 (interactive)
9860 (let ((sym (anything-c-symbolify var)))
9861 (set sym (eval-minibuffer (format "Set %s: " var)
9862 (prin1-to-string (symbol-value sym))))))
9863 ;; (setq hh 12)
9864 ;; (anything-c-set-variable 'hh)
9866 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Persistent Action Helpers ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
9867 (defvar anything-match-line-overlay-face nil)
9868 (defvar anything-match-line-overlay nil)
9870 (defun anything-match-line-color-current-line (&optional start end buf face rec)
9871 "Highlight and underline current position"
9872 (let ((args (list (or start (line-beginning-position))
9873 (or end (1+ (line-end-position)))
9874 buf)))
9875 (if (not anything-match-line-overlay)
9876 (setq anything-match-line-overlay (apply 'make-overlay args))
9877 (apply 'move-overlay anything-match-line-overlay args)))
9878 (overlay-put anything-match-line-overlay
9879 'face (or face anything-match-line-overlay-face))
9880 (when rec
9881 (goto-char start)
9882 (recenter)))
9884 (defalias 'anything-persistent-highlight-point 'anything-match-line-color-current-line)
9886 (defface anything-overlay-line-face '((t (:background "IndianRed4" :underline t)))
9887 "Face for source header in the anything buffer." :group 'anything)
9889 (setq anything-match-line-overlay-face 'anything-overlay-line-face)
9891 (defun anything-match-line-cleanup ()
9892 (when anything-match-line-overlay
9893 (delete-overlay anything-match-line-overlay)
9894 (setq anything-match-line-overlay nil)))
9896 (defun anything-match-line-update ()
9897 (when anything-match-line-overlay
9898 (delete-overlay anything-match-line-overlay)
9899 (anything-match-line-color-current-line)))
9901 (add-hook 'anything-cleanup-hook 'anything-match-line-cleanup)
9902 (add-hook 'anything-after-persistent-action-hook 'anything-match-line-update)
9904 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Actions Transformers ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
9905 ;;; Files
9906 (defun anything-c-transform-file-load-el (actions candidate)
9907 "Add action to load the file CANDIDATE if it is an emacs lisp
9908 file. Else return ACTIONS unmodified."
9909 (if (member (file-name-extension candidate) '("el" "elc"))
9910 (append actions '(("Load Emacs Lisp File" . load-file)))
9911 actions))
9913 (defun anything-c-transform-file-browse-url (actions candidate)
9914 "Add an action to browse the file CANDIDATE if it in a html
9915 file or URL. Else return ACTIONS unmodified."
9916 (let ((browse-action '("Browse with Browser" . browse-url)))
9917 (cond ((string-match "^http\\|^ftp" candidate)
9918 (cons browse-action actions))
9919 ((string-match "\\.html?$" candidate)
9920 (append actions (list browse-action)))
9921 (t actions))))
9923 ;;;; Function
9924 (defun anything-c-transform-function-call-interactively (actions candidate)
9925 "Add an action to call the function CANDIDATE interactively if
9926 it is a command. Else return ACTIONS unmodified."
9927 (if (commandp (intern-soft candidate))
9928 (append actions '(("Call Interactively"
9930 anything-c-call-interactively)))
9931 actions))
9933 ;;;; S-Expressions
9934 (defun anything-c-transform-sexp-eval-command-sexp (actions candidate)
9935 "If CANDIDATE's `car' is a command, then add an action to
9936 evaluate it and put it onto the `command-history'."
9937 (if (commandp (car (read candidate)))
9938 ;; Make it first entry
9939 (cons '("Eval and put onto command-history" .
9940 (lambda (sexp)
9941 (let ((sym (read sexp)))
9942 (eval sym)
9943 (setq command-history
9944 (cons sym command-history)))))
9945 actions)
9946 actions))
9948 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Candidate Transformers ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
9949 ;;; Buffers
9950 (defun anything-c-skip-boring-buffers (buffers)
9951 (anything-c-skip-entries buffers anything-c-boring-buffer-regexp))
9953 (defun anything-c-skip-current-buffer (buffers)
9954 (if anything-allow-skipping-current-buffer
9955 (remove (buffer-name anything-current-buffer) buffers)
9956 buffers))
9958 (defun anything-c-shadow-boring-buffers (buffers)
9959 "Buffers matching `anything-c-boring-buffer-regexp' will be
9960 displayed with the `file-name-shadow' face if available."
9961 (anything-c-shadow-entries buffers anything-c-boring-buffer-regexp))
9963 (defvar anything-c-buffer-display-string-functions
9964 '(anything-c-buffer-display-string--compilation
9965 anything-c-buffer-display-string--shell
9966 anything-c-buffer-display-string--eshell)
9967 "Functions to setup display string for buffer.
9969 Function has one argument, buffer name.
9970 If it returns string, use it.
9971 If it returns nil, display buffer name.
9972 See `anything-c-buffer-display-string--compilation' for example.")
9974 (defun anything-c-transform-buffer-display-string (buffers)
9975 "Setup display string for buffer candidates
9976 using `anything-c-buffer-display-string-functions'."
9977 (loop for buf in buffers
9978 if (consp buf)
9979 collect buf
9980 else
9981 for disp = (progn (set-buffer buf)
9982 (run-hook-with-args-until-success
9983 'anything-c-buffer-display-string-functions buf))
9984 collect (if disp (cons disp buf) buf)))
9986 (defun anything-c-buffer-display-string--compilation (buf)
9987 (anything-aif (car compilation-arguments)
9988 (format "%s: %s [%s]" buf it default-directory)))
9989 (defun anything-c-buffer-display-string--eshell (buf)
9990 (when (eq major-mode 'eshell-mode)
9991 (format "%s: %s [%s]" buf
9992 (ignore-errors (ring-ref eshell-history-ring 0))
9993 default-directory)))
9994 (defun anything-c-buffer-display-string--shell (buf)
9995 (when (eq major-mode 'shell-mode)
9996 (format "%s: %s [%s]" buf
9997 (ignore-errors (ring-ref comint-input-ring 0))
9998 default-directory)))
10000 ;;; Files
10001 (defun anything-c-shadow-boring-files (files)
10002 "Files matching `anything-c-boring-file-regexp' will be
10003 displayed with the `file-name-shadow' face if available."
10004 (anything-c-shadow-entries files anything-c-boring-file-regexp))
10006 (defun anything-c-skip-boring-files (files)
10007 "Files matching `anything-c-boring-file-regexp' will be skipped."
10008 (anything-c-skip-entries files anything-c-boring-file-regexp))
10009 ;; (anything-c-skip-boring-files '("README" "/src/.svn/hoge"))
10011 (defun anything-c-skip-current-file (files)
10012 "Current file will be skipped."
10013 (remove (buffer-file-name anything-current-buffer) files))
10015 (defun anything-c-w32-pathname-transformer (args)
10016 "Change undesirable features of windows pathnames to ones more acceptable to
10017 other candidate transformers."
10018 (if (eq system-type 'windows-nt)
10019 (mapcar (lambda (x)
10020 (replace-regexp-in-string "/cygdrive/\\(.\\)" "\\1:" x))
10021 (mapcar (lambda (y)
10022 (replace-regexp-in-string "\\\\" "/" y)) args))
10023 args))
10025 (defun anything-c-shorten-home-path (files)
10026 "Replaces /home/user with ~."
10027 (let ((home (replace-regexp-in-string "\\\\" "/" ; stupid Windows...
10028 (getenv "HOME"))))
10029 (mapcar (lambda (file)
10030 (if (and (stringp file) (string-match home file))
10031 (cons (replace-match "~" nil nil file) file)
10032 file))
10033 files)))
10035 ;;; Functions
10036 (defun anything-c-mark-interactive-functions (functions)
10037 "Mark interactive functions (commands) with (i) after the function name."
10038 (let (list)
10039 (loop for function in functions
10040 do (push (cons (concat function
10041 (when (commandp (intern-soft function)) " (i)"))
10042 function)
10043 list)
10044 finally (return (nreverse list)))))
10046 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Adaptive Sorting of Candidates ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10048 ;; Internal
10049 (defvar anything-c-adaptive-done nil
10050 "nil if history information is not yet stored for the current
10051 selection.")
10053 (defvar anything-c-adaptive-history nil
10054 "Contains the stored history information.
10055 Format: ((SOURCE-NAME (SELECTED-CANDIDATE (PATTERN . NUMBER-OF-USE) ...) ...) ...)")
10057 (defadvice anything-initialize (before anything-c-adaptive-initialize activate)
10058 "Advise `anything-initialize' to reset `anything-c-adaptive-done'
10059 when anything is started."
10060 (when anything-c-use-adaptative-sorting
10061 (setq anything-c-adaptive-done nil)))
10063 (defadvice anything-exit-minibuffer (before anything-c-adaptive-exit-minibuffer activate)
10064 "Advise `anything-exit-minibuffer' to store history information
10065 when a candidate is selected with RET."
10066 (when anything-c-use-adaptative-sorting
10067 (anything-c-adaptive-store-selection)))
10069 (defadvice anything-select-action (before anything-c-adaptive-select-action activate)
10070 "Advise `anything-select-action' to store history information
10071 when the user goes to the action list with TAB."
10072 (when anything-c-use-adaptative-sorting
10073 (anything-c-adaptive-store-selection)))
10075 (defun anything-c-source-use-adaptative-p (&optional source-name)
10076 "Return current source only if it use adaptative history, nil otherwise."
10077 (when anything-c-use-adaptative-sorting
10078 (let* ((source (or source-name (anything-get-current-source)))
10079 (adapt-source (or (assoc-default 'filtered-candidate-transformer
10080 (assoc (assoc-default 'type source)
10081 anything-type-attributes))
10082 (assoc-default 'candidate-transformer
10083 (assoc (assoc-default 'type source)
10084 anything-type-attributes))
10085 (assoc-default 'filtered-candidate-transformer source)
10086 (assoc-default 'candidate-transformer source))))
10087 (if (listp adapt-source)
10088 (when (member 'anything-c-adaptive-sort adapt-source) source)
10089 (when (eq adapt-source 'anything-c-adaptive-sort) source)))))
10091 (defun anything-c-adaptive-store-selection ()
10092 "Store history information for the selected candidate."
10093 (unless anything-c-adaptive-done
10094 (setq anything-c-adaptive-done t)
10095 (let ((source (anything-c-source-use-adaptative-p)))
10096 (when source
10097 (let* ((source-name (or (assoc-default 'type source)
10098 (assoc-default 'name source)))
10099 (source-info (or (assoc source-name anything-c-adaptive-history)
10100 (progn
10101 (push (list source-name) anything-c-adaptive-history)
10102 (car anything-c-adaptive-history))))
10103 (selection (anything-get-selection))
10104 (selection-info (progn
10105 (setcdr source-info
10106 (cons
10107 (let ((found (assoc selection (cdr source-info))))
10108 (if (not found)
10109 ;; new entry
10110 (list selection)
10112 ;; move entry to the beginning of the
10113 ;; list, so that it doesn't get
10114 ;; trimmed when the history is
10115 ;; truncated
10116 (setcdr source-info
10117 (delete found (cdr source-info)))
10118 found))
10119 (cdr source-info)))
10120 (cadr source-info)))
10121 (pattern-info (progn
10122 (setcdr selection-info
10123 (cons
10124 (let ((found (assoc anything-pattern (cdr selection-info))))
10125 (if (not found)
10126 ;; new entry
10127 (cons anything-pattern 0)
10129 ;; move entry to the beginning of the
10130 ;; list, so if two patterns used the
10131 ;; same number of times then the one
10132 ;; used last appears first in the list
10133 (setcdr selection-info
10134 (delete found (cdr selection-info)))
10135 found))
10136 (cdr selection-info)))
10137 (cadr selection-info))))
10139 ;; increase usage count
10140 (setcdr pattern-info (1+ (cdr pattern-info)))
10142 ;; truncate history if needed
10143 (if (> (length (cdr selection-info)) anything-c-adaptive-history-length)
10144 (setcdr selection-info
10145 (subseq (cdr selection-info) 0 anything-c-adaptive-history-length))))))))
10147 (defun anything-c-adaptative-maybe-load-history ()
10148 (when (and anything-c-use-adaptative-sorting
10149 (file-readable-p anything-c-adaptive-history-file))
10150 (load-file anything-c-adaptive-history-file)))
10152 (add-hook 'emacs-startup-hook 'anything-c-adaptative-maybe-load-history)
10153 (add-hook 'kill-emacs-hook 'anything-c-adaptive-save-history)
10155 (defun anything-c-adaptive-save-history ()
10156 "Save history information to file given by `anything-c-adaptive-history-file'."
10157 (interactive)
10158 (when anything-c-use-adaptative-sorting
10159 (with-temp-buffer
10160 (insert
10161 ";; -*- mode: emacs-lisp -*-\n"
10162 ";; History entries used for anything adaptive display.\n")
10163 (prin1 `(setq anything-c-adaptive-history ',anything-c-adaptive-history)
10164 (current-buffer))
10165 (insert ?\n)
10166 (write-region (point-min) (point-max) anything-c-adaptive-history-file nil
10167 (unless (interactive-p) 'quiet)))))
10169 (defun anything-c-adaptive-sort (candidates source)
10170 "Sort the CANDIDATES for SOURCE by usage frequency.
10171 This is a filtered candidate transformer you can use for the
10172 attribute `filtered-candidate-transformer' of a source in
10173 `anything-sources' or a type in `anything-type-attributes'."
10174 (let* ((source-name (or (assoc-default 'type source)
10175 (assoc-default 'name source)))
10176 (source-info (assoc source-name anything-c-adaptive-history)))
10177 (if source-info
10178 (let ((usage
10179 ;; ... assemble a list containing the (CANIDATE . USAGE-COUNT)
10180 ;; pairs
10181 (mapcar (lambda (candidate-info)
10182 (let ((count 0))
10183 (dolist (pattern-info (cdr candidate-info))
10184 (if (not (equal (car pattern-info)
10185 anything-pattern))
10186 (incf count (cdr pattern-info))
10188 ;; if current pattern is equal to the previously
10189 ;; used one then this candidate has priority
10190 ;; (that's why its count is boosted by 10000) and
10191 ;; it only has to compete with other candidates
10192 ;; which were also selected with the same pattern
10193 (setq count (+ 10000 (cdr pattern-info)))
10194 (return)))
10195 (cons (car candidate-info) count)))
10196 (cdr source-info)))
10197 sorted)
10198 (if (and usage (consp usage))
10199 ;; sort the list in descending order, so candidates with highest
10200 ;; priorty come first
10201 (progn
10202 (setq usage (sort usage (lambda (first second)
10203 (> (cdr first) (cdr second)))))
10205 ;; put those candidates first which have the highest usage count
10206 (dolist (info usage)
10207 (when (member* (car info) candidates
10208 :test 'anything-c-adaptive-compare)
10209 (push (car info) sorted)
10210 (setq candidates (remove* (car info) candidates
10211 :test 'anything-c-adaptive-compare))))
10213 ;; and append the rest
10214 (append (reverse sorted) candidates nil))
10215 (message "Your `%s' is maybe corrupted or too old, \
10216 you should reinitialize it with `anything-c-reset-adaptative-history'"
10217 anything-c-adaptive-history-file)
10218 (sit-for 1)
10219 candidates))
10220 ;; if there is no information stored for this source then do nothing
10221 candidates)))
10223 ;;;###autoload
10224 (defun anything-c-reset-adaptative-history ()
10225 "Delete all `anything-c-adaptive-history' and his file.
10226 Useful when you have a old or corrupted `anything-c-adaptive-history-file'."
10227 (interactive)
10228 (when (y-or-n-p "Really delete all your `anything-c-adaptive-history'? ")
10229 (setq anything-c-adaptive-history nil)
10230 (delete-file anything-c-adaptive-history-file)))
10232 (defun anything-c-adaptive-compare (x y)
10233 "Compare candidates X and Y taking into account that the
10234 candidate can be in (DISPLAY . REAL) format."
10235 (equal (if (listp x)
10236 (cdr x)
10238 (if (listp y)
10239 (cdr y)
10240 y)))
10242 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Outliner ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10243 (defvar anything-outline-goto-near-line-flag t)
10244 (defvar anything-outline-using nil)
10245 (defun anything-after-update-hook--outline ()
10246 (if (and (eq anything-outline-using t)
10247 (eq anything-outline-goto-near-line-flag t))
10248 (anything-outline-goto-near-line)))
10249 (add-hook 'anything-after-update-hook 'anything-after-update-hook--outline)
10251 (defun anything-outline-goto-near-line ()
10252 (with-anything-window
10253 ;; TODO need consideration whether to update position by every input.
10254 (when t ; (equal anything-pattern "")
10255 (anything-goto-line 2)
10256 (let ((lineno (with-current-buffer anything-current-buffer
10257 (line-number-at-pos (car anything-current-position)))))
10258 (block exit
10259 (while (<= (progn (skip-chars-forward " ")
10260 (or (number-at-point) lineno))
10261 lineno)
10262 (forward-line 1)
10263 (when (eobp)
10264 (forward-line -1)
10265 (return-from exit))))
10266 (forward-line -1)
10267 (and (bobp) (forward-line 1))
10268 (and (anything-pos-header-line-p) (forward-line -2))
10269 (anything-mark-current-line)))))
10271 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Plug-in ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10272 ;; Plug-in: info-index
10273 (defun* anything-c-info-init (&optional (file (anything-attr 'info-file)))
10274 (let (result)
10275 (unless (anything-candidate-buffer)
10276 (save-window-excursion
10277 (info file)
10278 (let (Info-history
10279 (tobuf (anything-candidate-buffer 'global))
10280 (infobuf (current-buffer))
10281 s e)
10282 (dolist (node (or (anything-attr 'index-nodes) (Info-index-nodes)))
10283 (Info-goto-node node)
10284 (goto-char (point-min))
10285 (while (search-forward "\n* " nil t)
10286 (unless (search-forward "Menu:\n" (1+ (point-at-eol)) t)
10287 '(save-current-buffer (buffer-substring-no-properties (point-at-bol) (point-at-eol)) result)
10288 (setq s (point-at-bol)
10289 e (point-at-eol))
10290 (with-current-buffer tobuf
10291 (insert-buffer-substring infobuf s e)
10292 (insert "\n"))))))))))
10294 (defun anything-c-info-goto (node-line)
10295 (Info-goto-node (car node-line))
10296 (anything-goto-line (cdr node-line)))
10298 (defun anything-c-info-display-to-real (line)
10299 (and (string-match
10300 ;; This regexp is stolen from Info-apropos-matches
10301 "\\* +\\([^\n]*.+[^\n]*\\):[ \t]+\\([^\n]*\\)\\.\\(?:[ \t\n]*(line +\\([0-9]+\\))\\)?" line)
10302 (cons (format "(%s)%s" (anything-attr 'info-file) (match-string 2 line))
10303 (string-to-number (or (match-string 3 line) "1")))))
10305 (defun anything-c-make-info-source (source file)
10306 `(,@source
10307 (name . ,(concat "Info Index: " file))
10308 (info-file . ,file)
10309 (init . anything-c-info-init)
10310 (display-to-real . anything-c-info-display-to-real)
10311 (get-line . buffer-substring)
10312 (candidates-in-buffer)
10313 (action ("Goto node" . anything-c-info-goto))))
10315 (defun anything-compile-source--info-index (source)
10316 (anything-aif (anything-interpret-value (assoc-default 'info-index source))
10317 (anything-c-make-info-source source it)
10318 source))
10319 (add-to-list 'anything-compile-source-functions 'anything-compile-source--info-index)
10321 (anything-document-attribute 'info-index "info-index plugin"
10322 "Create a source of info index very easily.
10324 ex. (defvar anything-c-source-info-wget '((info-index . \"wget\"))")
10326 (anything-document-attribute 'index-nodes "info-index plugin (optional)"
10327 "Index nodes of info file.
10329 If it is omitted, `Info-index-nodes' is used to collect index nodes.
10330 Some info files are missing index specification.
10332 ex. See `anything-c-source-info-screen'.")
10334 ;; Plug-in: candidates-file
10335 (defun anything-compile-source--candidates-file (source)
10336 (if (assoc-default 'candidates-file source)
10337 `((init anything-p-candidats-file-init
10338 ,@(let ((orig-init (assoc-default 'init source)))
10339 (cond ((null orig-init) nil)
10340 ((functionp orig-init) (list orig-init))
10341 (t orig-init))))
10342 (candidates-in-buffer)
10343 ,@source)
10344 source))
10345 (add-to-list 'anything-compile-source-functions 'anything-compile-source--candidates-file)
10347 (defun anything-p-candidats-file-init ()
10348 (destructuring-bind (file &optional updating)
10349 (anything-mklist (anything-attr 'candidates-file))
10350 (setq file (anything-interpret-value file))
10351 (with-current-buffer (anything-candidate-buffer (find-file-noselect file))
10352 (when updating
10353 (buffer-disable-undo)
10354 (font-lock-mode -1)
10355 (auto-revert-mode 1)))))
10357 (anything-document-attribute 'candidates-file "candidates-file plugin"
10358 "Use a file as the candidates buffer.
10360 1st argument is a filename, string or function name or variable name.
10361 If optional 2nd argument is non-nil, the file opened with `auto-revert-mode'.")
10363 ;; Plug-in: headline
10364 (defun anything-compile-source--anything-headline (source)
10365 (if (assoc-default 'headline source)
10366 (append '((init . anything-headline-init)
10367 (get-line . buffer-substring)
10368 (type . line))
10369 source
10370 '((candidates-in-buffer)
10371 (persistent-help . "Show this line")))
10372 source))
10373 (add-to-list 'anything-compile-source-functions 'anything-compile-source--anything-headline)
10375 (defun anything-headline-init ()
10376 (when (and (anything-current-buffer-is-modified)
10377 (with-current-buffer anything-current-buffer
10378 (eval (or (anything-attr 'condition) t))))
10379 (anything-headline-make-candidate-buffer
10380 (anything-interpret-value (anything-attr 'headline))
10381 (anything-interpret-value (anything-attr 'subexp)))))
10383 (anything-document-attribute 'headline "Headline plug-in"
10384 "Regexp string for anything-headline to scan.")
10385 (anything-document-attribute 'condition "Headline plug-in"
10386 "A sexp representing the condition to use anything-headline.")
10387 (anything-document-attribute 'subexp "Headline plug-in"
10388 "Display (match-string-no-properties subexp).")
10391 (defun anything-headline-get-candidates (regexp subexp)
10392 (with-current-buffer anything-current-buffer
10393 (save-excursion
10394 (goto-char (point-min))
10395 (if (functionp regexp) (setq regexp (funcall regexp)))
10396 (let (hierarchy curhead)
10397 (flet ((matched ()
10398 (if (numberp subexp)
10399 (cons (match-string-no-properties subexp) (match-beginning subexp))
10400 (cons (buffer-substring (point-at-bol) (point-at-eol))
10401 (point-at-bol))))
10402 (hierarchies (headlines)
10403 (1+ (loop for (_ . hierarchy) in headlines
10404 maximize hierarchy)))
10405 (vector-0-n (v n)
10406 (loop for i from 0 to hierarchy
10407 collecting (aref curhead i)))
10408 (arrange (headlines)
10409 (unless (null headlines) ; FIX headlines empty bug!
10410 (loop with curhead = (make-vector (hierarchies headlines) "")
10411 for ((str . pt) . hierarchy) in headlines
10412 do (aset curhead hierarchy str)
10413 collecting
10414 (cons
10415 (format "H%d:%s" (1+ hierarchy)
10416 (mapconcat 'identity (vector-0-n curhead hierarchy) " / "))
10417 pt)))))
10418 (if (listp regexp)
10419 (arrange
10420 (sort
10421 (loop for re in regexp
10422 for hierarchy from 0
10423 do (goto-char (point-min))
10424 appending
10425 (loop
10426 while (re-search-forward re nil t)
10427 collect (cons (matched) hierarchy)))
10428 (lambda (a b) (> (cdar b) (cdar a)))))
10429 (loop while (re-search-forward regexp nil t)
10430 collect (matched))))))))
10433 (defun anything-headline-make-candidate-buffer (regexp subexp)
10434 (with-current-buffer (anything-candidate-buffer 'local)
10435 (loop for (content . pos) in (anything-headline-get-candidates regexp subexp)
10436 do (insert
10437 (format "%5d:%s\n"
10438 (with-current-buffer anything-current-buffer
10439 (line-number-at-pos pos))
10440 content)))))
10442 (defun anything-headline-goto-position (pos recenter)
10443 (goto-char pos)
10444 (unless recenter
10445 (set-window-start (get-buffer-window anything-current-buffer) (point))))
10447 (defun anything-revert-buffer (candidate)
10448 (with-current-buffer candidate
10449 (when (or (buffer-modified-p)
10450 (not (verify-visited-file-modtime
10451 (get-buffer candidate))))
10452 (revert-buffer t t))))
10454 (defun anything-revert-marked-buffers (ignore)
10455 (mapc 'anything-revert-buffer (anything-marked-candidates)))
10457 (defun anything-kill-marked-buffers (ignore)
10458 (mapc 'kill-buffer (anything-marked-candidates)))
10460 ;; Plug-in: persistent-help
10461 (defun anything-compile-source--persistent-help (source)
10462 (append source '((header-line . anything-persistent-help-string))))
10463 (add-to-list 'anything-compile-source-functions 'anything-compile-source--persistent-help)
10465 (defun anything-persistent-help-string ()
10466 (substitute-command-keys
10467 (concat "\\<anything-map>\\[anything-execute-persistent-action]: "
10468 (or (anything-interpret-value (anything-attr 'persistent-help))
10469 (anything-aif (or (assoc-default 'persistent-action
10470 (anything-get-current-source))
10471 (assoc-default 'action
10472 (anything-get-current-source)))
10473 (cond ((symbolp it) (symbol-name it))
10474 ((listp it) (or (ignore-errors (caar it)) ""))))
10476 " (keeping session)")))
10478 (anything-document-attribute 'persistent-help "persistent-help plug-in"
10479 "A string to explain persistent-action of this source.
10480 It also accepts a function or a variable name.")
10482 ;;; (anything '(((name . "persistent-help test")(candidates "a")(persistent-help . "TEST"))))
10484 ;; Plug-in: Type customize
10485 (defun anything-c-uniq-list (lst)
10486 "Like `remove-duplicates' in CL.
10487 But cut deeper duplicates and test by `equal'. "
10488 (reverse (remove-duplicates (reverse lst) :test 'equal)))
10489 (defvar anything-additional-type-attributes nil)
10490 (defun anything-c-arrange-type-attribute (type spec)
10491 "Override type attributes by `define-anything-type-attribute'.
10493 The SPEC is like source. The symbol `REST' is replaced with original attribute value.
10495 Example: Set `play-sound-file' as default action
10496 (anything-c-arrange-type-attribute 'file
10497 '((action (\"Play sound\" . play-sound-file)
10498 REST ;; Rest of actions (find-file, find-file-other-window, ...)
10501 (add-to-list 'anything-additional-type-attributes
10502 (cons type
10503 (loop with typeattr = (assoc-default type anything-type-attributes)
10504 for (attr . value) in spec
10505 if (listp value)
10506 collect (cons attr
10507 (anything-c-uniq-list
10508 (loop for v in value
10509 if (eq v 'REST)
10510 append (assoc-default attr typeattr)
10511 else
10512 collect v)))
10513 else
10514 collect (cons attr value)))))
10515 (put 'anything-c-arrange-type-attribute 'lisp-indent-function 1)
10517 (defun anything-compile-source--type-customize (source)
10518 (anything-aif (assoc-default (assoc-default 'type source) anything-additional-type-attributes)
10519 (append it source)
10520 source))
10521 (add-to-list 'anything-compile-source-functions 'anything-compile-source--type-customize t)
10523 ;; Plug-in: default-action
10524 (defun anything-compile-source--default-action (source)
10525 (anything-aif (assoc-default 'default-action source)
10526 (append `((action ,it ,@(remove it (assoc-default 'action source))))
10527 source)
10528 source))
10529 (add-to-list 'anything-compile-source-functions 'anything-compile-source--default-action t)
10530 (anything-document-attribute 'default-action "default-action plug-in"
10531 "Default action.")
10533 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10535 (defun anything-c-find-file-or-marked (candidate)
10536 "Open file CANDIDATE or open anything marked files in background."
10537 (let ((marked (anything-marked-candidates))
10538 (ffap-newfile-prompt anything-ff-newfile-prompt-p)
10539 (find-file-wildcards nil))
10540 (if (> (length marked) 1)
10541 ;; Open all marked files in background and display
10542 ;; the first one.
10543 (progn (mapc 'find-file-noselect (cdr marked))
10544 (find-file (car marked)))
10545 (if (and (not (file-exists-p candidate))
10546 (and ffap-url-regexp
10547 (not (string-match ffap-url-regexp candidate)))
10548 (string-match "/$" candidate))
10549 ;; A a non--existing filename ending with /
10550 ;; Create a directory and jump to it.
10551 (when (y-or-n-p (format "Create directory `%s'? " candidate))
10552 (let ((dirfname (directory-file-name candidate)))
10553 (if (file-exists-p dirfname)
10554 (error "Mkdir: Unable to create directory `%s': file exists."
10555 (anything-c-basename dirfname))
10556 (make-directory candidate 'parent)))
10557 (anything-find-files1 candidate))
10558 ;; A non--existing filename NOT ending with / or
10559 ;; an existing filename, create or jump to it.
10560 (find-file-at-point (car marked))))))
10562 (defun anything-delete-marked-files (ignore)
10563 (let* ((files (anything-marked-candidates))
10564 (len (length files)))
10565 (if (not (y-or-n-p
10566 (format "Delete *%s File(s):\n%s"
10568 (mapconcat (lambda (f) (format "- %s\n" f)) files ""))))
10569 (message "(No deletions performed)")
10570 (dolist (i files)
10571 (set-text-properties 0 (length i) nil i)
10572 (anything-c-delete-file i))
10573 (message "%s File(s) deleted" len))))
10575 (defun anything-ediff-marked-buffers (candidate &optional merge)
10576 "Ediff 2 marked buffers or 1 marked buffer and current-buffer.
10577 With optional arg `merge' call `ediff-merge-buffers'."
10578 (let ((lg-lst (length (anything-marked-candidates)))
10579 buf1 buf2)
10580 (case lg-lst
10582 (error "Error:You have to mark at least 1 buffer"))
10584 (setq buf1 anything-current-buffer
10585 buf2 (first (anything-marked-candidates))))
10587 (setq buf1 (first (anything-marked-candidates))
10588 buf2 (second (anything-marked-candidates))))
10590 (error "Error:To much buffers marked!")))
10591 (if merge
10592 (ediff-merge-buffers buf1 buf2)
10593 (ediff-buffers buf1 buf2))))
10595 (defun anything-bookmark-get-bookmark-from-name (bmk)
10596 "Return bookmark name even if it is a bookmark with annotation.
10597 e.g prepended with *.
10598 Return nil if bmk is not a valid bookmark."
10599 (let ((bookmark (replace-regexp-in-string "\*" "" bmk)))
10600 (if (assoc bookmark bookmark-alist)
10601 bookmark
10602 (when (assoc bmk bookmark-alist)
10603 bmk))))
10605 (defun anything-delete-marked-bookmarks (ignore)
10606 "Delete this bookmark or all marked bookmarks."
10607 (dolist (i (anything-marked-candidates))
10608 (bookmark-delete (anything-bookmark-get-bookmark-from-name i)
10609 'batch)))
10611 (defun anything-require-or-error (feature function)
10612 (or (require feature nil t)
10613 (error "Need %s to use `%s'." feature function)))
10615 (defun anything-find-buffer-on-elscreen (candidate)
10616 "Open buffer in new screen, if marked buffers open all in elscreens."
10617 (anything-require-or-error 'elscreen 'anything-find-buffer-on-elscreen)
10618 (anything-aif (anything-marked-candidates)
10619 (dolist (i it)
10620 (let ((target-screen (elscreen-find-screen-by-buffer
10621 (get-buffer i) 'create)))
10622 (elscreen-goto target-screen)))
10623 (let ((target-screen (elscreen-find-screen-by-buffer
10624 (get-buffer candidate) 'create)))
10625 (elscreen-goto target-screen))))
10627 (defun anything-elscreen-find-file (file)
10628 (anything-require-or-error 'elscreen 'anything-elscreen-find-file)
10629 (elscreen-find-file file))
10631 ;; Toggle anything-match-plugin
10632 (defvar anything-mp-initial-highlight-delay nil)
10633 (defun anything-c-toggle-match-plugin ()
10634 "Toggle anything-match-plugin."
10635 (interactive)
10636 (let ((anything-match-plugin-enabled
10637 (member 'anything-compile-source--match-plugin
10638 anything-compile-source-functions)))
10639 (flet ((disable-match-plugin ()
10640 (setq anything-compile-source-functions
10641 (delq 'anything-compile-source--match-plugin
10642 anything-compile-source-functions))
10643 (setq anything-mp-initial-highlight-delay
10644 anything-mp-highlight-delay)
10645 (setq anything-mp-highlight-delay nil))
10646 (enable-match-plugin ()
10647 (require 'anything-match-plugin)
10648 (unless anything-mp-initial-highlight-delay
10649 (setq anything-mp-initial-highlight-delay
10650 anything-mp-highlight-delay))
10651 (setq anything-compile-source-functions
10652 (cons 'anything-compile-source--match-plugin
10653 anything-compile-source-functions))
10654 (unless anything-mp-highlight-delay
10655 (setq anything-mp-highlight-delay
10656 anything-mp-initial-highlight-delay))))
10657 (if anything-match-plugin-enabled
10658 (when (y-or-n-p "Really disable match-plugin? ")
10659 (disable-match-plugin)
10660 (message "Anything-match-plugin disabled"))
10661 (when (y-or-n-p "Really enable match-plugin? ")
10662 (enable-match-plugin)
10663 (message "Anything-match-plugin enabled"))))))
10665 ;; anything switch to buffer
10666 ;; Shut up byte compiler in emacs24.
10668 (defun anything-c-switch-to-buffer (buffer-or-name)
10669 "Same as `switch-to-buffer' whithout warnings at compile time."
10670 (with-no-warnings
10671 (switch-to-buffer buffer-or-name)))
10673 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Setup ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10675 ;;;; Type Attributes
10676 (define-anything-type-attribute 'buffer
10677 `((action
10678 ("Switch to buffer" . anything-c-switch-to-buffer)
10679 ,(and (locate-library "popwin") '("Switch to buffer in popup window" . popwin:popup-buffer))
10680 ("Switch to buffer other window" . switch-to-buffer-other-window)
10681 ("Switch to buffer other frame" . switch-to-buffer-other-frame)
10682 ,(and (locate-library "elscreen") '("Display buffer in Elscreen" . anything-find-buffer-on-elscreen))
10683 ("Query replace regexp" . anything-c-buffer-query-replace-regexp)
10684 ("View buffer" . view-buffer)
10685 ("Display buffer" . display-buffer)
10686 ("Grep buffers (C-u grep all buffers)" . anything-c-grep-buffers)
10687 ("Revert buffer(s)" . anything-revert-marked-buffers)
10688 ("Insert buffer" . insert-buffer)
10689 ("Kill buffer(s)" . anything-kill-marked-buffers)
10690 ("Diff with file" . diff-buffer-with-file)
10691 ("Ediff Marked buffers" . anything-ediff-marked-buffers)
10692 ("Ediff Merge marked buffers" . (lambda (candidate)
10693 (anything-ediff-marked-buffers candidate t))))
10694 (persistent-help . "Show this buffer")
10695 (candidate-transformer anything-c-skip-current-buffer
10696 anything-c-skip-boring-buffers
10697 anything-c-transform-buffer-display-string))
10698 "Buffer or buffer name.")
10700 (define-anything-type-attribute 'file
10701 `((action
10702 ("Find file" . anything-find-many-files)
10703 ,(and (locate-library "popwin") '("Find file in popup window" . popwin:find-file))
10704 ("Find file as root" . anything-find-file-as-root)
10705 ("Find file other window" . find-file-other-window)
10706 ("Find file other frame" . find-file-other-frame)
10707 ("Open dired in file's directory" . anything-c-open-dired)
10708 ("Grep File(s) `C-u recurse'" . anything-find-files-grep)
10709 ("Pdfgrep File(s)" . anything-ff-pdfgrep)
10710 ("View file" . view-file)
10711 ("Insert file" . insert-file)
10712 ("Delete file(s)" . anything-delete-marked-files)
10713 ("Open file externally (C-u to choose)" . anything-c-open-file-externally)
10714 ("Open file with default tool" . anything-c-open-file-with-default-tool)
10715 ("Find file in hex dump" . hexl-find-file))
10716 (persistent-help . "Show this file")
10717 (action-transformer anything-c-transform-file-load-el
10718 anything-c-transform-file-browse-url)
10719 (candidate-transformer anything-c-w32-pathname-transformer
10720 anything-c-skip-current-file
10721 anything-c-skip-boring-files
10722 anything-c-shorten-home-path))
10723 "File name.")
10725 (let ((actions '(("Describe command" . describe-function)
10726 ("Add command to kill ring" . anything-c-kill-new)
10727 ("Go to command's definition" . find-function)
10728 ("Debug on entry" . debug-on-entry)
10729 ("Cancel debug on entry" . cancel-debug-on-entry)
10730 ("Trace function" . trace-function)
10731 ("Trace function (background)" . trace-function-background)
10732 ("Untrace function" . untrace-function))))
10733 (define-anything-type-attribute 'command
10734 `((action ("Call interactively" . anything-c-call-interactively)
10735 ,@actions)
10736 ;; Sort commands according to their usage count.
10737 ;(filtered-candidate-transformer . anything-c-adaptive-sort)
10738 (coerce . anything-c-symbolify)
10739 (persistent-action . describe-function))
10740 "Command. (string or symbol)")
10742 (define-anything-type-attribute 'function
10743 `((action . ,actions)
10744 (action-transformer anything-c-transform-function-call-interactively)
10745 (candidate-transformer anything-c-mark-interactive-functions)
10746 (coerce . anything-c-symbolify))
10747 "Function. (string or symbol)"))
10749 (define-anything-type-attribute 'variable
10750 '((action ("Describe variable" . describe-variable)
10751 ("Add variable to kill ring" . anything-c-kill-new)
10752 ("Go to variable's definition" . find-variable)
10753 ("Set variable" . anything-c-set-variable))
10754 (coerce . anything-c-symbolify))
10755 "Variable.")
10757 (define-anything-type-attribute 'sexp
10758 '((action ("Eval s-expression" . (lambda (c) (eval (read c))))
10759 ("Add s-expression to kill ring" . kill-new))
10760 (action-transformer anything-c-transform-sexp-eval-command-sexp))
10761 "String representing S-Expressions.")
10763 (define-anything-type-attribute 'bookmark
10764 `((coerce . anything-bookmark-get-bookmark-from-name)
10765 (action
10766 ("Jump to bookmark" . (lambda (bookmark)
10767 (let ((current-prefix-arg anything-current-prefix-arg))
10768 (bookmark-jump bookmark))
10769 (anything-update)))
10770 ("Jump to BM other window" . (lambda (bookmark)
10771 (bookmark-jump-other-window bookmark)
10772 (anything-update)))
10773 ("Bookmark edit annotation" . bookmark-edit-annotation)
10774 ("Bookmark show annotation" . bookmark-show-annotation)
10775 ("Delete bookmark(s)" . anything-delete-marked-bookmarks)
10776 ,@(and (locate-library "bookmark-extensions")
10777 `(("Edit Bookmark" . bmkext-edit-bookmark)))
10778 ("Rename bookmark" . bookmark-rename)
10779 ("Relocate bookmark" . bookmark-relocate)))
10780 "Bookmark name.")
10782 (define-anything-type-attribute 'line
10783 '((display-to-real . anything-c-display-to-real-line)
10784 (action ("Go to Line" . anything-c-action-line-goto)))
10785 "LINENO:CONTENT string, eg. \" 16:foo\".
10787 Optional `target-file' attribute is a name of target file.
10789 Optional `before-jump-hook' attribute is a function with no
10790 arguments which is called before jumping to position.
10792 Optional `after-jump-hook' attribute is a function with no
10793 arguments which is called after jumping to position.
10795 If `adjust' attribute is specified, searches the line whose
10796 content is CONTENT near the LINENO.
10798 If `recenter' attribute is specified, the line is displayed at
10799 the center of window, otherwise at the top of window.
10802 (define-anything-type-attribute 'file-line
10803 `((filtered-candidate-transformer anything-c-filtered-candidate-transformer-file-line)
10804 (multiline)
10805 (action ("Go to" . anything-c-action-file-line-goto)))
10806 "FILENAME:LINENO:CONTENT string, eg. \"~/.emacs:16:;; comment\".
10808 Optional `default-directory' attribute is a default-directory
10809 FILENAME is interpreted.
10811 Optional `before-jump-hook' attribute is a function with no
10812 arguments which is called before jumping to position.
10814 Optional `after-jump-hook' attribute is a function with no
10815 arguments which is called after jumping to position.
10817 If `adjust' attribute is specified, searches the line whose
10818 content is CONTENT near the LINENO.
10820 If `recenter' attribute is specified, the line is displayed at
10821 the center of window, otherwise at the top of window.
10824 (define-anything-type-attribute 'timer
10825 '((real-to-display . anything-c-timer-real-to-display)
10826 (action ("Cancel Timer" . cancel-timer)
10827 ("Describe Function" . (lambda (tm) (describe-function (timer--function tm))))
10828 ("Find Function" . (lambda (tm) (find-function (timer--function tm)))))
10829 (persistent-action . (lambda (tm) (describe-function (timer--function tm))))
10830 (persistent-help . "Describe Function"))
10831 "Timer.")
10833 ;;;; Default `anything-sources'
10834 ;; Setting `anything-sources' is DEPRECATED, but it seems that newbies
10835 ;; tend to invoke M-x anything directly. So I offer default setting.
10836 (setq anything-sources
10837 '(anything-c-source-buffers+
10838 anything-c-source-recentf
10839 anything-c-source-files-in-current-dir+))
10841 ;; Unit tests are now in ../developer-tools/unit-test-anything-config.el.
10843 (provide 'anything-config)
10845 ;;; Local Variables:
10846 ;;; time-stamp-format: "%:y-%02m-%02d %02H:%02M:%02S (%Z) %u"
10847 ;;; End:
10849 ;; How to save (DO NOT REMOVE!!)
10850 ;; (progn (magit-push) (emacswiki-post "anything-config.el"))
10851 ;;; anything-config.el ends here
10853 ;;; LocalWords: Tassilo Patrovics Vagn Johansen Dahl Clementson infos
10854 ;;; LocalWords: Kamphausen informations McBrayer Volpiatto bbdb bb
10855 ;;; LocalWords: iswitchb imenu Recentf sym samewindow pos bol eol
10856 ;;; LocalWords: aif str lst func attrib recentf lessp prin mapatoms commandp
10857 ;;; LocalWords: cmd stb Picklist picklist mapcan subentry destructuring dirs
10858 ;;; LocalWords: darwin locat MacOS mdfind Firstname Lastname calc prepend jids
10859 ;;; LocalWords: dotimes Thierry online vname
10860 ;;; LocalWords: csharp javascript lua makefile cperl zcat lineno buf
10861 ;;; LocalWords: multiline href fn cand NewTitle cwd filepath thru ret
10862 ;;; LocalWords: bfn fOpen UNC cygdrive nt xdg macos FILE's elc rx svn hg
10863 ;;; LocalWords: CANDIDATE's darcs facep pathname args pathnames subseq priorty
10864 ;;; LocalWords: Vokes rfind berkeley JST ffap lacarte bos
10865 ;;; LocalWords: Lacarte Minibuf epp LaCarte bm attrset migemo attr conf mklist
10866 ;;; LocalWords: startpos noselect dont desc