* anything-config.el (anything-esh-pcomplete): Use named buffer.
[anything-config.git] / anything-config.el
blob9b6b9e9be5c12e3bc7d01c5ec638932b7966d42f
1 ;;; anything-config.el --- Applications libary for `anything.el'
3 ;; Filename: anything-config.el
5 ;; Description: Applications libary for `anything.el'
7 ;; Author: Tassilo Horn <tassilo@member.fsf.org>
9 ;; Maintainer: Tassilo Horn <tassilo@member.fsf.org>
10 ;; rubikitch <rubikitch@ruby-lang.org>
11 ;; Thierry Volpiatto <thierry.volpiatto@gmail.com>
12 ;; Copyright (C) 2007 ~ 2011, Tassilo Horn, all rights reserved.
13 ;; Copyright (C) 2009, Andy Stewart, all rights reserved.
14 ;; Copyright (C) 2009 ~ 2012, rubikitch, all rights reserved.
15 ;; Copyright (C) 2009 ~ 2012, Thierry Volpiatto, all rights reserved.
17 ;; Created: 2009-02-16 21:38:23
19 ;; X-URL: <http://repo.or.cz/w/anything-config.git>
21 ;; MailingList: <https://groups.google.com/group/emacs-anything?hl=en>
23 ;; Keywords: anything, anything-config
25 ;; Compatibility: GNU Emacs 22 ~ 24
27 ;; Dependencies: `anything.el', `anything-match-plugin.el'.
29 ;;; This file is NOT part of GNU Emacs
31 ;;; License
33 ;; This program is free software; you can redistribute it and/or modify
34 ;; it under the terms of the GNU General Public License as published by
35 ;; the Free Software Foundation; either version 3, or (at your option)
36 ;; any later version.
38 ;; This program is distributed in the hope that it will be useful,
39 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
40 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
41 ;; GNU General Public License for more details.
43 ;; You should have received a copy of the GNU General Public License
44 ;; along with this program; see the file COPYING. If not, write to
45 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
46 ;; Floor, Boston, MA 02110-1301, USA.
48 ;;; Commentary:
50 ;; Predefined configurations for `anything.el'
52 ;; For quick start, try `anything-for-files' to open files.
54 ;; To configure anything you should define anything command
55 ;; with your favorite sources, like below:
57 ;; (defun my-anything ()
58 ;; (interactive)
59 ;; (anything-other-buffer
60 ;; '(anything-c-source-buffers
61 ;; anything-c-source-file-name-history
62 ;; anything-c-source-info-pages
63 ;; anything-c-source-info-elisp
64 ;; anything-c-source-man-pages
65 ;; anything-c-source-locate
66 ;; anything-c-source-emacs-commands)
67 ;; " *my-anything*"))
69 ;; Then type M-x my-anything to use sources.
71 ;; Defining own command is better than setup `anything-sources'
72 ;; directly, because you can define multiple anything commands with
73 ;; different sources. Each anything command should have own anything
74 ;; buffer, because M-x anything-resume revives anything command.
76 ;; NOTE: What you find on Emacswiki is mostly deprecated and not maintained,
77 ;; don't complain if you use such code or configuration and something
78 ;; doesn't work.
81 ;;; Autodoc documentation:
82 ;; ---------------------
84 ;; * Commands defined here are:
85 ;; [EVAL] (autodoc-document-lisp-buffer :type 'command :prefix "anything-" :docstring t)
86 ;; `anything-configuration'
87 ;; Customize `anything'.
88 ;; `anything-c-buffer-help'
89 ;; Help command for anything buffers.
90 ;; `anything-ff-help'
91 ;; Help command for `anything-find-files'.
92 ;; `anything-read-file-name-help'
93 ;; Not documented.
94 ;; `anything-generic-file-help'
95 ;; Not documented.
96 ;; `anything-grep-help'
97 ;; Not documented.
98 ;; `anything-pdfgrep-help'
99 ;; Not documented.
100 ;; `anything-etags-help'
101 ;; The help function for etags.
102 ;; `anything-c-ucs-help'
103 ;; Help command for `anything-ucs'.
104 ;; `anything-c-bookmark-help'
105 ;; Help command for bookmarks.
106 ;; `anything-show-this-source-only'
107 ;; Show all candidates of this source.
108 ;; `anything-test-sources'
109 ;; List all anything sources for test.
110 ;; `anything-select-source'
111 ;; [OBSOLETE] Select source.
112 ;; `anything-insert-buffer-name'
113 ;; Insert buffer name.
114 ;; `anything-quit-and-find-file'
115 ;; Drop into `anything-find-files' from `anything'.
116 ;; `anything-mark-all'
117 ;; Mark all visible unmarked candidates in current source.
118 ;; `anything-unmark-all'
119 ;; Unmark all candidates in all sources of current anything session.
120 ;; `anything-toggle-all-marks'
121 ;; Toggle all marks.
122 ;; `anything-buffer-diff-persistent'
123 ;; Toggle diff buffer without quitting anything.
124 ;; `anything-buffer-revert-persistent'
125 ;; Revert buffer without quitting anything.
126 ;; `anything-buffer-save-persistent'
127 ;; Save buffer without quitting anything.
128 ;; `anything-buffer-run-kill-buffers'
129 ;; Run kill buffer action from `anything-c-source-buffers-list'.
130 ;; `anything-buffer-run-grep'
131 ;; Run Grep action from `anything-c-source-buffers-list'.
132 ;; `anything-buffer-run-zgrep'
133 ;; Run Grep action from `anything-c-source-buffers-list'.
134 ;; `anything-buffer-run-query-replace-regexp'
135 ;; Run Query replace regexp action from `anything-c-source-buffers-list'.
136 ;; `anything-buffer-run-query-replace'
137 ;; Run Query replace action from `anything-c-source-buffers-list'.
138 ;; `anything-buffer-switch-other-window'
139 ;; Run switch to other window action from `anything-c-source-buffers-list'.
140 ;; `anything-buffer-switch-other-frame'
141 ;; Run switch to other frame action from `anything-c-source-buffers-list'.
142 ;; `anything-buffer-switch-to-elscreen'
143 ;; Run switch to elscreen action from `anything-c-source-buffers-list'.
144 ;; `anything-buffer-run-ediff'
145 ;; Run ediff action from `anything-c-source-buffers-list'.
146 ;; `anything-buffer-run-ediff-merge'
147 ;; Run ediff action from `anything-c-source-buffers-list'.
148 ;; `anything-ff-run-toggle-auto-update'
149 ;; Not documented.
150 ;; `anything-ff-run-switch-to-history'
151 ;; Run Switch to history action from `anything-c-source-find-files'.
152 ;; `anything-ff-run-grep'
153 ;; Run Grep action from `anything-c-source-find-files'.
154 ;; `anything-ff-run-pdfgrep'
155 ;; Run Pdfgrep action from `anything-c-source-find-files'.
156 ;; `anything-ff-run-zgrep'
157 ;; Run Grep action from `anything-c-source-find-files'.
158 ;; `anything-ff-run-copy-file'
159 ;; Run Copy file action from `anything-c-source-find-files'.
160 ;; `anything-ff-run-rename-file'
161 ;; Run Rename file action from `anything-c-source-find-files'.
162 ;; `anything-ff-run-byte-compile-file'
163 ;; Run Byte compile file action from `anything-c-source-find-files'.
164 ;; `anything-ff-run-load-file'
165 ;; Run Load file action from `anything-c-source-find-files'.
166 ;; `anything-ff-run-eshell-command-on-file'
167 ;; Run eshell command on file action from `anything-c-source-find-files'.
168 ;; `anything-ff-run-ediff-file'
169 ;; Run Ediff file action from `anything-c-source-find-files'.
170 ;; `anything-ff-run-ediff-merge-file'
171 ;; Run Ediff merge file action from `anything-c-source-find-files'.
172 ;; `anything-ff-run-symlink-file'
173 ;; Run Symlink file action from `anything-c-source-find-files'.
174 ;; `anything-ff-run-hardlink-file'
175 ;; Run Hardlink file action from `anything-c-source-find-files'.
176 ;; `anything-ff-run-delete-file'
177 ;; Run Delete file action from `anything-c-source-find-files'.
178 ;; `anything-ff-run-complete-fn-at-point'
179 ;; Run complete file name action from `anything-c-source-find-files'.
180 ;; `anything-ff-run-switch-to-eshell'
181 ;; Run switch to eshell action from `anything-c-source-find-files'.
182 ;; `anything-ff-run-switch-other-window'
183 ;; Run switch to other window action from `anything-c-source-find-files'.
184 ;; `anything-ff-run-switch-other-frame'
185 ;; Run switch to other frame action from `anything-c-source-find-files'.
186 ;; `anything-ff-run-open-file-externally'
187 ;; Run open file externally command action from `anything-c-source-find-files'.
188 ;; `anything-ff-run-locate'
189 ;; Run locate action from `anything-c-source-find-files'.
190 ;; `anything-ff-run-gnus-attach-files'
191 ;; Run gnus attach files command action from `anything-c-source-find-files'.
192 ;; `anything-ff-run-etags'
193 ;; Run Etags command action from `anything-c-source-find-files'.
194 ;; `anything-ff-run-print-file'
195 ;; Run Print file action from `anything-c-source-find-files'.
196 ;; `anything-ff-run-toggle-basename'
197 ;; Not documented.
198 ;; `anything-find-files-down-one-level'
199 ;; Go down one level like unix command `cd ..'.
200 ;; `anything-ff-properties-persistent'
201 ;; Show properties without quitting anything.
202 ;; `anything-ff-persistent-delete'
203 ;; Delete current candidate without quitting.
204 ;; `anything-ff-run-kill-buffer-persistent'
205 ;; Execute `anything-ff-kill-buffer-fname' whitout quitting.
206 ;; `anything-ff-rotate-left-persistent'
207 ;; Rotate image left without quitting anything.
208 ;; `anything-ff-rotate-right-persistent'
209 ;; Rotate image right without quitting anything.
210 ;; `anything-c-goto-precedent-file'
211 ;; Go to precedent file in anything grep/etags buffers.
212 ;; `anything-c-goto-next-file'
213 ;; Go to precedent file in anything grep/etags buffers.
214 ;; `anything-c-grep-run-persistent-action'
215 ;; Run grep persistent action from `anything-do-grep-1'.
216 ;; `anything-c-grep-run-default-action'
217 ;; Run grep default action from `anything-do-grep-1'.
218 ;; `anything-c-grep-run-other-window-action'
219 ;; Run grep goto other window action from `anything-do-grep-1'.
220 ;; `anything-c-grep-run-save-buffer'
221 ;; Run grep save results action from `anything-do-grep-1'.
222 ;; `anything-yank-text-at-point'
223 ;; Yank text at point in minibuffer.
224 ;; `anything-c-bookmark-run-jump-other-window'
225 ;; Jump to bookmark from keyboard.
226 ;; `anything-c-bookmark-run-delete'
227 ;; Delete bookmark from keyboard.
228 ;; `anything-c-bmkext-run-edit'
229 ;; Run `bmkext-edit-bookmark' from keyboard.
230 ;; `anything-yaoddmuse-cache-pages'
231 ;; Fetch the list of files on emacswiki and create cache file.
232 ;; `anything-eval-new-line-and-indent'
233 ;; Not documented.
234 ;; `anything-call-source-from-anything'
235 ;; Call anything source within `anything' session.
236 ;; `anything-create-from-anything'
237 ;; Run `anything-create' from `anything' as a fallback.
238 ;; `anything-c-ucs-persistent-insert'
239 ;; Not documented.
240 ;; `anything-c-ucs-persistent-forward'
241 ;; Not documented.
242 ;; `anything-c-ucs-persistent-backward'
243 ;; Not documented.
244 ;; `anything-c-ucs-persistent-delete'
245 ;; Not documented.
246 ;; `anything-lisp-completion-at-point'
247 ;; Anything lisp symbol completion at point.
248 ;; `anything-c-complete-file-name-at-point'
249 ;; Complete file name at point.
250 ;; `anything-lisp-completion-at-point-or-indent'
251 ;; First call indent and second call complete lisp symbol.
252 ;; `anything-lisp-completion-or-file-name-at-point'
253 ;; Complete lisp symbol or filename at point.
254 ;; `anything-w32-shell-execute-open-file'
255 ;; Not documented.
256 ;; `anything-c-set-variable'
257 ;; Set value to VAR interactively.
258 ;; `anything-c-adaptive-save-history'
259 ;; Save history information to file given by `anything-c-adaptive-history-file'.
260 ;; `anything-c-reset-adaptative-history'
261 ;; Delete all `anything-c-adaptive-history' and his file.
262 ;; `anything-mini'
263 ;; Preconfigured `anything' lightweight version (buffer -> recentf).
264 ;; `anything-for-files'
265 ;; Preconfigured `anything' for opening files.
266 ;; `anything-recentf'
267 ;; Preconfigured `anything' for `recentf'.
268 ;; `anything-info-at-point'
269 ;; Preconfigured `anything' for searching info at point.
270 ;; `anything-show-kill-ring'
271 ;; Preconfigured `anything' for `kill-ring'.
272 ;; `anything-minibuffer-history'
273 ;; Preconfigured `anything' for `minibuffer-history'.
274 ;; `anything-gentoo'
275 ;; Preconfigured `anything' for gentoo linux.
276 ;; `anything-imenu'
277 ;; Preconfigured `anything' for `imenu'.
278 ;; `anything-google-suggest'
279 ;; Preconfigured `anything' for google search with google suggest.
280 ;; `anything-yahoo-suggest'
281 ;; Preconfigured `anything' for Yahoo searching with Yahoo suggest.
282 ;; `anything-for-buffers'
283 ;; Preconfigured `anything' for buffers.
284 ;; `anything-buffers-list'
285 ;; Preconfigured `anything' to list buffers.
286 ;; `anything-bbdb'
287 ;; Preconfigured `anything' for BBDB.
288 ;; `anything-locate'
289 ;; Preconfigured `anything' for Locate.
290 ;; `anything-w3m-bookmarks'
291 ;; Preconfigured `anything' for w3m bookmark.
292 ;; `anything-firefox-bookmarks'
293 ;; Preconfigured `anything' for firefox bookmark.
294 ;; `anything-colors'
295 ;; Preconfigured `anything' for color.
296 ;; `anything-bookmarks'
297 ;; Preconfigured `anything' for bookmarks.
298 ;; `anything-c-pp-bookmarks'
299 ;; Preconfigured `anything' for bookmarks (pretty-printed).
300 ;; `anything-c-insert-latex-math'
301 ;; Preconfigured anything for latex math symbols completion.
302 ;; `anything-register'
303 ;; Preconfigured `anything' for Emacs registers.
304 ;; `anything-man-woman'
305 ;; Preconfigured `anything' for Man and Woman pages.
306 ;; `anything-org-keywords'
307 ;; Preconfigured `anything' for org keywords.
308 ;; `anything-emms'
309 ;; Preconfigured `anything' for emms sources.
310 ;; `anything-eev-anchors'
311 ;; Preconfigured `anything' for eev anchors.
312 ;; `anything-bm-list'
313 ;; Preconfigured `anything' for visible bookmarks.
314 ;; `anything-timers'
315 ;; Preconfigured `anything' for timers.
316 ;; `anything-list-emacs-process'
317 ;; Preconfigured `anything' for emacs process.
318 ;; `anything-occur'
319 ;; Preconfigured Anything for Occur source.
320 ;; `anything-browse-code'
321 ;; Preconfigured anything to browse code.
322 ;; `anything-org-headlines'
323 ;; Preconfigured anything to show org headlines.
324 ;; `anything-regexp'
325 ;; Preconfigured anything to build regexps.
326 ;; `anything-c-copy-files-async'
327 ;; Preconfigured anything to copy file list FLIST to DEST asynchronously.
328 ;; `anything-find-files'
329 ;; Preconfigured `anything' for anything implementation of `find-file'.
330 ;; `anything-write-file'
331 ;; Preconfigured `anything' providing completion for `write-file'.
332 ;; `anything-insert-file'
333 ;; Preconfigured `anything' providing completion for `insert-file'.
334 ;; `anything-dired-rename-file'
335 ;; Preconfigured `anything' to rename files from dired.
336 ;; `anything-dired-copy-file'
337 ;; Preconfigured `anything' to copy files from dired.
338 ;; `anything-dired-symlink-file'
339 ;; Preconfigured `anything' to symlink files from dired.
340 ;; `anything-dired-hardlink-file'
341 ;; Preconfigured `anything' to hardlink files from dired.
342 ;; `anything-do-grep'
343 ;; Preconfigured anything for grep.
344 ;; `anything-do-pdfgrep'
345 ;; Preconfigured anything for pdfgrep.
346 ;; `anything-c-etags-select'
347 ;; Preconfigured anything for etags.
348 ;; `anything-filelist'
349 ;; Preconfigured `anything' to open files instantly.
350 ;; `anything-filelist+'
351 ;; Preconfigured `anything' to open files/buffers/bookmarks instantly.
352 ;; `anything-M-x'
353 ;; Preconfigured `anything' for Emacs commands.
354 ;; `anything-manage-advice'
355 ;; Preconfigured `anything' to disable/enable function advices.
356 ;; `anything-bookmark-ext'
357 ;; Preconfigured `anything' for bookmark-extensions sources.
358 ;; `anything-simple-call-tree'
359 ;; Preconfigured `anything' for simple-call-tree. List function relationships.
360 ;; `anything-mark-ring'
361 ;; Preconfigured `anything' for `anything-c-source-mark-ring'.
362 ;; `anything-global-mark-ring'
363 ;; Preconfigured `anything' for `anything-c-source-global-mark-ring'.
364 ;; `anything-all-mark-rings'
365 ;; Preconfigured `anything' for `anything-c-source-global-mark-ring' and `anything-c-source-mark-ring'.
366 ;; `anything-yaoddmuse-emacswiki-edit-or-view'
367 ;; Preconfigured `anything' to edit or view EmacsWiki page.
368 ;; `anything-yaoddmuse-emacswiki-post-library'
369 ;; Preconfigured `anything' to post library to EmacsWiki.
370 ;; `anything-eval-expression'
371 ;; Preconfigured anything for `anything-c-source-evaluation-result'.
372 ;; `anything-eval-expression-with-eldoc'
373 ;; Preconfigured anything for `anything-c-source-evaluation-result' with `eldoc' support.
374 ;; `anything-calcul-expression'
375 ;; Preconfigured anything for `anything-c-source-calculation-result'.
376 ;; `anything-surfraw'
377 ;; Preconfigured `anything' to search PATTERN with search ENGINE.
378 ;; `anything-call-source'
379 ;; Preconfigured `anything' to call anything source.
380 ;; `anything-execute-anything-command'
381 ;; Preconfigured `anything' to execute preconfigured `anything'.
382 ;; `anything-create'
383 ;; Preconfigured `anything' to do many create actions from STRING.
384 ;; `anything-top'
385 ;; Preconfigured `anything' for top command.
386 ;; `anything-select-xfont'
387 ;; Preconfigured `anything' to select Xfont.
388 ;; `anything-world-time'
389 ;; Preconfigured `anything' to show world time.
390 ;; `anything-apt'
391 ;; Preconfigured `anything' : frontend of APT package manager.
392 ;; `anything-esh-pcomplete'
393 ;; Preconfigured anything to provide anything completion in eshell.
394 ;; `anything-eshell-history'
395 ;; Preconfigured anything for eshell history.
396 ;; `anything-c-run-external-command'
397 ;; Preconfigured `anything' to run External PROGRAM asyncronously from Emacs.
398 ;; `anything-ratpoison-commands'
399 ;; Preconfigured `anything' to execute ratpoison commands.
400 ;; `anything-ucs'
401 ;; Preconfigured anything for `ucs-names' math symbols.
402 ;; `anything-c-apropos'
403 ;; Preconfigured anything to describe commands, functions, variables and faces.
404 ;; `anything-xrandr-set'
405 ;; Not documented.
407 ;; * User variables defined here:
408 ;; [EVAL] (autodoc-document-lisp-buffer :type 'user-variable :prefix "anything-" :var-value t)
409 ;; `anything-c-adaptive-history-file'
410 ;; Default Value: "~/.emacs.d/anything-c-adaptive-history"
411 ;; `anything-c-adaptive-history-length'
412 ;; Default Value: 50
413 ;; `anything-c-google-suggest-url'
414 ;; Default Value: "http://google.com/complete/search?output=toolbar&q="
415 ;; `anything-c-google-suggest-search-url'
416 ;; Default Value: "http://www.google.com/search?ie=utf-8&oe=utf-8&q="
417 ;; `anything-google-suggest-use-curl-p'
418 ;; Default Value: nil
419 ;; `anything-c-yahoo-suggest-url'
420 ;; Default Value: "http://search.yahooapis.com/WebSearchService/V1/relatedSuggestion?appid=G [...]
421 ;; `anything-c-yahoo-suggest-search-url'
422 ;; Default Value: "http://search.yahoo.com/search?&ei=UTF-8&fr&h=c&p="
423 ;; `anything-c-boring-buffer-regexp'
424 ;; Default Value: "\\ (\\` \\)\\|\\*anything\\|\\*ac-mode\\| \\*Echo Area\\| \\*Minibuf"
425 ;; `anything-c-boring-file-regexp'
426 ;; Default Value: "/\\ (?:\\(?:\\.\\(?:git\\|hg\\|svn\\)\\|CVS\\|_darcs\\)\\)\\(?:/\\|$\\)\\| [...]
427 ;; `anything-kill-ring-threshold'
428 ;; Default Value: 10
429 ;; `anything-c-kill-ring-max-lines-number'
430 ;; Default Value: nil
431 ;; `anything-su-or-sudo'
432 ;; Default Value: "su"
433 ;; `anything-for-files-prefered-list'
434 ;; Default Value: (anything-c-source-ffap-line anything-c-source-ffap-guesser anything-c-sou [...]
435 ;; `anything-create--actions-private'
436 ;; Default Value: nil
437 ;; `anything-allow-skipping-current-buffer'
438 ;; Default Value: nil
439 ;; `anything-c-enable-eval-defun-hack'
440 ;; Default Value: t
441 ;; `anything-tramp-verbose'
442 ;; Default Value: 0
443 ;; `anything-raise-command'
444 ;; Default Value: nil
445 ;; `anything-command-map-prefix-key'
446 ;; Default Value: "<f5> a"
447 ;; `anything-c-browse-code-regexp-lisp'
448 ;; Default Value: "^ * (def\\(un\\|subst\\|macro\\|face\\|alias\\|advice\\|struct\\|type\\|th [...]
449 ;; `anything-c-browse-code-regexp-python'
450 ;; Default Value: "\\<def\\>\\|\\<class\\>"
451 ;; `anything-c-browse-code-regexp-alist'
452 ;; Default Value: ((lisp-interaction-mode . "^ *(def\\(un\\|subst\\|macro\\|face\\|alias\\|a [...]
453 ;; `anything-c-external-programs-associations'
454 ;; Default Value: nil
455 ;; `anything-ff-auto-update-initial-value'
456 ;; Default Value: t
457 ;; `anything-c-copy-async-prefered-emacs'
458 ;; Default Value: "emacs"
459 ;; `anything-ff-lynx-style-map'
460 ;; Default Value: t
461 ;; `anything-ff-history-max-length'
462 ;; Default Value: 100
463 ;; `anything-ff-smart-completion'
464 ;; Default Value: t
465 ;; `anything-ff-default-kbsize'
466 ;; Default Value: 1024.0
467 ;; `anything-ff-tramp-not-fancy'
468 ;; Default Value: t
469 ;; `anything-ff-exif-data-program'
470 ;; Default Value: "exiftran"
471 ;; `anything-ff-exif-data-program-args'
472 ;; Default Value: "-d"
473 ;; `anything-c-grep-use-ioccur-style-keys'
474 ;; Default Value: t
475 ;; `anything-c-pdfgrep-default-read-command'
476 ;; Default Value: "xpdf '%f' %p"
477 ;; `anything-c-etags-tag-file-name'
478 ;; Default Value: "TAGS"
479 ;; `anything-c-etags-tag-file-search-limit'
480 ;; Default Value: 10
481 ;; `anything-c-etags-use-regexp-search'
482 ;; Default Value: nil
483 ;; `anything-c-etags-search-regexp'
484 ;; Default Value: "^.+: .+ \\<%s"
485 ;; `anything-c-filelist-file-name'
486 ;; Default Value: nil
487 ;; `anything-c-eldoc-in-minibuffer-show-fn'
488 ;; Default Value: anything-c-show-info-in-mode-line
489 ;; `anything-c-turn-on-show-completion'
490 ;; Default Value: t
491 ;; `anything-c-show-completion-use-special-display'
492 ;; Default Value: t
493 ;; `anything-c-show-completion-min-window-height'
494 ;; Default Value: 7
495 ;; `anything-lisp-completion-or-indent-delay'
496 ;; Default Value: 0.6
497 ;; `anything-c-default-external-file-browser'
498 ;; Default Value: "nautilus"
499 ;; `anything-c-use-adaptative-sorting'
500 ;; Default Value: nil
501 ;; `anything-ff-newfile-prompt-p'
502 ;; Default Value: t
503 ;; `anything-ff-avfs-directory'
504 ;; Default Value: nil
505 ;; `anything-ff-file-compressed-list'
506 ;; Default Value: ("gz" "bz2" "zip" "7z")
507 ;; `anything-locate-db-file-regexp'
508 ;; Default Value: "m?locate.db$"
509 ;; `anything-c-locate-command'
510 ;; Default Value: nil
511 ;; `anything-c-show-info-in-mode-line-delay'
512 ;; Default Value: 12
513 ;; `anything-c-copy-files-async-log-file'
514 ;; Default Value: "/tmp/dired.log"
515 ;; `anything-ff-printer-list'
516 ;; Default Value: nil
517 ;; `anything-ff-transformer-show-only-basename'
518 ;; Default Value: nil
519 ;; `anything-ff-quick-delete-dont-prompt-for-deletion'
520 ;; Default Value: nil
521 ;; `anything-ff-signal-error-on-dot-files'
522 ;; Default Value: t
523 ;; `anything-completing-read-handlers-alist'
524 ;; Default Value: ((describe-function . anything-completing-read-symbols) (describe-variabl [...]
526 ;; * Anything sources defined here:
527 ;; [EVAL] (autodoc-document-lisp-buffer :type 'anything-source :prefix "anything-" :any-sname t)
528 ;; `anything-c-source-regexp' (Regexp Builder)
529 ;; `anything-c-source-buffers' (Buffers)
530 ;; `anything-c-source-buffer-not-found' (Create buffer)
531 ;; `anything-c-source-buffers-list' (Buffers)
532 ;; `anything-c-source-file-name-history' (File Name History)
533 ;; `anything-c-source-files-in-current-dir' (Files from Current Directory)
534 ;; `anything-c-source-files-in-current-dir+' (Files from Current Directory)
535 ;; `anything-c-source-find-files' (Find Files)
536 ;; `anything-c-source-write-file' (Write File)
537 ;; `anything-c-source-insert-file' (Insert File)
538 ;; `anything-c-source-copy-files' (Copy Files)
539 ;; `anything-c-source-symlink-files' (Symlink Files)
540 ;; `anything-c-source-hardlink-files' (Hardlink Files)
541 ;; `anything-c-source-file-cache' (File Cache)
542 ;; `anything-c-source-locate' (Locate)
543 ;; `anything-c-source-recentf' (Recentf)
544 ;; `anything-c-source-ffap-guesser' (File at point)
545 ;; `anything-c-source-ffap-line' (File/Lineno at point)
546 ;; `anything-c-source-files-in-all-dired' (Files in all dired buffer.)
547 ;; `anything-c-source-filelist' (FileList)
548 ;; `anything-c-source-info-pages' (Info Pages)
549 ;; `anything-c-source-man-pages' (Manual Pages)
550 ;; `anything-c-source-complex-command-history' (Complex Command History)
551 ;; `anything-c-source-extended-command-history' (Emacs Commands History)
552 ;; `anything-c-source-emacs-commands' (Emacs Commands)
553 ;; `anything-c-source-emacs-functions' (Emacs Functions)
554 ;; `anything-c-source-emacs-functions-with-abbrevs' (Emacs Functions)
555 ;; `anything-c-source-advice' (Function Advice)
556 ;; `anything-c-source-emacs-variables' (Emacs Variables)
557 ;; `anything-c-source-lacarte' (Lacarte)
558 ;; `anything-c-source-bookmarks' (Bookmarks)
559 ;; `anything-c-source-bookmark-set' (Set Bookmark)
560 ;; `anything-c-source-bm' (Visible Bookmarks)
561 ;; `anything-c-source-bookmarks-ssh' (Bookmarks-ssh)
562 ;; `anything-c-source-bookmarks-su' (Bookmarks-root)
563 ;; `anything-c-source-bookmarks-local' (Bookmarks-Local)
564 ;; `anything-c-source-bmkext-addressbook' (Bookmark Addressbook)
565 ;; `anything-c-source-bookmark-w3m' (Bookmark W3m)
566 ;; `anything-c-source-bookmark-images' (Bookmark Images)
567 ;; `anything-c-source-bookmark-man' (Bookmark Woman&Man)
568 ;; `anything-c-source-bookmark-gnus' (Bookmark Gnus)
569 ;; `anything-c-source-bookmark-info' (Bookmark Info)
570 ;; `anything-c-source-bookmark-files&dirs' (Bookmark Files&Directories)
571 ;; `anything-c-source-bookmark-su-files&dirs' (Bookmark Root-Files&Directories)
572 ;; `anything-c-source-bookmark-ssh-files&dirs' (Bookmark Ssh-Files&Directories)
573 ;; `anything-c-source-firefox-bookmarks' (Firefox Bookmarks)
574 ;; `anything-c-source-w3m-bookmarks' (W3m Bookmarks)
575 ;; `anything-c-source-elisp-library-scan' (Elisp libraries (Scan))
576 ;; `anything-c-source-imenu' (Imenu)
577 ;; `anything-c-source-ctags' (Exuberant ctags)
578 ;; `anything-c-source-etags-select' (Etags)
579 ;; `anything-c-source-semantic' (Semantic Tags)
580 ;; `anything-c-source-simple-call-tree-functions-callers' (Function is called by)
581 ;; `anything-c-source-simple-call-tree-callers-functions' (Function calls)
582 ;; `anything-c-source-commands-and-options-in-file' (Commands/Options in file)
583 ;; `anything-c-source-customize-face' (Customize Face)
584 ;; `anything-c-source-colors' (Colors)
585 ;; `anything-c-source-tracker-search' (Tracker Search)
586 ;; `anything-c-source-mac-spotlight' (mdfind)
587 ;; `anything-c-source-picklist' (Picklist)
588 ;; `anything-c-source-kill-ring' (Kill Ring)
589 ;; `anything-c-source-mark-ring' (mark-ring)
590 ;; `anything-c-source-global-mark-ring' (global-mark-ring)
591 ;; `anything-c-source-register' (Registers)
592 ;; `anything-c-source-latex-math' (Latex Math Menu)
593 ;; `anything-c-source-fixme' (TODO/FIXME/DRY comments)
594 ;; `anything-c-source-rd-headline' (RD HeadLine)
595 ;; `anything-c-source-oddmuse-headline' (Oddmuse HeadLine)
596 ;; `anything-c-source-emacs-source-defun' (Emacs Source DEFUN)
597 ;; `anything-c-source-emacs-lisp-expectations' (Emacs Lisp Expectations)
598 ;; `anything-c-source-emacs-lisp-toplevels' (Emacs Lisp Toplevel / Level 4 Comment / Linkd Star)
599 ;; `anything-c-source-yaoddmuse-emacswiki-edit-or-view' (Yaoddmuse Edit or View (EmacsWiki))
600 ;; `anything-c-source-yaoddmuse-emacswiki-post-library' (Yaoddmuse Post library (EmacsWiki))
601 ;; `anything-c-source-eev-anchor' (Anchors)
602 ;; `anything-c-source-org-headline' (Org HeadLine)
603 ;; `anything-c-source-org-keywords' (Org Keywords)
604 ;; `anything-c-source-bbdb' (BBDB)
605 ;; `anything-c-source-evaluation-result' (Evaluation Result)
606 ;; `anything-c-source-calculation-result' (Calculation Result)
607 ;; `anything-c-source-google-suggest' (Google Suggest)
608 ;; `anything-c-source-yahoo-suggest' (Yahoo Suggest)
609 ;; `anything-c-source-emms-streams' (Emms Streams)
610 ;; `anything-c-source-emms-dired' (Music Directory)
611 ;; `anything-c-source-emms-files' (Emms files)
612 ;; `anything-c-source-jabber-contacts' (Jabber Contacts)
613 ;; `anything-c-source-call-source' (Call anything source)
614 ;; `anything-c-source-anything-commands' (Preconfigured Anything)
615 ;; `anything-c-source-occur' (Occur)
616 ;; `anything-c-source-browse-code' (Browse code)
617 ;; `anything-c-source-create' (Create)
618 ;; `anything-c-source-minibuffer-history' (Minibuffer History)
619 ;; `anything-c-source-elscreen' (Elscreen)
620 ;; `anything-c-source-top' (Top (Press C-c C-u to refresh))
621 ;; `anything-c-source-absolute-time-timers' (Absolute Time Timers)
622 ;; `anything-c-source-idle-time-timers' (Idle Time Timers)
623 ;; `anything-c-source-xrandr-change-resolution' (Change Resolution)
624 ;; `anything-c-source-xfonts' (X Fonts)
625 ;; `anything-c-source-ucs' (Ucs names)
626 ;; `anything-c-source-emacs-process' (Emacs Process)
627 ;; `anything-c-source-time-world' (Time World List)
628 ;; `anything-c-source-apt' (APT)
629 ;; `anything-c-source-gentoo' (Portage sources)
630 ;; `anything-c-source-use-flags' (Use Flags)
631 ;; `anything-c-source-ratpoison-commands' (Ratpoison Commands)
632 ;; `anything-c-source-esh' (Eshell completions)
633 ;; `anything-c-source-eshell-history' (Eshell history)
635 ;; *** END auto-documentation
637 ;;; For Maintainers:
639 ;; Install developer-tools/autodoc.el and
640 ;; Evaluate (autodoc-update-all) before commit or run it interactively.
641 ;; This function generates anything-c-source-* / functions / options list.
643 ;; [EVAL IT] (autodoc-update-all)
645 ;; Please write details documentation about function, then others will
646 ;; read code more easier. -- Andy Stewart
650 ;;; Change log:
652 ;; Change log of this file is found at
653 ;; http://repo.or.cz/w/anything-config.git/history/master:/anything-config.el
655 ;; Change log of this project is found at
656 ;; http://repo.or.cz/w/anything-config.git?a=shortlog
658 ;;; Contributors:
660 ;; Tamas Patrovics
661 ;; Tassilo Horn <tassilo@member.fsf.org>
662 ;; Vagn Johansen <gonz808@hotmail.com>
663 ;; Mathias Dahl <mathias.dahl@gmail.com>
664 ;; Bill Clementson <billclem@gmail.com>
665 ;; Stefan Kamphausen (see http://www.skamphausen.de for more informations)
666 ;; Drew Adams <drew.adams@oracle.com>
667 ;; Jason McBrayer <jmcbray@carcosa.net>
668 ;; Andy Stewart <lazycat.manatee@gmail.com>
669 ;; Thierry Volpiatto <thierry.volpiatto@gmail.com>
670 ;; rubikitch <rubikitch@ruby-lang.org>
671 ;; Scott Vokes <vokes.s@gmail.com>
672 ;; Kenichirou Oyama <k1lowxb@gmail.com>
675 ;;; TODO
677 ;; - Fix documentation, now many functions haven't documentations.
681 ;;; Code:
683 ;;; Require
686 (require 'anything)
687 (require 'thingatpt)
688 (require 'ffap)
689 (require 'cl)
690 (eval-when-compile (require 'dired))
691 (require 'dired-aux)
692 (require 'dired-x)
693 (require 'tramp)
694 (require 'grep)
695 (require 'url)
696 (require 'xml)
697 (eval-when-compile (require 'org)) ; Shut up byte compiler about org-directory.
698 (eval-when-compile (require 'semantic nil t))
699 (require 'anything-match-plugin)
703 ;;; Declare external functions
706 (declare-function gnus-dired-attach "ext:gnus-dired.el" (files-to-attach))
707 (declare-function image-dired-display-image "image-dired.el" (file &optional original-size))
708 (declare-function image-dired-update-property "image-dired.el" (prop value))
709 (declare-function woman-file-name-all-completions "woman.el" (topic))
710 (declare-function Man-getpage-in-background "man.el" (topic))
711 (declare-function simple-call-tree-analyze "ext:simple-call-tree.el" (&optional test))
712 (declare-function yaoddmuse-update-pagename "ext:yaoddmuse.el" (&optional unforced))
713 (declare-function yaoddmuse-get-library-list "ext:yaoddmuse.el" (&optional dirs string))
714 (declare-function org-get-current-options "ext:org-exp.el")
715 (declare-function emms-streams "ext:emms-streams")
716 (declare-function emms-stream-delete-bookmark "ext:emms-streams")
717 (declare-function emms-stream-add-bookmark "ext:emms-streams" (name url fd type))
718 (declare-function emms-stream-save-bookmarks-file "ext:emms-streams")
719 (declare-function emms-stream-quit "ext:emms-streams")
720 (declare-function with-current-emms-playlist "ext:emms" (&rest body))
721 (declare-function emms-playlist-tracks-in-region "ext:emms" (beg end))
722 (declare-function emms-playlist-first "ext:emms")
723 (declare-function emms-playlist-mode-play-smart "ext:emms-playlist-mode")
724 (declare-function term-line-mode "term")
725 (declare-function term-char-mode "term")
726 (declare-function term-send-input "term")
727 (declare-function term-send-eof "term")
728 (declare-function Info-index-nodes "info" (&optional file))
729 (declare-function Info-goto-node "info" (&optional fork))
730 (declare-function Info-find-node "info.el" (filename nodename &optional no-going-back))
731 (declare-function elscreen-find-screen-by-buffer "ext:elscreen.el" (buffer &optional create))
732 (declare-function elscreen-find-file "ext:elscreen.el" (filename))
733 (declare-function elscreen-goto "ext:elscreen.el" (screen))
734 (declare-function semantic-format-tag-summarize "ext:format.el" (tag &optional parent color) t)
735 (declare-function semantic-tag-components "ext:tag.el" (tag) t)
736 (declare-function semantic-go-to-tag "ext:tag-file.el" (tag) t)
737 (declare-function semantic-tag-type "ext:tag-file.el" (tag) t)
738 (declare-function semantic-tag-class "ext:tag-file.el" (tag) t)
739 (declare-function bbdb "ext:bbdb-com")
740 (declare-function bbdb-current-record "ext:bbdb-com")
741 (declare-function bbdb-redisplay-one-record "ext:bbdb-com")
742 (declare-function bbdb-record-net "ext:bbdb-com" (string) t)
743 (declare-function bbdb-current-record "ext:bbdb-com")
744 (declare-function bbdb-dwim-net-address "ext:bbdb-com")
745 (declare-function bbdb-records "ext:bbdb-com"
746 (&optional dont-check-disk already-in-db-buffer))
747 (declare-function eshell-read-aliases-list "em-alias")
748 (declare-function eshell-send-input "esh-mode" (&optional use-region queue-p no-newline))
749 (declare-function eshell-bol "esh-mode")
750 (declare-function eldoc-current-symbol "eldoc")
751 (declare-function eldoc-get-fnsym-args-string "eldoc" (sym &optional index))
752 (declare-function eldoc-get-var-docstring "eldoc" (sym))
753 (declare-function eldoc-fnsym-in-current-sexp "eldoc")
754 (declare-function find-library-name "find-func.el" (library))
755 (declare-function adoc-construct "ext:auto-document.el" (buf))
756 (declare-function adoc-first-line "ext:auto-document.el" (str))
757 (declare-function adoc-prin1-to-string "ext:auto-document.el" (object))
758 (declare-function secure-hash "ext:fns.c" (algorithm object &optional start end binary))
759 (declare-function w32-shell-execute "ext:w32fns.c" (operation document &optional parameters show-flag))
762 ;;; compatibility
765 (unless (fboundp 'window-system)
766 (defun window-system (&optional arg)
767 window-system))
769 (unless (fboundp 'make-composed-keymap)
770 (defun make-composed-keymap (maps &optional parent)
771 "Construct a new keymap composed of MAPS and inheriting from PARENT.
772 When looking up a key in the returned map, the key is looked in each
773 keymap of MAPS in turn until a binding is found.
774 If no binding is found in MAPS, the lookup continues in PARENT, if non-nil.
775 As always with keymap inheritance, a nil binding in MAPS overrides
776 any corresponding binding in PARENT, but it does not override corresponding
777 bindings in other keymaps of MAPS.
778 MAPS can be a list of keymaps or a single keymap.
779 PARENT if non-nil should be a keymap."
780 `(keymap
781 ,@(if (keymapp maps) (list maps) maps)
782 ,@parent)))
784 (unless (fboundp 'apply-partially)
785 (defun apply-partially (fun &rest args)
786 "Return a function that is a partial application of FUN to ARGS.
787 ARGS is a list of the first N arguments to pass to FUN.
788 The result is a new function which does the same as FUN, except that
789 the first N arguments are fixed at the values with which this function
790 was called."
791 (lexical-let ((fun fun) (args1 args))
792 (lambda (&rest args2) (apply fun (append args1 args2))))))
795 ;;; Customize
798 (defgroup anything-config nil
799 "Predefined configurations for `anything.el'."
800 :group 'anything)
802 (defcustom anything-c-adaptive-history-file
803 "~/.emacs.d/anything-c-adaptive-history"
804 "Path of file where history information is stored."
805 :type 'string
806 :group 'anything-config)
808 (defcustom anything-c-adaptive-history-length 50
809 "Maximum number of candidates stored for a source."
810 :type 'number
811 :group 'anything-config)
813 (defcustom anything-c-google-suggest-url
814 "http://google.com/complete/search?output=toolbar&q="
815 "URL used for looking up Google suggestions."
816 :type 'string
817 :group 'anything-config)
819 (defcustom anything-c-google-suggest-search-url
820 "http://www.google.com/search?ie=utf-8&oe=utf-8&q="
821 "URL used for Google searching."
822 :type 'string
823 :group 'anything-config)
825 (defcustom anything-google-suggest-use-curl-p nil
826 "When non--nil use CURL to get info from `anything-c-google-suggest-url'.
827 Otherwise `url-retrieve-synchronously' is used."
828 :type 'boolean
829 :group 'anything-config)
831 (defcustom anything-c-yahoo-suggest-url
832 "http://search.yahooapis.com/WebSearchService/V1/relatedSuggestion?appid=Generic&query="
833 "Url used for looking up Yahoo suggestions."
834 :type 'string
835 :group 'anything-config)
837 (defcustom anything-c-yahoo-suggest-search-url
838 "http://search.yahoo.com/search?&ei=UTF-8&fr&h=c&p="
839 "Url used for Yahoo searching."
840 :type 'string
841 :group 'anything-config)
843 (defcustom anything-c-boring-buffer-regexp
844 (rx (or
845 (group bos " ")
846 ;; anything-buffers
847 "*anything" "*ac-mode"
848 ;; echo area
849 " *Echo Area" " *Minibuf"))
850 "The regexp that match boring buffers.
851 Buffer candidates matching this regular expression will be
852 filtered from the list of candidates if the
853 `anything-c-skip-boring-buffers' candidate transformer is used, or
854 they will be displayed with face `file-name-shadow' if
855 `anything-c-shadow-boring-buffers' is used."
856 :type 'string
857 :group 'anything-config)
858 ;; (string-match anything-c-boring-buffer-regexp "buf")
859 ;; (string-match anything-c-boring-buffer-regexp " hidden")
860 ;; (string-match anything-c-boring-buffer-regexp " *Minibuf-1*")
862 (defcustom anything-c-boring-file-regexp
863 (rx (or
864 ;; Boring directories
865 (and "/" (or ".svn" "CVS" "_darcs" ".git" ".hg") (or "/" eol))
866 ;; Boring files
867 (and line-start ".#")
868 (and (or ".class" ".la" ".o" "~") eol)))
869 "The regexp that match boring files.
870 File candidates matching this regular expression will be
871 filtered from the list of candidates if the
872 `anything-c-skip-boring-files' candidate transformer is used, or
873 they will be displayed with face `file-name-shadow' if
874 `anything-c-shadow-boring-files' is used."
875 :type 'string
876 :group 'anything-config)
878 (defcustom anything-kill-ring-threshold 10
879 "Minimum length to be listed by `anything-c-source-kill-ring'."
880 :type 'integer
881 :group 'anything-config)
883 (defcustom anything-c-kill-ring-max-lines-number nil
884 "Max number of lines displayed per candidate in kill-ring browser.
885 If nil or zero, don't truncate candidate, show all."
886 :type 'integer
887 :group 'anything-config)
889 (defcustom anything-su-or-sudo "su"
890 "What command to use for root access."
891 :type 'string
892 :group 'anything-config)
894 (defcustom anything-for-files-prefered-list
895 '(anything-c-source-ffap-line
896 anything-c-source-ffap-guesser
897 anything-c-source-buffers-list
898 anything-c-source-recentf
899 anything-c-source-bookmarks
900 anything-c-source-file-cache
901 anything-c-source-files-in-current-dir+
902 anything-c-source-locate)
903 "Your prefered sources to find files."
904 :type 'list
905 :group 'anything-config)
907 (defcustom anything-create--actions-private nil
908 "User defined actions for `anything-create' / `anything-c-source-create'.
909 It is a list of (DISPLAY . FUNCTION) pairs like `action'
910 attribute of `anything-sources'.
912 It is prepended to predefined pairs."
913 :type 'list
914 :group 'anything-config)
916 (defcustom anything-allow-skipping-current-buffer nil
917 "Show current buffer or not in anything buffer"
918 :type 'boolean
919 :group 'anything-config)
921 (defcustom anything-c-enable-eval-defun-hack t
922 "If non-nil, execute `anything' using the source at point when C-M-x is pressed.
923 This hack is invoked when pressing C-M-x in the form \
924 (defvar anything-c-source-XXX ...) or (setq anything-c-source-XXX ...)."
925 :type 'boolean
926 :group 'anything-config)
928 (defcustom anything-tramp-verbose 0
929 "Just like `tramp-verbose' but specific to anything.
930 When set to 0 don't show tramp messages in anything.
931 If you want to have the default tramp messages set it to 3."
932 :type 'integer
933 :group 'anything-config)
935 (defcustom anything-raise-command nil
936 "A shell command to jump to a window running specific program.
937 Need external program wmctrl.
938 This will be use with `format', so use something like \"wmctrl -xa %s\"."
939 :type 'string
940 :group 'anything-config)
942 (defun anything-set-anything-command-map-prefix-key (var key)
943 "The customize set function for `anything-command-map-prefix-key'."
944 (when (boundp var)
945 (define-key ctl-x-map (symbol-value var) nil))
946 (set var key)
947 (define-key ctl-x-map (symbol-value var) 'anything-command-map))
949 (defcustom anything-command-map-prefix-key "c"
950 "The prefix key for all `anything-command-map' commands.
951 It use `ctl-x-map', so when set, the prefix key will be 'C-x <prefix>'.
953 !!WARNING!!
954 This default value is very likely to be changed,
955 because it is under discussion."
956 :type 'string
957 :set 'anything-set-anything-command-map-prefix-key
958 :group 'anything-config)
960 (defcustom anything-c-browse-code-regexp-lisp
961 "^ *\(def\\(un\\|subst\\|macro\\|face\\|alias\\|advice\\|struct\\|\
962 type\\|theme\\|var\\|group\\|custom\\|const\\|method\\|class\\)"
963 "Regexp used to parse lisp buffer when browsing code."
964 :type 'string
965 :group 'anything-config)
967 (defcustom anything-c-browse-code-regexp-python
968 "\\<def\\>\\|\\<class\\>"
969 "Regexp used to parse python buffer when browsing code."
970 :type 'string
971 :group 'anything-config)
973 (defcustom anything-c-browse-code-regexp-alist
974 `((lisp-interaction-mode . ,anything-c-browse-code-regexp-lisp)
975 (emacs-lisp-mode . ,anything-c-browse-code-regexp-lisp)
976 (lisp-mode . ,anything-c-browse-code-regexp-lisp)
977 (python-mode . ,anything-c-browse-code-regexp-python))
978 "Alist to store regexps for browsing code corresponding \
979 to a specific `major-mode'."
980 :type 'list
981 :group 'anything-config)
983 (defcustom anything-c-external-programs-associations nil
984 "Alist to store externals programs associated with file extension.
985 This variable overhide setting in .mailcap file.
986 e.g : '\(\(\"jpg\" . \"gqview\"\) (\"pdf\" . \"xpdf\"\)\) "
987 :type 'list
988 :group 'anything-config)
990 (defcustom anything-ff-auto-update-initial-value t
991 "Auto update when only one candidate directory is matched.
992 This is the default value when starting `anything-find-files'."
993 :group 'anything-config
994 :type 'boolean)
996 (defcustom anything-c-copy-async-prefered-emacs "emacs"
997 "Path to the emacs you want to use for copying async.
998 Emacs versions < 24 fail to copy directory due to a bug not fixed
999 in `copy-directory'."
1000 :group 'anything-config
1001 :type 'string)
1003 (defcustom anything-ff-lynx-style-map t
1004 "Use arrow keys to navigate with `anything-find-files'.
1005 You will have to restart Emacs or reeval `anything-find-files-map'
1006 and `anything-c-read-file-map' for this take effect."
1007 :group 'anything-config
1008 :type 'boolean)
1010 (defcustom anything-ff-history-max-length 100
1011 "Number of elements shown in `anything-find-files' history."
1012 :group 'anything-config
1013 :type 'integer)
1015 (defcustom anything-ff-smart-completion t
1016 "Try to complete filenames smarter when non--nil.
1017 See `anything-ff-transform-fname-for-completion' for more info."
1018 :group 'anything-config
1019 :type 'boolean)
1021 (defcustom anything-ff-default-kbsize 1024.0
1022 "Default Kbsize to use for showing files size.
1023 It is a float, usually 1024.0 but could be 1000.0 on some systems."
1024 :group 'anything-config
1025 :type 'float)
1027 (defcustom anything-ff-tramp-not-fancy t
1028 "No colors when listing remote files when set to non--nil.
1029 This make listing much faster, specially on slow machines."
1030 :group 'anything-config
1031 :type 'boolean)
1033 (defcustom anything-ff-exif-data-program "exiftran"
1034 "Program used to extract exif data of an image file."
1035 :group 'anything-config
1036 :type 'string)
1038 (defcustom anything-ff-exif-data-program-args "-d"
1039 "*Arguments used for `anything-ff-exif-data-program'."
1040 :group 'anything-config
1041 :type 'string)
1043 (defcustom anything-c-grep-use-ioccur-style-keys t
1044 "Use Arrow keys to jump to occurences."
1045 :group 'anything-config
1046 :type 'boolean)
1048 (defcustom anything-c-pdfgrep-default-read-command "xpdf '%f' %p"
1049 "Default command to read pdf files from pdfgrep.
1050 Where '%f' format spec is filename and '%p' is page number"
1051 :group 'anything-config
1052 :type 'string)
1054 (defcustom anything-c-etags-tag-file-name "TAGS"
1055 "Etags tag file name."
1056 :type 'string
1057 :group 'anything-config)
1059 (defcustom anything-c-etags-tag-file-search-limit 10
1060 "The limit level of directory to search tag file.
1061 Don't search tag file deeply if outside this value."
1062 :type 'number
1063 :group 'anything-config)
1065 (defcustom anything-c-etags-use-regexp-search nil
1066 "When non--nil search etags candidates by regexp.
1067 This disable anything-match-plugin when enabled.
1068 When nil search is performed directly on patter and *match-plugin is used
1069 if available. You can customize `anything-c-etags-search-regexp'."
1070 :group 'anything-config
1071 :type 'boolean)
1073 (defcustom anything-c-etags-search-regexp "^.+: .+ \\<%s"
1074 "Regexp that match tags in an anything etags buffer.
1075 The format spec is replaced by pattern.
1076 This regexp have no effect when `anything-c-etags-use-regexp-search'
1077 is nil."
1078 :group 'anything-config
1079 :type 'regexp)
1081 (defcustom anything-c-filelist-file-name nil
1082 "Filename of file list.
1083 Accept a list of string for multiple files.
1085 This file tend to be very large \(> 100MB\) and recommend to be in ramdisk for speed.
1086 File list is created by make-filelist.rb script.
1088 Usage:
1089 ruby make-filelist.rb > /tmp/all.filelist
1091 Then
1092 ;; Assume that /tmp is ramdisk or tmpfs
1093 \(setq anything-grep-candidates-fast-directory-regexp \"^/tmp/\"\)
1094 \(setq anything-c-filelist-file-name \"/tmp/all.filelist\"\)
1096 :type 'string
1097 :group 'anything-config)
1099 (defcustom anything-c-eldoc-in-minibuffer-show-fn
1100 'anything-c-show-info-in-mode-line
1101 "A function to display eldoc info.
1102 Should take one arg: the string to display."
1103 :group 'anything-config
1104 :type 'symbol)
1106 (defcustom anything-c-turn-on-show-completion t
1107 "Display candidate in buffer while moving selection when non--nil."
1108 :group 'anything-config
1109 :type 'boolean)
1111 (defcustom anything-c-show-completion-use-special-display t
1112 "A special display will be used in lisp completion if non--nil.
1113 All functions that are wrapped in macro `with-anything-show-completion'
1114 will be affected."
1115 :group 'anything-config
1116 :type 'boolean)
1118 (defcustom anything-c-show-completion-min-window-height 7
1119 "Minimum completion window height used in show completion.
1120 This is used in macro `with-anything-show-completion'."
1121 :group 'anything-config
1122 :type 'integer)
1124 (defcustom anything-lisp-completion-or-indent-delay 0.6
1125 "After this delay `anything-lisp-completion-counter' is reset to 0.
1126 This allow to indent again without completing lisp symbol after this delay.
1127 Default is 0.6 seconds."
1128 :group 'anything-config
1129 :type 'number)
1131 (defcustom anything-c-default-external-file-browser "nautilus"
1132 "Default external file browser for your system.
1133 Directories will be opened externally with it when
1134 opening file externally in `anything-find-files'.
1135 Set to nil if you do not have external file browser
1136 or do not want to use it.
1137 Windows users should set that to \"explorer.exe\"."
1138 :group 'anything-config
1139 :type 'string)
1141 (defcustom anything-c-use-adaptative-sorting nil
1142 "Wheter to use or not adaptative sorting.
1143 Even if a source use it, it will have no effect when set to nil."
1144 :type 'boolean
1145 :group 'anything-config)
1147 (defcustom anything-ff-newfile-prompt-p t
1148 "Whether Prompt or not when creating new file.
1149 This set `ffap-newfile-prompt'."
1150 :type 'boolean
1151 :group 'anything-config)
1154 (defcustom anything-ff-avfs-directory nil
1155 "The default avfs directory, usually '.avfs'.
1156 When this is set you will be able to expand archive filenames with `C-z'
1157 inside an avfs directory mounted with mountavfs.
1158 See <http://sourceforge.net/projects/avf/>."
1159 :type 'boolean
1160 :group 'anything-config)
1162 (defcustom anything-ff-file-compressed-list '("gz" "bz2" "zip" "7z")
1163 "Minimal list of compressed files extension."
1164 :type 'list
1165 :group 'anything-config)
1167 (defcustom anything-locate-db-file-regexp "m?locate\.db$"
1168 "Default regexp to match locate database.
1169 If nil Search in all files."
1170 :type 'string
1171 :group 'anything-config)
1173 (defcustom anything-c-locate-command nil
1174 "A list of arguments for locate program.
1175 If nil it will be calculated when `anything-locate' startup
1176 with these default values for different systems:
1178 Gnu/linux: \"locate -i -r %s\"
1179 berkeley-unix: \"locate -i %s\"
1180 windows-nt: \"es -i -r %s\"
1181 Others: \"locate %s\"
1183 This string will be passed to format so it should end with `%s'.
1184 The \"-r\" option must be the last option."
1185 :type 'string
1186 :group 'anything-config)
1188 (defcustom anything-c-show-info-in-mode-line-delay 12
1189 "Eldoc will show info in mode-line during this delay if user is idle."
1190 :type 'integer
1191 :group 'anything-config)
1193 (defcustom anything-c-copy-files-async-log-file "/tmp/dired.log"
1194 "The file used to communicate with two emacs when copying files async."
1195 :type 'string
1196 :group 'anything-config)
1198 (defcustom anything-ff-printer-list nil
1199 "A list of available printers on your system.
1200 When non--nil let you choose a printer to print file.
1201 Otherwise when nil the variable `printer-name' will be used.
1202 On Unix based systems (lpstat command needed) you don't need to set this,
1203 `anything-ff-find-printers' will find a list of available printers for you."
1204 :type 'list
1205 :group 'anything-config)
1207 (defcustom anything-ff-transformer-show-only-basename nil
1208 "Show only basename of candidates in `anything-find-files'.
1209 This can be toggled at anytime from `anything-find-files' with \
1210 \\<anything-find-files-map>0\\[anything-ff-run-toggle-basename]."
1211 :type 'boolean
1212 :group 'anything-config)
1214 (defcustom anything-ff-quick-delete-dont-prompt-for-deletion nil
1215 "Don't ask in persistent deletion of files when non--nil."
1216 :group 'anything-config
1217 :type 'boolean)
1219 (defcustom anything-ff-signal-error-on-dot-files t
1220 "Signal error when file is `.' or `..' on file deletion when non--nil.
1221 Default is non--nil."
1222 :group 'anything-config
1223 :type 'boolean)
1225 (defcustom anything-completing-read-handlers-alist
1226 '((describe-function . anything-completing-read-symbols)
1227 (describe-variable . anything-completing-read-symbols)
1228 (debug-on-entry . anything-completing-read-symbols)
1229 (find-function . anything-completing-read-symbols)
1230 (trace-function . anything-completing-read-symbols)
1231 (trace-function-background . anything-completing-read-symbols)
1232 (find-tag . anything-completing-read-with-cands-in-buffer)
1233 (ffap-alternate-file . nil))
1234 "Alist of handlers to replace `completing-read', `read-file-name' in `ac-mode'.
1235 Each entry is a cons cell like \(emacs_command . completing-read_handler\)
1236 where key and value are symbols.
1238 Each key is an Emacs command that use originaly `completing-read'.
1240 Each value maybe an anything function that take same arguments as
1241 `completing-read' plus NAME and BUFFER, where NAME is the name of the new
1242 anything source and BUFFER the name of the buffer we will use.
1243 This function prefix name must start by \"anything\".
1245 See `anything-completing-read-symbols' for example.
1247 If the value of an entry is nil completion will fall back to
1248 emacs vanilla behavior.
1249 e.g If you want to disable anything completion for `describe-function':
1250 \(describe-function . nil\).
1252 Ido is also supported, you can use `ido-completing-read' and
1253 `ido-read-file-name' as value of an entry or just 'ido.
1254 e.g ido completion for `find-file':
1255 \(find-file . ido\)
1256 same as
1257 \(find-file . ido-read-file-name\)
1258 Note that you don't need to enable `ido-mode' for this to work."
1259 :group 'anything-config
1260 :type '(alist :key-type symbol :value-type symbol))
1262 (defcustom anything-M-x-requires-pattern 2
1263 "Value of requires-pattern for `anything-M-x'.
1264 Set it to 0 to disable requires-pattern in `anything-M-x'."
1265 :group 'anything-config
1266 :type 'boolean)
1268 ;;; Build info-index sources with info-index plug-in.
1271 (defun anything-c-build-info-index-command (name doc source buffer)
1272 "Define an anything command NAME with documentation DOC.
1273 Arg SOURCE will be an existing anything source named
1274 `anything-c-source-info-<NAME>' and BUFFER a string buffer name."
1275 (eval (list 'defun name nil doc
1276 (list 'interactive)
1277 (list 'anything
1278 :sources source
1279 :buffer buffer
1280 :candidate-number-limit 1000))))
1282 (defun anything-c-define-info-index-sources (var-value &optional commands)
1283 "Define anything sources named anything-c-source-info-<NAME>.
1284 Sources are generated for all entries of `anything-c-default-info-index-list'.
1285 If COMMANDS arg is non--nil build also commands named `anything-info<NAME>'.
1286 Where NAME is one of `anything-c-default-info-index-list'."
1287 (loop with symbols = (loop for str in var-value
1288 collect
1289 (intern (concat "anything-c-source-info-" str)))
1290 for sym in symbols
1291 for str in var-value
1292 do (set sym (list (cons 'name (format "Info index: %s" str))
1293 (cons 'info-index str)))
1294 when commands
1295 do (let ((com (intern (concat "anything-info-" str))))
1296 (anything-c-build-info-index-command com
1297 (format "Predefined anything for %s info." str) sym
1298 (format "*anything info %s*" str)))))
1300 (defun anything-info-index-set (var value)
1301 (set var value)
1302 (anything-c-define-info-index-sources value t))
1304 (defcustom anything-c-default-info-index-list
1305 '("elisp" "cl" "org" "gnus" "tramp" "ratpoison"
1306 "zsh" "bash" "coreutils" "fileutils"
1307 "find" "sh-utils" "textutils" "libc"
1308 "make" "automake" "autoconf" "emacs-lisp-intro"
1309 "emacs" "elib" "eieio" "gauche-refe" "guile"
1310 "guile-tut" "goops" "screen" "latex" "gawk"
1311 "sed" "m4" "wget" "binutils" "as" "bfd" "gprof"
1312 "ld" "diff" "flex" "grep" "gzip" "libtool"
1313 "texinfo" "info" "gdb" "stabs" "cvsbook" "cvs"
1314 "bison" "id-utils" "global")
1315 "Info Manual entries to use for building anything info index commands."
1316 :group 'anything-config
1317 :type 'list
1318 :set 'anything-info-index-set)
1321 ;;; General internal variables
1323 ;; Some internals variable that need to be loaded
1324 ;; here to avoid compiler warnings.
1325 (defvar anything-c-external-commands-list nil
1326 "A list of all external commands the user can execute. If this
1327 variable is not set by the user, it will be calculated
1328 automatically.")
1330 (defvar anything-c-show-completion-overlay nil)
1334 ;;; Faces
1337 (defface anything-buffer-saved-out
1338 '((t (:foreground "red")))
1339 "*Face used for buffer files modified outside of emacs."
1340 :group 'anything-config)
1342 (defface anything-buffer-not-saved
1343 '((t (:foreground "Indianred2")))
1344 "*Face used for buffer files not already saved on disk."
1345 :group 'anything-config)
1347 (defface anything-ff-prefix
1348 '((t (:background "yellow" :foreground "black")))
1349 "*Face used to prefix new file or url paths in `anything-find-files'."
1350 :group 'anything-config)
1352 (defface anything-ff-executable
1353 '((t (:foreground "green")))
1354 "*Face used for executable files in `anything-find-files'."
1355 :group 'anything-config)
1357 (defface anything-ff-directory
1358 '((t (:foreground "DarkRed" :background "LightGray")))
1359 "*Face used for directories in `anything-find-files'."
1360 :group 'anything-config)
1362 (defface anything-ff-symlink
1363 '((t (:foreground "DarkOrange")))
1364 "*Face used for symlinks in `anything-find-files'."
1365 :group 'anything-config)
1367 (defface anything-ff-invalid-symlink
1368 '((t (:foreground "black" :background "red")))
1369 "*Face used for invalid symlinks in `anything-find-files'."
1370 :group 'anything-config)
1372 (defface anything-ff-file
1373 '((t (:foreground "CadetBlue" :underline t)))
1374 "*Face used for file names in `anything-find-files'."
1375 :group 'anything-config)
1377 (defface anything-grep-match
1378 '((t (:inherit match)))
1379 "Face used to highlight grep matches."
1380 :group 'anything-config)
1382 (defface anything-grep-file
1383 '((t (:foreground "BlueViolet" :underline t)))
1384 "Face used to highlight grep results filenames."
1385 :group 'anything-config)
1387 (defface anything-grep-lineno
1388 '((t (:foreground "Darkorange1")))
1389 "Face used to highlight grep number lines."
1390 :group 'anything-config)
1392 (defface anything-grep-running
1393 '((t (:foreground "Red")))
1394 "Face used in mode line when grep is running."
1395 :group 'anything-config)
1397 (defface anything-grep-finish
1398 '((t (:foreground "Green")))
1399 "Face used in mode line when grep is finish."
1400 :group 'anything-config)
1402 (defface anything-M-x-key-face '((t (:foreground "orange" :underline t)))
1403 "*Face used in anything-M-x to show keybinding."
1404 :group 'anything)
1406 (defface anything-bmkext-info
1407 '((t (:foreground "green")))
1408 "*Face used for W3m Emacs bookmarks (not w3m bookmarks)."
1409 :group 'anything)
1411 (defface anything-bmkext-w3m
1412 '((t (:foreground "yellow")))
1413 "*Face used for W3m Emacs bookmarks (not w3m bookmarks)."
1414 :group 'anything)
1416 (defface anything-bmkext-gnus
1417 '((t (:foreground "magenta")))
1418 "*Face used for Gnus bookmarks."
1419 :group 'anything)
1421 (defface anything-bmkext-man
1422 '((t (:foreground "Orange4")))
1423 "*Face used for Woman/man bookmarks."
1424 :group 'anything)
1426 (defface anything-bmkext-no--file
1427 '((t (:foreground "grey")))
1428 "*Face used for non--file bookmarks."
1429 :group 'anything)
1431 (defface anything-bmkext-file
1432 '((t (:foreground "Deepskyblue2")))
1433 "*Face used for non--file bookmarks."
1434 :group 'anything)
1436 (defface anything-bookmarks-su-face '((t (:foreground "red")))
1437 "Face for su/sudo bookmarks."
1438 :group 'anything)
1440 (defface anything-w3m-bookmarks-face '((t (:foreground "cyan1" :underline t)))
1441 "Face for w3m bookmarks" :group 'anything)
1443 (defface anything-emms-playlist
1444 '((t (:foreground "Springgreen4" :underline t)))
1445 "*Face used for tracks in current emms playlist."
1446 :group 'anything)
1448 (defface anything-apt-installed
1449 '((t (:foreground "green")))
1450 "*Face used for apt installed candidates."
1451 :group 'anything)
1453 (defface anything-apt-deinstalled
1454 '((t (:foreground "DimGray")))
1455 "*Face used for apt deinstalled candidates."
1456 :group 'anything)
1458 (defface anything-gentoo-match-face '((t (:foreground "red")))
1459 "Face for anything-gentoo installed packages."
1460 :group 'traverse-faces)
1462 (defface anything-lisp-show-completion
1463 '((t (:background "DarkSlateGray")))
1464 "*Face used for showing candidates in `anything-lisp-completion'."
1465 :group 'anything-config)
1467 (defface anything-lisp-completion-info
1468 '((t (:foreground "red")))
1469 "*Face used for showing info in `anything-lisp-completion'."
1470 :group 'anything-config)
1472 (defface anything-overlay-line-face '((t (:background "IndianRed4" :underline t)))
1473 "Face for source header in the anything buffer." :group 'anything)
1475 ;;;###autoload
1476 (defun anything-configuration ()
1477 "Customize `anything'."
1478 (interactive)
1479 (customize-group "anything-config"))
1483 ;;; Anything-command-map
1486 ;;;###autoload
1487 (defvar anything-command-map)
1488 (define-prefix-command 'anything-command-map)
1491 (define-key anything-command-map (kbd "<SPC>") 'anything-execute-anything-command)
1492 (define-key anything-command-map (kbd "a") 'anything-c-apropos)
1493 (define-key anything-command-map (kbd "e") 'anything-c-etags-select)
1494 (define-key anything-command-map (kbd "l") 'anything-locate)
1495 (define-key anything-command-map (kbd "s") 'anything-surfraw)
1496 (define-key anything-command-map (kbd "r") 'anything-regexp)
1497 (define-key anything-command-map (kbd "w") 'anything-w3m-bookmarks)
1498 (define-key anything-command-map (kbd "x") 'anything-firefox-bookmarks)
1499 (define-key anything-command-map (kbd "#") 'anything-emms)
1500 (define-key anything-command-map (kbd "m") 'anything-man-woman)
1501 (define-key anything-command-map (kbd "t") 'anything-top)
1502 (define-key anything-command-map (kbd "i") 'anything-imenu)
1503 (define-key anything-command-map (kbd "<tab>") 'anything-lisp-completion-at-point)
1504 (define-key anything-command-map (kbd "p") 'anything-list-emacs-process)
1505 (define-key anything-command-map (kbd "C-x r b") 'anything-c-pp-bookmarks)
1506 (define-key anything-command-map (kbd "M-y") 'anything-show-kill-ring)
1507 (define-key anything-command-map (kbd "C-c <SPC>") 'anything-all-mark-rings)
1508 (define-key anything-command-map (kbd "C-x C-f") 'anything-find-files)
1509 (define-key anything-command-map (kbd "f") 'anything-for-files)
1510 (define-key anything-command-map (kbd "C-:") 'anything-eval-expression-with-eldoc)
1511 (define-key anything-command-map (kbd "C-,") 'anything-calcul-expression)
1512 (define-key anything-command-map (kbd "M-x") 'anything-M-x)
1513 (define-key anything-command-map (kbd "C-x C-w") 'anything-write-file)
1514 (define-key anything-command-map (kbd "C-x i") 'anything-insert-file)
1515 (define-key anything-command-map (kbd "M-s o") 'anything-occur)
1516 (define-key anything-command-map (kbd "M-g s") 'anything-do-grep)
1517 (define-key anything-command-map (kbd "c") 'anything-colors)
1518 (define-key anything-command-map (kbd "F") 'anything-select-xfont)
1519 (define-key anything-command-map (kbd "C-c f") 'anything-recentf)
1520 (define-key anything-command-map (kbd "C-c g") 'anything-google-suggest)
1521 (define-key anything-command-map (kbd "h i") 'anything-info-at-point)
1522 (define-key anything-command-map (kbd "h r") 'anything-info-emacs)
1523 (define-key anything-command-map (kbd "h g") 'anything-info-gnus)
1524 (define-key anything-command-map (kbd "C-x C-b") 'anything-buffers-list)
1525 (define-key anything-command-map (kbd "C-c C-b") 'anything-browse-code)
1526 (define-key anything-command-map (kbd "C-x r i") 'anything-register)
1527 (define-key anything-command-map (kbd "C-c C-x") 'anything-c-run-external-command)
1529 ;; In Emacs 23.1.50, minibuffer-local-must-match-filename-map was renamed to
1530 ;; minibuffer-local-filename-must-match-map.
1531 (defvar minibuffer-local-filename-must-match-map (make-sparse-keymap)) ;; Emacs 23.1.+
1532 (defvar minibuffer-local-must-match-filename-map (make-sparse-keymap)) ;; Older Emacsen
1533 (dolist (map (list minibuffer-local-filename-completion-map
1534 minibuffer-local-completion-map
1535 minibuffer-local-must-match-filename-map
1536 minibuffer-local-filename-must-match-map
1537 minibuffer-local-map
1538 minibuffer-local-isearch-map
1539 minibuffer-local-must-match-map
1540 minibuffer-local-ns-map))
1541 (define-key map "\C-r" 'anything-minibuffer-history))
1545 ;;; Menu
1548 (easy-menu-define nil global-map
1549 "`anything' menu"
1550 '("Anything"
1551 ["All anything commands" anything-execute-anything-command t]
1552 ["Find any Files/Buffers" anything-for-files t]
1553 ["Anything Everywhere (Toggle)" ac-mode t]
1554 "----"
1555 ("Files:"
1556 ["Find files" anything-find-files t]
1557 ["Recent Files" anything-recentf t]
1558 ["Locate" anything-locate t]
1559 ["Bookmarks" anything-c-pp-bookmarks t])
1560 ("Buffers:"
1561 ["Find buffers" anything-buffers-list t])
1562 ("Commands:"
1563 ["Emacs Commands" anything-M-x t]
1564 ["Externals Commands" anything-c-run-external-command t])
1565 ("Help:"
1566 ["Anything Apropos" anything-c-apropos t])
1567 ("Info:"
1568 ["Info at point" anything-info-at-point t]
1569 ["Emacs Manual index" anything-info-emacs t]
1570 ["Gnus Manual index" anything-info-gnus t])
1571 ("Org:"
1572 ["Org keywords" anything-org-keywords t]
1573 ["Org headlines" anything-org-headlines t])
1574 ("Tools:"
1575 ["Occur" anything-occur t]
1576 ["Grep" anything-do-grep t]
1577 ["Etags" anything-c-etags-select t]
1578 ["Lisp complete at point" anything-lisp-completion-at-point t]
1579 ["Browse Kill ring" anything-show-kill-ring t]
1580 ["Browse register" anything-register t]
1581 ["Browse code" anything-browse-code t]
1582 ["Mark Ring" anything-all-mark-rings t]
1583 ["Regexp handler" anything-regexp t]
1584 ["Colors & Faces" anything-colors t]
1585 ["Show xfonts" anything-select-xfont t]
1586 ["Ucs Symbols" anything-ucs t]
1587 ["Imenu" anything-imenu t]
1588 ["Google Suggest" anything-google-suggest t]
1589 ["Eval expression" anything-eval-expression-with-eldoc t]
1590 ["Calcul expression" anything-calcul-expression t]
1591 ["Man pages" anything-man-woman t]
1592 ["Top externals process" anything-top t]
1593 ["Emacs internals process" anything-list-emacs-process t])
1594 "----"
1595 ["Prefered Options" anything-configuration t]))
1597 ;;; Anything map add ons
1600 (define-key anything-map (kbd "C-x C-f") 'anything-quit-and-find-file)
1601 (define-key anything-map (kbd "M-m") 'anything-toggle-all-marks)
1602 (define-key anything-map (kbd "C-w") 'anything-yank-text-at-point)
1605 ;;; Specialized keymaps
1608 (defvar anything-c-buffer-map
1609 (let ((map (copy-keymap anything-map)))
1610 (define-key map (kbd "C-c ?") 'anything-c-buffer-help)
1611 ;; No need to have separate command for grep and zgrep
1612 ;; as we don't use recursivity for buffers.
1613 ;; So use zgrep for both as it is capable to handle non--compressed files.
1614 (define-key map (kbd "M-g s") 'anything-buffer-run-zgrep)
1615 (define-key map (kbd "C-c o") 'anything-buffer-switch-other-window)
1616 (define-key map (kbd "C-c C-o") 'anything-buffer-switch-other-frame)
1617 (define-key map (kbd "C-c =") 'anything-buffer-run-ediff)
1618 (define-key map (kbd "M-=") 'anything-buffer-run-ediff-merge)
1619 (define-key map (kbd "C-=") 'anything-buffer-diff-persistent)
1620 (define-key map (kbd "M-U") 'anything-buffer-revert-persistent)
1621 (define-key map (kbd "M-D") 'anything-buffer-run-kill-buffers)
1622 (define-key map (kbd "C-x C-s") 'anything-buffer-save-persistent)
1623 (define-key map (kbd "C-M-%") 'anything-buffer-run-query-replace-regexp)
1624 (define-key map (kbd "M-%") 'anything-buffer-run-query-replace)
1625 (define-key map (kbd "M-m") 'anything-toggle-all-marks)
1626 (define-key map (kbd "M-a") 'anything-mark-all)
1627 (when (locate-library "elscreen")
1628 (define-key map (kbd "<C-tab>") 'anything-buffer-switch-to-elscreen))
1629 (delq nil map))
1630 "Keymap for buffer sources in anything.")
1632 (defvar anything-find-files-map
1633 (let ((map (copy-keymap anything-map)))
1634 (define-key map (kbd "C-]") 'anything-ff-run-toggle-basename)
1635 (define-key map (kbd "C-x C-f") 'anything-ff-run-locate)
1636 (define-key map (kbd "M-g s") 'anything-ff-run-grep)
1637 (define-key map (kbd "M-g p") 'anything-ff-run-pdfgrep)
1638 (define-key map (kbd "M-g z") 'anything-ff-run-zgrep)
1639 (define-key map (kbd "M-.") 'anything-ff-run-etags)
1640 (define-key map (kbd "M-R") 'anything-ff-run-rename-file)
1641 (define-key map (kbd "M-C") 'anything-ff-run-copy-file)
1642 (define-key map (kbd "M-B") 'anything-ff-run-byte-compile-file)
1643 (define-key map (kbd "M-L") 'anything-ff-run-load-file)
1644 (define-key map (kbd "M-S") 'anything-ff-run-symlink-file)
1645 (define-key map (kbd "M-H") 'anything-ff-run-hardlink-file)
1646 (define-key map (kbd "M-D") 'anything-ff-run-delete-file)
1647 (define-key map (kbd "M-K") 'anything-ff-run-kill-buffer-persistent)
1648 (define-key map (kbd "C-d") 'anything-ff-persistent-delete)
1649 (define-key map (kbd "M-e") 'anything-ff-run-switch-to-eshell)
1650 (define-key map (kbd "<M-tab>") 'anything-ff-run-complete-fn-at-point)
1651 (define-key map (kbd "C-c o") 'anything-ff-run-switch-other-window)
1652 (define-key map (kbd "C-c C-o") 'anything-ff-run-switch-other-frame)
1653 (define-key map (kbd "C-c C-x") 'anything-ff-run-open-file-externally)
1654 (define-key map (kbd "M-!") 'anything-ff-run-eshell-command-on-file)
1655 (define-key map (kbd "C-=") 'anything-ff-run-ediff-file)
1656 (define-key map (kbd "C-c =") 'anything-ff-run-ediff-merge-file)
1657 (define-key map (kbd "M-p") 'anything-ff-run-switch-to-history)
1658 (define-key map (kbd "M-i") 'anything-ff-properties-persistent)
1659 (define-key map (kbd "C-c ?") 'anything-ff-help)
1660 (define-key map (kbd "C-}") 'anything-narrow-window)
1661 (define-key map (kbd "C-{") 'anything-enlarge-window)
1662 (define-key map (kbd "C-<backspace>") 'anything-ff-run-toggle-auto-update)
1663 (define-key map (kbd "M-a") 'anything-mark-all)
1664 (define-key map (kbd "M-m") 'anything-toggle-all-marks)
1665 (define-key map (kbd "M-u") 'anything-unmark-all)
1666 (define-key map (kbd "C-c C-a") 'anything-ff-run-gnus-attach-files)
1667 (define-key map (kbd "C-c p") 'anything-ff-run-print-file)
1668 ;; Next 2 have no effect if candidate is not an image file.
1669 (define-key map (kbd "M-l") 'anything-ff-rotate-left-persistent)
1670 (define-key map (kbd "M-r") 'anything-ff-rotate-right-persistent)
1671 (define-key map (kbd "C-.") 'anything-find-files-down-one-level)
1672 (define-key map (kbd "C-l") 'anything-find-files-down-one-level)
1673 (define-key map (kbd "C-h C-b") 'anything-send-bug-report-from-anything)
1674 (define-key map (kbd "C-h C-d") 'anything-debug-output)
1675 (when anything-ff-lynx-style-map
1676 (define-key map (kbd "<left>") 'anything-find-files-down-one-level)
1677 (define-key map (kbd "<right>") 'anything-execute-persistent-action))
1678 (delq nil map))
1679 "Keymap for `anything-find-files'.")
1681 (defvar anything-c-read-file-map
1682 (let ((map (copy-keymap anything-map)))
1683 (define-key map (kbd "C-]") 'anything-ff-run-toggle-basename)
1684 (define-key map (kbd "C-.") 'anything-find-files-down-one-level)
1685 (define-key map (kbd "C-l") 'anything-find-files-down-one-level)
1686 (define-key map (kbd "C-<backspace>") 'anything-ff-run-toggle-auto-update)
1687 (define-key map (kbd "C-c ?") 'anything-read-file-name-help)
1688 (when anything-ff-lynx-style-map
1689 (define-key map (kbd "<left>") 'anything-find-files-down-one-level)
1690 (define-key map (kbd "<right>") 'anything-execute-persistent-action)
1691 (define-key map (kbd "C-o") nil)
1692 (define-key map (kbd "<M-left>") 'anything-previous-source)
1693 (define-key map (kbd "<M-right>") 'anything-next-source))
1694 (delq nil map))
1695 "Keymap for `anything-c-read-file-name'.")
1697 (defvar anything-generic-files-map
1698 (let ((map (copy-keymap anything-map)))
1699 (define-key map (kbd "M-g s") 'anything-ff-run-grep)
1700 (define-key map (kbd "M-g z") 'anything-ff-run-zgrep)
1701 (define-key map (kbd "M-g p") 'anything-ff-run-pdfgrep)
1702 (define-key map (kbd "M-D") 'anything-ff-run-delete-file)
1703 (define-key map (kbd "C-=") 'anything-ff-run-ediff-file)
1704 (define-key map (kbd "C-c =") 'anything-ff-run-ediff-merge-file)
1705 (define-key map (kbd "C-c o") 'anything-ff-run-switch-other-window)
1706 (define-key map (kbd "M-i") 'anything-ff-properties-persistent)
1707 (define-key map (kbd "C-c C-x") 'anything-ff-run-open-file-externally)
1708 (define-key map (kbd "C-w") 'anything-yank-text-at-point)
1709 (define-key map (kbd "C-c ?") 'anything-generic-file-help)
1710 map)
1711 "Generic Keymap for files.")
1713 (defvar anything-c-grep-map
1714 (let ((map (copy-keymap anything-map)))
1715 (define-key map (kbd "M-<down>") 'anything-c-goto-next-file)
1716 (define-key map (kbd "M-<up>") 'anything-c-goto-precedent-file)
1717 (define-key map (kbd "C-c o") 'anything-c-grep-run-other-window-action)
1718 (define-key map (kbd "C-w") 'anything-yank-text-at-point)
1719 (define-key map (kbd "C-x C-s") 'anything-c-grep-run-save-buffer)
1720 (when anything-c-grep-use-ioccur-style-keys
1721 (define-key map (kbd "<right>") 'anything-c-grep-run-persistent-action)
1722 (define-key map (kbd "<left>") 'anything-c-grep-run-default-action))
1723 (define-key map (kbd "C-c ?") 'anything-grep-help)
1724 (delq nil map))
1725 "Keymap used in Grep sources.")
1727 (defvar anything-c-pdfgrep-map
1728 (let ((map (copy-keymap anything-map)))
1729 (define-key map (kbd "M-<down>") 'anything-c-goto-next-file)
1730 (define-key map (kbd "M-<up>") 'anything-c-goto-precedent-file)
1731 (define-key map (kbd "C-w") 'anything-yank-text-at-point)
1732 (define-key map (kbd "C-c ?") 'anything-pdfgrep-help)
1733 map)
1734 "Keymap used in pdfgrep.")
1736 (defvar anything-c-etags-map
1737 (let ((map (copy-keymap anything-map)))
1738 (define-key map (kbd "M-<down>") 'anything-c-goto-next-file)
1739 (define-key map (kbd "M-<up>") 'anything-c-goto-precedent-file)
1740 (define-key map (kbd "C-w") 'anything-yank-text-at-point)
1741 (define-key map (kbd "C-c ?") 'anything-etags-help)
1742 map)
1743 "Keymap used in Etags.")
1745 (defvar anything-eval-expression-map
1746 (let ((map (copy-keymap anything-map)))
1747 (define-key map (kbd "<C-return>") 'anything-eval-new-line-and-indent)
1748 (define-key map (kbd "<tab>") 'lisp-indent-line)
1749 (define-key map (kbd "<C-tab>") 'lisp-complete-symbol)
1750 (define-key map (kbd "C-p") 'previous-line)
1751 (define-key map (kbd "C-n") 'next-line)
1752 (define-key map (kbd "<up>") 'previous-line)
1753 (define-key map (kbd "<down>") 'next-line)
1754 (define-key map (kbd "<right>") 'forward-char)
1755 (define-key map (kbd "<left>") 'backward-char)
1756 map))
1758 (defvar anything-c-ucs-map
1759 (let ((map (copy-keymap anything-map)))
1760 (define-key map (kbd "<C-backspace>") 'anything-c-ucs-persistent-delete)
1761 (define-key map (kbd "<C-left>") 'anything-c-ucs-persistent-backward)
1762 (define-key map (kbd "<C-right>") 'anything-c-ucs-persistent-forward)
1763 (define-key map (kbd "<C-return>") 'anything-c-ucs-persistent-insert)
1764 (define-key map (kbd "C-c ?") 'anything-c-ucs-help)
1765 map)
1766 "Keymap for `anything-ucs'.")
1768 (defvar anything-c-bookmark-map
1769 (let ((map (copy-keymap anything-map)))
1770 (define-key map (kbd "C-c o") 'anything-c-bookmark-run-jump-other-window)
1771 (define-key map (kbd "C-d") 'anything-c-bookmark-run-delete)
1772 (when (locate-library "bookmark-extensions")
1773 (define-key map (kbd "M-e") 'anything-c-bmkext-run-edit))
1774 (define-key map (kbd "C-c ?") 'anything-c-bookmark-help)
1775 (delq nil map))
1776 "Generic Keymap for emacs bookmark sources.")
1778 (defvar anything-esh-on-file-map
1779 (let ((map (copy-keymap anything-map)))
1780 (define-key map (kbd "C-c ?") 'anything-esh-help)
1781 map)
1782 "Keymap for `anything-find-files-eshell-command-on-file'.")
1784 (defvar anything-eshell-history-map
1785 (let ((map (copy-keymap anything-map)))
1786 (define-key map (kbd "M-p") 'anything-next-line)
1787 map)
1788 "Keymap for `anything-eshell-history'.")
1790 (defvar anything-kill-ring-map
1791 (let ((map (copy-keymap anything-map)))
1792 (define-key map (kbd "M-y") 'anything-next-line)
1793 (define-key map (kbd "M-u") 'anything-previous-line)
1794 map)
1795 "Keymap for `anything-show-kill-ring'.")
1797 (defvar anything-occur-map
1798 (let ((map (copy-keymap anything-map)))
1799 (define-key map (kbd "C-M-%") 'anything-occur-run-query-replace-regexp)
1800 map)
1801 "Keymap for `anything-occur'.")
1804 ;;; Embeded documentation.
1807 (defun anything-c-list-preconfigured-anything ()
1808 "Collect preconfigured anything functions in this file."
1809 (loop with doc
1810 with sym
1811 for entry in (cdr (assoc
1812 (file-truename (locate-library "anything-config"))
1813 load-history))
1814 if (and (consp entry)
1815 (eq (car entry) 'defun)
1816 (string-match "^Preconfigured.+$"
1817 (setq doc (or (documentation (setq sym (cdr entry)))
1818 ""))))
1819 collect (cons sym (match-string 0 doc))))
1821 (defun anything-c-format-preconfigured-anything ()
1822 (mapcar (lambda (x) (format "\\[%s] : %s\n" (car x) (cdr x)))
1823 (anything-c-list-preconfigured-anything)))
1825 ;;; Global help message - Used by `anything-help'
1828 (setq anything-help-message
1829 (lambda ()
1830 (concat
1831 "\\<anything-map>"
1832 "`anything' is QuickSilver-like candidate-selection framework.
1834 Narrow the list by typing some pattern,
1835 Multiple patterns are allowed by splitting by space.
1836 Select with natural Emacs operations, choose with RET.
1838 If you have any problems, press C-c C-x C-b!!
1839 Feel free to send bug reports. I'll fix them.
1840 The steps are described in the beginning of anything.el file.
1842 == Basic Operations ==
1843 C-p, Up: Previous Line
1844 C-n, Down : Next Line
1845 M-v, PageUp : Previous Page
1846 C-v, PageDown : Next Page
1847 Enter : Execute first (default) action / Select
1848 M-< : First Line
1849 M-> : Last Line
1850 M-PageUp, C-M-S-v, C-M-y : Previous Page (other-window)
1851 M-PageDown, C-M-v : Next Page (other-window)
1853 Tab, C-i : Show action list
1854 Left : Previous Source
1855 Right, C-o : Next Source
1856 C-k : Delete pattern
1857 C-z : Persistent Action (Execute action with anything session kept)
1858 C-c C-x C-b: Send a bug report
1860 == Shortcuts For 2nd/3rd Action ==
1861 \\[anything-select-2nd-action-or-end-of-line] : Execute 2nd Action (if the minibuffer cursor is at end of line)
1862 \\[anything-select-3rd-action] : Execute 3rd Action
1864 == Visible Marks ==
1865 Visible marks store candidate. Some actions uses marked candidates.
1867 \\[anything-toggle-visible-mark] : Toggle Visible Mark
1868 \\[anything-prev-visible-mark] : Previous Mark
1869 \\[anything-next-visible-mark] : Next Mark
1871 == Miscellaneous Commands ==
1872 \\[anything-toggle-resplit-window] : Toggle vertical/horizontal split anything window
1873 \\[anything-quit-and-find-file] : Drop into `find-file'
1874 \\[anything-delete-current-selection] : Delete Selected Item (visually)
1875 \\[anything-kill-selection-and-quit] : Set Item Into the kill-ring And Quit
1876 \\[anything-yank-selection] : Yank Selected Item Into Pattern
1877 \\[anything-follow-mode] : Toggle Automatical Execution Of Persistent Action
1878 \\[anything-force-update] : Recalculate And Redisplay Candidates
1880 == Global Commands ==
1881 \\<global-map>\\[anything-resume] revives last `anything' session.
1882 It is very useful, so you should bind any key.
1884 Single source is executed by \\[anything-call-source].
1886 == Preconfigured `anything' ==
1887 Preconfigured `anything' is commands that uses `anything' interface.
1888 You can use them without configuration.
1891 (apply 'concat (anything-c-format-preconfigured-anything))
1893 Enjoy!")))
1895 ;;; `anything-buffer-list' help
1898 (defvar anything-c-buffer-help-message
1899 "== Anything Buffer ==
1900 \nTips:
1901 You can enter a partial name of major-mode (e.g lisp, sh) to narrow down buffers.
1902 Enter then a space and a pattern to narrow down to buffers matching this pattern.
1903 \nSpecific commands for `anything-buffers-list':
1904 \\<anything-c-buffer-map>
1905 \\[anything-buffer-run-zgrep]\t\t->Grep Buffer(s) works as zgrep too. (C-u grep all buffers but non--file buffers).
1906 \\[anything-buffer-switch-other-window]\t\t->Switch other window.
1907 \\[anything-buffer-switch-other-frame]\t\t->Switch other frame.
1908 \\[anything-buffer-run-query-replace-regexp]\t\t->Query replace regexp in marked buffers.
1909 \\[anything-buffer-run-query-replace]\t\t->Query replace in marked buffers.
1910 \\[anything-buffer-switch-to-elscreen]\t\t->Find buffer in Elscreen.
1911 \\[anything-buffer-run-ediff]\t\t->Ediff current buffer with candidate. If two marked buffers ediff those buffers.
1912 \\[anything-buffer-run-ediff-merge]\t\t->Ediff merge current buffer with candidate. If two marked buffers ediff merge those buffers.
1913 \\[anything-buffer-diff-persistent]\t\t->Toggle Diff buffer with saved file without quitting.
1914 \\[anything-buffer-revert-persistent]\t\t->Revert buffer without quitting.
1915 \\[anything-buffer-save-persistent]\t\t->Save buffer without quitting.
1916 \\[anything-buffer-run-kill-buffers]\t\t->Delete marked buffers and quit.
1917 \\[anything-toggle-all-marks]\t\t->Toggle all marks.
1918 \\[anything-mark-all]\t\t->Mark all.
1919 \\[anything-c-buffer-help]\t\t->Display this help.
1920 \n== Anything Map ==
1921 \\{anything-map}")
1923 ;;;###autoload
1924 (defun anything-c-buffer-help ()
1925 "Help command for anything buffers."
1926 (interactive)
1927 (let ((anything-help-message anything-c-buffer-help-message))
1928 (anything-help)))
1930 ;;; Find files help (`anything-find-files')
1933 (defvar anything-ff-help-message
1934 "== Anything Find Files ==
1935 \nTips:
1936 \n- Enter `~/' at end of pattern to quickly reach home directory.
1937 - Enter `/' at end of pattern to quickly reach root of your file system.
1938 - Enter `./' at end of pattern to quickly reach `default-directory' (initial start of session).
1939 - You can complete with partial basename \(e.g \"fb\" will complete \"foobar\"\).
1940 - Use `C-u C-z' to watch an image.
1941 - To browse images directories turn on `anything-follow-mode' and navigate with arrow keys.
1942 - When entered ediff, hitting `C-g' will ask you to use locate to find the file to ediff with.
1944 \nSpecific commands for `anything-find-files':
1945 \\<anything-find-files-map>
1946 \\[anything-ff-run-locate]\t\t->Run Locate on basename of candidate (C-u to specify locate db).
1947 \\[anything-ff-run-grep]\t\t->Run Grep (C-u Recursive).
1948 \\[anything-ff-run-pdfgrep]\t\t->Run Pdfgrep on marked files.
1949 \\[anything-ff-run-zgrep]\t\t->Run zgrep (C-u Recursive).
1950 \\[anything-ff-run-etags]\t\t->Run Etags (C-u use thing-at-point `C-u C-u' reload cache)
1951 \\[anything-ff-run-rename-file]\t\t->Rename File (C-u Follow).
1952 \\[anything-ff-run-copy-file]\t\t->Copy File (C-u Follow).
1953 \\[anything-ff-run-byte-compile-file]\t\t->Byte Compile File (C-u Load).
1954 \\[anything-ff-run-load-file]\t\t->Load File.
1955 \\[anything-ff-run-symlink-file]\t\t->Symlink File.
1956 \\[anything-ff-run-hardlink-file]\t\t->Hardlink file.
1957 \\[anything-ff-run-delete-file]\t\t->Delete File.
1958 \\[anything-ff-run-kill-buffer-persistent]\t\t->Kill buffer candidate without quitting.
1959 \\[anything-ff-persistent-delete]\t\t->Delete file without quitting.
1960 \\[anything-ff-run-switch-to-eshell]\t\t->Switch to Eshell.
1961 \\[anything-ff-run-eshell-command-on-file]\t\t->Eshell command on file (C-u Run on all marked files at once).
1962 \\[anything-ff-run-ediff-file]\t\t->Ediff file.
1963 \\[anything-ff-run-ediff-merge-file]\t\t->Ediff merge file.
1964 \\[anything-ff-run-complete-fn-at-point]\t\t->Complete file name at point.
1965 \\[anything-ff-run-switch-other-window]\t\t->Switch other window.
1966 \\[anything-ff-run-switch-other-frame]\t\t->Switch other frame.
1967 \\[anything-ff-run-open-file-externally]\t\t->Open file with external program (C-u to choose).
1968 \\[anything-ff-rotate-left-persistent]\t\t->Rotate Image Left.
1969 \\[anything-ff-rotate-right-persistent]\t\t->Rotate Image Right.
1970 \\[anything-find-files-down-one-level]\t\t->Go down precedent directory.
1971 \\[anything-ff-run-switch-to-history]\t\t->Switch to anything find-files history.
1972 \\[anything-ff-properties-persistent]\t\t->Show file properties in a tooltip.
1973 \\[anything-mark-all]\t\t->Mark all visibles candidates.
1974 \\[anything-ff-run-toggle-auto-update]\t->Toggle auto expansion of directories.
1975 \\[anything-unmark-all]\t\t->Unmark all candidates, visibles and invisibles.
1976 \\[anything-ff-run-gnus-attach-files]\t\t->Gnus attach files to message buffer.
1977 \\[anything-ff-run-print-file]\t\t->Print file, (C-u to refresh printers list).
1978 \\[anything-enlarge-window]\t\t->Enlarge anything window.
1979 \\[anything-narrow-window]\t\t->Narrow anything window.
1980 \\[anything-ff-run-toggle-basename]\t\t->Toggle basename/fullpath.
1981 \\[anything-send-bug-report-from-anything]\t\t->Send Bug report.
1982 \\[anything-ff-help]\t\t->Display this help info.
1983 \n== Anything Map ==
1984 \\{anything-map}")
1986 ;;;###autoload
1987 (defun anything-ff-help ()
1988 "Help command for `anything-find-files'."
1989 (interactive)
1990 (let ((anything-help-message anything-ff-help-message))
1991 (anything-help)))
1993 ;;; Help for `anything-c-read-file-name'
1996 (defvar anything-read-file-name-help-message
1997 "== Anything read file name Map ==\
1998 \nSpecific commands for anything-c-read-file-name:
1999 \\<anything-c-read-file-map>
2000 \\[anything-find-files-down-one-level]\t\t->Go down precedent directory.
2001 \\[anything-ff-run-toggle-auto-update]\t->Toggle auto expansion of directories.
2002 \\[anything-next-source]\t->Goto next source.
2003 \\[anything-previous-source]\t->Goto previous source.
2004 \\[anything-read-file-name-help]\t\t->Display this help info.
2005 \n== Anything Map ==
2006 \\{anything-map}")
2008 ;;;###autoload
2009 (defun anything-read-file-name-help ()
2010 (interactive)
2011 (let ((anything-help-message anything-read-file-name-help-message))
2012 (anything-help)))
2014 ;;; Generic file help - Used by locate.
2017 (defvar anything-generic-file-help-message
2018 "== Anything Generic files Map ==\
2019 \nSpecific commands for anything locate and others files sources:
2020 \\<anything-generic-files-map>
2021 \\[anything-ff-run-grep]\t\t->Run grep (C-u recurse).
2022 \\[anything-ff-run-pdfgrep]\t\t->Run Pdfgrep on marked files.
2023 \\[anything-ff-run-delete-file]\t\t->Delete file.
2024 \\[anything-ff-run-ediff-file]\t\t->Ediff file.
2025 \\[anything-ff-run-ediff-merge-file]\t\t->Ediff merge file.
2026 \\[anything-ff-run-switch-other-window]\t\t->Switch other window.
2027 \\[anything-ff-properties-persistent]\t\t->Show file properties.
2028 \\[anything-yank-text-at-point]\t\t->Yank text at point.
2029 \\[anything-ff-run-open-file-externally]\t\t->Open file with external program (C-u to choose).
2030 \nLocate tips:
2031 You can add after writing search pattern any of the locate command line options.
2032 e.g -b, -e, -n <number>...etc.
2033 See Man locate for more infos.
2034 \n== Anything Map ==
2035 \\{anything-map}")
2037 ;;;###autoload
2038 (defun anything-generic-file-help ()
2039 (interactive)
2040 (let ((anything-help-message anything-generic-file-help-message))
2041 (anything-help)))
2043 ;;; Grep help
2046 (defvar anything-grep-help-message
2047 "== Anything Grep Map ==\
2048 \nSpecific commands for Grep and Etags:
2049 \\<anything-c-grep-map>
2050 \\[anything-c-goto-next-file]\t->Next File.
2051 \\[anything-c-goto-precedent-file]\t\t->Precedent File.
2052 \\[anything-yank-text-at-point]\t\t->Yank Text at point in minibuffer.
2053 \\[anything-c-grep-run-other-window-action]\t\t->Jump other window.
2054 \\[anything-c-grep-run-persistent-action]\t\t->Run persistent action (Same as `C-z').
2055 \\[anything-c-grep-run-default-action]\t\t->Run default action (Same as RET).
2056 \\[anything-grep-help]\t\t->Show this help.
2057 \n== Anything Map ==
2058 \\{anything-map}")
2060 ;;;###autoload
2061 (defun anything-grep-help ()
2062 (interactive)
2063 (let ((anything-help-message anything-grep-help-message))
2064 (anything-help)))
2066 ;;; Pdf grep help
2069 (defvar anything-pdfgrep-help-message
2070 "== Anything PdfGrep Map ==\
2071 \nSpecific commands for Pdf Grep:
2072 \\<anything-c-pdfgrep-map>
2073 \\[anything-c-goto-next-file]\t->Next File.
2074 \\[anything-c-goto-precedent-file]\t\t->Precedent File.
2075 \\[anything-yank-text-at-point]\t\t->Yank Text at point in minibuffer.
2076 \\[anything-pdfgrep-help]\t\t->Show this help.
2077 \n== Anything Map ==
2078 \\{anything-map}")
2080 ;;;###autoload
2081 (defun anything-pdfgrep-help ()
2082 (interactive)
2083 (let ((anything-help-message anything-pdfgrep-help-message))
2084 (anything-help)))
2086 ;;; Etags help
2089 (defvar anything-etags-help-message
2090 "== Anything Etags Map ==\
2091 \nSpecific commands for Etags:
2092 \\<anything-c-etags-map>
2093 \\[anything-c-goto-next-file]\t->Next File.
2094 \\[anything-c-goto-precedent-file]\t\t->Precedent File.
2095 \\[anything-yank-text-at-point]\t\t->Yank Text at point in minibuffer.
2096 \\[anything-etags-help]\t\t->Show this help.
2097 \n== Anything Map ==
2098 \\{anything-map}")
2100 ;;;###autoload
2101 (defun anything-etags-help ()
2102 "The help function for etags."
2103 (interactive)
2104 (let ((anything-help-message anything-etags-help-message))
2105 (anything-help)))
2107 ;;; Ucs help
2110 (defvar anything-c-ucs-help-message
2111 "== Anything Ucs ==
2112 \nSpecific commands for `anything-ucs':
2113 \\<anything-c-ucs-map>
2114 \\[anything-c-ucs-persistent-insert]\t->Insert char.
2115 \\[anything-c-ucs-persistent-forward]\t->Forward char.
2116 \\[anything-c-ucs-persistent-backward]\t->Backward char.
2117 \\[anything-c-ucs-persistent-delete]\t->Delete char backward.
2118 \\[anything-c-ucs-help]\t\t->Show this help.
2120 \n== Anything Map ==
2121 \\{anything-map}")
2123 (defun anything-c-ucs-help ()
2124 "Help command for `anything-ucs'."
2125 (interactive)
2126 (let ((anything-help-message anything-c-ucs-help-message))
2127 (anything-help)))
2129 ;;; Bookmark help
2132 (defvar anything-bookmark-help-message
2133 "== Anything bookmark name Map ==\
2134 \nSpecific commands for bookmarks:
2135 \\<anything-c-bookmark-map>
2136 \\[anything-c-bookmark-run-jump-other-window]\t\t->Jump other window.
2137 \\[anything-c-bookmark-run-delete]\t\t->Delete bookmark.
2138 \\[anything-c-bmkext-run-edit]\t\t->Edit bookmark (only for bmkext).
2139 \\[anything-c-bookmark-help]\t\t->Run this help.
2140 \n== Anything Map ==
2141 \\{anything-map}")
2143 (defun anything-c-bookmark-help ()
2144 "Help command for bookmarks."
2145 (interactive)
2146 (let ((anything-help-message anything-bookmark-help-message))
2147 (anything-help)))
2149 ;;; Eshell command on file help
2152 (defvar anything-c-esh-help-message
2153 "== Anything eshell on file ==
2154 \nTips:
2156 - Passing extra args after filename:
2158 Normally your command or alias will be called with file as argument.
2160 e.g <command> 'candidate_file'
2162 But you can also pass an argument or more after 'candidate_file' like this:
2164 <command> %s [extra_args]\n
2166 'candidate_file' will be inserted at '%s' and your command will look at this:
2168 <command> 'candidate_file' [args]
2170 - Specify many files as args (marked files):
2172 e.g <command> file1 file2 ...
2174 Please restart and use a prefix arg to call `anything-find-files-eshell-command-on-file'.
2175 Otherwise your command will be called many times like this:
2177 <command> file1 <command> file2 etc...
2179 \nSpecific commands for `anything-find-files-eshell-command-on-file':
2180 \\<anything-esh-on-file-map>
2181 \\[anything-esh-help]\t\t->Display this help.
2182 \n== Anything Map ==
2183 \\{anything-map}")
2185 (defun anything-esh-help ()
2186 "Help command for `anything-find-files-eshell-command-on-file'."
2187 (interactive)
2188 (let ((anything-help-message anything-c-esh-help-message))
2189 (anything-help)))
2192 ;;; Mode line strings
2195 (defvar anything-buffer-mode-line-string
2196 '("Buffer(s)"
2197 "\\<anything-c-buffer-map>\
2198 \\[anything-c-buffer-help]:Help, \
2199 \\<anything-map>\
2200 \\[anything-select-action]:Acts,\
2201 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
2202 \\[anything-select-3rd-action]:NthAct,\
2203 \\[anything-send-bug-report-from-anything]:BugReport."
2204 "String displayed in mode-line in `anything-c-source-buffers-list'"))
2206 (defvar anything-ff-mode-line-string
2207 "\\<anything-find-files-map>\
2208 \\[anything-ff-help]:Help, \
2209 \\[anything-send-bug-report-from-anything]:BugReport, \
2210 \\<anything-map>\
2211 \\[anything-select-action]:Acts, \
2212 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
2213 \\[anything-select-3rd-action]:NthAct"
2214 "String displayed in mode-line in `anything-c-source-find-files'")
2216 (defvar anything-read-file-name-mode-line-string
2217 "\\<anything-c-read-file-map>\
2218 \\[anything-read-file-name-help]:Help, \
2219 \\<anything-map>\
2220 \\[anything-select-action]:Acts,\
2221 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
2222 \\[anything-select-3rd-action]:NthAct"
2223 "String displayed in mode-line in `anything-c-source-find-files'")
2225 (defvar anything-generic-file-mode-line-string
2226 "\\<anything-generic-files-map>\
2227 \\[anything-generic-file-help]:Help, \
2228 \\<anything-map>\
2229 \\[anything-select-action]:Acts,\
2230 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
2231 \\[anything-select-3rd-action]:NthAct,\
2232 \\[anything-send-bug-report-from-anything]:BugReport."
2233 "String displayed in mode-line in Locate.")
2235 (defvar anything-grep-mode-line-string
2236 "\\<anything-c-grep-map>\
2237 \\[anything-grep-help]:Help,\
2238 \\<anything-map>\
2239 \\[anything-select-action]:Acts,\
2240 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
2241 \\[anything-select-3rd-action]:NthAct,\
2242 \\[anything-send-bug-report-from-anything]:BugReport."
2243 "String displayed in mode-line in `anything-do-grep'.")
2245 (defvar anything-pdfgrep-mode-line-string
2246 "\\<anything-c-pdfgrep-map>\
2247 \\[anything-pdfgrep-help]:Help,\
2248 \\<anything-map>\
2249 \\[anything-select-action]:Acts,\
2250 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
2251 \\[anything-select-3rd-action]:NthAct,\
2252 \\[anything-send-bug-report-from-anything]:BugReport."
2253 "String displayed in mode-line in `anything-do-pdfgrep'.")
2255 (defvar anything-etags-mode-line-string
2256 "\\<anything-c-etags-map>\
2257 \\[anything-etags-help]:Help,\
2258 \\<anything-map>\
2259 \\[anything-select-action]:Acts,\
2260 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
2261 \\[anything-select-3rd-action]:NthAct,\
2262 \\[anything-send-bug-report-from-anything]:BugReport."
2263 "String displayed in mode-line in `anything-c-etags-select'.")
2266 (defvar anything-c-ucs-mode-line-string
2267 "\\<anything-c-ucs-map>\
2268 \\[anything-c-ucs-help]:Help, \
2269 \\<anything-map>\
2270 \\[anything-select-action]:Acts,\
2271 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
2272 \\[anything-select-3rd-action]:NthAct."
2273 "String displayed in mode-line in `anything-ucs'.")
2275 (defvar anything-bookmark-mode-line-string
2276 '("Bookmark(s)"
2277 "\\<anything-c-bookmark-map>\
2278 \\[anything-c-bookmark-help]:Help, \
2279 \\<anything-map>\
2280 \\[anything-select-action]:Acts,\
2281 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
2282 \\[anything-select-3rd-action]:NthAct,\
2283 \\[anything-send-bug-report-from-anything]:BugReport."
2284 "String displayed in mode-line in `anything-c-source-buffers-list'"))
2286 (defvar anything-occur-mode-line
2287 "\\<anything-map>\
2288 \\[anything-help]:Help,\
2289 \\<anything-occur-map>\
2290 \\[anything-occur-run-query-replace-regexp]:Query replace regexp,\
2291 \\<anything-map>\
2292 \\[anything-select-action]:Acts,\
2293 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
2294 \\[anything-select-3rd-action]:NthAct,\
2295 \\[anything-send-bug-report-from-anything]:BugReport.")
2298 ;;; Utilities Functions
2301 (defun anything-ff-find-printers ()
2302 "Return a list of available printers on Unix systems."
2303 (when (executable-find "lpstat")
2304 (let ((printer-list (with-temp-buffer
2305 (call-process "lpstat" nil t nil "-a")
2306 (split-string (buffer-string) "\n"))))
2307 (loop for p in printer-list
2308 for printer = (car (split-string p))
2309 when printer
2310 collect printer))))
2312 ;; Shut up byte compiler in emacs24*.
2313 (defun anything-c-switch-to-buffer (buffer-or-name)
2314 "Same as `switch-to-buffer' whithout warnings at compile time."
2315 (with-no-warnings
2316 (switch-to-buffer buffer-or-name)))
2318 (defun* anything-c-position (item seq &key (test 'eq) all)
2319 "A simple and faster replacement of CL `position'.
2320 Return position of first occurence of ITEM found in SEQ.
2321 Argument SEQ can be a string, in this case ITEM have to be a char.
2322 Argument ALL, if non--nil specify to return a list of positions of
2323 all ITEM found in SEQ."
2324 (let ((key (if (stringp seq) 'across 'in)))
2325 (eval
2326 `(loop for c ,key seq
2327 for index from 0
2328 when (funcall test c item)
2329 if all collect index into ls
2330 else return index
2331 finally return ls))))
2333 (defun anything-c-get-pid-from-process-name (process-name)
2334 "Get pid from running process PROCESS-NAME."
2335 (loop with process-list = (list-system-processes)
2336 for pid in process-list
2337 for process = (assoc-default 'comm (process-attributes pid))
2338 when (and process (string-match process-name process))
2339 return pid))
2341 (defun* anything-current-buffer-narrowed-p (&optional
2342 (buffer anything-current-buffer))
2343 "Check if BUFFER is narrowed.
2344 Default is `anything-current-buffer'."
2345 (with-current-buffer buffer
2346 (let ((beg (point-min))
2347 (end (point-max))
2348 (total (buffer-size)))
2349 (or (/= beg 1) (/= end (1+ total))))))
2351 (defun anything-region-active-p ()
2352 (and transient-mark-mode mark-active (/= (mark) (point))))
2354 (defun anything-goto-char (loc)
2355 "Go to char, revealing if necessary."
2356 (goto-char loc)
2357 (when (or (eq major-mode 'org-mode)
2358 (and (boundp 'outline-minor-mode)
2359 outline-minor-mode))
2360 (require 'org) ; On some old Emacs versions org may not be loaded.
2361 (org-reveal)))
2363 (defun anything-goto-line (lineno &optional noanim)
2364 "Goto LINENO opening only outline headline if needed.
2365 Animation is used unless NOANIM is non--nil."
2366 (goto-char (point-min))
2367 (anything-goto-char (point-at-bol lineno))
2368 (unless noanim
2369 (anything-match-line-color-current-line)
2370 (sit-for 0.3)
2371 (anything-match-line-cleanup)))
2373 (defun anything-show-this-source-only ()
2374 "Show all candidates of this source."
2375 (interactive)
2376 (let (anything-candidate-number-limit)
2377 (anything-set-source-filter
2378 (list (assoc-default 'name (anything-get-current-source))))))
2380 ;;;###autoload
2381 (defun anything-test-sources ()
2382 "List all anything sources for test.
2383 The output is sexps which are evaluated by \\[eval-last-sexp]."
2384 (interactive)
2385 (with-output-to-temp-buffer "*Anything Test Sources*"
2386 (mapc (lambda (s) (princ (format ";; (anything '%s)\n" s)))
2387 (apropos-internal "^anything-c-source" #'boundp))
2388 (pop-to-buffer standard-output)))
2390 (defun anything-displaying-source-names ()
2391 "Display sources name."
2392 (with-current-buffer anything-buffer
2393 (goto-char (point-min))
2394 (loop with pos
2395 while (setq pos (next-single-property-change (point) 'anything-header))
2396 do (goto-char pos)
2397 collect (buffer-substring-no-properties (point-at-bol)(point-at-eol))
2398 do (forward-line 1))))
2400 ;; [Obsolete]
2401 (defun anything-select-source ()
2402 "[OBSOLETE] Select source."
2403 (interactive)
2404 (let ((default (assoc-default 'name (anything-get-current-source)))
2405 (source-names (anything-displaying-source-names))
2406 (all-source-names (mapcar (lambda (s) (assoc-default 'name s))
2407 (anything-get-sources))))
2408 (setq anything-candidate-number-limit 9999)
2409 (anything-aif
2410 (let (anything-source-filter)
2411 (anything-nest '(((name . "Anything Source")
2412 (candidates . source-names)
2413 (action . identity))
2414 ((name . "Anything Source (ALL)")
2415 (candidates . all-source-names)
2416 (action . identity)))
2417 nil "Source: " nil
2418 default "*anything select source*"))
2419 (anything-set-source-filter (list it))
2420 (anything-set-source-filter nil))))
2422 (defun anything-insert-string (str)
2423 "Insert STR."
2424 (anything-set-pattern str 'noupdate))
2426 ;;;###autoload
2427 (defun anything-insert-buffer-name ()
2428 "Insert buffer name."
2429 (interactive)
2430 (anything-set-pattern
2431 (with-anything-current-buffer
2432 (if buffer-file-name (file-name-nondirectory buffer-file-name)
2433 (buffer-name)))))
2435 (defalias 'anything-insert-symbol 'next-history-element)
2436 (defalias 'anything-insert-selection 'anything-yank-selection)
2438 (defun anything-c-match-on-file-name (candidate)
2439 "Return non-nil if `anything-pattern' match basename of filename CANDIDATE."
2440 (string-match anything-pattern (file-name-nondirectory candidate)))
2442 (defun anything-c-match-on-directory-name (candidate)
2443 "Return non-nil if `anything-pattern' match directory part of CANDIDATE."
2444 (anything-aif (file-name-directory candidate)
2445 (string-match anything-pattern it)))
2447 (defun anything-c-match-on-basename (candidate)
2448 "Return non-nil if `anything-pattern' match basename of filename CANDIDATE."
2449 (string-match anything-pattern (anything-c-basename candidate)))
2451 (defun anything-c-string-match (candidate)
2452 "Return non-nil if `anything-pattern' match CANDIDATE.
2453 The match is done with `string-match'."
2454 (string-match anything-pattern candidate))
2456 (defun anything-c-skip-entries (list regexp)
2457 "Remove entries which matches REGEXP from LIST."
2458 (remove-if (lambda (x) (and (stringp x) (string-match regexp x)))
2459 list))
2461 (defun anything-c-shadow-entries (list regexp)
2462 "Display elements of LIST matching REGEXP with the `file-name-shadow' face."
2463 (mapcar (lambda (file)
2464 ;; Add shadow face property to boring files.
2465 (let ((face (if (facep 'file-name-shadow)
2466 'file-name-shadow
2467 ;; fall back to default on XEmacs
2468 'default)))
2469 (if (string-match regexp file)
2470 (setq file (propertize file 'face face))))
2471 file)
2472 list))
2474 (defsubst anything-c-stringify (str-or-sym)
2475 "Get string of STR-OR-SYM."
2476 (if (stringp str-or-sym)
2477 str-or-sym
2478 (symbol-name str-or-sym)))
2480 (defsubst anything-c-symbolify (str-or-sym)
2481 "Get symbol of STR-OR-SYM."
2482 (if (symbolp str-or-sym)
2483 str-or-sym
2484 (intern str-or-sym)))
2486 (defun anything-c-describe-function (func)
2487 "FUNC is symbol or string."
2488 (describe-function (anything-c-symbolify func)))
2490 (defun anything-c-describe-variable (var)
2491 "VAR is symbol or string."
2492 (describe-variable (anything-c-symbolify var)))
2494 (defun anything-c-find-function (func)
2495 "FUNC is symbol or string."
2496 (find-function (anything-c-symbolify func)))
2498 (defun anything-c-find-variable (var)
2499 "VAR is symbol or string."
2500 (find-variable (anything-c-symbolify var)))
2502 (defun anything-c-kill-new (candidate &optional replace)
2503 "CANDIDATE is symbol or string.
2504 See `kill-new' for argument REPLACE."
2505 (kill-new (anything-c-stringify candidate) replace))
2507 (defun* anything-fast-remove-dups (seq &key (test 'eq))
2508 "Remove duplicates elements in list SEQ.
2509 This is same as `remove-duplicates' but with memoisation.
2510 It is much faster, especially in large lists.
2511 A test function can be provided with TEST argument key.
2512 Default is `eq'."
2513 (loop with cont = (make-hash-table :test test)
2514 for elm in seq
2515 unless (gethash elm cont)
2516 do (puthash elm elm cont)
2517 finally return
2518 (loop for i being the hash-values in cont collect i)))
2520 (defadvice eval-defun (after anything-source-hack activate)
2521 "Allow immediate execution of anything source when evaling it.
2522 See `anything-c-enable-eval-defun-hack'."
2523 (when anything-c-enable-eval-defun-hack
2524 (let ((varsym (save-excursion
2525 (beginning-of-defun)
2526 (forward-char 1)
2527 (when (memq (read (current-buffer)) '(defvar setq))
2528 (read (current-buffer))))))
2529 (when (string-match "^anything-c-source-" (symbol-name varsym))
2530 (anything varsym)))))
2531 ;; (progn (ad-disable-advice 'eval-defun 'after 'anything-source-hack) (ad-update 'eval-defun))
2534 ;; Move this function from anything.el and redefine here
2535 ;; to avoid an unneeded defadvice.
2536 (defun anything-quit-and-find-file ()
2537 "Drop into `anything-find-files' from `anything'.
2538 If current selection is a buffer or a file, `anything-find-files'
2539 from its directory."
2540 (interactive)
2541 (anything-run-after-quit
2542 (lambda (f)
2543 (if (file-exists-p f)
2544 (anything-find-files-1 (file-name-directory f)
2545 (if anything-ff-transformer-show-only-basename
2546 (anything-c-basename f) f))
2547 (anything-find-files-1 f)))
2548 (anything-aif (get-buffer (anything-get-selection))
2549 (or (buffer-file-name it)
2550 (car (rassoc it dired-buffers))
2551 (and (with-current-buffer it
2552 (eq major-mode 'org-agenda-mode))
2553 org-directory
2554 (expand-file-name org-directory))
2555 default-directory)
2556 (let ((sel (anything-get-selection)))
2557 (cond ((or (file-remote-p sel)
2558 (file-exists-p sel))
2559 (expand-file-name sel))
2560 ((string-match ffap-url-regexp sel)
2561 sel)
2562 (t default-directory))))))
2565 (defmacro* anything-c-walk-directory (directory &key path (directories t) match)
2566 "Walk through DIRECTORY tree.
2567 PATH can be one of basename, relative, or full.
2568 DIRECTORIES when non--nil (default) return also directories names, otherwise
2569 skip directories names.
2570 MATCH match only filenames matching regexp MATCH."
2571 `(let (result
2572 (fn (case ,path
2573 (basename 'file-name-nondirectory)
2574 (relative 'file-relative-name)
2575 (full 'identity)
2576 (t 'file-name-nondirectory))))
2577 (labels ((ls-R (dir)
2578 (loop with ls = (directory-files dir t directory-files-no-dot-files-regexp)
2579 for f in ls
2580 if (file-directory-p f)
2581 do (progn (when ,directories
2582 (push (funcall fn f) result))
2583 ;; Don't recurse in directory symlink.
2584 (unless (file-symlink-p f)
2585 (ls-R f)))
2586 else do
2587 (unless (and ,match (not (string-match ,match (file-name-nondirectory f))))
2588 (push (funcall fn f) result)))))
2589 (ls-R ,directory)
2590 (nreverse result))))
2592 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Anything Applications ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2594 ;;; Anything regexp.
2597 (defvar anything-build-regexp-history nil)
2598 (defun anything-c-query-replace-regexp (candidate)
2599 "Query replace regexp from `anything-regexp'.
2600 With a prefix arg replace only matches surrounded by word boundaries,
2601 i.e Don't replace inside a word, regexp is surrounded with \\bregexp\\b."
2602 (let ((regexp (funcall (anything-attr 'regexp))))
2603 (apply 'query-replace-regexp
2604 (anything-c-query-replace-args regexp))))
2606 (defun anything-c-kill-regexp-as-sexp (candidate)
2607 "Kill regexp in a format usable in lisp code."
2608 (anything-c-regexp-kill-new
2609 (prin1-to-string (funcall (anything-attr 'regexp)))))
2611 (defun anything-c-kill-regexp (candidate)
2612 "Kill regexp as it is in `anything-pattern'."
2613 (anything-c-regexp-kill-new (funcall (anything-attr 'regexp))))
2615 (defun anything-c-query-replace-args (regexp)
2616 "create arguments of `query-replace-regexp' action in `anything-regexp'."
2617 (let ((region-only (anything-region-active-p)))
2618 (list
2619 regexp
2620 (query-replace-read-to regexp
2621 (format "Query replace %sregexp %s"
2622 (if anything-current-prefix-arg "word " "")
2623 (if region-only "in region " ""))
2625 anything-current-prefix-arg
2626 (when region-only (region-beginning))
2627 (when region-only (region-end)))))
2629 (defvar anything-c-source-regexp
2630 '((name . "Regexp Builder")
2631 (init . (lambda ()
2632 (anything-candidate-buffer anything-current-buffer)))
2633 (candidates-in-buffer)
2634 (get-line . anything-c-regexp-get-line)
2635 (persistent-action . anything-c-regexp-persistent-action)
2636 (persistent-help . "Show this line")
2637 (multiline)
2638 (delayed)
2639 (requires-pattern . 2)
2640 (mode-line . "Press TAB to select action.")
2641 (regexp . (lambda () anything-input))
2642 (action . (("Kill Regexp as sexp" . anything-c-kill-regexp-as-sexp)
2643 ("Query Replace Regexp (C-u Not inside word.)"
2644 . anything-c-query-replace-regexp)
2645 ("Kill Regexp" . anything-c-kill-regexp)))))
2647 (defun anything-c-regexp-get-line (s e)
2648 (propertize
2649 (apply 'concat
2650 ;; Line contents
2651 (format "%5d: %s" (line-number-at-pos (1- s)) (buffer-substring s e))
2652 ;; subexps
2653 (loop for i from 0 to (1- (/ (length (match-data)) 2))
2654 collect (format "\n %s'%s'"
2655 (if (zerop i) "Group 0: " (format "Group %d: " i))
2656 (match-string i))))
2657 ;; match beginning
2658 ;; KLUDGE: point of anything-candidate-buffer is +1 than that of anything-current-buffer.
2659 ;; It is implementation problem of candidates-in-buffer.
2660 'anything-realvalue
2661 (1- s)))
2663 (defun anything-c-regexp-persistent-action (pt)
2664 (anything-goto-char pt)
2665 (anything-persistent-highlight-point))
2667 (defun anything-c-regexp-kill-new (input)
2668 (kill-new input)
2669 (message "Killed: %s" input))
2671 (defun anything-quote-whitespace (candidate)
2672 "Quote whitespace, if some, in string CANDIDATE."
2673 (replace-regexp-in-string " " "\\\\ " candidate))
2676 ;;; Toggle all marks.
2679 ;;;###autoload
2680 (defun anything-mark-all ()
2681 "Mark all visible unmarked candidates in current source."
2682 (interactive)
2683 (with-anything-window
2684 (save-excursion
2685 (goto-char (anything-get-previous-header-pos))
2686 (anything-next-line)
2687 (let* ((next-head (anything-get-next-header-pos))
2688 (end (and next-head
2689 (save-excursion
2690 (goto-char next-head)
2691 (forward-line -1)
2692 (point))))
2693 (maxpoint (or end (point-max))))
2694 (while (< (point) maxpoint)
2695 (anything-mark-current-line)
2696 (let* ((prefix (get-text-property (point-at-bol) 'display))
2697 (cand (anything-get-selection))
2698 (bn (and (anything-file-completion-source-p)
2699 (anything-c-basename cand)))
2700 (src (assoc-default 'name (anything-get-current-source))))
2701 (when (and (not (anything-this-visible-mark))
2702 (not (or (string= prefix "[?]")
2703 (string= prefix "[@]"))))
2704 ;; Don't mark possibles directories ending with . or ..
2705 ;; autosave files/links and non--existent file.
2706 (unless
2707 (and (or (anything-file-completion-source-p)
2708 (equal src "Files from Current Directory"))
2709 (or (string-match "^\\.#.*\\|^#.*#$\\|\\.$" bn)
2710 ;; We need to test here when not using a transformer
2711 ;; that tag prefix (i.e on tramp)
2712 (not (file-exists-p cand))))
2713 (anything-make-visible-mark))))
2714 (forward-line 1) (end-of-line))))
2715 (anything-mark-current-line)
2716 (message "%s candidates marked" (length anything-marked-candidates))))
2718 ;;;###autoload
2719 (defun anything-unmark-all ()
2720 "Unmark all candidates in all sources of current anything session."
2721 (interactive)
2722 (with-anything-window
2723 (let ((len (length anything-marked-candidates)))
2724 (save-excursion
2725 (anything-clear-visible-mark))
2726 (setq anything-marked-candidates nil)
2727 (anything-mark-current-line)
2728 (message "%s candidates unmarked" len))))
2730 ;;;###autoload
2731 (defun anything-toggle-all-marks ()
2732 "Toggle all marks.
2733 Mark all visible candidates of current source or unmark all candidates
2734 visible or invisible in all sources of current anything session"
2735 (interactive)
2736 (let ((marked (anything-marked-candidates)))
2737 (if (and (>= (length marked) 1)
2738 (with-anything-window anything-visible-mark-overlays))
2739 (anything-unmark-all)
2740 (anything-mark-all))))
2744 ;;; Buffers
2747 (defun anything-c-buffer-list ()
2748 "Return a list of buffer names.
2749 The first buffer in the list will be the last recently used
2750 buffer that is not the current buffer unless
2751 `anything-allow-skipping-current-buffer' is nil."
2752 (let ((buffers (mapcar 'buffer-name (buffer-list))))
2753 (if anything-allow-skipping-current-buffer
2754 (progn
2755 (setq buffers (remove (buffer-name anything-current-buffer) buffers))
2756 (append (cdr buffers) (list (car buffers))))
2757 buffers)))
2759 (defvar anything-c-source-buffers
2760 '((name . "Buffers")
2761 (candidates . anything-c-buffer-list)
2762 (type . buffer)))
2764 (defvar anything-c-source-buffer-not-found
2765 `((name . "Create buffer")
2766 (dummy)
2767 (filtered-candidate-transformer (lambda (cands source)
2768 (list anything-pattern)))
2769 (keymap . ,anything-map)
2770 (action . (lambda (candidate)
2771 (anything-c-switch-to-buffer (get-buffer-create candidate))))))
2773 ;;; Buffers-list (was buffers+)
2776 (defun anything-c-highlight-buffers (buffers)
2777 "Transformer function to highlight BUFFERS list.
2778 Should be called after others transformers i.e (boring buffers)."
2779 (loop with buflist = (if anything-allow-skipping-current-buffer
2780 buffers
2781 (cons (pop (cdr buffers)) buffers))
2782 for i in buflist
2783 for buf = (get-buffer i)
2784 for bfname = (buffer-file-name buf)
2785 collect
2786 (cond (;; A dired buffer.
2787 (rassoc buf dired-buffers)
2788 (propertize i 'face 'anything-ff-directory
2789 'help-echo (car (rassoc buf dired-buffers))))
2790 ;; A buffer file modified somewhere outside of emacs.
2791 ((and bfname (not (file-remote-p bfname))
2792 (file-exists-p bfname)
2793 (not (verify-visited-file-modtime buf)))
2794 (propertize i 'face 'anything-buffer-saved-out
2795 'help-echo bfname))
2796 ;; A new buffer file not already saved on disk.
2797 ((and bfname (not (file-remote-p bfname))
2798 (not (verify-visited-file-modtime buf)))
2799 (propertize i 'face 'anything-buffer-not-saved
2800 'help-echo bfname))
2801 ;; A Remote buffer file modified and not saved on disk.
2802 ((and bfname (file-remote-p bfname) (buffer-modified-p buf))
2803 (let ((prefix (propertize
2804 " " 'display
2805 (propertize "@ " 'face 'anything-ff-prefix))))
2806 (cons (concat prefix (propertize i 'face 'anything-ff-symlink
2807 'help-echo bfname)) i)))
2808 ;; A buffer file modified and not saved on disk.
2809 ((and bfname (buffer-modified-p buf))
2810 (propertize i 'face 'anything-ff-symlink
2811 'help-echo bfname))
2812 ;; A remote buffer file not modified and saved on disk.
2813 ((and bfname (file-remote-p bfname))
2814 (let ((prefix (propertize
2815 " " 'display
2816 (propertize "@ " 'face 'anything-ff-prefix))))
2817 (cons (concat prefix (propertize i 'face 'font-lock-type-face
2818 'help-echo bfname)) i)))
2819 ;; A buffer file not modified and saved on disk.
2820 (bfname
2821 (propertize i 'face 'font-lock-type-face
2822 'help-echo bfname))
2823 ;; Any non--file buffer.
2824 (t (propertize i 'face 'italic)))))
2827 (defvar anything-c-source-buffers-list
2828 `((name . "Buffers")
2829 (candidates . anything-c-buffer-list)
2830 (type . buffer)
2831 (match anything-c-buffer-match-major-mode)
2832 (candidate-transformer anything-c-skip-boring-buffers
2833 anything-c-highlight-buffers)
2834 (persistent-action . anything-c-buffers-list-persistent-action)
2835 (keymap . ,anything-c-buffer-map)
2836 (volatile)
2837 (mode-line . anything-buffer-mode-line-string)
2838 (persistent-help . "Show this buffer / C-u \\[anything-execute-persistent-action]: Kill this buffer")))
2840 (defvaralias 'anything-c-source-buffers+ 'anything-c-source-buffers-list)
2842 (defun anything-c-buffer-match-major-mode (candidate)
2843 "Match maybe buffer by major-mode.
2844 If you give a major-mode or partial major-mode,
2845 it will list all buffers of this major-mode and/or buffers with name
2846 matching this major-mode.
2847 If you add a space after major-mode and then a space,
2848 it will match all buffers of the major-mode
2849 before space matching pattern after space.
2850 If you give a pattern which doesn't match a major-mode, it will search buffer
2851 with name matching pattern."
2852 (let* ((cand (replace-regexp-in-string "^\\s-\\{1\\}" "" candidate))
2853 (buf (get-buffer cand)))
2854 (when buf
2855 (with-current-buffer buf
2856 (let ((mjm (symbol-name major-mode))
2857 (split (split-string anything-pattern)))
2858 (cond ((string-match "\\s-$" anything-pattern)
2859 (string-match (car split) mjm))
2860 ((string-match "\\s-" anything-pattern)
2861 (and (string-match (car split) mjm)
2862 (string-match (cadr split) cand)))
2863 (t (or (string-match anything-pattern mjm)
2864 (string-match anything-pattern cand)))))))))
2866 (defun anything-c-buffer-query-replace-1 (&optional regexp-flag)
2867 "Query replace in marked buffers.
2868 If REGEXP-FLAG is given use `query-replace-regexp'."
2869 (let ((fn (if regexp-flag 'query-replace-regexp 'query-replace))
2870 (prompt (if regexp-flag "Query replace regexp" "Query replace"))
2871 (bufs (anything-marked-candidates)))
2872 (loop
2873 with replace = (query-replace-read-from prompt regexp-flag)
2874 with tostring = (unless (consp replace)
2875 (query-replace-read-to
2876 replace prompt regexp-flag))
2877 for buf in bufs
2879 (save-window-excursion
2880 (anything-c-switch-to-buffer buf)
2881 (save-excursion
2882 (let ((case-fold-search t))
2883 (goto-char (point-min))
2884 (if (consp replace)
2885 (apply fn (list (car replace) (cdr replace)))
2886 (apply fn (list replace tostring)))))))))
2888 (defun anything-c-buffer-query-replace-regexp (candidate)
2889 (anything-c-buffer-query-replace-1 'regexp))
2891 (defun anything-c-buffer-query-replace (candidate)
2892 (anything-c-buffer-query-replace-1))
2894 (defun anything-buffer-toggle-diff (candidate)
2895 "Toggle diff buffer CANDIDATE with it's file."
2896 (if (get-buffer-window "*Diff*")
2897 (kill-buffer "*Diff*")
2898 (diff-buffer-with-file (get-buffer candidate))))
2900 ;;;###autoload
2901 (defun anything-buffer-diff-persistent ()
2902 "Toggle diff buffer without quitting anything."
2903 (interactive)
2904 (anything-attrset 'diff-action 'anything-buffer-toggle-diff)
2905 (anything-execute-persistent-action 'diff-action))
2907 (defun anything-buffer-revert-and-update (candidate)
2908 (let ((marked (anything-marked-candidates)))
2909 (loop for buf in marked do (anything-revert-buffer buf))
2910 (anything-force-update candidate)))
2912 ;;;###autoload
2913 (defun anything-buffer-revert-persistent ()
2914 "Revert buffer without quitting anything."
2915 (interactive)
2916 (anything-attrset 'revert-action 'anything-buffer-revert-and-update)
2917 (anything-execute-persistent-action 'revert-action 'onewindow))
2919 (defun anything-buffer-save-and-update (candidate)
2920 (let ((marked (anything-marked-candidates))
2921 (enable-recursive-minibuffers t))
2922 (loop for buf in marked do
2923 (with-current-buffer (get-buffer buf)
2924 (save-buffer)))
2925 (anything-force-update candidate)))
2927 ;;;###autoload
2928 (defun anything-buffer-save-persistent ()
2929 "Save buffer without quitting anything."
2930 (interactive)
2931 (anything-attrset 'save-action 'anything-buffer-save-and-update)
2932 (anything-execute-persistent-action 'save-action 'onewindow))
2934 ;;;###autoload
2935 (defun anything-buffer-run-kill-buffers ()
2936 "Run kill buffer action from `anything-c-source-buffers-list'."
2937 (interactive)
2938 (anything-c-quit-and-execute-action 'anything-kill-marked-buffers))
2940 ;;;###autoload
2941 (defun anything-buffer-run-grep ()
2942 "Run Grep action from `anything-c-source-buffers-list'."
2943 (interactive)
2944 (anything-c-quit-and-execute-action 'anything-c-grep-buffers))
2946 ;;;###autoload
2947 (defun anything-buffer-run-zgrep ()
2948 "Run Grep action from `anything-c-source-buffers-list'."
2949 (interactive)
2950 (anything-c-quit-and-execute-action 'anything-c-zgrep-buffers))
2952 ;;;###autoload
2953 (defun anything-buffer-run-query-replace-regexp ()
2954 "Run Query replace regexp action from `anything-c-source-buffers-list'."
2955 (interactive)
2956 (anything-c-quit-and-execute-action 'anything-c-buffer-query-replace-regexp))
2958 ;;;###autoload
2959 (defun anything-buffer-run-query-replace ()
2960 "Run Query replace action from `anything-c-source-buffers-list'."
2961 (interactive)
2962 (anything-c-quit-and-execute-action 'anything-c-buffer-query-replace))
2964 ;;;###autoload
2965 (defun anything-buffer-switch-other-window ()
2966 "Run switch to other window action from `anything-c-source-buffers-list'."
2967 (interactive)
2968 (anything-c-quit-and-execute-action 'switch-to-buffer-other-window))
2970 ;;;###autoload
2971 (defun anything-buffer-switch-other-frame ()
2972 "Run switch to other frame action from `anything-c-source-buffers-list'."
2973 (interactive)
2974 (anything-c-quit-and-execute-action 'switch-to-buffer-other-frame))
2976 ;;;###autoload
2977 (defun anything-buffer-switch-to-elscreen ()
2978 "Run switch to elscreen action from `anything-c-source-buffers-list'."
2979 (interactive)
2980 (anything-c-quit-and-execute-action 'anything-find-buffer-on-elscreen))
2982 ;;;###autoload
2983 (defun anything-buffer-run-ediff ()
2984 "Run ediff action from `anything-c-source-buffers-list'."
2985 (interactive)
2986 (anything-c-quit-and-execute-action 'anything-ediff-marked-buffers))
2988 (defun anything-buffer-run-ediff-merge ()
2989 "Run ediff action from `anything-c-source-buffers-list'."
2990 (interactive)
2991 (anything-c-quit-and-execute-action 'anything-ediff-marked-buffers-merge))
2993 (defun anything-c-buffers-persistent-kill (buffer)
2994 "Persistent action to kill buffer."
2995 (with-current-buffer (get-buffer buffer)
2996 (if (and (buffer-modified-p)
2997 (buffer-file-name (current-buffer)))
2998 (progn
2999 (save-buffer)
3000 (kill-buffer buffer))
3001 (kill-buffer buffer)))
3002 (anything-delete-current-selection))
3004 (defun anything-c-buffers-list-persistent-action (candidate)
3005 (if current-prefix-arg
3006 (anything-c-buffers-persistent-kill candidate)
3007 (anything-c-switch-to-buffer candidate)))
3010 ;;;; <File>
3013 ;;; File name history
3014 (defvar anything-c-source-file-name-history
3015 '((name . "File Name History")
3016 (candidates . file-name-history)
3017 (match anything-c-match-on-basename)
3018 (type . file)))
3020 ;;; Files in current dir
3023 (defvar anything-c-source-files-in-current-dir
3024 '((name . "Files from Current Directory")
3025 (candidates . (lambda ()
3026 (with-anything-current-buffer
3027 (directory-files (anything-c-current-directory)))))
3028 ;; volatile is not needed, I think.
3029 (type . file)))
3031 (defun anything-c-highlight-files (files)
3032 (loop for i in files
3033 if (file-directory-p i)
3034 collect (propertize (file-name-nondirectory i)
3035 'face 'anything-ff-directory
3036 'help-echo (expand-file-name i))
3037 else
3038 collect (propertize (file-name-nondirectory i)
3039 'face 'anything-ff-file
3040 'help-echo (expand-file-name i))))
3042 (defvar anything-c-source-files-in-current-dir+
3043 `((name . "Files from Current Directory")
3044 (candidates . (lambda ()
3045 (with-anything-current-buffer
3046 (directory-files (anything-c-current-directory) t))))
3047 (keymap . ,anything-generic-files-map)
3048 (help-message . anything-generic-file-help-message)
3049 (mode-line . anything-generic-file-mode-line-string)
3050 (candidate-transformer anything-c-highlight-files)
3051 ;; volatile is not needed, I think.
3052 (type . file)))
3056 ;;; Anything-find-files - The anything files browser.
3059 ;; Internal.
3060 (defvar anything-c-find-files-doc-header " (`C-l': Go to precedent level)"
3061 "*The doc that is inserted in the Name header of a find-files or dired source.")
3062 (defvar anything-ff-auto-update-flag nil
3063 "Internal, flag to turn on/off auto-update in `anything-find-files'.
3064 Don't set it directly, use instead `anything-ff-auto-update-initial-value'.")
3065 (defvar anything-ff-last-expanded nil
3066 "Store last expanded directory or file.")
3067 (defvar anything-ff-default-directory nil)
3068 (defvar anything-ff-history nil)
3069 (defvar anything-ff-cand-to-mark nil)
3072 (defvar anything-c-source-find-files
3073 `((name . "Find Files")
3074 (header-name . (lambda (name)
3075 (concat name anything-c-find-files-doc-header)))
3076 ;; It is needed for filenames with capital letters
3077 (disable-shortcuts)
3078 (init . (lambda ()
3079 (setq anything-ff-auto-update-flag
3080 anything-ff-auto-update-initial-value)))
3081 (candidates . anything-find-files-get-candidates)
3082 (filtered-candidate-transformer anything-c-find-files-transformer)
3083 (persistent-action . anything-find-files-persistent-action)
3084 (persistent-help . "Hit1 Expand Candidate, Hit2 or (C-u) Find file")
3085 (mode-line . anything-ff-mode-line-string)
3086 (volatile)
3087 (candidate-number-limit . 9999)
3088 (action-transformer . anything-find-files-action-transformer)
3089 (action
3090 . ,(delq
3092 `(("Find File" . anything-c-find-file-or-marked)
3093 ("Find file in Dired" . anything-c-point-file-in-dired)
3094 ,(and (locate-library "elscreen")
3095 '("Find file in Elscreen" . anything-elscreen-find-file))
3096 ,(and (locate-library "popwin")
3097 '("Find file in popup window" . popwin:find-file))
3098 ("Checksum File" . anything-ff-checksum)
3099 ("Complete at point `M-tab'"
3100 . anything-c-insert-file-name-completion-at-point)
3101 ("Open file externally `C-c C-x, C-u to choose'"
3102 . anything-c-open-file-externally)
3103 ("Grep File(s) `M-g s, C-u Recurse'" . anything-find-files-grep)
3104 ("Zgrep File(s) `M-g z, C-u Recurse'" . anything-ff-zgrep)
3105 ("Switch to Eshell `M-e'" . anything-ff-switch-to-eshell)
3106 ("Etags `M-., C-u tap, C-u C-u reload tag file'" . anything-ff-etags-select)
3107 ("Eshell command on file(s) `M-!, C-u run on all marked at once.'"
3108 . anything-find-files-eshell-command-on-file)
3109 ("Find file as root" . anything-find-file-as-root)
3110 ("Find file in hex dump" . hexl-find-file)
3111 ("Ediff File `C-='" . anything-find-files-ediff-files)
3112 ("Ediff Merge File `C-c ='" . anything-find-files-ediff-merge-files)
3113 ("Delete File(s) `M-D'" . anything-delete-marked-files)
3114 ("Copy file(s) `M-C, C-u to follow'" . anything-find-files-copy)
3115 ("Copy file(s) Async" . anything-ff-copy-async)
3116 ("Rename file(s) `M-R, C-u to follow'" . anything-find-files-rename)
3117 ("Serial rename files" . anything-ff-serial-rename)
3118 ("Serial rename by symlinking files" . anything-ff-serial-rename-by-symlink)
3119 ("Serial rename by copying files" . anything-ff-serial-rename-by-copying)
3120 ("Symlink files(s) `M-S, C-u to follow'" . anything-find-files-symlink)
3121 ("Relsymlink file(s) `C-u to follow'" . anything-find-files-relsymlink)
3122 ("Hardlink file(s) `M-H, C-u to follow'" . anything-find-files-hardlink)
3123 ("Find file other window `C-o'" . find-file-other-window)
3124 ("Switch to history `M-p'" . anything-find-files-switch-to-hist)
3125 ("Find file other frame `C-c C-o'" . find-file-other-frame)
3126 ("Print File `C-c p, C-u to refresh'" . anything-ff-print)
3127 ("Locate `C-x C-f, C-u to specify locate db'" . anything-ff-locate))))))
3129 (defun anything-find-files-set-prompt-for-action (action files)
3130 "Set prompt for action ACTION for FILES."
3131 (let ((len (length files)))
3132 (format "%s *%s File(s)\n%s to: "
3133 action len
3134 (mapconcat (lambda (f)
3135 (format "- %s\n" f)) files ""))))
3137 (defun anything-dwim-target-directory ()
3138 "Return value of `default-directory' of buffer in other window.
3139 If there is only one window return the value ot `default-directory'
3140 for current buffer."
3141 (with-anything-current-buffer
3142 (let ((num-windows (length (window-list))))
3143 (if (> num-windows 1)
3144 (save-selected-window
3145 (other-window 1)
3146 default-directory)
3147 (car anything-ff-history)))))
3149 (defun anything-find-files-do-action (action)
3150 "Generic function for creating action from `anything-c-source-find-files'.
3151 ACTION must be an action supported by `anything-dired-action'."
3152 (let* ((ifiles (mapcar 'expand-file-name ; Allow modify '/foo/.' -> '/foo'
3153 (anything-marked-candidates)))
3154 (cand (anything-get-selection)) ; Target
3155 (prompt (anything-find-files-set-prompt-for-action
3156 (capitalize (symbol-name action)) ifiles))
3157 (parg anything-current-prefix-arg)
3158 (dest (anything-c-read-file-name
3159 prompt
3160 :preselect (if anything-ff-transformer-show-only-basename
3161 (anything-c-basename cand) cand)
3162 :initial-input (anything-dwim-target-directory)
3163 :history (anything-find-files-history :comp-read nil))))
3164 (anything-dired-action
3165 dest :files ifiles :action action :follow parg)))
3167 (defun anything-find-files-copy (candidate)
3168 "Copy files from `anything-find-files'."
3169 (anything-find-files-do-action 'copy))
3171 (defun anything-find-files-rename (candidate)
3172 "Rename files from `anything-find-files'."
3173 (anything-find-files-do-action 'rename))
3175 (defun anything-find-files-symlink (candidate)
3176 "Symlink files from `anything-find-files'."
3177 (anything-find-files-do-action 'symlink))
3179 (defun anything-find-files-relsymlink (candidate)
3180 "Relsymlink files from `anything-find-files'."
3181 (anything-find-files-do-action 'relsymlink))
3183 (defun anything-find-files-hardlink (candidate)
3184 "Hardlink files from `anything-find-files'."
3185 (anything-find-files-do-action 'hardlink))
3187 (defun anything-find-files-byte-compile (candidate)
3188 "Byte compile elisp files from `anything-find-files'."
3189 (let ((files (anything-marked-candidates))
3190 (parg anything-current-prefix-arg))
3191 (loop for fname in files
3192 do (byte-compile-file fname parg))))
3194 (defun anything-find-files-load-files (candidate)
3195 "Load elisp files from `anything-find-files'."
3196 (let ((files (anything-marked-candidates)))
3197 (loop for fname in files
3198 do (load fname))))
3200 (defun anything-find-files-ediff-files-1 (candidate &optional merge)
3201 "Generic function to ediff/merge files in `anything-find-files'."
3202 (let ((bname (anything-c-basename candidate))
3203 (prompt (if merge "Ediff Merge `%s' With File: "
3204 "Ediff `%s' With File: "))
3205 (fun (if merge 'ediff-merge-files 'ediff-files)))
3206 (funcall fun
3207 candidate
3208 (condition-case quit
3209 (anything-c-read-file-name
3210 (format prompt bname))
3211 (quit ;; Hit C-g ask user to fallback to locate.
3212 (if (y-or-n-p "Search file for ediff with locate? ")
3213 (anything-c-locate-read-file-name
3214 (format prompt bname)
3215 ;; Check if -b option is available.
3216 (if (and (eq system-type 'windows-nt)
3217 (string-match "^es" anything-c-locate-command))
3218 bname
3219 (concat bname " -b")))
3220 (error "Error: Ediff Operation aborted")))))))
3222 (defun anything-find-files-ediff-files (candidate)
3223 (anything-find-files-ediff-files-1 candidate))
3225 (defun anything-find-files-ediff-merge-files (candidate)
3226 (anything-find-files-ediff-files-1 candidate 'merge))
3228 (defun anything-find-files-grep (candidate)
3229 "Default action to grep files from `anything-find-files'."
3230 (anything-do-grep-1 (anything-marked-candidates)
3231 anything-current-prefix-arg))
3233 (defun anything-ff-zgrep (candidate)
3234 "Default action to zgrep files from `anything-find-files'."
3235 (let ((prefarg anything-current-prefix-arg)
3236 (ls (anything-marked-candidates)))
3237 (anything-ff-zgrep-1 ls prefarg)))
3239 (defun anything-ff-pdfgrep (candidate)
3240 "Default action to pdfgrep files from `anything-find-files'."
3241 (let ((cands (loop for file in (anything-marked-candidates)
3242 if (or (string= (file-name-extension file) "pdf")
3243 (string= (file-name-extension file) "PDF"))
3244 collect file))
3245 (anything-c-pdfgrep-default-function 'anything-c-pdfgrep-init))
3246 (when cands
3247 (anything-do-pdfgrep-1 cands))))
3249 (defun anything-ff-etags-select (candidate)
3250 "Default action to jump to etags from `anything-find-files'."
3251 (when (get-buffer anything-action-buffer)
3252 (kill-buffer anything-action-buffer))
3253 (let ((default-directory anything-ff-default-directory))
3254 (anything-c-etags-select anything-current-prefix-arg)))
3256 (defun anything-find-files-switch-to-hist (candidate)
3257 "Switch to anything-find-files history."
3258 (anything-find-files t))
3260 ;;; Asynchronous copy of files.
3263 (defun anything-c-copy-files-async-1 (flist dest)
3264 "Copy a list of Files FLIST to DEST asynchronously.
3265 It use another emacs process to do the job.
3266 Communication with background emacs is done with temp file
3267 `anything-c-copy-files-async-log-file'."
3268 (start-file-process "emacs-batch" nil anything-c-copy-async-prefered-emacs
3269 "-Q" "--batch" "--eval"
3270 (format "(progn
3271 (require 'dired) (require 'cl)
3272 (let ((dired-recursive-copies 'always)
3273 failures success
3274 (ovw-count 0)
3275 (cpf-count 0))
3276 (dolist (f '%S)
3277 (condition-case err
3278 (let ((file-exists (file-exists-p
3279 (expand-file-name
3280 (file-name-nondirectory (directory-file-name f))
3281 (file-name-directory
3282 (file-name-as-directory \"%s\"))))))
3283 (dired-copy-file f \"%s\" t)
3284 (if file-exists
3285 (progn (push (cons \"Overwriting\" f) success)
3286 (incf ovw-count))
3287 (push (cons \"Copying\" f) success)
3288 (incf cpf-count)))
3289 (file-error
3290 (push (dired-make-relative
3291 (expand-file-name
3292 (file-name-nondirectory (directory-file-name f))
3293 (file-name-directory \"%s\")))
3294 failures))))
3295 (with-current-buffer (find-file-noselect \"%s\")
3296 (erase-buffer)
3297 (when failures
3298 (dolist (fail (reverse failures))
3299 (insert (concat \"Failed to copy \" fail \"\n\"))))
3300 (when success
3301 (loop for (a . s) in (reverse success) do
3302 (insert (concat a \" \" s \" to %s done\n\"))))
3303 (and (/= cpf-count 0) (insert (concat (int-to-string cpf-count) \" File(s) Copied\n\")))
3304 (and (/= ovw-count 0) (insert (concat (int-to-string ovw-count) \" File(s) Overwrited\n\")))
3305 (and failures (insert (concat (int-to-string (length failures)) \" File(s) Failed to copy\n\")))
3306 (save-buffer))))"
3307 flist dest dest dest anything-c-copy-files-async-log-file dest)))
3309 (defun anything-c-copy-async-with-log (flist dest)
3310 "Copy file list FLIST to DEST showing log.
3311 Log is send to `anything-c-copy-files-async-log-file'.
3312 Copying is done asynchronously with `anything-c-copy-files-async-1'."
3313 (declare (special auto-revert-interval))
3314 (pop-to-buffer (find-file-noselect anything-c-copy-files-async-log-file))
3315 (set (make-local-variable 'auto-revert-interval) 1)
3316 (erase-buffer)
3317 (insert "Wait copying files...\n")
3318 (sit-for 0.5) (save-buffer)
3319 (goto-char (point-max))
3320 (auto-revert-mode 1)
3321 (anything-c-copy-files-async-1 flist dest))
3323 (defun anything-ff-copy-async (candidate)
3324 "Anything find files action to copy files async.
3325 Copying is done asynchronously with `anything-c-copy-files-async-1'."
3326 (let* ((flist (anything-marked-candidates))
3327 (dest (anything-c-read-file-name
3328 (anything-find-files-set-prompt-for-action
3329 "Copy Async" flist)
3330 :preselect candidate
3331 :initial-input (car anything-ff-history)
3332 :history (anything-find-files-history :comp-read nil))))
3333 (anything-c-copy-async-with-log flist dest)))
3335 (defvar eshell-command-aliases-list nil)
3336 (defvar anything-eshell-command-on-file-input-history nil)
3337 (defun anything-find-files-eshell-command-on-file-1 (candidate &optional map)
3338 "Run `eshell-command' on CANDIDATE or marked candidates.
3339 This is done possibly with an eshell alias, if no alias found, you can type in
3340 an eshell command.
3342 Basename of CANDIDATE can be a wild-card.
3343 e.g you can do \"eshell-command command *.el\"
3344 Where \"*.el\" is the CANDIDATE.
3346 It is possible to do eshell-command command <CANDIDATE> <some more args>
3347 like this: \"command %s some more args\".
3349 If MAP is given run `eshell-command' on all marked files at once,
3350 Otherwise, run `eshell-command' on each marked files.
3351 In other terms, with a prefix arg do on the three marked files
3352 \"foo\" \"bar\" \"baz\":
3354 \"eshell-command command foo bar baz\"
3356 otherwise do
3358 \"eshell-command command foo\"
3359 \"eshell-command command bar\"
3360 \"eshell-command command baz\"
3362 Note:
3363 If `eshell' or `eshell-command' have not been run once,
3364 or if you have no eshell aliases `eshell-command-aliases-list'
3365 will not be loaded first time you use this."
3366 (when (or eshell-command-aliases-list
3367 (y-or-n-p "Eshell is not loaded, run eshell-command without alias anyway? "))
3368 (and eshell-command-aliases-list (eshell-read-aliases-list))
3369 (let* ((cand-list (anything-marked-candidates))
3370 (default-directory (or anything-ff-default-directory
3371 ;; If candidate is an url *-ff-default-directory is nil
3372 ;; so keep value of default-directory.
3373 default-directory))
3374 (command (anything-comp-read
3375 "Command: "
3376 (loop for (a . c) in eshell-command-aliases-list
3377 when (string-match "\\(\\$1\\|\\$\\*\\)$" (car c))
3378 collect (propertize a 'help-echo (car c)) into ls
3379 finally return (sort ls 'string<))
3380 :buffer "*esh command on file*"
3381 :name "Eshell command"
3382 :keymap anything-esh-on-file-map
3383 :mode-line
3384 '("Eshell alias"
3385 "C-c ?: Help, \\[universal-argument]: Insert output at point")
3386 :input-history
3387 'anything-eshell-command-on-file-input-history))
3388 (alias-value (car (assoc-default command eshell-command-aliases-list))))
3389 (when (and (= (length cand-list) 1)
3390 (string-match "[*]" (anything-c-basename (car cand-list))))
3391 (setq cand-list (file-expand-wildcards (car cand-list) t)))
3392 ;; Be sure output don't go in current buffer
3393 ;; but allow sending output to current buffer
3394 ;; if a prefix arg have been passed during the
3395 ;; `anything-comp-read' call.
3396 (setq current-prefix-arg anything-current-prefix-arg)
3397 ;; MAP have been set before calling `anything-comp-read'
3398 ;; by `anything-current-prefix-arg'.
3399 (if (and (or map ; prefix-arg
3400 (and alias-value
3401 ;; If command is an alias be sure it accept
3402 ;; more than one arg i.e $*.
3403 (string-match "\\$\\*$" alias-value)))
3404 (> (length cand-list) 1))
3406 ;; Run eshell-command with ALL marked files as arguments.
3407 (let ((mapfiles (mapconcat 'shell-quote-argument cand-list " ")))
3408 (if (string-match "'%s'\\|\"%s\"\\|%s" command)
3409 (eshell-command (format command mapfiles)) ; See [1]
3410 (eshell-command (format "%s %s" command mapfiles))))
3412 ;; Run eshell-command on EACH marked files.
3413 (loop for i in cand-list
3414 for bn = (anything-c-basename i)
3415 for files = (format "'%s'" i)
3416 for com = (if (string-match "'%s'\\|\"%s\"\\|%s" command)
3417 ;; [1] This allow to enter other args AFTER filename
3418 ;; i.e <command %s some_more_args>
3419 (format command files)
3420 (format "%s %s" command files))
3421 do (eshell-command com))))))
3423 (defun anything-find-files-eshell-command-on-file (candidate)
3424 "Run `eshell-command' on CANDIDATE or marked candidates.
3425 See `anything-find-files-eshell-command-on-file-1' for more info."
3426 (anything-find-files-eshell-command-on-file-1
3427 candidate anything-current-prefix-arg))
3429 (defun anything-ff-switch-to-eshell (candidate)
3430 "Switch to eshell and cd to `anything-ff-default-directory'."
3431 (flet ((cd-eshell ()
3432 (goto-char (point-max))
3433 (insert
3434 (format "cd '%s'" anything-ff-default-directory))
3435 (eshell-send-input)))
3436 (if (get-buffer "*eshell*")
3437 (progn
3438 (anything-c-switch-to-buffer "*eshell*")
3439 (cd-eshell))
3440 (call-interactively 'eshell)
3441 (cd-eshell))))
3443 (defun anything-ff-serial-rename-action (method)
3444 "Rename all marked files to `anything-ff-default-directory' with METHOD.
3445 See `anything-ff-serial-rename-1'."
3446 (let* ((cands (anything-marked-candidates))
3447 (def-name (car cands))
3448 (name (read-string "NewName: "
3449 (replace-regexp-in-string
3450 "[0-9]+$" ""
3451 (anything-c-basename
3452 def-name
3453 (file-name-extension def-name)))))
3454 (start (read-number "StartAtNumber: "))
3455 (extension (read-string "Extension: "
3456 (file-name-extension (car cands))))
3457 (dir (expand-file-name
3458 (anything-c-read-file-name
3459 "Serial Rename to directory: "
3460 :initial-input
3461 (expand-file-name anything-ff-default-directory)
3462 :test 'file-directory-p
3463 :must-match t)))
3464 (res (loop for f in cands
3465 for bn = (anything-c-basename f)
3466 for count from start
3467 concat (format "%s <-> %s%s.%s\n"
3468 bn name count extension))))
3469 (if (y-or-n-p
3470 (format "Result:\n %sRename like this to <%s> ? " res dir))
3471 (progn
3472 (anything-ff-serial-rename-1
3473 dir cands name start extension :method method)
3474 (message nil)
3475 (anything-find-files-1 dir))
3476 (message "Operation aborted"))))
3478 (defun anything-ff-member-directory-p (file directory)
3479 (let ((dir-file (expand-file-name
3480 (file-name-as-directory (file-name-directory file))))
3481 (cur-dir (expand-file-name (file-name-as-directory directory))))
3482 (string= dir-file cur-dir)))
3484 (defun* anything-ff-serial-rename-1
3485 (directory collection new-name start-at-num extension &key (method 'rename))
3486 "rename files in COLLECTION to DIRECTORY with the prefix name NEW-NAME.
3487 Rename start at number START-AT-NUM - ex: prefixname-01.jpg.
3488 EXTENSION is the file extension to use, in empty prompt,
3489 reuse the original extension of file.
3490 METHOD can be one of rename, copy or symlink.
3491 Files will be renamed if they are files of current directory, otherwise they
3492 will be treated with METHOD.
3493 Default METHOD is rename."
3494 ;; Maybe remove directories selected by error in collection.
3495 (setq collection (remove-if 'file-directory-p collection))
3496 (flet ((symlink-file (file dest)
3497 (let ((flist (list file)))
3498 (anything-dired-action
3499 dest :action 'symlink :files flist))))
3501 (let* ((tmp-dir (file-name-as-directory
3502 (concat (file-name-as-directory directory)
3503 (symbol-name (gensym "tmp")))))
3504 (fn (case method
3505 (copy 'copy-file)
3506 (symlink 'symlink-file)
3507 (rename 'rename-file)
3508 (t (error "Error: Unknow method %s" method)))))
3509 (make-directory tmp-dir)
3510 (unwind-protect
3511 (progn
3512 ;; Rename all files to tmp-dir with new-name.
3513 ;; If files are not from start directory, use method
3514 ;; to move files to tmp-dir.
3515 (loop for i in collection
3516 for count from start-at-num
3517 for fnum = (if (< count 10) "0%s" "%s")
3518 for nname = (concat tmp-dir new-name (format fnum count)
3519 (if (not (string= extension ""))
3520 (format ".%s" (replace-regexp-in-string
3521 "[.]" "" extension))
3522 (file-name-extension i 'dot)))
3523 do (if (anything-ff-member-directory-p i directory)
3524 (rename-file i nname)
3525 (funcall fn i nname)))
3526 ;; Now move all from tmp-dir to destination.
3527 (loop with dirlist = (directory-files
3528 tmp-dir t directory-files-no-dot-files-regexp)
3529 for f in dirlist do
3530 (if (file-symlink-p f)
3531 (symlink-file (file-truename f)
3532 (concat (file-name-as-directory directory)
3533 (anything-c-basename f)))
3534 (rename-file f directory))))
3535 (delete-directory tmp-dir t)))))
3537 (defun anything-ff-serial-rename (candidate)
3538 "Serial rename all marked files to `anything-ff-default-directory'.
3539 Rename only file of current directory, and symlink files coming from
3540 other directories.
3541 See `anything-ff-serial-rename-1'."
3542 (anything-ff-serial-rename-action 'rename))
3544 (defun anything-ff-serial-rename-by-symlink (candidate)
3545 "Serial rename all marked files to `anything-ff-default-directory'.
3546 Rename only file of current directory, and symlink files coming from
3547 other directories.
3548 See `anything-ff-serial-rename-1'."
3549 (anything-ff-serial-rename-action 'symlink))
3551 (defun anything-ff-serial-rename-by-copying (candidate)
3552 "Serial rename all marked files to `anything-ff-default-directory'.
3553 Rename only file of current directory, and copy files coming from
3554 other directories.
3555 See `anything-ff-serial-rename-1'."
3556 (anything-ff-serial-rename-action 'copy))
3558 (defun anything-c-quit-and-execute-action (action)
3559 "Quit current anything session and execute ACTION."
3560 (setq anything-saved-action action)
3561 (anything-exit-minibuffer))
3563 (defun anything-ff-toggle-auto-update (candidate)
3564 (setq anything-ff-auto-update-flag (not anything-ff-auto-update-flag))
3565 (message "[Auto expansion %s]"
3566 (if anything-ff-auto-update-flag "enabled" "disabled")))
3568 ;;;###autoload
3569 (defun anything-ff-run-toggle-auto-update ()
3570 (interactive)
3571 (anything-attrset 'toggle-auto-update 'anything-ff-toggle-auto-update)
3572 (anything-execute-persistent-action 'toggle-auto-update))
3574 ;;;###autoload
3575 (defun anything-ff-run-switch-to-history ()
3576 "Run Switch to history action from `anything-c-source-find-files'."
3577 (interactive)
3578 (anything-c-quit-and-execute-action 'anything-find-files-switch-to-hist))
3580 ;;;###autoload
3581 (defun anything-ff-run-grep ()
3582 "Run Grep action from `anything-c-source-find-files'."
3583 (interactive)
3584 (anything-c-quit-and-execute-action 'anything-find-files-grep))
3586 ;;;###autoload
3587 (defun anything-ff-run-pdfgrep ()
3588 "Run Pdfgrep action from `anything-c-source-find-files'."
3589 (interactive)
3590 (anything-c-quit-and-execute-action 'anything-ff-pdfgrep))
3592 ;;;###autoload
3593 (defun anything-ff-run-zgrep ()
3594 "Run Grep action from `anything-c-source-find-files'."
3595 (interactive)
3596 (anything-c-quit-and-execute-action 'anything-ff-zgrep))
3598 ;;;###autoload
3599 (defun anything-ff-run-copy-file ()
3600 "Run Copy file action from `anything-c-source-find-files'."
3601 (interactive)
3602 (anything-c-quit-and-execute-action 'anything-find-files-copy))
3604 ;;;###autoload
3605 (defun anything-ff-run-rename-file ()
3606 "Run Rename file action from `anything-c-source-find-files'."
3607 (interactive)
3608 (anything-c-quit-and-execute-action 'anything-find-files-rename))
3610 ;;;###autoload
3611 (defun anything-ff-run-byte-compile-file ()
3612 "Run Byte compile file action from `anything-c-source-find-files'."
3613 (interactive)
3614 (anything-c-quit-and-execute-action 'anything-find-files-byte-compile))
3616 ;;;###autoload
3617 (defun anything-ff-run-load-file ()
3618 "Run Load file action from `anything-c-source-find-files'."
3619 (interactive)
3620 (anything-c-quit-and-execute-action 'anything-find-files-load-files))
3622 ;;;###autoload
3623 (defun anything-ff-run-eshell-command-on-file ()
3624 "Run eshell command on file action from `anything-c-source-find-files'."
3625 (interactive)
3626 (anything-c-quit-and-execute-action 'anything-find-files-eshell-command-on-file))
3628 ;;;###autoload
3629 (defun anything-ff-run-ediff-file ()
3630 "Run Ediff file action from `anything-c-source-find-files'."
3631 (interactive)
3632 (anything-c-quit-and-execute-action 'anything-find-files-ediff-files))
3634 ;;;###autoload
3635 (defun anything-ff-run-ediff-merge-file ()
3636 "Run Ediff merge file action from `anything-c-source-find-files'."
3637 (interactive)
3638 (anything-c-quit-and-execute-action 'anything-find-files-ediff-merge-files))
3640 ;;;###autoload
3641 (defun anything-ff-run-symlink-file ()
3642 "Run Symlink file action from `anything-c-source-find-files'."
3643 (interactive)
3644 (anything-c-quit-and-execute-action 'anything-find-files-symlink))
3646 ;;;###autoload
3647 (defun anything-ff-run-hardlink-file ()
3648 "Run Hardlink file action from `anything-c-source-find-files'."
3649 (interactive)
3650 (anything-c-quit-and-execute-action 'anything-find-files-hardlink))
3652 ;;;###autoload
3653 (defun anything-ff-run-delete-file ()
3654 "Run Delete file action from `anything-c-source-find-files'."
3655 (interactive)
3656 (anything-c-quit-and-execute-action 'anything-delete-marked-files))
3658 ;;;###autoload
3659 (defun anything-ff-run-complete-fn-at-point ()
3660 "Run complete file name action from `anything-c-source-find-files'."
3661 (interactive)
3662 (anything-c-quit-and-execute-action
3663 'anything-c-insert-file-name-completion-at-point))
3665 ;;;###autoload
3666 (defun anything-ff-run-switch-to-eshell ()
3667 "Run switch to eshell action from `anything-c-source-find-files'."
3668 (interactive)
3669 (anything-c-quit-and-execute-action 'anything-ff-switch-to-eshell))
3671 ;;;###autoload
3672 (defun anything-ff-run-switch-other-window ()
3673 "Run switch to other window action from `anything-c-source-find-files'."
3674 (interactive)
3675 (anything-c-quit-and-execute-action 'find-file-other-window))
3677 ;;;###autoload
3678 (defun anything-ff-run-switch-other-frame ()
3679 "Run switch to other frame action from `anything-c-source-find-files'."
3680 (interactive)
3681 (anything-c-quit-and-execute-action 'find-file-other-frame))
3683 ;;;###autoload
3684 (defun anything-ff-run-open-file-externally ()
3685 "Run open file externally command action from `anything-c-source-find-files'."
3686 (interactive)
3687 (anything-c-quit-and-execute-action 'anything-c-open-file-externally))
3689 (defun anything-ff-locate (candidate)
3690 "Locate action function for `anything-find-files'."
3691 (let ((input (concat (anything-c-basename
3692 (expand-file-name
3693 candidate
3694 anything-ff-default-directory))
3695 ;; The locate '-b' option doesn't exists
3696 ;; in everything.
3697 (unless (and (eq system-type 'windows-nt)
3698 (string-match "^es" anything-c-locate-command))
3699 " -b")))
3700 (anything-mp-highlight-delay 0.7))
3701 (anything-locate-1 anything-current-prefix-arg input)))
3703 ;;;###autoload
3704 (defun anything-ff-run-locate ()
3705 "Run locate action from `anything-c-source-find-files'."
3706 (interactive)
3707 (anything-c-quit-and-execute-action 'anything-ff-locate))
3709 ;;;###autoload
3710 (defun anything-ff-run-gnus-attach-files ()
3711 "Run gnus attach files command action from `anything-c-source-find-files'."
3712 (interactive)
3713 (anything-c-quit-and-execute-action 'anything-ff-gnus-attach-files))
3715 ;;;###autoload
3716 (defun anything-ff-run-etags ()
3717 "Run Etags command action from `anything-c-source-find-files'."
3718 (interactive)
3719 (anything-c-quit-and-execute-action 'anything-ff-etags-select))
3721 (defun anything-ff-print (candidate)
3722 "Print marked files.
3723 You have to set in order
3724 variables `lpr-command',`lpr-switches' and/or `printer-name'.
3726 e.g:
3727 \(setq lpr-command \"gtklp\"\)
3728 \(setq lpr-switches '(\"-P\")\)
3729 \(setq printer-name \"Epson-Stylus-Photo-R265\"\)
3731 Same as `dired-do-print' but for anything."
3732 (when (or anything-current-prefix-arg
3733 (not anything-ff-printer-list))
3734 (setq anything-ff-printer-list
3735 (anything-ff-find-printers)))
3736 (let* ((file-list (anything-marked-candidates))
3737 (len (length file-list))
3738 (printer-name (if anything-ff-printer-list
3739 (anything-comp-read
3740 "Printer: " anything-ff-printer-list)
3741 printer-name))
3742 (command (read-string
3743 (format "Print *%s File(s):\n%s with: "
3745 (mapconcat
3746 (lambda (f) (format "- %s\n" f))
3747 file-list ""))
3748 (when (and lpr-command
3749 (or lpr-switches
3750 printer-name))
3751 (mapconcat 'identity
3752 (cons lpr-command
3753 (append (if (stringp lpr-switches)
3754 (list lpr-switches)
3755 lpr-switches)
3756 (list printer-name)))
3757 " "))))
3758 (file-args (mapconcat #'(lambda (x)
3759 (format "'%s'" x))
3760 file-list " "))
3761 (cmd-line (concat command " " file-args)))
3762 (if command
3763 (start-process-shell-command "anything-print" nil cmd-line)
3764 (error "Error: Please verify your printer settings in Emacs."))))
3766 ;;;###autoload
3767 (defun anything-ff-run-print-file ()
3768 "Run Print file action from `anything-c-source-find-files'."
3769 (interactive)
3770 (anything-c-quit-and-execute-action 'anything-ff-print))
3772 (defun anything-ff-checksum (file)
3773 "Calculate the checksum of FILE.
3774 Provide completion on different algorithms to use on Emacs24.
3775 On Emacs23 only 'sha1' is available.
3776 The checksum is copied to kill-ring."
3777 (let ((algo-list (and (fboundp 'secure-hash)
3778 '(md5 sha1 sha224 sha256 sha384 sha512))))
3779 (kill-new
3780 (if algo-list
3781 (secure-hash (intern
3782 (anything-comp-read
3783 "Algorithm: " algo-list))
3784 file)
3785 (sha1 (with-temp-buffer
3786 (insert-file-contents file)
3787 (buffer-string)))))
3788 (message "Checksum copied to kill-ring.")))
3790 (defun anything-ff-toggle-basename (candidate)
3791 (setq anything-ff-transformer-show-only-basename
3792 (not anything-ff-transformer-show-only-basename))
3793 (let ((target (if anything-ff-transformer-show-only-basename
3794 (anything-c-basename candidate) candidate)))
3795 (anything-force-update target)))
3797 (defun anything-ff-run-toggle-basename ()
3798 (interactive)
3799 (anything-attrset 'toggle-basename 'anything-ff-toggle-basename)
3800 (anything-execute-persistent-action 'toggle-basename))
3802 (defun* anything-reduce-file-name (fname level &key unix-close expand)
3803 "Reduce FNAME by LEVEL from end or beginning depending LEVEL value.
3804 If LEVEL is positive reduce from end else from beginning.
3805 If UNIX-CLOSE is non--nil close filename with /.
3806 If EXPAND is non--nil expand-file-name."
3807 (let* ((exp-fname (expand-file-name fname))
3808 (fname-list (split-string (if (or (string= fname "~/") expand)
3809 exp-fname fname) "/" t))
3810 (len (length fname-list))
3811 (pop-list (if (< level 0)
3812 (subseq fname-list (* level -1))
3813 (subseq fname-list 0 (- len level))))
3814 (result (mapconcat 'identity pop-list "/"))
3815 (empty (string= result "")))
3816 (when unix-close (setq result (concat result "/")))
3817 (if (string-match "^~" result)
3818 (if (string= result "~/") "~/" result)
3819 (if (< level 0)
3820 (if empty "../" (concat "../" result))
3821 (cond ((eq system-type 'windows-nt)
3822 (if empty (expand-file-name "/") ; Expand to "/" or "c:/".
3823 result))
3824 (empty "/")
3826 (concat "/" result)))))))
3828 ;; Internal
3829 (defvar anything-file-completion-sources
3830 '("Find Files" "Read File Name"
3831 "Read File Name History" "Copy Files"
3832 "Rename Files" "Symlink Files"
3833 "Hardlink Files" "Write File" "Insert File")
3834 "Sources that use the *find-files mechanism can be added here.
3835 Sources generated by `ac-mode' don't need to be added here, it will
3836 be done automatically.
3837 You should not modify this yourself unless you know what you do.")
3839 (defun anything-file-completion-source-p ()
3840 "Test if current source is a dired or find-files source."
3841 (let ((cur-source (cdr (assoc 'name (anything-get-current-source)))))
3842 (loop for i in anything-file-completion-sources
3843 thereis (string= cur-source i))))
3845 (defun anything-find-files-down-one-level (arg)
3846 "Go down one level like unix command `cd ..'.
3847 If prefix numeric arg is given go ARG level down."
3848 (interactive "p")
3849 (when (and (anything-file-completion-source-p)
3850 (not (anything-ff-invalid-tramp-name-p)))
3851 (with-anything-window
3852 (setq anything-follow-mode nil))
3853 ;; When going to precedent level we want to be at the line
3854 ;; corresponding to actual directory, so store this info
3855 ;; in `anything-ff-last-expanded'.
3856 (if (and (not (file-directory-p anything-pattern))
3857 (file-exists-p anything-pattern))
3858 (setq anything-ff-last-expanded anything-pattern)
3859 (setq anything-ff-last-expanded anything-ff-default-directory))
3860 (let ((new-pattern (anything-reduce-file-name anything-pattern arg
3861 :unix-close t :expand t)))
3862 (anything-set-pattern new-pattern))))
3864 (defun anything-ff-retrieve-last-expanded ()
3865 "Move overlay to last visited directory `anything-ff-last-expanded'.
3866 This happen after using `anything-find-files-down-one-level',
3867 or hitting C-z on \"..\"."
3868 (when (and anything-ff-last-expanded
3869 (anything-file-completion-source-p))
3870 (let ((presel (if anything-ff-transformer-show-only-basename
3871 (anything-c-basename
3872 (directory-file-name anything-ff-last-expanded))
3873 (directory-file-name anything-ff-last-expanded))))
3874 (with-anything-window
3875 (when (re-search-forward
3876 (concat "^" (regexp-quote presel) "$") nil t)
3877 (forward-line 0)
3878 (anything-mark-current-line)))
3879 (setq anything-ff-last-expanded nil))))
3880 (add-hook 'anything-after-update-hook 'anything-ff-retrieve-last-expanded)
3882 ;; Auto-update - anything-find-files auto expansion of directories.
3884 (defun anything-ff-update-when-only-one-matched ()
3885 "Expand to directory when sole completion.
3886 When only one candidate is remaining and it is a directory,
3887 expand to this directory."
3888 (when (and anything-ff-auto-update-flag
3889 (anything-file-completion-source-p)
3890 (not (anything-ff-invalid-tramp-name-p)))
3891 (let* ((history-p (string= (assoc-default
3892 'name (anything-get-current-source))
3893 "Read File Name History"))
3894 (pat (if (string-match tramp-file-name-regexp
3895 anything-pattern)
3896 (anything-create-tramp-name anything-pattern)
3897 anything-pattern))
3898 (completed-p (string= (file-name-as-directory pat)
3899 anything-ff-default-directory)))
3900 (when (and (or
3901 ;; Only one candidate remaining
3902 ;; and at least 2 char in basename.
3903 (and (<= (anything-approximate-candidate-number) 2)
3904 (>= (length (anything-c-basename anything-pattern)) 2))
3905 ;; Already completed.
3906 completed-p)
3907 (not history-p)) ; Don't try to auto complete in history.
3908 (with-anything-window
3909 (let ((cur-cand (prog2
3910 (unless completed-p
3911 ;; Only one non--existing candidate
3912 ;; and one directory candidate, move to it.
3913 (anything-next-line))
3914 (anything-get-selection))))
3915 (when (and (stringp cur-cand) (file-directory-p cur-cand))
3916 (if (and (not (string-match "^.*[.]\\{1,2\\}$" cur-cand)) ; [1]
3917 ;; Maybe we are here because completed-p is true
3918 ;; but check this again to be sure. (Windows fix)
3919 (<= (anything-approximate-candidate-number) 2)) ; [2]
3920 ;; If after going to next line the candidate
3921 ;; is not one of "." or ".." [1]
3922 ;; and only one candidate is remaining [2],
3923 ;; assume candidate is a new directory to expand, and do it.
3924 (anything-set-pattern (file-name-as-directory cur-cand))
3925 ;; The candidate is one of "." or ".."
3926 ;; that mean we have entered the last letter of the directory name
3927 ;; in prompt, so expansion is already done, just add the "/" at end
3928 ;; of name unless anything-pattern ends with "."
3929 ;; (i.e we are writing something starting with ".")
3930 (unless (string-match "^.*[.]\\{1\\}$" anything-pattern)
3931 (anything-set-pattern
3932 ;; Need to expand-file-name to avoid e.g /ssh:host:./ in prompt.
3933 (expand-file-name (file-name-as-directory anything-pattern)))))
3934 (anything-check-minibuffer-input-1))))))))
3935 (add-hook 'anything-after-update-hook 'anything-ff-update-when-only-one-matched)
3937 ;; Allow expanding to home directory or root
3938 ;; when entering respectively "~/" or "//" at end of pattern.
3939 ;; e.g /home/thierry/labo/anything-config-qp/~/
3940 ;; will expand to "~/"
3941 ;; and /home/thierry/labo/anything-config-qp//
3942 ;; will expand to "/"
3943 (defun anything-ff-auto-expand-to-home-or-root ()
3944 "Goto home, root or default directory when pattern ends with ~/, /, or ./.
3945 This happen only in function using sources that are
3946 `anything-file-completion-source-p' compliant."
3947 (when (and (anything-file-completion-source-p)
3948 (string-match ".*\\(/~/\\|/\\{2\\}\\|/[.]\\{1\\}/\\)$"
3949 anything-pattern))
3950 (let ((match (match-string 1 anything-pattern)))
3951 (cond ((string= match "//")
3952 ;; Expand to "/" or "c:/"
3953 (setq anything-pattern (expand-file-name "/")))
3954 ((string= match "/~/")
3955 (if (eq system-type 'windows-nt)
3956 (setq anything-pattern (file-name-as-directory (getenv "HOME")))
3957 (setq anything-pattern "~/")))
3958 ((string= match "/./")
3959 (setq anything-pattern
3960 (with-anything-current-buffer
3961 (expand-file-name default-directory))))))
3962 (setq anything-ff-default-directory anything-pattern)
3963 ;; For some reasons, i must use here with-current-buffer => mini buffer
3964 ;; and not `anything-set-pattern' that use with-selected-window => mini win.
3965 (with-current-buffer (window-buffer (minibuffer-window))
3966 (delete-minibuffer-contents)
3967 (insert anything-pattern))))
3969 (add-hook 'anything-after-update-hook 'anything-ff-auto-expand-to-home-or-root)
3971 (defun anything-c-point-file-in-dired (file)
3972 "Put point on filename FILE in dired buffer."
3973 (dired (file-name-directory file))
3974 (dired-goto-file file))
3976 (defun anything-create-tramp-name (fname)
3977 "Build filename for `anything-pattern' like /su:: or /sudo::."
3978 (apply #'tramp-make-tramp-file-name
3979 (loop with v = (tramp-dissect-file-name fname)
3980 for i across v collect i)))
3982 (defun* anything-ff-tramp-hostnames (&optional (pattern anything-pattern))
3983 "Get a list of hosts for tramp method found in `anything-pattern'.
3984 Argument PATTERN default to `anything-pattern', it is here only for debugging
3985 purpose."
3986 (when (string-match tramp-file-name-regexp pattern)
3987 (let ((method (match-string 1 pattern))
3988 (tn (match-string 0 pattern))
3989 (all-methods (mapcar 'car tramp-methods)))
3990 (anything-fast-remove-dups
3991 (loop for (f . h) in (tramp-get-completion-function method)
3992 append (loop for e in (funcall f (car h))
3993 for host = (and (consp e) (cadr e))
3994 when (and host (not (member host all-methods)))
3995 collect (concat tn host)))
3996 :test 'equal))))
3998 (defun anything-ff-before-action-hook-fn ()
3999 "Exit anything when user try to execute action on an invalid tramp fname."
4000 (let ((cand (anything-get-selection)))
4001 (when (and (anything-file-completion-source-p)
4002 (anything-ff-invalid-tramp-name-p cand) ; Check candidate.
4003 (anything-ff-invalid-tramp-name-p)) ; check anything-pattern.
4004 (error "Error: Unknow file or directory `%s'" cand))))
4005 (add-hook 'anything-before-action-hook 'anything-ff-before-action-hook-fn)
4007 (defun* anything-ff-invalid-tramp-name-p (&optional (pattern anything-pattern))
4008 "Return non--nil when PATTERN is an invalid tramp filename."
4009 (string= (anything-ff-set-pattern pattern)
4010 "Invalid tramp file name"))
4012 (defun anything-ff-set-pattern (pattern)
4013 "Handle tramp filenames in `anything-pattern'."
4014 (let ((methods (mapcar 'car tramp-methods))
4015 (reg "\\`/\\([^[/:]+\\|[^/]+]\\):.*:")
4016 cur-method tramp-name)
4017 (cond ((string= pattern "") "")
4018 ((string-match ".*\\(~?/?[.]\\{1\\}/\\)$" pattern)
4019 (with-anything-current-buffer
4020 (expand-file-name default-directory)))
4021 ((string-match ".*\\(~//\\|//\\)$" pattern)
4022 (expand-file-name "/") ; Expand to "/" or "c:/"
4024 ((string-match "^~\\|.*/~/$" pattern)
4025 (let* ((home (expand-file-name (getenv "HOME"))))
4026 (replace-match home nil t pattern)))
4027 ;; Match "/method:maybe_hostname:"
4028 ((and (string-match reg pattern)
4029 (setq cur-method (match-string 1 pattern))
4030 (member cur-method methods))
4031 (setq tramp-name (anything-create-tramp-name
4032 (match-string 0 pattern)))
4033 (replace-match tramp-name nil t pattern))
4034 ;; Match "/hostname:"
4035 ((and (string-match tramp-file-name-regexp pattern)
4036 (setq cur-method (match-string 1 pattern))
4037 (and cur-method (not (member cur-method methods))))
4038 (setq tramp-name (anything-create-tramp-name
4039 (match-string 0 pattern)))
4040 (replace-match tramp-name nil t pattern))
4041 ;; Match "/method:" in this case don't try to connect.
4042 ((and (not (string-match reg pattern))
4043 (string-match tramp-file-name-regexp pattern)
4044 (member (match-string 1 pattern) methods))
4045 "Invalid tramp file name") ; Write in anything-buffer.
4046 ;; PATTERN is a directory, end it with "/".
4047 ;; This will make PATTERN not ending yet with "/"
4048 ;; candidate for `anything-ff-default-directory',
4049 ;; allowing `anything-ff-retrieve-last-expanded' to retrieve it
4050 ;; when descending level.
4051 ((file-directory-p pattern)
4052 (file-name-as-directory pattern))
4053 ;; Return PATTERN unchanged.
4054 (t pattern))))
4056 (defun anything-find-files-get-candidates (&optional require-match)
4057 "Create candidate list for `anything-c-source-find-files'."
4058 (let* ((path (anything-ff-set-pattern anything-pattern))
4059 (path-name-dir (if (file-directory-p path)
4060 (file-name-as-directory path)
4061 (file-name-directory path)))
4062 (tramp-verbose anything-tramp-verbose)) ; No tramp message when 0.
4063 (set-text-properties 0 (length path) nil path)
4064 ;; Don't set now `anything-pattern' if `path' == "Invalid tramp file name"
4065 ;; like that the actual value (e.g /ssh:) is passed to
4066 ;; `anything-ff-tramp-hostnames'.
4067 (unless (string= path "Invalid tramp file name")
4068 (setq anything-pattern (anything-ff-transform-fname-for-completion path)))
4069 (setq anything-ff-default-directory
4070 (if (string= anything-pattern "")
4071 (expand-file-name "/") ; Expand to "/" or "c:/"
4072 (unless (string-match ffap-url-regexp path)
4073 ;; If path is an url *default-directory have to be nil.
4074 path-name-dir)))
4075 (cond ((string= path "Invalid tramp file name")
4076 (or (anything-ff-tramp-hostnames) ; Hostnames completion.
4077 (prog2
4078 ;; `anything-pattern' have not been modified yet.
4079 ;; Set it here to the value of `path' that should be now
4080 ;; "Invalid tramp file name" and set the candidates list
4081 ;; to ("Invalid tramp file name") to make `anything-pattern'
4082 ;; match single candidate "Invalid tramp file name".
4083 (setq anything-pattern path)
4084 ;; "Invalid tramp file name" is now printed
4085 ;; in `anything-buffer'.
4086 (list path))))
4087 ((or (file-regular-p path)
4088 (and (not (file-exists-p path)) (string-match "/$" path))
4089 (and ffap-url-regexp (string-match ffap-url-regexp path)))
4090 (list path))
4091 ((string= path "") (anything-ff-directory-files "/" t))
4092 ((and (file-directory-p path) (not (file-readable-p path)))
4093 (list (format "Opening directory: access denied, `%s'" path)))
4094 ((file-directory-p path) (anything-ff-directory-files path t))
4096 (append (unless require-match (list path))
4097 (anything-ff-directory-files path-name-dir t))))))
4099 (defun anything-ff-directory-files (directory &optional full)
4100 "List contents of DIRECTORY.
4101 Argument FULL mean absolute path.
4102 It is same as `directory-files' but always returns the
4103 dotted filename '.' and '..' on root directories on Windows
4104 systems."
4105 (setq directory (expand-file-name directory))
4106 (let ((ls (directory-files directory full))
4107 dot dot2 lsdir)
4108 (if (or
4109 ;; A windows volume.
4110 (string-match "^[a-zA-Z]\\{1\\}:/$" directory)
4111 ;; Empty directories on ftp hosts may have no dot dirs.
4112 (and (file-remote-p directory)
4113 (string-match "^/ftp:" directory)))
4114 (progn (setq dot (concat directory "."))
4115 (setq dot2 (concat directory ".."))
4116 (setq lsdir (remove dot2 (remove dot ls)))
4117 (append (list dot dot2) lsdir))
4118 ls)))
4120 (defun anything-ff-transform-fname-for-completion (fname)
4121 "Return FNAME with it's basename modified as a regexp.
4122 e.g foo => f.*o.*o .
4123 If basename contain one or more space or FNAME is a valid directory name
4124 return FNAME unchanged."
4125 (let ((bn (anything-c-basename fname)))
4126 (if (or (not anything-ff-smart-completion)
4127 (string-match "\\s-" bn)
4128 (string-match "/$" fname) ; Allow mkdir.
4129 (file-directory-p fname))
4130 fname ; Fall back to match-plugin.
4131 (setq bn (if (> (length bn) 2) ; Normal completion on first 2 char.
4132 (mapconcat 'identity (split-string bn "" t) ".*") bn))
4133 (concat (file-name-directory fname) bn))))
4135 (defun anything-ff-save-history ()
4136 "Store the last value of `anything-ff-default-directory' \
4137 in `anything-ff-history'."
4138 (when (and anything-ff-default-directory
4139 (anything-file-completion-source-p))
4140 (push anything-ff-default-directory anything-ff-history)))
4141 (add-hook 'anything-cleanup-hook 'anything-ff-save-history)
4143 (defun anything-ff-valid-symlink-p (file)
4144 (file-exists-p (file-truename file)))
4146 (defun anything-ff-properties (candidate)
4147 "Show file properties of CANDIDATE in a tooltip or message."
4148 (let ((type (anything-ff-attributes candidate :type t))
4149 (dired-line (anything-ff-attributes candidate :dired t :human-size t)))
4150 (if (window-system)
4151 (tooltip-show
4152 (concat
4153 (anything-c-basename candidate) ": \n"
4154 "Type: " type "\n"
4155 (when (string= type "symlink")
4156 (format "True name: '%s'\n"
4157 (cond ((string-match "^\.#" (anything-c-basename candidate))
4158 "Autosave symlink")
4159 ((anything-ff-valid-symlink-p candidate)
4160 (file-truename candidate))
4161 (t "Invalid Symlink"))))
4162 dired-line))
4163 (message dired-line) (sit-for 5))))
4165 ;;;###autoload
4166 (defun anything-ff-properties-persistent ()
4167 "Show properties without quitting anything."
4168 (interactive)
4169 (anything-attrset 'properties-action 'anything-ff-properties)
4170 (anything-execute-persistent-action 'properties-action))
4172 ;;;###autoload
4173 (defun anything-ff-persistent-delete ()
4174 "Delete current candidate without quitting."
4175 (interactive)
4176 (anything-attrset 'quick-delete 'anything-ff-quick-delete)
4177 (anything-execute-persistent-action 'quick-delete))
4179 (defun anything-ff-dot-file-p (file)
4180 "Check if FILE is `.' or `..'."
4181 (member (anything-c-basename file) '("." "..")))
4183 (defun anything-ff-quick-delete (candidate)
4184 "Delete file CANDIDATE without quitting."
4185 (if (and anything-ff-signal-error-on-dot-files
4186 (anything-ff-dot-file-p candidate))
4187 (message "Error: Cannot operate on `.' or `..'")
4188 (let ((presel (prog1 (save-excursion
4189 (let (sel)
4190 (anything-next-line)
4191 (setq sel (anything-get-selection))
4192 (if (string= sel candidate)
4193 (progn (anything-previous-line)
4194 (anything-get-selection))
4195 sel)))
4196 (anything-mark-current-line))))
4197 (setq presel (if (and anything-ff-transformer-show-only-basename
4198 (not (anything-ff-dot-file-p presel)))
4199 (anything-c-basename presel) presel))
4200 (if anything-ff-quick-delete-dont-prompt-for-deletion
4201 (anything-c-delete-file candidate)
4202 (save-selected-window
4203 (when (y-or-n-p (format "Really Delete file `%s'? " candidate))
4204 (anything-c-delete-file candidate)
4205 (message nil))))
4206 (anything-force-update presel))))
4208 (defun anything-ff-kill-buffer-fname (candidate)
4209 (let* ((buf (get-file-buffer candidate))
4210 (buf-name (buffer-name buf)))
4211 (if buf
4212 (progn
4213 (kill-buffer buf) (message "Buffer `%s' killed" buf))
4214 (message "No buffer to kill"))))
4216 (defun anything-ff-kill-or-find-buffer-fname (candidate)
4217 "Find file CANDIDATE or kill it's buffer if it is visible.
4218 Never kill `anything-current-buffer'.
4219 Never kill buffer modified.
4220 This is called normally on third hit of \
4221 \\<anything-map>\\[anything-execute-persistent-action]
4222 in `anything-find-files-persistent-action'."
4223 (let* ((buf (get-file-buffer candidate))
4224 (buf-name (buffer-name buf)))
4225 (if (and buf (get-buffer-window buf)
4226 (not (eq buf (get-buffer anything-current-buffer)))
4227 (not (buffer-modified-p buf)))
4228 (progn
4229 (kill-buffer buf) (message "Buffer `%s' killed" buf-name))
4230 (find-file candidate))))
4232 ;;;###autoload
4233 (defun anything-ff-run-kill-buffer-persistent ()
4234 "Execute `anything-ff-kill-buffer-fname' whitout quitting."
4235 (interactive)
4236 (anything-attrset 'kill-buffer-fname 'anything-ff-kill-buffer-fname)
4237 (anything-execute-persistent-action 'kill-buffer-fname))
4239 (defun anything-ff-human-size (size)
4240 "Return a string showing SIZE of a file in human readable form.
4241 SIZE can be an integer or a float depending it's value.
4242 `file-attributes' will take care of that to avoid overflow error.
4243 KBSIZE if a floating point number, default value is 1024.0."
4244 (let ((M (cons "M" (/ size (expt anything-ff-default-kbsize 2))))
4245 (G (cons "G" (/ size (expt anything-ff-default-kbsize 3))))
4246 (K (cons "K" (/ size anything-ff-default-kbsize)))
4247 (B (cons "B" size)))
4248 (loop with result = B
4249 for (a . b) in
4250 (loop for (x . y) in (list M G K B)
4251 unless (< y 1) collect (cons x y))
4252 when (< b (cdr result)) do (setq result (cons a b))
4253 finally return (if (string= (car result) "B")
4254 (format "%s" size)
4255 (format "%.1f%s" (cdr result) (car result))))))
4257 (defun* anything-ff-attributes
4258 (file &key type links uid gid access-time modif-time
4259 status size mode gid-change inode device-num dired human-size)
4260 "Easy interface for `file-attributes'."
4261 (let ((all (destructuring-bind
4262 (type links uid gid access-time modif-time
4263 status size mode gid-change inode device-num)
4264 (file-attributes file 'string)
4265 (list :type type
4266 :links links
4267 :uid uid
4268 :gid gid
4269 :access-time access-time
4270 :modif-time modif-time
4271 :status status
4272 :size size
4273 :mode mode
4274 :gid-change gid-change
4275 :inode inode
4276 :device-num device-num))))
4277 (cond (type
4278 (let ((result (getf all :type)))
4279 (cond ((stringp result)
4280 "symlink")
4281 (result "directory")
4282 (t "file"))))
4283 (links (getf all :links))
4284 (uid (getf all :uid))
4285 (gid (getf all :gid))
4286 (access-time
4287 (format-time-string "%Y-%m-%d %R" (getf all :access-time)))
4288 (modif-time
4289 (format-time-string "%Y-%m-%d %R" (getf all :modif-time)))
4290 (status
4291 (format-time-string "%Y-%m-%d %R" (getf all :status)))
4292 (size (if human-size (anything-ff-human-size (getf all :size))
4293 (getf all :size)))
4294 (mode (getf all :mode))
4295 (gid-change (getf all :gid-change))
4296 (inode (getf all :inode))
4297 (device-num (getf all :device-num))
4298 (dired
4299 (concat
4300 (getf all :mode) " "
4301 (number-to-string (getf all :links)) " "
4302 (getf all :uid) ":"
4303 (getf all :gid) " "
4304 (if human-size (anything-ff-human-size (getf all :size))
4305 (int-to-string (getf all :size))) " "
4306 (format-time-string "%Y-%m-%d %R" (getf all :modif-time))))
4307 (t all))))
4309 (defun anything-ff-prefix-filename (fname &optional file-or-symlinkp new-file)
4310 "Return filename FNAME maybe prefixed with [?] or [@].
4311 If FILE-OR-SYMLINKP is non--nil this mean we assume FNAME is an
4312 existing filename or valid symlink and there is no need to test it.
4313 NEW-FILE when non--nil mean FNAME is a non existing file and
4314 return FNAME prefixed with [?]."
4315 (let* ((prefix-new (propertize
4316 " " 'display
4317 (propertize "[?]" 'face 'anything-ff-prefix)))
4318 (prefix-url (propertize
4319 " " 'display
4320 (propertize "[@]" 'face 'anything-ff-prefix))))
4321 (cond ((or file-or-symlinkp (file-exists-p fname)) fname)
4322 ((string-match ffap-url-regexp fname)
4323 (concat prefix-url " " fname))
4324 ((or new-file (not (file-exists-p fname)))
4325 (concat prefix-new " " fname)))))
4327 (defun anything-c-find-files-transformer (files sources)
4328 "Transformer for `anything-c-source-find-files'.
4329 Tramp files are not highlighted unless `anything-ff-tramp-not-fancy'
4330 is non--nil."
4331 (if (and (string-match tramp-file-name-regexp anything-pattern)
4332 anything-ff-tramp-not-fancy)
4333 (if anything-ff-transformer-show-only-basename
4334 (loop for i in files collect
4335 (if (string-match "[.]\\{1,2\\}$" i)
4336 i (cons (anything-c-basename i) i)))
4337 files)
4338 (anything-ff-highlight-files files sources)))
4340 (defun anything-ff-highlight-files (files sources)
4341 "Candidate transformer for `anything-c-source-find-files' without icons."
4342 (loop for i in files
4343 for disp = (if (and anything-ff-transformer-show-only-basename
4344 (not (string-match "[.]\\{1,2\\}$" i))
4345 (not (string-match ffap-url-regexp i)))
4346 (anything-c-basename i) i)
4347 collect
4348 (cond ((and (stringp (car (file-attributes i)))
4349 (not (anything-ff-valid-symlink-p i))
4350 (not (string-match "^\.#" (anything-c-basename i))))
4351 (cons (anything-ff-prefix-filename
4352 (propertize disp 'face 'anything-ff-invalid-symlink) t)
4354 ((stringp (car (file-attributes i)))
4355 (cons (anything-ff-prefix-filename
4356 (propertize disp 'face 'anything-ff-symlink) t)
4358 ((eq t (car (file-attributes i)))
4359 (cons (anything-ff-prefix-filename
4360 (propertize disp 'face 'anything-ff-directory) t)
4362 ((file-executable-p i)
4363 (cons (anything-ff-prefix-filename
4364 (propertize disp 'face 'anything-ff-executable) t)
4366 ((file-exists-p i)
4367 (cons (anything-ff-prefix-filename
4368 (propertize disp 'face 'anything-ff-file) t)
4371 (cons (anything-ff-prefix-filename
4372 (propertize disp 'face 'anything-ff-file) nil 'new-file)
4373 i)))))
4375 (defun anything-find-files-action-transformer (actions candidate)
4376 "Action transformer for `anything-c-source-find-files'."
4377 (cond ((with-anything-current-buffer
4378 (eq major-mode 'message-mode))
4379 (append (subseq actions 0 4)
4380 '(("Gnus attach file(s)" . anything-ff-gnus-attach-files))
4381 (subseq actions 4)))
4382 ((string-match (image-file-name-regexp) candidate)
4383 (append (subseq actions 0 4)
4384 '(("Rotate image right `M-r'" . anything-ff-rotate-image-right)
4385 ("Rotate image left `M-l'" . anything-ff-rotate-image-left))
4386 (subseq actions 4)))
4387 ((string-match "\.el$" (anything-aif (anything-marked-candidates)
4388 (car it) candidate))
4389 (append (subseq actions 0 4)
4390 '(("Byte compile lisp file(s) `M-B, C-u to load'"
4391 . anything-find-files-byte-compile)
4392 ("Load File(s) `M-L'" . anything-find-files-load-files))
4393 (subseq actions 4)))
4394 ((and (string-match "\.html?$" candidate)
4395 (file-exists-p candidate))
4396 (append (subseq actions 0 4)
4397 '(("Browse url file" . browse-url-of-file))
4398 (subseq actions 5)))
4399 ((or (string= (file-name-extension candidate) "pdf")
4400 (string= (file-name-extension candidate) "PDF"))
4401 (append (subseq actions 0 4)
4402 '(("Pdfgrep File(s)" . anything-ff-pdfgrep))
4403 (subseq actions 5)))
4404 (t actions)))
4406 (defun anything-ff-gnus-attach-files (candidate)
4407 "Run `gnus-dired-attach' on `anything-marked-candidates' or CANDIDATE."
4408 (let ((flist (anything-marked-candidates)))
4409 (gnus-dired-attach flist)))
4411 (defun anything-ff-rotate-current-image-1 (file &optional num-arg)
4412 "Rotate current image at NUM-ARG degrees.
4413 This is a destructive operation on FILE made by external tool mogrify."
4414 (declare (special image-dired-display-image-buffer))
4415 (setq file (file-truename file)) ; For symlinked images.
4416 ;; When FILE is not an image-file, do nothing.
4417 (when (string-match (image-file-name-regexp) file)
4418 (if (executable-find "mogrify")
4419 (progn
4420 (shell-command (format "mogrify -rotate %s %s"
4421 (or num-arg 90)
4422 (shell-quote-argument file)))
4423 (when (buffer-live-p image-dired-display-image-buffer)
4424 (kill-buffer image-dired-display-image-buffer))
4425 (image-dired-display-image file)
4426 (message nil)
4427 (display-buffer (get-buffer image-dired-display-image-buffer)))
4428 (error "mogrify not found"))))
4430 (defun anything-ff-rotate-image-left (candidate)
4431 "Rotate image file CANDIDATE left.
4432 This affect directly file CANDIDATE."
4433 (anything-ff-rotate-current-image-1 candidate -90))
4435 (defun anything-ff-rotate-image-right (candidate)
4436 "Rotate image file CANDIDATE right.
4437 This affect directly file CANDIDATE."
4438 (anything-ff-rotate-current-image-1 candidate))
4440 (defun anything-ff-rotate-left-persistent ()
4441 "Rotate image left without quitting anything."
4442 (interactive)
4443 (anything-attrset 'image-action1 'anything-ff-rotate-image-left)
4444 (anything-execute-persistent-action 'image-action1))
4446 (defun anything-ff-rotate-right-persistent ()
4447 "Rotate image right without quitting anything."
4448 (interactive)
4449 (anything-attrset 'image-action2 'anything-ff-rotate-image-right)
4450 (anything-execute-persistent-action 'image-action2))
4452 (defun anything-ff-exif-data (candidate)
4453 "Extract exif data from file CANDIDATE using `anything-ff-exif-data-program'."
4454 (if (and anything-ff-exif-data-program
4455 (executable-find anything-ff-exif-data-program))
4456 (shell-command-to-string (format "%s %s %s"
4457 anything-ff-exif-data-program
4458 anything-ff-exif-data-program-args
4459 candidate))
4460 (format "No program %s found to extract exif"
4461 anything-ff-exif-data-program)))
4463 (defun anything-find-files-persistent-action (candidate)
4464 "Open subtree CANDIDATE without quitting anything.
4465 If CANDIDATE is not a directory expand CANDIDATE filename.
4466 If CANDIDATE is alone, open file CANDIDATE filename.
4467 That's mean:
4468 First hit on C-z expand CANDIDATE second hit open file.
4469 If a prefix arg is given or `anything-follow-mode' is on open file."
4470 (let ((follow (buffer-local-value
4471 'anything-follow-mode
4472 (get-buffer-create anything-buffer)))
4473 (new-pattern (anything-get-selection))
4474 (num-lines-buf (with-current-buffer anything-buffer
4475 (count-lines (point-min) (point-max)))))
4476 (flet ((insert-in-minibuffer (fname)
4477 (with-selected-window (minibuffer-window)
4478 (unless follow
4479 (delete-minibuffer-contents)
4480 (set-text-properties 0 (length fname) nil fname)
4481 (insert fname)))))
4482 (cond ((and (string= (anything-ff-set-pattern anything-pattern)
4483 "Invalid tramp file name")
4484 (string-match tramp-file-name-regexp candidate))
4485 ;; First hit insert hostname and
4486 ;; second hit insert ":" and expand.
4487 (if (string= candidate anything-pattern)
4488 (insert-in-minibuffer (concat candidate ":"))
4489 (insert-in-minibuffer candidate)))
4490 (;; A symlink directory, expand it's truename.
4491 (and (file-directory-p candidate) (file-symlink-p candidate))
4492 (insert-in-minibuffer (file-name-as-directory
4493 (file-truename
4494 (expand-file-name candidate)))))
4495 ;; A directory, open it.
4496 ((file-directory-p candidate)
4497 (when (string= (anything-c-basename candidate) "..")
4498 (setq anything-ff-last-expanded anything-ff-default-directory))
4499 (insert-in-minibuffer (file-name-as-directory
4500 (expand-file-name candidate))))
4501 ;; A symlink file, expand to it's true name. (first hit)
4502 ((and (file-symlink-p candidate) (not current-prefix-arg) (not follow))
4503 (insert-in-minibuffer (file-truename candidate)))
4504 ;; A regular file, expand it, (first hit)
4505 ((and (>= num-lines-buf 3) (not current-prefix-arg) (not follow))
4506 (insert-in-minibuffer new-pattern))
4507 ;; An image file and it is the second hit on C-z,
4508 ;; show the file in `image-dired'.
4509 ((string-match (image-file-name-regexp) candidate)
4510 (when (buffer-live-p image-dired-display-image-buffer)
4511 (kill-buffer image-dired-display-image-buffer))
4512 (image-dired-display-image candidate)
4513 (message nil)
4514 (anything-c-switch-to-buffer image-dired-display-image-buffer)
4515 (with-current-buffer image-dired-display-image-buffer
4516 (let ((exif-data (anything-ff-exif-data candidate)))
4517 (image-dired-update-property 'help-echo exif-data))))
4518 ;; Allow browsing archive on avfs fs.
4519 ;; Assume volume is already mounted with mountavfs.
4520 ((and anything-ff-avfs-directory
4521 (string-match
4522 (regexp-quote (expand-file-name anything-ff-avfs-directory))
4523 (file-name-directory candidate))
4524 (anything-ff-file-compressed-p candidate))
4525 (insert-in-minibuffer (concat candidate "#")))
4526 ;; On second hit we open file.
4527 ;; On Third hit we kill it's buffer maybe.
4529 (anything-ff-kill-or-find-buffer-fname candidate))))))
4531 (defun anything-ff-file-compressed-p (candidate)
4532 "Whether CANDIDATE is a compressed file or not."
4533 (member (file-name-extension candidate)
4534 anything-ff-file-compressed-list))
4536 (defun anything-c-insert-file-name-completion-at-point (candidate)
4537 "Insert file name completion at point."
4538 (with-anything-current-buffer
4539 (if buffer-read-only
4540 (error "Error: Buffer `%s' is read-only" (buffer-name))
4541 (let* ((end (point))
4542 (guess (substring-no-properties (thing-at-point 'filename)))
4543 (beg (- (point) (length guess)))
4544 (full-path-p (or (string-match-p (concat "^" (getenv "HOME")) guess)
4545 (string-match-p "^[^\~]" guess))))
4546 (set-text-properties 0 (length candidate) nil candidate)
4547 (if (and guess (not (string= guess ""))
4548 (string-match-p "^~\\|/.*" guess))
4549 (progn
4550 (delete-region beg end)
4551 (insert (if full-path-p
4552 (expand-file-name candidate)
4553 (abbreviate-file-name candidate))))
4554 (error "Aborting completion: No valid file name at point"))))))
4556 (defun* anything-find-files-history (&key (comp-read t))
4557 "The `anything-find-files' history.
4558 Show the first `anything-ff-history-max-length' elements of
4559 `anything-ff-history' in an `anything-comp-read'."
4560 (let ((history (when anything-ff-history
4561 (anything-fast-remove-dups anything-ff-history
4562 :test 'equal))))
4563 (when history
4564 (setq anything-ff-history
4565 (if (>= (length history) anything-ff-history-max-length)
4566 (subseq history 0 anything-ff-history-max-length)
4567 history))
4568 (if comp-read
4569 (anything-comp-read
4570 "Switch to Directory: "
4571 anything-ff-history
4572 :name "Anything Find Files History"
4573 :must-match t)
4574 anything-ff-history))))
4576 (defun anything-find-files-1 (fname &optional preselect)
4577 "Find FNAME with `anything' completion.
4578 Like `find-file' but with `anything' support.
4579 Use it for non--interactive calls of `anything-find-files'."
4580 (when (get-buffer anything-action-buffer)
4581 (kill-buffer anything-action-buffer))
4582 (let ((anything-mp-highlight-delay nil)
4583 ;; Be sure we don't erase the precedent minibuffer if some.
4584 (anything-ff-auto-update-initial-value
4585 (not (minibuffer-window-active-p (minibuffer-window))))
4586 anything-samewindow)
4587 (anything :sources 'anything-c-source-find-files
4588 :input fname
4589 :preselect preselect
4590 :keymap anything-find-files-map
4591 :prompt "Find Files or Url: "
4592 :buffer "*Anything Find Files*")))
4595 (defun anything-find-files-initial-input (&optional input)
4596 "Return INPUT if present, otherwise try to guess it."
4597 (or (and input (or (and (file-remote-p input) input)
4598 (expand-file-name input)))
4599 (anything-find-files-input
4600 (ffap-guesser)
4601 (thing-at-point 'filename))))
4603 (defun anything-find-files-input (fap tap)
4604 "Default input of `anything-find-files'."
4605 (let* ((def-dir (anything-c-current-directory))
4606 (lib (anything-find-library-at-point))
4607 (url (anything-ff-find-url-at-point))
4608 (remp (and fap (file-remote-p fap)))
4609 (file-p (and (not remp)
4611 (not (string= fap ""))
4612 (file-exists-p fap)
4613 tap (not (string= tap ""))
4614 (file-exists-p
4615 (file-name-directory (expand-file-name tap def-dir))))))
4616 (cond (lib) ; e.g we are inside a require sexp.
4617 (url) ; String at point is an hyperlink.
4618 (remp fap)
4619 (file-p (expand-file-name tap def-dir))
4620 (t (and (not (string= fap "")) fap)))))
4622 (defun anything-c-current-directory ()
4623 "Return current-directory name at point.
4624 Useful in dired buffers when there is inserted subdirs."
4625 (if (eq major-mode 'dired-mode)
4626 (dired-current-directory)
4627 default-directory))
4629 (defun anything-ff-find-url-at-point ()
4630 "Try to find link to an url in text-property at point."
4631 (let* ((he (get-text-property (point) 'help-echo))
4632 (ov (overlays-at (point)))
4633 (ov-he (and ov (overlay-get
4634 (car (overlays-at (point))) 'help-echo)))
4635 (w3m-l (get-text-property (point) 'w3m-href-anchor))
4636 (nt-prop (get-text-property (point) 'nt-link)))
4637 ;; Org link.
4638 (when (and (stringp he) (string-match "^LINK: " he))
4639 (setq he (replace-match "" t t he)))
4640 (loop for i in (list he ov-he w3m-l nt-prop)
4641 thereis (and (stringp i) (string-match ffap-url-regexp i) i))))
4643 (defun anything-find-library-at-point ()
4644 "Try to find library path at point.
4645 Find inside `require' and `declare-function' sexp."
4646 (require 'find-func)
4647 (let* ((beg-sexp (save-excursion (search-backward "(" (point-at-bol) t)))
4648 (end-sexp (save-excursion (search-forward ")" (point-at-eol) t)))
4649 (sexp (and beg-sexp end-sexp
4650 (buffer-substring-no-properties
4651 (1+ beg-sexp) (1- end-sexp)))))
4652 (ignore-errors
4653 (cond ((and sexp (string-match "require \'.+[^)]" sexp))
4654 (find-library-name
4655 (replace-regexp-in-string
4656 "'\\|\)\\|\(" ""
4657 ;; If require use third arg, ignore it,
4658 ;; always use library path found in `load-path'.
4659 (second (split-string (match-string 0 sexp))))))
4660 ((and sexp (string-match-p "^declare-function" sexp))
4661 (find-library-name
4662 (replace-regexp-in-string
4663 "\"\\|ext:" ""
4664 (third (split-string sexp)))))
4665 (t nil)))))
4667 ;;; Anything completion for `write-file'.==> C-x C-w
4668 (defvar anything-c-source-write-file
4669 `((name . "Write File")
4670 (header-name . (lambda (name)
4671 (concat name anything-c-find-files-doc-header)))
4672 ;; It is needed for filenames with capital letters
4673 (disable-shortcuts)
4674 (candidates . anything-find-files-get-candidates)
4675 (filtered-candidate-transformer anything-c-find-files-transformer)
4676 (persistent-action . anything-find-files-persistent-action)
4677 (persistent-help . "Expand Candidate")
4678 (volatile)
4679 (action .
4680 (("Write File" . (lambda (candidate)
4681 (write-file candidate 'confirm)))))))
4683 ;;; Anything completion for `insert-file'.==> C-x i
4684 (defvar anything-c-source-insert-file
4685 `((name . "Insert File")
4686 (header-name . (lambda (name)
4687 (concat name anything-c-find-files-doc-header)))
4688 ;; It is needed for filenames with capital letters
4689 (disable-shortcuts)
4690 (candidates . anything-find-files-get-candidates)
4691 (filtered-candidate-transformer anything-c-find-files-transformer)
4692 (persistent-action . anything-find-files-persistent-action)
4693 (persistent-help . "Expand Candidate")
4694 (volatile)
4695 (action .
4696 (("Insert File" . (lambda (candidate)
4697 (when (y-or-n-p (format "Really insert %s in %s "
4698 candidate anything-current-buffer))
4699 (insert-file-contents candidate))))))))
4701 ;;; Anything completion for copy, rename and (rel)sym/hard/link files from dired.
4702 (defvar anything-c-source-copy-files
4703 `((name . "Copy Files")
4704 (header-name . (lambda (name)
4705 (concat name anything-c-find-files-doc-header)))
4706 ;; It is needed for filenames with capital letters
4707 (disable-shortcuts)
4708 (candidates . anything-find-files-get-candidates)
4709 (filtered-candidate-transformer anything-c-find-files-transformer)
4710 (persistent-action . anything-find-files-persistent-action)
4711 (persistent-help . "Expand Candidate")
4712 (volatile)
4713 (action .
4714 (("Copy File"
4715 . (lambda (candidate)
4716 (anything-dired-action candidate :action 'copy)))
4717 ("Copy and Follow"
4718 . (lambda (candidate)
4719 (anything-dired-action candidate :action 'copy :follow t)))))))
4722 (defvar anything-c-source-rename-files
4723 `((name . "Rename Files")
4724 (header-name . (lambda (name)
4725 (concat name anything-c-find-files-doc-header)))
4726 ;; It is needed for filenames with capital letters
4727 (disable-shortcuts)
4728 (candidates . anything-find-files-get-candidates)
4729 (filtered-candidate-transformer anything-c-find-files-transformer)
4730 (persistent-action . anything-find-files-persistent-action)
4731 (persistent-help . "Expand Candidate")
4732 (volatile)
4733 (action .
4734 (("Rename File"
4735 . (lambda (candidate)
4736 (anything-dired-action candidate :action 'rename)))
4737 ("Rename and Follow"
4738 . (lambda (candidate)
4739 (anything-dired-action candidate :action 'rename :follow t)))))))
4741 (defvar anything-c-source-symlink-files
4742 `((name . "Symlink Files")
4743 (header-name . (lambda (name)
4744 (concat name anything-c-find-files-doc-header)))
4745 ;; It is needed for filenames with capital letters
4746 (disable-shortcuts)
4747 (candidates . anything-find-files-get-candidates)
4748 (filtered-candidate-transformer anything-c-find-files-transformer)
4749 (persistent-action . anything-find-files-persistent-action)
4750 (persistent-help . "Expand Candidate")
4751 (volatile)
4752 (action
4753 . (("Symlink File"
4754 . (lambda (candidate)
4755 (anything-dired-action candidate :action 'symlink)))
4756 ("RelSymlink File"
4757 . (lambda (candidate)
4758 (anything-dired-action candidate :action 'relsymlink)))))))
4761 (defvar anything-c-source-hardlink-files
4762 `((name . "Hardlink Files")
4763 (header-name . (lambda (name)
4764 (concat name anything-c-find-files-doc-header)))
4765 ;; It is needed for filenames with capital letters
4766 (disable-shortcuts)
4767 (candidates . anything-find-files-get-candidates)
4768 (filtered-candidate-transformer anything-c-find-files-transformer)
4769 (persistent-action . anything-find-files-persistent-action)
4770 (persistent-help . "Expand Candidate")
4771 (volatile)
4772 (action
4773 . (("Hardlink File"
4774 . (lambda (candidate)
4775 (anything-dired-action candidate :action 'hardlink)))))))
4777 (defun* anything-dired-action (candidate &key action follow (files (dired-get-marked-files)))
4778 "Copy, rename or symlink file at point or marked files in dired to CANDIDATE.
4779 ACTION is a key that can be one of 'copy, 'rename, 'symlink, 'relsymlink."
4780 (when (get-buffer dired-log-buffer) (kill-buffer dired-log-buffer))
4781 (let ((fn (case action
4782 ('copy 'dired-copy-file)
4783 ('rename 'dired-rename-file)
4784 ('symlink 'make-symbolic-link)
4785 ('relsymlink 'dired-make-relative-symlink)
4786 ('hardlink 'dired-hardlink)))
4787 (marker (case action
4788 ((copy rename) dired-keep-marker-copy)
4789 ('symlink dired-keep-marker-symlink)
4790 ('relsymlink dired-keep-marker-relsymlink)
4791 ('hardlink dired-keep-marker-hardlink)))
4792 (dirflag (and (= (length files) 1)
4793 (file-directory-p (car files))
4794 (not (file-directory-p candidate)))))
4795 (dired-create-files
4796 fn (symbol-name action) files
4797 ;; CANDIDATE is the destination.
4798 (if (file-directory-p candidate)
4799 ;; When CANDIDATE is a directory, build file-name in this directory.
4800 ;; Else we use CANDIDATE.
4801 #'(lambda (from)
4802 (expand-file-name (file-name-nondirectory from) candidate))
4803 #'(lambda (from) candidate))
4804 marker)
4805 (push (file-name-as-directory
4806 (if (file-directory-p candidate)
4807 candidate (file-name-directory candidate)))
4808 anything-ff-history)
4809 (when (and follow (not (get-buffer dired-log-buffer)))
4810 (let ((target (directory-file-name candidate)))
4811 (unwind-protect
4812 (progn
4813 (setq anything-ff-cand-to-mark
4814 (anything-get-dest-fnames-from-list files candidate dirflag))
4815 (if (and dirflag (eq action 'rename))
4816 (anything-find-files-1 (file-name-directory target)
4817 (if anything-ff-transformer-show-only-basename
4818 (anything-c-basename target) target))
4819 (anything-find-files-1 (expand-file-name candidate))))
4820 (setq anything-ff-cand-to-mark nil))))))
4822 (defun anything-c-basename (fname &optional ext)
4823 "Print FNAME with any leading directory components removed.
4824 If specified, also remove filename extension EXT."
4825 (if (and ext (or (string= (file-name-extension fname) ext)
4826 (string= (file-name-extension fname t) ext))
4827 (not (file-directory-p fname)))
4828 (file-name-sans-extension (file-name-nondirectory fname))
4829 (file-name-nondirectory (directory-file-name fname))))
4831 (defun anything-get-dest-fnames-from-list (flist dest-cand rename-dir-flag)
4832 "Transform filenames of FLIST to abs of DEST-CAND.
4833 If RENAME-DIR-FLAG is non--nil collect the `directory-file-name' of transformed
4834 members of FLIST."
4835 ;; At this point files have been renamed/copied at destination.
4836 ;; That's mean DEST-CAND exists.
4837 (loop
4838 with dest = (expand-file-name dest-cand)
4839 for src in flist
4840 for basename-src = (anything-c-basename src)
4841 for fname = (cond (rename-dir-flag (directory-file-name dest))
4842 ((file-directory-p dest)
4843 (concat (file-name-as-directory dest) basename-src))
4844 (t dest))
4845 when (file-exists-p fname)
4846 collect fname into tmp-list
4847 finally return (sort tmp-list 'string<)))
4849 (defun anything-ff-maybe-mark-candidates ()
4850 "Mark all candidates of list `anything-ff-cand-to-mark'."
4851 (when (and (string= (assoc-default 'name (anything-get-current-source))
4852 (assoc-default 'name anything-c-source-find-files))
4853 anything-ff-cand-to-mark)
4854 (with-anything-window
4855 (while anything-ff-cand-to-mark
4856 (if (string= (car anything-ff-cand-to-mark) (anything-get-selection))
4857 (progn
4858 (anything-make-visible-mark)
4859 (anything-next-line)
4860 (setq anything-ff-cand-to-mark (cdr anything-ff-cand-to-mark)))
4861 (anything-next-line)))
4862 (unless (anything-this-visible-mark)
4863 (anything-prev-visible-mark)))))
4865 (add-hook 'anything-after-update-hook #'anything-ff-maybe-mark-candidates)
4867 (defun* anything-dired-do-action-on-file (&key action)
4868 (let* ((files (dired-get-marked-files))
4869 (len (length files))
4870 (fname (if (> len 1)
4871 (format "* %d Files" len)
4872 (car files)))
4873 (source (case action
4874 ('copy 'anything-c-source-copy-files)
4875 ('rename 'anything-c-source-rename-files)
4876 ('symlink 'anything-c-source-symlink-files)
4877 ('hardlink 'anything-c-source-hardlink-files)))
4878 (prompt-fm (case action
4879 ('copy "Copy %s to: ")
4880 ('rename "Rename %s to: ")
4881 ('symlink "Symlink %s to: ")
4882 ('hardlink "Hardlink %s to: ")))
4883 (buffer (case action
4884 ('copy "*Anything Copy Files*")
4885 ('rename "*Anything Rename Files*")
4886 ('symlink "*Anything Symlink Files*")
4887 ('hardlink "*Anything Hardlink Files*")))
4888 (anything-mp-highlight-delay nil))
4889 (anything :sources source
4890 :input (or (dired-dwim-target-directory)
4891 (expand-file-name (anything-c-current-directory)))
4892 :preselect (dired-get-filename)
4893 :prompt (format prompt-fm fname)
4894 :keymap anything-c-read-file-map
4895 :buffer buffer)))
4897 ;;;###autoload
4898 (define-minor-mode anything-dired-mode ()
4899 "Enable anything completion in Dired functions.
4900 Bindings affected are C, R, S, H.
4901 This is deprecated for Emacs24+ users, use `ac-mode' instead."
4902 :group 'anything-config
4903 :global t
4904 (if anything-dired-mode
4905 (progn
4906 (substitute-key-definition
4907 'dired-do-copy 'anything-dired-copy-file dired-mode-map)
4908 (substitute-key-definition
4909 'dired-do-rename 'anything-dired-rename-file dired-mode-map)
4910 (substitute-key-definition
4911 'dired-do-symlink 'anything-dired-symlink-file dired-mode-map)
4912 (substitute-key-definition
4913 'dired-do-hardlink 'anything-dired-hardlink-file dired-mode-map))
4914 (substitute-key-definition
4915 'anything-dired-copy-file 'dired-do-copy dired-mode-map)
4916 (substitute-key-definition
4917 'anything-dired-rename-file 'dired-do-rename dired-mode-map)
4918 (substitute-key-definition
4919 'anything-dired-symlink-file 'dired-do-symlink dired-mode-map)
4920 (substitute-key-definition
4921 'anything-dired-hardlink-file 'dired-do-hardlink dired-mode-map)))
4923 (defalias 'anything-dired-bindings 'anything-dired-mode)
4925 (defun* anything-c-read-file-name
4926 (prompt
4927 &key
4928 (name "Read File Name")
4929 (initial-input (expand-file-name default-directory))
4930 (buffer "*Anything Completions*")
4931 test
4932 (preselect nil)
4933 (history nil)
4934 must-match
4935 (marked-candidates nil)
4936 (alistp t)
4937 (persistent-action 'anything-find-files-persistent-action)
4938 (persistent-help "Hit1 Expand Candidate, Hit2 or (C-u) Find file"))
4939 "Read a file name with anything completion.
4940 It is anything `read-file-name' emulation.
4942 Argument PROMPT is the default prompt to use.
4944 Keys description:
4946 - NAME: Source name, default to \"Read File Name\".
4948 - INITIAL-INPUT: Where to start read file name, default to `default-directory'.
4950 - BUFFER: `anything-buffer' name default to \"*Anything Completions*\".
4952 - TEST: A predicate called with one arg 'candidate'.
4954 - PRESELECT: anything preselection.
4956 - HISTORY: Display HISTORY in a special source.
4958 - MUST-MATCH: Can be 'confirm, nil, or t.
4960 - MARKED-CANDIDATES: When non--nil return a list of marked candidates.
4962 - ALISTP: Don't use `all-completions' in history (take effect only on history).
4964 - PERSISTENT-ACTION: a persistent action function.
4966 - PERSISTENT-HELP: persistent help message."
4967 (when (get-buffer anything-action-buffer)
4968 (kill-buffer anything-action-buffer))
4970 ;; Assume completion have been already required,
4971 ;; so always use 'confirm.
4972 (when (eq must-match 'confirm-after-completion)
4973 (setq must-match 'confirm))
4975 (flet ((action-fn (candidate)
4976 (if marked-candidates
4977 (anything-marked-candidates)
4978 (identity candidate))))
4980 (let* ((anything-mp-highlight-delay nil)
4981 ;; Be sure we don't erase the underlying minibuffer if some.
4982 (anything-ff-auto-update-initial-value
4983 (not (minibuffer-window-active-p (minibuffer-window))))
4984 anything-same-window
4985 (hist (and history (anything-comp-read-get-candidates
4986 history nil nil alistp)))
4987 (minibuffer-completion-confirm must-match)
4988 (must-match-map (when must-match
4989 (let ((map (make-sparse-keymap)))
4990 (define-key map (kbd "RET")
4991 'anything-confirm-and-exit-minibuffer)
4992 map)))
4993 (anything-map (if must-match-map
4994 (make-composed-keymap
4995 must-match-map anything-c-read-file-map)
4996 anything-c-read-file-map)))
4998 (or (anything
4999 :sources
5000 `(((name . ,(format "%s History" name))
5001 (header-name . (lambda (name)
5002 (concat name anything-c-find-files-doc-header)))
5003 (disable-shortcuts)
5004 (mode-line . anything-read-file-name-mode-line-string)
5005 (candidates . hist)
5006 (persistent-action . ,persistent-action)
5007 (persistent-help . ,persistent-help)
5008 (action . ,'action-fn))
5009 ((name . ,name)
5010 (header-name . (lambda (name)
5011 (concat name anything-c-find-files-doc-header)))
5012 (init . (lambda ()
5013 (setq anything-ff-auto-update-flag
5014 anything-ff-auto-update-initial-value)))
5015 ;; It is needed for filenames with capital letters
5016 (disable-shortcuts)
5017 (mode-line . anything-read-file-name-mode-line-string)
5018 (candidates
5019 . (lambda ()
5020 (if test
5021 (loop with hn = (anything-ff-tramp-hostnames)
5022 for i in (anything-find-files-get-candidates
5023 must-match)
5024 when (or (member i hn) (funcall test i))
5025 collect i)
5026 (anything-find-files-get-candidates must-match))))
5027 (filtered-candidate-transformer anything-c-find-files-transformer)
5028 (persistent-action . ,persistent-action)
5029 (candidate-number-limit . 9999)
5030 (toggle-auto-update . anything-ff-toggle-auto-update)
5031 (persistent-help . ,persistent-help)
5032 (volatile)
5033 (action . ,'action-fn)))
5034 :input initial-input
5035 :prompt prompt
5036 :resume 'noresume
5037 :buffer buffer
5038 :preselect preselect)
5039 (when (and (not (string= anything-pattern ""))
5040 (eq anything-exit-status 0)
5041 (eq must-match 'confirm))
5042 (identity anything-pattern))
5043 (keyboard-quit)))))
5046 ;;; File Cache
5047 (defvar anything-c-file-cache-initialized-p nil)
5049 (defvar anything-c-file-cache-files nil)
5051 (defvar anything-c-source-file-cache
5052 `((name . "File Cache")
5053 (init
5054 . (lambda ()
5055 (require 'filecache nil t)
5056 (unless anything-c-file-cache-initialized-p
5057 (setq anything-c-file-cache-files
5058 (loop for item in file-cache-alist append
5059 (destructuring-bind (base &rest dirs) item
5060 (loop for dir in dirs collect
5061 (concat dir base)))))
5062 (defadvice file-cache-add-file (after file-cache-list activate)
5063 (add-to-list 'anything-c-file-cache-files (expand-file-name file)))
5064 (setq anything-c-file-cache-initialized-p t))))
5065 (keymap . ,anything-generic-files-map)
5066 (help-message . anything-generic-file-help-message)
5067 (mode-line . anything-generic-file-mode-line-string)
5068 (candidates . anything-c-file-cache-files)
5069 (match anything-c-match-on-basename)
5070 (type . file)))
5073 ;;; Locate
5076 ;; NOTE for WINDOZE users:
5077 ;; You have to install Everything with his command line interface here:
5078 ;; http://www.voidtools.com/download.php
5080 (defun anything-locate-1 (&optional localdb init)
5081 "Generic function to run Locate.
5082 if LOCALDB is non--nil search and use a local locate db file.
5083 INIT is a string to use as initial input in prompt.
5084 See `anything-locate-with-db' and `anything-locate'."
5085 (anything-locate-with-db
5086 (and localdb
5087 (anything-c-read-file-name
5088 "LocateDBFiles: "
5089 :marked-candidates t
5090 :preselect anything-locate-db-file-regexp
5091 :test #'(lambda (x)
5092 (if anything-locate-db-file-regexp
5093 ;; Select only locate db files and directories
5094 ;; to allow navigation.
5095 (or (string-match
5096 anything-locate-db-file-regexp x)
5097 (file-directory-p x))
5098 x))))
5099 init))
5100 ;; (anything-locate-1 t)
5102 (defun anything-locate-with-db (&optional db initial-input)
5103 "Run locate -d DB.
5104 If DB is not given or nil use locate without -d option.
5105 Argument DB can be given as a string or list of db files.
5106 Argument INITIAL-INPUT is a string to use as initial-input.
5107 See also `anything-locate'."
5108 (when (and db (stringp db)) (setq db (list db)))
5109 (unless anything-c-locate-command
5110 (setq anything-c-locate-command
5111 (case system-type
5112 ('gnu/linux "locate -i -r %s")
5113 ('berkeley-unix "locate -i %s")
5114 ('windows-nt "es -i -r %s")
5115 (t "locate %s"))))
5116 (let ((anything-c-locate-command
5117 (if db
5118 (replace-regexp-in-string
5119 "locate"
5120 (format "locate -d %s"
5121 (mapconcat 'identity
5122 ;; Remove eventually
5123 ;; marked directories by error.
5124 (loop for i in db
5125 unless (file-directory-p i)
5126 collect i) ":"))
5127 anything-c-locate-command)
5128 anything-c-locate-command)))
5129 (anything :sources 'anything-c-source-locate
5130 :buffer "*anything locate*"
5131 :input initial-input
5132 :keymap anything-generic-files-map)))
5133 ;; (anything-locate-with-db "~/locate.db")
5135 (defun anything-c-locate-init ()
5136 "Initialize async locate process for `anything-c-source-locate'."
5137 (setq mode-line-format
5138 '(" " mode-line-buffer-identification " "
5139 (line-number-mode "%l") " "
5140 (:eval (propertize "(Locate Process Running) "
5141 'face '((:foreground "red"))))))
5142 (prog1
5143 (start-process-shell-command "locate-process" nil
5144 (format anything-c-locate-command
5145 anything-pattern))
5146 (set-process-sentinel (get-process "locate-process")
5147 #'(lambda (process event)
5148 (when (string= event "finished\n")
5149 (with-anything-window
5150 (force-mode-line-update nil)
5151 (anything-update-move-first-line)))))))
5153 (defvar anything-c-source-locate
5154 `((name . "Locate")
5155 (candidates . anything-c-locate-init)
5156 (type . file)
5157 (requires-pattern . 3)
5158 (keymap . ,anything-generic-files-map)
5159 (help-message . anything-generic-file-help-message)
5160 (candidate-number-limit . 9999)
5161 (mode-line . anything-generic-file-mode-line-string)
5162 (delayed))
5163 "Find files matching the current input pattern with locate.")
5165 (defun anything-c-locate-read-file-name (prompt &optional init)
5166 "Search a file with locate and return it's filename.
5167 Use argument PROMPT and INIT for `anything' arguments
5168 prompt and input."
5169 (anything :sources
5170 '((name . "Locate")
5171 (candidates . anything-c-locate-init)
5172 (action . identity)
5173 (requires-pattern . 3)
5174 (candidate-number-limit . 9999)
5175 (mode-line . anything-generic-file-mode-line-string)
5176 (delayed))
5177 :prompt prompt
5178 :input init
5179 :buffer "*anything locate rfn*"))
5183 ;;; Anything Incremental Grep.
5186 ;; Allow to grep incrementally with anything interface.
5187 ;; It allow also to Grep files recursively without using 'find' shell command.
5188 ;; On Windows you will need at least Grep version 2.5.4 of Gnuwin32.
5189 (defvar anything-c-grep-default-command
5190 "grep -d skip %e -niH -e %p %f"
5191 "Default grep format command for `anything-do-grep-1'.
5192 Where:
5193 '%e' format spec is for --exclude or --include grep options.
5194 '%p' format spec is for pattern.
5195 '%f' format spec is for filenames.")
5197 (defvar anything-c-grep-default-recurse-command
5198 "grep -d recurse %e -niH -e %p %f"
5199 "Default recursive grep format command for `anything-do-grep-1'.
5200 See `anything-c-grep-default-command' for format specs.")
5202 (defvar anything-c-default-zgrep-command "zgrep -niH -e %p %f")
5204 (defvar anything-c-rzgrep-cache (make-hash-table :test 'equal))
5206 (defvar anything-c-grep-default-function 'anything-c-grep-init)
5208 (defvar anything-c-grep-debug-command-line nil
5209 "Turn on anything grep command-line debugging when non--nil.")
5211 (defvar anything-c-zgrep-recurse-flag nil)
5213 (defvar anything-c-grep-history nil)
5215 (defvar anything-c-grep-max-length-history 100
5216 "*Max number of elements to save in `anything-c-grep-history'.")
5218 (defun anything-c-grep-prepare-candidates (candidates)
5219 "Prepare filenames and directories CANDIDATES for grep command line."
5220 ;; If one or more candidate is a directory, search in all files
5221 ;; of this candidate (e.g /home/user/directory/*).
5222 ;; If r option is enabled search also in subdidrectories.
5223 ;; We need here to expand wildcards to support crap windows filenames
5224 ;; as grep doesn't accept quoted wildcards (e.g "dir/*.el").
5225 (if anything-c-zgrep-recurse-flag
5226 (mapconcat 'shell-quote-argument candidates " ")
5227 (loop for i in candidates append
5228 (cond ( ;; Candidate is a directory and we use recursion.
5229 (and (file-directory-p i)
5230 (anything-c-grep-recurse-p))
5231 (list (expand-file-name i)))
5232 ;; Candidate is a directory, search in all files.
5233 ((file-directory-p i)
5234 (file-expand-wildcards
5235 (concat (file-name-as-directory (expand-file-name i)) "*") t))
5236 ;; Candidate is a file or wildcard and we use recursion, use the
5237 ;; current directory instead of candidate.
5238 ((and (or (file-exists-p i) (string-match "\*" i))
5239 (anything-c-grep-recurse-p))
5240 (list (expand-file-name
5241 (directory-file-name ; Needed for windoze.
5242 (file-name-directory (directory-file-name i))))))
5243 ;; Candidate use wildcard.
5244 ((string-match "^\*" (anything-c-basename i))
5245 (file-expand-wildcards i t))
5246 ;; Else should be one or more file.
5247 (t (list i))) into all-files
5248 finally return
5249 (mapconcat 'shell-quote-argument all-files " "))))
5251 (defun anything-c-grep-recurse-p ()
5252 "Check if `anything-do-grep-1' have switched to recursive."
5253 (let ((args (replace-regexp-in-string
5254 "grep" "" anything-c-grep-default-command)))
5255 (string-match-p "r\\|recurse" args)))
5257 (defun anything-c-grep-init (only-files &optional include zgrep)
5258 "Start an asynchronous grep process in ONLY-FILES list."
5259 (let* ((fnargs (anything-c-grep-prepare-candidates
5260 (if (file-remote-p anything-ff-default-directory)
5261 (mapcar #'(lambda (x)
5262 (file-remote-p x 'localname))
5263 only-files)
5264 only-files)))
5265 (ignored-files (mapconcat
5266 #'(lambda (x)
5267 (concat "--exclude=" (shell-quote-argument x)))
5268 grep-find-ignored-files " "))
5269 (ignored-dirs (mapconcat
5270 ;; Need grep version >=2.5.4 of Gnuwin32 on windoze.
5271 #'(lambda (x)
5272 (concat "--exclude-dir=" (shell-quote-argument x)))
5273 grep-find-ignored-directories " "))
5274 (exclude (if (anything-c-grep-recurse-p)
5275 (concat (or include ignored-files) " " ignored-dirs)
5276 ignored-files))
5277 (cmd-line (format-spec
5278 anything-c-grep-default-command
5279 (delq nil
5280 (list (unless zgrep (cons ?e exclude))
5281 (cons ?p (shell-quote-argument anything-pattern))
5282 (cons ?f fnargs))))))
5283 (when anything-c-grep-debug-command-line
5284 (with-current-buffer (get-buffer-create "*any grep debug*")
5285 (goto-char (point-max))
5286 (insert (concat ">>> " cmd-line "\n\n"))))
5287 (setq mode-line-format
5288 '(" " mode-line-buffer-identification " "
5289 (line-number-mode "%l") " "
5290 (:eval (when (get-process "grep-process")
5291 (propertize "[Grep Process Running] "
5292 'face 'anything-grep-running)))))
5293 (force-mode-line-update nil)
5294 (prog1
5295 (let ((default-directory anything-ff-default-directory))
5296 (start-file-process-shell-command "grep-process" nil cmd-line))
5297 (message nil)
5298 (set-process-sentinel
5299 (get-process "grep-process")
5300 #'(lambda (process event)
5301 (when (string= event "finished\n")
5302 (with-anything-window
5303 (anything-update-move-first-line)
5304 (setq mode-line-format
5305 '(" " mode-line-buffer-identification " "
5306 (line-number-mode "%l") " "
5307 (:eval (propertize
5308 (format "[Grep Process Finished - (%s results)] "
5309 (let ((nlines (1- (count-lines
5310 (point-min)
5311 (point-max)))))
5312 (if (> nlines 0) nlines 0)))
5313 'face 'anything-grep-finish))))
5314 (force-mode-line-update nil))))))))
5316 (defun anything-c-grep-action (candidate &optional where mark)
5317 "Define a default action for `anything-do-grep' on CANDIDATE.
5318 WHERE can be one of other-window, elscreen, other-frame."
5319 (let* ((split (anything-c-grep-split-line candidate))
5320 (lineno (string-to-number (nth 1 split)))
5321 (loc-fname (car split))
5322 (tramp-method (file-remote-p anything-ff-default-directory 'method))
5323 (tramp-host (file-remote-p anything-ff-default-directory 'host))
5324 (tramp-prefix (concat "/" tramp-method ":" tramp-host ":"))
5325 (fname (if tramp-host
5326 (concat tramp-prefix loc-fname) loc-fname)))
5327 (case where
5328 (other-window (find-file-other-window fname))
5329 (elscreen (anything-elscreen-find-file fname))
5330 (other-frame (find-file-other-frame fname))
5331 (t (find-file fname)))
5332 (anything-goto-line lineno)
5333 (when mark
5334 (set-marker (mark-marker) (point))
5335 (push-mark (point) 'nomsg))
5336 ;; Save history
5337 (unless (or anything-in-persistent-action
5338 (string= anything-pattern ""))
5339 (setq anything-c-grep-history
5340 (cons anything-pattern
5341 (delete anything-pattern anything-c-grep-history)))
5342 (when (> (length anything-c-grep-history)
5343 anything-c-grep-max-length-history)
5344 (setq anything-c-grep-history
5345 (delete (car (last anything-c-grep-history))
5346 anything-c-grep-history))))))
5348 (defun anything-c-grep-other-window (candidate)
5349 "Jump to result in other window from anything grep."
5350 (anything-c-grep-action candidate 'other-window))
5352 (defun anything-c-grep-other-frame (candidate)
5353 "Jump to result in other frame from anything grep."
5354 (anything-c-grep-action candidate 'other-frame))
5356 (defun anything-c-grep-jump-elscreen (candidate)
5357 "Jump to result in elscreen from anything grep."
5358 (anything-c-grep-action candidate 'elscreen))
5360 (defun anything-c-grep-save-results (candidate)
5361 "Save anything grep result in a `grep-mode' buffer."
5362 (let ((buf "*grep*")
5363 new-buf)
5364 (when (get-buffer buf)
5365 (setq new-buf (read-string "GrepBufferName: " buf))
5366 (loop for b in (anything-c-buffer-list)
5367 when (and (string= new-buf b)
5368 (not (y-or-n-p
5369 (format "Buffer `%s' already exists overwrite? "
5370 new-buf))))
5371 do (setq new-buf (read-string "GrepBufferName: " "*grep ")))
5372 (setq buf new-buf))
5373 (with-current-buffer (get-buffer-create buf)
5374 (let ((inhibit-read-only t))
5375 (erase-buffer)
5376 (insert "-*- mode: grep -*-\n\n"
5377 (format "Grep Results for `%s':\n\n" anything-pattern))
5378 (save-excursion
5379 (insert (with-current-buffer anything-buffer
5380 (forward-line 1)
5381 (buffer-substring (point) (point-max))))
5382 (grep-mode))))
5383 (message "Anything Grep Results saved in `%s' buffer" buf)))
5385 (defun anything-c-grep-persistent-action (candidate)
5386 "Persistent action for `anything-do-grep'.
5387 With a prefix arg record CANDIDATE in `mark-ring'."
5388 (if current-prefix-arg
5389 (anything-c-grep-action candidate nil 'mark)
5390 (anything-c-grep-action candidate))
5391 (anything-match-line-color-current-line))
5393 (defun anything-c-grep-guess-extensions (files)
5394 "Try to guess file extensions in FILES list when using grep recurse.
5395 These extensions will be added to command line with --include arg of grep."
5396 (loop
5397 with glob-list = nil
5398 with lst = (if (file-directory-p (car files))
5399 (directory-files
5400 (car files) nil
5401 directory-files-no-dot-files-regexp)
5402 files)
5403 for i in lst
5404 for ext = (file-name-extension i t)
5405 for glob = (and ext (not (string= ext ""))
5406 (concat "*" ext))
5407 unless (or (not glob)
5408 (member glob glob-list)
5409 (member glob grep-find-ignored-files))
5410 collect glob into glob-list
5411 finally return glob-list))
5413 (defun anything-do-grep-1 (only &optional recurse zgrep)
5414 "Launch grep with a list of ONLY files.
5415 When RECURSE is given use -r option of grep and prompt user
5416 to set the --include args of grep.
5417 You can give more than one arg separated by space.
5418 e.g *.el *.py *.tex.
5419 If it's empty --exclude `grep-find-ignored-files' is used instead."
5420 (let* ((anything-compile-source-functions
5421 ;; rule out anything-match-plugin because the input is one regexp.
5422 (delq 'anything-compile-source--match-plugin
5423 (copy-sequence anything-compile-source-functions)))
5424 (exts (anything-c-grep-guess-extensions only))
5425 (globs (and (not zgrep) (mapconcat 'identity exts " ")))
5426 (include-files (and recurse (not zgrep)
5427 (read-string "OnlyExt(*.[ext]): "
5428 globs)))
5429 ;; Set `minibuffer-history' AFTER includes-files
5430 ;; to avoid storing wild-cards here.
5431 (minibuffer-history anything-c-grep-history)
5432 (anything-c-grep-default-command (cond ((and recurse zgrep) anything-c-default-zgrep-command)
5433 (recurse anything-c-grep-default-recurse-command)
5434 (zgrep anything-c-default-zgrep-command)
5435 (t anything-c-grep-default-command)))
5436 ;; Disable match-plugin and use here own highlighting.
5437 (anything-mp-highlight-delay nil))
5438 (when include-files
5439 (setq include-files
5440 (and (not (string= include-files ""))
5441 (mapconcat #'(lambda (x)
5442 (concat "--include=" (shell-quote-argument x)))
5443 (split-string include-files) " "))))
5444 ;; When called as action from an other source e.g *-find-files
5445 ;; we have to kill action buffer.
5446 (when (get-buffer anything-action-buffer)
5447 (kill-buffer anything-action-buffer))
5448 ;; `anything-find-files' haven't already started,
5449 ;; give a default value to `anything-ff-default-directory'.
5450 (setq anything-ff-default-directory (or anything-ff-default-directory
5451 default-directory))
5452 (anything
5453 :sources
5454 `(((name . "Grep")
5455 (header-name . (lambda (name)
5456 (concat name "(C-c ? Help)")))
5457 (candidates
5458 . (lambda ()
5459 (funcall anything-c-grep-default-function only include-files zgrep)))
5460 (filtered-candidate-transformer anything-c-grep-cand-transformer)
5461 (candidate-number-limit . 9999)
5462 (mode-line . anything-grep-mode-line-string)
5463 (keymap . ,anything-c-grep-map)
5464 (action . ,(delq
5466 `(("Find File" . anything-c-grep-action)
5467 ("Find file other frame" . anything-c-grep-other-frame)
5468 ,(and (locate-library "elscreen")
5469 '("Find file in Elscreen"
5470 . anything-c-grep-jump-elscreen))
5471 ("Save results in grep buffer" . anything-c-grep-save-results)
5472 ("Find file other window" . anything-c-grep-other-window))))
5473 (persistent-action . anything-c-grep-persistent-action)
5474 (persistent-help . "Jump to line (`C-u' Record in mark ring)")
5475 (requires-pattern . 3)
5476 (delayed)))
5477 :buffer "*anything grep*")))
5479 (defun anything-ff-zgrep-1 (flist recursive)
5480 (unwind-protect
5481 (let* ((def-dir (or anything-ff-default-directory
5482 default-directory))
5483 (only (if recursive
5484 (or (gethash def-dir anything-c-rzgrep-cache)
5485 (puthash
5486 def-dir
5487 (anything-c-walk-directory
5488 def-dir
5489 :directories nil
5490 :path 'full
5491 :match ".*\\(\.gz\\|\.bz\\|\.xz\\|\.lzma\\)$")
5492 anything-c-rzgrep-cache))
5493 flist)))
5494 (when recursive (setq anything-c-zgrep-recurse-flag t))
5495 (anything-do-grep-1 only recursive 'zgrep))
5496 (setq anything-c-zgrep-recurse-flag nil)))
5498 (defun anything-c-grep-split-line (line)
5499 "Split a grep output line."
5500 (let (beg fname lineno str)
5501 ;; Don't print until grep line is valid.
5502 (when (string-match "\\(.*\\)\\(:[0-9]+:\\)\\(.*\\)" line)
5503 (with-temp-buffer
5504 (insert line)
5505 (goto-char (point-min))
5506 (setq beg (point))
5507 (forward-char 2)
5508 (re-search-forward ":" nil t)
5509 (setq fname (buffer-substring-no-properties beg (1- (point))))
5510 (setq beg (point))
5511 (re-search-forward ":" nil t)
5512 (setq lineno (buffer-substring-no-properties beg (1- (point))))
5513 (setq str (buffer-substring-no-properties (point) (point-at-eol))))
5514 (list fname lineno str))))
5516 (defun anything-c-grep-cand-transformer (candidates sources)
5517 "Filtered candidate transformer function for `anything-do-grep'."
5518 (loop for i in candidates
5519 for split = (and i (anything-c-grep-split-line i))
5520 for fname = (car split)
5521 for lineno = (nth 1 split)
5522 for str = (nth 2 split)
5523 when (and fname lineno str)
5524 collect
5525 (cons (concat (propertize (file-name-nondirectory fname)
5526 'face 'anything-grep-file
5527 'help-echo fname) ":"
5528 (propertize lineno 'face 'anything-grep-lineno) ":"
5529 (anything-c-grep-highlight-match str))
5530 i)))
5532 (defun anything-c-grep-highlight-match (str)
5533 "Highlight in string STR all occurences matching `anything-pattern'."
5534 (condition-case nil
5535 (with-temp-buffer
5536 (insert str)
5537 (goto-char (point-min))
5538 (while (and (re-search-forward anything-pattern nil t)
5539 (> (- (match-end 0) (match-beginning 0)) 0))
5540 (add-text-properties
5541 (match-beginning 0) (match-end 0)
5542 '(face anything-grep-match)))
5543 (buffer-string))
5544 (error nil)))
5546 ;; Go to next or precedent file (common to etags and grep).
5547 (defun anything-c-goto-next-or-prec-file (n)
5548 "Go to next or precedent candidate file in anything grep/etags buffers.
5549 If N is positive go forward otherwise go backward."
5550 (with-anything-window
5551 (let* ((current-line-list (split-string
5552 (buffer-substring
5553 (point-at-bol)
5554 (point-at-eol)) ":"))
5555 (current-fname (nth 0 current-line-list))
5556 (fn-b-o-f (if (eq n 1) 'eobp 'bobp)))
5557 (catch 'break
5558 (while (not (funcall fn-b-o-f))
5559 (forward-line n) ; Go forward or backward depending of n value.
5560 (unless (search-forward current-fname (point-at-eol) t)
5561 (anything-mark-current-line)
5562 (throw 'break nil))))
5563 (cond ((and (eq n 1) (eobp))
5564 (re-search-backward ".")
5565 (forward-line 0)
5566 (anything-mark-current-line))
5567 ((and (< n 1) (bobp))
5568 (forward-line 1)
5569 (anything-mark-current-line))))))
5571 ;;;###autoload
5572 (defun anything-c-goto-precedent-file ()
5573 "Go to precedent file in anything grep/etags buffers."
5574 (interactive)
5575 (anything-c-goto-next-or-prec-file -1))
5577 ;;;###autoload
5578 (defun anything-c-goto-next-file ()
5579 "Go to precedent file in anything grep/etags buffers."
5580 (interactive)
5581 (anything-c-goto-next-or-prec-file 1))
5583 ;;;###autoload
5584 (defun anything-c-grep-run-persistent-action ()
5585 "Run grep persistent action from `anything-do-grep-1'."
5586 (interactive)
5587 (anything-attrset 'jump-persistent 'anything-c-grep-persistent-action)
5588 (anything-execute-persistent-action 'jump-persistent))
5590 ;;;###autoload
5591 (defun anything-c-grep-run-default-action ()
5592 "Run grep default action from `anything-do-grep-1'."
5593 (interactive)
5594 (anything-c-quit-and-execute-action 'anything-c-grep-action))
5596 ;;;###autoload
5597 (defun anything-c-grep-run-other-window-action ()
5598 "Run grep goto other window action from `anything-do-grep-1'."
5599 (interactive)
5600 (anything-c-quit-and-execute-action 'anything-c-grep-other-window))
5602 ;;;###autoload
5603 (defun anything-c-grep-run-save-buffer ()
5604 "Run grep save results action from `anything-do-grep-1'."
5605 (interactive)
5606 (anything-c-quit-and-execute-action 'anything-c-grep-save-results))
5608 ;; Grep buffers
5609 (defun anything-c-grep-buffers-1 (candidate &optional zgrep)
5610 "Run grep on all file--buffers or CANDIDATE if it is a file--buffer.
5611 If one of selected buffers is not a file--buffer,
5612 it is ignored and grep will run on all others file--buffers.
5613 If only one candidate is selected and it is not a file--buffer,
5614 switch to this buffer and run `anything-occur'.
5615 If a prefix arg is given run grep on all buffers ignoring non--file-buffers."
5616 (let* ((prefarg (or current-prefix-arg anything-current-prefix-arg))
5617 (cands (if prefarg
5618 (buffer-list)
5619 (anything-marked-candidates)))
5620 (win-conf (current-window-configuration))
5621 ;; Non--fname buffers are ignored.
5622 (bufs (loop for buf in cands
5623 for fname = (buffer-file-name (get-buffer buf))
5624 when fname
5625 collect (expand-file-name fname))))
5626 (if bufs
5627 (if zgrep
5628 (anything-do-grep-1 bufs nil 'zgrep)
5629 (anything-do-grep-1 bufs))
5630 ;; bufs is empty, thats mean we have only CANDIDATE
5631 ;; and it is not a buffer-filename, fallback to occur.
5632 (anything-c-switch-to-buffer candidate)
5633 (when (get-buffer anything-action-buffer)
5634 (kill-buffer anything-action-buffer))
5635 (anything-occur)
5636 (when (eq anything-exit-status 1)
5637 (set-window-configuration win-conf)))))
5639 (defun anything-c-grep-buffers (candidate)
5640 "Action to grep buffers."
5641 (anything-c-grep-buffers-1 candidate))
5643 (defun anything-c-zgrep-buffers (candidate)
5644 "Action to zgrep buffers."
5645 (anything-c-grep-buffers-1 candidate 'zgrep))
5648 ;;; Anything interface for pdfgrep
5649 ;; pdfgrep program <http://pdfgrep.sourceforge.net/>
5650 ;; and a pdf-reader (e.g xpdf) are needed.
5652 (defvar anything-c-pdfgrep-default-command "pdfgrep --color never -niH %s %s")
5653 (defvar anything-c-pdfgrep-default-function 'anything-c-pdfgrep-init)
5654 (defvar anything-c-pdfgrep-debug-command-line nil)
5656 (defun anything-c-pdfgrep-init (only-files)
5657 "Start an asynchronous pdfgrep process in ONLY-FILES list."
5658 (let* ((fnargs (anything-c-grep-prepare-candidates
5659 (if (file-remote-p anything-ff-default-directory)
5660 (mapcar #'(lambda (x)
5661 (file-remote-p x 'localname))
5662 only-files)
5663 only-files)))
5664 (cmd-line (format anything-c-pdfgrep-default-command
5665 anything-pattern
5666 fnargs)))
5667 (when anything-c-pdfgrep-debug-command-line
5668 (with-current-buffer (get-buffer-create "*any pdfgrep debug*")
5669 (goto-char (point-max))
5670 (insert (concat ">>> " cmd-line "\n\n"))))
5671 (setq mode-line-format
5672 '(" " mode-line-buffer-identification " "
5673 (line-number-mode "%l") " "
5674 (:eval (propertize "(Pdfgrep Process Running) "
5675 'face '((:foreground "red"))))))
5676 (prog1
5677 (let ((default-directory anything-ff-default-directory))
5678 (start-file-process-shell-command "pdfgrep-process" nil cmd-line))
5679 (message nil)
5680 (set-process-sentinel
5681 (get-process "pdfgrep-process")
5682 #'(lambda (process event)
5683 (when (string= event "finished\n")
5684 (with-anything-window
5685 (anything-update-move-first-line))
5686 (force-mode-line-update nil)))))))
5689 (defun anything-do-pdfgrep-1 (only)
5690 "Launch pdfgrep with a list of ONLY files."
5691 (unless (executable-find "pdfgrep")
5692 (error "Error: No such program `pdfgrep'."))
5693 (let* ((anything-compile-source-functions
5694 ;; rule out anything-match-plugin because the input is one regexp.
5695 (delq 'anything-compile-source--match-plugin
5696 (copy-sequence anything-compile-source-functions)))
5697 ;; Disable match-plugin and use here own highlighting.
5698 (anything-mp-highlight-delay nil))
5699 ;; When called as action from an other source e.g *-find-files
5700 ;; we have to kill action buffer.
5701 (when (get-buffer anything-action-buffer)
5702 (kill-buffer anything-action-buffer))
5703 ;; If `anything-find-files' haven't already started,
5704 ;; give a default value to `anything-ff-default-directory'.
5705 (setq anything-ff-default-directory (or anything-ff-default-directory
5706 default-directory))
5707 (anything
5708 :sources
5709 `(((name . "PdfGrep")
5710 (candidates
5711 . (lambda ()
5712 (funcall anything-c-pdfgrep-default-function only)))
5713 (filtered-candidate-transformer anything-c-grep-cand-transformer)
5714 (candidate-number-limit . 9999)
5715 (mode-line . anything-pdfgrep-mode-line-string)
5716 (action . anything-c-pdfgrep-action)
5717 (persistent-help . "Jump to PDF Page")
5718 (requires-pattern . 3)
5719 (delayed)))
5720 :keymap anything-c-pdfgrep-map
5721 :buffer "*anything grep*")))
5724 (defun anything-c-pdfgrep-action (candidate)
5725 (let* ((split (anything-c-grep-split-line candidate))
5726 (pageno (nth 1 split))
5727 (fname (car split)))
5728 (start-file-process-shell-command
5729 "pdf-reader" nil
5730 (format-spec anything-c-pdfgrep-default-read-command
5731 (list (cons ?f fname) (cons ?p pageno))))))
5734 ;; Yank text at point.
5737 ;; Internal
5738 (defvar anything-yank-point nil)
5740 ;;;###autoload
5741 (defun anything-yank-text-at-point ()
5742 "Yank text at point in minibuffer."
5743 (interactive)
5744 (let (input)
5745 (flet ((insert-in-minibuffer (word)
5746 (with-selected-window (minibuffer-window)
5747 (let ((str anything-pattern))
5748 (delete-minibuffer-contents)
5749 (set-text-properties 0 (length word) nil word)
5750 (insert (concat str word))))))
5751 (with-anything-current-buffer
5752 ;; Start to initial point if C-w have never been hit.
5753 (unless anything-yank-point (setq anything-yank-point (point)))
5754 (and anything-yank-point (goto-char anything-yank-point))
5755 (forward-word 1)
5756 (setq input (buffer-substring-no-properties anything-yank-point (point)))
5757 (setq anything-yank-point (point))) ; End of last forward-word
5758 (insert-in-minibuffer input))))
5760 (defun anything-reset-yank-point ()
5761 (setq anything-yank-point nil))
5763 (add-hook 'anything-after-persistent-action-hook 'anything-reset-yank-point)
5764 (add-hook 'anything-cleanup-hook 'anything-reset-yank-point)
5767 ;;; Recentf files
5770 (defvar anything-c-source-recentf
5771 `((name . "Recentf")
5772 (init . (lambda ()
5773 (require 'recentf)
5774 (or recentf-mode (recentf-mode 1))))
5775 ;; Needed for filenames with capitals letters.
5776 (disable-shortcuts)
5777 (candidates . recentf-list)
5778 (keymap . ,anything-generic-files-map)
5779 (help-message . anything-generic-file-help-message)
5780 (mode-line . anything-generic-file-mode-line-string)
5781 (match anything-c-match-on-basename)
5782 (type . file))
5783 "See (info \"(emacs)File Conveniences\").
5784 Set `recentf-max-saved-items' to a bigger value if default is too small.")
5786 ;;; ffap
5787 (eval-when-compile (require 'ffap))
5788 (defvar anything-c-source-ffap-guesser
5789 `((name . "File at point")
5790 (init . (lambda () (require 'ffap)))
5791 (candidates . (lambda ()
5792 (anything-aif
5793 (with-anything-current-buffer
5794 (ffap-guesser))
5795 (list it))))
5796 (keymap . ,anything-generic-files-map)
5797 (help-message . anything-generic-file-help-message)
5798 (mode-line . anything-generic-file-mode-line-string)
5799 (type . file)))
5801 ;;; ffap with line number
5802 (defun anything-c-ffap-file-line-at-point ()
5803 "Get (FILENAME . LINENO) at point."
5804 (anything-aif (let (ffap-alist) (ffap-file-at-point))
5805 (save-excursion
5806 (beginning-of-line)
5807 (when (and (search-forward it nil t)
5808 (looking-at ":\\([0-9]+\\)"))
5809 (cons it (string-to-number (match-string 1)))))))
5811 (defun anything-c-ffap-line-candidates ()
5812 (with-anything-current-buffer
5813 (anything-attrset 'ffap-line-location (anything-c-ffap-file-line-at-point)))
5814 (anything-aif (anything-attr 'ffap-line-location)
5815 (destructuring-bind (file . line) it
5816 (list (cons (format "%s (line %d)" file line) file)))))
5818 ;;; Goto line after opening file by `anything-c-source-ffap-line'.
5819 (defun anything-c-ffap-line-goto-line ()
5820 (when (car (anything-attr 'ffap-line-location))
5821 (unwind-protect
5822 (ignore-errors
5823 (with-selected-window
5824 (get-buffer-window
5825 (get-file-buffer (car (anything-attr 'ffap-line-location))))
5826 (anything-goto-line (cdr (anything-attr 'ffap-line-location)))))
5827 (anything-attrset 'ffap-line-location nil))))
5828 (add-hook 'anything-after-action-hook 'anything-c-ffap-line-goto-line)
5829 (add-hook 'anything-after-persistent-action-hook 'anything-c-ffap-line-goto-line)
5831 (defvar anything-c-source-ffap-line
5832 `((name . "File/Lineno at point")
5833 (init . (lambda () (require 'ffap)))
5834 (candidates . anything-c-ffap-line-candidates)
5835 (keymap . ,anything-map)
5836 (type . file)))
5838 ;;; list of files gleaned from every dired buffer
5839 (defun anything-c-files-in-all-dired-candidates ()
5840 (save-excursion
5841 (mapcan
5842 (lambda (dir)
5843 (cond ((listp dir) ;filelist
5844 dir)
5845 ((equal "" (file-name-nondirectory dir)) ;dir
5846 (directory-files dir t))
5847 (t ;wildcard
5848 (file-expand-wildcards dir t))))
5849 (delq nil
5850 (mapcar (lambda (buf)
5851 (set-buffer buf)
5852 (when (eq major-mode 'dired-mode)
5853 (if (consp dired-directory)
5854 (cdr dired-directory) ;filelist
5855 dired-directory))) ;dir or wildcard
5856 (buffer-list))))))
5857 ;; (dired '("~/" "~/.emacs-custom.el" "~/.emacs.bmk"))
5859 (defvar anything-c-source-files-in-all-dired
5860 '((name . "Files in all dired buffer.")
5861 (candidates . anything-c-files-in-all-dired-candidates)
5862 (type . file)))
5864 (defvar anything-c-source-filelist
5865 '((name . "FileList")
5866 (grep-candidates . anything-c-filelist-file-name)
5867 (candidate-number-limit . 200)
5868 (requires-pattern . 4)
5869 (type . file))
5870 "Source to find files instantly.
5871 See `anything-c-filelist-file-name' docstring for usage.")
5874 ;;;; <info>
5875 ;;; Info pages
5876 (defvar anything-c-info-pages nil
5877 "All info pages on system.
5878 Will be calculated the first time you invoke anything with this
5879 source.")
5881 (defun anything-c-info-pages-init ()
5882 "Collect candidates for initial Info node Top."
5883 (if anything-c-info-pages
5884 anything-c-info-pages
5885 (let ((info-topic-regexp "\\* +\\([^:]+: ([^)]+)[^.]*\\)\\.")
5886 topics)
5887 (require 'info)
5888 (with-temp-buffer
5889 (Info-find-node "dir" "top")
5890 (goto-char (point-min))
5891 (while (re-search-forward info-topic-regexp nil t)
5892 (push (match-string-no-properties 1) topics))
5893 (kill-buffer))
5894 (setq anything-c-info-pages topics))))
5896 (defvar anything-c-source-info-pages
5897 `((name . "Info Pages")
5898 (init . anything-c-info-pages-init)
5899 (candidates . anything-c-info-pages)
5900 (action . (("Show with Info" .(lambda (node-str)
5901 (info (replace-regexp-in-string
5902 "^[^:]+: " "" node-str))))))
5903 (requires-pattern . 2)))
5906 ;;; Man and woman UI
5909 (defvar anything-c-man-pages nil
5910 "All man pages on system.
5911 Will be calculated the first time you invoke anything with this
5912 source.")
5914 (defun anything-c-man-default-action (candidate)
5915 "Default action for jumping to a woman or man page from anything."
5916 (let ((wfiles (woman-file-name-all-completions candidate)))
5917 (condition-case err
5918 (if (> (length wfiles) 1)
5919 (woman-find-file
5920 (anything-comp-read
5921 "ManFile: " wfiles :must-match t))
5922 (woman candidate))
5923 ;; If woman is unable to format correctly
5924 ;; use man instead.
5925 (error (kill-buffer) ; Kill woman buffer.
5926 (let ((Man-notify-method 'meek))
5927 (Man-getpage-in-background candidate))))))
5929 (defvar anything-c-source-man-pages
5930 `((name . "Manual Pages")
5931 (candidates . (lambda ()
5932 (if anything-c-man-pages
5933 anything-c-man-pages
5934 ;; XEmacs doesn't have a woman :)
5935 (setq anything-c-man-pages
5936 (ignore-errors
5937 (require 'woman)
5938 (woman-file-name "")
5939 (sort (mapcar 'car woman-topic-all-completions)
5940 'string-lessp))))))
5941 (action ("Show with Woman" . anything-c-man-default-action))
5942 ;; Woman does not work OS X
5943 ;; http://xahlee.org/emacs/modernization_man_page.html
5944 (action-transformer . (lambda (actions candidate)
5945 (if (eq system-type 'darwin)
5946 '(("Show with Man" . man))
5947 actions)))
5948 (requires-pattern . 2)))
5951 ;;;; <Command>
5952 ;;; Anything M-x - Enhanced M-x UI
5955 ;; Another replacement of `M-x' that act exactly like the
5956 ;; vanilla Emacs one, no problem of windows configuration, prefix args
5957 ;; can be passed before calling `M-x' (e.g C-u M-x..) but also during
5958 ;; anything invocation.
5959 ;; Documentation of commands available without quitting,
5960 ;; Show keybindings of commands.
5961 ;; Show history.
5962 (defvar anything-M-x-input-history nil)
5964 (defun* anything-M-x-get-major-mode-command-alist (mode-map)
5965 "Return alist of MODE-MAP."
5966 (loop for key being the key-seqs of mode-map using (key-bindings com)
5967 for str-key = (key-description key)
5968 for ismenu = (string-match "<menu-bar>" str-key)
5969 unless ismenu collect (cons str-key com)))
5971 (defun anything-get-mode-map-from-mode (mode)
5972 "Guess the mode-map name according to MODE.
5973 Some modes don't use conventional mode-map name
5974 so we need to guess mode-map name. e.g python-mode ==> py-mode-map.
5975 Return nil if no mode-map found."
5976 (loop
5977 ;; Start with a conventional mode-map name.
5978 with mode-map = (intern-soft (format "%s-map" mode))
5979 with mode-string = (symbol-name mode)
5980 with mode-name = (replace-regexp-in-string "-mode" "" mode-string)
5981 while (not mode-map)
5982 for count downfrom (length mode-name)
5983 ;; Return when no result after parsing entire string.
5984 when (eq count 0) return nil
5985 for sub-name = (substring mode-name 0 count)
5986 do (setq mode-map (intern-soft (format "%s-map" (concat sub-name "-mode"))))
5987 finally return mode-map))
5989 (defun anything-M-x-current-mode-map-alist ()
5990 "Return mode-map alist of current `major-mode'."
5991 (let ((map (anything-get-mode-map-from-mode major-mode)))
5992 (when (and map (boundp map))
5993 (anything-M-x-get-major-mode-command-alist (symbol-value map)))))
5996 (defun anything-M-x-transformer (candidates sources)
5997 "filtered-candidate-transformer to show bindings in emacs commands.
5998 Show global bindings and local bindings according to current `major-mode'."
5999 (with-anything-current-buffer
6000 (loop
6001 with local-map = (anything-M-x-current-mode-map-alist)
6002 for cand in candidates
6003 for local-key = (car (rassq cand local-map))
6004 for key = (substitute-command-keys (format "\\[%s]" cand))
6005 collect
6006 (cons (cond ((and (string-match "^M-x" key) local-key)
6007 (format "%s (%s)"
6008 cand (propertize
6009 local-key
6010 'face 'anything-M-x-key-face)))
6011 ((string-match "^M-x" key) cand)
6012 (t (format "%s (%s)"
6013 cand (propertize
6015 'face 'anything-M-x-key-face))))
6016 cand) into ls
6017 finally return
6018 (sort ls #'(lambda (x y) (string-lessp (car x) (car y)))))))
6021 ;;; Complex command history
6024 (defvar anything-c-source-complex-command-history
6025 '((name . "Complex Command History")
6026 (candidates . (lambda () (mapcar 'prin1-to-string command-history)))
6027 (type . sexp)))
6029 ;;; M-x history (not related to `anything-M-x')
6032 (defvar anything-c-source-extended-command-history
6033 '((name . "Emacs Commands History")
6034 (candidates
6035 . (lambda ()
6036 (anything-fast-remove-dups extended-command-history :test 'equal)))
6037 (type . command)))
6039 ;;; Emacs commands (Basic source for emacs commands)
6042 (defvar anything-c-source-emacs-commands
6043 '((name . "Emacs Commands")
6044 (candidates . (lambda ()
6045 (let (commands)
6046 (mapatoms (lambda (a)
6047 (if (commandp a)
6048 (push (symbol-name a)
6049 commands))))
6050 (sort commands 'string-lessp))))
6051 (type . command)
6052 (requires-pattern . 2))
6053 "Source for completing and invoking Emacs commands.
6054 A command is a function with interactive spec that can
6055 be invoked with `M-x'.
6057 To get non-interactive functions listed, use
6058 `anything-c-source-emacs-functions'.")
6061 ;;;; <Function>
6062 ;;; Emacs functions
6065 (defvar anything-c-source-emacs-functions
6066 '((name . "Emacs Functions")
6067 (candidates . (lambda ()
6068 (let (commands)
6069 (mapatoms (lambda (a)
6070 (if (functionp a)
6071 (push (symbol-name a) commands))))
6072 (sort commands 'string-lessp))))
6073 (type . function)
6074 (requires-pattern . 2))
6075 "Source for completing Emacs functions.")
6077 ;;; With abbrev expansion
6078 ;;; Similar to my exec-abbrev-cmd.el
6079 ;;; See http://www.tsdh.de/cgi-bin/wiki.pl/exec-abbrev-cmd.el
6080 (defvar anything-c-function-abbrev-regexp nil
6081 "The regexp for `anything-c-source-emacs-functions-with-abbrevs'.
6082 Regexp built from the current `anything-pattern' interpreting it
6083 as abbreviation.
6084 Only for internal use.")
6086 (defun anything-c-match-function-by-abbrev (candidate)
6087 "Return non-nil if `anything-pattern' is an abbreviation of the function CANDIDATE.
6089 Abbreviations are made by taking the first character from each
6090 word in the function's name, e.g. \"bb\" is an abbrev for
6091 `bury-buffer', \"stb\" is an abbrev for `anything-c-switch-to-buffer'."
6092 (string-match anything-c-function-abbrev-regexp candidate))
6094 (defvar anything-c-source-emacs-functions-with-abbrevs
6095 (append anything-c-source-emacs-functions
6096 '((match anything-c-match-function-by-abbrev
6097 anything-c-string-match))
6098 '((init
6099 . (lambda ()
6100 (defadvice anything-update
6101 (before anything-c-update-function-abbrev-regexp activate)
6102 (let ((char-list (append anything-pattern nil))
6103 (str "^"))
6104 (dolist (c char-list)
6105 (setq str (concat str (list c) "[^-]*-")))
6106 (setq str (concat (substring str 0 (1- (length str))) "$"))
6107 (setq anything-c-function-abbrev-regexp str))))))))
6109 (defvar anything-c-source-advice
6110 '((name . "Function Advice")
6111 (candidates . anything-c-advice-candidates)
6112 (action ("Toggle Enable/Disable" . anything-c-advice-toggle))
6113 (persistent-action . anything-c-advice-persistent-action)
6114 (multiline)
6115 (persistent-help . "Describe function / C-u C-z: Toggle advice")))
6116 ;; (let ((debug-on-signal t))(anything 'anything-c-source-advice))
6117 ;; (testadvice)
6119 (defun anything-c-advice-candidates ()
6120 (require 'advice)
6121 (loop for (fname) in ad-advised-functions
6122 for function = (intern fname)
6123 append
6124 (loop for class in ad-advice-classes append
6125 (loop for advice in (ad-get-advice-info-field function class)
6126 for enabled = (ad-advice-enabled advice)
6127 collect
6128 (cons (format
6129 "%s %s %s"
6130 (if enabled "Enabled " "Disabled")
6131 (propertize fname 'face 'font-lock-function-name-face)
6132 (ad-make-single-advice-docstring advice class nil))
6133 (list function class advice))))))
6135 (defun anything-c-advice-persistent-action (func-class-advice)
6136 (if current-prefix-arg
6137 (anything-c-advice-toggle func-class-advice)
6138 (describe-function (car func-class-advice))))
6140 (defun anything-c-advice-toggle (func-class-advice)
6141 (destructuring-bind (function class advice) func-class-advice
6142 (cond ((ad-advice-enabled advice)
6143 (ad-advice-set-enabled advice nil)
6144 (message "Disabled"))
6145 (t ;disabled
6146 (ad-advice-set-enabled advice t)
6147 (message "Enabled")))
6148 (ad-activate function)
6149 (and anything-in-persistent-action
6150 (anything-c-advice-update-current-display-string))))
6152 (defun anything-c-advice-update-current-display-string ()
6153 (anything-edit-current-selection
6154 (let ((newword (cond ((looking-at "Disabled") "Enabled")
6155 ((looking-at "Enabled") "Disabled")))
6156 realvalue)
6157 (when newword
6158 (delete-region (point) (progn (forward-word 1) (point)))
6159 (insert newword)))))
6162 ;;;; <Variable>
6163 ;;; Emacs variables
6166 (defvar anything-c-source-emacs-variables
6167 '((name . "Emacs Variables")
6168 (candidates . (lambda ()
6169 (sort (all-completions "" obarray 'boundp) 'string-lessp)))
6170 (type . variable)
6171 (requires-pattern . 2))
6172 "Source for completing Emacs variables.")
6175 ;;; LaCarte
6176 (defvar anything-c-source-lacarte
6177 '((name . "Lacarte")
6178 (init . (lambda () (require 'lacarte )))
6179 (candidates . (lambda () (delete '(nil) (lacarte-get-overall-menu-item-alist))))
6180 (candidate-number-limit . 9999)
6181 (action . anything-c-call-interactively))
6182 "Needs lacarte.el.
6184 http://www.emacswiki.org/cgi-bin/wiki/download/lacarte.el")
6187 ;;; Bookmarks
6190 ;; Bind some faces for bookmarks.
6191 (defvar anything-c-bookmarks-face1 'anything-ff-directory)
6192 (defvar anything-c-bookmarks-face2 'anything-ff-file)
6193 (defvar anything-c-bookmarks-face3 'anything-bookmarks-su-face)
6195 (eval-when-compile (require 'bookmark))
6196 (defvar anything-c-source-bookmarks
6197 `((name . "Bookmarks")
6198 (init . (lambda ()
6199 (require 'bookmark)))
6200 (candidates . bookmark-all-names)
6201 (type . bookmark))
6202 "See (info \"(emacs)Bookmarks\").")
6204 ;;; bookmark-set
6205 (defvar anything-c-source-bookmark-set
6206 '((name . "Set Bookmark")
6207 (dummy)
6208 (action . bookmark-set))
6209 "See (info \"(emacs)Bookmarks\").")
6211 ;;; Visible Bookmarks
6212 ;; (install-elisp "http://cvs.savannah.gnu.org/viewvc/*checkout*/bm/bm/bm.el")
6215 ;; http://d.hatena.ne.jp/grandVin/20080911/1221114327
6216 (defvar anything-c-source-bm
6217 '((name . "Visible Bookmarks")
6218 (init . anything-c-bm-init)
6219 (candidates-in-buffer)
6220 (type . line))
6221 "Needs bm.el.
6223 http://www.nongnu.org/bm/")
6225 (defun anything-c-bm-init ()
6226 "Init function for `anything-c-source-bm'."
6227 (when (require 'bm nil t)
6228 (with-no-warnings
6229 (let ((bookmarks (bm-lists))
6230 (buf (anything-candidate-buffer 'global)))
6231 (dolist (bm (sort* (append (car bookmarks) (cdr bookmarks))
6232 '< :key 'overlay-start))
6233 (let ((start (overlay-start bm))
6234 (end (overlay-end bm))
6235 (annotation (or (overlay-get bm 'annotation) "")))
6236 (unless (< (- end start) 1) ; org => (if (< (- end start) 2)
6237 (let ((str (format "%5d: [%s]: %s\n"
6238 (line-number-at-pos start)
6239 annotation
6240 (buffer-substring start (1- end)))))
6241 (with-current-buffer buf (insert str))))))))))
6243 ;;; Special bookmarks
6244 (defvar anything-c-source-bookmarks-ssh
6245 '((name . "Bookmarks-ssh")
6246 (init . (lambda ()
6247 (require 'bookmark)))
6248 (candidates . (lambda () (anything-c-collect-bookmarks :ssh t)))
6249 (type . bookmark))
6250 "See (info \"(emacs)Bookmarks\").")
6252 (defvar anything-c-source-bookmarks-su
6253 '((name . "Bookmarks-root")
6254 (init . (lambda ()
6255 (require 'bookmark)))
6256 (candidates . (lambda () (anything-c-collect-bookmarks :su t)))
6257 (filtered-candidate-transformer anything-c-highlight-bookmark-su)
6259 (type . bookmark))
6260 "See (info \"(emacs)Bookmarks\").")
6262 (defvar anything-c-source-bookmarks-local
6263 '((name . "Bookmarks-Local")
6264 (init . (lambda ()
6265 (require 'bookmark)))
6266 (candidates . (lambda () (anything-c-collect-bookmarks :local t)))
6267 (filtered-candidate-transformer
6268 anything-c-adaptive-sort
6269 anything-c-highlight-bookmark)
6270 (type . bookmark))
6271 "See (info \"(emacs)Bookmarks\").")
6273 (defun* anything-c-collect-bookmarks (&key local su sudo ssh)
6274 (let* ((lis-all (bookmark-all-names))
6275 (lis-loc (cond (local (loop for i in lis-all
6276 unless (string-match "^(ssh)\\|^(su)" i)
6277 collect i))
6278 (su (loop for i in lis-all
6279 when (string-match "^(su)" i)
6280 collect i))
6281 (sudo (loop for i in lis-all
6282 when (string-match "^(sudo)" i)
6283 collect i))
6284 (ssh (loop for i in lis-all
6285 when (string-match "^(ssh)" i)
6286 collect i)))))
6287 (sort lis-loc 'string-lessp)))
6289 (defun anything-c-bookmark-root-logged-p ()
6290 (catch 'break
6291 (dolist (i (mapcar #'buffer-name (buffer-list)))
6292 (when (string-match (format "*tramp/%s ." anything-su-or-sudo) i)
6293 (throw 'break t)))))
6295 (defun anything-c-highlight-bookmark-su (files source)
6296 (if (anything-c-bookmark-root-logged-p)
6297 (anything-c-highlight-bookmark files source)
6298 (anything-c-highlight-not-logged files source)))
6300 (defun anything-c-highlight-not-logged (files source)
6301 (loop for i in files
6302 collect (propertize i 'face anything-c-bookmarks-face3)))
6304 (defun anything-c-highlight-bookmark (bookmarks source)
6305 "Used as `candidate-transformer' to colorize bookmarks.
6306 Work both with standard Emacs bookmarks and bookmark-extensions.el."
6307 (loop for i in bookmarks
6308 for isfile = (bookmark-get-filename i)
6309 for bufp = (and (fboundp 'bmkext-get-buffer-name)
6310 (bmkext-get-buffer-name i))
6311 for handlerp = (and (fboundp 'bookmark-get-handler)
6312 (bookmark-get-handler i))
6313 for isw3m = (and (fboundp 'bmkext-w3m-bookmark-p)
6314 (bmkext-w3m-bookmark-p i))
6315 for isgnus = (and (fboundp 'bmkext-gnus-bookmark-p)
6316 (bmkext-gnus-bookmark-p i))
6317 for isman = (and (fboundp 'bmkext-man-bookmark-p) ; Man
6318 (bmkext-man-bookmark-p i))
6319 for iswoman = (and (fboundp 'bmkext-woman-bookmark-p) ; Woman
6320 (bmkext-woman-bookmark-p i))
6321 for handlerp = (bookmark-get-handler i)
6322 for isannotation = (bookmark-get-annotation i)
6323 for isabook = (string= (bookmark-prop-get i 'type) "addressbook")
6324 for isinfo = (eq handlerp 'Info-bookmark-jump)
6325 ;; Add a * if bookmark have annotation
6326 if (and isannotation (not (string-equal isannotation "")))
6327 do (setq i (concat "*" i))
6328 collect (cond (;; info buffers
6329 isinfo
6330 (propertize i 'face 'anything-bmkext-info 'help-echo isfile))
6331 (;; w3m buffers
6332 isw3m
6333 (propertize i 'face 'anything-bmkext-w3m 'help-echo isfile))
6334 (;; gnus buffers
6335 isgnus
6336 (propertize i 'face 'anything-bmkext-gnus 'help-echo isfile))
6337 (;; Man Woman
6338 (or iswoman isman)
6339 (propertize i 'face 'anything-bmkext-man 'help-echo isfile))
6340 (;; Addressbook
6341 isabook
6342 (propertize i 'face '((:foreground "Tomato"))))
6343 (;; directories
6344 (and isfile (file-directory-p isfile))
6345 (propertize i 'face anything-c-bookmarks-face1 'help-echo isfile))
6346 (;; regular files
6348 (propertize i 'face 'anything-bmkext-file 'help-echo isfile)))))
6350 (defun anything-c-bookmark-jump (candidate)
6351 "Jump to bookmark from keyboard."
6352 (let ((current-prefix-arg anything-current-prefix-arg))
6353 (bookmark-jump candidate)))
6355 ;;;###autoload
6356 (defun anything-c-bookmark-run-jump-other-window ()
6357 "Jump to bookmark from keyboard."
6358 (interactive)
6359 (anything-c-quit-and-execute-action 'bookmark-jump-other-window))
6361 ;;;###autoload
6362 (defun anything-c-bookmark-run-delete ()
6363 "Delete bookmark from keyboard."
6364 (interactive)
6365 (when (y-or-n-p "Delete bookmark?")
6366 (anything-c-quit-and-execute-action 'anything-delete-marked-bookmarks)))
6369 ;;; Sources to filter bookmark-extensions bookmarks.
6372 ;; Dependency: http://mercurial.intuxication.org/hg/emacs-bookmark-extension
6373 ;; If you want to enable google-maps in addressbook you will need
6374 ;; Julien Danjou google-maps-el package available here:
6375 ;; http://julien.danjou.info/google-maps-el.html
6377 (defun anything-c-bmkext-filter-setup-alist (fn &rest args)
6378 "Return a filtered `bookmark-alist' sorted alphabetically."
6379 (loop
6380 with alist = (if args
6381 (apply #'(lambda (x) (funcall fn x)) args)
6382 (funcall fn))
6383 for i in alist
6384 for b = (car i)
6385 collect b into sa
6386 finally return (sort sa 'string-lessp)))
6388 ;;;###autoload
6389 (defun anything-c-bmkext-run-edit ()
6390 "Run `bmkext-edit-bookmark' from keyboard."
6391 (interactive)
6392 (anything-c-quit-and-execute-action 'bmkext-edit-bookmark))
6394 ;;; Addressbook.
6397 (defvar anything-c-source-bmkext-addressbook
6398 '((name . "Bookmark Addressbook")
6399 (init . (lambda ()
6400 (require 'bookmark-extensions)
6401 (bookmark-maybe-load-default-file)))
6402 (candidates . anything-c-bmkext-addressbook-setup-alist)
6403 (persistent-action
6404 . (lambda (candidate)
6405 (let ((bmk (anything-bookmark-get-bookmark-from-name
6406 candidate)))
6407 (bookmark--jump-via bmk 'pop-to-buffer))))
6408 (persistent-help . "Show contact - Prefix with C-u to append")
6409 (filtered-candidate-transformer
6410 anything-c-adaptive-sort
6411 anything-c-highlight-bookmark)
6412 (action . (("Show Contact(s)"
6413 . (lambda (candidate)
6414 (let* ((contacts (anything-marked-candidates))
6415 (current-prefix-arg (or anything-current-prefix-arg
6416 (> (length contacts) 1))))
6417 (bookmark-jump
6418 (anything-bookmark-get-bookmark-from-name (car contacts)))
6419 (anything-aif (cdr contacts)
6420 (loop for bmk in it do
6421 (bookmark-jump
6422 (anything-bookmark-get-bookmark-from-name bmk)))))))
6423 ("Send Mail"
6424 . (lambda (candidate)
6425 (let* ((contacts (anything-marked-candidates))
6426 (bmk (anything-bookmark-get-bookmark-from-name
6427 (car contacts)))
6428 (append (message-buffers)))
6429 (if append
6430 (addressbook-set-mail-buffer1 bmk 'append)
6431 (addressbook-set-mail-buffer1 bmk))
6432 (setq contacts (cdr contacts))
6433 (when contacts
6434 (loop for bmk in contacts do
6435 (addressbook-set-mail-buffer1 bmk 'append))))))
6436 ("Edit Bookmark"
6437 . (lambda (candidate)
6438 (let ((bmk (anything-bookmark-get-bookmark-from-name
6439 candidate)))
6440 (addressbook-bookmark-edit
6441 (assoc bmk bookmark-alist)))))
6442 ("Insert Email at point"
6443 . (lambda (candidate)
6444 (let* ((bmk (anything-bookmark-get-bookmark-from-name
6445 candidate))
6446 (mlist (split-string
6447 (assoc-default
6448 'email (assoc bmk bookmark-alist))
6449 ", ")))
6450 (insert
6451 (if (> (length mlist) 1)
6452 (anything-comp-read
6453 "Insert Mail Address: " mlist :must-match t)
6454 (car mlist))))))
6455 ("Show annotation"
6456 . (lambda (candidate)
6457 (let ((bmk (anything-bookmark-get-bookmark-from-name
6458 candidate)))
6459 (bookmark-show-annotation bmk))))
6460 ("Edit annotation"
6461 . (lambda (candidate)
6462 (let ((bmk (anything-bookmark-get-bookmark-from-name
6463 candidate)))
6464 (bookmark-edit-annotation bmk))))
6465 ("Show Google map"
6466 . (lambda (candidate)
6467 (let* ((bmk (anything-bookmark-get-bookmark-from-name
6468 candidate))
6469 (full-bmk (assoc bmk bookmark-alist)))
6470 (addressbook-google-map full-bmk))))))))
6473 (defun anything-c-bmkext-addressbook-setup-alist ()
6474 "Specialized filter function for bookmarks w3m."
6475 (anything-c-bmkext-filter-setup-alist 'bmkext-addressbook-alist-only))
6477 ;; W3m bookmarks from bookmark-extensions.
6478 (defvar anything-c-source-bookmark-w3m
6479 '((name . "Bookmark W3m")
6480 (init . (lambda ()
6481 (require 'bookmark-extensions)
6482 (bookmark-maybe-load-default-file)))
6483 (candidates . anything-c-bookmark-w3m-setup-alist)
6484 (filtered-candidate-transformer
6485 anything-c-adaptive-sort
6486 anything-c-highlight-bookmark)
6487 (type . bookmark)))
6489 (defun anything-c-bookmark-w3m-setup-alist ()
6490 "Specialized filter function for bookmarks w3m."
6491 (anything-c-bmkext-filter-setup-alist 'bmkext-w3m-alist-only))
6493 ;; Images
6494 (defvar anything-c-source-bookmark-images
6495 '((name . "Bookmark Images")
6496 (init . (lambda ()
6497 (require 'bookmark-extensions)
6498 (bookmark-maybe-load-default-file)))
6499 (candidates . anything-c-bookmark-images-setup-alist)
6500 (filtered-candidate-transformer
6501 anything-c-adaptive-sort
6502 anything-c-highlight-bookmark)
6503 (type . bookmark)))
6505 (defun anything-c-bookmark-images-setup-alist ()
6506 "Specialized filter function for images bookmarks."
6507 (anything-c-bmkext-filter-setup-alist 'bmkext-image-file-alist-only))
6509 ;; Woman Man
6510 (defvar anything-c-source-bookmark-man
6511 '((name . "Bookmark Woman&Man")
6512 (init . (lambda ()
6513 (require 'bookmark-extensions)
6514 (bookmark-maybe-load-default-file)))
6515 (candidates . anything-c-bookmark-man-setup-alist)
6516 (filtered-candidate-transformer
6517 anything-c-adaptive-sort
6518 anything-c-highlight-bookmark)
6519 (type . bookmark)))
6521 (defun anything-c-bookmark-man-setup-alist ()
6522 "Specialized filter function for bookmarks w3m."
6523 (append (anything-c-bmkext-filter-setup-alist 'bmkext-man-alist-only)
6524 (anything-c-bmkext-filter-setup-alist 'bmkext-woman-alist-only)))
6526 ;; Gnus
6527 (defvar anything-c-source-bookmark-gnus
6528 '((name . "Bookmark Gnus")
6529 (init . (lambda ()
6530 (require 'bookmark-extensions)
6531 (bookmark-maybe-load-default-file)))
6532 (candidates . anything-c-bookmark-gnus-setup-alist)
6533 (filtered-candidate-transformer
6534 anything-c-adaptive-sort
6535 anything-c-highlight-bookmark)
6536 (type . bookmark)))
6538 (defun anything-c-bookmark-gnus-setup-alist ()
6539 "Specialized filter function for bookmarks gnus."
6540 (anything-c-bmkext-filter-setup-alist 'bmkext-gnus-alist-only))
6542 ;; Info
6543 (defvar anything-c-source-bookmark-info
6544 '((name . "Bookmark Info")
6545 (init . (lambda ()
6546 (require 'bookmark-extensions)
6547 (bookmark-maybe-load-default-file)))
6548 (candidates . anything-c-bookmark-info-setup-alist)
6549 (filtered-candidate-transformer
6550 anything-c-adaptive-sort
6551 anything-c-highlight-bookmark)
6552 (type . bookmark)))
6554 (defun anything-c-bookmark-info-setup-alist ()
6555 "Specialized filter function for bookmarks info."
6556 (anything-c-bmkext-filter-setup-alist 'bmkext-info-alist-only))
6558 ;; Local Files&directories
6559 (defvar anything-c-source-bookmark-files&dirs
6560 '((name . "Bookmark Files&Directories")
6561 (init . (lambda ()
6562 (require 'bookmark-extensions)
6563 (bookmark-maybe-load-default-file)))
6564 (candidates . anything-c-bookmark-local-files-setup-alist)
6565 (filtered-candidate-transformer
6566 anything-c-adaptive-sort
6567 anything-c-highlight-bookmark)
6568 (type . bookmark)))
6570 (defun anything-c-bookmark-local-files-setup-alist ()
6571 "Specialized filter function for bookmarks locals files."
6572 (anything-c-bmkext-filter-setup-alist 'bmkext-local-file-alist-only))
6574 ;; Su Files&directories
6575 (defvar anything-c-source-bookmark-su-files&dirs
6576 '((name . "Bookmark Root-Files&Directories")
6577 (init . (lambda ()
6578 (require 'bookmark-extensions)
6579 (bookmark-maybe-load-default-file)))
6580 (candidates . anything-c-bookmark-su-files-setup-alist)
6581 (filtered-candidate-transformer
6582 anything-c-adaptive-sort
6583 anything-c-highlight-bookmark-su)
6584 (type . bookmark)))
6586 (defun anything-c-bookmark-su-files-setup-alist ()
6587 "Specialized filter function for bookmarks su/sudo files."
6588 (declare (special bmkext-su-or-sudo-regexp))
6589 (loop
6590 with l = (anything-c-bmkext-filter-setup-alist 'bmkext-remote-file-alist-only)
6591 for i in l
6592 for isfile = (bookmark-get-filename i)
6593 for istramp = (and isfile (boundp 'tramp-file-name-regexp)
6594 (save-match-data
6595 (string-match tramp-file-name-regexp isfile)))
6596 for issu = (and istramp
6597 (string-match bmkext-su-or-sudo-regexp isfile))
6598 if issu
6599 collect i))
6601 ;; Ssh Files&directories
6602 (defvar anything-c-source-bookmark-ssh-files&dirs
6603 '((name . "Bookmark Ssh-Files&Directories")
6604 (init . (lambda ()
6605 (require 'bookmark-extensions)
6606 (bookmark-maybe-load-default-file)))
6607 (candidates . anything-c-bookmark-ssh-files-setup-alist)
6608 (filtered-candidate-transformer . anything-c-adaptive-sort)
6609 (type . bookmark)))
6611 (defun anything-c-bookmark-ssh-files-setup-alist ()
6612 "Specialized filter function for bookmarks ssh files."
6613 (loop
6614 with l = (anything-c-bmkext-filter-setup-alist 'bmkext-remote-file-alist-only)
6615 for i in l
6616 for isfile = (bookmark-get-filename i)
6617 for istramp = (and isfile (boundp 'tramp-file-name-regexp)
6618 (save-match-data
6619 (string-match tramp-file-name-regexp isfile)))
6620 for isssh = (and istramp
6621 (string-match "/ssh:" isfile))
6622 if isssh
6623 collect i))
6627 ;;; Firefox bookmarks
6630 ;; You will have to set firefox to import bookmarks in his html file bookmarks.html.
6631 ;; (only for firefox versions >=3)
6632 ;; To achieve that, open about:config in firefox and double click on this line to enable value
6633 ;; to true:
6634 ;; user_pref("browser.bookmarks.autoExportHTML", false);
6635 ;; You should have now:
6636 ;; user_pref("browser.bookmarks.autoExportHTML", true);
6637 ;; NOTE: This is also working in the same way for mozilla aka seamonkey.
6639 (defvar anything-firefox-bookmark-url-regexp "\\(https\\|http\\|ftp\\|about\\|file\\)://[^ \"]*")
6640 (defvar anything-firefox-bookmarks-regexp ">\\([^><]+.[^</a>]\\)")
6642 (defun anything-get-firefox-user-init-dir ()
6643 "Guess the default Firefox user directory name."
6644 (let* ((moz-dir (concat (getenv "HOME") "/.mozilla/firefox/"))
6645 (moz-user-dir
6646 (with-current-buffer (find-file-noselect (concat moz-dir "profiles.ini"))
6647 (goto-char (point-min))
6648 (prog1
6649 (when (search-forward "Path=" nil t)
6650 (buffer-substring-no-properties (point) (point-at-eol)))
6651 (kill-buffer)))))
6652 (file-name-as-directory (concat moz-dir moz-user-dir))))
6654 (defun anything-guess-firefox-bookmark-file ()
6655 "Return the path of the Firefox bookmarks file."
6656 (concat (anything-get-firefox-user-init-dir) "bookmarks.html"))
6658 (defun anything-html-bookmarks-to-alist (file url-regexp bmk-regexp)
6659 "Parse html bookmark FILE and return an alist with (title . url) as elements."
6660 (let (bookmarks-alist url title)
6661 (with-temp-buffer
6662 (insert-file-contents file)
6663 (goto-char (point-min))
6664 (while (re-search-forward "href=\\|^ *<DT><A HREF=" nil t)
6665 (forward-line 0)
6666 (when (re-search-forward url-regexp nil t)
6667 (setq url (match-string 0)))
6668 (when (re-search-forward bmk-regexp nil t)
6669 (setq title (match-string 1)))
6670 (push (cons title url) bookmarks-alist)
6671 (forward-line)))
6672 (nreverse bookmarks-alist)))
6674 (defvar anything-c-firefox-bookmarks-alist nil)
6675 (defvar anything-c-source-firefox-bookmarks
6676 '((name . "Firefox Bookmarks")
6677 (init . (lambda ()
6678 (setq anything-c-firefox-bookmarks-alist
6679 (anything-html-bookmarks-to-alist
6680 (anything-guess-firefox-bookmark-file)
6681 anything-firefox-bookmark-url-regexp
6682 anything-firefox-bookmarks-regexp))))
6683 (candidates . (lambda ()
6684 (mapcar #'car anything-c-firefox-bookmarks-alist)))
6685 (filtered-candidate-transformer
6686 anything-c-adaptive-sort
6687 anything-c-highlight-firefox-bookmarks)
6688 (action . (("Browse Url"
6689 . (lambda (candidate)
6690 (anything-c-browse-url
6691 (anything-c-firefox-bookmarks-get-value candidate))))
6692 ("Copy Url"
6693 . (lambda (elm)
6694 (kill-new (anything-c-w3m-bookmarks-get-value elm))))))))
6697 (defun anything-c-firefox-bookmarks-get-value (elm)
6698 (assoc-default elm anything-c-firefox-bookmarks-alist))
6700 (defun anything-c-highlight-firefox-bookmarks (bookmarks source)
6701 (loop for i in bookmarks
6702 collect (propertize
6703 i 'face '((:foreground "YellowGreen"))
6704 'help-echo (anything-c-firefox-bookmarks-get-value i))))
6708 ;;; W3m bookmark - anything interface.
6711 ;; Some users have the emacs-w3m library in load-path
6712 ;; without having the w3m executable :-;
6713 ;; So check if w3m program is present before trying to load
6714 ;; emacs-w3m.
6715 (eval-when-compile
6716 (when (executable-find "w3m")
6717 (require 'w3m-bookmark nil t)))
6719 (defvar w3m-bookmark-file "~/.w3m/bookmark.html")
6720 (defvar anything-w3m-bookmarks-regexp ">\\([^><]+.[^</a>]\\)")
6721 (defvar anything-w3m-bookmark-url-regexp "\\(https\\|http\\|ftp\\|file\\)://[^>]*")
6722 (defvar anything-c-w3m-bookmarks-alist nil)
6723 (defvar anything-c-source-w3m-bookmarks
6724 '((name . "W3m Bookmarks")
6725 (init . (lambda ()
6726 (setq anything-c-w3m-bookmarks-alist
6727 (anything-html-bookmarks-to-alist
6728 w3m-bookmark-file
6729 anything-w3m-bookmark-url-regexp
6730 anything-w3m-bookmarks-regexp))))
6731 (candidates . (lambda ()
6732 (mapcar #'car anything-c-w3m-bookmarks-alist)))
6733 (filtered-candidate-transformer
6734 anything-c-adaptive-sort
6735 anything-c-highlight-w3m-bookmarks)
6736 (action . (("Browse Url"
6737 . (lambda (candidate)
6738 (anything-c-w3m-browse-bookmark candidate)))
6739 ("Copy Url"
6740 . (lambda (elm)
6741 (kill-new (anything-c-w3m-bookmarks-get-value elm))))
6742 ("Browse Url Externally"
6743 . (lambda (candidate)
6744 (anything-c-w3m-browse-bookmark candidate t)))
6745 ("Delete Bookmark"
6746 . (lambda (candidate)
6747 (anything-c-w3m-delete-bookmark candidate)))
6748 ("Rename Bookmark"
6749 . (lambda (candidate)
6750 (anything-c-w3m-rename-bookmark candidate)))))
6751 (persistent-action . (lambda (candidate)
6752 (if current-prefix-arg
6753 (anything-c-w3m-browse-bookmark candidate t)
6754 (anything-c-w3m-browse-bookmark candidate nil t))))
6755 (persistent-help . "Open URL with emacs-w3m in new tab / \
6756 C-u \\[anything-execute-persistent-action]: Open URL with Firefox"))
6757 "Needs w3m and emacs-w3m.
6759 http://w3m.sourceforge.net/
6760 http://emacs-w3m.namazu.org/")
6763 (defun anything-c-w3m-bookmarks-get-value (elm)
6764 (replace-regexp-in-string
6765 "\"" "" (cdr (assoc elm anything-c-w3m-bookmarks-alist))))
6767 (defun anything-c-w3m-browse-bookmark (elm &optional use-external new-tab)
6768 (let* ((fn (if use-external 'anything-c-browse-url 'w3m-browse-url))
6769 (arg (and (eq fn 'w3m-browse-url) new-tab)))
6770 (funcall fn (anything-c-w3m-bookmarks-get-value elm) arg)))
6772 (defun anything-c-highlight-w3m-bookmarks (bookmarks source)
6773 (loop for i in bookmarks
6774 collect (propertize
6775 i 'face 'anything-w3m-bookmarks-face
6776 'help-echo (anything-c-w3m-bookmarks-get-value i))))
6779 (defun anything-c-w3m-delete-bookmark (elm)
6780 "Delete w3m bookmark from `w3m-bookmark-file'."
6781 (with-current-buffer
6782 (find-file-literally w3m-bookmark-file)
6783 (goto-char (point-min))
6784 (when (re-search-forward elm nil t)
6785 (beginning-of-line)
6786 (delete-region (point)
6787 (line-end-position))
6788 (delete-blank-lines))
6789 (save-buffer)
6790 (kill-buffer)))
6792 (defun anything-c-w3m-rename-bookmark (elm)
6793 "Rename w3m bookmark in `w3m-bookmark-file'."
6794 (let* ((old-title (replace-regexp-in-string ">" "" elm))
6795 (new-title (read-string "NewTitle: " old-title)))
6796 (with-current-buffer
6797 (find-file-literally w3m-bookmark-file)
6798 (goto-char (point-min))
6799 (when (re-search-forward (concat elm "<") nil t)
6800 (goto-char (1- (point)))
6801 (delete-char (- (length old-title)))
6802 (insert new-title))
6803 (save-buffer)
6804 (kill-buffer))))
6807 ;;;; <Library>
6808 ;;; Elisp library scan
6811 (defvar anything-c-source-elisp-library-scan
6812 '((name . "Elisp libraries (Scan)")
6813 (init . (anything-c-elisp-library-scan-init))
6814 (candidates-in-buffer)
6815 (action ("Find library"
6816 . (lambda (candidate) (find-file (find-library-name candidate))))
6817 ("Find library other window"
6818 . (lambda (candidate)
6819 (find-file-other-window (find-library-name candidate))))
6820 ("Load library"
6821 . (lambda (candidate) (load-library candidate))))))
6823 (defun anything-c-elisp-library-scan-init ()
6824 "Init anything buffer status."
6825 (let ((anything-buffer (anything-candidate-buffer 'global))
6826 (library-list (anything-c-elisp-library-scan-list)))
6827 (with-current-buffer anything-buffer
6828 (dolist (library library-list)
6829 (insert (format "%s\n" library))))))
6831 (defun anything-c-elisp-library-scan-list (&optional dirs string)
6832 "Do completion for file names passed to `locate-file'.
6833 DIRS is directory to search path.
6834 STRING is string to match."
6835 ;; Use `load-path' as path when ignore `dirs'.
6836 (or dirs (setq dirs load-path))
6837 ;; Init with blank when ignore `string'.
6838 (or string (setq string ""))
6839 ;; Get library list.
6840 (let ((string-dir (file-name-directory string))
6841 ;; File regexp that suffix match `load-file-rep-suffixes'.
6842 (match-regexp (format "^.*\\.el%s$" (regexp-opt load-file-rep-suffixes)))
6843 name
6844 names)
6845 (dolist (dir dirs)
6846 (unless dir
6847 (setq dir default-directory))
6848 (if string-dir
6849 (setq dir (expand-file-name string-dir dir)))
6850 (when (file-directory-p dir)
6851 (dolist (file (file-name-all-completions
6852 (file-name-nondirectory string) dir))
6853 ;; Suffixes match `load-file-rep-suffixes'.
6854 (setq name (if string-dir (concat string-dir file) file))
6855 (if (string-match match-regexp name)
6856 (add-to-list 'names name)))))
6857 names))
6860 ;;;; <Programming>
6864 ;;; Imenu
6867 (defvar anything-c-imenu-delimiter " / ")
6869 (defvar anything-c-imenu-index-filter nil)
6870 (make-variable-buffer-local 'anything-c-imenu-index-filter)
6872 (defvar anything-c-cached-imenu-alist nil)
6873 (make-variable-buffer-local 'anything-c-cached-imenu-alist)
6875 (defvar anything-c-cached-imenu-candidates nil)
6876 (make-variable-buffer-local 'anything-c-cached-imenu-candidates)
6878 (defvar anything-c-cached-imenu-tick nil)
6879 (make-variable-buffer-local 'anything-c-cached-imenu-tick)
6881 (eval-when-compile (require 'imenu))
6882 (setq imenu-auto-rescan t)
6884 (defun anything-imenu-create-candidates (entry)
6885 "Create candidates with ENTRY."
6886 (if (listp (cdr entry))
6887 (mapcan
6888 (lambda (sub)
6889 (if (consp (cdr sub))
6890 (mapcar
6891 (lambda (subentry)
6892 (concat (car entry) anything-c-imenu-delimiter subentry))
6893 (anything-imenu-create-candidates sub))
6894 (list (concat (car entry) anything-c-imenu-delimiter (car sub)))))
6895 (cdr entry))
6896 (list entry)))
6898 (defvar anything-c-source-imenu
6899 '((name . "Imenu")
6900 (init . (lambda () (require 'imenu)))
6901 (candidates . anything-c-imenu-candidates)
6902 (persistent-action . (lambda (elm)
6903 (anything-c-imenu-default-action elm)
6904 (unless (fboundp 'semantic-imenu-tag-overlay)
6905 (anything-match-line-color-current-line))))
6906 (persistent-help . "Show this entry")
6907 (action . anything-c-imenu-default-action))
6908 "See (info \"(emacs)Imenu\")")
6911 (defun anything-c-imenu-candidates ()
6912 (with-anything-current-buffer
6913 (let ((tick (buffer-modified-tick)))
6914 (if (eq anything-c-cached-imenu-tick tick)
6915 anything-c-cached-imenu-candidates
6916 (setq imenu--index-alist nil)
6917 (setq anything-c-cached-imenu-tick tick
6918 anything-c-cached-imenu-candidates
6919 (ignore-errors
6920 (mapcan
6921 'anything-imenu-create-candidates
6922 (setq anything-c-cached-imenu-alist
6923 (let ((index (imenu--make-index-alist)))
6924 (if anything-c-imenu-index-filter
6925 (funcall anything-c-imenu-index-filter index)
6926 index))))))
6927 (setq anything-c-cached-imenu-candidates
6928 (mapcar #'(lambda (x)
6929 (if (stringp x)
6931 (car x)))
6932 anything-c-cached-imenu-candidates))))))
6934 (setq imenu-default-goto-function 'imenu-default-goto-function)
6935 (defun anything-c-imenu-default-action (elm)
6936 "The default action for `anything-c-source-imenu'."
6937 (let ((path (split-string elm anything-c-imenu-delimiter))
6938 (alist anything-c-cached-imenu-alist))
6939 (dolist (elm path)
6940 (setq alist (assoc elm alist)))
6941 (imenu alist)))
6945 ;;; Ctags
6948 (defvar anything-c-ctags-modes
6949 '( c-mode c++-mode awk-mode csharp-mode java-mode javascript-mode lua-mode
6950 makefile-mode pascal-mode perl-mode cperl-mode php-mode python-mode
6951 scheme-mode sh-mode slang-mode sql-mode tcl-mode ))
6953 (defun anything-c-source-ctags-init ()
6954 (when (and buffer-file-name
6955 (memq major-mode anything-c-ctags-modes)
6956 (anything-current-buffer-is-modified))
6957 (with-current-buffer (anything-candidate-buffer 'local)
6958 (call-process-shell-command
6959 (if (string-match "\\.el\\.gz$" anything-buffer-file-name)
6960 (format "ctags -e -u -f- --language-force=lisp --fields=n =(zcat %s) "
6961 anything-buffer-file-name)
6962 (format "ctags -e -u -f- --fields=n %s " anything-buffer-file-name))
6963 nil (current-buffer))
6964 (goto-char (point-min))
6965 (forward-line 2)
6966 (delete-region (point-min) (point))
6967 (loop while (and (not (eobp)) (search-forward "\001" (point-at-eol) t))
6968 for lineno-start = (point)
6969 for lineno = (buffer-substring
6970 lineno-start
6971 (1- (search-forward "," (point-at-eol) t)))
6973 (beginning-of-line)
6974 (insert (format "%5s:" lineno))
6975 (search-forward "\177" (point-at-eol) t)
6976 (delete-region (1- (point)) (point-at-eol))
6977 (forward-line 1)))))
6979 (defvar anything-c-source-ctags
6980 '((name . "Exuberant ctags")
6981 (init . anything-c-source-ctags-init)
6982 (candidates-in-buffer)
6983 (adjust)
6984 (type . line))
6985 "Needs Exuberant Ctags.
6987 http://ctags.sourceforge.net/")
6990 ;;; Etags
6993 ;; anything-etags.el is deprecated, if this file is found,
6994 ;; warn user at compile time.
6995 (eval-when-compile
6996 (when (locate-library "anything-etags.el")
6997 (display-warning
6998 '(anything-config)
6999 "You are using obsolete library `anything-etags.el' and should remove it."
7000 :warning)))
7002 (defvar anything-c-etags-tag-file-dir nil
7003 "Etags file directory.")
7004 (defvar anything-c-etags-mtime-alist nil
7005 "Store the last modification time of etags files here.")
7006 (defvar anything-c-etags-cache (make-hash-table :test 'equal)
7007 "Cache content of etags files used here for faster access.")
7009 (defun anything-c-etags-get-tag-file (&optional directory)
7010 "Return the path of etags file if found."
7011 ;; Get tag file from `default-directory' or upper directory.
7012 (let ((current-dir (anything-c-etags-find-tag-file-directory
7013 (or directory default-directory))))
7014 ;; Return nil if not find tag file.
7015 (when current-dir
7016 ;; Set tag file directory.
7017 (setq anything-c-etags-tag-file-dir current-dir)
7018 (expand-file-name anything-c-etags-tag-file-name current-dir))))
7020 (defun anything-c-etags-find-tag-file-directory (current-dir)
7021 "Try to find the directory containing tag file.
7022 If not found in CURRENT-DIR search in upper directory."
7023 (flet ((file-exists? (dir)
7024 (let ((tag-path (expand-file-name
7025 anything-c-etags-tag-file-name dir)))
7026 (and (stringp tag-path)
7027 (file-regular-p tag-path)
7028 (file-readable-p tag-path)))))
7029 (loop with count = 0
7030 until (file-exists? current-dir)
7031 ;; Return nil if outside the value of
7032 ;; `anything-c-etags-tag-file-search-limit'.
7033 if (= count anything-c-etags-tag-file-search-limit)
7034 do (return nil)
7035 ;; Or search upper directories.
7036 else
7037 do (incf count)
7038 (setq current-dir (expand-file-name (concat current-dir "../")))
7039 finally return current-dir)))
7041 (defun anything-c-source-etags-header-name (x)
7042 "Create header name for this anything etags session."
7043 (concat "Etags in "
7044 (with-anything-current-buffer
7045 (anything-c-etags-get-tag-file))))
7047 (defmacro anything-c-etags-create-buffer (file)
7048 "Create the `anything-buffer' based on contents of etags tag FILE."
7049 `(let* ((tag-fname ,file)
7051 (split (with-current-buffer (find-file-noselect tag-fname)
7052 (prog1
7053 (split-string (buffer-string) "\n" 'omit-nulls)
7054 (setq max (line-number-at-pos (point-max)))
7055 (kill-buffer))))
7056 (progress-reporter (make-progress-reporter "Loading tag file..." 0 max)))
7057 (loop
7058 with fname
7059 with cand
7060 for i in split for count from 0
7061 for elm = (unless (string-match "^\x0c" i)
7062 (anything-aif (string-match "\177" i)
7063 (substring i 0 it)
7065 do (cond ((and elm (string-match "^\\(.+\\),[0-9]+" elm))
7066 (setq fname (match-string 1 elm)))
7067 (elm (setq cand (concat fname ": " elm)))
7068 (t (setq cand nil)))
7069 when cand do (progn
7070 (insert (concat cand "\n"))
7071 (progress-reporter-update progress-reporter count)))))
7073 (defun anything-c-etags-init ()
7074 "Feed `anything-buffer' using `anything-c-etags-cache' or tag file.
7075 If no entry in cache, create one."
7076 (let ((tagfile (anything-c-etags-get-tag-file)))
7077 (when tagfile
7078 (with-current-buffer (anything-candidate-buffer 'global)
7079 (anything-aif (gethash tagfile anything-c-etags-cache)
7080 ;; An entry is present in cache, insert it.
7081 (insert it)
7082 ;; No entry, create a new buffer using content of tag file (slower).
7083 (anything-c-etags-create-buffer tagfile)
7084 ;; Store content of buffer in cache.
7085 (puthash tagfile (buffer-string) anything-c-etags-cache)
7086 ;; Store or set the last modification of tag file.
7087 (anything-aif (assoc tagfile anything-c-etags-mtime-alist)
7088 ;; If an entry exists modify it.
7089 (setcdr it (anything-c-etags-mtime tagfile))
7090 ;; No entry create a new one.
7091 (add-to-list 'anything-c-etags-mtime-alist
7092 (cons tagfile (anything-c-etags-mtime tagfile)))))))))
7094 (defvar anything-c-source-etags-select
7095 '((name . "Etags")
7096 (header-name . anything-c-source-etags-header-name)
7097 (init . anything-c-etags-init)
7098 (candidates-in-buffer)
7099 (search . (anything-c-etags-search-fn))
7100 (mode-line . anything-etags-mode-line-string)
7101 (action . anything-c-etags-default-action)
7102 (persistent-action . (lambda (candidate)
7103 (anything-c-etags-default-action candidate)
7104 (anything-match-line-color-current-line))))
7105 "Anything source for Etags.")
7107 (defun anything-c-etags-search-fn (pattern)
7108 "Search function for `anything-c-source-etags-select'."
7109 (re-search-forward
7110 (if anything-c-etags-use-regexp-search
7111 (format anything-c-etags-search-regexp pattern)
7112 pattern)
7113 nil t))
7115 (defun anything-c-etags-default-action (candidate)
7116 "Anything default action to jump to an etags entry."
7117 (let* ((split (split-string candidate ": "))
7118 (fname (expand-file-name
7119 (car split) anything-c-etags-tag-file-dir))
7120 (elm (cadr split)))
7121 (find-file fname)
7122 (goto-char (point-min))
7123 (search-forward elm nil t)
7124 (goto-char (match-beginning 0))))
7126 (defun anything-c-etags-mtime (file)
7127 "Last modification time of etags tag FILE."
7128 (cadr (nth 5 (file-attributes file))))
7130 (defun anything-c-etags-file-modified-p (file)
7131 "Check if tag FILE have been modified in this session.
7132 If FILE is nil return nil."
7133 (let ((last-modif (and file
7134 (assoc-default file anything-c-etags-mtime-alist))))
7135 (and last-modif
7136 (/= last-modif (anything-c-etags-mtime file)))))
7140 ;;; Semantic
7143 (defvar anything-semantic-candidates nil)
7145 (defun anything-semantic-construct-candidates (tags depth)
7146 (when (require 'semantic nil t)
7147 (apply
7148 'append
7149 (mapcar
7150 (lambda (tag)
7151 (if (listp tag)
7152 (let ((type (semantic-tag-type tag))
7153 (class (semantic-tag-class tag)))
7154 (if (or (and (stringp type)
7155 (or (string= type "class")
7156 (string= type "namespace")))
7157 (eq class 'function)
7158 (eq class 'variable))
7159 (cons (cons (concat (make-string (* depth 2) ?\s)
7160 (semantic-format-tag-summarize tag nil t))
7161 tag)
7162 (anything-semantic-construct-candidates
7163 (semantic-tag-components tag) (1+ depth)))))))
7164 tags))))
7166 (defun anything-semantic-default-action (candidate)
7167 (let ((tag (cdr (assoc candidate anything-semantic-candidates))))
7168 (semantic-go-to-tag tag)))
7170 (defvar anything-c-source-semantic
7171 '((name . "Semantic Tags")
7172 (init . (lambda ()
7173 (setq anything-semantic-candidates
7174 (ignore-errors (anything-semantic-construct-candidates
7175 (semantic-fetch-tags) 0)))))
7176 (candidates . (lambda ()
7177 (if anything-semantic-candidates
7178 (mapcar 'car anything-semantic-candidates))))
7179 (persistent-action . (lambda (elm)
7180 (anything-semantic-default-action elm)
7181 (anything-match-line-color-current-line)))
7182 (persistent-help . "Show this entry")
7183 (action . anything-semantic-default-action)
7184 "Needs semantic in CEDET.
7186 http://cedet.sourceforge.net/semantic.shtml
7187 http://cedet.sourceforge.net/"))
7191 ;;; Anything interface of `simple-call-tree.el'.
7193 ;; <http://www.emacswiki.org/cgi-bin/wiki/download/simple-call-tree.el>
7195 ;; Function is called by
7196 (defvar anything-c-source-simple-call-tree-functions-callers
7197 '((name . "Function is called by")
7198 (init . anything-c-simple-call-tree-functions-callers-init)
7199 (multiline)
7200 (candidates . anything-c-simple-call-tree-candidates)
7201 (persistent-action . anything-c-simple-call-tree-persistent-action)
7202 (persistent-help . "Show function definitions by rotation")
7203 (action ("Find definition selected by persistent-action" .
7204 anything-c-simple-call-tree-find-definition)))
7205 "Needs simple-call-tree.el.
7206 http://www.emacswiki.org/cgi-bin/wiki/download/simple-call-tree.el")
7208 (defvar anything-c-simple-call-tree-tick nil)
7209 (make-variable-buffer-local 'anything-c-simple-call-tree-tick)
7210 (defun anything-c-simple-call-tree-analyze-maybe ()
7211 (unless (eq (buffer-chars-modified-tick) anything-c-simple-call-tree-tick)
7212 (simple-call-tree-analyze)
7213 (setq anything-c-simple-call-tree-tick (buffer-chars-modified-tick))))
7215 (defun anything-c-simple-call-tree-init-base (function message)
7216 (require 'simple-call-tree)
7217 (with-no-warnings
7218 (when (anything-current-buffer-is-modified)
7219 (anything-c-simple-call-tree-analyze-maybe)
7220 (let ((list (funcall function simple-call-tree-alist)))
7221 (with-current-buffer (anything-candidate-buffer 'local)
7222 (dolist (entry list)
7223 (let ((funcs (concat " " (mapconcat #'identity (cdr entry) "\n "))))
7224 (insert (car entry) message
7225 (if (string= funcs " ")
7226 " no functions."
7227 funcs)
7228 "\n\n"))))))))
7230 (defun anything-c-simple-call-tree-functions-callers-init ()
7231 (anything-c-simple-call-tree-init-base 'simple-call-tree-invert
7232 " is called by\n"))
7234 (defun anything-c-simple-call-tree-candidates ()
7235 (with-current-buffer (anything-candidate-buffer)
7236 (split-string (buffer-string) "\n\n")))
7238 (defvar anything-c-simple-call-tree-related-functions nil)
7239 (defvar anything-c-simple-call-tree-function-index 0)
7240 (defun anything-c-simple-call-tree-persistent-action (candidate)
7241 (unless (eq last-command 'anything-execute-persistent-action)
7242 (setq anything-c-simple-call-tree-related-functions
7243 (delete "no functions."
7244 (split-string
7245 (replace-regexp-in-string " \\| is called by\\| calls "
7246 "" candidate)
7247 "\n")))
7248 (setq anything-c-simple-call-tree-function-index -1))
7249 (incf anything-c-simple-call-tree-function-index)
7250 (anything-c-simple-call-tree-find-definition candidate))
7252 (defun anything-c-simple-call-tree-find-definition (candidate)
7253 (find-function
7254 (intern
7255 (nth (mod anything-c-simple-call-tree-function-index
7256 (length anything-c-simple-call-tree-related-functions))
7257 anything-c-simple-call-tree-related-functions))))
7260 ;;; Function calls
7261 (defvar anything-c-source-simple-call-tree-callers-functions
7262 '((name . "Function calls")
7263 (init . anything-c-simple-call-tree-callers-functions-init)
7264 (multiline)
7265 (candidates . anything-c-simple-call-tree-candidates)
7266 (persistent-action . anything-c-simple-call-tree-persistent-action)
7267 (persistent-help . "Show function definitions by rotation")
7268 (action ("Find definition selected by persistent-action" .
7269 anything-c-simple-call-tree-find-definition)))
7270 "Needs simple-call-tree.el.
7271 http://www.emacswiki.org/cgi-bin/wiki/download/simple-call-tree.el")
7273 (defun anything-c-simple-call-tree-callers-functions-init ()
7274 (anything-c-simple-call-tree-init-base 'identity " calls \n"))
7279 ;;; Anything UI of auto-document.el
7281 ;; <http://www.emacswiki.org/cgi-bin/wiki/download/auto-document.el>
7283 ;; Commands/Options with doc
7284 (defvar anything-c-auto-document-data nil)
7285 (make-variable-buffer-local 'anything-c-auto-document-data)
7286 (defvar anything-c-source-commands-and-options-in-file
7287 '((name . "Commands/Options in file")
7288 (header-name
7289 . (lambda (x) (format "Commands/Options in %s"
7290 (buffer-local-value 'buffer-file-name
7291 anything-current-buffer))))
7292 (candidates . anything-command-and-options-candidates)
7293 (multiline)
7294 (action . imenu))
7295 "List Commands and Options with doc. It needs auto-document.el .
7297 http://www.emacswiki.org/cgi-bin/wiki/download/auto-document.el")
7299 (eval-when-compile (require 'auto-document nil t))
7300 (defun anything-command-and-options-candidates ()
7301 (with-anything-current-buffer
7302 (when (and (require 'auto-document nil t)
7303 (eq major-mode 'emacs-lisp-mode)
7304 (or (anything-current-buffer-is-modified)
7305 (not anything-c-auto-document-data)))
7306 (or imenu--index-alist (imenu--make-index-alist t))
7307 (setq anything-c-auto-document-data
7308 (destructuring-bind (commands options)
7309 (adoc-construct anything-current-buffer)
7310 (append
7311 (loop for (command . doc) in commands
7312 for cmdname = (symbol-name command)
7313 collect
7314 (cons
7315 (format "Command: %s\n %s"
7316 (propertize cmdname 'face font-lock-function-name-face)
7317 (adoc-first-line doc))
7318 (assoc cmdname imenu--index-alist)))
7319 (loop with var-alist = (cdr (assoc "Variables" imenu--index-alist))
7320 for (option doc default) in options
7321 for optname = (symbol-name option)
7322 collect
7323 (cons
7324 (format "Option: %s\n %s\n default = %s"
7325 (propertize optname 'face font-lock-variable-name-face)
7326 (adoc-first-line doc)
7327 (adoc-prin1-to-string default))
7328 (assoc optname
7329 var-alist)))))))
7330 anything-c-auto-document-data))
7334 ;;;; <Color and Face>
7337 ;;; Customize Face
7340 (defvar anything-c-source-customize-face
7341 '((name . "Customize Face")
7342 (init . (lambda ()
7343 (unless (anything-candidate-buffer)
7344 (save-selected-window
7345 (list-faces-display))
7346 (anything-candidate-buffer (get-buffer "*Faces*")))))
7347 (candidates-in-buffer)
7348 (get-line . buffer-substring)
7349 (action . (lambda (line)
7350 (customize-face (intern (car (split-string line))))))
7351 (requires-pattern . 3))
7352 "See (info \"(emacs)Faces\")")
7354 ;;; Colors browser
7357 (defvar anything-c-source-colors
7358 '((name . "Colors")
7359 (init . (lambda () (unless (anything-candidate-buffer)
7360 (save-selected-window
7361 (list-colors-display))
7362 (anything-candidate-buffer (get-buffer "*Colors*")))))
7363 (candidates-in-buffer)
7364 (get-line . buffer-substring)
7365 (action
7366 ("Copy Name" . (lambda (candidate)
7367 (kill-new (anything-c-colors-get-name candidate))))
7368 ("Copy RGB" . (lambda (candidate)
7369 (kill-new (anything-c-colors-get-rgb candidate))))
7370 ("Insert Name" . (lambda (candidate)
7371 (with-anything-current-buffer
7372 (insert (anything-c-colors-get-name candidate)))))
7373 ("Insert RGB" . (lambda (candidate)
7374 (with-anything-current-buffer
7375 (insert (anything-c-colors-get-rgb candidate))))))))
7377 (defun anything-c-colors-get-name (candidate)
7378 "Get color name."
7379 (replace-regexp-in-string
7380 " " ""
7381 (with-temp-buffer
7382 (insert (capitalize candidate))
7383 (goto-char (point-min))
7384 (search-forward-regexp "\\s-\\{2,\\}")
7385 (delete-region (point) (point-max))
7386 (buffer-string))))
7388 (defun anything-c-colors-get-rgb (candidate)
7389 "Get color RGB."
7390 (replace-regexp-in-string
7391 " " ""
7392 (with-temp-buffer
7393 (insert (capitalize candidate))
7394 (goto-char (point-max))
7395 (search-backward-regexp "\\s-\\{2,\\}")
7396 (delete-region (point) (point-min))
7397 (buffer-string))))
7400 ;;;; <Search Engine>
7401 ;;; Tracker desktop search
7402 (defvar anything-c-source-tracker-search
7403 '((name . "Tracker Search")
7404 (candidates . (lambda ()
7405 (start-process "tracker-search-process" nil
7406 "tracker-search"
7407 anything-pattern)))
7408 (type . file)
7409 (requires-pattern . 3)
7410 (delayed))
7411 "Source for retrieving files matching the current input pattern
7412 with the tracker desktop search.")
7414 ;;; Spotlight (MacOS X desktop search)
7415 (defvar anything-c-source-mac-spotlight
7416 '((name . "mdfind")
7417 (candidates
7418 . (lambda () (start-process "mdfind-process" nil "mdfind" anything-pattern)))
7419 (type . file)
7420 (requires-pattern . 3)
7421 (delayed))
7422 "Source for retrieving files via Spotlight's command line
7423 utility mdfind.")
7425 ;;; Picklist
7426 (defvar anything-c-source-picklist
7427 '((name . "Picklist")
7428 (candidates . (lambda () (mapcar 'car picklist-list)))
7429 (type . file)))
7433 ;;; Kill ring
7436 (defvar anything-c-source-kill-ring
7437 `((name . "Kill Ring")
7438 (init . (lambda () (anything-attrset 'last-command last-command)))
7439 (candidates . anything-c-kill-ring-candidates)
7440 (filtered-candidate-transformer anything-c-kill-ring-transformer)
7441 (action . anything-c-kill-ring-action)
7442 (keymap . ,anything-kill-ring-map)
7443 (last-command)
7444 (migemo)
7445 (multiline))
7446 "Source for browse and insert contents of kill-ring.")
7448 (defun anything-c-kill-ring-candidates ()
7449 (loop for kill in (anything-fast-remove-dups kill-ring :test 'equal)
7450 unless (or (< (length kill) anything-kill-ring-threshold)
7451 (string-match "^[\\s\\t]+$" kill))
7452 collect kill))
7454 (defun anything-c-kill-ring-transformer (candidates source)
7455 "Display only the `anything-c-kill-ring-max-lines-number' lines of candidate."
7456 (loop for i in candidates
7457 for nlines = (with-temp-buffer (insert i) (count-lines (point-min) (point-max)))
7458 if (and anything-c-kill-ring-max-lines-number
7459 (> nlines anything-c-kill-ring-max-lines-number))
7460 collect (cons
7461 (with-temp-buffer
7462 (insert i)
7463 (goto-char (point-min))
7464 (concat
7465 (buffer-substring
7466 (point-min)
7467 (save-excursion
7468 (forward-line anything-c-kill-ring-max-lines-number)
7469 (point)))
7470 "[...]")) i)
7471 else collect i))
7473 (defun anything-c-kill-ring-action (str)
7474 "Insert STR in `kill-ring' and set STR to the head.
7475 If this action is executed just after `yank',
7476 replace with STR as yanked string."
7477 (setq kill-ring (delete str kill-ring))
7478 (if (not (eq (anything-attr 'last-command) 'yank))
7479 (insert-for-yank str)
7480 ;; from `yank-pop'
7481 (let ((inhibit-read-only t)
7482 (before (< (point) (mark t))))
7483 (if before
7484 (funcall (or yank-undo-function 'delete-region) (point) (mark t))
7485 (funcall (or yank-undo-function 'delete-region) (mark t) (point)))
7486 (setq yank-undo-function nil)
7487 (set-marker (mark-marker) (point) (current-buffer))
7488 (insert-for-yank str)
7489 ;; Set the window start back where it was in the yank command,
7490 ;; if possible.
7491 (set-window-start (selected-window) yank-window-start t)
7492 (if before
7493 ;; This is like exchange-point-and-mark, but doesn't activate the mark.
7494 ;; It is cleaner to avoid activation, even though the command
7495 ;; loop would deactivate the mark because we inserted text.
7496 (goto-char (prog1 (mark t)
7497 (set-marker (mark-marker) (point) (current-buffer)))))))
7498 (kill-new str))
7502 ;;;; <Mark ring>
7503 ;; DO NOT include these sources in `anything-sources' use
7504 ;; the commands `anything-mark-ring', `anything-global-mark-ring' or
7505 ;; `anything-all-mark-rings' instead.
7507 (defun anything-c-source-mark-ring-candidates ()
7508 (flet ((get-marks (pos)
7509 (save-excursion
7510 (goto-char pos)
7511 (beginning-of-line)
7512 (let ((line (car (split-string (thing-at-point 'line) "[\n\r]"))))
7513 (when (string= "" line)
7514 (setq line "<EMPTY LINE>"))
7515 (format "%7d: %s" (line-number-at-pos) line)))))
7516 (with-anything-current-buffer
7517 (loop
7518 with marks = (if (mark) (cons (mark-marker) mark-ring) mark-ring)
7519 with recip = nil
7520 for i in marks
7521 for m = (get-marks i)
7522 unless (member m recip)
7523 collect m into recip
7524 finally return recip))))
7526 (defvar anything-mark-ring-cache nil)
7527 (defvar anything-c-source-mark-ring
7528 '((name . "mark-ring")
7529 (init . (lambda ()
7530 (setq anything-mark-ring-cache
7531 (ignore-errors (anything-c-source-mark-ring-candidates)))))
7532 (candidates . (lambda ()
7533 (anything-aif anything-mark-ring-cache
7534 it)))
7535 (action . (("Goto line"
7536 . (lambda (candidate)
7537 (anything-goto-line (string-to-number candidate))))))
7538 (persistent-action . (lambda (candidate)
7539 (anything-goto-line (string-to-number candidate))
7540 (anything-match-line-color-current-line)))
7541 (persistent-help . "Show this line")))
7544 ;;; Global-mark-ring
7545 (defvar anything-c-source-global-mark-ring
7546 '((name . "global-mark-ring")
7547 (candidates . anything-c-source-global-mark-ring-candidates)
7548 (action . (("Goto line"
7549 . (lambda (candidate)
7550 (let ((items (split-string candidate ":")))
7551 (anything-c-switch-to-buffer (second items))
7552 (anything-goto-line (string-to-number (car items))))))))
7553 (persistent-action . (lambda (candidate)
7554 (let ((items (split-string candidate ":")))
7555 (anything-c-switch-to-buffer (second items))
7556 (anything-goto-line (string-to-number (car items)))
7557 (anything-match-line-color-current-line))))
7558 (persistent-help . "Show this line")))
7560 (defun anything-c-source-global-mark-ring-candidates ()
7561 (flet ((buf-fn (m)
7562 (with-current-buffer (marker-buffer m)
7563 (goto-char m)
7564 (beginning-of-line)
7565 (let (line)
7566 (if (string= "" line)
7567 (setq line "<EMPTY LINE>")
7568 (setq line (car (split-string (thing-at-point 'line)
7569 "[\n\r]"))))
7570 (format "%7d:%s: %s"
7571 (line-number-at-pos) (marker-buffer m) line)))))
7572 (loop
7573 with marks = global-mark-ring
7574 with recip = nil
7575 for i in marks
7576 for gm = (unless (or (string-match
7577 "^ " (format "%s" (marker-buffer i)))
7578 (null (marker-buffer i)))
7579 (buf-fn i))
7580 when (and gm (not (member gm recip)))
7581 collect gm into recip
7582 finally return recip)))
7586 ;;;; <Register>
7587 ;;; Insert from register
7588 (defvar anything-c-source-register
7589 '((name . "Registers")
7590 (candidates . anything-c-register-candidates)
7591 (action-transformer . anything-c-register-action-transformer)
7592 (multiline)
7593 (action))
7594 "See (info \"(emacs)Registers\")")
7596 (defun anything-c-register-candidates ()
7597 "Collecting register contents and appropriate commands."
7598 (loop for (char . val) in register-alist
7599 for key = (single-key-description char)
7600 for string-actions =
7601 (cond
7602 ((numberp val)
7603 (list (int-to-string val)
7604 'insert-register
7605 'increment-register))
7606 ((markerp val)
7607 (let ((buf (marker-buffer val)))
7608 (if (null buf)
7609 (list "a marker in no buffer")
7610 (list (concat
7611 "a buffer position:"
7612 (buffer-name buf)
7613 ", position "
7614 (int-to-string (marker-position val)))
7615 'jump-to-register
7616 'insert-register))))
7617 ((and (consp val) (window-configuration-p (car val)))
7618 (list "window configuration."
7619 'jump-to-register))
7620 ((and (consp val) (frame-configuration-p (car val)))
7621 (list "frame configuration."
7622 'jump-to-register))
7623 ((and (consp val) (eq (car val) 'file))
7624 (list (concat "file:"
7625 (prin1-to-string (cdr val))
7626 ".")
7627 'jump-to-register))
7628 ((and (consp val) (eq (car val) 'file-query))
7629 (list (concat "file:a file-query reference: file "
7630 (car (cdr val))
7631 ", position "
7632 (int-to-string (car (cdr (cdr val))))
7633 ".")
7634 'jump-to-register))
7635 ((consp val)
7636 (let ((lines (format "%4d" (length val))))
7637 (list (format "%s: %s\n" lines
7638 (truncate-string-to-width
7639 (mapconcat 'identity (list (car val))
7640 ;; (mapconcat (lambda (y) y) val
7641 "^J") (- (window-width) 15)))
7642 'insert-register)))
7643 ((stringp val)
7644 (list ;; without properties
7645 (substring-no-properties val)
7646 'insert-register
7647 'append-to-register
7648 'prepend-to-register))
7650 "GARBAGE!"))
7651 collect (cons (format "register %3s: %s" key (car string-actions))
7652 (cons char (cdr string-actions)))))
7654 (defun anything-c-register-action-transformer (actions register-and-functions)
7655 "Decide actions by the contents of register."
7656 (loop with func-actions =
7657 '((insert-register
7658 "Insert Register" .
7659 (lambda (c) (insert-register (car c))))
7660 (jump-to-register
7661 "Jump to Register" .
7662 (lambda (c) (jump-to-register (car c))))
7663 (append-to-register
7664 "Append Region to Register" .
7665 (lambda (c) (append-to-register
7666 (car c) (region-beginning) (region-end))))
7667 (prepend-to-register
7668 "Prepend Region to Register" .
7669 (lambda (c) (prepend-to-register
7670 (car c) (region-beginning) (region-end))))
7671 (increment-register
7672 "Increment Prefix Arg to Register" .
7673 (lambda (c) (increment-register
7674 anything-current-prefix-arg (car c)))))
7675 for func in (cdr register-and-functions)
7676 for cell = (assq func func-actions)
7677 when cell
7678 collect (cdr cell)))
7682 ;;; Latex completion
7683 (defun anything-c-latex-math-candidates ()
7684 "Collect candidates for latex math completion."
7685 (declare (special LaTeX-math-menu))
7686 (loop for i in (cddr LaTeX-math-menu)
7687 for elm = (loop for s in i when (vectorp s)
7688 collect (cons (aref s 0) (aref s 1)))
7689 append elm))
7691 (defvar anything-c-source-latex-math
7692 '((name . "Latex Math Menu")
7693 (init . (lambda ()
7694 (with-anything-current-buffer
7695 (LaTeX-math-mode 1))))
7696 (candidate-number-limit . 9999)
7697 (candidates . anything-c-latex-math-candidates)
7698 (action . (lambda (candidate)
7699 (call-interactively candidate)))))
7702 ;;;; <Headline Extraction>
7703 (defvar anything-c-source-fixme
7704 '((name . "TODO/FIXME/DRY comments")
7705 (headline . "^.*\\<\\(TODO\\|FIXME\\|DRY\\)\\>.*$")
7706 (adjust)
7707 (recenter))
7708 "Show TODO/FIXME/DRY comments in current file.")
7710 (defvar anything-c-source-rd-headline
7711 '((name . "RD HeadLine")
7712 (headline "^= \\(.+\\)$" "^== \\(.+\\)$" "^=== \\(.+\\)$" "^==== \\(.+\\)$")
7713 (condition . (memq major-mode '(rdgrep-mode rd-mode)))
7714 (migemo)
7715 (subexp . 1))
7716 "Show RD headlines.
7718 RD is Ruby's POD.
7719 http://en.wikipedia.org/wiki/Ruby_Document_format")
7721 (defvar anything-c-source-oddmuse-headline
7722 '((name . "Oddmuse HeadLine")
7723 (headline "^= \\(.+\\) =$" "^== \\(.+\\) ==$"
7724 "^=== \\(.+\\) ===$" "^==== \\(.+\\) ====$")
7725 (condition . (memq major-mode '(oddmuse-mode yaoddmuse-mode)))
7726 (migemo)
7727 (subexp . 1))
7728 "Show Oddmuse headlines, such as EmacsWiki.")
7730 (defvar anything-c-source-emacs-source-defun
7731 '((name . "Emacs Source DEFUN")
7732 (headline . "DEFUN\\|DEFVAR")
7733 (condition . (string-match "/emacs2[0-9].+/src/.+c$"
7734 (or buffer-file-name ""))))
7735 "Show DEFUN/DEFVAR in Emacs C source file.")
7737 (defvar anything-c-source-emacs-lisp-expectations
7738 '((name . "Emacs Lisp Expectations")
7739 (headline . "(desc[ ]\\|(expectations")
7740 (condition . (eq major-mode 'emacs-lisp-mode)))
7741 "Show descriptions (desc) in Emacs Lisp Expectations.
7743 http://www.emacswiki.org/cgi-bin/wiki/download/el-expectations.el")
7745 (defvar anything-c-source-emacs-lisp-toplevels
7746 '((name . "Emacs Lisp Toplevel / Level 4 Comment / Linkd Star")
7747 (headline . "^(\\|(@\\*\\|^;;;;")
7748 (get-line . buffer-substring)
7749 (condition . (eq major-mode 'emacs-lisp-mode))
7750 (adjust))
7751 "Show top-level forms, level 4 comments and linkd stars (optional) in Emacs Lisp.
7752 linkd.el is optional because linkd stars are extracted by regexp.
7753 http://www.emacswiki.org/cgi-bin/wiki/download/linkd.el")
7756 ;;; Anything yaoddmuse
7758 ;; Be sure to have yaoddmuse.el installed
7759 ;; install-elisp may be required if you want to install elisp file from here.
7760 (defvar anything-yaoddmuse-use-cache-file nil)
7761 (defvar anything-c-yaoddmuse-cache-file "~/.emacs.d/yaoddmuse-cache.el")
7762 (defvar anything-c-yaoddmuse-ew-cache nil)
7764 (defun anything-yaoddmuse-get-candidates ()
7765 (declare (special yaoddmuse-pages-hash))
7766 (if anything-yaoddmuse-use-cache-file
7767 (ignore-errors
7768 (unless anything-c-yaoddmuse-ew-cache
7769 (load anything-c-yaoddmuse-cache-file)
7770 (setq anything-c-yaoddmuse-ew-cache
7771 (gethash "EmacsWiki" yaoddmuse-pages-hash)))
7772 anything-c-yaoddmuse-ew-cache)
7773 (yaoddmuse-update-pagename t)
7774 (gethash "EmacsWiki" yaoddmuse-pages-hash)))
7776 (defvar anything-c-source-yaoddmuse-emacswiki-edit-or-view
7777 '((name . "Yaoddmuse Edit or View (EmacsWiki)")
7778 (candidates . anything-yaoddmuse-get-candidates)
7779 (action . (("Edit page" . (lambda (candidate)
7780 (yaoddmuse-edit "EmacsWiki" candidate)))
7781 ("Browse page"
7782 . (lambda (candidate)
7783 (yaoddmuse-browse-page "EmacsWiki" candidate)))
7784 ("Browse page other window"
7785 . (lambda (candidate)
7786 (if (one-window-p)
7787 (split-window-vertically))
7788 (yaoddmuse-browse-page "EmacsWiki" candidate)))
7789 ("Browse diff"
7790 . (lambda (candidate)
7791 (yaoddmuse-browse-page-diff "EmacsWiki" candidate)))
7792 ("Copy URL"
7793 . (lambda (candidate)
7794 (kill-new (yaoddmuse-url "EmacsWiki" candidate))
7795 (message "Have copy page %s's URL to yank." candidate)))
7796 ("Create page"
7797 . (lambda (candidate)
7798 (yaoddmuse-edit "EmacsWiki" anything-input)))
7799 ("Update cache"
7800 . (lambda (candidate)
7801 (if anything-yaoddmuse-use-cache-file
7802 (progn
7803 (anything-yaoddmuse-cache-pages t)
7804 (setq anything-c-yaoddmuse-ew-cache
7805 (gethash "EmacsWiki" yaoddmuse-pages-hash)))
7806 (yaoddmuse-update-pagename))))))
7807 (action-transformer anything-c-yaoddmuse-action-transformer))
7808 "Needs yaoddmuse.el.
7810 http://www.emacswiki.org/emacs/download/yaoddmuse.el")
7813 (defvar anything-c-source-yaoddmuse-emacswiki-post-library
7814 '((name . "Yaoddmuse Post library (EmacsWiki)")
7815 (init . (anything-yaoddmuse-init))
7816 (candidates-in-buffer)
7817 (action . (("Post library and Browse"
7818 . (lambda (candidate)
7819 (yaoddmuse-post-file
7820 (find-library-name candidate)
7821 "EmacsWiki"
7822 (file-name-nondirectory (find-library-name candidate))
7823 nil t)))
7824 ("Post library"
7825 . (lambda (candidate)
7826 (yaoddmuse-post-file
7827 (find-library-name candidate)
7828 "EmacsWiki"
7829 (file-name-nondirectory
7830 (find-library-name candidate))))))))
7831 "Needs yaoddmuse.el.
7833 http://www.emacswiki.org/emacs/download/yaoddmuse.el")
7836 (defun anything-c-yaoddmuse-action-transformer (actions candidate)
7837 "Allow the use of `install-elisp' only on elisp files."
7838 (if (string-match "\.el$" candidate)
7839 (append actions '(("Install Elisp"
7840 . (lambda (elm)
7841 (install-elisp-from-emacswiki elm)))))
7842 actions))
7844 ;;;###autoload
7845 (defun anything-yaoddmuse-cache-pages (&optional load)
7846 "Fetch the list of files on emacswiki and create cache file.
7847 If load is non--nil load the file and feed `yaoddmuse-pages-hash'."
7848 (interactive)
7849 (declare (special yaoddmuse-pages-hash))
7850 (yaoddmuse-update-pagename)
7851 (save-excursion
7852 (find-file anything-c-yaoddmuse-cache-file)
7853 (erase-buffer)
7854 (insert "(puthash \"EmacsWiki\" '(")
7855 (loop for i in (gethash "EmacsWiki" yaoddmuse-pages-hash)
7857 (insert (concat "(\"" (car i) "\") ")))
7858 (insert ") yaoddmuse-pages-hash)\n")
7859 (save-buffer)
7860 (kill-buffer (current-buffer))
7861 (when (or current-prefix-arg
7862 load)
7863 (load anything-c-yaoddmuse-cache-file))))
7865 (defun anything-yaoddmuse-init ()
7866 "Init anything buffer status."
7867 (let ((anything-buffer (anything-candidate-buffer 'global))
7868 (library-list (yaoddmuse-get-library-list)))
7869 (with-current-buffer anything-buffer
7870 ;; Insert library name.
7871 (dolist (library library-list)
7872 (insert (format "%s\n" library)))
7873 ;; Sort lines.
7874 (sort-lines nil (point-min) (point-max)))))
7877 ;;; Eev anchors
7878 (defvar anything-c-source-eev-anchor
7879 '((name . "Anchors")
7880 (candidates
7881 . (lambda ()
7882 (ignore-errors
7883 (with-anything-current-buffer
7884 (loop initially (goto-char (point-min))
7885 while (re-search-forward
7886 (format ee-anchor-format "\\([^\.].+\\)") nil t)
7887 for anchor = (match-string-no-properties 1)
7888 collect (cons (format "%5d:%s"
7889 (line-number-at-pos (match-beginning 0))
7890 (format ee-anchor-format anchor))
7891 anchor))))))
7892 (persistent-action . (lambda (item)
7893 (ee-to item)
7894 (anything-match-line-color-current-line)))
7895 (persistent-help . "Show this entry")
7896 (action . (("Goto link" . ee-to)))))
7899 ;;; Org headlines
7902 (defvar anything-c-source-org-headline
7903 `((name . "Org HeadLine")
7904 (headline
7905 ,@(mapcar
7906 (lambda (num)
7907 (format "^\\*\\{%d\\} \\(.+?\\)\\([ \t]*:[a-zA-Z0-9_@:]+:\\)?[ \t]*$"
7908 num))
7909 (number-sequence 1 8)))
7910 (condition . (eq major-mode 'org-mode))
7911 (migemo)
7912 (subexp . 1)
7913 (persistent-action . (lambda (elm)
7914 (anything-c-action-line-goto elm)
7915 (org-cycle)))
7916 (action-transformer
7917 . (lambda (actions candidate)
7918 '(("Go to Line" . anything-c-action-line-goto)
7919 ("Refile to this Headline" . anything-c-org-headline-refile)
7920 ("Insert Link to This Headline"
7921 . anything-c-org-headline-insert-link-to-headline)))))
7922 "Show Org headlines.
7923 org-mode is very very much extended text-mode/outline-mode.
7925 See (find-library \"org.el\")
7926 See http://orgmode.org for the latest version.")
7928 (defun anything-c-org-headline-insert-link-to-headline (lineno-and-content)
7929 (insert
7930 (save-excursion
7931 (anything-goto-line (car lineno-and-content))
7932 (and (looking-at org-complex-heading-regexp)
7933 (org-make-link-string (concat "*" (match-string 4)))))))
7935 (defun anything-c-org-headline-refile (lineno-and-content)
7936 "Refile current org entry to LINENO-AND-CONTENT."
7937 (with-anything-current-buffer
7938 (org-cut-subtree)
7939 (anything-goto-line (car lineno-and-content))
7940 (org-end-of-subtree t t)
7941 (let ((org-yank-adjusted-subtrees t))
7942 (org-yank))))
7945 ;;; Org keywords
7948 (defvar anything-c-source-org-keywords
7949 '((name . "Org Keywords")
7950 (init . anything-c-org-keywords-init)
7951 (candidates . anything-c-org-keywords-candidates)
7952 (action . anything-c-org-keywords-insert)
7953 (persistent-action . anything-c-org-keywords-show-help)
7954 (persistent-help . "Show an example and info page to describe this keyword.")
7955 (keywords-examples)
7956 (keywords)))
7958 (defvar anything-c-org-keywords-info-location
7959 '(("#+TITLE:" . "(org)Export options")
7960 ("#+AUTHOR:" . "(org)Export options")
7961 ("#+DATE:" . "(org)Export options")
7962 ("#+EMAIL:" . "(org)Export options")
7963 ("#+DESCRIPTION:" . "(org)Export options")
7964 ("#+KEYWORDS:" . "(org)Export options")
7965 ("#+LANGUAGE:" . "(org)Export options")
7966 ("#+TEXT:" . "(org)Export options")
7967 ("#+TEXT:" . "(org)Export options")
7968 ("#+OPTIONS:" . "(org)Export options")
7969 ("#+BIND:" . "(org)Export options")
7970 ("#+LINK_UP:" . "(org)Export options")
7971 ("#+LINK_HOME:" . "(org)Export options")
7972 ("#+LATEX_HEADER:" . "(org)Export options")
7973 ("#+EXPORT_SELECT_TAGS:" . "(org)Export options")
7974 ("#+EXPORT_EXCLUDE_TAGS:" . "(org)Export options")
7975 ("#+INFOJS_OPT" . "(org)Javascript support")
7976 ("#+BEGIN_HTML" . "(org)Quoting HTML tags")
7977 ("#+BEGIN_LaTeX" . "(org)Quoting LaTeX code")
7978 ("#+ORGTBL" . "(org)Radio tables")
7979 ("#+HTML:" . "(org)Quoting HTML tags")
7980 ("#+LaTeX:" . "(org)Quoting LaTeX code")
7981 ("#+BEGIN:" . "(org)Dynamic blocks") ;clocktable columnview
7982 ("#+BEGIN_EXAMPLE" . "(org)Literal examples")
7983 ("#+BEGIN_QUOTE" . "(org)Paragraphs")
7984 ("#+BEGIN_VERSE" . "(org)Paragraphs")
7985 ("#+BEGIN_SRC" . "(org)Literal examples")
7986 ("#+CAPTION" . "(org)Tables in HTML export")
7987 ("#+LABEL" . "(org)Tables in LaTeX export")
7988 ("#+ATTR_HTML" . "(org)Links")
7989 ("#+ATTR_LaTeX" . "(org)Images in LaTeX export")))
7991 (defun anything-c-org-keywords-init ()
7992 (unless (anything-attr 'keywords-examples)
7993 (require 'org)
7994 (anything-attrset 'keywords-examples
7995 (append
7996 (mapcar
7997 (lambda (x)
7998 (string-match "^#\\+\\(\\([A-Z_]+:?\\).*\\)" x)
7999 (cons (match-string 2 x) (match-string 1 x)))
8000 (org-split-string (org-get-current-options) "\n"))
8001 (mapcar 'list org-additional-option-like-keywords)))
8002 (anything-attrset 'keywords (mapcar 'car (anything-attr 'keywords-examples)))))
8004 (defun anything-c-org-keywords-candidates ()
8005 (and (or (eq (buffer-local-value 'major-mode anything-current-buffer) 'org-mode)
8006 (eq (buffer-local-value 'major-mode anything-current-buffer) 'message-mode))
8007 (anything-attr 'keywords)))
8009 (defun anything-c-org-keywords-insert (keyword)
8010 (cond ((and (string-match "BEGIN" keyword)
8011 (anything-region-active-p))
8012 (let ((beg (region-beginning))
8013 (end (region-end)))
8014 (goto-char end)
8015 (insert "\n#+" (replace-regexp-in-string
8016 "BEGIN" "END" keyword) "\n")
8017 (goto-char beg)
8018 (insert "#+" keyword " ")
8019 (save-excursion (insert "\n"))))
8020 ((string-match "BEGIN" keyword)
8021 (insert "#+" keyword " ")
8022 (save-excursion
8023 (insert "\n#+" (replace-regexp-in-string
8024 "BEGIN" "END" keyword) "\n")))
8025 (t (insert "#+" keyword " "))))
8027 (defun anything-c-org-keywords-show-help (keyword)
8028 (info (or (assoc-default (concat "#+" keyword) anything-c-org-keywords-info-location)
8029 "(org)In-buffer settings"))
8030 (search-forward (concat "#+" keyword) nil t)
8031 (anything-persistent-highlight-point)
8032 (message "%s" (or (cdr (assoc keyword (anything-attr 'keywords-examples))) "")))
8036 ;;; bbdb
8039 (defvar bbdb-records)
8040 (defvar bbdb-buffer-name)
8042 (defun anything-c-bbdb-candidates ()
8043 "Return a list of all names in the bbdb database. The format
8044 is \"Firstname Lastname\"."
8045 (mapcar (lambda (bbdb-record)
8046 (replace-regexp-in-string
8047 "\\s-+$" ""
8048 (concat (aref bbdb-record 0) " " (aref bbdb-record 1))))
8049 (bbdb-records)))
8051 (defun anything-c-bbdb-create-contact (actions candidate)
8052 "Action transformer that returns only an entry to add the
8053 current `anything-pattern' as new contact. All other actions are
8054 removed."
8055 (if (string= candidate "*Add to contacts*")
8056 '(("Add to contacts" . (lambda (actions)
8057 (bbdb-create-internal
8058 (read-from-minibuffer "Name: " anything-c-bbdb-name)
8059 (read-from-minibuffer "Company: ")
8060 (read-from-minibuffer "Email: ")
8063 (read-from-minibuffer "Note: ")))))
8064 actions))
8066 (defun anything-c-bbdb-get-record (candidate)
8067 "Return record that match CANDIDATE."
8068 (bbdb candidate nil)
8069 (set-buffer "*BBDB*")
8070 (bbdb-current-record))
8072 (defvar anything-c-bbdb-name nil
8073 "Only for internal use.")
8075 (defvar anything-c-source-bbdb
8076 '((name . "BBDB")
8077 (candidates . anything-c-bbdb-candidates)
8078 (action ("Send a mail" . anything-c-bbdb-compose-mail)
8079 ("View person's data" . anything-c-bbdb-view-person-action))
8080 (filtered-candidate-transformer . (lambda (candidates source)
8081 (setq anything-c-bbdb-name anything-pattern)
8082 (if (not candidates)
8083 (list "*Add to contacts*")
8084 candidates)))
8085 (action-transformer . (lambda (actions candidate)
8086 (anything-c-bbdb-create-contact actions candidate))))
8087 "Needs BBDB.
8089 http://bbdb.sourceforge.net/")
8091 (defun anything-c-bbdb-view-person-action (candidate)
8092 "View BBDB data of single CANDIDATE or marked candidates."
8093 (anything-aif (anything-marked-candidates)
8094 (let ((bbdb-append-records (length it)))
8095 (dolist (i it)
8096 (bbdb-redisplay-one-record (anything-c-bbdb-get-record i))))
8097 (bbdb-redisplay-one-record (anything-c-bbdb-get-record candidate))))
8099 (defun anything-c-bbdb-collect-mail-addresses ()
8100 "Return a list of all mail addresses of records in bbdb buffer."
8101 (with-current-buffer bbdb-buffer-name
8102 (loop for i in bbdb-records
8103 if (bbdb-record-net (car i))
8104 collect (bbdb-dwim-net-address (car i)))))
8106 (defun anything-c-bbdb-compose-mail (candidate)
8107 "Compose a mail with all records of bbdb buffer."
8108 (anything-c-bbdb-view-person-action candidate)
8109 (let* ((address-list (anything-c-bbdb-collect-mail-addresses))
8110 (address-str (mapconcat 'identity address-list ",\n ")))
8111 (compose-mail address-str)))
8114 ;;; Evaluation Result
8117 ;; Internal
8118 (defvar anything-eldoc-active-minibuffers-list nil)
8119 (defvar anything-eval-expression-input-history nil)
8121 (defvar anything-c-source-evaluation-result
8122 '((name . "Evaluation Result")
8123 (disable-shortcuts)
8124 (dummy)
8125 (multiline)
8126 (mode-line . "C-RET: nl-and-indent, tab: reindent, C-tab:complete, C-p/n: next/prec-line.")
8127 (filtered-candidate-transformer . (lambda (candidates source)
8128 (list
8129 (condition-case nil
8130 (with-anything-current-buffer
8131 (pp-to-string
8132 (eval (read anything-pattern))))
8133 (error "Error")))))
8134 (action . (("Copy result to kill-ring" . (lambda (candidate)
8135 (with-current-buffer anything-buffer
8136 (let ((end (save-excursion
8137 (goto-char (point-max))
8138 (search-backward "\n")
8139 (point))))
8140 (kill-region (point) end)))))
8141 ("copy sexp to kill-ring" . (lambda (candidate)
8142 (kill-new anything-input)))))))
8144 (defun anything-eval-new-line-and-indent ()
8145 (interactive)
8146 (newline) (lisp-indent-line))
8148 (defun anything-eldoc-store-minibuffer ()
8149 "Store minibuffer buffer name in `anything-eldoc-active-minibuffers-list'."
8150 (with-selected-window (minibuffer-window)
8151 (push (buffer-name) anything-eldoc-active-minibuffers-list)))
8153 (defun anything-eldoc-show-in-eval ()
8154 "Return eldoc in mode-line for current minibuffer input."
8155 (let ((buf (with-selected-window (minibuffer-window)
8156 (buffer-name))))
8157 (when (member buf anything-eldoc-active-minibuffers-list)
8158 (let* ((str-all (with-current-buffer buf
8159 (minibuffer-completion-contents)))
8160 (sym (when str-all
8161 (with-temp-buffer
8162 (insert str-all)
8163 (goto-char (point-max))
8164 (unless (looking-back ")\\|\"") (forward-char -1))
8165 (eldoc-current-symbol))))
8166 (info-fn (eldoc-fnsym-in-current-sexp))
8167 (doc (or (eldoc-get-var-docstring sym)
8168 (eldoc-get-fnsym-args-string
8169 (car info-fn) (cadr info-fn)))))
8170 (when doc (funcall anything-c-eldoc-in-minibuffer-show-fn doc))))))
8172 (defun anything-c-show-info-in-mode-line (str)
8173 "Display string STR in mode-line."
8174 (save-selected-window
8175 (with-current-buffer anything-buffer
8176 (let ((mode-line-format (concat " " str)))
8177 (force-mode-line-update)
8178 (sit-for anything-c-show-info-in-mode-line-delay))
8179 (force-mode-line-update))))
8181 ;;; Calculation Result
8184 (defvar anything-c-source-calculation-result
8185 '((name . "Calculation Result")
8186 (dummy)
8187 (filtered-candidate-transformer . (lambda (candidates source)
8188 (list
8189 (condition-case nil
8190 (calc-eval anything-pattern)
8191 (error "error")))))
8192 (action ("Copy result to kill-ring" . kill-new))))
8195 ;;; Google Suggestions
8198 ;; Internal
8199 (defvar anything-ggs-max-length-real-flag 0)
8200 (defvar anything-ggs-max-length-num-flag 0)
8202 (defun anything-c-google-suggest-fetch (input)
8203 "Fetch suggestions for INPUT from XML buffer.
8204 Return an alist with elements like (data . number_results)."
8205 (setq anything-ggs-max-length-real-flag 0
8206 anything-ggs-max-length-num-flag 0)
8207 (let ((request (concat anything-c-google-suggest-url
8208 (url-hexify-string input))))
8209 (flet ((fetch ()
8210 (loop
8211 with result-alist = (xml-get-children
8212 (car (xml-parse-region
8213 (point-min) (point-max)))
8214 'CompleteSuggestion)
8215 for i in result-alist
8216 for data = (cdr (caadr (assoc 'suggestion i)))
8217 for nqueries = (cdr (caadr (assoc 'num_queries i)))
8218 for lqueries = (length (anything-c-ggs-set-number-result
8219 nqueries))
8220 for ldata = (length data)
8222 (progn
8223 (when (> ldata anything-ggs-max-length-real-flag)
8224 (setq anything-ggs-max-length-real-flag ldata))
8225 (when (> lqueries anything-ggs-max-length-num-flag)
8226 (setq anything-ggs-max-length-num-flag lqueries)))
8227 collect (cons data nqueries) into cont
8228 finally return cont)))
8229 (if anything-google-suggest-use-curl-p
8230 (with-temp-buffer
8231 (call-process "curl" nil t nil request)
8232 (fetch))
8233 (with-current-buffer
8234 (url-retrieve-synchronously request)
8235 (fetch))))))
8237 (defun anything-c-google-suggest-set-candidates (&optional request-prefix)
8238 "Set candidates with result and number of google results found."
8239 (let ((suggestions
8240 (loop with suggested-results = (anything-c-google-suggest-fetch
8241 (or (and request-prefix
8242 (concat request-prefix
8243 " " anything-pattern))
8244 anything-pattern))
8245 for (real . numresult) in suggested-results
8246 ;; Prepare number of results with ","
8247 for fnumresult = (anything-c-ggs-set-number-result numresult)
8248 ;; Calculate number of spaces to add before fnumresult
8249 ;; if it is smaller than longest result
8250 ;; `anything-ggs-max-length-num-flag'.
8251 ;; e.g 1,234,567
8252 ;; 345,678
8253 ;; To be sure it is aligned properly.
8254 for nspaces = (if (< (length fnumresult)
8255 anything-ggs-max-length-num-flag)
8256 (- anything-ggs-max-length-num-flag
8257 (length fnumresult))
8259 ;; Add now the spaces before fnumresult.
8260 for align-fnumresult = (concat (make-string nspaces ? )
8261 fnumresult)
8262 for interval = (- anything-ggs-max-length-real-flag
8263 (length real))
8264 for spaces = (make-string (+ 2 interval) ? )
8265 for display = (format "%s%s(%s results)"
8266 real spaces align-fnumresult)
8267 collect (cons display real))))
8268 (if (loop for (disp . dat) in suggestions
8269 thereis (equal dat anything-pattern))
8270 suggestions
8271 ;; if there is no suggestion exactly matching the input then
8272 ;; prepend a Search on Google item to the list
8273 (append
8274 suggestions
8275 (list (cons (concat "Search for " "'" anything-input "'" " on Google")
8276 anything-input))))))
8278 (defun anything-c-ggs-set-number-result (num)
8279 (if num
8280 (progn
8281 (and (numberp num) (setq num (number-to-string num)))
8282 (loop for i in (reverse (split-string num "" t))
8283 for count from 1
8284 append (list i) into C
8285 when (= count 3)
8286 append (list ",") into C
8287 and do (setq count 0)
8288 finally return
8289 (replace-regexp-in-string
8290 "^," "" (mapconcat 'identity (reverse C) ""))))
8291 "?"))
8293 (defvar anything-c-google-suggest-default-browser-function nil
8294 "*The browse url function you prefer to use with google suggest.
8295 When nil, use the first browser function available
8296 See `anything-browse-url-default-browser-alist'.")
8298 (defun anything-c-google-suggest-action (candidate)
8299 "Default action to jump to a google suggested candidate."
8300 (let ((arg (concat anything-c-google-suggest-search-url
8301 (url-hexify-string candidate))))
8302 (anything-aif anything-c-google-suggest-default-browser-function
8303 (funcall it arg)
8304 (anything-c-browse-url arg))))
8306 (defvar anything-c-google-suggest-default-function
8307 'anything-c-google-suggest-set-candidates
8308 "Default function to use in anything google suggest.")
8310 (defvar anything-c-source-google-suggest
8311 '((name . "Google Suggest")
8312 (candidates . (lambda ()
8313 (funcall anything-c-google-suggest-default-function)))
8314 (action . (("Google Search" . anything-c-google-suggest-action)))
8315 (volatile)
8316 (requires-pattern . 3)
8317 (delayed)))
8319 (defun anything-c-google-suggest-emacs-lisp ()
8320 "Try to emacs lisp complete with google suggestions."
8321 (anything-c-google-suggest-set-candidates "emacs lisp"))
8324 ;;; Yahoo suggestions
8327 (defun anything-c-yahoo-suggest-fetch (input)
8328 "Fetch Yahoo suggestions for INPUT from XML buffer.
8329 Return an alist with elements like (data . number_results)."
8330 (let ((request (concat anything-c-yahoo-suggest-url
8331 (url-hexify-string input))))
8332 (flet ((fetch ()
8333 (loop
8334 with result-alist = (xml-get-children
8335 (car (xml-parse-region
8336 (point-min) (point-max)))
8337 'Result)
8338 for i in result-alist
8339 collect (caddr i))))
8340 (with-current-buffer
8341 (url-retrieve-synchronously request)
8342 (fetch)))))
8344 (defun anything-c-yahoo-suggest-set-candidates ()
8345 "Set candidates with Yahoo results found."
8346 (let ((suggestions (anything-c-yahoo-suggest-fetch anything-input)))
8347 (or suggestions
8348 (append
8349 suggestions
8350 (list (cons (concat "Search for " "'" anything-input "'" " on Yahoo")
8351 anything-input))))))
8353 (defun anything-c-yahoo-suggest-action (candidate)
8354 "Default action to jump to a Yahoo suggested candidate."
8355 (anything-c-browse-url (concat anything-c-yahoo-suggest-search-url
8356 (url-hexify-string candidate))))
8358 (defvar anything-c-source-yahoo-suggest
8359 '((name . "Yahoo Suggest")
8360 (candidates . anything-c-yahoo-suggest-set-candidates)
8361 (action . (("Yahoo Search" . anything-c-yahoo-suggest-action)))
8362 (volatile)
8363 (requires-pattern . 3)
8364 (delayed)))
8368 ;;; Web browser functions.
8371 (require 'browse-url)
8372 ;; If default setting of `w3m-command' is not
8373 ;; what you want you and you modify it, you will have to reeval
8374 ;; also `anything-browse-url-default-browser-alist'.
8375 (defvar w3m-command "/usr/bin/w3m")
8376 (defvar anything-c-home-url "http://www.google.fr"
8377 "*Default url to use as home url.")
8379 (defvar ac-browse-url-chromium-program "chromium-browser")
8380 (defvar ac-browse-url-uzbl-program "uzbl-browser")
8381 (defvar anything-browse-url-default-browser-alist
8382 `((,w3m-command . w3m-browse-url)
8383 (,browse-url-firefox-program . browse-url-firefox)
8384 (,ac-browse-url-chromium-program . ac-browse-url-chromium)
8385 (,ac-browse-url-uzbl-program . ac-browse-url-uzbl)
8386 (,browse-url-kde-program . browse-url-kde)
8387 (,browse-url-gnome-moz-program . browse-url-gnome-moz)
8388 (,browse-url-mozilla-program . browse-url-mozilla)
8389 (,browse-url-galeon-program . browse-url-galeon)
8390 (,browse-url-netscape-program . browse-url-netscape)
8391 (,browse-url-mosaic-program . browse-url-mosaic)
8392 (,browse-url-xterm-program . browse-url-text-xterm))
8393 "*Alist of \(executable . function\) to try to find a suitable url browser.")
8395 (defun* anything-c-generic-browser (url name &rest args)
8396 "Browse URL with NAME browser."
8397 (let ((proc (concat name " " url)))
8398 (message "Starting %s..." name)
8399 (apply 'start-process proc nil name
8400 (append args (list url)))
8401 (set-process-sentinel
8402 (get-process proc)
8403 #'(lambda (process event)
8404 (when (string= event "finished\n")
8405 (message "%s process %s" process event))))))
8407 (defun ac-browse-url-chromium (url)
8408 "Browse URL with google chrome browser."
8409 (interactive "sURL: ")
8410 (anything-c-generic-browser
8411 url ac-browse-url-chromium-program))
8413 (defun ac-browse-url-uzbl (url &optional ignore)
8414 "Browse URL with uzbl browser."
8415 (interactive "sURL: ")
8416 (anything-c-generic-browser url ac-browse-url-uzbl-program "-u"))
8418 (defun anything-browse-url-default-browser (url &rest args)
8419 "Find the first available browser and ask it to load URL."
8420 (let ((default-browser-fn
8421 (loop for (exe . fn) in anything-browse-url-default-browser-alist
8422 thereis (and exe (executable-find exe) fn))))
8423 (if default-browser-fn
8424 (apply default-browser-fn url args)
8425 (error "No usable browser found"))))
8427 (defun anything-c-browse-url (url &rest args)
8428 "Default command to browse URL."
8429 (if browse-url-browser-function
8430 (browse-url url args)
8431 (anything-browse-url-default-browser url args)))
8434 ;;; Surfraw
8436 ;; Need external program surfraw.
8437 ;; <http://surfraw.alioth.debian.org/>
8439 (defvar anything-surfraw-default-browser-function nil
8440 "*The browse url function you prefer to use with surfraw.
8441 When nil, fallback to `browse-url-browser-function'.")
8443 ;; Internal
8444 (defvar anything-surfraw-engines-history nil)
8445 (defvar anything-surfraw-input-history nil)
8447 (defun anything-c-build-elvi-list ()
8448 "Return list of all engines and descriptions handled by surfraw."
8449 (cdr
8450 (with-temp-buffer
8451 (call-process "surfraw" nil t nil
8452 "-elvi")
8453 (split-string (buffer-string) "\n"))))
8456 ;;; Emms
8459 (defun anything-emms-stream-edit-bookmark (elm)
8460 "Change the information of current emms-stream bookmark from anything."
8461 (declare (special emms-stream-list))
8462 (let* ((cur-buf anything-current-buffer)
8463 (bookmark (assoc elm emms-stream-list))
8464 (name (read-from-minibuffer "Description: "
8465 (nth 0 bookmark)))
8466 (url (read-from-minibuffer "URL: "
8467 (nth 1 bookmark)))
8468 (fd (read-from-minibuffer "Feed Descriptor: "
8469 (int-to-string (nth 2 bookmark))))
8470 (type (read-from-minibuffer "Type (url, streamlist, or lastfm): "
8471 (format "%s" (car (last bookmark))))))
8472 (save-window-excursion
8473 (emms-streams)
8474 (when (re-search-forward (concat "^" name) nil t)
8475 (beginning-of-line)
8476 (emms-stream-delete-bookmark)
8477 (emms-stream-add-bookmark name url (string-to-number fd) type)
8478 (emms-stream-save-bookmarks-file)
8479 (emms-stream-quit)
8480 (anything-c-switch-to-buffer cur-buf)))))
8482 (defun anything-emms-stream-delete-bookmark (candidate)
8483 "Delete emms-streams bookmarks from anything."
8484 (let* ((cands (anything-marked-candidates))
8485 (bmks (loop for bm in cands collect
8486 (car (assoc bm emms-stream-list))))
8487 (bmk-reg (mapconcat 'regexp-quote bmks "\\|^")))
8488 (when (y-or-n-p (format "Really delete radios\n -%s: ? "
8489 (mapconcat 'identity bmks "\n -")))
8490 (save-window-excursion
8491 (emms-streams)
8492 (goto-char (point-min))
8493 (loop while (re-search-forward bmk-reg nil t)
8494 do (progn (beginning-of-line)
8495 (emms-stream-delete-bookmark))
8496 finally do (progn
8497 (emms-stream-save-bookmarks-file)
8498 (emms-stream-quit)))))))
8500 (defvar anything-c-source-emms-streams
8501 '((name . "Emms Streams")
8502 (init . (lambda ()
8503 (emms-stream-init)))
8504 (candidates . (lambda ()
8505 (declare (special emms-stream-list))
8506 (mapcar 'car emms-stream-list)))
8507 (action . (("Play" . (lambda (elm)
8508 (declare (special emms-stream-list))
8509 (let* ((stream (assoc elm emms-stream-list))
8510 (fn (intern (concat "emms-play-" (symbol-name (car (last stream))))))
8511 (url (second stream)))
8512 (funcall fn url))))
8513 ("Delete" . anything-emms-stream-delete-bookmark)
8514 ("Edit" . anything-emms-stream-edit-bookmark)))
8515 (filtered-candidate-transformer . anything-c-adaptive-sort)))
8517 ;; Don't forget to set `emms-source-file-default-directory'
8518 (defvar anything-c-source-emms-dired
8519 '((name . "Music Directory")
8520 (candidates . (lambda ()
8521 (cddr (directory-files emms-source-file-default-directory))))
8522 (action .
8523 (("Play Directory" . (lambda (item)
8524 (emms-play-directory
8525 (expand-file-name
8526 item
8527 emms-source-file-default-directory))))
8528 ("Open dired in file's directory" . (lambda (item)
8529 (anything-c-open-dired
8530 (expand-file-name
8531 item
8532 emms-source-file-default-directory))))))
8533 (filtered-candidate-transformer . anything-c-adaptive-sort)))
8536 (defun anything-c-emms-files-modifier (candidates source)
8537 (let ((current-playlist (with-current-emms-playlist
8538 (loop with cur-list = (emms-playlist-tracks-in-region
8539 (point-min) (point-max))
8540 for i in cur-list
8541 for name = (assoc-default 'name i)
8542 when name
8543 collect name))))
8544 (loop for i in candidates
8545 if (member (cdr i) current-playlist)
8546 collect (cons (propertize (car i)
8547 'face 'anything-emms-playlist)
8548 (cdr i)) into lis
8549 else collect i into lis
8550 finally return (reverse lis))))
8552 (defun anything-c-emms-play-current-playlist ()
8553 "Play current playlist."
8554 (with-current-emms-playlist
8555 (emms-playlist-first)
8556 (emms-playlist-mode-play-smart)))
8558 (defvar anything-c-source-emms-files
8559 '((name . "Emms files")
8560 (candidates . (lambda ()
8561 (loop for v being the hash-values in emms-cache-db
8562 for name = (assoc-default 'name v)
8563 for artist = (or (assoc-default 'info-artist v) "unknown")
8564 for genre = (or (assoc-default 'info-genre v) "unknown")
8565 for tracknum = (or (assoc-default 'info-tracknumber v) "unknown")
8566 for song = (or (assoc-default 'info-title v) "unknown")
8567 for info = (concat artist " - " genre " - " tracknum ": " song)
8568 unless (string-match "^\\(http\\|mms\\):" name)
8569 collect (cons info name))))
8570 (filtered-candidate-transformer . anything-c-emms-files-modifier)
8571 (candidate-number-limit . 9999)
8572 (action . (("Play file" . emms-play-file)
8573 ("Add to Playlist and play (C-u clear current)"
8574 . (lambda (candidate)
8575 (when anything-current-prefix-arg
8576 (emms-playlist-current-clear))
8577 (emms-playlist-new)
8578 (mapc 'emms-add-playlist-file (anything-marked-candidates))
8579 (unless emms-player-playing-p
8580 (anything-c-emms-play-current-playlist))))))))
8584 ;;; Jabber Contacts (jabber.el)
8585 (defun anything-c-jabber-online-contacts ()
8586 "List online Jabber contacts."
8587 (with-no-warnings
8588 (let (jids)
8589 (dolist (item (jabber-concat-rosters) jids)
8590 (when (get item 'connected)
8591 (push (if (get item 'name)
8592 (cons (get item 'name) item)
8593 (cons (symbol-name item) item)) jids))))))
8595 (defvar anything-c-source-jabber-contacts
8596 '((name . "Jabber Contacts")
8597 (init . (lambda () (require 'jabber)))
8598 (candidates . (lambda () (mapcar 'car (anything-c-jabber-online-contacts))))
8599 (action . (lambda (x)
8600 (jabber-chat-with
8601 (jabber-read-account)
8602 (symbol-name
8603 (cdr (assoc x (anything-c-jabber-online-contacts)))))))))
8607 ;;; Call source.
8608 (defvar anything-source-select-buffer "*anything source select*")
8609 (defvar anything-c-source-call-source
8610 `((name . "Call anything source")
8611 (candidate-number-limit)
8612 (candidates
8613 . (lambda ()
8614 (loop for vname in (all-completions "anything-c-source-" obarray)
8615 for var = (intern vname)
8616 for name = (ignore-errors (assoc-default 'name (symbol-value var)))
8617 if name collect
8618 (cons (format "%s `%s'"
8619 name (propertize vname 'face 'font-lock-variable-name-face))
8620 var))))
8621 (action
8622 . (("Invoke anything with selected source"
8624 (lambda (candidate)
8625 (setq anything-candidate-number-limit 9999)
8626 (anything candidate nil nil nil nil
8627 anything-source-select-buffer)))
8628 ("Describe variable" . describe-variable)
8629 ("Find variable" . find-variable)))
8630 (persistent-action . describe-variable)
8631 (persistent-help . "Show description of this source")))
8633 (defun anything-call-source-from-anything ()
8634 "Call anything source within `anything' session."
8635 (interactive)
8636 (setq anything-input-idle-delay 0)
8637 (anything-set-sources '(anything-c-source-call-source)))
8639 ;;; Execute Preconfigured anything.
8640 (defvar anything-c-source-anything-commands
8641 '((name . "Preconfigured Anything")
8642 (candidates . anything-c-anything-commands-candidates)
8643 (type . command)
8644 (candidate-number-limit)))
8646 (defun anything-c-anything-commands-candidates ()
8647 (loop for (cmd . desc) in (anything-c-list-preconfigured-anything)
8648 collect (cons (if (where-is-internal cmd nil t)
8649 (substitute-command-keys (format "M-x %s (\\[%s]) : %s" cmd cmd desc))
8650 (substitute-command-keys (format "\\[%s] : %s" cmd desc)))
8651 cmd)))
8654 ;;; Occur
8657 (defun anything-c-occur-init ()
8658 "Create the initial anything occur buffer.
8659 If region is active use region as buffer contents
8660 instead of whole buffer."
8661 (with-current-buffer (anything-candidate-buffer 'global)
8662 (erase-buffer)
8663 (let ((buf-contents
8664 (with-anything-current-buffer
8665 (if (anything-region-active-p)
8666 (buffer-substring (region-beginning) (region-end))
8667 (buffer-substring (point-min) (point-max))))))
8668 (insert buf-contents))))
8670 (defun anything-c-occur-get-line (s e)
8671 (format "%7d:%s" (line-number-at-pos (1- s)) (buffer-substring s e)))
8673 (defun anything-c-occur-query-replace-regexp (candidate)
8674 "Query replace regexp starting from CANDIDATE.
8675 If region is active ignore CANDIDATE and replace only in region.
8676 With a prefix arg replace only matches surrounded by word boundaries,
8677 i.e Don't replace inside a word, regexp is surrounded with \\bregexp\\b."
8678 (let ((regexp anything-input))
8679 (unless (anything-region-active-p)
8680 (anything-c-action-line-goto candidate))
8681 (apply 'query-replace-regexp
8682 (anything-c-query-replace-args regexp))))
8684 (defun anything-occur-run-query-replace-regexp ()
8685 "Run `query-replace-regexp' in anything occur from keymap."
8686 (interactive)
8687 (anything-c-quit-and-execute-action
8688 'anything-c-occur-query-replace-regexp))
8690 (defvar anything-c-source-occur
8691 `((name . "Occur")
8692 (init . anything-c-occur-init)
8693 (candidates-in-buffer)
8694 (migemo)
8695 (get-line . anything-c-occur-get-line)
8696 (display-to-real . anything-c-display-to-real-line)
8697 (action . (("Go to Line" . anything-c-action-line-goto)
8698 ("Query replace regexp (C-u Not inside word.)"
8699 . anything-c-occur-query-replace-regexp)))
8700 (recenter)
8701 (mode-line . anything-occur-mode-line)
8702 (keymap . ,anything-occur-map)
8703 (requires-pattern . 1)
8704 (delayed)))
8707 ;;; Anything browse code.
8708 (defun anything-c-browse-code-get-line (beg end)
8709 "Select line if it match the regexp corresponding to current `major-mode'.
8710 Line is parsed for BEG position to END position."
8711 (let ((str-line (buffer-substring beg end))
8712 (regexp (assoc-default major-mode
8713 anything-c-browse-code-regexp-alist))
8714 (num-line (if (string= anything-pattern "") beg (1- beg))))
8715 (when (and regexp (string-match regexp str-line))
8716 (format "%4d:%s" (line-number-at-pos num-line) str-line))))
8719 (defvar anything-c-source-browse-code
8720 '((name . "Browse code")
8721 (init . (lambda ()
8722 (anything-candidate-buffer anything-current-buffer)
8723 (with-anything-current-buffer
8724 (jit-lock-fontify-now))))
8725 (candidate-number-limit . 9999)
8726 (candidates-in-buffer)
8727 (get-line . anything-c-browse-code-get-line)
8728 (type . line)
8729 (recenter)))
8732 ;; Do many actions for input
8733 (defvar anything-c-source-create
8734 '((name . "Create")
8735 (dummy)
8736 (action)
8737 (action-transformer . anything-create--actions))
8738 "Do many create actions from `anything-pattern'.
8739 See also `anything-create--actions'.")
8741 (defun anything-create-from-anything ()
8742 "Run `anything-create' from `anything' as a fallback."
8743 (interactive)
8744 (anything-run-after-quit 'anything-create nil anything-pattern))
8746 (defun anything-create--actions (&rest ignored)
8747 "Default actions for `anything-create' / `anything-c-source-create'."
8748 (remove-if-not
8749 (lambda (pair) (and (consp pair) (functionp (cdr pair))))
8750 (append anything-create--actions-private
8751 '(("find-file" . find-file)
8752 ("find-file other window" . find-file-other-window)
8753 ("New buffer" . anything-c-switch-to-buffer)
8754 ("New buffer other window" . switch-to-buffer-other-window)
8755 ("Bookmark Set" . bookmark-set)
8756 ("Set Register" .
8757 (lambda (x) (set-register (read-char "Register: ") x)))
8758 ("Insert Linkd star" . linkd-insert-star)
8759 ("Insert Linkd Tag" . linkd-insert-tag)
8760 ("Insert Linkd Link" . linkd-insert-link)
8761 ("Insert Linkd Lisp" . linkd-insert-lisp)
8762 ("Insert Linkd Wiki" . linkd-insert-wiki)
8763 ("Google Search" . google)))))
8766 ;; Minibuffer History
8769 (defvar anything-c-source-minibuffer-history
8770 '((name . "Minibuffer History")
8771 (header-name . (lambda (name)
8772 (format "%s (%s)" name minibuffer-history-variable)))
8773 (candidates
8774 . (lambda ()
8775 (let ((history (loop for i in
8776 (symbol-value minibuffer-history-variable)
8777 unless (string= "" i) collect i)))
8778 (if (consp (car history))
8779 (mapcar 'prin1-to-string history)
8780 history))))
8781 (migemo)
8782 (action . insert)))
8785 ;;; Elscreen
8788 (defvar anything-c-source-elscreen
8789 '((name . "Elscreen")
8790 (candidates
8791 . (lambda ()
8792 (if (cdr (elscreen-get-screen-to-name-alist))
8793 (sort
8794 (loop for sname in (elscreen-get-screen-to-name-alist)
8795 append (list (format "[%d] %s" (car sname) (cdr sname))))
8796 #'(lambda (a b) (compare-strings a nil nil b nil nil))))))
8797 (action
8798 . (("Change Screen" .
8799 (lambda (candidate)
8800 (elscreen-goto (- (aref candidate 1) (aref "0" 0)))))
8801 ("Kill Screen(s)" .
8802 (lambda (candidate)
8803 (dolist (i (anything-marked-candidates))
8804 (elscreen-goto (- (aref i 1) (aref "0" 0)))
8805 (elscreen-kill))))
8806 ("Only Screen" .
8807 (lambda (candidate)
8808 (elscreen-goto (- (aref candidate 1) (aref "0" 0)))
8809 (elscreen-kill-others)))))))
8812 ;;;; <System>
8814 ;;; Top (process)
8815 (defvar anything-c-top-command "COLUMNS=%s top -b -n 1"
8816 "Top command (batch mode). %s is replaced with `frame-width'.")
8817 (defvar anything-c-source-top
8818 '((name . "Top (Press C-c C-u to refresh)")
8819 (init . anything-c-top-init)
8820 (candidates-in-buffer)
8821 (display-to-real . anything-c-top-display-to-real)
8822 (persistent-action . anything-c-top-sh-persistent-action)
8823 (persistent-help . "SIGTERM")
8824 (action
8825 ("kill (TERM)" . (lambda (pid)
8826 (anything-c-top-sh (format "kill -TERM %s" pid))))
8827 ("kill (KILL)" . (lambda (pid)
8828 (anything-c-top-sh (format "kill -KILL %s" pid))))
8829 ("Copy PID" . (lambda (pid) (kill-new pid))))))
8831 (defun anything-c-top-sh (cmd)
8832 (message "Executed %s\n%s" cmd (shell-command-to-string cmd)))
8834 (defun anything-c-top-sh-persistent-action (pid)
8835 (delete-other-windows)
8836 (anything-c-top-sh (format "kill -TERM %s" pid))
8837 (anything-force-update))
8839 (defun anything-c-top-init ()
8840 (with-current-buffer (anything-candidate-buffer 'global)
8841 (call-process-shell-command
8842 (format anything-c-top-command
8843 (- (frame-width) (if anything-enable-digit-shortcuts 4 0)))
8844 nil (current-buffer))))
8846 (defun anything-c-top-display-to-real (line)
8847 (car (split-string line)))
8849 ;;; Timers
8850 (defvar anything-c-source-absolute-time-timers
8851 '((name . "Absolute Time Timers")
8852 (candidates . timer-list)
8853 (type . timer)))
8855 (defvar anything-c-source-idle-time-timers
8856 '((name . "Idle Time Timers")
8857 (candidates . timer-idle-list)
8858 (type . timer)))
8860 (defun anything-c-timer-real-to-display (timer)
8861 (destructuring-bind (triggered t1 t2 t3 repeat-delay func args idle-delay)
8862 (append timer nil) ;use `append' to convert vector->list
8863 (format "%s repeat=%5S %s(%s)"
8864 (let ((time (list t1 t2 t3)))
8865 (if idle-delay
8866 (format-time-string "idle-for=%5s" time)
8867 (format-time-string "%m/%d %T" time)))
8868 repeat-delay
8869 func
8870 (mapconcat 'prin1-to-string args " "))))
8872 ;;; X RandR resolution change
8875 ;;; FIXME I do not care multi-display.
8877 (defun anything-c-xrandr-info ()
8878 "Return a pair with current X screen number and current X display name."
8879 (with-temp-buffer
8880 (call-process "xrandr" nil (current-buffer) nil
8881 "--current")
8882 (let (screen output)
8883 (goto-char (point-min))
8884 (save-excursion
8885 (when (re-search-forward "\\(^Screen \\)\\([0-9]\\):" nil t)
8886 (setq screen (match-string 2))))
8887 (when (re-search-forward "^\\(.*\\) connected" nil t)
8888 (setq output (match-string 1)))
8889 (list screen output))))
8891 (defun anything-c-xrandr-screen ()
8892 "Return current X screen number."
8893 (car (anything-c-xrandr-info)))
8895 (defun anything-c-xrandr-output ()
8896 "Return current X display name."
8897 (cadr (anything-c-xrandr-info)))
8899 (defvar anything-c-source-xrandr-change-resolution
8900 '((name . "Change Resolution")
8901 (candidates
8902 . (lambda ()
8903 (with-temp-buffer
8904 (call-process "xrandr" nil (current-buffer) nil
8905 "--screen" (anything-c-xrandr-screen) "-q")
8906 (goto-char 1)
8907 (loop with modes = nil
8908 while (re-search-forward " \\([0-9]+x[0-9]+\\)" nil t)
8909 for mode = (match-string 1)
8910 unless (member mode modes)
8911 collect mode into modes
8912 finally return modes))))
8913 (action
8914 ("Change Resolution"
8915 . (lambda (mode)
8916 (call-process "xrandr" nil nil nil
8917 "--screen" (anything-c-xrandr-screen)
8918 "--output" (anything-c-xrandr-output)
8919 "--mode" mode))))))
8921 ;;; Xfont selection
8924 (defun anything-c-persistent-xfont-action (elm)
8925 "Show current font temporarily"
8926 (let ((current-font (cdr (assoc 'font (frame-parameters))))
8927 (default-font elm))
8928 (unwind-protect
8929 (progn (set-frame-font default-font 'keep-size) (sit-for 2))
8930 (set-frame-font current-font))))
8932 (defvar anything-c-xfonts-cache nil)
8933 (defvar anything-c-source-xfonts
8934 '((name . "X Fonts")
8935 (init . (lambda ()
8936 (unless anything-c-xfonts-cache
8937 (setq anything-c-xfonts-cache
8938 (x-list-fonts "*")))))
8939 (candidates . anything-c-xfonts-cache)
8940 (action . (("Copy to kill ring" . (lambda (elm)
8941 (kill-new elm)))
8942 ("Set Font" . (lambda (elm)
8943 (kill-new elm)
8944 (set-frame-font elm 'keep-size)
8945 (message "New font have been copied to kill ring")))))
8946 (persistent-action . anything-c-persistent-xfont-action)
8947 (persistent-help . "Switch to this font temporarily")))
8949 ;;; 𝕌𝕔𝕤 𝕊𝕪𝕞𝕓𝕠𝕝 𝕔𝕠𝕞𝕡𝕝𝕖𝕥𝕚𝕠𝕟
8952 (defvar anything-c-ucs-max-len 0)
8953 (defun anything-c-calculate-ucs-max-len ()
8954 "Calculate the length of longest `ucs-names' candidate."
8955 (loop with count = 0
8956 for (n . v) in (ucs-names)
8957 for len = (length n)
8958 if (> len count)
8959 do (setq count len)
8960 finally return count))
8962 (defun anything-c-ucs-init ()
8963 "Initialize an anything buffer with ucs symbols.
8964 Only math* symbols are collected."
8965 (unless (> anything-c-ucs-max-len 0)
8966 (setq anything-c-ucs-max-len
8967 (anything-c-calculate-ucs-max-len)))
8968 (with-current-buffer (anything-candidate-buffer
8969 (get-buffer-create "*anything ucs*"))
8970 ;; `ucs-names' fn will not run again, data is cached in
8971 ;; var `ucs-names'.
8972 (loop for (n . v) in (ucs-names)
8973 for len = (length n)
8974 for diff = (+ (- anything-c-ucs-max-len len) 2)
8975 unless (string= "" n)
8976 do (progn (insert (concat
8977 n ":"
8978 (make-string
8979 diff ? )))
8980 (ucs-insert v)
8981 (insert "\n")))))
8983 (defun anything-c-ucs-forward-char (candidate)
8984 (with-anything-current-buffer
8985 (forward-char 1)))
8987 (defun anything-c-ucs-backward-char (candidate)
8988 (with-anything-current-buffer
8989 (forward-char -1)))
8991 (defun anything-c-ucs-delete-backward (candidate)
8992 (with-anything-current-buffer
8993 (delete-char -1)))
8995 (defun anything-c-ucs-insert-char (candidate)
8996 (with-anything-current-buffer
8997 (insert
8998 (replace-regexp-in-string
8999 " " ""
9000 (cadr (split-string candidate ":"))))))
9002 (defun anything-c-ucs-persistent-insert ()
9003 (interactive)
9004 (anything-attrset 'action-insert 'anything-c-ucs-insert-char)
9005 (anything-execute-persistent-action 'action-insert))
9007 (defun anything-c-ucs-persistent-forward ()
9008 (interactive)
9009 (anything-attrset 'action-forward 'anything-c-ucs-forward-char)
9010 (anything-execute-persistent-action 'action-forward))
9012 (defun anything-c-ucs-persistent-backward ()
9013 (interactive)
9014 (anything-attrset 'action-back 'anything-c-ucs-backward-char)
9015 (anything-execute-persistent-action 'action-back))
9017 (defun anything-c-ucs-persistent-delete ()
9018 (interactive)
9019 (anything-attrset 'action-delete 'anything-c-ucs-delete-backward)
9020 (anything-execute-persistent-action 'action-delete))
9022 (defvar anything-c-source-ucs
9023 '((name . "Ucs names")
9024 (init . anything-c-ucs-init)
9025 (candidate-number-limit . 9999)
9026 (candidates-in-buffer)
9027 (mode-line . anything-c-ucs-mode-line-string)
9028 (action . (("Insert" . anything-c-ucs-insert-char)
9029 ("Forward char" . anything-c-ucs-forward-char)
9030 ("Backward char" . anything-c-ucs-backward-char)
9031 ("Delete char backward" . anything-c-ucs-delete-backward))))
9032 "Source for collecting `ucs-names' math symbols.")
9035 ;;; Emacs process
9038 (defvar anything-c-source-emacs-process
9039 '((name . "Emacs Process")
9040 (candidates . (lambda () (mapcar #'process-name (process-list))))
9041 (persistent-action . (lambda (elm)
9042 (delete-process (get-process elm))
9043 (anything-delete-current-selection)))
9044 (persistent-help . "Kill Process")
9045 (action ("Kill Process" . (lambda (elm)
9046 (delete-process (get-process elm)))))))
9048 ;;; World time
9051 (defvar anything-c-source-time-world
9052 '((name . "Time World List")
9053 (init . (lambda ()
9054 (let ((anything-buffer (anything-candidate-buffer 'global)))
9055 (with-current-buffer anything-buffer
9056 (display-time-world-display display-time-world-list)))))
9057 (candidates-in-buffer)))
9061 ;;; Anything interface for Debian/Ubuntu packages (apt-*)
9064 (defvar anything-c-source-apt
9065 '((name . "APT")
9066 (init . anything-c-apt-init)
9067 (candidates-in-buffer)
9068 (candidate-transformer anything-c-apt-candidate-transformer)
9069 (display-to-real . anything-c-apt-display-to-real)
9070 (requires-pattern . 2)
9071 (update . anything-c-apt-refresh)
9072 (action
9073 ("Show package description" . anything-c-apt-cache-show)
9074 ("Install package" . anything-c-apt-install)
9075 ("Reinstall package" . anything-c-apt-reinstall)
9076 ("Remove package" . anything-c-apt-uninstall)
9077 ("Purge package" . anything-c-apt-purge))
9078 (persistent-action . anything-c-apt-persistent-action)
9079 (persistent-help . "Show package description")))
9081 (defvar anything-c-apt-query "emacs")
9082 (defvar anything-c-apt-search-command "apt-cache search '%s'")
9083 (defvar anything-c-apt-show-command "apt-cache show '%s'")
9084 (defvar anything-c-apt-installed-packages nil)
9085 (defvar anything-c-apt-all-packages nil)
9086 (defvar anything-c-apt-input-history nil)
9088 (defun anything-c-apt-refresh ()
9089 "Refresh installed candidates list."
9090 (setq anything-c-apt-installed-packages nil)
9091 (setq anything-c-apt-all-packages nil))
9093 (defun anything-c-apt-persistent-action (candidate)
9094 "Persistent action for APT source."
9095 (anything-c-apt-cache-show candidate))
9097 (defun anything-c-apt-candidate-transformer (candidates)
9098 "Show installed CANDIDATES and the ones to deinstall in a different color."
9099 (loop for cand in candidates
9100 for name = (anything-c-apt-display-to-real cand)
9101 collect (cond ((string= (assoc-default
9102 name anything-c-apt-installed-packages)
9103 "deinstall")
9104 (propertize cand 'face 'anything-apt-deinstalled))
9105 ((string= (assoc-default
9106 name anything-c-apt-installed-packages)
9107 "install")
9108 (propertize cand 'face 'anything-apt-installed))
9109 (t cand))))
9111 (defun anything-c-apt-init ()
9112 "Initialize list of debian packages."
9113 (let ((query ""))
9114 (unless (and anything-c-apt-installed-packages
9115 anything-c-apt-all-packages)
9116 (message "Loading package list...")
9117 (setq anything-c-apt-installed-packages
9118 (with-temp-buffer
9119 (call-process-shell-command "dpkg --get-selections"
9120 nil (current-buffer))
9121 (loop for i in (split-string (buffer-string) "\n" t)
9122 for p = (split-string i)
9123 collect (cons (car p) (cadr p)))))
9124 (setq anything-c-apt-all-packages
9125 (with-current-buffer
9126 (anything-candidate-buffer
9127 (get-buffer-create (format "*anything-apt*")))
9128 (erase-buffer)
9129 (call-process-shell-command
9130 (format anything-c-apt-search-command query)
9131 nil (current-buffer))))
9132 (message "Loading package list done")
9133 (sit-for 0.5))))
9135 (defun anything-c-apt-display-to-real (line)
9136 "Return only name of a debian package.
9137 LINE is displayed like:
9138 package name - description."
9139 (car (split-string line " - ")))
9141 (defun anything-c-shell-command-if-needed (command)
9142 "Run shell command COMMAND to describe package.
9143 If a buffer named COMMAND already exists, just switch to it."
9144 (let ((buf (get-buffer command)))
9145 (anything-c-switch-to-buffer (get-buffer-create command))
9146 (unless buf (insert (shell-command-to-string command)))))
9148 (defun anything-c-apt-cache-show (package)
9149 "Show information on apt package PACKAGE."
9150 (anything-c-shell-command-if-needed
9151 (format anything-c-apt-show-command package)))
9153 (defun anything-c-apt-install (package)
9154 "Run 'apt-get install' shell command on PACKAGE."
9155 (anything-c-apt-generic-action :action 'install))
9157 (defun anything-c-apt-reinstall (package)
9158 "Run 'apt-get install --reinstall' shell command on PACKAGE."
9159 (anything-c-apt-generic-action :action 'reinstall))
9161 (defun anything-c-apt-uninstall (package)
9162 "Run 'apt-get remove' shell command on PACKAGE."
9163 (anything-c-apt-generic-action :action 'uninstall))
9165 (defun anything-c-apt-purge (package)
9166 "Run 'apt-get purge' shell command on PACKAGE."
9167 (anything-c-apt-generic-action :action 'purge))
9169 (defun* anything-c-apt-generic-action (&key action)
9170 "Run 'apt-get ACTION'.
9171 Support install, remove and purge actions."
9172 (ansi-term (getenv "SHELL") "anything apt")
9173 (term-line-mode)
9174 (let ((command (case action
9175 ('install "sudo apt-get install ")
9176 ('reinstall "sudo apt-get install --reinstall ")
9177 ('uninstall "sudo apt-get remove ")
9178 ('purge "sudo apt-get purge ")
9179 (t (error "Unknow action"))))
9180 (beg (point))
9182 (cand-list (mapconcat #'(lambda (x) (format "'%s'" x))
9183 (anything-marked-candidates) " ")))
9184 (goto-char (point-max))
9185 (insert (concat command cand-list))
9186 (setq end (point))
9187 (if (y-or-n-p (format "%s package" (symbol-name action)))
9188 (progn
9189 (setq anything-c-external-commands-list nil)
9190 (setq anything-c-apt-installed-packages nil)
9191 (term-char-mode) (term-send-input))
9192 (delete-region beg end) (term-send-eof) (kill-buffer))))
9194 ;; (anything-c-apt-install "jed")
9197 ;;; Anything UI for gentoo portage.
9200 (defvar anything-c-gentoo-use-flags nil)
9201 (defvar anything-c-gentoo-buffer "*anything-gentoo-output*")
9202 (defvar anything-c-cache-gentoo nil)
9203 (defvar anything-c-cache-world nil)
9204 (defvar anything-c-source-gentoo
9205 '((name . "Portage sources")
9206 (init . (lambda ()
9207 (get-buffer-create anything-c-gentoo-buffer)
9208 (unless anything-c-cache-gentoo
9209 (anything-c-gentoo-setup-cache))
9210 (unless anything-c-cache-world
9211 (setq anything-c-cache-world (anything-c-gentoo-get-world)))
9212 (anything-c-gentoo-init-list)))
9213 (candidates-in-buffer)
9214 (match . identity)
9215 (candidate-transformer anything-c-highlight-world)
9216 (action . (("Show package" . (lambda (elm)
9217 (anything-c-gentoo-eshell-action elm "eix")))
9218 ("Show history" . (lambda (elm)
9219 (if (member elm anything-c-cache-world)
9220 (anything-c-gentoo-eshell-action elm "genlop -qe")
9221 (message "No infos on packages not yet installed"))))
9222 ("Copy in kill-ring" . kill-new)
9223 ("insert at point" . insert)
9224 ("Browse HomePage" . (lambda (elm)
9225 (let ((urls (anything-c-gentoo-get-url elm)))
9226 (browse-url (anything-comp-read "Url: " urls :must-match t)))))
9227 ("Show extra infos" . (lambda (elm)
9228 (if (member elm anything-c-cache-world)
9229 (anything-c-gentoo-eshell-action elm "genlop -qi")
9230 (message "No infos on packages not yet installed"))))
9231 ("Show use flags" . (lambda (elm)
9232 (anything-c-gentoo-default-action elm "equery" "-C" "u")
9233 (font-lock-add-keywords nil '(("^\+.*" . font-lock-variable-name-face)))
9234 (font-lock-mode 1)))
9235 ("Run emerge pretend" . (lambda (elm)
9236 (anything-c-gentoo-eshell-action elm "emerge -p")))
9237 ("Emerge" . (lambda (elm)
9238 (anything-gentoo-install elm :action 'install)))
9239 ("Unmerge" . (lambda (elm)
9240 (anything-gentoo-install elm :action 'uninstall)))
9241 ("Show dependencies" . (lambda (elm)
9242 (anything-c-gentoo-default-action elm "equery" "-C" "d")))
9243 ("Show related files" . (lambda (elm)
9244 (anything-c-gentoo-default-action elm "equery" "files")))
9245 ("Refresh" . (lambda (elm)
9246 (anything-c-gentoo-setup-cache)
9247 (setq anything-c-cache-world (anything-c-gentoo-get-world))))))))
9250 (defun* anything-gentoo-install (candidate &key action)
9251 (setq anything-c-external-commands-list nil)
9252 (ansi-term (getenv "SHELL") "Gentoo emerge")
9253 (term-line-mode)
9254 (let ((command (case action
9255 ('install "sudo emerge -av ")
9256 ('uninstall "sudo emerge -avC ")
9257 (t (error "Unknow action"))))
9258 (elms (mapconcat 'identity (anything-marked-candidates) " "))
9259 (beg (point)) end)
9260 (goto-char (point-max))
9261 (insert (concat command elms))
9262 (setq end (point))
9263 (term-char-mode) (term-send-input)))
9265 (defun anything-c-gentoo-default-action (elm command &rest args)
9266 "Gentoo default action that use `anything-c-gentoo-buffer'."
9267 (if (member elm anything-c-cache-world)
9268 (progn
9269 (anything-c-switch-to-buffer anything-c-gentoo-buffer)
9270 (erase-buffer)
9271 (let ((com-list (append args (list elm))))
9272 (apply #'call-process command nil t nil
9273 com-list)))
9274 (message "No infos on packages not yet installed")))
9276 (defvar anything-c-source-use-flags
9277 '((name . "Use Flags")
9278 (init . (lambda ()
9279 (unless anything-c-gentoo-use-flags
9280 (anything-c-gentoo-setup-use-flags-cache))
9281 (anything-c-gentoo-get-use)))
9282 (candidates-in-buffer)
9283 (match . identity)
9284 (candidate-transformer anything-c-highlight-local-use)
9285 (action . (("Description"
9286 . (lambda (elm)
9287 (anything-c-switch-to-buffer anything-c-gentoo-buffer)
9288 (erase-buffer)
9289 (apply #'call-process "euse" nil t nil
9290 `("-i"
9291 ,elm))
9292 (font-lock-add-keywords nil `((,elm . font-lock-variable-name-face)))
9293 (font-lock-mode 1)))
9294 ("Enable"
9295 . (lambda (elm)
9296 (anything-c-gentoo-eshell-action elm "*sudo -p Password: euse -E")))
9297 ("Disable"
9298 . (lambda (elm)
9299 (anything-c-gentoo-eshell-action elm "*sudo -p Password: euse -D")))
9300 ("Remove"
9301 . (lambda (elm)
9302 (anything-c-gentoo-eshell-action elm "*sudo -p Password: euse -P")))
9303 ("Show which dep use this flag"
9304 . (lambda (elm)
9305 (anything-c-switch-to-buffer anything-c-gentoo-buffer)
9306 (erase-buffer)
9307 (apply #'call-process "equery" nil t nil
9308 `("-C"
9310 ,elm))))))))
9314 (defun anything-c-gentoo-init-list ()
9315 "Initialize buffer with all packages in Portage."
9316 (let* ((portage-buf (get-buffer-create "*anything-gentoo*"))
9317 (buf (anything-candidate-buffer 'portage-buf)))
9318 (with-current-buffer buf
9319 (dolist (i anything-c-cache-gentoo)
9320 (insert (concat i "\n"))))))
9322 (defun anything-c-gentoo-setup-cache ()
9323 "Set up `anything-c-cache-gentoo'"
9324 (setq anything-c-cache-gentoo
9325 (split-string (with-temp-buffer
9326 (call-process "eix" nil t nil
9327 "--only-names")
9328 (buffer-string)))))
9330 (defun anything-c-gentoo-eshell-action (elm command)
9331 (when (get-buffer "*EShell Command Output*")
9332 (kill-buffer "*EShell Command Output*"))
9333 (message "Wait searching...")
9334 (let ((buf-fname (buffer-file-name anything-current-buffer)))
9335 (if (and buf-fname (string-match tramp-file-name-regexp buf-fname))
9336 (progn
9337 (save-window-excursion
9338 (pop-to-buffer "*scratch*")
9339 (eshell-command (format "%s %s" command elm)))
9340 (pop-to-buffer "*EShell Command Output*"))
9341 (eshell-command (format "%s %s" command elm)))))
9343 (defun anything-c-gentoo-get-use ()
9344 "Initialize buffer with all use flags."
9345 (let* ((use-buf (get-buffer-create "*anything-gentoo-use*"))
9346 (buf (anything-candidate-buffer 'use-buf)))
9347 (with-current-buffer buf
9348 (dolist (i anything-c-gentoo-use-flags)
9349 (insert (concat i "\n"))))))
9352 (defun anything-c-gentoo-setup-use-flags-cache ()
9353 "Setup `anything-c-gentoo-use-flags'"
9354 (setq anything-c-gentoo-use-flags
9355 (split-string (with-temp-buffer
9356 (call-process "eix" nil t nil
9357 "--print-all-useflags")
9358 (buffer-string)))))
9360 (defun anything-c-gentoo-get-url (elm)
9361 "Return a list of urls from eix output."
9362 (loop
9363 with url-list = (split-string
9364 (with-temp-buffer
9365 (call-process "eix" nil t nil
9366 elm "--format" "<homepage>\n")
9367 (buffer-string)))
9368 with all
9369 for i in url-list
9370 when (and (string-match "^http://.*" i)
9371 (not (member i all)))
9372 collect i into all
9373 finally return all))
9375 (defun anything-c-gentoo-get-world ()
9376 "Return list of all installed package on your system."
9377 (split-string (with-temp-buffer
9378 (call-process "qlist" nil t nil
9379 "-I")
9380 (buffer-string))))
9382 (defun anything-c-gentoo-get-local-use ()
9383 (split-string (with-temp-buffer
9384 (call-process "portageq" nil t nil
9385 "envvar"
9386 "USE")
9387 (buffer-string))))
9390 (defun anything-c-highlight-world (eix)
9391 "Highlight all installed package."
9392 (loop for i in eix
9393 if (member i anything-c-cache-world)
9394 collect (propertize i 'face 'anything-gentoo-match-face)
9395 else
9396 collect i))
9398 (defun anything-c-highlight-local-use (use-flags)
9399 (let ((local-uses (anything-c-gentoo-get-local-use)))
9400 (loop for i in use-flags
9401 if (member i local-uses)
9402 collect (propertize i 'face 'anything-gentoo-match-face)
9403 else
9404 collect i)))
9408 ;;; Anything ratpoison UI
9411 (defvar anything-c-source-ratpoison-commands
9412 '((name . "Ratpoison Commands")
9413 (init . anything-c-ratpoison-commands-init)
9414 (candidates-in-buffer)
9415 (action ("Execute the command" . anything-c-ratpoison-commands-execute))
9416 (display-to-real . anything-c-ratpoison-commands-display-to-real)
9417 (candidate-number-limit)))
9419 (defun anything-c-ratpoison-commands-init ()
9420 (unless (anything-candidate-buffer)
9421 (with-current-buffer (anything-candidate-buffer 'global)
9422 ;; with ratpoison prefix key
9423 (save-excursion
9424 (call-process "ratpoison" nil (current-buffer) nil "-c" "help"))
9425 (while (re-search-forward "^\\([^ ]+\\) \\(.+\\)$" nil t)
9426 (replace-match "<ratpoison> \\1: \\2"))
9427 (goto-char (point-max))
9428 ;; direct binding
9429 (save-excursion
9430 (call-process "ratpoison" nil (current-buffer) nil "-c" "help top"))
9431 (while (re-search-forward "^\\([^ ]+\\) \\(.+\\)$" nil t)
9432 (replace-match "\\1: \\2")))))
9434 (defun anything-c-ratpoison-commands-display-to-real (display)
9435 (and (string-match ": " display)
9436 (substring display (match-end 0))))
9438 (defun anything-c-ratpoison-commands-execute (candidate)
9439 (call-process "ratpoison" nil nil nil "-ic" candidate))
9443 ;;; Anything `completing-read' replacement
9446 (defun anything-comp-read-get-candidates (collection &optional test sort-fn alistp)
9447 "Convert COLLECTION to list removing elements that don't match TEST.
9448 See `anything-comp-read' about supported COLLECTION arguments.
9450 SORT-FN is a predicate to sort COLLECTION.
9452 ALISTP when non--nil will not use `all-completions' to collect
9453 candidates because it doesn't handle alists correctly for anything.
9454 i.e In `all-completions' the keys \(cars of elements\)
9455 are the possible completions. In anything we want to use the cdr instead
9456 like \(display . real\).
9460 \(setq A '((a . 1) (b . 2) (c . 3)))
9461 ==>((a . 1) (b . 2) (c . 3))
9462 \(anything-comp-read \"test: \" A :alistp nil
9463 :exec-when-only-one t
9464 :initial-input \"a\")
9465 ==>\"a\"
9466 \(anything-comp-read \"test: \" A :alistp t
9467 :exec-when-only-one t
9468 :initial-input \"1\")
9469 ==>\"1\"
9471 See docstring of `all-completions' for more info.
9473 If COLLECTION is an `obarray', a TEST should be needed. See `obarray'."
9474 (let ((cands
9475 (cond ((and (eq collection obarray) test)
9476 (all-completions "" collection test))
9477 ((and (vectorp collection) test)
9478 (loop for i across collection when (funcall test i) collect i))
9479 ((vectorp collection)
9480 (loop for i across collection collect i))
9481 ((and alistp test)
9482 (loop for i in collection when (funcall test i) collect i))
9483 ((and (symbolp collection) (boundp collection))
9484 (symbol-value collection))
9485 (alistp collection)
9486 ((and collection test)
9487 (all-completions "" collection test))
9488 (t (all-completions "" collection)))))
9489 (if sort-fn (sort cands sort-fn) cands)))
9491 (defun anything-cr-default-transformer (candidates source)
9492 "Default filter candidate function for `anything-comp-read'.
9493 Do nothing, just return candidate list unmodified."
9494 candidates)
9496 (defun* anything-comp-read (prompt collection
9497 &key
9498 test
9499 initial-input
9500 default
9501 preselect
9502 (buffer "*Anything Completions*")
9503 must-match
9504 (requires-pattern 0)
9505 (history nil)
9506 input-history
9507 (persistent-action nil)
9508 (persistent-help "DoNothing")
9509 (mode-line anything-mode-line-string)
9510 (keymap anything-map)
9511 (name "Anything Completions")
9512 candidates-in-buffer
9513 exec-when-only-one
9514 (volatile t)
9515 sort
9516 (fc-transformer 'anything-cr-default-transformer)
9517 (marked-candidates nil)
9518 (alistp t))
9519 "Read a string in the minibuffer, with anything completion.
9521 It is anything `completing-read' equivalent.
9523 - PROMPT is the prompt name to use.
9525 - COLLECTION can be a list, vector, obarray or hash-table.
9526 It can be also a function that receives three arguments:
9527 the values string, predicate and t. See `all-completions' for more details.
9529 Keys description:
9531 - TEST: A predicate called with one arg i.e candidate.
9533 - INITIAL-INPUT: Same as input arg in `anything'.
9535 - PRESELECT: See preselect arg of `anything'.
9537 - DEFAULT: This option is used only for compatibility with regular
9538 Emacs `completing-read'.
9540 - BUFFER: Name of anything-buffer.
9542 - MUST-MATCH: Candidate selected must be one of COLLECTION.
9544 - REQUIRES-PATTERN: Same as anything attribute, default is 0.
9546 - HISTORY: A list containing specific history, default is nil.
9547 When it is non--nil, all elements of HISTORY are displayed in
9548 a special source before COLLECTION.
9550 - INPUT-HISTORY: A symbol. the minibuffer input history will be
9551 stored there, if nil or not provided, `minibuffer-history'
9552 will be used instead.
9554 - PERSISTENT-ACTION: A function called with one arg i.e candidate.
9556 - PERSISTENT-HELP: A string to document PERSISTENT-ACTION.
9558 - NAME: The name related to this local source.
9560 - EXEC-WHEN-ONLY-ONE: Bound `anything-execute-action-at-once-if-one'
9561 to non--nil. (possibles values are t or nil).
9563 - VOLATILE: Use volatile attribute \(enabled by default\).
9565 - SORT: A predicate to give to `sort' e.g `string-lessp'.
9567 - FC-TRANSFORMER: A `filtered-candidate-transformer' function.
9569 - MARKED-CANDIDATES: If non--nil return candidate or marked candidates as a list.
9571 - ALISTP: \(default is non--nil\) See `anything-comp-read-get-candidates'.
9573 - CANDIDATES-IN-BUFFER: when non--nil use a source build with
9574 `anything-candidates-in-buffer' which is much faster.
9575 Argument VOLATILE have no effect when CANDIDATES-IN-BUFFER is non--nil.
9577 Any prefix args passed during `anything-comp-read' invocation will be recorded
9578 in `anything-current-prefix-arg', otherwise if prefix args were given before
9579 `anything-comp-read' invocation, the value of `current-prefix-arg' will be used.
9580 That's mean you can pass prefix args before or after calling a command
9581 that use `anything-comp-read' See `anything-M-x' for example."
9582 (when (get-buffer anything-action-buffer)
9583 (kill-buffer anything-action-buffer))
9584 (flet ((action-fn (candidate)
9585 (if marked-candidates
9586 (anything-marked-candidates)
9587 (identity candidate))))
9588 ;; Assume completion have been already required,
9589 ;; so always use 'confirm.
9590 (when (eq must-match 'confirm-after-completion)
9591 (setq must-match 'confirm))
9592 (let* ((minibuffer-completion-confirm must-match)
9593 (must-match-map (when must-match
9594 (let ((map (make-sparse-keymap)))
9595 (define-key map (kbd "RET")
9596 'anything-confirm-and-exit-minibuffer)
9597 map)))
9598 (anything-map (if must-match-map
9599 (make-composed-keymap
9600 must-match-map (or keymap anything-map))
9601 (or keymap anything-map)))
9602 (src-hist `((name . ,(format "%s History" name))
9603 (candidates
9604 . (lambda ()
9605 (let ((all (anything-comp-read-get-candidates
9606 history nil nil ,alistp)))
9607 (delete
9609 (anything-fast-remove-dups
9610 (if (and default (not (string= default "")))
9611 (delq nil (cons default
9612 (delete default all)))
9613 all)
9614 :test 'equal)))))
9615 (filtered-candidate-transformer
9616 . (lambda (candidates sources)
9617 (loop for i in candidates
9618 do (set-text-properties 0 (length i) nil i)
9619 collect i)))
9620 (persistent-action . ,persistent-action)
9621 (persistent-help . ,persistent-help)
9622 (mode-line . ,mode-line)
9623 (keymap . ,anything-map)
9624 (action . ,'action-fn)))
9625 (src `((name . ,name)
9626 (candidates
9627 . (lambda ()
9628 (let ((cands (anything-comp-read-get-candidates
9629 collection test sort alistp)))
9630 (unless (or must-match (string= anything-pattern ""))
9631 (setq cands (append (list anything-pattern) cands)))
9632 (if (and default (not (string= default "")))
9633 (delq nil (cons default (delete default cands)))
9634 cands))))
9635 (filtered-candidate-transformer ,fc-transformer)
9636 (requires-pattern . ,requires-pattern)
9637 (persistent-action . ,persistent-action)
9638 (persistent-help . ,persistent-help)
9639 (mode-line . ,mode-line)
9640 (keymap . ,anything-map)
9641 (action . ,'action-fn)))
9642 (src-1 `((name . ,name)
9643 (init
9644 . (lambda ()
9645 (let ((cands (anything-comp-read-get-candidates
9646 collection test sort alistp)))
9647 (unless (or must-match (string= anything-pattern ""))
9648 (setq cands (append (list anything-pattern) cands)))
9649 (with-current-buffer (anything-candidate-buffer 'global)
9650 (loop for i in
9651 (if (and default (not (string= default "")))
9652 (delq nil (cons default (delete default cands)))
9653 cands)
9654 do (insert (concat i "\n")))))))
9655 (candidates-in-buffer)
9656 (filtered-candidate-transformer ,fc-transformer)
9657 (requires-pattern . ,requires-pattern)
9658 (persistent-action . ,persistent-action)
9659 (persistent-help . ,persistent-help)
9660 (mode-line . ,mode-line)
9661 (keymap . ,anything-map)
9662 (action . ,'action-fn)))
9663 (src-list (list src-hist
9664 (if candidates-in-buffer
9665 src-1
9666 (if volatile
9667 (append src '((volatile)))
9668 src))))
9669 (anything-execute-action-at-once-if-one exec-when-only-one))
9671 (anything
9672 :sources src-list
9673 :input initial-input
9674 :default default
9675 :preselect preselect
9676 :prompt prompt
9677 :resume 'noresume
9678 :history (and (symbolp input-history) input-history)
9679 :buffer buffer)
9680 (when (and (eq anything-exit-status 0)
9681 (eq must-match 'confirm))
9682 ;; Return empty string only if it is the DEFAULT
9683 ;; value and anything-pattern is empty.
9684 ;; otherwise return anything-pattern
9685 (if (and (string= anything-pattern "") default)
9686 default (identity anything-pattern)))
9687 (unless (or (eq anything-exit-status 1)
9688 must-match) ; FIXME this should not be needed now.
9689 default)
9690 (keyboard-quit)))))
9692 ;; Generic completing-read
9694 ;; Support also function as collection.
9695 ;; e.g M-x man is supported.
9696 ;; Support hash-table and vectors as collection.
9697 ;; NOTE:
9698 ;; Some crap emacs functions may not be supported
9699 ;; like ffap-alternate-file (bad use of completing-read)
9700 ;; and maybe others.
9701 ;; Provide a mode `anything-completion-mode' which turn on
9702 ;; anything in all `completing-read' and `read-file-name' in Emacs.
9704 (defvar anything-completion-mode-string " AC")
9706 (defvar anything-completion-mode-quit-message
9707 "Anything completion disabled")
9709 (defvar anything-completion-mode-start-message
9710 "Anything completion enabled")
9712 ;;; Specialized handlers
9715 (defun anything-completing-read-symbols
9716 (prompt collection test require-match init
9717 hist default inherit-input-method name buffer)
9718 "Specialized function for fast symbols completion in `ac-mode'."
9720 (anything
9721 :sources `((name . ,name)
9722 (init . (lambda ()
9723 (with-current-buffer (anything-candidate-buffer 'global)
9724 (goto-char (point-min))
9725 (when (and default (stringp default)
9726 ;; Some defaults args result as
9727 ;; (symbol-name nil) == "nil".
9728 ;; e.g debug-on-entry.
9729 (not (string= default "nil"))
9730 (not (string= default "")))
9731 (insert (concat default "\n")))
9732 (loop with all = (all-completions "" collection test)
9733 for sym in all
9734 unless (and default (eq sym default))
9735 do (insert (concat sym "\n"))))))
9736 (persistent-action . anything-lisp-completion-persistent-action)
9737 (persistent-help . "Show brief doc in mode-line")
9738 (candidates-in-buffer)
9739 (action . identity))
9740 :prompt prompt
9741 :buffer buffer
9742 :input init
9743 :history hist
9744 :resume 'noresume
9745 :default (or default ""))
9746 (keyboard-quit)))
9749 ;;; Generic completing read
9752 (defun anything-completing-read-default-1
9753 (prompt collection test require-match
9754 init hist default inherit-input-method
9755 name buffer &optional cands-in-buffer exec-when-only-one)
9756 "Call `anything-comp-read' with same args as `completing-read'.
9757 Extra optional arg CANDS-IN-BUFFER mean use `candidates-in-buffer'
9758 method which is faster.
9759 It should be used when candidate list don't need to rebuild dynamically."
9760 (let ((history (or (car-safe hist) hist)))
9761 (anything-comp-read
9762 prompt collection
9763 :test test
9764 :history history
9765 :input-history history
9766 :must-match require-match
9767 :alistp nil ; Be sure `all-completions' is used.
9768 :name name
9769 :requires-pattern (if (and (string= default "")
9770 (or (eq require-match 'confirm)
9771 (eq require-match
9772 'confirm-after-completion)))
9773 1 0)
9774 :candidates-in-buffer cands-in-buffer
9775 :exec-when-only-one exec-when-only-one
9776 :buffer buffer
9777 ;; If DEF is not provided, fallback to empty string
9778 ;; to avoid `thing-at-point' to be appended on top of list
9779 :default (or default "")
9780 ;; Use `regexp-quote' to fix initial input
9781 ;; with special characters (e.g nnimap+gmail:)
9782 :initial-input (and (stringp init) (regexp-quote init)))))
9784 (defun anything-completing-read-with-cands-in-buffer
9785 (prompt collection test require-match
9786 init hist default inherit-input-method
9787 name buffer)
9788 "Same as `anything-completing-read-default-1' but use candidates-in-buffer."
9789 ;; Some commands like find-tag may use `read-file-name' from inside
9790 ;; the calculation of collection. in this case it clash with
9791 ;; candidates-in-buffer that reuse precedent data (files) which is wrong.
9792 ;; So (re)calculate collection outside of main anything-session.
9793 (let ((cands (all-completions "" collection)))
9794 (anything-completing-read-default-1 prompt cands test require-match
9795 init hist default inherit-input-method
9796 name buffer t)))
9798 (defun* anything-completing-read-default
9799 (prompt collection &optional
9800 predicate require-match
9801 initial-input hist def
9802 inherit-input-method)
9803 "An anything replacement of `completing-read'.
9804 This function should be used only as a `completing-read-function'.
9806 Don't use it directly, use instead `anything-comp-read' in your programs.
9808 See documentation of `completing-read' and `all-completions' for details."
9809 (declare (special anything-completion-mode))
9810 (let* ((current-command this-command)
9811 (str-command (symbol-name current-command))
9812 (buf-name (format "*ac-mode-%s*" str-command))
9813 (entry (assq current-command
9814 anything-completing-read-handlers-alist))
9815 (def-com (cdr-safe entry))
9816 (str-defcom (and def-com (symbol-name def-com)))
9817 (def-args (list prompt collection predicate require-match
9818 initial-input hist def inherit-input-method))
9819 ;; Append the two extra args needed to set the buffer and source name
9820 ;; in anything specialized functions.
9821 (any-args (append def-args (list str-command buf-name)))
9822 anything-completion-mode-start-message ; Be quiet
9823 anything-completion-mode-quit-message
9824 (minibuffer-completion-table collection)
9825 (minibuffer-completion-predicate predicate)
9826 ;; Be sure this pesty *completion* buffer doesn't popup.
9827 (minibuffer-setup-hook (remove 'minibuffer-completion-help
9828 minibuffer-setup-hook)))
9829 (when (eq def-com 'ido) (setq def-com 'ido-completing-read))
9830 (unless (or (not entry) def-com)
9831 ;; An entry in *read-handlers-alist exists but have
9832 ;; a nil value, so we exit from here, disable `ac-mode'
9833 ;; and run the command again with it original behavior.
9834 ;; `ac-mode' will be restored on exit.
9835 (return-from anything-completing-read-default
9836 (unwind-protect
9837 (progn
9838 (ac-mode -1)
9839 (apply completing-read-function def-args))
9840 (ac-mode 1))))
9841 ;; If we use now `completing-read' we MUST turn off `ac-mode'
9842 ;; to avoid infinite recursion and CRASH. It will be reenabled on exit.
9843 (when (or (eq def-com 'completing-read)
9844 ;; All specialized functions are prefixed by "anything"
9845 (and (stringp str-defcom)
9846 (not (string-match "^anything" str-defcom))))
9847 (ac-mode -1))
9848 (unwind-protect
9849 (cond (;; An anything specialized function exists, run it.
9850 (and def-com anything-completion-mode)
9851 (apply def-com any-args))
9852 (;; Try to handle `ido-completing-read' everywhere.
9853 (and def-com (eq def-com 'ido-completing-read))
9854 (setcar (memq collection def-args)
9855 (all-completions "" collection predicate))
9856 (apply def-com def-args))
9857 (;; User set explicitely `completing-read' or something similar
9858 ;; in *read-handlers-alist, use this with exactly the same
9859 ;; args as in `completing-read'.
9860 ;; If we are here `anything-completion-mode' is now disabled.
9861 def-com
9862 (apply def-com def-args))
9863 (t ; Fall back to classic `anything-comp-read'.
9864 (anything-completing-read-default-1
9865 prompt collection predicate require-match
9866 initial-input hist def inherit-input-method
9867 str-command buf-name)))
9868 (ac-mode 1)
9869 ;; When exiting minibuffer, `this-command' is set to
9870 ;; `anything-exit-minibuffer', which is unwanted when starting
9871 ;; on another `completing-read', so restore `this-command' to
9872 ;; initial value when exiting.
9873 (setq this-command current-command))))
9875 (defun* anything-generic-read-file-name
9876 (prompt &optional dir default-filename mustmatch initial predicate)
9877 "An anything replacement of `read-file-name'."
9878 (declare (special anything-completion-mode))
9879 (let* ((default (and default-filename
9880 (if (listp default-filename)
9881 (car default-filename)
9882 default-filename)))
9883 (init (or default initial dir default-directory))
9884 (ini-input (and init (expand-file-name init)))
9885 (current-command this-command)
9886 (str-command (symbol-name current-command))
9887 (anything-file-completion-sources
9888 (cons str-command
9889 (remove str-command anything-file-completion-sources)))
9890 (buf-name (format "*ac-mode-%s*" str-command))
9891 (entry (assq current-command
9892 anything-completing-read-handlers-alist))
9893 (def-com (cdr-safe entry))
9894 (str-defcom (symbol-name def-com))
9895 (def-args (list prompt dir default-filename mustmatch initial predicate))
9896 ;; Append the two extra args needed to set the buffer and source name
9897 ;; in anything specialized functions.
9898 (any-args (append def-args (list str-command buf-name)))
9899 (ido-state ido-mode)
9900 anything-completion-mode-start-message ; Be quiet
9901 anything-completion-mode-quit-message ; Same here
9902 fname)
9903 ;; Some functions that normally call `completing-read' can switch
9904 ;; brutally to `read-file-name' (e.g find-tag), in this case
9905 ;; the anything specialized function will fail because it is build
9906 ;; for `completing-read', so set it to 'incompatible to be sure
9907 ;; we switch to `anything-c-read-file-name' and don't try to call it
9908 ;; with wrong number of args.
9909 (when (and def-com (> (length (help-function-arglist def-com)) 8))
9910 (setq def-com 'incompatible))
9911 (when (eq def-com 'ido) (setq def-com 'ido-read-file-name))
9912 (unless (or (not entry) def-com)
9913 (return-from anything-generic-read-file-name
9914 (unwind-protect
9915 (progn
9916 (ac-mode -1)
9917 (apply read-file-name-function def-args))
9918 (ac-mode 1))))
9919 ;; If we use now `read-file-name' we MUST turn off `ac-mode'
9920 ;; to avoid infinite recursion and CRASH. It will be reenabled on exit.
9921 (when (or (eq def-com 'read-file-name)
9922 (eq def-com 'ido-read-file-name)
9923 (and (stringp str-defcom)
9924 (not (string-match "^anything" str-defcom))))
9925 (ac-mode -1))
9926 (unwind-protect
9927 (setq fname
9928 (cond (;; A specialized function exists, run it
9929 ;; with the two extra args specific to anything..
9930 (and def-com anything-completion-mode
9931 (not (eq def-com 'ido-read-file-name))
9932 (not (eq def-com 'incompatible)))
9933 (apply def-com any-args))
9934 (;; Def-com value is `ido-read-file-name'
9935 ;; run it with default args.
9936 (and def-com (eq def-com 'ido-read-file-name))
9937 (ido-mode 1)
9938 (apply def-com def-args))
9939 (;; Def-com value is `read-file-name'
9940 ;; run it with default args.
9941 (eq def-com 'read-file-name)
9942 (apply def-com def-args))
9943 (t ; Fall back to classic `anything-c-read-file-name'.
9944 (anything-c-read-file-name
9945 prompt
9946 :name str-command
9947 :buffer buf-name
9948 :initial-input (expand-file-name init dir)
9949 :alistp nil
9950 :must-match mustmatch
9951 :test predicate))))
9952 (ac-mode 1)
9953 (ido-mode (if ido-state 1 -1))
9954 ;; Same comment as in `anything-completing-read-default'.
9955 (setq this-command current-command))
9956 (if (and mustmatch (not (file-exists-p fname)))
9957 (if (y-or-n-p "File does not exists, create buffer?")
9958 fname (error "Abort file does not exists"))
9959 fname)))
9961 ;;;###autoload
9962 (define-minor-mode anything-completion-mode
9963 "Toggle generic anything completion.
9965 All functions in Emacs that use `completing-read'
9966 or `read-file-name' and friends will use anything interface
9967 when this mode is turned on.
9968 However you can modify this behavior for functions of your choice
9969 with `anything-completing-read-handlers-alist'.
9971 Called with a positive arg, turn on unconditionally, with a
9972 negative arg turn off.
9973 You can turn it on with `ac-mode'.
9975 Some crap emacs functions may not be supported,
9976 e.g `ffap-alternate-file' and maybe others
9977 You can add such functions to `anything-completing-read-handlers-alist'
9978 with a nil value.
9980 Note: This mode will work only partially on Emacs23."
9981 :group 'anything
9982 :global t
9983 :lighter anything-completion-mode-string
9984 (declare (special completing-read-function))
9985 (if anything-completion-mode
9986 (progn
9987 (setq completing-read-function 'anything-completing-read-default
9988 read-file-name-function 'anything-generic-read-file-name)
9989 (message anything-completion-mode-start-message))
9990 (setq completing-read-function (and (fboundp 'completing-read-default)
9991 'completing-read-default)
9992 read-file-name-function (and (fboundp 'read-file-name-default)
9993 'read-file-name-default))
9994 (message anything-completion-mode-quit-message)))
9996 (defalias 'ac-mode 'anything-completion-mode)
10000 ;;; Eshell completion.
10002 ;; Enable like this in .emacs:
10004 ;; (add-hook 'eshell-mode-hook
10005 ;; #'(lambda ()
10006 ;; (define-key eshell-mode-map [remap pcomplete] 'anything-esh-pcomplete)))
10008 (defvar anything-c-source-esh
10009 '((name . "Eshell completions")
10010 (init . (lambda ()
10011 (setq pcomplete-current-completions nil
10012 pcomplete-last-completion-raw nil)
10013 ;; Eshell-command add this hook in all minibuffers
10014 ;; Remove it for the anything one. (Fixed in Emacs24)
10015 (remove-hook 'minibuffer-setup-hook 'eshell-mode)))
10016 (candidates . anything-esh-get-candidates)
10017 (action . anything-ec-insert))
10018 "Anything source for Eshell completion.")
10020 ;; Internal.
10021 (defvar anything-ec-target "")
10022 (defun anything-ec-insert (candidate)
10023 "Replace text at point with CANDIDATE.
10024 The function that call this should set `anything-ec-target' to thing at point.
10025 This is the same as `ac-insert', just inlined here for compatibility."
10026 (let ((pt (point)))
10027 (when (and anything-ec-target
10028 (search-backward anything-ec-target nil t)
10029 (string= (buffer-substring (point) pt) anything-ec-target))
10030 (delete-region (point) pt)))
10031 (insert (anything-quote-whitespace candidate)))
10033 (defun anything-esh-get-candidates ()
10034 "Get candidates for eshell completion using `pcomplete'."
10035 (catch 'pcompleted
10036 (let* ((pcomplete-stub)
10037 pcomplete-seen pcomplete-norm-func
10038 pcomplete-args pcomplete-last pcomplete-index
10039 (pcomplete-autolist pcomplete-autolist)
10040 (pcomplete-suffix-list pcomplete-suffix-list))
10041 (with-anything-current-buffer
10042 (loop with table = (pcomplete-completions)
10043 with entry = (condition-case nil
10044 ;; On Emacs24 `try-completion' return
10045 ;; pattern when more than one result.
10046 ;; Otherwise Emacs23 return nil, which
10047 ;; is wrong, in this case use pattern
10048 ;; to behave like Emacs24.
10049 (or (try-completion anything-pattern
10050 (pcomplete-entries))
10051 anything-pattern)
10052 ;; In Emacs23 `pcomplete-entries' may fail
10053 ;; with error, so try this instead.
10054 (error
10056 (let ((fc (car (last
10057 (pcomplete-parse-arguments)))))
10058 ;; Check if last arg require fname completion.
10059 (and (file-name-directory fc) fc))))
10060 for i in (all-completions pcomplete-stub table)
10061 for file-cand = (and entry
10062 (if (file-remote-p i) i
10063 (expand-file-name
10064 i (file-name-directory entry))))
10065 if (and file-cand (or (file-remote-p file-cand)
10066 (file-exists-p file-cand)))
10067 collect file-cand into ls
10068 else collect i into ls
10069 finally return
10070 (if (and entry (not (string= entry "")) (file-exists-p entry))
10071 (append (list (expand-file-name entry default-directory)) ls)
10072 ls))))))
10074 ;;; Eshell history.
10077 (defvar anything-c-source-eshell-history
10078 `((name . "Eshell history")
10079 (init . (lambda ()
10080 (let (eshell-hist-ignoredups)
10081 ;; Write the content's of ring to file.
10082 (eshell-write-history eshell-history-file-name t)
10083 (with-current-buffer (anything-candidate-buffer 'global)
10084 (insert-file-contents eshell-history-file-name)))
10085 ;; Same comment as in `anything-c-source-esh'
10086 (remove-hook 'minibuffer-setup-hook 'eshell-mode)))
10087 (candidates-in-buffer)
10088 (keymap . ,anything-eshell-history-map)
10089 (filtered-candidate-transformer . (lambda (candidates sources)
10090 (reverse candidates)))
10091 (candidate-number-limit . 9999)
10092 (action . (lambda (candidate)
10093 (eshell-kill-input)
10094 (insert candidate))))
10095 "Anything source for Eshell history.")
10098 ;;; Show completion - an alternative of anything-show-completion.el.
10100 ;; Provide show completion with macro `with-anything-show-completion'.
10103 ;; Called each time cursor move in anything-buffer.
10104 (defun anything-c-show-completion ()
10105 (with-anything-current-buffer
10106 (overlay-put anything-c-show-completion-overlay
10107 'display (anything-get-selection))))
10109 (defun anything-c-show-completion-init-overlay (beg end)
10110 (and anything-c-turn-on-show-completion
10111 (setq anything-c-show-completion-overlay (make-overlay beg end))
10112 (overlay-put anything-c-show-completion-overlay
10113 'face 'anything-lisp-show-completion)))
10115 (defun anything-c-show-completion-display-function (buffer)
10116 "A special resized anything window is used depending on position in BUFFER."
10117 (with-selected-window (selected-window)
10118 (let* ((screen-size (+ (count-screen-lines (window-start) (point) t)
10119 1 ; mode-line
10120 (if header-line-format 1 0))) ; header-line
10121 (def-size (- (window-height)
10122 anything-c-show-completion-min-window-height))
10123 (upper-height (max window-min-height (min screen-size def-size)))
10124 split-window-keep-point)
10125 (recenter -1)
10126 (set-window-buffer (if (active-minibuffer-window)
10127 (minibuffer-selected-window)
10128 (split-window nil upper-height))
10129 buffer))))
10131 (defmacro with-anything-show-completion (beg end &rest body)
10132 "Show anything candidate in an overlay at point.
10133 BEG and END are the beginning and end position of the current completion
10134 in `anything-current-buffer'.
10135 BODY is an anything call where we want to enable show completion.
10136 If `anything-c-turn-on-show-completion' is nil just do nothing."
10137 (declare (indent 2) (debug t))
10138 `(let ((anything-move-selection-after-hook
10139 (and anything-c-turn-on-show-completion
10140 (append (list 'anything-c-show-completion)
10141 anything-move-selection-after-hook))))
10142 (unwind-protect
10143 (progn
10144 (anything-c-show-completion-init-overlay ,beg ,end)
10145 (let ((anything-display-function
10146 (if anything-c-show-completion-use-special-display
10147 'anything-c-show-completion-display-function
10148 'anything-default-display-buffer)))
10149 ,@body))
10150 (and anything-c-turn-on-show-completion
10151 (delete-overlay anything-c-show-completion-overlay)))))
10154 ;;; Lisp symbol completion.
10157 ;;;###autoload
10158 (defun anything-lisp-completion-at-point ()
10159 "Anything lisp symbol completion at point."
10160 (interactive)
10161 (let* ((data (lisp-completion-at-point))
10162 (beg (car data))
10163 (end (point)) ; 'cadr data' is wrong when no space after point.
10164 (plist (nthcdr 3 data))
10165 (pred (plist-get plist :predicate))
10166 (lgst-len 0)
10167 (target (and beg end (buffer-substring-no-properties beg end)))
10168 (candidates (all-completions target (nth 2 data) pred))
10169 (anything-quit-if-no-candidate t)
10171 (anything-execute-action-at-once-if-one t)
10172 (anything-match-plugin-enabled
10173 (member 'anything-compile-source--match-plugin
10174 anything-compile-source-functions)))
10175 (if candidates
10176 (with-anything-show-completion beg end
10177 ;; Overlay is initialized now in anything-current-buffer.
10178 (anything
10179 :sources
10180 '((name . "Lisp completion")
10181 (init . (lambda ()
10182 (with-current-buffer (anything-candidate-buffer 'global)
10183 (loop for sym in candidates
10184 for len = (length sym)
10185 when (> len lgst-len) do (setq lgst-len len)
10186 do (insert (concat sym "\n"))))))
10187 (candidates-in-buffer)
10188 (persistent-action . anything-lisp-completion-persistent-action)
10189 (persistent-help . "Show brief doc in mode-line")
10190 (filtered-candidate-transformer anything-lisp-completion-transformer)
10191 (action . (lambda (candidate)
10192 (delete-region beg end)
10193 (insert candidate))))
10194 :input (if anything-match-plugin-enabled (concat target " ") target)))
10195 (message "[No Match]"))))
10197 (defun anything-lisp-completion-persistent-action (candidate)
10198 (let ((cursor-in-echo-area t)
10199 mode-line-in-non-selected-windows)
10200 (anything-c-show-info-in-mode-line
10201 (propertize
10202 (anything-c-get-first-line-documentation
10203 (intern candidate))
10204 'face 'anything-lisp-completion-info))))
10206 (defun anything-lisp-completion-transformer (candidates source)
10207 "Anything candidates transformer for lisp completion."
10208 (declare (special lgst-len))
10209 (loop for c in candidates
10210 for sym = (intern c)
10211 for annot = (cond ((commandp sym) " (Com)")
10212 ((fboundp sym) " (Fun)")
10213 ((boundp sym) " (Var)")
10214 ((facep sym) " (Face)"))
10215 for spaces = (make-string (- lgst-len (length c)) ? )
10216 collect (cons (concat c spaces annot) c)))
10218 (defun anything-c-get-first-line-documentation (sym)
10219 "Return first line documentation of symbol SYM.
10220 If SYM is not documented, return \"Not documented\"."
10221 (let ((doc (cond ((fboundp sym)
10222 (documentation sym t))
10223 ((boundp sym)
10224 (documentation-property sym 'variable-documentation t))
10225 ((facep sym)
10226 (face-documentation sym))
10227 (t nil))))
10228 (if (and doc (not (string= doc ""))
10229 ;; `documentation' return "\n\n(args...)"
10230 ;; for CL-style functions.
10231 (not (string-match-p "^\n\n" doc)))
10232 (car (split-string doc "\n"))
10233 "Not documented")))
10235 ;;; File completion.
10237 ;; Complete file name at point.
10238 (defun anything-c-thing-before-point ()
10239 "Get symbol name before point.
10240 Borrowed from anything-complete.el, inlined here for compatibility."
10241 (save-excursion
10242 (let ((beg (point)))
10243 ;; older regexp "\(\\|\\s-\\|^\\|\\_<\\|\r\\|'\\|#'"
10244 (when (re-search-backward
10245 "\\_<" (field-beginning nil nil (point-at-bol)) t)
10246 (buffer-substring-no-properties beg (match-end 0))))))
10248 ;;;###autoload
10249 (defun anything-c-complete-file-name-at-point ()
10250 "Complete file name at point."
10251 (interactive)
10252 (let* ((init (substring-no-properties (thing-at-point 'filename)))
10253 (end (point))
10254 (beg (- (point) (length init)))
10255 (anything-quit-if-no-candidate t)
10256 (anything-execute-action-at-once-if-one t)
10257 completion)
10258 (with-anything-show-completion beg end
10259 (setq completion (anything-c-read-file-name "FileName: "
10260 :initial-input init)))
10261 (anything-c-insert-file-name-completion-at-point completion)))
10263 ;; Internal
10264 (defvar anything-lisp-completion-counter 0)
10265 ;;;###autoload
10266 (defun anything-lisp-completion-at-point-or-indent (arg)
10267 "First call indent and second call complete lisp symbol.
10268 The second call should happen before `anything-lisp-completion-or-indent-delay',
10269 after this delay, next call will indent again.
10270 After completion, next call is always indent.
10271 See that like click and double mouse click.
10272 One hit indent, two quick hits maybe indent and complete."
10273 (interactive "P")
10274 ;; Be sure `indent-for-tab-command' will not try
10275 ;; to use `completion-at-point'.
10276 (let ((tab-always-indent (if (eq tab-always-indent 'complete)
10277 t tab-always-indent)))
10278 (incf anything-lisp-completion-counter)
10279 (unwind-protect
10280 (if (> anything-lisp-completion-counter 1)
10281 (anything-lisp-completion-or-file-name-at-point)
10282 (indent-for-tab-command arg))
10283 ;; After `anything-lisp-completion-or-indent-delay' seconds
10284 ;; reset to 0.
10285 (run-with-timer anything-lisp-completion-or-indent-delay nil
10286 #'(lambda ()
10287 (setq anything-lisp-completion-counter 0)))
10288 ;; Always reset to 0 at second hit.
10289 (when (eq anything-lisp-completion-counter 2)
10290 (setq anything-lisp-completion-counter 0)))))
10292 ;;;###autoload
10293 (defun anything-lisp-completion-or-file-name-at-point ()
10294 "Complete lisp symbol or filename at point.
10295 Filename completion happen if filename is started in
10296 or between double quotes."
10297 (interactive)
10298 (let ((tap (substring-no-properties (thing-at-point 'filename))))
10299 (if (and tap (string-match "^\\(~/\\|/\\|[a-zA-Z]\:/\\).*" tap)
10300 (save-excursion (search-backward "\"" (point-at-bol) t)))
10301 (anything-c-complete-file-name-at-point)
10302 (anything-lisp-completion-at-point))))
10304 (defun anything-c-apropos-init (test default)
10305 "Init candidates buffer for `anything-c-apropos' sources."
10306 (with-current-buffer (anything-candidate-buffer 'global)
10307 (goto-char (point-min))
10308 (when (and default (stringp default)
10309 ;; Some defaults args result as
10310 ;; (symbol-name nil) == "nil".
10311 ;; e.g debug-on-entry.
10312 (not (string= default "nil"))
10313 (funcall test (intern default)))
10314 (insert (concat default "\n")))
10315 (loop with all = (all-completions "" obarray test)
10316 for sym in all
10317 unless (and default (eq sym default))
10318 do (insert (concat sym "\n")))))
10321 ;;; Run Externals commands within Emacs with anything completion
10324 (defvar anything-external-command-history nil)
10326 (defun anything-c-external-commands-list-1 (&optional sort)
10327 "Returns a list of all external commands the user can execute.
10328 If `anything-c-external-commands-list' is non-nil it will
10329 return its contents. Else it calculates all external commands
10330 and sets `anything-c-external-commands-list'."
10331 (if anything-c-external-commands-list
10332 anything-c-external-commands-list
10333 (setq anything-c-external-commands-list
10334 (loop
10335 with paths = (split-string (getenv "PATH") path-separator)
10336 with completions = ()
10337 for dir in paths
10338 when (and (file-exists-p dir) (file-accessible-directory-p dir))
10339 for lsdir = (loop for i in (directory-files dir t)
10340 for bn = (file-name-nondirectory i)
10341 when (and (not (member bn completions))
10342 (not (file-directory-p i))
10343 (file-executable-p i))
10344 collect bn)
10345 append lsdir into completions
10346 finally return (if sort (sort completions 'string-lessp) completions)))))
10348 (defun anything-run-or-raise (exe &optional file)
10349 "Generic command that run asynchronously EXE.
10350 If EXE is already running just jump to his window if `anything-raise-command'
10351 is non--nil.
10352 When FILE argument is provided run EXE with FILE.
10353 In this case EXE must be provided as \"EXE %s\"."
10354 (lexical-let* ((real-com (car (split-string (replace-regexp-in-string
10355 "%s" "" exe))))
10356 (proc (if file (concat real-com " " file) real-com)))
10357 (if (get-process proc)
10358 (if anything-raise-command
10359 (shell-command (format anything-raise-command real-com))
10360 (error "Error: %s is already running" real-com))
10361 (when (loop for i in anything-c-external-commands-list thereis real-com)
10362 (message "Starting %s..." real-com)
10363 (if file
10364 (start-process-shell-command
10365 proc nil (format exe (shell-quote-argument
10366 (if (eq system-type 'windows-nt)
10367 (anything-w32-prepare-filename file)
10368 file))))
10369 (start-process-shell-command proc nil real-com))
10370 (set-process-sentinel
10371 (get-process proc)
10372 #'(lambda (process event)
10373 (when (and (string= event "finished\n")
10374 anything-raise-command
10375 (not (anything-c-get-pid-from-process-name real-com)))
10376 (shell-command (format anything-raise-command "emacs")))
10377 (message "%s process...Finished." process))))
10378 (setq anything-c-external-commands-list
10379 (cons real-com
10380 (delete real-com anything-c-external-commands-list))))))
10384 ;;; Generic action functions
10387 (defun anything-c-file-buffers (filename)
10388 "Returns a list of buffer names corresponding to FILENAME."
10389 (let ((name (expand-file-name filename))
10390 (buf-list ()))
10391 (dolist (buf (buffer-list) buf-list)
10392 (let ((bfn (buffer-file-name buf)))
10393 (when (and bfn (string= name bfn))
10394 (push (buffer-name buf) buf-list))))))
10396 (defun anything-revert-buffer (candidate)
10397 (with-current-buffer candidate
10398 (when (or (buffer-modified-p)
10399 (not (verify-visited-file-modtime
10400 (get-buffer candidate))))
10401 (revert-buffer t t))))
10403 (defun anything-revert-marked-buffers (ignore)
10404 (mapc 'anything-revert-buffer (anything-marked-candidates)))
10406 (defun anything-kill-marked-buffers (ignore)
10407 (mapc 'kill-buffer (anything-marked-candidates)))
10409 (defun anything-c-delete-file (file &optional error-if-dot-file-p)
10410 "Delete the given file after querying the user.
10411 Ask to kill buffers associated with that file, too."
10412 (when (and error-if-dot-file-p
10413 (anything-ff-dot-file-p file))
10414 (error "Error: Cannot operate on `.' or `..'"))
10415 (let ((buffers (anything-c-file-buffers file)))
10416 (if (< emacs-major-version 24)
10417 ;; `dired-delete-file' in Emacs versions < 24
10418 ;; doesn't support delete-by-moving-to-trash
10419 ;; so use `delete-directory' and `delete-file'
10420 ;; that handle it.
10421 (cond ((and (not (file-symlink-p file))
10422 (file-directory-p file)
10423 (directory-files file t dired-re-no-dot))
10424 (when (y-or-n-p (format "Recursive delete of `%s'? " file))
10425 (delete-directory file 'recursive)))
10426 ((and (not (file-symlink-p file))
10427 (file-directory-p file))
10428 (delete-directory file))
10429 (t (delete-file file)))
10430 (dired-delete-file
10431 file 'dired-recursive-deletes delete-by-moving-to-trash))
10432 (when buffers
10433 (dolist (buf buffers)
10434 (when (y-or-n-p (format "Kill buffer %s, too? " buf))
10435 (kill-buffer buf))))))
10437 (defun anything-get-mailcap-for-file (filename)
10438 "Get the command to use for FILENAME from mailcap files.
10439 The command is like <command %s> and is meant to use with `format'."
10440 (mailcap-parse-mailcaps)
10441 (let* ((ext (file-name-extension filename))
10442 (mime (when ext (mailcap-extension-to-mime ext)))
10443 (result (when mime (mailcap-mime-info mime))))
10444 ;; If elisp file have no associations in .mailcap
10445 ;; `mailcap-maybe-eval' is returned, in this case just return nil.
10446 (when (stringp result) result)))
10448 (defun anything-get-default-program-for-file (filename)
10449 "Try to find a default program to open FILENAME.
10450 Try first in `anything-c-external-programs-associations' and then in mailcap file
10451 if nothing found return nil."
10452 (let* ((ext (file-name-extension filename))
10453 (def-prog (assoc-default ext anything-c-external-programs-associations)))
10454 (cond ((and def-prog (not (string= def-prog "")))
10455 (concat def-prog " %s"))
10456 ((and anything-c-default-external-file-browser
10457 (file-directory-p filename))
10458 (concat anything-c-default-external-file-browser " %s"))
10459 (t (anything-get-mailcap-for-file filename)))))
10461 (defun anything-c-open-file-externally (file)
10462 "Open FILE with an external program.
10463 Try to guess which program to use with `anything-get-default-program-for-file'.
10464 If not found or a prefix arg is given query the user which tool to use."
10465 (let* ((fname (expand-file-name file))
10466 (collection (anything-c-external-commands-list-1 'sort))
10467 (def-prog (anything-get-default-program-for-file fname))
10468 (real-prog-name (if (or anything-current-prefix-arg (not def-prog))
10469 ;; Prefix arg or no default program.
10470 (prog1
10471 (anything-comp-read
10472 "Program: " collection
10473 :must-match t
10474 :name "Open file Externally"
10475 :history anything-external-command-history)
10476 ;; Always prompt to set this program as default.
10477 (setq def-prog nil))
10478 ;; No prefix arg or default program exists.
10479 (replace-regexp-in-string " %s\\| '%s'" "" def-prog)))
10480 (program (concat real-prog-name " %s")))
10481 (unless (or def-prog ; Association exists, no need to record it.
10482 ;; Don't try to record non--filenames associations (e.g urls).
10483 (not (file-exists-p fname)))
10484 (when
10485 (y-or-n-p
10486 (format
10487 "Do you want to make `%s' the default program for this kind of files? "
10488 real-prog-name))
10489 (anything-aif (assoc (file-name-extension fname)
10490 anything-c-external-programs-associations)
10491 (setq anything-c-external-programs-associations
10492 (delete it anything-c-external-programs-associations)))
10493 (push (cons (file-name-extension fname)
10494 (read-string
10495 "Program (Add args maybe and confirm): " real-prog-name))
10496 anything-c-external-programs-associations)
10497 (customize-save-variable 'anything-c-external-programs-associations
10498 anything-c-external-programs-associations)))
10499 (anything-run-or-raise program file)
10500 (setq anything-external-command-history
10501 (cons real-prog-name
10502 (delete real-prog-name
10503 (loop for i in anything-external-command-history
10504 when (executable-find i) collect i))))))
10506 (defun anything-c-find-file-or-marked (candidate)
10507 "Open file CANDIDATE or open anything marked files in background."
10508 (let ((marked (anything-marked-candidates))
10509 (ffap-newfile-prompt anything-ff-newfile-prompt-p)
10510 (find-file-wildcards nil))
10511 (if (> (length marked) 1)
10512 ;; Open all marked files in background and display
10513 ;; the first one.
10514 (progn (mapc 'find-file-noselect (cdr marked))
10515 (find-file (car marked)))
10516 (if (and (not (file-exists-p candidate))
10517 (and ffap-url-regexp
10518 (not (string-match ffap-url-regexp candidate)))
10519 (string-match "/$" candidate))
10520 ;; A a non--existing filename ending with /
10521 ;; Create a directory and jump to it.
10522 (when (y-or-n-p (format "Create directory `%s'? " candidate))
10523 (let ((dirfname (directory-file-name candidate)))
10524 (if (file-exists-p dirfname)
10525 (error "Mkdir: Unable to create directory `%s': file exists."
10526 (anything-c-basename dirfname))
10527 (make-directory candidate 'parent)))
10528 (anything-find-files-1 candidate))
10529 ;; A non--existing filename NOT ending with / or
10530 ;; an existing filename, create or jump to it.
10531 (find-file-at-point (car marked))))))
10533 (defun anything-delete-marked-files (ignore)
10534 (let* ((files (anything-marked-candidates))
10535 (len (length files)))
10536 (if (not (y-or-n-p
10537 (format "Delete *%s File(s):\n%s"
10539 (mapconcat (lambda (f) (format "- %s\n" f)) files ""))))
10540 (message "(No deletions performed)")
10541 (dolist (i files)
10542 (set-text-properties 0 (length i) nil i)
10543 (anything-c-delete-file i anything-ff-signal-error-on-dot-files))
10544 (message "%s File(s) deleted" len))))
10546 (defun anything-ediff-marked-buffers (candidate &optional merge)
10547 "Ediff 2 marked buffers or CANDIDATE and `anything-current-buffer'.
10548 With optional arg MERGE call `ediff-merge-buffers'."
10549 (let ((lg-lst (length (anything-marked-candidates)))
10550 buf1 buf2)
10551 (case lg-lst
10553 (error "Error:You have to mark at least 1 buffer"))
10555 (setq buf1 anything-current-buffer
10556 buf2 (first (anything-marked-candidates))))
10558 (setq buf1 (first (anything-marked-candidates))
10559 buf2 (second (anything-marked-candidates))))
10561 (error "Error:To much buffers marked!")))
10562 (if merge
10563 (ediff-merge-buffers buf1 buf2)
10564 (ediff-buffers buf1 buf2))))
10566 (defun anything-ediff-marked-buffers-merge (candidate)
10567 "Ediff merge `anything-current-buffer' with CANDIDATE.
10568 See `anything-ediff-marked-buffers'."
10569 (anything-ediff-marked-buffers candidate t))
10571 (defun anything-bookmark-get-bookmark-from-name (bmk)
10572 "Return bookmark name even if it is a bookmark with annotation.
10573 e.g prepended with *.
10574 Return nil if bmk is not a valid bookmark."
10575 (let ((bookmark (replace-regexp-in-string "\*" "" bmk)))
10576 (if (assoc bookmark bookmark-alist)
10577 bookmark
10578 (when (assoc bmk bookmark-alist)
10579 bmk))))
10581 (defun anything-delete-marked-bookmarks (ignore)
10582 "Delete this bookmark or all marked bookmarks."
10583 (dolist (i (anything-marked-candidates))
10584 (bookmark-delete (anything-bookmark-get-bookmark-from-name i)
10585 'batch)))
10587 (defun anything-require-or-error (feature function)
10588 (or (require feature nil t)
10589 (error "Need %s to use `%s'." feature function)))
10591 (defun anything-find-buffer-on-elscreen (candidate)
10592 "Open buffer in new screen, if marked buffers open all in elscreens."
10593 (anything-require-or-error 'elscreen 'anything-find-buffer-on-elscreen)
10594 (anything-aif (anything-marked-candidates)
10595 (dolist (i it)
10596 (let ((target-screen (elscreen-find-screen-by-buffer
10597 (get-buffer i) 'create)))
10598 (elscreen-goto target-screen)))
10599 (let ((target-screen (elscreen-find-screen-by-buffer
10600 (get-buffer candidate) 'create)))
10601 (elscreen-goto target-screen))))
10603 (defun anything-elscreen-find-file (file)
10604 (anything-require-or-error 'elscreen 'anything-elscreen-find-file)
10605 (elscreen-find-file file))
10607 (defun anything-w32-prepare-filename (file)
10608 "Convert filename FILE to something usable by external w32 executables."
10609 (replace-regexp-in-string ; For UNC paths
10610 "/" "\\"
10611 (replace-regexp-in-string ; Strip cygdrive paths
10612 "/cygdrive/\\(.\\)" "\\1:"
10613 file nil nil) nil t))
10615 ;;;###autoload
10616 (defun anything-w32-shell-execute-open-file (file)
10617 (interactive "fOpen file:")
10618 (with-no-warnings
10619 (w32-shell-execute "open" (anything-w32-prepare-filename file))))
10621 (defun anything-c-open-file-with-default-tool (file)
10622 "Open FILE with the default tool on this platform."
10623 (if (eq system-type 'windows-nt)
10624 (anything-w32-shell-execute-open-file file)
10625 (start-process "anything-c-open-file-with-default-tool"
10627 (cond ((eq system-type 'gnu/linux)
10628 "xdg-open")
10629 ((or (eq system-type 'darwin) ;; Mac OS X
10630 (eq system-type 'macos)) ;; Mac OS 9
10631 "open"))
10632 file)))
10634 (defun anything-c-open-dired (file)
10635 "Opens a dired buffer in FILE's directory. If FILE is a
10636 directory, open this directory."
10637 (if (file-directory-p file)
10638 (dired file)
10639 (dired (file-name-directory file))
10640 (dired-goto-file file)))
10642 (defun anything-c-display-to-real-line (candidate)
10643 (if (string-match "^ *\\([0-9]+\\):\\(.*\\)$" candidate)
10644 (list (string-to-number (match-string 1 candidate)) (match-string 2 candidate))
10645 (error "Line number not found")))
10647 (defun anything-c-action-line-goto (lineno-and-content)
10648 (apply #'anything-goto-file-line (anything-interpret-value (anything-attr 'target-file))
10649 (append lineno-and-content
10650 (list (if (and (anything-attr-defined 'target-file)
10651 (not anything-in-persistent-action))
10652 'find-file-other-window
10653 'find-file)))))
10655 (defun* anything-c-action-file-line-goto (file-line-content &optional (find-file-function #'find-file))
10656 (apply #'anything-goto-file-line
10657 (if (stringp file-line-content)
10658 ;; Case: filtered-candidate-transformer is skipped
10659 (cdr (anything-c-filtered-candidate-transformer-file-line-1 file-line-content))
10660 file-line-content)))
10662 (require 'compile)
10663 (defun anything-c-filtered-candidate-transformer-file-line (candidates source)
10664 (delq nil (mapcar 'anything-c-filtered-candidate-transformer-file-line-1 candidates)))
10666 (defun anything-c-filtered-candidate-transformer-file-line-1 (candidate)
10667 (when (string-match "^\\(.+?\\):\\([0-9]+\\):\\(.*\\)$" candidate)
10668 (let ((filename (match-string 1 candidate))
10669 (lineno (match-string 2 candidate))
10670 (content (match-string 3 candidate)))
10671 (cons (format "%s:%s\n %s"
10672 (propertize filename 'face compilation-info-face)
10673 (propertize lineno 'face compilation-line-face)
10674 content)
10675 (list (expand-file-name
10676 filename
10677 (or (anything-interpret-value (anything-attr 'default-directory))
10678 (and (anything-candidate-buffer)
10679 (buffer-local-value
10680 'default-directory (anything-candidate-buffer)))))
10681 (string-to-number lineno) content)))))
10683 (defun* anything-goto-file-line (file lineno content &optional (find-file-function #'find-file))
10684 (anything-aif (anything-attr 'before-jump-hook)
10685 (funcall it))
10686 (when file (funcall find-file-function file))
10687 (if (anything-attr-defined 'adjust)
10688 (anything-c-goto-line-with-adjustment lineno content)
10689 (anything-goto-line lineno))
10690 (unless (anything-attr-defined 'recenter)
10691 (set-window-start (get-buffer-window anything-current-buffer) (point)))
10692 (anything-aif (anything-attr 'after-jump-hook)
10693 (funcall it))
10694 (when anything-in-persistent-action
10695 (anything-match-line-color-current-line)))
10697 (defun anything-find-file-as-root (candidate)
10698 (find-file (concat "/" anything-su-or-sudo "::" (expand-file-name candidate))))
10700 (defun anything-find-many-files (ignore)
10701 (mapc 'find-file (anything-marked-candidates)))
10703 ;; borrowed from etags.el
10704 ;; (anything-c-goto-line-with-adjustment (line-number-at-pos) ";; borrowed from etags.el")
10705 (defun anything-c-goto-line-with-adjustment (line line-content)
10706 (let ((startpos)
10707 offset found pat)
10708 ;; This constant is 1/2 the initial search window.
10709 ;; There is no sense in making it too small,
10710 ;; since just going around the loop once probably
10711 ;; costs about as much as searching 2000 chars.
10712 (setq offset 1000
10713 found nil
10714 pat (concat (if (eq selective-display t)
10715 "\\(^\\|\^m\\) *" "^ *") ;allow indent
10716 (regexp-quote line-content)))
10717 ;; If no char pos was given, try the given line number.
10718 (setq startpos (progn (anything-goto-line line) (point)))
10719 (or startpos (setq startpos (point-min)))
10720 ;; First see if the tag is right at the specified location.
10721 (goto-char startpos)
10722 (setq found (looking-at pat))
10723 (while (and (not found)
10724 (progn
10725 (goto-char (- startpos offset))
10726 (not (bobp))))
10727 (setq found
10728 (re-search-forward pat (+ startpos offset) t)
10729 offset (* 3 offset))) ; expand search window
10730 (or found
10731 (re-search-forward pat nil t)
10732 (error "not found")))
10733 ;; Position point at the right place
10734 ;; if the search string matched an extra Ctrl-m at the beginning.
10735 (and (eq selective-display t)
10736 (looking-at "\^m")
10737 (forward-char 1))
10738 (beginning-of-line))
10740 (anything-document-attribute 'default-directory "type . file-line"
10741 "`default-directory' to interpret file.")
10742 (anything-document-attribute 'before-jump-hook "type . file-line / line"
10743 "Function to call before jumping to the target location.")
10744 (anything-document-attribute 'after-jump-hook "type . file-line / line"
10745 "Function to call after jumping to the target location.")
10746 (anything-document-attribute 'adjust "type . file-line"
10747 "Search around line matching line contents.")
10748 (anything-document-attribute 'recenter "type . file-line / line"
10749 "`recenter' after jumping.")
10750 (anything-document-attribute 'target-file "type . line"
10751 "Goto line of target-file.")
10753 ;;;###autoload
10754 (defun anything-c-call-interactively (cmd-or-name)
10755 "Execute CMD-OR-NAME as Emacs command.
10756 It is added to `extended-command-history'.
10757 `anything-current-prefix-arg' is used as the command's prefix argument."
10758 (setq extended-command-history
10759 (cons (anything-c-stringify cmd-or-name)
10760 (delete (anything-c-stringify cmd-or-name) extended-command-history)))
10761 (let ((current-prefix-arg anything-current-prefix-arg)
10762 (cmd (anything-c-symbolify cmd-or-name)))
10763 (if (stringp (symbol-function cmd))
10764 (execute-kbd-macro (symbol-function cmd))
10765 (setq this-command cmd)
10766 (call-interactively cmd))))
10768 ;;;###autoload
10769 (defun anything-c-set-variable (var)
10770 "Set value to VAR interactively."
10771 (interactive)
10772 (let ((sym (anything-c-symbolify var)))
10773 (set sym (eval-minibuffer (format "Set %s: " var)
10774 (prin1-to-string (symbol-value sym))))))
10775 ;; (setq hh 12)
10776 ;; (anything-c-set-variable 'hh)
10780 ;;; Persistent Action Helpers
10783 (defvar anything-match-line-overlay-face nil)
10784 (defvar anything-match-line-overlay nil)
10786 (defun anything-match-line-color-current-line (&optional start end buf face rec)
10787 "Highlight and underline current position"
10788 (let ((args (list (or start (line-beginning-position))
10789 (or end (1+ (line-end-position)))
10790 buf)))
10791 (if (not anything-match-line-overlay)
10792 (setq anything-match-line-overlay (apply 'make-overlay args))
10793 (apply 'move-overlay anything-match-line-overlay args)))
10794 (overlay-put anything-match-line-overlay
10795 'face (or face anything-match-line-overlay-face))
10796 (when rec
10797 (goto-char start)
10798 (recenter)))
10800 (defalias 'anything-persistent-highlight-point 'anything-match-line-color-current-line)
10803 (setq anything-match-line-overlay-face 'anything-overlay-line-face)
10805 (defun anything-match-line-cleanup ()
10806 (when anything-match-line-overlay
10807 (delete-overlay anything-match-line-overlay)
10808 (setq anything-match-line-overlay nil)))
10810 (defun anything-match-line-update ()
10811 (when anything-match-line-overlay
10812 (delete-overlay anything-match-line-overlay)
10813 (anything-match-line-color-current-line)))
10815 (add-hook 'anything-cleanup-hook 'anything-match-line-cleanup)
10816 (add-hook 'anything-after-persistent-action-hook 'anything-match-line-update)
10819 ;;; Actions Transformers
10822 ;;; Files
10823 (defun anything-c-transform-file-load-el (actions candidate)
10824 "Add action to load the file CANDIDATE if it is an emacs lisp
10825 file. Else return ACTIONS unmodified."
10826 (if (member (file-name-extension candidate) '("el" "elc"))
10827 (append actions '(("Load Emacs Lisp File" . load-file)))
10828 actions))
10830 (defun anything-c-transform-file-browse-url (actions candidate)
10831 "Add an action to browse the file CANDIDATE if it in a html
10832 file or URL. Else return ACTIONS unmodified."
10833 (let ((browse-action '("Browse with Browser" . browse-url)))
10834 (cond ((string-match "^http\\|^ftp" candidate)
10835 (cons browse-action actions))
10836 ((string-match "\\.html?$" candidate)
10837 (append actions (list browse-action)))
10838 (t actions))))
10840 ;;; Function
10841 (defun anything-c-transform-function-call-interactively (actions candidate)
10842 "Add an action to call the function CANDIDATE interactively if
10843 it is a command. Else return ACTIONS unmodified."
10844 (if (commandp (intern-soft candidate))
10845 (append actions '(("Call Interactively"
10847 anything-c-call-interactively)))
10848 actions))
10850 ;;;; S-Expressions
10851 (defun anything-c-transform-sexp-eval-command-sexp (actions candidate)
10852 "If CANDIDATE's `car' is a command, then add an action to
10853 evaluate it and put it onto the `command-history'."
10854 (if (commandp (car (read candidate)))
10855 ;; Make it first entry
10856 (cons '("Eval and put onto command-history" .
10857 (lambda (sexp)
10858 (let ((sym (read sexp)))
10859 (eval sym)
10860 (setq command-history
10861 (cons sym command-history)))))
10862 actions)
10863 actions))
10866 ;;; Candidate Transformers
10869 ;;; Buffers
10870 (defun anything-c-skip-boring-buffers (buffers)
10871 (anything-c-skip-entries buffers anything-c-boring-buffer-regexp))
10873 (defun anything-c-skip-current-buffer (buffers)
10874 "[DEPRECATED] Skip current buffer in buffer lists.
10875 This transformer should not be used as this is now handled directly
10876 in `anything-c-buffer-list' and `anything-c-highlight-buffers'."
10877 (if anything-allow-skipping-current-buffer
10878 (remove (buffer-name anything-current-buffer) buffers)
10879 buffers))
10881 (defun anything-c-shadow-boring-buffers (buffers)
10882 "Buffers matching `anything-c-boring-buffer-regexp' will be
10883 displayed with the `file-name-shadow' face if available."
10884 (anything-c-shadow-entries buffers anything-c-boring-buffer-regexp))
10886 (defvar anything-c-buffer-display-string-functions
10887 '(anything-c-buffer-display-string--compilation
10888 anything-c-buffer-display-string--shell
10889 anything-c-buffer-display-string--eshell)
10890 "Functions to setup display string for buffer.
10892 Function has one argument, buffer name.
10893 If it returns string, use it.
10894 If it returns nil, display buffer name.
10895 See `anything-c-buffer-display-string--compilation' for example.")
10897 (defun anything-c-transform-buffer-display-string (buffers)
10898 "Setup display string for buffer candidates
10899 using `anything-c-buffer-display-string-functions'."
10900 (loop for buf in buffers
10901 if (consp buf)
10902 collect buf
10903 else
10904 for disp = (progn (set-buffer buf)
10905 (run-hook-with-args-until-success
10906 'anything-c-buffer-display-string-functions buf))
10907 collect (if disp (cons disp buf) buf)))
10909 (defun anything-c-buffer-display-string--compilation (buf)
10910 (anything-aif (car compilation-arguments)
10911 (format "%s: %s [%s]" buf it default-directory)))
10913 (defun anything-c-buffer-display-string--eshell (buf)
10914 (declare (special eshell-history-ring))
10915 (when (eq major-mode 'eshell-mode)
10916 (format "%s: %s [%s]" buf
10917 (ignore-errors (ring-ref eshell-history-ring 0))
10918 default-directory)))
10920 (defun anything-c-buffer-display-string--shell (buf)
10921 (when (eq major-mode 'shell-mode)
10922 (format "%s: %s [%s]" buf
10923 (ignore-errors (ring-ref comint-input-ring 0))
10924 default-directory)))
10926 ;;; Files
10927 (defun anything-c-shadow-boring-files (files)
10928 "Files matching `anything-c-boring-file-regexp' will be
10929 displayed with the `file-name-shadow' face if available."
10930 (anything-c-shadow-entries files anything-c-boring-file-regexp))
10932 (defun anything-c-skip-boring-files (files)
10933 "Files matching `anything-c-boring-file-regexp' will be skipped."
10934 (anything-c-skip-entries files anything-c-boring-file-regexp))
10935 ;; (anything-c-skip-boring-files '("README" "/src/.svn/hoge"))
10937 (defun anything-c-skip-current-file (files)
10938 "Current file will be skipped."
10939 (remove (buffer-file-name anything-current-buffer) files))
10941 (defun anything-c-w32-pathname-transformer (args)
10942 "Change undesirable features of windows pathnames to ones more acceptable to
10943 other candidate transformers."
10944 (if (eq system-type 'windows-nt)
10945 (anything-transform-mapcar
10946 (lambda (x)
10947 (replace-regexp-in-string
10948 "/cygdrive/\\(.\\)" "\\1:"
10949 (replace-regexp-in-string "\\\\" "/" x)))
10950 args)
10951 args))
10953 (defun anything-c-shorten-home-path (files)
10954 "Replaces /home/user with ~."
10955 (let ((home (replace-regexp-in-string "\\\\" "/" ; stupid Windows...
10956 (getenv "HOME"))))
10957 (anything-transform-mapcar
10958 (lambda (file)
10959 (if (and (stringp file) (string-match home file))
10960 (cons (replace-match "~" nil nil file) file)
10961 file))
10962 files)))
10964 ;;; Functions
10965 (defun anything-c-mark-interactive-functions (functions)
10966 "Mark interactive functions (commands) with (i) after the function name."
10967 (let (list)
10968 (loop for function in functions
10969 do (push (cons (concat function
10970 (when (commandp (intern-soft function)) " (i)"))
10971 function)
10972 list)
10973 finally (return (nreverse list)))))
10976 ;;; Adaptive Sorting of Candidates
10979 ;; Internal
10980 (defvar anything-c-adaptive-done nil
10981 "nil if history information is not yet stored for the current
10982 selection.")
10984 (defvar anything-c-adaptive-history nil
10985 "Contains the stored history information.
10986 Format: ((SOURCE-NAME (SELECTED-CANDIDATE (PATTERN . NUMBER-OF-USE) ...) ...) ...)")
10988 ;; Should run at beginning of `anything-initial-setup'.
10989 (add-hook 'anything-before-initialize-hook #'(lambda ()
10990 (when anything-c-use-adaptative-sorting
10991 (setq anything-c-adaptive-done nil))))
10993 ;; Should run at beginning of `anything-exit-minibuffer'.
10994 (add-hook 'anything-before-action-hook #'(lambda ()
10995 (when anything-c-use-adaptative-sorting
10996 (anything-c-adaptive-store-selection))))
10998 ;; Should run at beginning of `anything-select-action'.
10999 (add-hook 'anything-select-action-hook #'(lambda ()
11000 (when anything-c-use-adaptative-sorting
11001 (anything-c-adaptive-store-selection))))
11003 (defun anything-c-source-use-adaptative-p (&optional source-name)
11004 "Return current source only if it use adaptative history, nil otherwise."
11005 (when anything-c-use-adaptative-sorting
11006 (let* ((source (or source-name (anything-get-current-source)))
11007 (adapt-source (or (assoc-default 'filtered-candidate-transformer
11008 (assoc (assoc-default 'type source)
11009 anything-type-attributes))
11010 (assoc-default 'candidate-transformer
11011 (assoc (assoc-default 'type source)
11012 anything-type-attributes))
11013 (assoc-default 'filtered-candidate-transformer source)
11014 (assoc-default 'candidate-transformer source))))
11015 (if (listp adapt-source)
11016 (when (member 'anything-c-adaptive-sort adapt-source) source)
11017 (when (eq adapt-source 'anything-c-adaptive-sort) source)))))
11019 (defun anything-c-adaptive-store-selection ()
11020 "Store history information for the selected candidate."
11021 (unless anything-c-adaptive-done
11022 (setq anything-c-adaptive-done t)
11023 (let ((source (anything-c-source-use-adaptative-p)))
11024 (when source
11025 (let* ((source-name (or (assoc-default 'type source)
11026 (assoc-default 'name source)))
11027 (source-info (or (assoc source-name anything-c-adaptive-history)
11028 (progn
11029 (push (list source-name) anything-c-adaptive-history)
11030 (car anything-c-adaptive-history))))
11031 (selection (anything-get-selection))
11032 (selection-info (progn
11033 (setcdr source-info
11034 (cons
11035 (let ((found (assoc selection (cdr source-info))))
11036 (if (not found)
11037 ;; new entry
11038 (list selection)
11040 ;; move entry to the beginning of the
11041 ;; list, so that it doesn't get
11042 ;; trimmed when the history is
11043 ;; truncated
11044 (setcdr source-info
11045 (delete found (cdr source-info)))
11046 found))
11047 (cdr source-info)))
11048 (cadr source-info)))
11049 (pattern-info (progn
11050 (setcdr selection-info
11051 (cons
11052 (let ((found (assoc anything-pattern (cdr selection-info))))
11053 (if (not found)
11054 ;; new entry
11055 (cons anything-pattern 0)
11057 ;; move entry to the beginning of the
11058 ;; list, so if two patterns used the
11059 ;; same number of times then the one
11060 ;; used last appears first in the list
11061 (setcdr selection-info
11062 (delete found (cdr selection-info)))
11063 found))
11064 (cdr selection-info)))
11065 (cadr selection-info))))
11067 ;; increase usage count
11068 (setcdr pattern-info (1+ (cdr pattern-info)))
11070 ;; truncate history if needed
11071 (if (> (length (cdr selection-info)) anything-c-adaptive-history-length)
11072 (setcdr selection-info
11073 (subseq (cdr selection-info) 0 anything-c-adaptive-history-length))))))))
11075 (defun anything-c-adaptative-maybe-load-history ()
11076 (when (and anything-c-use-adaptative-sorting
11077 (file-readable-p anything-c-adaptive-history-file))
11078 (load-file anything-c-adaptive-history-file)))
11080 (add-hook 'emacs-startup-hook 'anything-c-adaptative-maybe-load-history)
11081 (add-hook 'kill-emacs-hook 'anything-c-adaptive-save-history)
11083 (defun anything-c-adaptive-save-history (&optional arg)
11084 "Save history information to file given by `anything-c-adaptive-history-file'."
11085 (interactive "p")
11086 (when anything-c-use-adaptative-sorting
11087 (with-temp-buffer
11088 (insert
11089 ";; -*- mode: emacs-lisp -*-\n"
11090 ";; History entries used for anything adaptive display.\n")
11091 (prin1 `(setq anything-c-adaptive-history ',anything-c-adaptive-history)
11092 (current-buffer))
11093 (insert ?\n)
11094 (write-region (point-min) (point-max) anything-c-adaptive-history-file nil
11095 (unless arg 'quiet)))))
11097 (defun anything-c-adaptive-sort (candidates source)
11098 "Sort the CANDIDATES for SOURCE by usage frequency.
11099 This is a filtered candidate transformer you can use for the
11100 attribute `filtered-candidate-transformer' of a source in
11101 `anything-sources' or a type in `anything-type-attributes'."
11102 (let* ((source-name (or (assoc-default 'type source)
11103 (assoc-default 'name source)))
11104 (source-info (assoc source-name anything-c-adaptive-history)))
11105 (if source-info
11106 (let ((usage
11107 ;; ... assemble a list containing the (CANIDATE . USAGE-COUNT)
11108 ;; pairs
11109 (mapcar (lambda (candidate-info)
11110 (let ((count 0))
11111 (dolist (pattern-info (cdr candidate-info))
11112 (if (not (equal (car pattern-info)
11113 anything-pattern))
11114 (incf count (cdr pattern-info))
11116 ;; if current pattern is equal to the previously
11117 ;; used one then this candidate has priority
11118 ;; (that's why its count is boosted by 10000) and
11119 ;; it only has to compete with other candidates
11120 ;; which were also selected with the same pattern
11121 (setq count (+ 10000 (cdr pattern-info)))
11122 (return)))
11123 (cons (car candidate-info) count)))
11124 (cdr source-info)))
11125 sorted)
11126 (if (and usage (consp usage))
11127 ;; sort the list in descending order, so candidates with highest
11128 ;; priorty come first
11129 (progn
11130 (setq usage (sort usage (lambda (first second)
11131 (> (cdr first) (cdr second)))))
11133 ;; put those candidates first which have the highest usage count
11134 (dolist (info usage)
11135 (when (member* (car info) candidates
11136 :test 'anything-c-adaptive-compare)
11137 (push (car info) sorted)
11138 (setq candidates (remove* (car info) candidates
11139 :test 'anything-c-adaptive-compare))))
11141 ;; and append the rest
11142 (append (reverse sorted) candidates nil))
11143 (message "Your `%s' is maybe corrupted or too old, \
11144 you should reinitialize it with `anything-c-reset-adaptative-history'"
11145 anything-c-adaptive-history-file)
11146 (sit-for 1)
11147 candidates))
11148 ;; if there is no information stored for this source then do nothing
11149 candidates)))
11151 ;;;###autoload
11152 (defun anything-c-reset-adaptative-history ()
11153 "Delete all `anything-c-adaptive-history' and his file.
11154 Useful when you have a old or corrupted `anything-c-adaptive-history-file'."
11155 (interactive)
11156 (when (y-or-n-p "Really delete all your `anything-c-adaptive-history'? ")
11157 (setq anything-c-adaptive-history nil)
11158 (delete-file anything-c-adaptive-history-file)))
11160 (defun anything-c-adaptive-compare (x y)
11161 "Compare candidates X and Y taking into account that the
11162 candidate can be in (DISPLAY . REAL) format."
11163 (equal (if (listp x)
11164 (cdr x)
11166 (if (listp y)
11167 (cdr y)
11168 y)))
11172 ;;; Outliner
11175 (defvar anything-outline-goto-near-line-flag t)
11176 (defvar anything-outline-using nil)
11177 (defun anything-after-update-hook--outline ()
11178 (if (and (eq anything-outline-using t)
11179 (eq anything-outline-goto-near-line-flag t))
11180 (anything-outline-goto-near-line)))
11181 (add-hook 'anything-after-update-hook 'anything-after-update-hook--outline)
11183 (defun anything-outline-goto-near-line ()
11184 (with-anything-window
11185 ;; TODO need consideration whether to update position by every input.
11186 (when t ; (equal anything-pattern "")
11187 (anything-goto-line 2)
11188 (let ((lineno (with-anything-current-buffer
11189 (line-number-at-pos (car anything-current-position)))))
11190 (block exit
11191 (while (<= (progn (skip-chars-forward " ")
11192 (or (number-at-point) lineno))
11193 lineno)
11194 (forward-line 1)
11195 (when (eobp)
11196 (forward-line -1)
11197 (return-from exit))))
11198 (forward-line -1)
11199 (and (bobp) (forward-line 1))
11200 (and (anything-pos-header-line-p) (forward-line -2))
11201 (anything-mark-current-line)))))
11205 ;;; Plug-in
11208 ;; Plug-in: info-index
11209 (defun* anything-c-info-init (&optional (file (anything-attr 'info-file)))
11210 (let (result)
11211 (unless (anything-candidate-buffer)
11212 (save-window-excursion
11213 (info file)
11214 (let (Info-history
11215 (tobuf (anything-candidate-buffer 'global))
11216 (infobuf (current-buffer))
11217 s e)
11218 (dolist (node (or (anything-attr 'index-nodes) (Info-index-nodes)))
11219 (Info-goto-node node)
11220 (goto-char (point-min))
11221 (while (search-forward "\n* " nil t)
11222 (unless (search-forward "Menu:\n" (1+ (point-at-eol)) t)
11223 '(save-current-buffer (buffer-substring-no-properties (point-at-bol) (point-at-eol)) result)
11224 (setq s (point-at-bol)
11225 e (point-at-eol))
11226 (with-current-buffer tobuf
11227 (insert-buffer-substring infobuf s e)
11228 (insert "\n"))))))))))
11230 (defun anything-c-info-goto (node-line)
11231 (Info-goto-node (car node-line))
11232 (anything-goto-line (cdr node-line)))
11234 (defun anything-c-info-display-to-real (line)
11235 (and (string-match
11236 ;; This regexp is stolen from Info-apropos-matches
11237 "\\* +\\([^\n]*.+[^\n]*\\):[ \t]+\\([^\n]*\\)\\.\\(?:[ \t\n]*(line +\\([0-9]+\\))\\)?" line)
11238 (cons (format "(%s)%s" (anything-attr 'info-file) (match-string 2 line))
11239 (string-to-number (or (match-string 3 line) "1")))))
11241 (defun anything-c-make-info-source (source file)
11242 `(,@source
11243 (name . ,(concat "Info Index: " file))
11244 (info-file . ,file)
11245 (init . anything-c-info-init)
11246 (display-to-real . anything-c-info-display-to-real)
11247 (get-line . buffer-substring)
11248 (candidates-in-buffer)
11249 (action ("Goto node" . anything-c-info-goto))))
11251 (defun anything-compile-source--info-index (source)
11252 (anything-aif (anything-interpret-value (assoc-default 'info-index source))
11253 (anything-c-make-info-source source it)
11254 source))
11255 (add-to-list 'anything-compile-source-functions 'anything-compile-source--info-index)
11257 (anything-document-attribute 'info-index "info-index plugin"
11258 "Create a source of info index very easily.
11260 ex. (defvar anything-c-source-info-wget '((info-index . \"wget\"))")
11262 (anything-document-attribute 'index-nodes "info-index plugin (optional)"
11263 "Index nodes of info file.
11265 If it is omitted, `Info-index-nodes' is used to collect index nodes.
11266 Some info files are missing index specification.
11268 ex. See `anything-c-source-info-screen'.")
11270 ;; Plug-in: candidates-file
11271 (defun anything-compile-source--candidates-file (source)
11272 (if (assoc-default 'candidates-file source)
11273 `((init anything-p-candidats-file-init
11274 ,@(let ((orig-init (assoc-default 'init source)))
11275 (cond ((null orig-init) nil)
11276 ((functionp orig-init) (list orig-init))
11277 (t orig-init))))
11278 (candidates-in-buffer)
11279 ,@source)
11280 source))
11281 (add-to-list 'anything-compile-source-functions 'anything-compile-source--candidates-file)
11283 (defun anything-p-candidats-file-init ()
11284 (destructuring-bind (file &optional updating)
11285 (anything-mklist (anything-attr 'candidates-file))
11286 (setq file (anything-interpret-value file))
11287 (with-current-buffer (anything-candidate-buffer (find-file-noselect file))
11288 (when updating
11289 (buffer-disable-undo)
11290 (font-lock-mode -1)
11291 (auto-revert-mode 1)))))
11293 (anything-document-attribute 'candidates-file "candidates-file plugin"
11294 "Use a file as the candidates buffer.
11296 1st argument is a filename, string or function name or variable name.
11297 If optional 2nd argument is non-nil, the file opened with `auto-revert-mode'.")
11299 ;; Plug-in: headline
11300 (defun anything-compile-source--anything-headline (source)
11301 (if (assoc-default 'headline source)
11302 (append '((init . anything-headline-init)
11303 (get-line . buffer-substring)
11304 (type . line))
11305 source
11306 '((candidates-in-buffer)
11307 (persistent-help . "Show this line")))
11308 source))
11309 (add-to-list 'anything-compile-source-functions 'anything-compile-source--anything-headline)
11311 (defun anything-headline-init ()
11312 (when (and (anything-current-buffer-is-modified)
11313 (with-anything-current-buffer
11314 (eval (or (anything-attr 'condition) t))))
11315 (anything-headline-make-candidate-buffer
11316 (anything-interpret-value (anything-attr 'headline))
11317 (anything-interpret-value (anything-attr 'subexp)))))
11319 (anything-document-attribute 'headline "Headline plug-in"
11320 "Regexp string for anything-headline to scan.")
11321 (anything-document-attribute 'condition "Headline plug-in"
11322 "A sexp representing the condition to use anything-headline.")
11323 (anything-document-attribute 'subexp "Headline plug-in"
11324 "Display (match-string-no-properties subexp).")
11326 ;; Le Wang: Note on how `anything-head-line-get-candidates' works with a list
11327 ;; of regexps.
11329 ;; 1. Create list of ((title . start-of-match) . hiearchy)
11330 ;; 2. Sort this list by start-of-match.
11331 ;; 3. Go through sorted list and return titles that reflect full hiearchy.
11333 ;; It's quite brilliantly written.
11337 (defun anything-headline-get-candidates (regexp subexp)
11338 (with-anything-current-buffer
11339 (save-excursion
11340 (goto-char (point-min))
11341 (if (functionp regexp) (setq regexp (funcall regexp)))
11342 (let (hierarchy curhead)
11343 (flet ((matched ()
11344 (if (numberp subexp)
11345 (cons (match-string-no-properties subexp) (match-beginning subexp))
11346 (cons (buffer-substring (point-at-bol) (point-at-eol))
11347 (point-at-bol))))
11348 (hierarchies (headlines)
11349 (1+ (loop for (_ . hierarchy) in headlines
11350 maximize hierarchy)))
11351 (vector-0-n (v n)
11352 (loop for i from 0 to hierarchy
11353 collecting (aref curhead i)))
11354 (arrange (headlines)
11355 (unless (null headlines) ; FIX headlines empty bug!
11356 (loop with curhead = (make-vector (hierarchies headlines) "")
11357 for ((str . pt) . hierarchy) in headlines
11358 do (aset curhead hierarchy str)
11359 collecting
11360 (cons
11361 (format "H%d:%s" (1+ hierarchy)
11362 (mapconcat 'identity (vector-0-n curhead hierarchy) " / "))
11363 pt)))))
11364 (if (listp regexp)
11365 (arrange
11366 (sort
11367 (loop for re in regexp
11368 for hierarchy from 0
11369 do (goto-char (point-min))
11370 appending
11371 (loop
11372 while (re-search-forward re nil t)
11373 collect (cons (matched) hierarchy)))
11374 (lambda (a b) (> (cdar b) (cdar a)))))
11375 (loop while (re-search-forward regexp nil t)
11376 collect (matched))))))))
11379 (defun anything-headline-make-candidate-buffer (regexp subexp)
11380 (with-current-buffer (anything-candidate-buffer 'local)
11381 (loop for (content . pos) in (anything-headline-get-candidates regexp subexp)
11382 do (insert
11383 (format "%5d:%s\n"
11384 (with-anything-current-buffer
11385 (line-number-at-pos pos))
11386 content)))))
11388 (defun anything-headline-goto-position (pos recenter)
11389 (goto-char pos)
11390 (unless recenter
11391 (set-window-start (get-buffer-window anything-current-buffer) (point))))
11394 ;; Plug-in: persistent-help
11395 (defun anything-compile-source--persistent-help (source)
11396 (append source '((header-line . anything-persistent-help-string))))
11397 (add-to-list 'anything-compile-source-functions 'anything-compile-source--persistent-help)
11399 (defun anything-persistent-help-string ()
11400 (substitute-command-keys
11401 (concat "\\<anything-map>\\[anything-execute-persistent-action]: "
11402 (or (anything-interpret-value (anything-attr 'persistent-help))
11403 (anything-aif (or (assoc-default 'persistent-action
11404 (anything-get-current-source))
11405 (assoc-default 'action
11406 (anything-get-current-source)))
11407 (cond ((symbolp it) (symbol-name it))
11408 ((listp it) (or (ignore-errors (caar it)) ""))))
11410 " (keeping session)")))
11412 (anything-document-attribute 'persistent-help "persistent-help plug-in"
11413 "A string to explain persistent-action of this source.
11414 It also accepts a function or a variable name.")
11416 ;;; (anything '(((name . "persistent-help test")(candidates "a")(persistent-help . "TEST"))))
11418 ;; Plug-in: Type customize
11419 (defun anything-c-uniq-list (lst)
11420 "Like `remove-duplicates' in CL.
11421 But cut deeper duplicates and test by `equal'. "
11422 (reverse (remove-duplicates (reverse lst) :test 'equal)))
11423 (defvar anything-additional-type-attributes nil)
11424 (defun anything-c-arrange-type-attribute (type spec)
11425 "Override type attributes by `define-anything-type-attribute'.
11427 The SPEC is like source. The symbol `REST' is replaced
11428 with original attribute value.
11430 Example: Set `play-sound-file' as default action
11431 (anything-c-arrange-type-attribute 'file
11432 '((action (\"Play sound\" . play-sound-file)
11433 REST ;; Rest of actions (find-file, find-file-other-window, etc...)."
11434 (add-to-list 'anything-additional-type-attributes
11435 (cons type
11436 (loop with typeattr = (assoc-default
11437 type anything-type-attributes)
11438 for (attr . value) in spec
11439 if (listp value)
11440 collect (cons attr
11441 (anything-c-uniq-list
11442 (loop for v in value
11443 if (eq v 'REST)
11444 append
11445 (assoc-default attr typeattr)
11446 else
11447 collect v)))
11448 else
11449 collect (cons attr value)))))
11450 (put 'anything-c-arrange-type-attribute 'lisp-indent-function 1)
11452 (defun anything-compile-source--type-customize (source)
11453 (anything-aif (assoc-default (assoc-default 'type source)
11454 anything-additional-type-attributes)
11455 (append it source)
11456 source))
11457 (add-to-list 'anything-compile-source-functions
11458 'anything-compile-source--type-customize t)
11460 ;; Plug-in: default-action
11461 (defun anything-compile-source--default-action (source)
11462 (anything-aif (assoc-default 'default-action source)
11463 (append `((action ,it ,@(remove it (assoc-default 'action source))))
11464 source)
11465 source))
11466 (add-to-list 'anything-compile-source-functions
11467 'anything-compile-source--default-action t)
11468 (anything-document-attribute 'default-action "default-action plug-in"
11469 "Default action.")
11472 ;;; Type Attributes
11475 (define-anything-type-attribute 'buffer
11476 `((action
11477 ("Switch to buffer" . anything-c-switch-to-buffer)
11478 ,(and (locate-library "popwin") '("Switch to buffer in popup window" . popwin:popup-buffer))
11479 ("Switch to buffer other window" . switch-to-buffer-other-window)
11480 ("Switch to buffer other frame" . switch-to-buffer-other-frame)
11481 ,(and (locate-library "elscreen") '("Display buffer in Elscreen" . anything-find-buffer-on-elscreen))
11482 ("Query replace regexp" . anything-c-buffer-query-replace-regexp)
11483 ("Query replace" . anything-c-buffer-query-replace)
11484 ("View buffer" . view-buffer)
11485 ("Display buffer" . display-buffer)
11486 ("Grep buffers (C-u grep all buffers)" . anything-c-zgrep-buffers)
11487 ("Revert buffer(s)" . anything-revert-marked-buffers)
11488 ("Insert buffer" . insert-buffer)
11489 ("Kill buffer(s)" . anything-kill-marked-buffers)
11490 ("Diff with file" . diff-buffer-with-file)
11491 ("Ediff Marked buffers" . anything-ediff-marked-buffers)
11492 ("Ediff Merge marked buffers" . (lambda (candidate)
11493 (anything-ediff-marked-buffers candidate t))))
11494 (persistent-help . "Show this buffer")
11495 (candidate-transformer anything-c-skip-boring-buffers
11496 anything-c-transform-buffer-display-string))
11497 "Buffer or buffer name.")
11499 (define-anything-type-attribute 'file
11500 `((action
11501 ("Find file" . anything-find-many-files)
11502 ,(and (locate-library "popwin") '("Find file in popup window" . popwin:find-file))
11503 ("Find file as root" . anything-find-file-as-root)
11504 ("Find file other window" . find-file-other-window)
11505 ("Find file other frame" . find-file-other-frame)
11506 ("Open dired in file's directory" . anything-c-open-dired)
11507 ("Grep File(s) `C-u recurse'" . anything-find-files-grep)
11508 ("Zgrep File(s) `C-u Recurse'" . anything-ff-zgrep)
11509 ("Pdfgrep File(s)" . anything-ff-pdfgrep)
11510 ("Checksum File" . anything-ff-checksum)
11511 ("Ediff File" . anything-find-files-ediff-files)
11512 ("Ediff Merge File" . anything-find-files-ediff-merge-files)
11513 ("View file" . view-file)
11514 ("Insert file" . insert-file)
11515 ("Delete file(s)" . anything-delete-marked-files)
11516 ("Open file externally (C-u to choose)" . anything-c-open-file-externally)
11517 ("Open file with default tool" . anything-c-open-file-with-default-tool)
11518 ("Find file in hex dump" . hexl-find-file))
11519 (persistent-help . "Show this file")
11520 (action-transformer anything-c-transform-file-load-el
11521 anything-c-transform-file-browse-url)
11522 (candidate-transformer anything-c-w32-pathname-transformer
11523 anything-c-skip-current-file
11524 anything-c-skip-boring-files
11525 anything-c-shorten-home-path))
11526 "File name.")
11528 (let ((actions '(("Describe command" . describe-function)
11529 ("Add command to kill ring" . anything-c-kill-new)
11530 ("Go to command's definition" . find-function)
11531 ("Debug on entry" . debug-on-entry)
11532 ("Cancel debug on entry" . cancel-debug-on-entry)
11533 ("Trace function" . trace-function)
11534 ("Trace function (background)" . trace-function-background)
11535 ("Untrace function" . untrace-function))))
11536 (define-anything-type-attribute 'command
11537 `((action ("Call interactively" . anything-c-call-interactively)
11538 ,@actions)
11539 (coerce . anything-c-symbolify)
11540 (persistent-action . describe-function))
11541 "Command. (string or symbol)")
11543 (define-anything-type-attribute 'function
11544 `((action . ,actions)
11545 (action-transformer anything-c-transform-function-call-interactively)
11546 (candidate-transformer anything-c-mark-interactive-functions)
11547 (coerce . anything-c-symbolify))
11548 "Function. (string or symbol)"))
11550 (define-anything-type-attribute 'variable
11551 '((action ("Describe variable" . describe-variable)
11552 ("Add variable to kill ring" . anything-c-kill-new)
11553 ("Go to variable's definition" . find-variable)
11554 ("Set variable" . anything-c-set-variable))
11555 (coerce . anything-c-symbolify))
11556 "Variable.")
11558 (define-anything-type-attribute 'sexp
11559 '((action ("Eval s-expression" . (lambda (c) (eval (read c))))
11560 ("Add s-expression to kill ring" . kill-new))
11561 (action-transformer anything-c-transform-sexp-eval-command-sexp))
11562 "String representing S-Expressions.")
11564 (define-anything-type-attribute 'bookmark
11565 `((coerce . anything-bookmark-get-bookmark-from-name)
11566 (action
11567 ("Jump to bookmark" . anything-c-bookmark-jump)
11568 ("Jump to BM other window" . bookmark-jump-other-window)
11569 ("Bookmark edit annotation" . bookmark-edit-annotation)
11570 ("Bookmark show annotation" . bookmark-show-annotation)
11571 ("Delete bookmark(s)" . anything-delete-marked-bookmarks)
11572 ,@(and (locate-library "bookmark-extensions")
11573 `(("Edit Bookmark" . bmkext-edit-bookmark)))
11574 ("Rename bookmark" . bookmark-rename)
11575 ("Relocate bookmark" . bookmark-relocate))
11576 (keymap . ,anything-c-bookmark-map)
11577 (mode-line . anything-bookmark-mode-line-string))
11578 "Bookmark name.")
11580 (define-anything-type-attribute 'line
11581 '((display-to-real . anything-c-display-to-real-line)
11582 (action ("Go to Line" . anything-c-action-line-goto)))
11583 "LINENO:CONTENT string, eg. \" 16:foo\".
11585 Optional `target-file' attribute is a name of target file.
11587 Optional `before-jump-hook' attribute is a function with no
11588 arguments which is called before jumping to position.
11590 Optional `after-jump-hook' attribute is a function with no
11591 arguments which is called after jumping to position.
11593 If `adjust' attribute is specified, searches the line whose
11594 content is CONTENT near the LINENO.
11596 If `recenter' attribute is specified, the line is displayed at
11597 the center of window, otherwise at the top of window.
11600 (define-anything-type-attribute 'file-line
11601 `((filtered-candidate-transformer anything-c-filtered-candidate-transformer-file-line)
11602 (multiline)
11603 (action ("Go to" . anything-c-action-file-line-goto)))
11604 "FILENAME:LINENO:CONTENT string, eg. \"~/.emacs:16:;; comment\".
11606 Optional `default-directory' attribute is a default-directory
11607 FILENAME is interpreted.
11609 Optional `before-jump-hook' attribute is a function with no
11610 arguments which is called before jumping to position.
11612 Optional `after-jump-hook' attribute is a function with no
11613 arguments which is called after jumping to position.
11615 If `adjust' attribute is specified, searches the line whose
11616 content is CONTENT near the LINENO.
11618 If `recenter' attribute is specified, the line is displayed at
11619 the center of window, otherwise at the top of window.
11622 (define-anything-type-attribute 'timer
11623 '((real-to-display . anything-c-timer-real-to-display)
11624 (action ("Cancel Timer" . cancel-timer)
11625 ("Describe Function" . (lambda (tm) (describe-function (timer--function tm))))
11626 ("Find Function" . (lambda (tm) (find-function (timer--function tm)))))
11627 (persistent-action . (lambda (tm) (describe-function (timer--function tm))))
11628 (persistent-help . "Describe Function"))
11629 "Timer.")
11632 ;;; Default `anything-sources'
11633 ;; Setting `anything-sources' is DEPRECATED, but it seems that newbies
11634 ;; tend to invoke M-x anything directly. So I offer default setting.
11635 (setq anything-sources
11636 '(anything-c-source-buffers-list
11637 anything-c-source-recentf
11638 anything-c-source-files-in-current-dir+))
11641 ;;; Preconfigured Anything
11644 ;;;###autoload
11645 (defun anything-mini ()
11646 "Preconfigured `anything' lightweight version \(buffer -> recentf\)."
11647 (interactive)
11648 (anything-other-buffer '(anything-c-source-buffers-list
11649 anything-c-source-recentf
11650 anything-c-source-buffer-not-found)
11651 "*anything mini*"))
11652 ;;;###autoload
11653 (defun anything-for-files ()
11654 "Preconfigured `anything' for opening files.
11655 ffap -> recentf -> buffer -> bookmark -> file-cache -> files-in-current-dir -> locate."
11656 (interactive)
11657 (anything-other-buffer anything-for-files-prefered-list "*anything for files*"))
11659 ;;;###autoload
11660 (defun anything-recentf ()
11661 "Preconfigured `anything' for `recentf'."
11662 (interactive)
11663 (anything-other-buffer 'anything-c-source-recentf "*anything recentf*"))
11665 ;;;###autoload
11666 (defun anything-info-at-point (arg)
11667 "Preconfigured `anything' for searching info at point.
11668 With a prefix-arg insert symbol at point."
11669 (interactive "P")
11670 (let ((anything-c-google-suggest-default-function
11671 'anything-c-google-suggest-emacs-lisp))
11672 (anything :sources '(anything-c-source-info-elisp
11673 anything-c-source-info-cl
11674 anything-c-source-info-pages
11675 anything-c-source-google-suggest)
11676 :input (and arg (thing-at-point 'symbol))
11677 :buffer "*anything info*")))
11679 ;;;###autoload
11680 (defun anything-show-kill-ring ()
11681 "Preconfigured `anything' for `kill-ring'.
11682 It is drop-in replacement of `yank-pop'.
11683 You may bind this command to M-y.
11684 First call open the kill-ring browser, next calls move to next line."
11685 (interactive)
11686 (anything :sources 'anything-c-source-kill-ring
11687 :buffer "*anything kill-ring*"))
11689 ;;;###autoload
11690 (defun anything-minibuffer-history ()
11691 "Preconfigured `anything' for `minibuffer-history'."
11692 (interactive)
11693 (let ((enable-recursive-minibuffers t))
11694 (anything-other-buffer 'anything-c-source-minibuffer-history
11695 "*anything minibuffer-history*")))
11697 ;;;###autoload
11698 (defun anything-gentoo ()
11699 "Preconfigured `anything' for gentoo linux."
11700 (interactive)
11701 (anything-other-buffer '(anything-c-source-gentoo
11702 anything-c-source-use-flags)
11703 "*anything gentoo*"))
11705 ;;;###autoload
11706 (defun anything-imenu ()
11707 "Preconfigured `anything' for `imenu'."
11708 (interactive)
11709 (anything :sources 'anything-c-source-imenu
11710 :buffer "*anything imenu*"))
11712 ;;;###autoload
11713 (defun anything-google-suggest ()
11714 "Preconfigured `anything' for google search with google suggest."
11715 (interactive)
11716 (anything-other-buffer 'anything-c-source-google-suggest "*anything google*"))
11718 ;;;###autoload
11719 (defun anything-yahoo-suggest ()
11720 "Preconfigured `anything' for Yahoo searching with Yahoo suggest."
11721 (interactive)
11722 (anything-other-buffer 'anything-c-source-yahoo-suggest "*anything yahoo*"))
11724 ;;; Converted from anything-show-*-only
11725 ;;;###autoload
11726 (defun anything-for-buffers ()
11727 "Preconfigured `anything' for buffers."
11728 (interactive)
11729 (anything-other-buffer 'anything-c-source-buffers "*anything for buffers*"))
11731 ;;;###autoload
11732 (defun anything-buffers-list ()
11733 "Preconfigured `anything' to list buffers.
11734 It is an enhanced version of `anything-for-buffers'."
11735 (interactive)
11736 (anything :sources '(anything-c-source-buffers-list
11737 anything-c-source-buffer-not-found)
11738 :buffer "*anything buffers*" :keymap anything-c-buffer-map))
11740 (defalias 'anything-buffers+ 'anything-buffers-list
11741 "Preconfigured `anything' to list buffers.
11742 It is an alias of `anything-buffers-list'.")
11744 ;;;###autoload
11745 (defun anything-bbdb ()
11746 "Preconfigured `anything' for BBDB.
11748 Needs BBDB.
11750 http://bbdb.sourceforge.net/"
11751 (interactive)
11752 (anything-other-buffer 'anything-c-source-bbdb "*anything bbdb*"))
11754 ;;;###autoload
11755 (defun anything-locate (arg)
11756 "Preconfigured `anything' for Locate.
11757 Note: you can add locate options after entering pattern.
11758 See 'man locate' for valid options.
11760 You can specify a specific database with prefix argument ARG \(C-u\).
11761 Many databases can be used: navigate and mark them.
11762 See also `anything-locate-with-db'.
11764 To create a user specific db, use
11765 \"updatedb -l 0 -o db_path -U directory\".
11766 Where db_path is a filename matched by
11767 `anything-locate-db-file-regexp'."
11768 (interactive "P")
11769 (anything-locate-1 arg))
11771 ;;;###autoload
11772 (defun anything-w3m-bookmarks ()
11773 "Preconfigured `anything' for w3m bookmark.
11775 Needs w3m and emacs-w3m.
11777 http://w3m.sourceforge.net/
11778 http://emacs-w3m.namazu.org/"
11779 (interactive)
11780 (anything-other-buffer 'anything-c-source-w3m-bookmarks
11781 "*anything w3m bookmarks*"))
11783 ;;;###autoload
11784 (defun anything-firefox-bookmarks ()
11785 "Preconfigured `anything' for firefox bookmark.
11786 You will have to enable html bookmarks in firefox:
11787 open about:config in firefox and double click on this line to enable value \
11788 to true:
11790 user_pref(\"browser.bookmarks.autoExportHTML\", false);
11792 You should have now:
11794 user_pref(\"browser.bookmarks.autoExportHTML\", true);
11796 After closing firefox, you will be able to browse you bookmarks.
11798 (interactive)
11799 (anything-other-buffer 'anything-c-source-firefox-bookmarks
11800 "*Anything Firefox*"))
11802 ;;;###autoload
11803 (defun anything-colors ()
11804 "Preconfigured `anything' for color."
11805 (interactive)
11806 (anything-other-buffer
11807 '(anything-c-source-colors anything-c-source-customize-face)
11808 "*anything colors*"))
11810 ;;;###autoload
11811 (defun anything-bookmarks ()
11812 "Preconfigured `anything' for bookmarks."
11813 (interactive)
11814 (anything-other-buffer 'anything-c-source-bookmarks "*anything bookmarks*"))
11816 ;;;###autoload
11817 (defun anything-c-pp-bookmarks ()
11818 "Preconfigured `anything' for bookmarks (pretty-printed)."
11819 (interactive)
11820 (anything-other-buffer '(anything-c-source-bookmarks-local
11821 anything-c-source-bookmarks-su
11822 anything-c-source-bookmarks-ssh)
11823 "*anything pp bookmarks*"))
11825 ;;;###autoload
11826 (defun anything-c-insert-latex-math ()
11827 "Preconfigured anything for latex math symbols completion."
11828 (interactive)
11829 (anything-other-buffer 'anything-c-source-latex-math "*anything latex*"))
11831 ;;;###autoload
11832 (defun anything-register ()
11833 "Preconfigured `anything' for Emacs registers."
11834 (interactive)
11835 (anything-other-buffer 'anything-c-source-register "*anything register*"))
11837 ;;;###autoload
11838 (defun anything-man-woman ()
11839 "Preconfigured `anything' for Man and Woman pages."
11840 (interactive)
11841 (anything-other-buffer 'anything-c-source-man-pages "*Anything man woman*"))
11843 ;;;###autoload
11844 (defun anything-org-keywords ()
11845 "Preconfigured `anything' for org keywords."
11846 (interactive)
11847 (anything-other-buffer 'anything-c-source-org-keywords "*org keywords*"))
11849 ;;;###autoload
11850 (defun anything-emms ()
11851 "Preconfigured `anything' for emms sources."
11852 (interactive)
11853 (anything :sources '(anything-c-source-emms-streams
11854 anything-c-source-emms-files
11855 anything-c-source-emms-dired)
11856 :buffer "*Anything Emms*"))
11858 ;;;###autoload
11859 (defun anything-eev-anchors ()
11860 "Preconfigured `anything' for eev anchors."
11861 (interactive)
11862 (anything-other-buffer 'anything-c-source-eev-anchor "*Anything eev anchors*"))
11864 ;;;###autoload
11865 (defun anything-bm-list ()
11866 "Preconfigured `anything' for visible bookmarks.
11868 Needs bm.el
11870 http://cvs.savannah.gnu.org/viewvc/*checkout*/bm/bm/bm.el"
11871 (interactive)
11872 (let ((anything-outline-using t))
11873 (anything-other-buffer 'anything-c-source-bm "*anything bm list*")))
11875 ;;;###autoload
11876 (defun anything-timers ()
11877 "Preconfigured `anything' for timers."
11878 (interactive)
11879 (anything-other-buffer '(anything-c-source-absolute-time-timers
11880 anything-c-source-idle-time-timers)
11881 "*anything timers*"))
11883 ;;;###autoload
11884 (defun anything-list-emacs-process ()
11885 "Preconfigured `anything' for emacs process."
11886 (interactive)
11887 (anything-other-buffer 'anything-c-source-emacs-process "*anything process*"))
11889 ;;;###autoload
11890 (defun anything-occur ()
11891 "Preconfigured Anything for Occur source.
11892 If region is active, search only in region,
11893 otherwise search in whole buffer."
11894 (interactive)
11895 (let ((anything-compile-source-functions
11896 ;; rule out anything-match-plugin because the input is one regexp.
11897 (delq 'anything-compile-source--match-plugin
11898 (copy-sequence anything-compile-source-functions))))
11899 (anything :sources 'anything-c-source-occur
11900 :buffer "*Anything Occur*"
11901 :history 'anything-c-grep-history)))
11903 ;;;###autoload
11904 (defun anything-browse-code ()
11905 "Preconfigured anything to browse code."
11906 (interactive)
11907 (anything :sources 'anything-c-source-browse-code
11908 :buffer "*anything browse code*"
11909 :default (thing-at-point 'symbol)))
11911 ;;;###autoload
11912 (defun anything-org-headlines ()
11913 "Preconfigured anything to show org headlines."
11914 (interactive)
11915 (anything-other-buffer 'anything-c-source-org-headline "*org headlines*"))
11917 ;;;###autoload
11918 (defun anything-regexp ()
11919 "Preconfigured anything to build regexps.
11920 `query-replace-regexp' can be run from there against found regexp."
11921 (interactive)
11922 (save-restriction
11923 (let ((anything-compile-source-functions
11924 ;; rule out anything-match-plugin because the input is one regexp.
11925 (delq 'anything-compile-source--match-plugin
11926 (copy-sequence anything-compile-source-functions))))
11927 (when (and (anything-region-active-p)
11928 ;; Don't narrow to region if buffer is already narrowed.
11929 (not (anything-current-buffer-narrowed-p)))
11930 (narrow-to-region (region-beginning) (region-end)))
11931 (anything :sources anything-c-source-regexp
11932 :buffer "*anything regexp*"
11933 :prompt "Regexp: "
11934 :history 'anything-build-regexp-history))))
11936 ;;;###autoload
11937 (defun anything-c-copy-files-async ()
11938 "Preconfigured anything to copy file list FLIST to DEST asynchronously."
11939 (interactive)
11940 (let* ((flist (anything-c-read-file-name
11941 "Copy File async: "
11942 :marked-candidates t))
11943 (dest (anything-c-read-file-name
11944 "Copy File async To: "
11945 :preselect (car flist)
11946 :initial-input (car anything-ff-history)
11947 :history (anything-find-files-history :comp-read nil))))
11948 (anything-c-copy-async-with-log flist dest)))
11950 ;;;###autoload
11951 (defun anything-find-files (arg)
11952 "Preconfigured `anything' for anything implementation of `find-file'.
11953 Called with a prefix arg show history if some.
11954 Don't call it from programs, use `anything-find-files-1' instead.
11955 This is the starting point for nearly all actions you can do on files."
11956 (interactive "P")
11957 (let ((any-input (if (and arg anything-ff-history)
11958 (anything-find-files-history)
11959 (anything-find-files-initial-input)))
11960 (presel (buffer-file-name (current-buffer))))
11961 (when (and (eq major-mode 'org-agenda-mode)
11962 org-directory
11963 (not any-input))
11964 (setq any-input (expand-file-name org-directory)))
11965 (set-text-properties 0 (length any-input) nil any-input)
11966 (if any-input
11967 (anything-find-files-1 any-input)
11968 (setq any-input (expand-file-name (anything-c-current-directory)))
11969 (anything-find-files-1
11970 any-input (if anything-ff-transformer-show-only-basename
11971 (and presel (anything-c-basename presel))
11972 presel)))))
11974 ;;;###autoload
11975 (defun anything-write-file ()
11976 "Preconfigured `anything' providing completion for `write-file'."
11977 (interactive)
11978 (let ((anything-mp-highlight-delay nil))
11979 (anything :sources 'anything-c-source-write-file
11980 :input (expand-file-name default-directory)
11981 :prompt "Write buffer to file: "
11982 :buffer "*Anything write file*")))
11984 ;;;###autoload
11985 (defun anything-insert-file ()
11986 "Preconfigured `anything' providing completion for `insert-file'."
11987 (interactive)
11988 (let ((anything-mp-highlight-delay nil))
11989 (anything :sources 'anything-c-source-insert-file
11990 :input (expand-file-name default-directory)
11991 :prompt "Insert file: "
11992 :buffer "*Anything insert file*")))
11994 ;;;###autoload
11995 (defun anything-dired-rename-file ()
11996 "Preconfigured `anything' to rename files from dired."
11997 (interactive)
11998 (anything-dired-do-action-on-file :action 'rename))
12000 ;;;###autoload
12001 (defun anything-dired-copy-file ()
12002 "Preconfigured `anything' to copy files from dired."
12003 (interactive)
12004 (anything-dired-do-action-on-file :action 'copy))
12006 ;;;###autoload
12007 (defun anything-dired-symlink-file ()
12008 "Preconfigured `anything' to symlink files from dired."
12009 (interactive)
12010 (anything-dired-do-action-on-file :action 'symlink))
12012 ;;;###autoload
12013 (defun anything-dired-hardlink-file ()
12014 "Preconfigured `anything' to hardlink files from dired."
12015 (interactive)
12016 (anything-dired-do-action-on-file :action 'hardlink))
12018 ;;;###autoload
12019 (defun anything-do-grep ()
12020 "Preconfigured anything for grep.
12021 Contrarily to Emacs `grep' no default directory is given, but
12022 the full path of candidates in ONLY.
12023 That allow to grep different files not only in `default-directory' but anywhere
12024 by marking them (C-<SPACE>). If one or more directory is selected
12025 grep will search in all files of these directories.
12026 You can use also wildcard in the base name of candidate.
12027 If a prefix arg is given use the -r option of grep.
12028 The prefix arg can be passed before or after start.
12029 See also `anything-do-grep-1'."
12030 (interactive)
12031 (let ((only (anything-c-read-file-name
12032 "Search in file(s): "
12033 :marked-candidates t
12034 :preselect (or (dired-get-filename nil t)
12035 (buffer-file-name (current-buffer)))))
12036 (prefarg (or current-prefix-arg anything-current-prefix-arg)))
12037 (anything-do-grep-1 only prefarg)))
12039 ;;;###autoload
12040 (defun anything-do-zgrep ()
12041 "Preconfigured anything for zgrep."
12042 (interactive)
12043 (let ((prefarg (or current-prefix-arg anything-current-prefix-arg))
12044 (ls (anything-c-read-file-name
12045 "Search in file(s): "
12046 :marked-candidates t
12047 :preselect (or (dired-get-filename nil t)
12048 (buffer-file-name (current-buffer))))))
12049 (anything-ff-zgrep-1 ls prefarg)))
12051 ;;;###autoload
12052 (defun anything-do-pdfgrep ()
12053 "Preconfigured anything for pdfgrep."
12054 (interactive)
12055 (let ((only (anything-c-read-file-name
12056 "Search in file(s): "
12057 :marked-candidates t
12058 :test #'(lambda (file)
12059 (or (string= (file-name-extension file) "pdf")
12060 (string= (file-name-extension file) "PDF")
12061 (file-directory-p file)))
12062 :preselect (or (dired-get-filename nil t)
12063 (buffer-file-name (current-buffer)))))
12064 (anything-c-grep-default-function 'anything-c-pdfgrep-init))
12065 (anything-do-pdfgrep-1 only)))
12067 ;;;###autoload
12068 (defun anything-c-etags-select (arg)
12069 "Preconfigured anything for etags.
12070 Called with one prefix arg use symbol at point as initial input.
12071 Called with two prefix arg reinitialize cache.
12072 If tag file have been modified reinitialize cache."
12073 (interactive "P")
12074 (let ((tag (anything-c-etags-get-tag-file))
12075 (init (and (equal arg '(4)) (thing-at-point 'symbol)))
12076 (anything-quit-if-no-candidate t)
12077 (anything-execute-action-at-once-if-one t)
12078 (anything-compile-source-functions
12079 (if anything-c-etags-use-regexp-search
12080 ;; rule out anything-match-plugin because the input is one regexp.
12081 (delq 'anything-compile-source--match-plugin
12082 (copy-sequence anything-compile-source-functions))
12083 anything-compile-source-functions)))
12084 (when (or (equal arg '(16))
12085 (and anything-c-etags-mtime-alist
12086 (anything-c-etags-file-modified-p tag)))
12087 (remhash tag anything-c-etags-cache))
12088 (if (and tag (file-exists-p tag))
12089 (anything :sources 'anything-c-source-etags-select
12090 :keymap anything-c-etags-map
12091 :input init
12092 :buffer "*anything etags*")
12093 (message "Error: No tag file found, please create one with etags shell command."))))
12095 ;;;###autoload
12096 (defun anything-filelist ()
12097 "Preconfigured `anything' to open files instantly.
12099 See `anything-c-filelist-file-name' docstring for usage."
12100 (interactive)
12101 (anything-other-buffer 'anything-c-source-filelist "*anything file list*"))
12103 ;;;###autoload
12104 (defun anything-filelist+ ()
12105 "Preconfigured `anything' to open files/buffers/bookmarks instantly.
12107 This is a replacement for `anything-for-files'.
12108 See `anything-c-filelist-file-name' docstring for usage."
12109 (interactive)
12110 (anything-other-buffer
12111 '(anything-c-source-ffap-line
12112 anything-c-source-ffap-guesser
12113 anything-c-source-buffers-list
12114 anything-c-source-recentf
12115 anything-c-source-bookmarks
12116 anything-c-source-file-cache
12117 anything-c-source-filelist)
12118 "*anything file list*"))
12120 ;;;###autoload
12121 (defun anything-M-x ()
12122 "Preconfigured `anything' for Emacs commands.
12123 It is `anything' replacement of regular `M-x' `execute-extended-command'."
12124 (interactive)
12125 (let* (in-help
12126 help-cand
12127 special-display-buffer-names
12128 special-display-regexps
12129 anything-persistent-action-use-special-display
12130 (history (loop with hist
12131 for i in extended-command-history
12132 for com = (intern i)
12133 when (fboundp com)
12134 collect i into hist finally return hist)))
12135 (flet ((pers-help (candidate)
12136 (let ((hbuf (get-buffer (help-buffer))))
12137 (if (and in-help (string= candidate help-cand))
12138 (progn
12139 ;; When M-x is started from a help buffer,
12140 ;; Don't kill it as it is anything-current-buffer.
12141 (unless (equal hbuf anything-current-buffer)
12142 (kill-buffer hbuf))
12143 (setq in-help nil))
12144 ;; Be sure anything-current-buffer
12145 ;; have not a dedicated window.
12146 (set-window-dedicated-p
12147 (get-buffer-window anything-current-buffer) nil)
12148 (describe-function (intern candidate))
12149 (message nil) ; Erase the new stupid message Type "q"[...]
12150 (setq in-help t))
12151 (setq help-cand candidate))))
12152 (let* ((command (anything-comp-read
12153 "M-x " obarray
12154 :test 'commandp
12155 :requires-pattern anything-M-x-requires-pattern
12156 :name "Emacs Commands"
12157 :buffer "*anything M-x*"
12158 :persistent-action 'pers-help
12159 :persistent-help "Describe this command"
12160 :history history
12161 :sort 'string-lessp
12162 :must-match t
12163 :candidates-in-buffer t
12164 :fc-transformer 'anything-M-x-transformer))
12165 (sym-com (intern command)))
12166 (unless current-prefix-arg
12167 (setq current-prefix-arg anything-current-prefix-arg))
12168 ;; Avoid having `this-command' set to *exit-minibuffer.
12169 (setq this-command sym-com)
12170 (call-interactively sym-com)
12171 (setq extended-command-history
12172 (cons command (delete command history)))))))
12174 ;;;###autoload
12175 (defun anything-manage-advice ()
12176 "Preconfigured `anything' to disable/enable function advices."
12177 (interactive)
12178 (anything-other-buffer 'anything-c-source-advice "*anything advice*"))
12180 ;;;###autoload
12181 (defun anything-bookmark-ext ()
12182 "Preconfigured `anything' for bookmark-extensions sources.
12183 Needs bookmark-ext.el:
12184 <http://mercurial.intuxication.org/hg/emacs-bookmark-extension>.
12185 Contain also `anything-c-source-google-suggest'."
12186 (interactive)
12187 (anything
12188 :sources
12189 '(anything-c-source-bookmark-files&dirs
12190 anything-c-source-bookmark-w3m
12191 anything-c-source-google-suggest
12192 anything-c-source-bmkext-addressbook
12193 anything-c-source-bookmark-gnus
12194 anything-c-source-bookmark-info
12195 anything-c-source-bookmark-man
12196 anything-c-source-bookmark-images
12197 anything-c-source-bookmark-su-files&dirs
12198 anything-c-source-bookmark-ssh-files&dirs)
12199 :prompt "SearchBookmark: "
12200 :buffer "*anything bmkext*"))
12202 ;;;###autoload
12203 (defun anything-simple-call-tree ()
12204 "Preconfigured `anything' for simple-call-tree. List function relationships.
12206 Needs simple-call-tree.el.
12207 http://www.emacswiki.org/cgi-bin/wiki/download/simple-call-tree.el"
12208 (interactive)
12209 (anything-other-buffer
12210 '(anything-c-source-simple-call-tree-functions-callers
12211 anything-c-source-simple-call-tree-callers-functions)
12212 "*anything simple-call-tree*"))
12214 ;;;###autoload
12215 (defun anything-mark-ring ()
12216 "Preconfigured `anything' for `anything-c-source-mark-ring'."
12217 (interactive)
12218 (anything :sources 'anything-c-source-mark-ring))
12220 ;;;###autoload
12221 (defun anything-global-mark-ring ()
12222 "Preconfigured `anything' for `anything-c-source-global-mark-ring'."
12223 (interactive)
12224 (anything :sources 'anything-c-source-global-mark-ring))
12226 ;;;###autoload
12227 (defun anything-all-mark-rings ()
12228 "Preconfigured `anything' for `anything-c-source-global-mark-ring' and \
12229 `anything-c-source-mark-ring'."
12230 (interactive)
12231 (anything :sources '(anything-c-source-mark-ring
12232 anything-c-source-global-mark-ring)))
12234 ;;;###autoload
12235 (defun anything-yaoddmuse-emacswiki-edit-or-view ()
12236 "Preconfigured `anything' to edit or view EmacsWiki page.
12238 Needs yaoddmuse.el.
12240 http://www.emacswiki.org/emacs/download/yaoddmuse.el"
12241 (interactive)
12242 (anything :sources 'anything-c-source-yaoddmuse-emacswiki-edit-or-view))
12244 ;;;###autoload
12245 (defun anything-yaoddmuse-emacswiki-post-library ()
12246 "Preconfigured `anything' to post library to EmacsWiki.
12248 Needs yaoddmuse.el.
12250 http://www.emacswiki.org/emacs/download/yaoddmuse.el"
12251 (interactive)
12252 (anything :sources 'anything-c-source-yaoddmuse-emacswiki-post-library))
12254 ;;;###autoload
12255 (defun anything-eval-expression (arg)
12256 "Preconfigured anything for `anything-c-source-evaluation-result'."
12257 (interactive "P")
12258 (anything :sources 'anything-c-source-evaluation-result
12259 :input (when arg (thing-at-point 'sexp))
12260 :buffer "*anything eval*"
12261 :history 'anything-eval-expression-input-history
12262 :keymap anything-eval-expression-map))
12264 ;;;###autoload
12265 (defun anything-eval-expression-with-eldoc ()
12266 "Preconfigured anything for `anything-c-source-evaluation-result' with `eldoc' support. "
12267 (interactive)
12268 (declare (special eldoc-idle-delay))
12269 (let ((timer (run-with-idle-timer eldoc-idle-delay
12270 'repeat 'anything-eldoc-show-in-eval))
12271 (minibuffer-completing-symbol t) ; Enable lisp completion.
12272 (completion-cycle-threshold t)) ; Always cycle, no pesty completion buffer (emacs24 only).
12273 (unwind-protect
12274 (minibuffer-with-setup-hook
12275 'anything-eldoc-store-minibuffer
12276 (call-interactively 'anything-eval-expression))
12277 (and timer (cancel-timer timer))
12278 (setq anything-eldoc-active-minibuffers-list
12279 (cdr anything-eldoc-active-minibuffers-list)))))
12281 ;;;###autoload
12282 (defun anything-calcul-expression ()
12283 "Preconfigured anything for `anything-c-source-calculation-result'."
12284 (interactive)
12285 (anything-other-buffer 'anything-c-source-calculation-result "*anything calcul*"))
12287 ;;;###autoload
12288 (defun anything-surfraw (pattern engine)
12289 "Preconfigured `anything' to search PATTERN with search ENGINE."
12290 (interactive (list (read-string "SearchFor: "
12291 nil 'anything-surfraw-input-history)
12292 (anything-comp-read
12293 "Engine: "
12294 (anything-c-build-elvi-list)
12295 :must-match t
12296 :name "Surfraw Search Engines"
12297 :history anything-surfraw-engines-history)))
12298 (let* ((engine-nodesc (car (split-string engine)))
12299 (url (with-temp-buffer
12300 (apply 'call-process "surfraw" nil t nil
12301 ;;JAVE
12302 (append (list engine-nodesc "-p") (split-string pattern)))
12303 (replace-regexp-in-string
12304 "\n" "" (buffer-string))))
12305 (browse-url-browser-function (or anything-surfraw-default-browser-function
12306 browse-url-browser-function)))
12307 (if (string= engine-nodesc "W")
12308 (anything-c-browse-url anything-c-home-url)
12309 (anything-c-browse-url url)
12310 (setq anything-surfraw-engines-history
12311 (cons engine (delete engine anything-surfraw-engines-history))))))
12313 ;;;###autoload
12314 (defun anything-call-source ()
12315 "Preconfigured `anything' to call anything source."
12316 (interactive)
12317 (anything :sources 'anything-c-source-call-source
12318 :buffer anything-source-select-buffer))
12320 ;;;###autoload
12321 (defun anything-execute-anything-command ()
12322 "Preconfigured `anything' to execute preconfigured `anything'."
12323 (interactive)
12324 (anything-other-buffer 'anything-c-source-anything-commands
12325 "*anything commands*"))
12327 ;;;###autoload
12328 (defun anything-create (&optional string initial-input)
12329 "Preconfigured `anything' to do many create actions from STRING.
12330 See also `anything-create--actions'."
12331 (interactive)
12332 (setq string (or string (read-string "Create Anything: " initial-input)))
12333 (anything :sources '(((name . "Anything Create")
12334 (header-name . (lambda (_) (format "Action for \"%s\"" string)))
12335 (candidates . anything-create--actions)
12336 (candidate-number-limit)
12337 (action . (lambda (func) (funcall func string)))))))
12339 ;;;###autoload
12340 (defun anything-top ()
12341 "Preconfigured `anything' for top command."
12342 (interactive)
12343 (let ((anything-samewindow t)
12344 (anything-enable-shortcuts)
12345 (anything-display-function 'anything-default-display-buffer)
12346 (anything-candidate-number-limit 9999))
12347 (save-window-excursion
12348 (delete-other-windows)
12349 (anything-other-buffer 'anything-c-source-top "*anything top*"))))
12351 ;;;###autoload
12352 (defun anything-select-xfont ()
12353 "Preconfigured `anything' to select Xfont."
12354 (interactive)
12355 (anything-other-buffer 'anything-c-source-xfonts "*anything select* xfont"))
12357 ;;;###autoload
12358 (defun anything-world-time ()
12359 "Preconfigured `anything' to show world time."
12360 (interactive)
12361 (anything-other-buffer 'anything-c-source-time-world "*anything world time*"))
12363 ;;;###autoload
12364 (defun anything-apt (arg)
12365 "Preconfigured `anything' : frontend of APT package manager.
12366 With a prefix arg reload cache."
12367 (interactive "P")
12368 (let ((query (read-string "Search Package: " nil 'anything-c-apt-input-history)))
12369 (when arg (anything-c-apt-refresh))
12370 (anything :sources 'anything-c-source-apt
12371 :prompt "Search Package: "
12372 :input query
12373 :history 'anything-c-apt-input-history)))
12375 ;;;###autoload
12376 (defun anything-esh-pcomplete ()
12377 "Preconfigured anything to provide anything completion in eshell."
12378 (interactive)
12379 (let* ((anything-quit-if-no-candidate t)
12380 (anything-execute-action-at-once-if-one t)
12381 (target (thing-at-point 'symbol))
12382 (end (point))
12383 (beg (or (and target (- end (length target)))
12384 ;; Nothing at point.
12385 (progn (insert " ") (point)))))
12386 (setq anything-ec-target (or target " "))
12387 (with-anything-show-completion beg end
12388 (anything :sources 'anything-c-source-esh
12389 :buffer "*anything pcomplete*"
12390 :input (anything-ff-set-pattern ; Handle tramp filenames.
12391 (car (last (ignore-errors ; Needed in lisp symbols completion.
12392 (pcomplete-parse-arguments)))))))))
12394 ;;;###autoload
12395 (defun anything-eshell-history ()
12396 "Preconfigured anything for eshell history."
12397 (interactive)
12398 (let* ((end (point))
12399 (beg (save-excursion (eshell-bol) (point)))
12400 flag-empty)
12401 (when (eq beg end)
12402 (insert " ")
12403 (setq flag-empty t)
12404 (setq end (point)))
12405 (unwind-protect
12406 (with-anything-show-completion beg end
12407 (anything :sources 'anything-c-source-eshell-history
12408 :buffer "*Eshell history*"))
12409 (when (and flag-empty
12410 (looking-back " "))
12411 (delete-char -1)))))
12413 ;;;###autoload
12414 (defun anything-c-run-external-command (program)
12415 "Preconfigured `anything' to run External PROGRAM asyncronously from Emacs.
12416 If program is already running exit with error.
12417 You can set your own list of commands with
12418 `anything-c-external-commands-list'."
12419 (interactive (list
12420 (anything-comp-read
12421 "RunProgram: "
12422 (anything-c-external-commands-list-1 'sort)
12423 :must-match t
12424 :name "External Commands"
12425 :history anything-external-command-history)))
12426 (anything-run-or-raise program)
12427 (setq anything-external-command-history
12428 (cons program (delete program
12429 (loop for i in anything-external-command-history
12430 when (executable-find i) collect i)))))
12432 ;;;###autoload
12433 (defun anything-ratpoison-commands ()
12434 "Preconfigured `anything' to execute ratpoison commands."
12435 (interactive)
12436 (anything-other-buffer 'anything-c-source-ratpoison-commands
12437 "*anything ratpoison commands*"))
12439 ;;;###autoload
12440 (defun anything-ucs ()
12441 "Preconfigured anything for `ucs-names' math symbols."
12442 (interactive)
12443 (anything :sources 'anything-c-source-ucs
12444 :keymap anything-c-ucs-map))
12446 ;;;###autoload
12447 (defun anything-c-apropos ()
12448 "Preconfigured anything to describe commands, functions, variables and faces."
12449 (interactive)
12450 (let ((default (thing-at-point 'symbol)))
12451 (anything :sources
12452 `(((name . "Commands")
12453 (init . (lambda ()
12454 (anything-c-apropos-init 'commandp ,default)))
12455 (persistent-action . anything-lisp-completion-persistent-action)
12456 (persistent-help . "Show brief doc in mode-line")
12457 (candidates-in-buffer)
12458 (action . (lambda (candidate)
12459 (describe-function (intern candidate)))))
12460 ((name . "Functions")
12461 (init . (lambda ()
12462 (anything-c-apropos-init #'(lambda (x) (and (fboundp x)
12463 (not (commandp x))))
12464 ,default)))
12465 (persistent-action . anything-lisp-completion-persistent-action)
12466 (persistent-help . "Show brief doc in mode-line")
12467 (candidates-in-buffer)
12468 (action . (lambda (candidate)
12469 (describe-function (intern candidate)))))
12470 ((name . "Variables")
12471 (init . (lambda ()
12472 (anything-c-apropos-init 'boundp ,default)))
12473 (persistent-action . anything-lisp-completion-persistent-action)
12474 (persistent-help . "Show brief doc in mode-line")
12475 (candidates-in-buffer)
12476 (action . (lambda (candidate)
12477 (describe-variable (intern candidate)))))
12478 ((name . "Faces")
12479 (init . (lambda ()
12480 (anything-c-apropos-init 'facep ,default)))
12481 (persistent-action . anything-lisp-completion-persistent-action)
12482 (persistent-help . "Show brief doc in mode-line")
12483 (candidates-in-buffer)
12484 (filtered-candidate-transformer . (lambda (candidates source)
12485 (loop for c in candidates
12486 collect (propertize c 'face (intern c)))))
12487 (action . (lambda (candidate)
12488 (describe-face (intern candidate)))))
12489 ((name . "Anything attributes")
12490 (candidates . (lambda ()
12491 (mapcar 'symbol-name anything-additional-attributes)))
12492 (action . (lambda (candidate)
12493 (with-output-to-temp-buffer "*Help*"
12494 (princ (get (intern candidate) 'anything-attrdoc))))))))))
12496 ;;;###autoload
12497 (defun anything-xrandr-set ()
12498 (interactive)
12499 (anything :sources 'anything-c-source-xrandr-change-resolution
12500 :buffer "*anything xrandr*"))
12503 ;;; Unit tests are now in ../developer-tools/unit-test-anything-config.el.
12505 (provide 'anything-config)
12507 ;; Local Variables:
12508 ;; coding: utf-8
12509 ;; End:
12511 ;;; anything-config.el ends here