* anything-config.el Fix expansion of root directory on Windows.
[anything-config.git] / anything-config.el
blob24fbb021a2f4e232dd887c2333294d44c1187971
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 ~ 2011, rubikitch, all rights reserved.
15 ;; Copyright (C) 2009 ~ 2011, 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'
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 ;;; !NOTICE!
50 ;; If this file does not work, upgrade anything.el!
51 ;; http://www.emacswiki.org/cgi-bin/wiki/download/anything.el
53 ;;; Commentary:
55 ;; Predefined configurations for `anything.el'
57 ;; For quick start, try `anything-for-files' to open files.
59 ;; To configure anything you should define anything command
60 ;; with your favorite sources, like below:
62 ;; (defun my-anything ()
63 ;; (interactive)
64 ;; (anything-other-buffer
65 ;; '(anything-c-source-buffers
66 ;; anything-c-source-file-name-history
67 ;; anything-c-source-info-pages
68 ;; anything-c-source-info-elisp
69 ;; anything-c-source-man-pages
70 ;; anything-c-source-locate
71 ;; anything-c-source-emacs-commands)
72 ;; " *my-anything*"))
74 ;; Then type M-x my-anything to use sources.
76 ;; Defining own command is better than setup `anything-sources'
77 ;; directly, because you can define multiple anything commands with
78 ;; different sources. Each anything command should have own anything
79 ;; buffer, because M-x anything-resume revives anything command.
82 ;;; Autodoc documentation:
83 ;; ---------------------
85 ;; * Commands defined here are:
86 ;; [EVAL] (autodoc-document-lisp-buffer :type 'command :prefix "anything-" :docstring t)
87 ;; `anything-configuration'
88 ;; Customize `anything'.
89 ;; `anything-c-buffer-help'
90 ;; Help command for anything buffers.
91 ;; `anything-ff-help'
92 ;; Help command for `anything-find-files'.
93 ;; `anything-read-file-name-help'
94 ;; Not documented.
95 ;; `anything-generic-file-help'
96 ;; Not documented.
97 ;; `anything-grep-help'
98 ;; Not documented.
99 ;; `anything-pdfgrep-help'
100 ;; Not documented.
101 ;; `anything-etags-help'
102 ;; The help function for etags.
103 ;; `anything-c-ucs-help'
104 ;; Help command for `anything-ucs'.
105 ;; `anything-show-this-source-only'
106 ;; Show all candidates of this source.
107 ;; `anything-test-sources'
108 ;; List all anything sources for test.
109 ;; `anything-select-source'
110 ;; [OBSOLETE] Select source.
111 ;; `anything-quit-and-find-file'
112 ;; Drop into `anything-find-files' from `anything'.
113 ;; `anything-mark-all'
114 ;; Mark all visible unmarked candidates in current source.
115 ;; `anything-unmark-all'
116 ;; Unmark all candidates in all sources of current anything session.
117 ;; `anything-toggle-all-marks'
118 ;; Toggle all marks.
119 ;; `anything-buffer-diff-persistent'
120 ;; Toggle diff buffer without quitting anything.
121 ;; `anything-buffer-revert-persistent'
122 ;; Revert buffer without quitting anything.
123 ;; `anything-buffer-save-persistent'
124 ;; Save buffer without quitting anything.
125 ;; `anything-buffer-run-kill-buffers'
126 ;; Run kill buffer action from `anything-c-source-buffers-list'.
127 ;; `anything-buffer-run-grep'
128 ;; Run Grep action from `anything-c-source-buffers-list'.
129 ;; `anything-buffer-run-zgrep'
130 ;; Run Grep action from `anything-c-source-buffers-list'.
131 ;; `anything-buffer-run-query-replace-regexp'
132 ;; Run Query replace regexp action from `anything-c-source-buffers-list'.
133 ;; `anything-buffer-run-query-replace'
134 ;; Run Query replace action from `anything-c-source-buffers-list'.
135 ;; `anything-buffer-switch-other-window'
136 ;; Run switch to other window action from `anything-c-source-buffers-list'.
137 ;; `anything-buffer-switch-other-frame'
138 ;; Run switch to other frame action from `anything-c-source-buffers-list'.
139 ;; `anything-buffer-switch-to-elscreen'
140 ;; Run switch to elscreen action from `anything-c-source-buffers-list'.
141 ;; `anything-buffer-run-ediff'
142 ;; Run ediff action from `anything-c-source-buffers-list'.
143 ;; `anything-buffer-run-ediff-merge'
144 ;; Run ediff action from `anything-c-source-buffers-list'.
145 ;; `anything-ff-run-toggle-auto-update'
146 ;; Not documented.
147 ;; `anything-ff-run-switch-to-history'
148 ;; Run Switch to history action from `anything-c-source-find-files'.
149 ;; `anything-ff-run-grep'
150 ;; Run Grep action from `anything-c-source-find-files'.
151 ;; `anything-ff-run-pdfgrep'
152 ;; Run Pdfgrep action from `anything-c-source-find-files'.
153 ;; `anything-ff-run-zgrep'
154 ;; Run Grep action from `anything-c-source-find-files'.
155 ;; `anything-ff-run-copy-file'
156 ;; Run Copy file action from `anything-c-source-find-files'.
157 ;; `anything-ff-run-rename-file'
158 ;; Run Rename file action from `anything-c-source-find-files'.
159 ;; `anything-ff-run-byte-compile-file'
160 ;; Run Byte compile file action from `anything-c-source-find-files'.
161 ;; `anything-ff-run-load-file'
162 ;; Run Load file action from `anything-c-source-find-files'.
163 ;; `anything-ff-run-eshell-command-on-file'
164 ;; Run eshell command on file action from `anything-c-source-find-files'.
165 ;; `anything-ff-run-ediff-file'
166 ;; Run Ediff file action from `anything-c-source-find-files'.
167 ;; `anything-ff-run-ediff-merge-file'
168 ;; Run Ediff merge file action from `anything-c-source-find-files'.
169 ;; `anything-ff-run-symlink-file'
170 ;; Run Symlink file action from `anything-c-source-find-files'.
171 ;; `anything-ff-run-delete-file'
172 ;; Run Delete file action from `anything-c-source-find-files'.
173 ;; `anything-ff-run-complete-fn-at-point'
174 ;; Run complete file name action from `anything-c-source-find-files'.
175 ;; `anything-ff-run-switch-to-eshell'
176 ;; Run switch to eshell action from `anything-c-source-find-files'.
177 ;; `anything-ff-run-switch-other-window'
178 ;; Run switch to other window action from `anything-c-source-find-files'.
179 ;; `anything-ff-run-switch-other-frame'
180 ;; Run switch to other frame action from `anything-c-source-find-files'.
181 ;; `anything-ff-run-open-file-externally'
182 ;; Run open file externally command action from `anything-c-source-find-files'.
183 ;; `anything-ff-run-locate'
184 ;; Run locate action from `anything-c-source-find-files'.
185 ;; `anything-ff-run-gnus-attach-files'
186 ;; Run gnus attach files command action from `anything-c-source-find-files'.
187 ;; `anything-ff-run-etags'
188 ;; Run Etags command action from `anything-c-source-find-files'.
189 ;; `anything-ff-run-print-file'
190 ;; Run Print file action from `anything-c-source-find-files'.
191 ;; `anything-ff-run-toggle-basename'
192 ;; Not documented.
193 ;; `anything-find-files-down-one-level'
194 ;; Go down one level like unix command `cd ..'.
195 ;; `anything-ff-properties-persistent'
196 ;; Show properties without quitting anything.
197 ;; `anything-ff-run-kill-buffer-persistent'
198 ;; Execute `anything-ff-kill-buffer-fname' whitout quitting.
199 ;; `anything-ff-rotate-left-persistent'
200 ;; Rotate image left without quitting anything.
201 ;; `anything-ff-rotate-right-persistent'
202 ;; Rotate image right without quitting anything.
203 ;; `anything-c-goto-precedent-file'
204 ;; Go to precedent file in anything grep/etags buffers.
205 ;; `anything-c-goto-next-file'
206 ;; Go to precedent file in anything grep/etags buffers.
207 ;; `anything-c-grep-run-persistent-action'
208 ;; Run grep persistent action from `anything-do-grep-1'.
209 ;; `anything-c-grep-run-default-action'
210 ;; Run grep default action from `anything-do-grep-1'.
211 ;; `anything-c-grep-run-other-window-action'
212 ;; Run grep goto other window action from `anything-do-grep-1'.
213 ;; `anything-c-grep-run-save-buffer'
214 ;; Run grep save results action from `anything-do-grep-1'.
215 ;; `anything-do-pdfgrep'
216 ;; Not documented.
217 ;; `anything-yank-text-at-point'
218 ;; Yank text at point in minibuffer.
219 ;; `anything-c-describe-attributes'
220 ;; Display the full documentation of ANYTHING-ATTRIBUTE (a symbol).
221 ;; `anything-yaoddmuse-cache-pages'
222 ;; Fetch the list of files on emacswiki and create cache file.
223 ;; `anything-eval-new-line-and-indent'
224 ;; Not documented.
225 ;; `anything-call-source-from-anything'
226 ;; Call anything source within `anything' session.
227 ;; `anything-create-from-anything'
228 ;; Run `anything-create' from `anything' as a fallback.
229 ;; `anything-c-ucs-persistent-insert'
230 ;; Not documented.
231 ;; `anything-c-ucs-persistent-forward'
232 ;; Not documented.
233 ;; `anything-c-ucs-persistent-backward'
234 ;; Not documented.
235 ;; `anything-c-ucs-persistent-delete'
236 ;; Not documented.
237 ;; `anything-lisp-completion-at-point'
238 ;; Anything lisp symbol completion at point.
239 ;; `anything-c-complete-file-name-at-point'
240 ;; Complete file name at point.
241 ;; `anything-lisp-completion-at-point-or-indent'
242 ;; First call indent and second call complete lisp symbol.
243 ;; `anything-lisp-completion-or-file-name-at-point'
244 ;; Complete lisp symbol or filename at point.
245 ;; `anything-c-set-variable'
246 ;; Set value to VAR interactively.
247 ;; `anything-c-adaptive-save-history'
248 ;; Save history information to file given by `anything-c-adaptive-history-file'.
249 ;; `anything-c-reset-adaptative-history'
250 ;; Delete all `anything-c-adaptive-history' and his file.
251 ;; `anything-c-toggle-match-plugin'
252 ;; Toggle anything-match-plugin.
253 ;; `anything-mini'
254 ;; Preconfigured `anything' lightweight version (buffer -> recentf).
255 ;; `anything-for-files'
256 ;; Preconfigured `anything' for opening files.
257 ;; `anything-recentf'
258 ;; Preconfigured `anything' for `recentf'.
259 ;; `anything-info-at-point'
260 ;; Preconfigured `anything' for searching info at point.
261 ;; `anything-info-emacs'
262 ;; Preconfigured anything for Emacs manual index.
263 ;; `anything-show-kill-ring'
264 ;; Preconfigured `anything' for `kill-ring'.
265 ;; `anything-minibuffer-history'
266 ;; Preconfigured `anything' for `minibuffer-history'.
267 ;; `anything-gentoo'
268 ;; Preconfigured `anything' for gentoo linux.
269 ;; `anything-imenu'
270 ;; Preconfigured `anything' for `imenu'.
271 ;; `anything-google-suggest'
272 ;; Preconfigured `anything' for google search with google suggest.
273 ;; `anything-yahoo-suggest'
274 ;; Preconfigured `anything' for Yahoo searching with Yahoo suggest.
275 ;; `anything-for-buffers'
276 ;; Preconfigured `anything' for buffer.
277 ;; `anything-buffers-list'
278 ;; Enhanced preconfigured `anything' for buffer.
279 ;; `anything-bbdb'
280 ;; Preconfigured `anything' for BBDB.
281 ;; `anything-locate'
282 ;; Preconfigured `anything' for Locate.
283 ;; `anything-w3m-bookmarks'
284 ;; Preconfigured `anything' for w3m bookmark.
285 ;; `anything-firefox-bookmarks'
286 ;; Preconfigured `anything' for firefox bookmark.
287 ;; `anything-colors'
288 ;; Preconfigured `anything' for color.
289 ;; `anything-bookmarks'
290 ;; Preconfigured `anything' for bookmarks.
291 ;; `anything-c-pp-bookmarks'
292 ;; Preconfigured `anything' for bookmarks (pretty-printed).
293 ;; `anything-c-insert-latex-math'
294 ;; Preconfigured anything for latex math symbols completion.
295 ;; `anything-register'
296 ;; Preconfigured `anything' for Emacs registers.
297 ;; `anything-man-woman'
298 ;; Preconfigured `anything' for Man and Woman pages.
299 ;; `anything-org-keywords'
300 ;; Preconfigured `anything' for org keywords.
301 ;; `anything-emms'
302 ;; Preconfigured `anything' for emms sources.
303 ;; `anything-eev-anchors'
304 ;; Preconfigured `anything' for eev anchors.
305 ;; `anything-bm-list'
306 ;; Preconfigured `anything' for visible bookmarks.
307 ;; `anything-timers'
308 ;; Preconfigured `anything' for timers.
309 ;; `anything-list-emacs-process'
310 ;; Preconfigured `anything' for emacs process.
311 ;; `anything-occur'
312 ;; Preconfigured Anything for Occur source.
313 ;; `anything-browse-code'
314 ;; Preconfigured anything to browse code.
315 ;; `anything-org-headlines'
316 ;; Preconfigured anything to show org headlines.
317 ;; `anything-info-gnus'
318 ;; Preconfigured anything to browse Gnus Manual.
319 ;; `anything-regexp'
320 ;; Preconfigured anything to build regexps.
321 ;; `anything-c-copy-files-async'
322 ;; Preconfigured anything to copy file list FLIST to DEST asynchronously.
323 ;; `anything-find-files'
324 ;; Preconfigured `anything' for anything implementation of `find-file'.
325 ;; `anything-write-file'
326 ;; Preconfigured `anything' providing completion for `write-file'.
327 ;; `anything-insert-file'
328 ;; Preconfigured `anything' providing completion for `insert-file'.
329 ;; `anything-dired-rename-file'
330 ;; Preconfigured `anything' to rename files from dired.
331 ;; `anything-dired-copy-file'
332 ;; Preconfigured `anything' to copy files from dired.
333 ;; `anything-dired-symlink-file'
334 ;; Preconfigured `anything' to symlink files from dired.
335 ;; `anything-dired-hardlink-file'
336 ;; Preconfigured `anything' to hardlink files from dired.
337 ;; `anything-do-grep'
338 ;; Preconfigured anything for grep.
339 ;; `anything-c-etags-select'
340 ;; Preconfigured anything for etags.
341 ;; `anything-filelist'
342 ;; Preconfigured `anything' to open files instantly.
343 ;; `anything-filelist+'
344 ;; Preconfigured `anything' to open files/buffers/bookmarks instantly.
345 ;; `anything-M-x'
346 ;; Preconfigured `anything' for Emacs commands.
347 ;; `anything-manage-advice'
348 ;; Preconfigured `anything' to disable/enable function advices.
349 ;; `anything-bookmark-ext'
350 ;; Preconfigured `anything' for bookmark-extensions sources.
351 ;; `anything-simple-call-tree'
352 ;; Preconfigured `anything' for simple-call-tree. List function relationships.
353 ;; `anything-mark-ring'
354 ;; Preconfigured `anything' for `anything-c-source-mark-ring'.
355 ;; `anything-global-mark-ring'
356 ;; Preconfigured `anything' for `anything-c-source-global-mark-ring'.
357 ;; `anything-all-mark-rings'
358 ;; Preconfigured `anything' for `anything-c-source-global-mark-ring' and `anything-c-source-mark-ring'.
359 ;; `anything-yaoddmuse-emacswiki-edit-or-view'
360 ;; Preconfigured `anything' to edit or view EmacsWiki page.
361 ;; `anything-yaoddmuse-emacswiki-post-library'
362 ;; Preconfigured `anything' to post library to EmacsWiki.
363 ;; `anything-eval-expression'
364 ;; Preconfigured anything for `anything-c-source-evaluation-result'.
365 ;; `anything-eval-expression-with-eldoc'
366 ;; Preconfigured anything for `anything-c-source-evaluation-result' with `eldoc' support.
367 ;; `anything-calcul-expression'
368 ;; Preconfigured anything for `anything-c-source-calculation-result'.
369 ;; `anything-surfraw'
370 ;; Preconfigured `anything' to search PATTERN with search ENGINE.
371 ;; `anything-call-source'
372 ;; Preconfigured `anything' to call anything source.
373 ;; `anything-execute-anything-command'
374 ;; Preconfigured `anything' to execute preconfigured `anything'.
375 ;; `anything-create'
376 ;; Preconfigured `anything' to do many create actions from STRING.
377 ;; `anything-top'
378 ;; Preconfigured `anything' for top command.
379 ;; `anything-select-xfont'
380 ;; Preconfigured `anything' to select Xfont.
381 ;; `anything-world-time'
382 ;; Preconfigured `anything' to show world time.
383 ;; `anything-apt'
384 ;; Preconfigured `anything' : frontend of APT package manager.
385 ;; `anything-esh-pcomplete'
386 ;; Preconfigured anything to provide anything completion in eshell.
387 ;; `anything-eshell-history'
388 ;; Preconfigured anything for eshell history.
389 ;; `anything-c-run-external-command'
390 ;; Preconfigured `anything' to run External PROGRAM asyncronously from Emacs.
391 ;; `anything-ratpoison-commands'
392 ;; Preconfigured `anything' to execute ratpoison commands.
393 ;; `anything-ucs'
394 ;; Preconfigured anything for `ucs-names' math symbols.
395 ;; `anything-c-apropos'
396 ;; Preconfigured anything to describe commands, functions, variables and faces.
398 ;; * User variables defined here:
399 ;; [EVAL] (autodoc-document-lisp-buffer :type 'user-variable :prefix "anything-" :var-value t)
400 ;; `anything-c-adaptive-history-file'
401 ;; Default Value: "~/.emacs.d/anything-c-adaptive-history"
402 ;; `anything-c-adaptive-history-length'
403 ;; Default Value: 50
404 ;; `anything-c-google-suggest-url'
405 ;; Default Value: "http://google.com/complete/search?output=toolbar&q="
406 ;; `anything-c-google-suggest-search-url'
407 ;; Default Value: "http://www.google.com/search?ie=utf-8&oe=utf-8&q="
408 ;; `anything-google-suggest-use-curl-p'
409 ;; Default Value: nil
410 ;; `anything-c-yahoo-suggest-url'
411 ;; Default Value: "http://search.yahooapis.com/WebSearchService/V1/relatedSuggestion?appid=G [...]
412 ;; `anything-c-yahoo-suggest-search-url'
413 ;; Default Value: "http://search.yahoo.com/search?&ei=UTF-8&fr&h=c&p="
414 ;; `anything-c-boring-buffer-regexp'
415 ;; Default Value: "\\ (\\` \\)\\|\\*anything\\|\\*ac-mode\\| \\*Echo Area\\| \\*Minibuf"
416 ;; `anything-c-boring-file-regexp'
417 ;; Default Value: "/\\ (?:\\(?:\\.\\(?:git\\|hg\\|svn\\)\\|CVS\\|_darcs\\)\\)\\(?:/\\|$\\)\\| [...]
418 ;; `anything-kill-ring-threshold'
419 ;; Default Value: 10
420 ;; `anything-c-kill-ring-max-lines-number'
421 ;; Default Value: nil
422 ;; `anything-su-or-sudo'
423 ;; Default Value: "su"
424 ;; `anything-for-files-prefered-list'
425 ;; Default Value: (anything-c-source-ffap-line anything-c-source-ffap-guesser anything-c-sou [...]
426 ;; `anything-create--actions-private'
427 ;; Default Value: nil
428 ;; `anything-allow-skipping-current-buffer'
429 ;; Default Value: t
430 ;; `anything-c-enable-eval-defun-hack'
431 ;; Default Value: t
432 ;; `anything-tramp-verbose'
433 ;; Default Value: 0
434 ;; `anything-raise-command'
435 ;; Default Value: nil
436 ;; `anything-command-map-prefix-key'
437 ;; Default Value: "<f5> a"
438 ;; `anything-c-browse-code-regexp-lisp'
439 ;; Default Value: "^ * (def\\(un\\|subst\\|macro\\|face\\|alias\\|advice\\|struct\\|type\\|th [...]
440 ;; `anything-c-browse-code-regexp-python'
441 ;; Default Value: "\\<def\\>\\|\\<class\\>"
442 ;; `anything-c-browse-code-regexp-alist'
443 ;; Default Value: ((lisp-interaction-mode . "^ *(def\\(un\\|subst\\|macro\\|face\\|alias\\|a [...]
444 ;; `anything-c-external-programs-associations'
445 ;; Default Value: nil
446 ;; `anything-ff-auto-update-initial-value'
447 ;; Default Value: t
448 ;; `anything-c-copy-async-prefered-emacs'
449 ;; Default Value: "emacs"
450 ;; `anything-ff-lynx-style-map'
451 ;; Default Value: t
452 ;; `anything-ff-history-max-length'
453 ;; Default Value: 100
454 ;; `anything-ff-smart-completion'
455 ;; Default Value: t
456 ;; `anything-ff-default-kbsize'
457 ;; Default Value: 1024.0
458 ;; `anything-ff-tramp-not-fancy'
459 ;; Default Value: t
460 ;; `anything-ff-exif-data-program'
461 ;; Default Value: "exiftran"
462 ;; `anything-ff-exif-data-program-args'
463 ;; Default Value: "-d"
464 ;; `anything-c-grep-use-ioccur-style-keys'
465 ;; Default Value: t
466 ;; `anything-c-pdfgrep-default-read-command'
467 ;; Default Value: "xpdf '%f' %p"
468 ;; `anything-c-etags-tag-file-name'
469 ;; Default Value: "TAGS"
470 ;; `anything-c-etags-tag-file-search-limit'
471 ;; Default Value: 10
472 ;; `anything-c-etags-use-regexp-search'
473 ;; Default Value: nil
474 ;; `anything-c-etags-search-regexp'
475 ;; Default Value: "^.+: .+ \\<%s"
476 ;; `anything-c-filelist-file-name'
477 ;; Default Value: nil
478 ;; `anything-c-eldoc-in-minibuffer-show-fn'
479 ;; Default Value: anything-c-show-info-in-mode-line
480 ;; `anything-c-turn-on-show-completion'
481 ;; Default Value: t
482 ;; `anything-lisp-completion-or-indent-delay'
483 ;; Default Value: 0.6
484 ;; `anything-c-default-external-file-browser'
485 ;; Default Value: "nautilus"
486 ;; `anything-c-use-adaptative-sorting'
487 ;; Default Value: nil
488 ;; `anything-ff-newfile-prompt-p'
489 ;; Default Value: t
490 ;; `anything-ff-avfs-directory'
491 ;; Default Value: nil
492 ;; `anything-ff-file-compressed-list'
493 ;; Default Value: ("gz" "bz2" "zip" "7z")
494 ;; `anything-locate-db-file-regexp'
495 ;; Default Value: "m?locate.db$"
496 ;; `anything-c-show-info-in-mode-line-delay'
497 ;; Default Value: 12
498 ;; `anything-c-copy-files-async-log-file'
499 ;; Default Value: "/tmp/dired.log"
500 ;; `anything-ff-printer-list'
501 ;; Default Value: nil
502 ;; `anything-ff-transformer-show-only-basename'
503 ;; Default Value: nil
504 ;; `anything-completing-read-handlers-alist'
505 ;; Default Value: ((describe-function . anything-completing-read-symbols) (describe-variabl [...]
507 ;; * Anything sources defined here:
508 ;; [EVAL] (autodoc-document-lisp-buffer :type 'anything-source :prefix "anything-" :any-sname t)
509 ;; `anything-c-source-regexp' (Regexp Builder)
510 ;; `anything-c-source-buffers' (Buffers)
511 ;; `anything-c-source-buffer-not-found' (Create buffer)
512 ;; `anything-c-source-buffers-list' (Buffers)
513 ;; `anything-c-source-file-name-history' (File Name History)
514 ;; `anything-c-source-files-in-current-dir' (Files from Current Directory)
515 ;; `anything-c-source-files-in-current-dir+' (Files from Current Directory)
516 ;; `anything-c-source-find-files' (Find Files)
517 ;; `anything-c-source-write-file' (Write File)
518 ;; `anything-c-source-insert-file' (Insert File)
519 ;; `anything-c-source-copy-files' (Copy Files)
520 ;; `anything-c-source-symlink-files' (Symlink Files)
521 ;; `anything-c-source-hardlink-files' (Hardlink Files)
522 ;; `anything-c-source-file-cache' (File Cache)
523 ;; `anything-c-source-locate' (Locate)
524 ;; `anything-c-source-recentf' (Recentf)
525 ;; `anything-c-source-ffap-guesser' (File at point)
526 ;; `anything-c-source-ffap-line' (File/Lineno at point)
527 ;; `anything-c-source-files-in-all-dired' (Files in all dired buffer.)
528 ;; `anything-c-source-filelist' (FileList)
529 ;; `anything-c-source-info-pages' (Info Pages)
530 ;; `anything-c-source-info-elisp' (Info index: elisp)
531 ;; `anything-c-source-info-cl' (Info index: cl)
532 ;; `anything-c-source-info-org' (Info index: org)
533 ;; `anything-c-source-info-gnus' (Info index: Gnus)
534 ;; `anything-c-source-info-ratpoison' (Info index: ratpoison)
535 ;; `anything-c-source-info-zsh' (Info index: zsh)
536 ;; `anything-c-source-info-bash' (Info index: bash)
537 ;; `anything-c-source-info-coreutils' (Info index: coreutils)
538 ;; `anything-c-source-info-fileutils' (Info index: fileutils)
539 ;; `anything-c-source-info-find' (Info index: find)
540 ;; `anything-c-source-info-sh-utils' (Info index: sh-utils)
541 ;; `anything-c-source-info-textutils' (Info index: textutils)
542 ;; `anything-c-source-info-libc' (Info index: libc)
543 ;; `anything-c-source-info-make' (Info index: make)
544 ;; `anything-c-source-info-automake' (Info index: automake)
545 ;; `anything-c-source-info-autoconf' (Info index: autoconf)
546 ;; `anything-c-source-info-emacs-lisp-intro' (Info index: emacs-lisp-intro)
547 ;; `anything-c-source-info-emacs' (Info index: emacs)
548 ;; `anything-c-source-info-elib' (Info index: elib)
549 ;; `anything-c-source-info-eieio' (Info index: eieio)
550 ;; `anything-c-source-info-gauche-refe' (Info index: gauche)
551 ;; `anything-c-source-info-guile' (Info index: guile)
552 ;; `anything-c-source-info-guile-tut' (Info index: guile-tut)
553 ;; `anything-c-source-info-goops' (Info index: goops)
554 ;; `anything-c-source-info-screen' (Info index: screen)
555 ;; `anything-c-source-info-latex' (Info index: latex)
556 ;; `anything-c-source-info-gawk' (Info index: gawk)
557 ;; `anything-c-source-info-sed' (Info index: sed)
558 ;; `anything-c-source-info-m4' (Info index: m4)
559 ;; `anything-c-source-info-wget' (Info index: wget)
560 ;; `anything-c-source-info-binutils' (Info index: binutils)
561 ;; `anything-c-source-info-as' (Info index: as)
562 ;; `anything-c-source-info-bfd' (Info index: bfd)
563 ;; `anything-c-source-info-gprof' (Info index: gprof)
564 ;; `anything-c-source-info-ld' (Info index: ld)
565 ;; `anything-c-source-info-diff' (Info index: diff)
566 ;; `anything-c-source-info-flex' (Info index: flex)
567 ;; `anything-c-source-info-grep' (Info index: grep)
568 ;; `anything-c-source-info-gzip' (Info index: gzip)
569 ;; `anything-c-source-info-libtool' (Info index: libtool)
570 ;; `anything-c-source-info-texinfo' (Info index: texinfo)
571 ;; `anything-c-source-info-info' (Info index: info)
572 ;; `anything-c-source-info-gdb' (Info index: gdb)
573 ;; `anything-c-source-info-stabs' (Info index: stabs)
574 ;; `anything-c-source-info-cvsbook' (Info index: cvsbook)
575 ;; `anything-c-source-info-cvs' (Info index: cvs)
576 ;; `anything-c-source-info-bison' (Info index: bison)
577 ;; `anything-c-source-info-id-utils' (Info index: id-utils)
578 ;; `anything-c-source-info-global' (Info index: global)
579 ;; `anything-c-source-man-pages' (Manual Pages)
580 ;; `anything-c-source-complex-command-history' (Complex Command History)
581 ;; `anything-c-source-extended-command-history' (Emacs Commands History)
582 ;; `anything-c-source-emacs-commands' (Emacs Commands)
583 ;; `anything-c-source-emacs-functions' (Emacs Functions)
584 ;; `anything-c-source-emacs-functions-with-abbrevs' (Emacs Functions)
585 ;; `anything-c-source-advice' (Function Advice)
586 ;; `anything-c-source-emacs-variables' (Emacs Variables)
587 ;; `anything-c-source-lacarte' (Lacarte)
588 ;; `anything-c-source-bookmarks' (Bookmarks)
589 ;; `anything-c-source-bookmark-set' (Set Bookmark)
590 ;; `anything-c-source-bm' (Visible Bookmarks)
591 ;; `anything-c-source-bookmarks-ssh' (Bookmarks-ssh)
592 ;; `anything-c-source-bookmarks-su' (Bookmarks-root)
593 ;; `anything-c-source-bookmarks-local' (Bookmarks-Local)
594 ;; `anything-c-source-bmkext-addressbook' (Bookmark Addressbook)
595 ;; `anything-c-source-bookmark-w3m' (Bookmark W3m)
596 ;; `anything-c-source-bookmark-images' (Bookmark Images)
597 ;; `anything-c-source-bookmark-man' (Bookmark Woman&Man)
598 ;; `anything-c-source-bookmark-gnus' (Bookmark Gnus)
599 ;; `anything-c-source-bookmark-info' (Bookmark Info)
600 ;; `anything-c-source-bookmark-files&dirs' (Bookmark Files&Directories)
601 ;; `anything-c-source-bookmark-su-files&dirs' (Bookmark Root-Files&Directories)
602 ;; `anything-c-source-bookmark-ssh-files&dirs' (Bookmark Ssh-Files&Directories)
603 ;; `anything-c-source-firefox-bookmarks' (Firefox Bookmarks)
604 ;; `anything-c-source-w3m-bookmarks' (W3m Bookmarks)
605 ;; `anything-c-source-elisp-library-scan' (Elisp libraries (Scan))
606 ;; `anything-c-source-imenu' (Imenu)
607 ;; `anything-c-source-ctags' (Exuberant ctags)
608 ;; `anything-c-source-etags-select' (Etags)
609 ;; `anything-c-source-semantic' (Semantic Tags)
610 ;; `anything-c-source-simple-call-tree-functions-callers' (Function is called by)
611 ;; `anything-c-source-simple-call-tree-callers-functions' (Function calls)
612 ;; `anything-c-source-commands-and-options-in-file' (Commands/Options in file)
613 ;; `anything-c-source-customize-face' (Customize Face)
614 ;; `anything-c-source-colors' (Colors)
615 ;; `anything-c-source-tracker-search' (Tracker Search)
616 ;; `anything-c-source-mac-spotlight' (mdfind)
617 ;; `anything-c-source-picklist' (Picklist)
618 ;; `anything-c-source-kill-ring' (Kill Ring)
619 ;; `anything-c-source-mark-ring' (mark-ring)
620 ;; `anything-c-source-global-mark-ring' (global-mark-ring)
621 ;; `anything-c-source-register' (Registers)
622 ;; `anything-c-source-latex-math' (Latex Math Menu)
623 ;; `anything-c-source-fixme' (TODO/FIXME/DRY comments)
624 ;; `anything-c-source-rd-headline' (RD HeadLine)
625 ;; `anything-c-source-oddmuse-headline' (Oddmuse HeadLine)
626 ;; `anything-c-source-emacs-source-defun' (Emacs Source DEFUN)
627 ;; `anything-c-source-emacs-lisp-expectations' (Emacs Lisp Expectations)
628 ;; `anything-c-source-emacs-lisp-toplevels' (Emacs Lisp Toplevel / Level 4 Comment / Linkd Star)
629 ;; `anything-c-source-yaoddmuse-emacswiki-edit-or-view' (Yaoddmuse Edit or View (EmacsWiki))
630 ;; `anything-c-source-yaoddmuse-emacswiki-post-library' (Yaoddmuse Post library (EmacsWiki))
631 ;; `anything-c-source-eev-anchor' (Anchors)
632 ;; `anything-c-source-org-headline' (Org HeadLine)
633 ;; `anything-c-source-org-keywords' (Org Keywords)
634 ;; `anything-c-source-bbdb' (BBDB)
635 ;; `anything-c-source-evaluation-result' (Evaluation Result)
636 ;; `anything-c-source-calculation-result' (Calculation Result)
637 ;; `anything-c-source-google-suggest' (Google Suggest)
638 ;; `anything-c-source-yahoo-suggest' (Yahoo Suggest)
639 ;; `anything-c-source-emms-streams' (Emms Streams)
640 ;; `anything-c-source-emms-dired' (Music Directory)
641 ;; `anything-c-source-emms-files' (Emms files)
642 ;; `anything-c-source-jabber-contacts' (Jabber Contacts)
643 ;; `anything-c-source-call-source' (Call anything source)
644 ;; `anything-c-source-anything-commands' (Preconfigured Anything)
645 ;; `anything-c-source-occur' (Occur)
646 ;; `anything-c-source-browse-code' (Browse code)
647 ;; `anything-c-source-create' (Create)
648 ;; `anything-c-source-minibuffer-history' (Minibuffer History)
649 ;; `anything-c-source-elscreen' (Elscreen)
650 ;; `anything-c-source-top' (Top (Press C-c C-u to refresh))
651 ;; `anything-c-source-absolute-time-timers' (Absolute Time Timers)
652 ;; `anything-c-source-idle-time-timers' (Idle Time Timers)
653 ;; `anything-c-source-xrandr-change-resolution' (Change Resolution)
654 ;; `anything-c-source-xfonts' (X Fonts)
655 ;; `anything-c-source-ucs' (Ucs names)
656 ;; `anything-c-source-emacs-process' (Emacs Process)
657 ;; `anything-c-source-time-world' (Time World List)
658 ;; `anything-c-source-apt' (APT)
659 ;; `anything-c-source-gentoo' (Portage sources)
660 ;; `anything-c-source-use-flags' (Use Flags)
661 ;; `anything-c-source-ratpoison-commands' (Ratpoison Commands)
662 ;; `anything-c-source-esh' (Eshell completions)
663 ;; `anything-c-source-eshell-history' (Eshell history)
665 ;; *** END auto-documentation
667 ;;; For Maintainers:
669 ;; Install developer-tools/autodoc.el and
670 ;; Evaluate (autodoc-update-all) before commit or run it interactively.
671 ;; This function generates anything-c-source-* / functions / options list.
673 ;; [EVAL IT] (autodoc-update-all)
675 ;; Please write details documentation about function, then others will
676 ;; read code more easier. -- Andy Stewart
680 ;;; Change log:
682 ;; Change log of this file is found at
683 ;; http://repo.or.cz/w/anything-config.git/history/master:/anything-config.el
685 ;; Change log of this project is found at
686 ;; http://repo.or.cz/w/anything-config.git?a=shortlog
688 ;;; Contributors:
690 ;; Tamas Patrovics
691 ;; Tassilo Horn <tassilo@member.fsf.org>
692 ;; Vagn Johansen <gonz808@hotmail.com>
693 ;; Mathias Dahl <mathias.dahl@gmail.com>
694 ;; Bill Clementson <billclem@gmail.com>
695 ;; Stefan Kamphausen (see http://www.skamphausen.de for more informations)
696 ;; Drew Adams <drew.adams@oracle.com>
697 ;; Jason McBrayer <jmcbray@carcosa.net>
698 ;; Andy Stewart <lazycat.manatee@gmail.com>
699 ;; Thierry Volpiatto <thierry.volpiatto@gmail.com>
700 ;; rubikitch <rubikitch@ruby-lang.org>
701 ;; Scott Vokes <vokes.s@gmail.com>
702 ;; Kenichirou Oyama <k1lowxb@gmail.com>
705 ;;; TODO
707 ;; - Fix documentation, now many functions haven't documentations.
711 ;;; Code:
713 ;;; Require
716 (require 'anything)
717 (require 'thingatpt)
718 (require 'ffap)
719 (require 'cl)
720 (require 'dired-aux)
721 (require 'dired-x)
722 (require 'tramp)
723 (require 'grep)
724 (require 'url)
725 (require 'xml)
726 (eval-when-compile (require 'org)) ; Shut up byte compiler about org-directory.
727 (eval-when-compile (require 'semantic nil t))
728 (require 'anything-match-plugin)
732 ;;; Declare external functions
735 (declare-function gnus-dired-attach "ext:gnus-dired.el" (files-to-attach))
736 (declare-function image-dired-display-image "image-dired.el" (file &optional original-size))
737 (declare-function image-dired-update-property "image-dired.el" (prop value))
738 (declare-function woman-file-name-all-completions "woman.el" (topic))
739 (declare-function Man-getpage-in-background "man.el" (topic))
740 (declare-function simple-call-tree-analyze "ext:simple-call-tree.el" (&optional test))
741 (declare-function yaoddmuse-update-pagename "ext:yaoddmuse.el" (&optional unforced))
742 (declare-function yaoddmuse-get-library-list "ext:yaoddmuse.el" (&optional dirs string))
743 (declare-function org-get-current-options "ext:org-exp.el")
744 (declare-function emms-streams "ext:emms-streams")
745 (declare-function emms-stream-delete-bookmark "ext:emms-streams")
746 (declare-function emms-stream-add-bookmark "ext:emms-streams" (name url fd type))
747 (declare-function emms-stream-save-bookmarks-file "ext:emms-streams")
748 (declare-function emms-stream-quit "ext:emms-streams")
749 (declare-function with-current-emms-playlist "ext:emms" (&rest body))
750 (declare-function emms-playlist-tracks-in-region "ext:emms" (beg end))
751 (declare-function emms-playlist-first "ext:emms")
752 (declare-function emms-playlist-mode-play-smart "ext:emms-playlist-mode")
753 (declare-function term-line-mode "term")
754 (declare-function term-char-mode "term")
755 (declare-function term-send-input "term")
756 (declare-function term-send-eof "term")
757 (declare-function Info-index-nodes "info" (&optional file))
758 (declare-function Info-goto-node "info" (&optional fork))
759 (declare-function Info-find-node "info.el" (filename nodename &optional no-going-back))
760 (declare-function elscreen-find-screen-by-buffer "ext:elscreen.el" (buffer &optional create))
761 (declare-function elscreen-find-file "ext:elscreen.el" (filename))
762 (declare-function elscreen-goto "ext:elscreen.el" (screen))
763 (declare-function semantic-format-tag-summarize "ext:format.el" (tag &optional parent color) t)
764 (declare-function semantic-tag-components "ext:tag.el" (tag) t)
765 (declare-function semantic-go-to-tag "ext:tag-file.el" (tag) t)
766 (declare-function semantic-tag-type "ext:tag-file.el" (tag) t)
767 (declare-function semantic-tag-class "ext:tag-file.el" (tag) t)
768 (declare-function bbdb "ext:bbdb-com")
769 (declare-function bbdb-current-record "ext:bbdb-com")
770 (declare-function bbdb-redisplay-one-record "ext:bbdb-com")
771 (declare-function bbdb-record-net "ext:bbdb-com" (string) t)
772 (declare-function bbdb-current-record "ext:bbdb-com")
773 (declare-function bbdb-dwim-net-address "ext:bbdb-com")
774 (declare-function bbdb-records "ext:bbdb-com"
775 (&optional dont-check-disk already-in-db-buffer))
776 (declare-function eshell-read-aliases-list "em-alias")
777 (declare-function eshell-send-input "esh-mode" (&optional use-region queue-p no-newline))
778 (declare-function eshell-bol "esh-mode")
779 (declare-function eldoc-current-symbol "eldoc")
780 (declare-function eldoc-get-fnsym-args-string "eldoc" (sym &optional index))
781 (declare-function eldoc-get-var-docstring "eldoc" (sym))
782 (declare-function eldoc-fnsym-in-current-sexp "eldoc")
783 (declare-function find-library-name "find-func.el" (library))
784 (declare-function adoc-construct "ext:auto-document.el" (buf))
785 (declare-function adoc-first-line "ext:auto-document.el" (str))
786 (declare-function adoc-prin1-to-string "ext:auto-document.el" (object))
787 (declare-function secure-hash "ext:fns.c" (algorithm object &optional start end binary))
791 ;;; compatibility
794 (unless (fboundp 'window-system)
795 (defun window-system (&optional arg)
796 window-system))
800 ;;; Customize
803 (defgroup anything-config nil
804 "Predefined configurations for `anything.el'."
805 :group 'anything)
807 (defcustom anything-c-adaptive-history-file
808 "~/.emacs.d/anything-c-adaptive-history"
809 "Path of file where history information is stored."
810 :type 'string
811 :group 'anything-config)
813 (defcustom anything-c-adaptive-history-length 50
814 "Maximum number of candidates stored for a source."
815 :type 'number
816 :group 'anything-config)
818 (defcustom anything-c-google-suggest-url
819 "http://google.com/complete/search?output=toolbar&q="
820 "URL used for looking up Google suggestions."
821 :type 'string
822 :group 'anything-config)
824 (defcustom anything-c-google-suggest-search-url
825 "http://www.google.com/search?ie=utf-8&oe=utf-8&q="
826 "URL used for Google searching."
827 :type 'string
828 :group 'anything-config)
830 (defcustom anything-google-suggest-use-curl-p nil
831 "*When non--nil use CURL to get info from `anything-c-google-suggest-url'.
832 Otherwise `url-retrieve-synchronously' is used."
833 :type 'boolean
834 :group 'anything-config)
836 (defcustom anything-c-yahoo-suggest-url
837 "http://search.yahooapis.com/WebSearchService/V1/relatedSuggestion?appid=Generic&query="
838 "Url used for looking up Yahoo suggestions."
839 :type 'string
840 :group 'anything-config)
842 (defcustom anything-c-yahoo-suggest-search-url
843 "http://search.yahoo.com/search?&ei=UTF-8&fr&h=c&p="
844 "Url used for Yahoo searching."
845 :type 'string
846 :group 'anything-config)
848 (defcustom anything-c-boring-buffer-regexp
849 (rx (or
850 (group bos " ")
851 ;; anything-buffers
852 "*anything" "*ac-mode"
853 ;; echo area
854 " *Echo Area" " *Minibuf"))
855 "The regexp that match boring buffers.
856 Buffer candidates matching this regular expression will be
857 filtered from the list of candidates if the
858 `anything-c-skip-boring-buffers' candidate transformer is used, or
859 they will be displayed with face `file-name-shadow' if
860 `anything-c-shadow-boring-buffers' is used."
861 :type 'string
862 :group 'anything-config)
863 ;; (string-match anything-c-boring-buffer-regexp "buf")
864 ;; (string-match anything-c-boring-buffer-regexp " hidden")
865 ;; (string-match anything-c-boring-buffer-regexp " *Minibuf-1*")
867 (defcustom anything-c-boring-file-regexp
868 (rx (or
869 ;; Boring directories
870 (and "/" (or ".svn" "CVS" "_darcs" ".git" ".hg") (or "/" eol))
871 ;; Boring files
872 (and line-start ".#")
873 (and (or ".class" ".la" ".o" "~") eol)))
874 "The regexp that match boring files.
875 File candidates matching this regular expression will be
876 filtered from the list of candidates if the
877 `anything-c-skip-boring-files' candidate transformer is used, or
878 they will be displayed with face `file-name-shadow' if
879 `anything-c-shadow-boring-files' is used."
880 :type 'string
881 :group 'anything-config)
883 (defcustom anything-kill-ring-threshold 10
884 "*Minimum length to be listed by `anything-c-source-kill-ring'."
885 :type 'integer
886 :group 'anything-config)
888 (defcustom anything-c-kill-ring-max-lines-number nil
889 "Max number of lines displayed per candidate in kill-ring browser.
890 If nil or zero, don't truncate candidate, show all."
891 :type 'integer
892 :group 'anything-config)
894 (defcustom anything-su-or-sudo "su"
895 "What command to use for root access."
896 :type 'string
897 :group 'anything-config)
899 (defcustom anything-for-files-prefered-list
900 '(anything-c-source-ffap-line
901 anything-c-source-ffap-guesser
902 anything-c-source-buffers-list
903 anything-c-source-recentf
904 anything-c-source-bookmarks
905 anything-c-source-file-cache
906 anything-c-source-files-in-current-dir+
907 anything-c-source-locate)
908 "Your prefered sources to find files."
909 :type 'list
910 :group 'anything-config)
912 (defcustom anything-create--actions-private nil
913 "User defined actions for `anything-create' / `anything-c-source-create'.
914 It is a list of (DISPLAY . FUNCTION) pairs like `action'
915 attribute of `anything-sources'.
917 It is prepended to predefined pairs."
918 :type 'list
919 :group 'anything-config)
921 (defcustom anything-allow-skipping-current-buffer t
922 "Show current buffer or not in anything buffer"
923 :type 'boolean
924 :group 'anything-config)
926 (defcustom anything-c-enable-eval-defun-hack t
927 "*If non-nil, execute `anything' using the source at point when C-M-x is pressed.
928 This hack is invoked when pressing C-M-x in the form \
929 (defvar anything-c-source-XXX ...) or (setq anything-c-source-XXX ...)."
930 :type 'boolean
931 :group 'anything-config)
933 (defcustom anything-tramp-verbose 0
934 "*Just like `tramp-verbose' but specific to anything.
935 When set to 0 don't show tramp messages in anything.
936 If you want to have the default tramp messages set it to 3."
937 :type 'integer
938 :group 'anything-config)
940 (defcustom anything-raise-command nil
941 "*A shell command to jump to a window running specific program.
942 Need external program wmctrl.
943 This will be use with `format', so use something like \"wmctrl -xa %s\"."
944 :type 'string
945 :group 'anything-config)
947 (defun anything-set-anything-command-map-prefix-key (var key)
948 (declare (special anything-command-map-prefix-key))
949 (when (boundp 'anything-command-map-prefix-key)
950 (global-unset-key (read-kbd-macro anything-command-map-prefix-key)))
951 (setq anything-command-map-prefix-key key)
952 (global-set-key (read-kbd-macro anything-command-map-prefix-key)
953 'anything-command-map))
955 (defcustom anything-command-map-prefix-key "<f5> a"
956 "*The prefix key for all `anything-command-map' commands.
958 !!WARNING!!
959 This default value is very likely to be changed,
960 because it is under discussion."
961 :type 'string
962 :set 'anything-set-anything-command-map-prefix-key
963 :group 'anything-config)
965 (defcustom anything-c-browse-code-regexp-lisp
966 "^ *\(def\\(un\\|subst\\|macro\\|face\\|alias\\|advice\\|struct\\|\
967 type\\|theme\\|var\\|group\\|custom\\|const\\|method\\|class\\)"
968 "*Regexp used to parse lisp buffer when browsing code."
969 :type 'string
970 :group 'anything-config)
972 (defcustom anything-c-browse-code-regexp-python
973 "\\<def\\>\\|\\<class\\>"
974 "*Regexp used to parse python buffer when browsing code."
975 :type 'string
976 :group 'anything-config)
978 (defcustom anything-c-browse-code-regexp-alist
979 `((lisp-interaction-mode . ,anything-c-browse-code-regexp-lisp)
980 (emacs-lisp-mode . ,anything-c-browse-code-regexp-lisp)
981 (lisp-mode . ,anything-c-browse-code-regexp-lisp)
982 (python-mode . ,anything-c-browse-code-regexp-python))
983 "*Alist to store regexps for browsing code corresponding \
984 to a specific `major-mode'."
985 :type 'list
986 :group 'anything-config)
988 (defcustom anything-c-external-programs-associations nil
989 "*Alist to store externals programs associated with file extension.
990 This variable overhide setting in .mailcap file.
991 e.g : '\(\(\"jpg\" . \"gqview\"\) (\"pdf\" . \"xpdf\"\)\) "
992 :type 'list
993 :group 'anything-config)
995 (defcustom anything-ff-auto-update-initial-value t
996 "Auto update when only one candidate directory is matched.
997 This is the default value when starting `anything-find-files'."
998 :group 'anything-config
999 :type 'boolean)
1001 (defcustom anything-c-copy-async-prefered-emacs "emacs"
1002 "Path to the emacs you want to use for copying async.
1003 Emacs versions < 24 fail to copy directory due to a bug not fixed
1004 in `copy-directory'."
1005 :group 'anything-config
1006 :type 'string)
1008 (defcustom anything-ff-lynx-style-map t
1009 "Use arrow keys to navigate with `anything-find-files'.
1010 You will have to restart Emacs or reeval `anything-find-files-map'
1011 and `anything-c-read-file-map' for this take effect."
1012 :group 'anything-config
1013 :type 'boolean)
1015 (defcustom anything-ff-history-max-length 100
1016 "*Number of elements shown in `anything-find-files' history."
1017 :group 'anything-config
1018 :type 'integer)
1020 (defcustom anything-ff-smart-completion t
1021 "Try to complete filenames smarter when non--nil.
1022 See `anything-ff-transform-fname-for-completion' for more info."
1023 :group 'anything-config
1024 :type 'boolean)
1026 (defcustom anything-ff-default-kbsize 1024.0
1027 "Default Kbsize to use for showing files size.
1028 It is a float, usually 1024.0 but could be 1000.0 on some systems."
1029 :group 'anything-config
1030 :type 'float)
1032 (defcustom anything-ff-tramp-not-fancy t
1033 "No colors when listing remote files when set to non--nil.
1034 This make listing much faster, specially on slow machines."
1035 :group 'anything-config
1036 :type 'boolean)
1038 (defcustom anything-ff-exif-data-program "exiftran"
1039 "*Program used to extract exif data of an image file."
1040 :group 'anything-config
1041 :type 'string)
1043 (defcustom anything-ff-exif-data-program-args "-d"
1044 "*Arguments used for `anything-ff-exif-data-program'."
1045 :group 'anything-config
1046 :type 'string)
1048 (defcustom anything-c-grep-use-ioccur-style-keys t
1049 "Use Arrow keys to jump to occurences."
1050 :group 'anything-config
1051 :type 'boolean)
1053 (defcustom anything-c-pdfgrep-default-read-command "xpdf '%f' %p"
1054 "Default command to read pdf files from pdfgrep.
1055 Where '%f' format spec is filename and '%p' is page number"
1056 :group 'anything-config
1057 :type 'string)
1059 (defcustom anything-c-etags-tag-file-name "TAGS"
1060 "Etags tag file name."
1061 :type 'string
1062 :group 'anything-config)
1064 (defcustom anything-c-etags-tag-file-search-limit 10
1065 "The limit level of directory to search tag file.
1066 Don't search tag file deeply if outside this value."
1067 :type 'number
1068 :group 'anything-config)
1070 (defcustom anything-c-etags-use-regexp-search nil
1071 "When non--nil search etags candidates by regexp.
1072 This disable anything-match-plugin when enabled.
1073 When nil search is performed directly on patter and *match-plugin is used
1074 if available. You can customize `anything-c-etags-search-regexp'."
1075 :group 'anything-config
1076 :type 'boolean)
1078 (defcustom anything-c-etags-search-regexp "^.+: .+ \\<%s"
1079 "Regexp that match tags in an anything etags buffer.
1080 The format spec is replaced by pattern.
1081 This regexp have no effect when `anything-c-etags-use-regexp-search'
1082 is nil."
1083 :group 'anything-config
1084 :type 'regexp)
1086 (defcustom anything-c-filelist-file-name nil
1087 "Filename of file list.
1088 Accept a list of string for multiple files.
1090 This file tend to be very large \(> 100MB\) and recommend to be in ramdisk for speed.
1091 File list is created by make-filelist.rb script.
1093 Usage:
1094 ruby make-filelist.rb > /tmp/all.filelist
1096 Then
1097 ;; Assume that /tmp is ramdisk or tmpfs
1098 \(setq anything-grep-candidates-fast-directory-regexp \"^/tmp/\"\)
1099 \(setq anything-c-filelist-file-name \"/tmp/all.filelist\"\)
1101 :type 'string
1102 :group 'anything-config)
1104 (defcustom anything-c-eldoc-in-minibuffer-show-fn
1105 'anything-c-show-info-in-mode-line
1106 "A function to display eldoc info.
1107 Should take one arg: the string to display."
1108 :group 'anything-config
1109 :type 'symbol)
1111 (defcustom anything-c-turn-on-show-completion t
1112 "Display candidate in buffer while moving selection when non--nil."
1113 :group 'anything-config
1114 :type 'boolean)
1116 (defcustom anything-lisp-completion-or-indent-delay 0.6
1117 "After this delay `anything-lisp-completion-counter' is reset to 0.
1118 This allow to indent again without completing lisp symbol after this delay.
1119 Default is 0.6 seconds."
1120 :group 'anything-config
1121 :type 'number)
1123 (defcustom anything-c-default-external-file-browser "nautilus"
1124 "Default external file browser for your system.
1125 Directories will be opened externally with it.
1126 Set to nil if you do not have external file browser
1127 or do not want to use it."
1128 :group 'anything-config
1129 :type 'string)
1131 (defcustom anything-c-use-adaptative-sorting nil
1132 "*Wheter to use or not adaptative sorting.
1133 Even if a source use it, it will have no effect when set to nil."
1134 :type 'boolean
1135 :group 'anything-config)
1137 (defcustom anything-ff-newfile-prompt-p t
1138 "Whether Prompt or not when creating new file.
1139 This set `ffap-newfile-prompt'."
1140 :type 'boolean
1141 :group 'anything-config)
1144 (defcustom anything-ff-avfs-directory nil
1145 "*The default avfs directory, usually '.avfs'.
1146 When this is set you will be able to expand archive filenames with `C-z'
1147 inside an avfs directory mounted with mountavfs.
1148 See <http://sourceforge.net/projects/avf/>."
1149 :type 'boolean
1150 :group 'anything-config)
1152 (defcustom anything-ff-file-compressed-list '("gz" "bz2" "zip" "7z")
1153 "*Minimal list of compressed files extension."
1154 :type 'list
1155 :group 'anything-config)
1157 (defcustom anything-locate-db-file-regexp "m?locate\.db$"
1158 "Default regexp to match locate database.
1159 If nil Search in all files."
1160 :type 'string
1161 :group 'anything-config)
1163 (defcustom anything-c-show-info-in-mode-line-delay 12
1164 "Eldoc will show info in mode-line during this delay if user is idle."
1165 :type 'integer
1166 :group 'anything-config)
1168 (defcustom anything-c-copy-files-async-log-file "/tmp/dired.log"
1169 "The file used to communicate with two emacs when copying files async."
1170 :type 'string
1171 :group 'anything-config)
1173 (defcustom anything-ff-printer-list nil
1174 "A list of available printers on your system.
1175 When non--nil let you choose a printer to print file.
1176 Otherwise when nil the variable `printer-name' will be used.
1177 On Unix based systems (lpstat command needed) you don't need to set this,
1178 `anything-ff-find-printers' will find a list of available printers for you."
1179 :type 'list
1180 :group 'anything-config)
1182 (defcustom anything-ff-transformer-show-only-basename nil
1183 "Show only basename of candidates in `anything-find-files'.
1184 This can be toggled at anytime from `anything-find-files' with \
1185 \\<anything-find-files-map>0\\[anything-ff-run-toggle-basename]."
1186 :type 'boolean
1187 :group 'anything-config)
1189 (defcustom anything-ff-quick-delete-dont-prompt-for-deletion nil
1190 "Don't ask in persistent deletion of files when non--nil."
1191 :group 'anything-config
1192 :type 'boolean)
1194 (defcustom anything-ff-signal-error-on-dot-files t
1195 "Signal error when file is `.' or `..' on file deletion when non--nil.
1196 Default is non--nil."
1197 :group 'anything-config
1198 :type 'boolean)
1200 (defcustom anything-completing-read-handlers-alist
1201 '((describe-function . anything-completing-read-symbols)
1202 (describe-variable . anything-completing-read-symbols)
1203 (debug-on-entry . anything-completing-read-symbols)
1204 (find-function . anything-completing-read-symbols)
1205 (trace-function . anything-completing-read-symbols)
1206 (trace-function-background . anything-completing-read-symbols)
1207 (find-tag . anything-completing-read-with-cands-in-buffer)
1208 (ffap-alternate-file . nil))
1209 "Alist of handlers to replace `completing-read', `read-file-name' in `ac-mode'.
1210 Each entry is a cons cell like \(emacs_command . completing-read_handler\)
1211 where key and value are symbols.
1213 Each key is an Emacs command that use originaly `completing-read'.
1215 Each value maybe an anything function that take same arguments as
1216 `completing-read' plus NAME and BUFFER, where NAME is the name of the new
1217 anything source and BUFFER the name of the buffer we will use.
1218 This function prefix name must start by \"anything\".
1220 See `anything-completing-read-symbols' for example.
1222 If the value of an entry is nil completion will fall back to
1223 emacs vanilla behavior.
1224 e.g If you want to disable anything completion for `describe-function':
1225 \(describe-function . nil\).
1227 Ido is also supported, you can use `ido-completing-read' and
1228 `ido-read-file-name' as value of an entry or just 'ido.
1229 e.g ido completion for `find-file':
1230 \(find-file . ido\)
1231 same as
1232 \(find-file . ido-read-file-name\)
1233 Note that you don't need to enable `ido-mode' for this to work."
1234 :group 'anything-config
1235 :type '(alist :key-type symbol :value-type symbol))
1239 ;;; General internal variables
1241 ;; Some internals variable that need to be loaded
1242 ;; here to avoid compiler warnings.
1243 (defvar anything-c-external-commands-list nil
1244 "A list of all external commands the user can execute. If this
1245 variable is not set by the user, it will be calculated
1246 automatically.")
1248 (defvar anything-c-show-completion-overlay nil)
1250 (defvar anything-c-locate-command
1251 (case system-type
1252 ('gnu/linux "locate -i -r %s")
1253 ('berkeley-unix "locate -i %s")
1254 ('windows-nt "es -i -r %s")
1255 (t "locate %s"))
1256 "A list of arguments for locate program.
1257 The \"-r\" option must be the last option.")
1260 ;;; Faces
1263 (defface anything-buffer-saved-out
1264 '((t (:foreground "red")))
1265 "*Face used for buffer files modified outside of emacs."
1266 :group 'anything-config)
1268 (defface anything-buffer-not-saved
1269 '((t (:foreground "Indianred2")))
1270 "*Face used for buffer files not already saved on disk."
1271 :group 'anything-config)
1273 (defface anything-ff-prefix
1274 '((t (:background "yellow" :foreground "black")))
1275 "*Face used to prefix new file or url paths in `anything-find-files'."
1276 :group 'anything-config)
1278 (defface anything-ff-executable
1279 '((t (:foreground "green")))
1280 "*Face used for executable files in `anything-find-files'."
1281 :group 'anything-config)
1283 (defface anything-ff-directory
1284 '((t (:foreground "DarkRed" :background "LightGray")))
1285 "*Face used for directories in `anything-find-files'."
1286 :group 'anything-config)
1288 (defface anything-ff-symlink
1289 '((t (:foreground "DarkOrange")))
1290 "*Face used for symlinks in `anything-find-files'."
1291 :group 'anything-config)
1293 (defface anything-ff-invalid-symlink
1294 '((t (:foreground "black" :background "red")))
1295 "*Face used for invalid symlinks in `anything-find-files'."
1296 :group 'anything-config)
1298 (defface anything-ff-file
1299 '((t (:foreground "CadetBlue" :underline t)))
1300 "*Face used for file names in `anything-find-files'."
1301 :group 'anything-config)
1303 (defface anything-grep-match
1304 '((t (:inherit match)))
1305 "Face used to highlight grep matches."
1306 :group 'anything-config)
1308 (defface anything-grep-file
1309 '((t (:foreground "BlueViolet" :underline t)))
1310 "Face used to highlight grep results filenames."
1311 :group 'anything-config)
1313 (defface anything-grep-lineno
1314 '((t (:foreground "Darkorange1")))
1315 "Face used to highlight grep number lines."
1316 :group 'anything-config)
1318 (defface anything-grep-running
1319 '((t (:foreground "Red")))
1320 "Face used in mode line when grep is running."
1321 :group 'anything-config)
1323 (defface anything-grep-finish
1324 '((t (:foreground "Green")))
1325 "Face used in mode line when grep is finish."
1326 :group 'anything-config)
1328 (defface anything-M-x-key-face '((t (:foreground "orange" :underline t)))
1329 "*Face used in anything-M-x to show keybinding."
1330 :group 'anything)
1332 (defface anything-bmkext-info
1333 '((t (:foreground "green")))
1334 "*Face used for W3m Emacs bookmarks (not w3m bookmarks)."
1335 :group 'anything)
1337 (defface anything-bmkext-w3m
1338 '((t (:foreground "yellow")))
1339 "*Face used for W3m Emacs bookmarks (not w3m bookmarks)."
1340 :group 'anything)
1342 (defface anything-bmkext-gnus
1343 '((t (:foreground "magenta")))
1344 "*Face used for Gnus bookmarks."
1345 :group 'anything)
1347 (defface anything-bmkext-man
1348 '((t (:foreground "Orange4")))
1349 "*Face used for Woman/man bookmarks."
1350 :group 'anything)
1352 (defface anything-bmkext-no--file
1353 '((t (:foreground "grey")))
1354 "*Face used for non--file bookmarks."
1355 :group 'anything)
1357 (defface anything-bmkext-file
1358 '((t (:foreground "Deepskyblue2")))
1359 "*Face used for non--file bookmarks."
1360 :group 'anything)
1362 (defface anything-bookmarks-su-face '((t (:foreground "red")))
1363 "Face for su/sudo bookmarks."
1364 :group 'anything)
1366 (defface anything-w3m-bookmarks-face '((t (:foreground "cyan1" :underline t)))
1367 "Face for w3m bookmarks" :group 'anything)
1369 (defface anything-emms-playlist
1370 '((t (:foreground "Springgreen4" :underline t)))
1371 "*Face used for tracks in current emms playlist."
1372 :group 'anything)
1374 (defface anything-apt-installed
1375 '((t (:foreground "green")))
1376 "*Face used for apt installed candidates."
1377 :group 'anything)
1379 (defface anything-gentoo-match-face '((t (:foreground "red")))
1380 "Face for anything-gentoo installed packages."
1381 :group 'traverse-faces)
1383 (defface anything-lisp-show-completion
1384 '((t (:background "DarkSlateGray")))
1385 "*Face used for showing candidates in `anything-lisp-completion'."
1386 :group 'anything-config)
1388 (defface anything-lisp-completion-info
1389 '((t (:foreground "red")))
1390 "*Face used for showing info in `anything-lisp-completion'."
1391 :group 'anything-config)
1393 (defface anything-overlay-line-face '((t (:background "IndianRed4" :underline t)))
1394 "Face for source header in the anything buffer." :group 'anything)
1396 ;;;###autoload
1397 (defun anything-configuration ()
1398 "Customize `anything'."
1399 (interactive)
1400 (customize-group "anything-config"))
1404 ;;; Anything-command-map
1407 ;;;###autoload
1408 (defvar anything-command-map)
1409 (define-prefix-command 'anything-command-map)
1412 (define-key anything-command-map (kbd "<SPC>") 'anything-execute-anything-command)
1413 (define-key anything-command-map (kbd "a") 'anything-c-apropos)
1414 (define-key anything-command-map (kbd "e") 'anything-c-etags-select)
1415 (define-key anything-command-map (kbd "l") 'anything-locate)
1416 (define-key anything-command-map (kbd "s") 'anything-surfraw)
1417 (define-key anything-command-map (kbd "r") 'anything-regexp)
1418 (define-key anything-command-map (kbd "w") 'anything-w3m-bookmarks)
1419 (define-key anything-command-map (kbd "x") 'anything-firefox-bookmarks)
1420 (define-key anything-command-map (kbd "#") 'anything-emms)
1421 (define-key anything-command-map (kbd "m") 'anything-man-woman)
1422 (define-key anything-command-map (kbd "t") 'anything-top)
1423 (define-key anything-command-map (kbd "i") 'anything-imenu)
1424 (define-key anything-command-map (kbd "<tab>") 'anything-lisp-completion-at-point)
1425 (define-key anything-command-map (kbd "p") 'anything-list-emacs-process)
1426 (define-key anything-command-map (kbd "C-x r b") 'anything-c-pp-bookmarks)
1427 (define-key anything-command-map (kbd "M-y") 'anything-show-kill-ring)
1428 (define-key anything-command-map (kbd "C-c <SPC>") 'anything-all-mark-rings)
1429 (define-key anything-command-map (kbd "C-x C-f") 'anything-find-files)
1430 (define-key anything-command-map (kbd "f") 'anything-for-files)
1431 (define-key anything-command-map (kbd "C-:") 'anything-eval-expression-with-eldoc)
1432 (define-key anything-command-map (kbd "C-,") 'anything-calcul-expression)
1433 (define-key anything-command-map (kbd "M-x") 'anything-M-x)
1434 (define-key anything-command-map (kbd "C-x C-w") 'anything-write-file)
1435 (define-key anything-command-map (kbd "C-x i") 'anything-insert-file)
1436 (define-key anything-command-map (kbd "M-s o") 'anything-occur)
1437 (define-key anything-command-map (kbd "M-g s") 'anything-do-grep)
1438 (define-key anything-command-map (kbd "c") 'anything-colors)
1439 (define-key anything-command-map (kbd "F") 'anything-select-xfont)
1440 (define-key anything-command-map (kbd "C-c f") 'anything-recentf)
1441 (define-key anything-command-map (kbd "C-c g") 'anything-google-suggest)
1442 (define-key anything-command-map (kbd "h i") 'anything-info-at-point)
1443 (define-key anything-command-map (kbd "h r") 'anything-info-emacs)
1444 (define-key anything-command-map (kbd "h g") 'anything-info-gnus)
1445 (define-key anything-command-map (kbd "C-x C-b") 'anything-buffers-list)
1446 (define-key anything-command-map (kbd "C-c C-b") 'anything-browse-code)
1447 (define-key anything-command-map (kbd "C-x r i") 'anything-register)
1448 (define-key anything-command-map (kbd "C-c C-x") 'anything-c-run-external-command)
1450 ;; In Emacs 23.1.50, minibuffer-local-must-match-filename-map was renamed to
1451 ;; minibuffer-local-filename-must-match-map.
1452 (defvar minibuffer-local-filename-must-match-map (make-sparse-keymap)) ;; Emacs 23.1.+
1453 (defvar minibuffer-local-must-match-filename-map (make-sparse-keymap)) ;; Older Emacsen
1454 (dolist (map (list minibuffer-local-filename-completion-map
1455 minibuffer-local-completion-map
1456 minibuffer-local-must-match-filename-map
1457 minibuffer-local-filename-must-match-map
1458 minibuffer-local-map
1459 minibuffer-local-isearch-map
1460 minibuffer-local-must-match-map
1461 minibuffer-local-ns-map))
1462 (define-key map "\C-r" 'anything-minibuffer-history))
1466 ;;; Menu
1469 (easy-menu-define nil global-map
1470 "`anything' menu"
1471 '("Anything"
1472 ["All anything commands" anything-execute-anything-command t]
1473 ["Find any Files/Buffers" anything-for-files t]
1474 ["Anything Everywhere (Toggle)" ac-mode t]
1475 "----"
1476 ("Files:"
1477 ["Find files" anything-find-files t]
1478 ["Recent Files" anything-recentf t]
1479 ["Locate" anything-locate t]
1480 ["Bookmarks" anything-c-pp-bookmarks t])
1481 ("Buffers:"
1482 ["Find buffers" anything-buffers-list t])
1483 ("Commands:"
1484 ["Emacs Commands" anything-M-x t]
1485 ["Externals Commands" anything-c-run-external-command t])
1486 ("Help:"
1487 ["Anything Apropos" anything-c-apropos t])
1488 ("Info:"
1489 ["Info at point" anything-info-at-point t]
1490 ["Emacs Manual index" anything-info-emacs t]
1491 ["Gnus Manual index" anything-info-gnus t])
1492 ("Org:"
1493 ["Org keywords" anything-org-keywords t]
1494 ["Org headlines" anything-org-headlines t])
1495 ("Tools:"
1496 ["Occur" anything-occur t]
1497 ["Grep" anything-do-grep t]
1498 ["Etags" anything-c-etags-select t]
1499 ["Lisp complete at point" anything-lisp-completion-at-point t]
1500 ["Browse Kill ring" anything-show-kill-ring t]
1501 ["Browse register" anything-register t]
1502 ["Browse code" anything-browse-code t]
1503 ["Mark Ring" anything-all-mark-rings t]
1504 ["Regexp handler" anything-regexp t]
1505 ["Colors & Faces" anything-colors t]
1506 ["Show xfonts" anything-select-xfont t]
1507 ["Ucs Symbols" anything-ucs t]
1508 ["Imenu" anything-imenu t]
1509 ["Google Suggest" anything-google-suggest t]
1510 ["Eval expression" anything-eval-expression-with-eldoc t]
1511 ["Calcul expression" anything-calcul-expression t]
1512 ["Man pages" anything-man-woman t]
1513 ["Top externals process" anything-top t]
1514 ["Emacs internals process" anything-list-emacs-process t])
1515 "----"
1516 ["Prefered Options" anything-configuration t]))
1518 ;;; Anything map add ons
1521 (define-key anything-map (kbd "C-x C-f") 'anything-quit-and-find-file)
1522 (define-key anything-map (kbd "M-m") 'anything-toggle-all-marks)
1523 (define-key anything-map (kbd "C-w") 'anything-yank-text-at-point)
1526 ;;; Specialized keymaps
1529 (defvar anything-c-buffer-map
1530 (let ((map (copy-keymap anything-map)))
1531 (define-key map (kbd "C-c ?") 'anything-c-buffer-help)
1532 ;; No need to have separate command for grep and zgrep
1533 ;; as we don't use recursivity for buffers.
1534 ;; So use zgrep for both as it is capable to handle non--compressed files.
1535 (define-key map (kbd "M-g s") 'anything-buffer-run-zgrep)
1536 (define-key map (kbd "C-o") 'anything-buffer-switch-other-window)
1537 (define-key map (kbd "C-c C-o") 'anything-buffer-switch-other-frame)
1538 (define-key map (kbd "C-c =") 'anything-buffer-run-ediff)
1539 (define-key map (kbd "M-=") 'anything-buffer-run-ediff-merge)
1540 (define-key map (kbd "C-=") 'anything-buffer-diff-persistent)
1541 (define-key map (kbd "M-U") 'anything-buffer-revert-persistent)
1542 (define-key map (kbd "M-D") 'anything-buffer-run-kill-buffers)
1543 (define-key map (kbd "C-x C-s") 'anything-buffer-save-persistent)
1544 (define-key map (kbd "C-M-%") 'anything-buffer-run-query-replace-regexp)
1545 (define-key map (kbd "M-%") 'anything-buffer-run-query-replace)
1546 (define-key map (kbd "M-m") 'anything-toggle-all-marks)
1547 (define-key map (kbd "M-a") 'anything-mark-all)
1548 (when (locate-library "elscreen")
1549 (define-key map (kbd "<C-tab>") 'anything-buffer-switch-to-elscreen))
1550 (delq nil map))
1551 "Keymap for buffer sources in anything.")
1553 (defvar anything-find-files-map
1554 (let ((map (copy-keymap anything-map)))
1555 (define-key map (kbd "C-]") 'anything-ff-run-toggle-basename)
1556 (define-key map (kbd "C-x C-f") 'anything-ff-run-locate)
1557 (define-key map (kbd "M-g s") 'anything-ff-run-grep)
1558 (define-key map (kbd "M-g p") 'anything-ff-run-pdfgrep)
1559 (define-key map (kbd "M-g z") 'anything-ff-run-zgrep)
1560 (define-key map (kbd "M-.") 'anything-ff-run-etags)
1561 (define-key map (kbd "M-R") 'anything-ff-run-rename-file)
1562 (define-key map (kbd "M-C") 'anything-ff-run-copy-file)
1563 (define-key map (kbd "M-B") 'anything-ff-run-byte-compile-file)
1564 (define-key map (kbd "M-L") 'anything-ff-run-load-file)
1565 (define-key map (kbd "M-S") 'anything-ff-run-symlink-file)
1566 (define-key map (kbd "M-D") 'anything-ff-run-delete-file)
1567 (define-key map (kbd "M-K") 'anything-ff-run-kill-buffer-persistent)
1568 (define-key map (kbd "C-d") 'anything-ff-persistent-delete)
1569 (define-key map (kbd "M-e") 'anything-ff-run-switch-to-eshell)
1570 (define-key map (kbd "<M-tab>") 'anything-ff-run-complete-fn-at-point)
1571 (define-key map (kbd "C-o") 'anything-ff-run-switch-other-window)
1572 (define-key map (kbd "C-c C-o") 'anything-ff-run-switch-other-frame)
1573 (define-key map (kbd "C-c C-x") 'anything-ff-run-open-file-externally)
1574 (define-key map (kbd "M-!") 'anything-ff-run-eshell-command-on-file)
1575 (define-key map (kbd "C-=") 'anything-ff-run-ediff-file)
1576 (define-key map (kbd "C-c =") 'anything-ff-run-ediff-merge-file)
1577 (define-key map (kbd "M-p") 'anything-ff-run-switch-to-history)
1578 (define-key map (kbd "M-i") 'anything-ff-properties-persistent)
1579 (define-key map (kbd "C-c ?") 'anything-ff-help)
1580 (define-key map (kbd "C-}") 'anything-narrow-window)
1581 (define-key map (kbd "C-{") 'anything-enlarge-window)
1582 (define-key map (kbd "C-<backspace>") 'anything-ff-run-toggle-auto-update)
1583 (define-key map (kbd "M-a") 'anything-mark-all)
1584 (define-key map (kbd "M-m") 'anything-toggle-all-marks)
1585 (define-key map (kbd "M-u") 'anything-unmark-all)
1586 (define-key map (kbd "C-c C-a") 'anything-ff-run-gnus-attach-files)
1587 (define-key map (kbd "C-c p") 'anything-ff-run-print-file)
1588 ;; Next 2 have no effect if candidate is not an image file.
1589 (define-key map (kbd "M-l") 'anything-ff-rotate-left-persistent)
1590 (define-key map (kbd "M-r") 'anything-ff-rotate-right-persistent)
1591 (define-key map (kbd "C-.") 'anything-find-files-down-one-level)
1592 (define-key map (kbd "C-l") 'anything-find-files-down-one-level)
1593 (define-key map (kbd "C-h C-b") 'anything-send-bug-report-from-anything)
1594 (define-key map (kbd "C-h C-d") 'anything-debug-output)
1595 (when anything-ff-lynx-style-map
1596 (define-key map (kbd "<left>") 'anything-find-files-down-one-level)
1597 (define-key map (kbd "<right>") 'anything-execute-persistent-action))
1598 (delq nil map))
1599 "Keymap for `anything-find-files'.")
1601 (defvar anything-c-read-file-map
1602 (let ((map (copy-keymap anything-map)))
1603 (define-key map (kbd "C-.") 'anything-find-files-down-one-level)
1604 (define-key map (kbd "C-l") 'anything-find-files-down-one-level)
1605 (define-key map (kbd "C-<backspace>") 'anything-ff-run-toggle-auto-update)
1606 (define-key map (kbd "C-c ?") 'anything-read-file-name-help)
1607 (when anything-ff-lynx-style-map
1608 (define-key map (kbd "<left>") 'anything-find-files-down-one-level)
1609 (define-key map (kbd "<right>") 'anything-execute-persistent-action)
1610 (define-key map (kbd "<M-left>") 'anything-previous-source)
1611 (define-key map (kbd "<M-right>") 'anything-next-source))
1612 (delq nil map))
1613 "Keymap for `anything-c-read-file-name'.")
1615 (defvar anything-generic-files-map
1616 (let ((map (copy-keymap anything-map)))
1617 (define-key map (kbd "M-g s") 'anything-ff-run-grep)
1618 (define-key map (kbd "M-g z") 'anything-ff-run-zgrep)
1619 (define-key map (kbd "M-g p") 'anything-ff-run-pdfgrep)
1620 (define-key map (kbd "M-D") 'anything-ff-run-delete-file)
1621 (define-key map (kbd "C-=") 'anything-ff-run-ediff-file)
1622 (define-key map (kbd "C-c =") 'anything-ff-run-ediff-merge-file)
1623 (define-key map (kbd "C-o") 'anything-ff-run-switch-other-window)
1624 (define-key map (kbd "M-i") 'anything-ff-properties-persistent)
1625 (define-key map (kbd "C-c C-x") 'anything-ff-run-open-file-externally)
1626 (define-key map (kbd "C-w") 'anything-yank-text-at-point)
1627 (define-key map (kbd "C-c ?") 'anything-generic-file-help)
1628 map)
1629 "Generic Keymap for files.")
1631 (defvar anything-c-grep-map
1632 (let ((map (copy-keymap anything-map)))
1633 (define-key map (kbd "M-<down>") 'anything-c-goto-next-file)
1634 (define-key map (kbd "M-<up>") 'anything-c-goto-precedent-file)
1635 (define-key map (kbd "C-o") 'anything-c-grep-run-other-window-action)
1636 (define-key map (kbd "C-w") 'anything-yank-text-at-point)
1637 (define-key map (kbd "C-x C-s") 'anything-c-grep-run-save-buffer)
1638 (when anything-c-grep-use-ioccur-style-keys
1639 (define-key map (kbd "<right>") 'anything-c-grep-run-persistent-action)
1640 (define-key map (kbd "<left>") 'anything-c-grep-run-default-action))
1641 (define-key map (kbd "C-c ?") 'anything-grep-help)
1642 (delq nil map))
1643 "Keymap used in Grep sources.")
1645 (defvar anything-c-pdfgrep-map
1646 (let ((map (copy-keymap anything-map)))
1647 (define-key map (kbd "M-<down>") 'anything-c-goto-next-file)
1648 (define-key map (kbd "M-<up>") 'anything-c-goto-precedent-file)
1649 (define-key map (kbd "C-w") 'anything-yank-text-at-point)
1650 (define-key map (kbd "C-c ?") 'anything-pdfgrep-help)
1651 map)
1652 "Keymap used in pdfgrep.")
1654 (defvar anything-c-etags-map
1655 (let ((map (copy-keymap anything-map)))
1656 (define-key map (kbd "M-<down>") 'anything-c-goto-next-file)
1657 (define-key map (kbd "M-<up>") 'anything-c-goto-precedent-file)
1658 (define-key map (kbd "C-w") 'anything-yank-text-at-point)
1659 (define-key map (kbd "C-c ?") 'anything-etags-help)
1660 map)
1661 "Keymap used in Etags.")
1663 (defvar anything-eval-expression-map
1664 (let ((map (copy-keymap anything-map)))
1665 (define-key map (kbd "<C-return>") 'anything-eval-new-line-and-indent)
1666 (define-key map (kbd "<tab>") 'lisp-indent-line)
1667 (define-key map (kbd "<C-tab>") 'lisp-complete-symbol)
1668 (define-key map (kbd "C-p") 'previous-line)
1669 (define-key map (kbd "C-n") 'next-line)
1670 (define-key map (kbd "<up>") 'previous-line)
1671 (define-key map (kbd "<down>") 'next-line)
1672 (define-key map (kbd "<right>") 'forward-char)
1673 (define-key map (kbd "<left>") 'backward-char)
1674 map))
1676 (defvar anything-c-ucs-map
1677 (let ((map (copy-keymap anything-map)))
1678 (define-key map (kbd "<C-backspace>") 'anything-c-ucs-persistent-delete)
1679 (define-key map (kbd "<C-left>") 'anything-c-ucs-persistent-backward)
1680 (define-key map (kbd "<C-right>") 'anything-c-ucs-persistent-forward)
1681 (define-key map (kbd "<C-return>") 'anything-c-ucs-persistent-insert)
1682 (define-key map (kbd "C-c ?") 'anything-c-ucs-help)
1683 map)
1684 "Keymap for `anything-ucs'.")
1688 ;;; Embeded documentation.
1691 (defun anything-c-list-preconfigured-anything ()
1692 "Collect preconfigured anything functions in this file."
1693 (loop with doc
1694 with sym
1695 for entry in (cdr (assoc
1696 (file-truename (locate-library "anything-config"))
1697 load-history))
1698 if (and (consp entry)
1699 (eq (car entry) 'defun)
1700 (string-match "^Preconfigured.+$"
1701 (setq doc (or (documentation (setq sym (cdr entry)))
1702 ""))))
1703 collect (cons sym (match-string 0 doc))))
1705 (defun anything-c-format-preconfigured-anything ()
1706 (mapcar (lambda (x) (format "\\[%s] : %s\n" (car x) (cdr x)))
1707 (anything-c-list-preconfigured-anything)))
1709 ;;; Global help message - Used by `anything-help'
1712 (setq anything-help-message
1713 (lambda ()
1714 (concat
1715 "\\<anything-map>"
1716 "`anything' is QuickSilver-like candidate-selection framework.
1718 Narrow the list by typing some pattern,
1719 Multiple patterns are allowed by splitting by space.
1720 Select with natural Emacs operations, choose with RET.
1722 If you have any problems, press C-c C-x C-b!!
1723 Feel free to send bug reports. I'll fix them.
1724 The steps are described in the beginning of anything.el file.
1726 == Basic Operations ==
1727 C-p, Up: Previous Line
1728 C-n, Down : Next Line
1729 M-v, PageUp : Previous Page
1730 C-v, PageDown : Next Page
1731 Enter : Execute first (default) action / Select
1732 M-< : First Line
1733 M-> : Last Line
1734 M-PageUp, C-M-S-v, C-M-y : Previous Page (other-window)
1735 M-PageDown, C-M-v : Next Page (other-window)
1737 Tab, C-i : Show action list
1738 Left : Previous Source
1739 Right, C-o : Next Source
1740 C-k : Delete pattern
1741 C-z : Persistent Action (Execute action with anything session kept)
1742 C-c C-x C-b: Send a bug report
1744 == Shortcuts For 2nd/3rd Action ==
1745 \\[anything-select-2nd-action-or-end-of-line] : Execute 2nd Action (if the minibuffer cursor is at end of line)
1746 \\[anything-select-3rd-action] : Execute 3rd Action
1748 == Visible Marks ==
1749 Visible marks store candidate. Some actions uses marked candidates.
1751 \\[anything-toggle-visible-mark] : Toggle Visible Mark
1752 \\[anything-prev-visible-mark] : Previous Mark
1753 \\[anything-next-visible-mark] : Next Mark
1755 == Miscellaneous Commands ==
1756 \\[anything-toggle-resplit-window] : Toggle vertical/horizontal split anything window
1757 \\[anything-quit-and-find-file] : Drop into `find-file'
1758 \\[anything-delete-current-selection] : Delete Selected Item (visually)
1759 \\[anything-kill-selection-and-quit] : Set Item Into the kill-ring And Quit
1760 \\[anything-yank-selection] : Yank Selected Item Into Pattern
1761 \\[anything-follow-mode] : Toggle Automatical Execution Of Persistent Action
1762 \\[anything-force-update] : Recalculate And Redisplay Candidates
1764 == Global Commands ==
1765 \\<global-map>\\[anything-resume] revives last `anything' session.
1766 It is very useful, so you should bind any key.
1768 Single source is executed by \\[anything-call-source].
1770 == Preconfigured `anything' ==
1771 Preconfigured `anything' is commands that uses `anything' interface.
1772 You can use them without configuration.
1775 (apply 'concat (anything-c-format-preconfigured-anything))
1777 Enjoy!")))
1779 ;;; `anything-buffer-list' help
1782 ;;;###autoload
1783 (defun anything-c-buffer-help ()
1784 "Help command for anything buffers."
1785 (interactive)
1786 (let ((anything-help-message "== Anything Buffer ==
1787 \nTips:
1788 You can enter a partial name of major-mode (e.g lisp, sh) to narrow down buffers.
1789 Enter then a space and a pattern to narrow down to buffers matching this pattern.
1790 \nSpecific commands for `anything-buffers-list':
1791 \\<anything-c-buffer-map>
1792 \\[anything-buffer-run-zgrep]\t\t->Grep Buffer(s) works as zgrep too. (C-u grep all buffers but non--file buffers).
1793 \\[anything-buffer-switch-other-window]\t\t->Switch other window.
1794 \\[anything-buffer-switch-other-frame]\t\t->Switch other frame.
1795 \\[anything-buffer-run-query-replace-regexp]\t\t->Query replace regexp in marked buffers.
1796 \\[anything-buffer-run-query-replace]\t\t->Query replace in marked buffers.
1797 \\[anything-buffer-switch-to-elscreen]\t\t->Find buffer in Elscreen.
1798 \\[anything-buffer-run-ediff]\t\t->Ediff current buffer with candidate. If two marked buffers ediff those buffers.
1799 \\[anything-buffer-run-ediff-merge]\t\t->Ediff merge current buffer with candidate. If two marked buffers ediff merge those buffers.
1800 \\[anything-buffer-diff-persistent]\t\t->Toggle Diff buffer with saved file without quitting.
1801 \\[anything-buffer-revert-persistent]\t\t->Revert buffer without quitting.
1802 \\[anything-buffer-save-persistent]\t\t->Save buffer without quitting.
1803 \\[anything-buffer-run-kill-buffers]\t\t->Delete marked buffers and quit.
1804 \\[anything-toggle-all-marks]\t\t->Toggle all marks.
1805 \\[anything-mark-all]\t\t->Mark all.
1806 \\[anything-c-buffer-help]\t\t->Display this help.
1807 \n== Anything Map ==
1808 \\{anything-map}
1810 (anything-help)))
1813 ;;; Find files help (`anything-find-files')
1816 ;;;###autoload
1817 (defun anything-ff-help ()
1818 "Help command for `anything-find-files'."
1819 (interactive)
1820 (let ((anything-help-message "== Anything Find Files ==
1821 \nTips:
1822 \n- Enter `~/' at end of pattern to quickly reach home directory.
1823 - Enter `/' at end of pattern to quickly reach root of your file system.
1824 - Enter `./' at end of pattern to quickly reach `default-directory' (initial start of session).
1825 - You can complete with partial basename \(e.g \"fb\" will complete \"foobar\"\).
1826 - Use `C-u C-z' to watch an image.
1827 - To browse images directories turn on `anything-follow-mode' and navigate with arrow keys.
1828 - When entered ediff, hitting `C-g' will ask you to use locate to find the file to ediff with.
1830 \nSpecific commands for `anything-find-files':
1831 \\<anything-find-files-map>
1832 \\[anything-ff-run-locate]\t\t->Run Locate on basename of candidate (C-u to specify locate db).
1833 \\[anything-ff-run-grep]\t\t->Run Grep (C-u Recursive).
1834 \\[anything-ff-run-pdfgrep]\t\t->Run Pdfgrep on marked files.
1835 \\[anything-ff-run-zgrep]\t\t->Run zgrep (C-u Recursive).
1836 \\[anything-ff-run-etags]\t\t->Run Etags (C-u use thing-at-point `C-u C-u' reload cache)
1837 \\[anything-ff-run-rename-file]\t\t->Rename File (C-u Follow).
1838 \\[anything-ff-run-copy-file]\t\t->Copy File (C-u Follow).
1839 \\[anything-ff-run-byte-compile-file]\t\t->Byte Compile File (C-u Load).
1840 \\[anything-ff-run-load-file]\t\t->Load File.
1841 \\[anything-ff-run-symlink-file]\t\t->Symlink File.
1842 \\[anything-ff-run-delete-file]\t\t->Delete File.
1843 \\[anything-ff-run-kill-buffer-persistent]\t\t->Kill buffer candidate without quitting.
1844 \\[anything-ff-persistent-delete]\t->Delete file without quitting.
1845 \\[anything-ff-run-switch-to-eshell]\t\t->Switch to Eshell.
1846 \\[anything-ff-run-eshell-command-on-file]\t\t->Eshell command on file (C-u Run on all marked files at once).
1847 \\[anything-ff-run-ediff-file]\t\t->Ediff file.
1848 \\[anything-ff-run-ediff-merge-file]\t\t->Ediff merge file.
1849 \\[anything-ff-run-complete-fn-at-point]\t\t->Complete file name at point.
1850 \\[anything-ff-run-switch-other-window]\t\t->Switch other window.
1851 \\[anything-ff-run-switch-other-frame]\t\t->Switch other frame.
1852 \\[anything-ff-run-open-file-externally]\t\t->Open file with external program (C-u to choose).
1853 \\[anything-ff-rotate-left-persistent]\t\t->Rotate Image Left.
1854 \\[anything-ff-rotate-right-persistent]\t\t->Rotate Image Right.
1855 \\[anything-find-files-down-one-level]\t\t->Go down precedent directory.
1856 \\[anything-ff-run-switch-to-history]\t\t->Switch to anything find-files history.
1857 \\[anything-ff-properties-persistent]\t\t->Show file properties in a tooltip.
1858 \\[anything-mark-all]\t\t->Mark all visibles candidates.
1859 \\[anything-ff-run-toggle-auto-update]\t->Toggle auto expansion of directories.
1860 \\[anything-unmark-all]\t\t->Unmark all candidates, visibles and invisibles.
1861 \\[anything-ff-run-gnus-attach-files]\t\t->Gnus attach files to message buffer.
1862 \\[anything-ff-run-print-file]\t\t->Print file with default printer.
1863 \\[anything-enlarge-window]\t\t->Enlarge anything window.
1864 \\[anything-narrow-window]\t\t->Narrow anything window.
1865 \\[anything-ff-run-toggle-basename]\t\t->Toggle basename/fullpath.
1866 \\[anything-send-bug-report-from-anything]\t\t->Send Bug report.
1867 \\[anything-ff-help]\t\t->Display this help info.
1868 \n== Anything Map ==
1869 \\{anything-map}
1871 (anything-help)))
1873 ;;; Help for `anything-c-read-file-name'
1876 ;;;###autoload
1877 (defun anything-read-file-name-help ()
1878 (interactive)
1879 (let ((anything-help-message "== Anything read file name Map ==\
1880 \nSpecific commands for anything-c-read-file-name:
1881 \\<anything-c-read-file-map>
1882 \\[anything-find-files-down-one-level]\t\t->Go down precedent directory.
1883 \\[anything-ff-run-toggle-auto-update]\t->Toggle auto expansion of directories.
1884 \\[anything-next-source]\t\t->Goto next source.
1885 \\[anything-previous-source]\t->Goto previous source.
1886 \\[anything-read-file-name-help]\t\t->Display this help info.
1887 \n== Anything Map ==
1888 \\{anything-map}
1890 (anything-help)))
1892 ;;; Generic file help - Used by locate.
1895 ;;;###autoload
1896 (defun anything-generic-file-help ()
1897 (interactive)
1898 (let ((anything-help-message "== Anything Generic files Map ==\
1899 \nSpecific commands for anything locate and others files sources:
1900 \\<anything-generic-files-map>
1901 \\[anything-ff-run-grep]\t\t->Run grep (C-u recurse).
1902 \\[anything-ff-run-pdfgrep]\t\t->Run Pdfgrep on marked files.
1903 \\[anything-ff-run-delete-file]\t\t->Delete file.
1904 \\[anything-ff-run-ediff-file]\t\t->Ediff file.
1905 \\[anything-ff-run-ediff-merge-file]\t\t->Ediff merge file.
1906 \\[anything-ff-run-switch-other-window]\t\t->Switch other window.
1907 \\[anything-ff-properties-persistent]\t\t->Show file properties.
1908 \\[anything-yank-text-at-point]\t\t->Yank text at point.
1909 \\[anything-ff-run-open-file-externally]\t\t->Open file with external program (C-u to choose).
1910 \nLocate tips:
1911 You can add after writing search pattern any of the locate command line options.
1912 e.g -b, -e, -n <number>...etc.
1913 See Man locate for more infos.
1914 \n== Anything Map ==
1915 \\{anything-map}"))
1916 (anything-help)))
1919 ;;; Grep help
1922 ;;;###autoload
1923 (defun anything-grep-help ()
1924 (interactive)
1925 (let ((anything-help-message "== Anything Grep Map ==\
1926 \nSpecific commands for Grep and Etags:
1927 \\<anything-c-grep-map>
1928 \\[anything-c-goto-next-file]\t->Next File.
1929 \\[anything-c-goto-precedent-file]\t\t->Precedent File.
1930 \\[anything-yank-text-at-point]\t\t->Yank Text at point in minibuffer.
1931 \\[anything-c-grep-run-other-window-action]\t\t->Jump other window.
1932 \\[anything-c-grep-run-persistent-action]\t\t->Run persistent action (Same as `C-z').
1933 \\[anything-c-grep-run-default-action]\t\t->Run default action (Same as RET).
1934 \\[anything-grep-help]\t\t->Show this help.
1935 \n== Anything Map ==
1936 \\{anything-map}"))
1937 (anything-help)))
1939 ;;; Pdf grep help
1942 ;;;###autoload
1943 (defun anything-pdfgrep-help ()
1944 (interactive)
1945 (let ((anything-help-message "== Anything PdfGrep Map ==\
1946 \nSpecific commands for Pdf Grep:
1947 \\<anything-c-pdfgrep-map>
1948 \\[anything-c-goto-next-file]\t->Next File.
1949 \\[anything-c-goto-precedent-file]\t\t->Precedent File.
1950 \\[anything-yank-text-at-point]\t\t->Yank Text at point in minibuffer.
1951 \\[anything-pdfgrep-help]\t\t->Show this help.
1952 \n== Anything Map ==
1953 \\{anything-map}"))
1954 (anything-help)))
1956 ;;; Etags help
1959 ;;;###autoload
1960 (defun anything-etags-help ()
1961 "The help function for etags."
1962 (interactive)
1963 (let ((anything-help-message "== Anything Etags Map ==\
1964 \nSpecific commands for Etags:
1965 \\<anything-c-etags-map>
1966 \\[anything-c-goto-next-file]\t->Next File.
1967 \\[anything-c-goto-precedent-file]\t\t->Precedent File.
1968 \\[anything-yank-text-at-point]\t\t->Yank Text at point in minibuffer.
1969 \\[anything-etags-help]\t\t->Show this help.
1970 \n== Anything Map ==
1971 \\{anything-map}"))
1972 (anything-help)))
1974 ;;; Ucs help
1977 (defun anything-c-ucs-help ()
1978 "Help command for `anything-ucs'."
1979 (interactive)
1980 (let ((anything-help-message "== Anything Ucs ==
1981 \nSpecific commands for `anything-ucs':
1982 \\<anything-c-ucs-map>
1983 \\[anything-c-ucs-persistent-insert]\t->Insert char.
1984 \\[anything-c-ucs-persistent-forward]\t->Forward char.
1985 \\[anything-c-ucs-persistent-backward]\t->Backward char.
1986 \\[anything-c-ucs-persistent-delete]\t->Delete char backward.
1987 \\[anything-c-ucs-help]\t\t->Show this help.
1989 \n== Anything Map ==
1990 \\{anything-map}
1992 (anything-help)))
1996 ;;; Mode line strings
1999 (defvar anything-buffer-mode-line-string
2000 '("Buffer(s)"
2001 "\\<anything-c-buffer-map>\
2002 \\[anything-c-buffer-help]:Help, \
2003 \\<anything-map>\
2004 \\[anything-select-action]:Acts,\
2005 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
2006 \\[anything-select-3rd-action]:NthAct,\
2007 \\[anything-send-bug-report-from-anything]:BugReport."
2008 "String displayed in mode-line in `anything-c-source-buffers-list'"))
2010 (defvar anything-ff-mode-line-string
2011 "\\<anything-find-files-map>\
2012 \\[anything-ff-help]:Help, \
2013 \\[anything-send-bug-report-from-anything]:BugReport, \
2014 \\<anything-map>\
2015 \\[anything-select-action]:Acts, \
2016 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
2017 \\[anything-select-3rd-action]:NthAct"
2018 "String displayed in mode-line in `anything-c-source-find-files'")
2020 (defvar anything-read-file-name-mode-line-string
2021 "\\<anything-c-read-file-map>\
2022 \\[anything-read-file-name-help]:Help, \
2023 \\<anything-map>\
2024 \\[anything-select-action]:Acts,\
2025 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
2026 \\[anything-select-3rd-action]:NthAct"
2027 "String displayed in mode-line in `anything-c-source-find-files'")
2029 (defvar anything-generic-file-mode-line-string
2030 "\\<anything-generic-files-map>\
2031 \\[anything-generic-file-help]:Help, \
2032 \\<anything-map>\
2033 \\[anything-select-action]:Acts,\
2034 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
2035 \\[anything-select-3rd-action]:NthAct,\
2036 \\[anything-send-bug-report-from-anything]:BugReport."
2037 "String displayed in mode-line in Locate.")
2039 (defvar anything-grep-mode-line-string
2040 "\\<anything-c-grep-map>\
2041 \\[anything-grep-help]:Help,\
2042 \\<anything-map>\
2043 \\[anything-select-action]:Acts,\
2044 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
2045 \\[anything-select-3rd-action]:NthAct,\
2046 \\[anything-send-bug-report-from-anything]:BugReport."
2047 "String displayed in mode-line in `anything-do-grep'.")
2049 (defvar anything-pdfgrep-mode-line-string
2050 "\\<anything-c-pdfgrep-map>\
2051 \\[anything-pdfgrep-help]:Help,\
2052 \\<anything-map>\
2053 \\[anything-select-action]:Acts,\
2054 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
2055 \\[anything-select-3rd-action]:NthAct,\
2056 \\[anything-send-bug-report-from-anything]:BugReport."
2057 "String displayed in mode-line in `anything-do-pdfgrep'.")
2059 (defvar anything-etags-mode-line-string
2060 "\\<anything-c-etags-map>\
2061 \\[anything-etags-help]:Help,\
2062 \\<anything-map>\
2063 \\[anything-select-action]:Acts,\
2064 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
2065 \\[anything-select-3rd-action]:NthAct,\
2066 \\[anything-send-bug-report-from-anything]:BugReport."
2067 "String displayed in mode-line in `anything-c-etags-select'.")
2070 (defvar anything-c-ucs-mode-line-string
2071 "\\<anything-c-ucs-map>\
2072 \\[anything-c-ucs-help]:Help, \
2073 \\<anything-map>\
2074 \\[anything-select-action]:Acts,\
2075 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
2076 \\[anything-select-3rd-action]:NthAct."
2077 "String displayed in mode-line in `anything-ucs'.")
2081 ;;; Utilities Functions
2084 (defun anything-ff-find-printers ()
2085 "Return a list of available printers on Unix systems."
2086 (when (executable-find "lpstat")
2087 (let ((printer-list (with-temp-buffer
2088 (call-process "lpstat" nil t nil "-a")
2089 (split-string (buffer-string) "\n"))))
2090 (loop for p in printer-list
2091 for printer = (car (split-string p))
2092 when printer
2093 collect printer))))
2095 ;; Shut up byte compiler in emacs24*.
2096 (defun anything-c-switch-to-buffer (buffer-or-name)
2097 "Same as `switch-to-buffer' whithout warnings at compile time."
2098 (with-no-warnings
2099 (switch-to-buffer buffer-or-name)))
2101 (defsubst* anything-c-position (item seq &key (test 'eq))
2102 "A simple and faster replacement of CL `position'."
2103 (loop for i in seq for index from 0
2104 when (funcall test i item) return index))
2106 (defun anything-c-get-pid-from-process-name (process-name)
2107 "Get pid from running process PROCESS-NAME."
2108 (loop with process-list = (list-system-processes)
2109 for pid in process-list
2110 for process = (assoc-default 'comm (process-attributes pid))
2111 when (and process (string-match process-name process))
2112 return pid))
2114 (defun* anything-current-buffer-narrowed-p (&optional
2115 (buffer anything-current-buffer))
2116 "Check if BUFFER is narrowed.
2117 Default is `anything-current-buffer'."
2118 (with-current-buffer buffer
2119 (let ((beg (point-min))
2120 (end (point-max))
2121 (total (buffer-size)))
2122 (or (/= beg 1) (/= end (1+ total))))))
2124 (defun anything-region-active-p ()
2125 (and transient-mark-mode mark-active (/= (mark) (point))))
2127 (defun anything-goto-line (lineno)
2128 "Goto LINENO opening only outline headline if needed."
2129 (goto-char (point-min)) (forward-line (1- lineno))
2130 (when (or (eq major-mode 'org-mode)
2131 (and (boundp 'outline-minor-mode)
2132 outline-minor-mode))
2133 (require 'org) ; On some old Emacs versions org may not be loaded.
2134 (org-reveal))
2135 (anything-match-line-color-current-line) (sit-for 0.3)
2136 (anything-match-line-cleanup))
2138 (defun anything-show-this-source-only ()
2139 "Show all candidates of this source."
2140 (interactive)
2141 (setq anything-candidate-number-limit nil)
2142 (anything-set-source-filter
2143 (list (assoc-default 'name (anything-get-current-source)))))
2145 ;;;###autoload
2146 (defun anything-test-sources ()
2147 "List all anything sources for test.
2148 The output is sexps which are evaluated by \\[eval-last-sexp]."
2149 (interactive)
2150 (with-output-to-temp-buffer "*Anything Test Sources*"
2151 (mapc (lambda (s) (princ (format ";; (anything '%s)\n" s)))
2152 (apropos-internal "^anything-c-source" #'boundp))
2153 (pop-to-buffer standard-output)))
2155 (defun anything-nest (&rest same-as-anything)
2156 "Nested `anything'. If you use `anything' within `anything', use it."
2157 (with-selected-window (anything-window)
2158 (let (anything-current-position
2159 anything-current-buffer
2160 (orig-anything-buffer anything-buffer)
2161 anything-pattern
2162 anything-buffer
2163 anything-sources
2164 anything-compiled-sources
2165 anything-buffer-chars-modified-tick
2166 (anything-samewindow t)
2167 (enable-recursive-minibuffers t))
2168 (unwind-protect
2169 (apply #'anything same-as-anything)
2170 (anything-initialize-overlays orig-anything-buffer)
2171 (add-hook 'post-command-hook 'anything-check-minibuffer-input)))))
2173 (defun anything-displaying-source-names ()
2174 "Display sources name."
2175 (with-current-buffer anything-buffer
2176 (goto-char (point-min))
2177 (loop with pos
2178 while (setq pos (next-single-property-change (point) 'anything-header))
2179 do (goto-char pos)
2180 collect (buffer-substring-no-properties (point-at-bol)(point-at-eol))
2181 do (forward-line 1))))
2183 ;; [Obsolete]
2184 (defun anything-select-source ()
2185 "[OBSOLETE] Select source."
2186 (interactive)
2187 (let ((default (assoc-default 'name (anything-get-current-source)))
2188 (source-names (anything-displaying-source-names))
2189 (all-source-names (mapcar (lambda (s) (assoc-default 'name s))
2190 (anything-get-sources))))
2191 (setq anything-candidate-number-limit 9999)
2192 (anything-aif
2193 (let (anything-source-filter)
2194 (anything-nest '(((name . "Anything Source")
2195 (candidates . source-names)
2196 (action . identity))
2197 ((name . "Anything Source (ALL)")
2198 (candidates . all-source-names)
2199 (action . identity)))
2200 nil "Source: " nil
2201 default "*anything select source*"))
2202 (anything-set-source-filter (list it))
2203 (anything-set-source-filter nil))))
2205 ;; Same as anything-set-pattern but bad written, please fix.
2206 (defun anything-insert-string (str)
2207 "Insert STR."
2208 (delete-minibuffer-contents)
2209 (insert str))
2211 ;;;###autoload
2212 (defun anything-insert-buffer-name ()
2213 "Insert buffer name."
2214 (interactive)
2215 (anything-insert-string
2216 (with-anything-current-buffer
2217 (if buffer-file-name (file-name-nondirectory buffer-file-name)
2218 (buffer-name)))))
2220 ;; This is not needed because M-n do the same thing now by default
2221 ;; See `anything-read-pattern-maybe'.
2222 ;; (defun anything-insert-symbol ()
2223 ;; "Insert current symbol."
2224 ;; (interactive)
2225 ;; (anything-insert-string
2226 ;; (with-anything-current-buffer
2227 ;; (save-excursion
2228 ;; (buffer-substring (beginning-of-thing 'symbol)
2229 ;; (end-of-thing 'symbol))))))
2231 ;; Same as `anything-yank-selection' but wrong because it use
2232 ;; `anything-current-buffer' to get selection.
2233 ;; (defun anything-insert-selection ()
2234 ;; "Insert current selection."
2235 ;; (interactive)
2236 ;; (anything-insert-string
2237 ;; (with-anything-current-buffer
2238 ;; (anything-get-selection))))
2240 (defun anything-c-match-on-file-name (candidate)
2241 "Return non-nil if `anything-pattern' match basename of filename CANDIDATE."
2242 (string-match anything-pattern (file-name-nondirectory candidate)))
2244 (defun anything-c-match-on-directory-name (candidate)
2245 "Return non-nil if `anything-pattern' match directory part of CANDIDATE."
2246 (anything-aif (file-name-directory candidate)
2247 (string-match anything-pattern it)))
2249 (defun anything-c-match-on-basename (candidate)
2250 "Return non-nil if `anything-pattern' match basename of filename CANDIDATE."
2251 (string-match anything-pattern (anything-c-basename candidate)))
2253 (defun anything-c-string-match (candidate)
2254 "Return non-nil if `anything-pattern' match CANDIDATE.
2255 The match is done with `string-match'."
2256 (string-match anything-pattern candidate))
2258 (defun anything-c-skip-entries (list regexp)
2259 "Remove entries which matches REGEXP from LIST."
2260 (remove-if (lambda (x) (and (stringp x) (string-match regexp x)))
2261 list))
2263 (defun anything-c-shadow-entries (list regexp)
2264 "Display elements of LIST matching REGEXP with the `file-name-shadow' face."
2265 (mapcar (lambda (file)
2266 ;; Add shadow face property to boring files.
2267 (let ((face (if (facep 'file-name-shadow)
2268 'file-name-shadow
2269 ;; fall back to default on XEmacs
2270 'default)))
2271 (if (string-match regexp file)
2272 (setq file (propertize file 'face face))))
2273 file)
2274 list))
2276 (defsubst anything-c-stringify (str-or-sym)
2277 "Get string of STR-OR-SYM."
2278 (if (stringp str-or-sym)
2279 str-or-sym
2280 (symbol-name str-or-sym)))
2282 (defsubst anything-c-symbolify (str-or-sym)
2283 "Get symbol of STR-OR-SYM."
2284 (if (symbolp str-or-sym)
2285 str-or-sym
2286 (intern str-or-sym)))
2288 (defun anything-c-describe-function (func)
2289 "FUNC is symbol or string."
2290 (describe-function (anything-c-symbolify func)))
2292 (defun anything-c-describe-variable (var)
2293 "VAR is symbol or string."
2294 (describe-variable (anything-c-symbolify var)))
2296 (defun anything-c-find-function (func)
2297 "FUNC is symbol or string."
2298 (find-function (anything-c-symbolify func)))
2300 (defun anything-c-find-variable (var)
2301 "VAR is symbol or string."
2302 (find-variable (anything-c-symbolify var)))
2304 (defun anything-c-kill-new (candidate &optional replace)
2305 "CANDIDATE is symbol or string.
2306 See `kill-new' for argument REPLACE."
2307 (kill-new (anything-c-stringify candidate) replace))
2309 (defun* anything-fast-remove-dups (seq &key (test 'eq))
2310 "Remove duplicates elements in list SEQ.
2311 This is same as `remove-duplicates' but with memoisation.
2312 It is much faster, especially in large lists.
2313 A test function can be provided with TEST argument key.
2314 Default is `eq'."
2315 (loop with cont = (make-hash-table :test test)
2316 for elm in seq
2317 unless (gethash elm cont)
2318 do (puthash elm elm cont)
2319 finally return
2320 (loop for i being the hash-values in cont collect i)))
2322 (defadvice eval-defun (after anything-source-hack activate)
2323 "Allow immediate execution of anything source when evaling it.
2324 See `anything-c-enable-eval-defun-hack'."
2325 (when anything-c-enable-eval-defun-hack
2326 (let ((varsym (save-excursion
2327 (beginning-of-defun)
2328 (forward-char 1)
2329 (when (memq (read (current-buffer)) '(defvar setq))
2330 (read (current-buffer))))))
2331 (when (string-match "^anything-c-source-" (symbol-name varsym))
2332 (anything varsym)))))
2333 ;; (progn (ad-disable-advice 'eval-defun 'after 'anything-source-hack) (ad-update 'eval-defun))
2336 ;; Move this function from anything.el and redefine here
2337 ;; to avoid an unneeded defadvice.
2338 (defun anything-quit-and-find-file ()
2339 "Drop into `anything-find-files' from `anything'.
2340 If current selection is a buffer or a file, `anything-find-files'
2341 from its directory."
2342 (interactive)
2343 (anything-run-after-quit
2344 (lambda (f)
2345 (if (file-exists-p f)
2346 (anything-find-files-1 (file-name-directory f)
2347 (if anything-ff-transformer-show-only-basename
2348 (anything-c-basename f) f))
2349 (anything-find-files-1 f)))
2350 (anything-aif (get-buffer (anything-get-selection))
2351 (or (buffer-file-name it)
2352 (car (rassoc it dired-buffers))
2353 (and (with-current-buffer it
2354 (eq major-mode 'org-agenda-mode))
2355 org-directory
2356 (expand-file-name org-directory))
2357 default-directory)
2358 (let ((sel (anything-get-selection)))
2359 (if (file-exists-p sel)
2360 (expand-file-name sel)
2361 default-directory)))))
2364 (defmacro* anything-c-walk-directory (directory &key path (directories t) match)
2365 "Walk through DIRECTORY tree.
2366 PATH can be one of basename, relative, or full.
2367 DIRECTORIES when non--nil (default) return also directories names, otherwise
2368 skip directories names.
2369 MATCH match only filenames matching regexp MATCH."
2370 `(let (result
2371 (fn (case ,path
2372 (basename 'file-name-nondirectory)
2373 (relative 'file-relative-name)
2374 (full 'identity)
2375 (t 'file-name-nondirectory))))
2376 (labels ((ls-R (dir)
2377 (loop with ls = (directory-files dir t directory-files-no-dot-files-regexp)
2378 for f in ls
2379 if (file-directory-p f)
2380 do (progn (when ,directories
2381 (push (funcall fn f) result))
2382 ;; Don't recurse in directory symlink.
2383 (unless (file-symlink-p f)
2384 (ls-R f)))
2385 else do
2386 (unless (and ,match (not (string-match ,match (file-name-nondirectory f))))
2387 (push (funcall fn f) result)))))
2388 (ls-R ,directory)
2389 (nreverse result))))
2391 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Anything Applications ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2393 ;;; Anything regexp.
2396 (defvar anything-build-regexp-history nil)
2397 (defun anything-c-query-replace-regexp (candidate)
2398 "Query replace regexp from `anything-regexp'.
2399 With a prefix arg replace only matches surrounded by word boundaries,
2400 i.e Don't replace inside a word, regexp is surrounded with \\bregexp\\b."
2401 (let ((regexp (funcall (anything-attr 'regexp))))
2402 (apply 'query-replace-regexp
2403 (anything-c-query-replace-args regexp))))
2405 (defun anything-c-kill-regexp-as-sexp (candidate)
2406 "Kill regexp in a format usable in lisp code."
2407 (anything-c-regexp-kill-new
2408 (prin1-to-string (funcall (anything-attr 'regexp)))))
2410 (defun anything-c-kill-regexp (candidate)
2411 "Kill regexp as it is in `anything-pattern'."
2412 (anything-c-regexp-kill-new (funcall (anything-attr 'regexp))))
2414 (defun anything-c-query-replace-args (regexp)
2415 "create arguments of `query-replace-regexp' action in `anything-regexp'."
2416 (let ((region-only (anything-region-active-p)))
2417 (list
2418 regexp
2419 (query-replace-read-to regexp
2420 (format "Query replace %sregexp %s"
2421 (if anything-current-prefix-arg "word " "")
2422 (if region-only "in region " ""))
2424 anything-current-prefix-arg
2425 (when region-only (region-beginning))
2426 (when region-only (region-end)))))
2428 (defvar anything-c-source-regexp
2429 '((name . "Regexp Builder")
2430 (init . (lambda ()
2431 (anything-candidate-buffer anything-current-buffer)))
2432 (candidates-in-buffer)
2433 (get-line . anything-c-regexp-get-line)
2434 (persistent-action . anything-c-regexp-persistent-action)
2435 (persistent-help . "Show this line")
2436 (multiline)
2437 (delayed)
2438 (requires-pattern . 2)
2439 (mode-line . "Press TAB to select action.")
2440 (regexp . (lambda () anything-input))
2441 (action . (("Kill Regexp as sexp" . anything-c-kill-regexp-as-sexp)
2442 ("Query Replace Regexp (C-u Not inside word.)"
2443 . anything-c-query-replace-regexp)
2444 ("Kill Regexp" . anything-c-kill-regexp)))))
2446 (defun anything-c-regexp-get-line (s e)
2447 (propertize
2448 (apply 'concat
2449 ;; Line contents
2450 (format "%5d: %s" (line-number-at-pos (1- s)) (buffer-substring s e))
2451 ;; subexps
2452 (loop for i from 0 to (1- (/ (length (match-data)) 2))
2453 collect (format "\n %s'%s'"
2454 (if (zerop i) "Group 0: " (format "Group %d: " i))
2455 (match-string i))))
2456 ;; match beginning
2457 ;; KLUDGE: point of anything-candidate-buffer is +1 than that of anything-current-buffer.
2458 ;; It is implementation problem of candidates-in-buffer.
2459 'anything-realvalue
2460 (1- s)))
2462 (defun anything-c-regexp-persistent-action (pt)
2463 (goto-char pt)
2464 (anything-persistent-highlight-point))
2466 (defun anything-c-regexp-kill-new (input)
2467 (kill-new input)
2468 (message "Killed: %s" input))
2472 ;;; Toggle all marks.
2475 ;;;###autoload
2476 (defun anything-mark-all ()
2477 "Mark all visible unmarked candidates in current source."
2478 (interactive)
2479 (with-anything-window
2480 (save-excursion
2481 (goto-char (anything-get-previous-header-pos))
2482 (anything-next-line)
2483 (let* ((next-head (anything-get-next-header-pos))
2484 (end (and next-head
2485 (save-excursion
2486 (goto-char next-head)
2487 (forward-line -1)
2488 (point))))
2489 (maxpoint (or end (point-max))))
2490 (while (< (point) maxpoint)
2491 (anything-mark-current-line)
2492 (let ((prefix (get-text-property (point-at-bol) 'display))
2493 (bn (anything-c-basename (anything-get-selection)))
2494 (src (assoc-default 'name (anything-get-current-source))))
2495 (when (and (not (anything-this-visible-mark))
2496 (not (or (string= prefix "[?]")
2497 (string= prefix "[@]"))))
2498 ;; Don't mark possibles directories ending with . or ..
2499 ;; and also autosave files/links.
2500 (unless
2501 (and (or (anything-file-completion-source-p)
2502 (equal src "Files from Current Directory"))
2503 (string-match "^\\.#.*\\|^#.*#$\\|\\.$" bn))
2504 (anything-make-visible-mark))))
2505 (forward-line 1) (end-of-line))))
2506 (anything-mark-current-line)
2507 (message "%s candidates marked" (length anything-marked-candidates))))
2509 ;;;###autoload
2510 (defun anything-unmark-all ()
2511 "Unmark all candidates in all sources of current anything session."
2512 (interactive)
2513 (with-anything-window
2514 (let ((len (length anything-marked-candidates)))
2515 (save-excursion
2516 (anything-clear-visible-mark))
2517 (setq anything-marked-candidates nil)
2518 (anything-mark-current-line)
2519 (message "%s candidates unmarked" len))))
2521 ;;;###autoload
2522 (defun anything-toggle-all-marks ()
2523 "Toggle all marks.
2524 Mark all visible candidates of current source or unmark all candidates
2525 visible or invisible in all sources of current anything session"
2526 (interactive)
2527 (let ((marked (anything-marked-candidates)))
2528 (if (and (>= (length marked) 1)
2529 (with-anything-window anything-visible-mark-overlays))
2530 (anything-unmark-all)
2531 (anything-mark-all))))
2535 ;;; Buffers
2538 (defun anything-c-buffer-list ()
2539 "Return the list of names of buffers with boring buffers filtered out.
2540 Boring buffers is specified by `anything-c-boring-buffer-regexp'.
2541 The first buffer in the list will be the last recently used
2542 buffer that is not the current buffer."
2543 (let ((buffers (mapcar 'buffer-name (buffer-list))))
2544 (append (cdr buffers) (list (car buffers)))))
2546 (defvar anything-c-source-buffers
2547 '((name . "Buffers")
2548 (candidates . anything-c-buffer-list)
2549 (type . buffer)))
2550 ;; (anything 'anything-c-source-buffers)
2552 (defvar anything-c-source-buffer-not-found
2553 '((name . "Create buffer")
2554 (dummy)
2555 (filtered-candidate-transformer (lambda (cands source)
2556 (list anything-pattern)))
2557 (action . (lambda (candidate)
2558 (anything-c-switch-to-buffer (get-buffer-create candidate))))))
2559 ;; (anything 'anything-c-source-buffer-not-found)
2561 ;;; Buffers-list (was buffers+)
2564 (eval-when-compile (require 'dired))
2566 (defun anything-c-highlight-buffers (buffers)
2567 (loop for i in buffers
2568 for buf = (get-buffer i)
2569 for bfname = (buffer-file-name buf)
2570 collect
2571 (cond (;; A dired buffer.
2572 (rassoc buf dired-buffers)
2573 (propertize i 'face 'anything-ff-directory
2574 'help-echo (car (rassoc buf dired-buffers))))
2575 ;; A buffer file modified somewhere outside of emacs.
2576 ((and bfname (not (file-remote-p bfname))
2577 (file-exists-p bfname)
2578 (not (verify-visited-file-modtime buf)))
2579 (propertize i 'face 'anything-buffer-saved-out
2580 'help-echo bfname))
2581 ;; A new buffer file not already saved on disk.
2582 ((and bfname (not (file-remote-p bfname))
2583 (not (verify-visited-file-modtime buf)))
2584 (propertize i 'face 'anything-buffer-not-saved
2585 'help-echo bfname))
2586 ;; A Remote buffer file modified and not saved on disk.
2587 ((and bfname (file-remote-p bfname) (buffer-modified-p buf))
2588 (let ((prefix (propertize
2589 " " 'display
2590 (propertize "@ " 'face 'anything-ff-prefix))))
2591 (cons (concat prefix (propertize i 'face 'anything-ff-symlink
2592 'help-echo bfname)) i)))
2593 ;; A buffer file modified and not saved on disk.
2594 ((and bfname (buffer-modified-p buf))
2595 (propertize i 'face 'anything-ff-symlink
2596 'help-echo bfname))
2597 ;; A remote buffer file not modified and saved on disk.
2598 ((and bfname (file-remote-p bfname))
2599 (let ((prefix (propertize
2600 " " 'display
2601 (propertize "@ " 'face 'anything-ff-prefix))))
2602 (cons (concat prefix (propertize i 'face 'font-lock-type-face
2603 'help-echo bfname)) i)))
2604 ;; A buffer file not modified and saved on disk.
2605 (bfname
2606 (propertize i 'face 'font-lock-type-face
2607 'help-echo bfname))
2608 ;; Any non--file buffer.
2609 (t (propertize i 'face 'italic)))))
2612 (defvar anything-c-source-buffers-list
2613 '((name . "Buffers")
2614 (candidates . anything-c-buffer-list)
2615 (type . buffer)
2616 (match anything-c-buffer-match-major-mode)
2617 (candidate-transformer
2618 anything-c-skip-current-buffer
2619 anything-c-skip-boring-buffers
2620 anything-c-highlight-buffers)
2621 (persistent-action . anything-c-buffers-list-persistent-action)
2622 (volatile)
2623 (mode-line . anything-buffer-mode-line-string)
2624 (persistent-help . "Show this buffer / C-u \\[anything-execute-persistent-action]: Kill this buffer")))
2625 ;; (anything 'anything-c-source-buffers-list)
2627 (defun anything-c-buffer-match-major-mode (candidate)
2628 "Match maybe buffer by major-mode.
2629 If you give a major-mode or partial major-mode,
2630 it will list all buffers of this major-mode and/or buffers with name
2631 matching this major-mode.
2632 If you add a space after major-mode and then a space,
2633 it will match all buffers of the major-mode
2634 before space matching pattern after space.
2635 If you give a pattern which doesn't match a major-mode, it will search buffer
2636 with name matching pattern."
2637 (let* ((cand (replace-regexp-in-string "^\\s-\\{1\\}" "" candidate))
2638 (buf (get-buffer cand)))
2639 (when buf
2640 (with-current-buffer buf
2641 (let ((mjm (symbol-name major-mode))
2642 (split (split-string anything-pattern)))
2643 (cond ((string-match "\\s-$" anything-pattern)
2644 (string-match (car split) mjm))
2645 ((string-match "\\s-" anything-pattern)
2646 (and (string-match (car split) mjm)
2647 (string-match (cadr split) cand)))
2648 (t (or (string-match anything-pattern mjm)
2649 (string-match anything-pattern cand)))))))))
2651 (defun anything-c-buffer-query-replace-1 (&optional regexp-flag)
2652 "Query replace in marked buffers.
2653 If REGEXP-FLAG is given use `query-replace-regexp'."
2654 (let ((fn (if regexp-flag 'query-replace-regexp 'query-replace))
2655 (prompt (if regexp-flag "Query replace regexp" "Query replace"))
2656 (bufs (anything-marked-candidates)))
2657 (loop
2658 with replace = (query-replace-read-from prompt regexp-flag)
2659 with tostring = (unless (consp replace)
2660 (query-replace-read-to
2661 replace prompt regexp-flag))
2662 for buf in bufs
2664 (save-window-excursion
2665 (anything-c-switch-to-buffer buf)
2666 (save-excursion
2667 (let ((case-fold-search t))
2668 (goto-char (point-min))
2669 (if (consp replace)
2670 (apply fn (list (car replace) (cdr replace)))
2671 (apply fn (list replace tostring)))))))))
2673 (defun anything-c-buffer-query-replace-regexp (candidate)
2674 (anything-c-buffer-query-replace-1 'regexp))
2676 (defun anything-c-buffer-query-replace (candidate)
2677 (anything-c-buffer-query-replace-1))
2679 (defun anything-buffer-toggle-diff (candidate)
2680 "Toggle diff buffer CANDIDATE with it's file."
2681 (if (get-buffer-window "*Diff*")
2682 (kill-buffer "*Diff*")
2683 (diff-buffer-with-file (get-buffer candidate))))
2685 ;;;###autoload
2686 (defun anything-buffer-diff-persistent ()
2687 "Toggle diff buffer without quitting anything."
2688 (interactive)
2689 (anything-attrset 'diff-action 'anything-buffer-toggle-diff)
2690 (anything-execute-persistent-action 'diff-action))
2692 (defun anything-buffer-revert-and-update (candidate)
2693 (let ((marked (anything-marked-candidates)))
2694 (loop for buf in marked do (anything-revert-buffer buf))
2695 (anything-force-update candidate)))
2697 ;;;###autoload
2698 (defun anything-buffer-revert-persistent ()
2699 "Revert buffer without quitting anything."
2700 (interactive)
2701 (anything-attrset 'revert-action 'anything-buffer-revert-and-update)
2702 (anything-execute-persistent-action 'revert-action 'onewindow))
2704 (defun anything-buffer-save-and-update (candidate)
2705 (let ((marked (anything-marked-candidates))
2706 (enable-recursive-minibuffers t))
2707 (loop for buf in marked do
2708 (with-current-buffer (get-buffer buf)
2709 (save-buffer)))
2710 (anything-force-update candidate)))
2712 ;;;###autoload
2713 (defun anything-buffer-save-persistent ()
2714 "Save buffer without quitting anything."
2715 (interactive)
2716 (anything-attrset 'save-action 'anything-buffer-save-and-update)
2717 (anything-execute-persistent-action 'save-action 'onewindow))
2719 ;;;###autoload
2720 (defun anything-buffer-run-kill-buffers ()
2721 "Run kill buffer action from `anything-c-source-buffers-list'."
2722 (interactive)
2723 (anything-c-quit-and-execute-action 'anything-kill-marked-buffers))
2725 ;;;###autoload
2726 (defun anything-buffer-run-grep ()
2727 "Run Grep action from `anything-c-source-buffers-list'."
2728 (interactive)
2729 (anything-c-quit-and-execute-action 'anything-c-grep-buffers))
2731 ;;;###autoload
2732 (defun anything-buffer-run-zgrep ()
2733 "Run Grep action from `anything-c-source-buffers-list'."
2734 (interactive)
2735 (anything-c-quit-and-execute-action 'anything-c-zgrep-buffers))
2737 ;;;###autoload
2738 (defun anything-buffer-run-query-replace-regexp ()
2739 "Run Query replace regexp action from `anything-c-source-buffers-list'."
2740 (interactive)
2741 (anything-c-quit-and-execute-action 'anything-c-buffer-query-replace-regexp))
2743 ;;;###autoload
2744 (defun anything-buffer-run-query-replace ()
2745 "Run Query replace action from `anything-c-source-buffers-list'."
2746 (interactive)
2747 (anything-c-quit-and-execute-action 'anything-c-buffer-query-replace))
2749 ;;;###autoload
2750 (defun anything-buffer-switch-other-window ()
2751 "Run switch to other window action from `anything-c-source-buffers-list'."
2752 (interactive)
2753 (anything-c-quit-and-execute-action 'switch-to-buffer-other-window))
2755 ;;;###autoload
2756 (defun anything-buffer-switch-other-frame ()
2757 "Run switch to other frame action from `anything-c-source-buffers-list'."
2758 (interactive)
2759 (anything-c-quit-and-execute-action 'switch-to-buffer-other-frame))
2761 ;;;###autoload
2762 (defun anything-buffer-switch-to-elscreen ()
2763 "Run switch to elscreen action from `anything-c-source-buffers-list'."
2764 (interactive)
2765 (anything-c-quit-and-execute-action 'anything-find-buffer-on-elscreen))
2767 ;;;###autoload
2768 (defun anything-buffer-run-ediff ()
2769 "Run ediff action from `anything-c-source-buffers-list'."
2770 (interactive)
2771 (anything-c-quit-and-execute-action 'anything-ediff-marked-buffers))
2773 (defun anything-buffer-run-ediff-merge ()
2774 "Run ediff action from `anything-c-source-buffers-list'."
2775 (interactive)
2776 (anything-c-quit-and-execute-action 'anything-ediff-marked-buffers-merge))
2778 (defun anything-c-buffers-persistent-kill (buffer)
2779 "Persistent action to kill buffer."
2780 (with-current-buffer (get-buffer buffer)
2781 (if (and (buffer-modified-p)
2782 (buffer-file-name (current-buffer)))
2783 (progn
2784 (save-buffer)
2785 (kill-buffer buffer))
2786 (kill-buffer buffer)))
2787 (anything-delete-current-selection))
2789 (defun anything-c-buffers-list-persistent-action (candidate)
2790 (if current-prefix-arg
2791 (anything-c-buffers-persistent-kill candidate)
2792 (anything-c-switch-to-buffer candidate)))
2795 ;;;; <File>
2798 ;;; File name history
2799 (defvar anything-c-source-file-name-history
2800 '((name . "File Name History")
2801 (candidates . file-name-history)
2802 (match anything-c-match-on-basename)
2803 (type . file)))
2804 ;; (anything 'anything-c-source-file-name-history)
2806 ;;; Files in current dir
2809 (defvar anything-c-source-files-in-current-dir
2810 '((name . "Files from Current Directory")
2811 (candidates . (lambda ()
2812 (with-anything-current-buffer
2813 (directory-files (anything-c-current-directory)))))
2814 ;; volatile is not needed, I think.
2815 (type . file)))
2816 ;; (anything 'anything-c-source-files-in-current-dir)
2818 (defun anything-c-highlight-files (files)
2819 (loop for i in files
2820 if (file-directory-p i)
2821 collect (propertize (file-name-nondirectory i)
2822 'face 'anything-ff-directory
2823 'help-echo (expand-file-name i))
2824 else
2825 collect (propertize (file-name-nondirectory i)
2826 'face 'anything-ff-file
2827 'help-echo (expand-file-name i))))
2829 (defvar anything-c-source-files-in-current-dir+
2830 '((name . "Files from Current Directory")
2831 (candidates . (lambda ()
2832 (with-anything-current-buffer
2833 (directory-files (anything-c-current-directory) t))))
2834 (candidate-transformer anything-c-highlight-files)
2835 ;; volatile is not needed, I think.
2836 (type . file)))
2837 ;; (anything 'anything-c-source-files-in-current-dir+)
2841 ;;; Anything-find-files - The anything files browser.
2844 ;; Internal.
2845 (defvar anything-c-find-files-doc-header " (`C-l': Go to precedent level)"
2846 "*The doc that is inserted in the Name header of a find-files or dired source.")
2847 (defvar anything-ff-auto-update-flag nil
2848 "Internal, flag to turn on/off auto-update in `anything-find-files'.
2849 Don't set it directly, use instead `anything-ff-auto-update-initial-value'.")
2850 (defvar anything-ff-last-expanded nil
2851 "Store last expanded directory or file.")
2852 (defvar anything-ff-default-directory nil)
2853 (defvar anything-ff-history nil)
2854 (defvar anything-ff-cand-to-mark nil)
2857 (defvar anything-c-source-find-files
2858 `((name . "Find Files")
2859 (header-name . (lambda (name)
2860 (concat name anything-c-find-files-doc-header)))
2861 ;; It is needed for filenames with capital letters
2862 (disable-shortcuts)
2863 (init . (lambda ()
2864 (setq anything-ff-auto-update-flag
2865 anything-ff-auto-update-initial-value)))
2866 (candidates . anything-find-files-get-candidates)
2867 (filtered-candidate-transformer anything-c-find-files-transformer)
2868 (persistent-action . anything-find-files-persistent-action)
2869 (persistent-help . "Hit1 Expand Candidate, Hit2 or (C-u) Find file")
2870 (mode-line . anything-ff-mode-line-string)
2871 (volatile)
2872 (candidate-number-limit . 9999)
2873 (action-transformer . anything-find-files-action-transformer)
2874 (action
2875 . ,(delq
2877 `(("Find File" . anything-c-find-file-or-marked)
2878 ("Find file in Dired" . anything-c-point-file-in-dired)
2879 ,(and (locate-library "elscreen")
2880 '("Find file in Elscreen" . anything-elscreen-find-file))
2881 ,(and (locate-library "popwin")
2882 '("Find file in popup window" . popwin:find-file))
2883 ("Checksum File" . anything-ff-checksum)
2884 ("Complete at point `M-tab'"
2885 . anything-c-insert-file-name-completion-at-point)
2886 ("Open file externally `C-c C-x, C-u to choose'"
2887 . anything-c-open-file-externally)
2888 ("Grep File(s) `M-g s, C-u Recurse'" . anything-find-files-grep)
2889 ("Zgrep File(s) `M-g z, C-u Recurse'" . anything-ff-zgrep)
2890 ("Switch to Eshell `M-e'" . anything-ff-switch-to-eshell)
2891 ("Etags `M-., C-u tap, C-u C-u reload tag file'" . anything-ff-etags-select)
2892 ("Eshell command on file(s) `M-!, C-u run on all marked at once.'"
2893 . anything-find-files-eshell-command-on-file)
2894 ("Find file as root" . anything-find-file-as-root)
2895 ("Find file in hex dump" . hexl-find-file)
2896 ("Ediff File `C-='" . anything-find-files-ediff-files)
2897 ("Ediff Merge File `C-c ='" . anything-find-files-ediff-merge-files)
2898 ("Delete File(s) `M-D'" . anything-delete-marked-files)
2899 ("Copy file(s) `M-C, C-u to follow'" . anything-find-files-copy)
2900 ("Copy file(s) Async" . anything-ff-copy-async)
2901 ("Rename file(s) `M-R, C-u to follow'" . anything-find-files-rename)
2902 ("Serial rename files" . anything-ff-serial-rename)
2903 ("Serial rename by symlinking files" . anything-ff-serial-rename-by-symlink)
2904 ("Serial rename by copying files" . anything-ff-serial-rename-by-copying)
2905 ("Symlink files(s) `M-S, C-u to follow'" . anything-find-files-symlink)
2906 ("Relsymlink file(s) `C-u to follow'" . anything-find-files-relsymlink)
2907 ("Hardlink file(s) `C-u to follow'" . anything-find-files-hardlink)
2908 ("Find file other window `C-o'" . find-file-other-window)
2909 ("Switch to history `M-p'" . anything-find-files-switch-to-hist)
2910 ("Find file other frame `C-c C-o'" . find-file-other-frame)
2911 ("Print File `C-c p'" . anything-ff-print)
2912 ("Locate `C-x C-f, C-u to specify locate db'" . anything-ff-locate))))))
2913 ;; (anything 'anything-c-source-find-files)
2915 (defun anything-find-files-set-prompt-for-action (action files)
2916 "Set prompt for action ACTION for FILES."
2917 (let ((len (length files)))
2918 (format "%s *%s File(s)\n%s to: "
2919 action len
2920 (mapconcat (lambda (f)
2921 (format "- %s\n" f)) files ""))))
2923 (defun anything-dwim-target-directory ()
2924 "Return value of `default-directory' of buffer in other window.
2925 If there is only one window return the value ot `default-directory'
2926 for current buffer."
2927 (with-anything-current-buffer
2928 (let ((num-windows (length (window-list))))
2929 (if (> num-windows 1)
2930 (save-selected-window
2931 (other-window 1)
2932 default-directory)
2933 (car anything-ff-history)))))
2935 (defun anything-find-files-do-action (action)
2936 "Generic function for creating action from `anything-c-source-find-files'.
2937 ACTION must be an action supported by `anything-dired-action'."
2938 (let* ((ifiles (mapcar 'expand-file-name ; Allow modify '/foo/.' -> '/foo'
2939 (anything-marked-candidates)))
2940 (cand (anything-get-selection)) ; Target
2941 (prompt (anything-find-files-set-prompt-for-action
2942 (capitalize (symbol-name action)) ifiles))
2943 (parg anything-current-prefix-arg)
2944 (dest (anything-c-read-file-name
2945 prompt
2946 :preselect (if anything-ff-transformer-show-only-basename
2947 (anything-c-basename cand) cand)
2948 :initial-input (anything-dwim-target-directory)
2949 :history (anything-find-files-history :comp-read nil))))
2950 (anything-dired-action
2951 dest :files ifiles :action action :follow parg)))
2953 (defun anything-find-files-copy (candidate)
2954 "Copy files from `anything-find-files'."
2955 (anything-find-files-do-action 'copy))
2957 (defun anything-find-files-rename (candidate)
2958 "Rename files from `anything-find-files'."
2959 (anything-find-files-do-action 'rename))
2961 (defun anything-find-files-symlink (candidate)
2962 "Symlink files from `anything-find-files'."
2963 (anything-find-files-do-action 'symlink))
2965 (defun anything-find-files-relsymlink (candidate)
2966 "Relsymlink files from `anything-find-files'."
2967 (anything-find-files-do-action 'relsymlink))
2969 (defun anything-find-files-hardlink (candidate)
2970 "Hardlink files from `anything-find-files'."
2971 (anything-find-files-do-action 'hardlink))
2973 (defun anything-find-files-byte-compile (candidate)
2974 "Byte compile elisp files from `anything-find-files'."
2975 (let ((files (anything-marked-candidates))
2976 (parg anything-current-prefix-arg))
2977 (loop for fname in files
2978 do (byte-compile-file fname parg))))
2980 (defun anything-find-files-load-files (candidate)
2981 "Load elisp files from `anything-find-files'."
2982 (let ((files (anything-marked-candidates)))
2983 (loop for fname in files
2984 do (load fname))))
2986 (defun anything-find-files-ediff-files-1 (candidate &optional merge)
2987 "Generic function to ediff/merge files in `anything-find-files'."
2988 (let ((bname (anything-c-basename candidate))
2989 (prompt (if merge "Ediff Merge `%s' With File: "
2990 "Ediff `%s' With File: "))
2991 (fun (if merge 'ediff-merge-files 'ediff-files)))
2992 (funcall fun
2993 candidate
2994 (condition-case quit
2995 (anything-c-read-file-name
2996 (format prompt bname))
2997 (quit ;; Hit C-g ask user to fallback to locate.
2998 (if (y-or-n-p "Search file for ediff with locate? ")
2999 (anything-c-locate-read-file-name
3000 (format prompt bname)
3001 ;; Check if -b option is available.
3002 (if (and (eq system-type 'windows-nt)
3003 (string-match "^es" anything-c-locate-command))
3004 bname
3005 (concat bname " -b")))
3006 (error "Error: Ediff Operation aborted")))))))
3008 (defun anything-find-files-ediff-files (candidate)
3009 (anything-find-files-ediff-files-1 candidate))
3011 (defun anything-find-files-ediff-merge-files (candidate)
3012 (anything-find-files-ediff-files-1 candidate 'merge))
3014 (defun anything-find-files-grep (candidate)
3015 "Default action to grep files from `anything-find-files'."
3016 (anything-do-grep-1 (anything-marked-candidates)
3017 anything-current-prefix-arg))
3019 (defun anything-ff-zgrep (candidate)
3020 "Default action to zgrep files from `anything-find-files'."
3021 (let ((prefarg anything-current-prefix-arg)
3022 (ls (anything-marked-candidates)))
3023 (anything-ff-zgrep-1 ls prefarg)))
3025 (defun anything-ff-pdfgrep (candidate)
3026 "Default action to pdfgrep files from `anything-find-files'."
3027 (let ((cands (loop for file in (anything-marked-candidates)
3028 if (or (string= (file-name-extension file) "pdf")
3029 (string= (file-name-extension file) "PDF"))
3030 collect file))
3031 (anything-c-pdfgrep-default-function 'anything-c-pdfgrep-init))
3032 (when cands
3033 (anything-do-pdfgrep-1 cands))))
3035 (defun anything-ff-etags-select (candidate)
3036 "Default action to jump to etags from `anything-find-files'."
3037 (when (get-buffer anything-action-buffer)
3038 (kill-buffer anything-action-buffer))
3039 (let ((default-directory anything-ff-default-directory))
3040 (anything-c-etags-select anything-current-prefix-arg)))
3042 (defun anything-find-files-switch-to-hist (candidate)
3043 "Switch to anything-find-files history."
3044 (anything-find-files t))
3046 ;;; Asynchronous copy of files.
3049 (defun anything-c-copy-files-async-1 (flist dest)
3050 "Copy a list of Files FLIST to DEST asynchronously.
3051 It use another emacs process to do the job.
3052 Communication with background emacs is done with temp file
3053 `anything-c-copy-files-async-log-file'."
3054 (start-file-process "emacs-batch" nil anything-c-copy-async-prefered-emacs
3055 "-Q" "--batch" "--eval"
3056 (format "(progn
3057 (require 'dired) (require 'cl)
3058 (let ((dired-recursive-copies 'always)
3059 failures success
3060 (ovw-count 0)
3061 (cpf-count 0))
3062 (dolist (f '%S)
3063 (condition-case err
3064 (let ((file-exists (file-exists-p
3065 (expand-file-name
3066 (file-name-nondirectory (directory-file-name f))
3067 (file-name-directory
3068 (file-name-as-directory \"%s\"))))))
3069 (dired-copy-file f \"%s\" t)
3070 (if file-exists
3071 (progn (push (cons \"Overwriting\" f) success)
3072 (incf ovw-count))
3073 (push (cons \"Copying\" f) success)
3074 (incf cpf-count)))
3075 (file-error
3076 (push (dired-make-relative
3077 (expand-file-name
3078 (file-name-nondirectory (directory-file-name f))
3079 (file-name-directory \"%s\")))
3080 failures))))
3081 (with-current-buffer (find-file-noselect \"%s\")
3082 (erase-buffer)
3083 (when failures
3084 (dolist (fail (reverse failures))
3085 (insert (concat \"Failed to copy \" fail \"\n\"))))
3086 (when success
3087 (loop for (a . s) in (reverse success) do
3088 (insert (concat a \" \" s \" to %s done\n\"))))
3089 (and (/= cpf-count 0) (insert (concat (int-to-string cpf-count) \" File(s) Copied\n\")))
3090 (and (/= ovw-count 0) (insert (concat (int-to-string ovw-count) \" File(s) Overwrited\n\")))
3091 (and failures (insert (concat (int-to-string (length failures)) \" File(s) Failed to copy\n\")))
3092 (save-buffer))))"
3093 flist dest dest dest anything-c-copy-files-async-log-file dest)))
3095 (defun anything-c-copy-async-with-log (flist dest)
3096 "Copy file list FLIST to DEST showing log.
3097 Log is send to `anything-c-copy-files-async-log-file'.
3098 Copying is done asynchronously with `anything-c-copy-files-async-1'."
3099 (declare (special auto-revert-interval))
3100 (pop-to-buffer (find-file-noselect anything-c-copy-files-async-log-file))
3101 (set (make-local-variable 'auto-revert-interval) 1)
3102 (erase-buffer)
3103 (insert "Wait copying files...\n")
3104 (sit-for 0.5) (save-buffer)
3105 (goto-char (point-max))
3106 (auto-revert-mode 1)
3107 (anything-c-copy-files-async-1 flist dest))
3109 (defun anything-ff-copy-async (candidate)
3110 "Anything find files action to copy files async.
3111 Copying is done asynchronously with `anything-c-copy-files-async-1'."
3112 (let* ((flist (anything-marked-candidates))
3113 (dest (anything-c-read-file-name
3114 (anything-find-files-set-prompt-for-action
3115 "Copy Async" flist)
3116 :preselect candidate
3117 :initial-input (car anything-ff-history)
3118 :history (anything-find-files-history :comp-read nil))))
3119 (anything-c-copy-async-with-log flist dest)))
3121 (defvar eshell-command-aliases-list nil)
3122 (defvar anything-eshell-command-on-file-input-history nil)
3123 (defun anything-find-files-eshell-command-on-file-1 (candidate &optional map)
3124 "Run `eshell-command' on CANDIDATE or marked candidates possibly with an eshell alias.
3126 Basename of CANDIDATE can be a wild-card.
3127 If MAP is given run `eshell-command' on all marked files at once,
3128 Otherwise, run `eshell-command' on each marked files.
3130 If `eshell' or `eshell-command' have not been run once, or if you have no eshell aliases
3131 `eshell-command-aliases-list' will not be loaded first time you use this."
3132 (when (or eshell-command-aliases-list
3133 (y-or-n-p "Eshell is not loaded, run eshell-command without alias anyway? "))
3134 (and eshell-command-aliases-list (eshell-read-aliases-list))
3135 (let* ((cand-list (anything-marked-candidates))
3136 (default-directory (or anything-ff-default-directory
3137 ;; If candidate is an url *-ff-default-directory is nil
3138 ;; so keep value of default-directory.
3139 default-directory))
3140 (command (anything-comp-read
3141 "Command: "
3142 (loop for (a . c) in eshell-command-aliases-list
3143 when (string-match "\\(\\$1\\|\\$\\*\\)$" (car c))
3144 collect (propertize a 'help-echo (car c)) into ls
3145 finally return (sort ls 'string<))
3146 :buffer "*esh command on file*"
3147 :name "Eshell command"
3148 :input-history
3149 'anything-eshell-command-on-file-input-history))
3150 (com-value (car (assoc-default command eshell-command-aliases-list))))
3151 (if (and (or map (and com-value (string-match "\\$\\*$" com-value)))
3152 (> (length cand-list) 1))
3153 ;; Run eshell-command with ALL marked files as arguments.
3154 (let ((mapfiles (mapconcat 'shell-quote-argument cand-list " ")))
3155 (eshell-command (format "%s %s" command mapfiles)))
3156 ;; Run eshell-command on EACH marked files.
3157 (loop
3158 for i in cand-list
3159 for bn = (anything-c-basename i)
3160 for files = (if (and bn (string-match "^\*" bn))
3161 ;; Assume if fname is a wildcard
3162 ;; cand-list have a length of 1.
3163 (mapconcat
3164 'shell-quote-argument
3165 (file-expand-wildcards i t) " ")
3166 (format "'%s'" i))
3167 for com = (if (string-match "'%s'\\|\"%s\"\\|%s" command)
3168 ;; This allow to enter other args AFTER filename
3169 ;; i.e <command %s some_more_args>
3170 (format command files)
3171 (format "%s %s" command files))
3172 do (eshell-command com))))))
3174 (defun anything-find-files-eshell-command-on-file (candidate)
3175 "Run `eshell-command' on CANDIDATE or marked candidates.
3176 See `anything-find-files-eshell-command-on-file-1' for more info."
3177 (anything-find-files-eshell-command-on-file-1
3178 candidate anything-current-prefix-arg))
3180 (defun anything-ff-switch-to-eshell (candidate)
3181 "Switch to eshell and cd to `anything-ff-default-directory'."
3182 (flet ((cd-eshell ()
3183 (goto-char (point-max))
3184 (insert
3185 (format "cd '%s'" anything-ff-default-directory))
3186 (eshell-send-input)))
3187 (if (get-buffer "*eshell*")
3188 (progn
3189 (anything-c-switch-to-buffer "*eshell*")
3190 (cd-eshell))
3191 (call-interactively 'eshell)
3192 (cd-eshell))))
3194 (defun anything-ff-serial-rename-action (method)
3195 "Rename all marked files to `anything-ff-default-directory' with METHOD.
3196 See `anything-ff-serial-rename-1'."
3197 (let* ((cands (anything-marked-candidates))
3198 (name (read-string "NewName: "))
3199 (start (read-number "StartAtNumber: "))
3200 (extension (read-string "Extension: " (file-name-extension (car cands))))
3201 (dir (expand-file-name
3202 (anything-c-read-file-name
3203 "Serial Rename to directory: " :initial-input
3204 (expand-file-name anything-ff-default-directory)))))
3205 (when (y-or-n-p (format "Serial Rename %s *files to `%s' with prefix `%s'? "
3206 (length cands) dir name))
3207 (anything-ff-serial-rename-1 dir cands name start extension :method method)
3208 (anything-find-files-1 dir))))
3210 (defun anything-ff-member-directory-p (file directory)
3211 (let ((dir-file (expand-file-name (file-name-as-directory (file-name-directory file))))
3212 (cur-dir (expand-file-name (file-name-as-directory directory))))
3213 (string= dir-file cur-dir)))
3215 (defun* anything-ff-serial-rename-1
3216 (directory collection new-name start-at-num extension &key (method 'rename))
3217 "rename files in COLLECTION to DIRECTORY with the prefix name NEW-NAME.
3218 Rename start at number START-AT-NUM - ex: prefixname-01.jpg.
3219 EXTENSION is the file extension to use, in empty prompt,
3220 reuse the original extension of file.
3221 METHOD can be one of rename, copy or symlink.
3222 Files will be renamed if they are files of current directory, otherwise they
3223 will be treated with METHOD.
3224 Default METHOD is rename."
3225 ;; Maybe remove directories selected by error in collection.
3226 (setq collection (remove-if 'file-directory-p collection))
3227 (flet ((symlink-file (file dest)
3228 (let ((flist (list file)))
3229 (anything-dired-action
3230 dest :action 'symlink :files flist))))
3232 (let* ((tmp-dir (file-name-as-directory
3233 (concat (file-name-as-directory directory)
3234 (symbol-name (gensym "tmp")))))
3235 (fn (case method
3236 (copy 'copy-file)
3237 (symlink 'symlink-file)
3238 (rename 'rename-file)
3239 (t (error "Error: Unknow method %s" method)))))
3240 (make-directory tmp-dir)
3241 (loop for i in collection
3242 for count from start-at-num
3243 for fnum = (if (< count 10) "0%s" "%s")
3244 for nname = (concat tmp-dir new-name (format fnum count)
3245 (if (not (string= extension ""))
3246 (format ".%s" (replace-regexp-in-string
3247 "[.]" "" extension))
3248 (file-name-extension i 'dot)))
3249 do (if (anything-ff-member-directory-p i directory)
3250 (rename-file i nname)
3251 (funcall fn i nname)))
3252 (loop with dirlist = (directory-files
3253 tmp-dir t directory-files-no-dot-files-regexp)
3254 for f in dirlist do
3255 (if (file-symlink-p f)
3256 (symlink-file (file-truename f)
3257 (concat (file-name-as-directory directory)
3258 (anything-c-basename f)))
3259 (rename-file f directory)))
3260 (delete-directory tmp-dir t))))
3262 (defun anything-ff-serial-rename (candidate)
3263 "Serial rename all marked files to `anything-ff-default-directory'.
3264 Rename only file of current directory, and symlink files coming from
3265 other directories.
3266 See `anything-ff-serial-rename-1'."
3267 (anything-ff-serial-rename-action 'rename))
3269 (defun anything-ff-serial-rename-by-symlink (candidate)
3270 "Serial rename all marked files to `anything-ff-default-directory'.
3271 Rename only file of current directory, and symlink files coming from
3272 other directories.
3273 See `anything-ff-serial-rename-1'."
3274 (anything-ff-serial-rename-action 'symlink))
3276 (defun anything-ff-serial-rename-by-copying (candidate)
3277 "Serial rename all marked files to `anything-ff-default-directory'.
3278 Rename only file of current directory, and copy files coming from
3279 other directories.
3280 See `anything-ff-serial-rename-1'."
3281 (anything-ff-serial-rename-action 'copy))
3283 (defun anything-c-quit-and-execute-action (action)
3284 "Quit current anything session and execute ACTION."
3285 (setq anything-saved-action action)
3286 (anything-exit-minibuffer))
3288 (defun anything-ff-toggle-auto-update (candidate)
3289 (setq anything-ff-auto-update-flag (not anything-ff-auto-update-flag))
3290 (message "[Auto expansion %s]"
3291 (if anything-ff-auto-update-flag "enabled" "disabled")))
3293 ;;;###autoload
3294 (defun anything-ff-run-toggle-auto-update ()
3295 (interactive)
3296 (anything-attrset 'toggle-auto-update 'anything-ff-toggle-auto-update)
3297 (anything-execute-persistent-action 'toggle-auto-update))
3299 ;;;###autoload
3300 (defun anything-ff-run-switch-to-history ()
3301 "Run Switch to history action from `anything-c-source-find-files'."
3302 (interactive)
3303 (anything-c-quit-and-execute-action 'anything-find-files-switch-to-hist))
3305 ;;;###autoload
3306 (defun anything-ff-run-grep ()
3307 "Run Grep action from `anything-c-source-find-files'."
3308 (interactive)
3309 (anything-c-quit-and-execute-action 'anything-find-files-grep))
3311 ;;;###autoload
3312 (defun anything-ff-run-pdfgrep ()
3313 "Run Pdfgrep action from `anything-c-source-find-files'."
3314 (interactive)
3315 (anything-c-quit-and-execute-action 'anything-ff-pdfgrep))
3317 ;;;###autoload
3318 (defun anything-ff-run-zgrep ()
3319 "Run Grep action from `anything-c-source-find-files'."
3320 (interactive)
3321 (anything-c-quit-and-execute-action 'anything-ff-zgrep))
3323 ;;;###autoload
3324 (defun anything-ff-run-copy-file ()
3325 "Run Copy file action from `anything-c-source-find-files'."
3326 (interactive)
3327 (anything-c-quit-and-execute-action 'anything-find-files-copy))
3329 ;;;###autoload
3330 (defun anything-ff-run-rename-file ()
3331 "Run Rename file action from `anything-c-source-find-files'."
3332 (interactive)
3333 (anything-c-quit-and-execute-action 'anything-find-files-rename))
3335 ;;;###autoload
3336 (defun anything-ff-run-byte-compile-file ()
3337 "Run Byte compile file action from `anything-c-source-find-files'."
3338 (interactive)
3339 (anything-c-quit-and-execute-action 'anything-find-files-byte-compile))
3341 ;;;###autoload
3342 (defun anything-ff-run-load-file ()
3343 "Run Load file action from `anything-c-source-find-files'."
3344 (interactive)
3345 (anything-c-quit-and-execute-action 'anything-find-files-load-files))
3347 ;;;###autoload
3348 (defun anything-ff-run-eshell-command-on-file ()
3349 "Run eshell command on file action from `anything-c-source-find-files'."
3350 (interactive)
3351 (anything-c-quit-and-execute-action 'anything-find-files-eshell-command-on-file))
3353 ;;;###autoload
3354 (defun anything-ff-run-ediff-file ()
3355 "Run Ediff file action from `anything-c-source-find-files'."
3356 (interactive)
3357 (anything-c-quit-and-execute-action 'anything-find-files-ediff-files))
3359 ;;;###autoload
3360 (defun anything-ff-run-ediff-merge-file ()
3361 "Run Ediff merge file action from `anything-c-source-find-files'."
3362 (interactive)
3363 (anything-c-quit-and-execute-action 'anything-find-files-ediff-merge-files))
3365 ;;;###autoload
3366 (defun anything-ff-run-symlink-file ()
3367 "Run Symlink file action from `anything-c-source-find-files'."
3368 (interactive)
3369 (anything-c-quit-and-execute-action 'anything-find-files-symlink))
3371 ;;;###autoload
3372 (defun anything-ff-run-delete-file ()
3373 "Run Delete file action from `anything-c-source-find-files'."
3374 (interactive)
3375 (anything-c-quit-and-execute-action 'anything-delete-marked-files))
3377 ;;;###autoload
3378 (defun anything-ff-run-complete-fn-at-point ()
3379 "Run complete file name action from `anything-c-source-find-files'."
3380 (interactive)
3381 (anything-c-quit-and-execute-action
3382 'anything-c-insert-file-name-completion-at-point))
3384 ;;;###autoload
3385 (defun anything-ff-run-switch-to-eshell ()
3386 "Run switch to eshell action from `anything-c-source-find-files'."
3387 (interactive)
3388 (anything-c-quit-and-execute-action 'anything-ff-switch-to-eshell))
3390 ;;;###autoload
3391 (defun anything-ff-run-switch-other-window ()
3392 "Run switch to other window action from `anything-c-source-find-files'."
3393 (interactive)
3394 (anything-c-quit-and-execute-action 'find-file-other-window))
3396 ;;;###autoload
3397 (defun anything-ff-run-switch-other-frame ()
3398 "Run switch to other frame action from `anything-c-source-find-files'."
3399 (interactive)
3400 (anything-c-quit-and-execute-action 'find-file-other-frame))
3402 ;;;###autoload
3403 (defun anything-ff-run-open-file-externally ()
3404 "Run open file externally command action from `anything-c-source-find-files'."
3405 (interactive)
3406 (anything-c-quit-and-execute-action 'anything-c-open-file-externally))
3408 (defun anything-ff-locate (candidate)
3409 "Locate action function for `anything-find-files'."
3410 (let ((input (concat (anything-c-basename
3411 (expand-file-name
3412 candidate
3413 anything-ff-default-directory))
3414 ;; The locate '-b' option doesn't exists
3415 ;; in everything.
3416 (unless (and (eq system-type 'windows-nt)
3417 (string-match "^es" anything-c-locate-command))
3418 " -b")))
3419 (anything-mp-highlight-delay 0.7))
3420 (anything-locate-1 anything-current-prefix-arg input)))
3422 ;;;###autoload
3423 (defun anything-ff-run-locate ()
3424 "Run locate action from `anything-c-source-find-files'."
3425 (interactive)
3426 (anything-c-quit-and-execute-action 'anything-ff-locate))
3428 ;;;###autoload
3429 (defun anything-ff-run-gnus-attach-files ()
3430 "Run gnus attach files command action from `anything-c-source-find-files'."
3431 (interactive)
3432 (anything-c-quit-and-execute-action 'anything-ff-gnus-attach-files))
3434 ;;;###autoload
3435 (defun anything-ff-run-etags ()
3436 "Run Etags command action from `anything-c-source-find-files'."
3437 (interactive)
3438 (anything-c-quit-and-execute-action 'anything-ff-etags-select))
3441 (defun anything-ff-print (candidate)
3442 "Print marked files.
3443 You have to set in order
3444 variables `lpr-command',`lpr-switches' and/or `printer-name'.
3446 e.g:
3447 \(setq lpr-command \"gtklp\"\)
3448 \(setq lpr-switches '(\"-P\")\)
3449 \(setq printer-name \"Epson-Stylus-Photo-R265\"\)
3451 Same as `dired-do-print' but for anything."
3452 (unless anything-ff-printer-list
3453 (setq anything-ff-printer-list
3454 (anything-ff-find-printers)))
3455 (let* ((file-list (anything-marked-candidates))
3456 (len (length file-list))
3457 (printer-name (if anything-ff-printer-list
3458 (anything-comp-read
3459 "Printer: " anything-ff-printer-list)
3460 printer-name))
3461 (command (read-string
3462 (format "Print *%s File(s):\n%s with: "
3464 (mapconcat
3465 (lambda (f) (format "- %s\n" f))
3466 file-list ""))
3467 (when (and lpr-command
3468 (or lpr-switches
3469 printer-name))
3470 (mapconcat 'identity
3471 (cons lpr-command
3472 (append (if (stringp lpr-switches)
3473 (list lpr-switches)
3474 lpr-switches)
3475 (list printer-name)))
3476 " "))))
3477 (file-args (mapconcat #'(lambda (x)
3478 (format "'%s'" x))
3479 file-list " "))
3480 (cmd-line (concat command " " file-args)))
3481 (if command
3482 (start-process-shell-command "anything-print" nil cmd-line)
3483 (error "Error: Please verify your printer settings in Emacs."))))
3485 ;;;###autoload
3486 (defun anything-ff-run-print-file ()
3487 "Run Print file action from `anything-c-source-find-files'."
3488 (interactive)
3489 (anything-c-quit-and-execute-action 'anything-ff-print))
3491 (defun anything-ff-checksum (file)
3492 "Calculate the checksum of FILE.
3493 Provide completion on different algorithms to use on Emacs24.
3494 On Emacs23 only 'sha1' is available.
3495 The checksum is copied to kill-ring."
3496 (let ((algo-list (and (fboundp 'secure-hash)
3497 '(md5 sha1 sha224 sha256 sha384 sha512))))
3498 (kill-new
3499 (if algo-list
3500 (secure-hash (intern
3501 (anything-comp-read
3502 "Algorithm: " algo-list))
3503 file)
3504 (sha1 (with-temp-buffer
3505 (insert-file-contents file)
3506 (buffer-string)))))
3507 (message "Checksum copied to kill-ring.")))
3509 (defun anything-ff-toggle-basename (candidate)
3510 (setq anything-ff-transformer-show-only-basename
3511 (not anything-ff-transformer-show-only-basename))
3512 (let ((target (if anything-ff-transformer-show-only-basename
3513 (anything-c-basename candidate) candidate)))
3514 (anything-force-update target)))
3516 (defun anything-ff-run-toggle-basename ()
3517 (interactive)
3518 (anything-attrset 'toggle-basename 'anything-ff-toggle-basename)
3519 (anything-execute-persistent-action 'toggle-basename))
3521 (defun* anything-reduce-file-name (fname level &key unix-close expand)
3522 "Reduce FNAME by LEVEL from end or beginning depending LEVEL value.
3523 If LEVEL is positive reduce from end else from beginning.
3524 If UNIX-CLOSE is non--nil close filename with /.
3525 If EXPAND is non--nil expand-file-name."
3526 (let* ((exp-fname (expand-file-name fname))
3527 (fname-list (split-string (if (or (string= fname "~/") expand)
3528 exp-fname fname) "/" t))
3529 (len (length fname-list))
3530 (pop-list (if (< level 0)
3531 (subseq fname-list (* level -1))
3532 (subseq fname-list 0 (- len level))))
3533 (result (mapconcat 'identity pop-list "/"))
3534 (empty (string= result "")))
3535 (when unix-close (setq result (concat result "/")))
3536 (if (string-match "^~" result)
3537 (if (string= result "~/") "~/" result)
3538 (if (< level 0)
3539 (if empty "../" (concat "../" result))
3540 (cond ((eq system-type 'windows-nt)
3541 (if empty (expand-file-name "/") ; Expand to "/" or "c:/".
3542 result))
3543 (empty "/")
3545 (concat "/" result)))))))
3547 ;; Internal
3548 (defvar anything-file-completion-sources
3549 '("Find Files" "Read File Name"
3550 "Read File Name History" "Copy Files"
3551 "Rename Files" "Symlink Files"
3552 "Hardlink Files" "Write File" "Insert File")
3553 "Sources that use the *find-files mechanism can be added here.
3554 Sources generated by `ac-mode' don't need to be added here, it will
3555 be done automatically.
3556 You should not modify this yourself unless you know what you do.")
3558 (defun anything-file-completion-source-p ()
3559 "Test if current source is a dired or find-files source."
3560 (let ((cur-source (cdr (assoc 'name (anything-get-current-source)))))
3561 (loop for i in anything-file-completion-sources
3562 thereis (string= cur-source i))))
3564 (defun anything-find-files-down-one-level (arg)
3565 "Go down one level like unix command `cd ..'.
3566 If prefix numeric arg is given go ARG level down."
3567 (interactive "p")
3568 (when (and (anything-file-completion-source-p)
3569 (not (anything-ff-invalid-tramp-name-p)))
3570 (with-anything-window
3571 (setq anything-follow-mode nil))
3572 ;; When going to precedent level we want to be at the line
3573 ;; corresponding to actual directory, so store this info
3574 ;; in `anything-ff-last-expanded'.
3575 (if (and (not (file-directory-p anything-pattern))
3576 (file-exists-p anything-pattern))
3577 (setq anything-ff-last-expanded anything-pattern)
3578 (setq anything-ff-last-expanded anything-ff-default-directory))
3579 (let ((new-pattern (anything-reduce-file-name anything-pattern arg
3580 :unix-close t :expand t)))
3581 (anything-set-pattern new-pattern))))
3583 (defun anything-ff-retrieve-last-expanded ()
3584 "Move overlay to last visited directory `anything-ff-last-expanded'.
3585 This happen after using `anything-find-files-down-one-level',
3586 or hitting C-z on \"..\"."
3587 (when (and anything-ff-last-expanded
3588 (anything-file-completion-source-p))
3589 (let ((dirname (if anything-ff-transformer-show-only-basename
3590 (anything-c-basename
3591 (directory-file-name anything-ff-last-expanded))
3592 (directory-file-name anything-ff-last-expanded))))
3593 (with-anything-window
3594 (when (or (re-search-forward (concat dirname "$") nil t)
3595 (re-search-forward
3596 (concat anything-ff-last-expanded "$") nil t))
3597 (forward-line 0)
3598 (anything-mark-current-line)))
3599 (setq anything-ff-last-expanded nil))))
3600 (add-hook 'anything-after-update-hook 'anything-ff-retrieve-last-expanded)
3602 ;; Auto-update - anything-find-files auto expansion of directories.
3604 (defun anything-ff-update-when-only-one-matched ()
3605 "Expand to directory when sole completion.
3606 When only one candidate is remaining and it is a directory,
3607 expand to this directory."
3608 (when (and anything-ff-auto-update-flag
3609 (anything-file-completion-source-p)
3610 (not (anything-ff-invalid-tramp-name-p)))
3611 (let* ((history-p (string= (assoc-default
3612 'name (anything-get-current-source))
3613 "Read File Name History"))
3614 (pat (if (string-match tramp-file-name-regexp
3615 anything-pattern)
3616 (anything-create-tramp-name anything-pattern)
3617 anything-pattern))
3618 (completed-p (string= (file-name-as-directory pat)
3619 anything-ff-default-directory)))
3620 (when (and (or
3621 ;; Only one candidate remaining
3622 ;; and at least 2 char in basename.
3623 (and (<= (anything-approximate-candidate-number) 2)
3624 (>= (length (anything-c-basename anything-pattern)) 2))
3625 ;; Already completed.
3626 completed-p)
3627 (not history-p)) ; Don't try to auto complete in history.
3628 (with-anything-window
3629 (let ((cur-cand (prog2
3630 (unless completed-p
3631 ;; Only one non--existing candidate
3632 ;; and one directory candidate, move to it.
3633 (anything-next-line))
3634 (anything-get-selection))))
3635 (when (file-directory-p cur-cand)
3636 (if (and (not (string-match "^.*[.]\\{1,2\\}$" cur-cand)) ; [1]
3637 ;; Maybe we are here because completed-p is true
3638 ;; but check this again to be sure. (Windows fix)
3639 (<= (anything-approximate-candidate-number) 2)) ; [2]
3640 ;; If after going to next line the candidate
3641 ;; is not one of "." or ".." [1]
3642 ;; and only one candidate is remaining [2],
3643 ;; assume candidate is a new directory to expand, and do it.
3644 (anything-set-pattern (file-name-as-directory cur-cand))
3645 ;; The candidate is one of "." or ".."
3646 ;; that mean we have entered the last letter of the directory name
3647 ;; in prompt, so expansion is already done, just add the "/" at end
3648 ;; of name unless anything-pattern ends with "."
3649 ;; (i.e we are writing something starting with ".")
3650 (unless (string-match "^.*[.]\\{1\\}$" anything-pattern)
3651 (anything-set-pattern
3652 ;; Need to expand-file-name to avoid e.g /ssh:host:./ in prompt.
3653 (expand-file-name (file-name-as-directory anything-pattern)))))
3654 (anything-check-minibuffer-input-1))))))))
3655 (add-hook 'anything-after-update-hook 'anything-ff-update-when-only-one-matched)
3657 ;; Allow expanding to home directory or root
3658 ;; when entering respectively "~/" or "//" at end of pattern.
3659 ;; e.g /home/thierry/labo/anything-config-qp/~/
3660 ;; will expand to "~/"
3661 ;; and /home/thierry/labo/anything-config-qp//
3662 ;; will expand to "/"
3663 (defun anything-ff-auto-expand-to-home-or-root ()
3664 "Goto home, root or default directory when pattern ends with ~/, /, or ./.
3665 This happen only in function using sources that are
3666 `anything-file-completion-source-p' compliant."
3667 (when (and (anything-file-completion-source-p)
3668 (string-match ".*\\(/~/\\|/\\{2\\}\\|/[.]\\{1\\}/\\)$"
3669 anything-pattern))
3670 (let ((match (match-string 1 anything-pattern)))
3671 (cond ((string= match "//")
3672 ;; Expand to "/" or "c:/"
3673 (setq anything-pattern (expand-file-name "/")))
3674 ((string= match "/~/")
3675 (if (eq system-type 'windows-nt)
3676 (setq anything-pattern (file-name-as-directory (getenv "HOME")))
3677 (setq anything-pattern "~/")))
3678 ((string= match "/./")
3679 (setq anything-pattern
3680 (with-anything-current-buffer
3681 (expand-file-name default-directory))))))
3682 (setq anything-ff-default-directory anything-pattern)
3683 ;; For some reasons, i must use here with-current-buffer => mini buffer
3684 ;; and not `anything-set-pattern' that use with-selected-window => mini win.
3685 (with-current-buffer (window-buffer (minibuffer-window))
3686 (delete-minibuffer-contents)
3687 (insert anything-pattern))))
3689 (add-hook 'anything-after-update-hook 'anything-ff-auto-expand-to-home-or-root)
3691 (defun anything-c-point-file-in-dired (file)
3692 "Put point on filename FILE in dired buffer."
3693 (dired (file-name-directory file))
3694 (dired-goto-file file))
3696 (defun anything-create-tramp-name (fname)
3697 "Build filename for `anything-pattern' like /su:: or /sudo::."
3698 (apply #'tramp-make-tramp-file-name
3699 (loop with v = (tramp-dissect-file-name fname)
3700 for i across v collect i)))
3702 (defun* anything-ff-tramp-hostnames (&optional (pattern anything-pattern))
3703 "Get a list of hosts for tramp method found in `anything-pattern'.
3704 Argument PATTERN default to `anything-pattern', it is here only for debugging
3705 purpose."
3706 (when (string-match tramp-file-name-regexp pattern)
3707 (let ((method (match-string 1 pattern))
3708 (tn (match-string 0 pattern))
3709 (all-methods (mapcar 'car tramp-methods)))
3710 (remove-duplicates
3711 (loop for (f . h) in (tramp-get-completion-function method)
3712 append (loop for e in (funcall f (car h))
3713 for host = (and (consp e) (cadr e))
3714 when (and host (not (member host all-methods)))
3715 collect (concat tn host)))
3716 :test 'equal))))
3718 (defun anything-ff-before-action-hook-fn ()
3719 "Exit anything when user try to execute action on an invalid tramp fname."
3720 (let ((cand (anything-get-selection)))
3721 (when (and (anything-file-completion-source-p)
3722 (anything-ff-invalid-tramp-name-p cand) ; Check candidate.
3723 (anything-ff-invalid-tramp-name-p)) ; check anything-pattern.
3724 (error "Error: Unknow file or directory `%s'" cand))))
3725 (add-hook 'anything-before-action-hook 'anything-ff-before-action-hook-fn)
3727 (defun* anything-ff-invalid-tramp-name-p (&optional (pattern anything-pattern))
3728 "Return non--nil when PATTERN is an invalid tramp filename."
3729 (string= (anything-ff-set-pattern pattern)
3730 "Invalid tramp file name"))
3732 (defun anything-ff-set-pattern (pattern)
3733 "Handle tramp filenames in `anything-pattern'."
3734 (let ((methods (mapcar 'car tramp-methods))
3735 (reg "\\`/\\([^[/:]+\\|[^/]+]\\):.*:")
3736 cur-method tramp-name)
3737 (cond ((string= pattern "") "")
3738 ((string-match ".*\\(~?/?[.]\\{1\\}/\\)$" pattern)
3739 (with-anything-current-buffer
3740 (expand-file-name default-directory)))
3741 ((string-match ".*\\(~//\\|//\\)$" pattern)
3742 (expand-file-name "/") ; Expand to "/" or "c:/"
3744 ((string-match "^~\\|.*/~/$" pattern)
3745 (let* ((home (expand-file-name (getenv "HOME"))))
3746 (replace-match home nil t pattern)))
3747 ;; Match "/method:maybe_hostname:"
3748 ((and (string-match reg pattern)
3749 (setq cur-method (match-string 1 pattern))
3750 (member cur-method methods))
3751 (setq tramp-name (anything-create-tramp-name
3752 (match-string 0 pattern)))
3753 (replace-match tramp-name nil t pattern))
3754 ;; Match "/hostname:"
3755 ((and (string-match tramp-file-name-regexp pattern)
3756 (setq cur-method (match-string 1 pattern))
3757 (and cur-method (not (member cur-method methods))))
3758 (setq tramp-name (anything-create-tramp-name
3759 (match-string 0 pattern)))
3760 (replace-match tramp-name nil t pattern))
3761 ;; Match "/method:" in this case don't try to connect.
3762 ((and (not (string-match reg pattern))
3763 (string-match tramp-file-name-regexp pattern)
3764 (member (match-string 1 pattern) methods))
3765 "Invalid tramp file name") ; Write in anything-buffer.
3766 ;; PATTERN is a directory, end it with "/".
3767 ;; This will make PATTERN not ending yet with "/"
3768 ;; candidate for `anything-ff-default-directory',
3769 ;; allowing `anything-ff-retrieve-last-expanded' to retrieve it
3770 ;; when descending level.
3771 ((file-directory-p pattern)
3772 (file-name-as-directory pattern))
3773 ;; Return PATTERN unchanged.
3774 (t pattern))))
3776 (defun anything-find-files-get-candidates ()
3777 "Create candidate list for `anything-c-source-find-files'."
3778 (let* ((path (anything-ff-set-pattern anything-pattern))
3779 (path-name-dir (if (file-directory-p path)
3780 (file-name-as-directory path)
3781 (file-name-directory path)))
3782 (tramp-verbose anything-tramp-verbose)) ; No tramp message when 0.
3783 (set-text-properties 0 (length path) nil path)
3784 ;; Don't set now `anything-pattern' if `path' == "Invalid tramp file name"
3785 ;; like that the actual value (e.g /ssh:) is passed to
3786 ;; `anything-ff-tramp-hostnames'.
3787 (unless (string= path "Invalid tramp file name")
3788 (setq anything-pattern (anything-ff-transform-fname-for-completion path)))
3789 (setq anything-ff-default-directory
3790 (if (string= anything-pattern "")
3791 (expand-file-name "/") ; Expand to "/" or "c:/"
3792 (unless (string-match ffap-url-regexp path)
3793 ;; If path is an url *default-directory have to be nil.
3794 path-name-dir)))
3795 (cond ((string= path "Invalid tramp file name")
3796 (or (anything-ff-tramp-hostnames) ; Hostnames completion.
3797 (prog2
3798 ;; `anything-pattern' have not been modified yet.
3799 ;; Set it here to the value of `path' that should be now
3800 ;; "Invalid tramp file name" and set the candidates list
3801 ;; to ("Invalid tramp file name") to make `anything-pattern'
3802 ;; match single candidate "Invalid tramp file name".
3803 (setq anything-pattern path)
3804 ;; "Invalid tramp file name" is now printed
3805 ;; in `anything-buffer'.
3806 (list path))))
3807 ((or (file-regular-p path)
3808 (and (not (file-exists-p path)) (string-match "/$" path))
3809 (and ffap-url-regexp (string-match ffap-url-regexp path)))
3810 (list path))
3811 ((string= path "") (directory-files "/" t))
3812 ((and (file-directory-p path) (not (file-readable-p path)))
3813 (list (format "Opening directory: access denied, `%s'" path)))
3814 ((file-directory-p path) (directory-files path t))
3816 (append (list path) (directory-files path-name-dir t))))))
3818 (defun anything-ff-transform-fname-for-completion (fname)
3819 "Return FNAME with it's basename modified as a regexp.
3820 e.g foo => f.*o.*o .
3821 If basename contain one or more space or FNAME is a valid directory name
3822 return FNAME unchanged."
3823 (let ((bn (anything-c-basename fname)))
3824 (if (or (not anything-ff-smart-completion)
3825 (string-match "\\s-" bn)
3826 (string-match "/$" fname) ; Allow mkdir.
3827 (file-directory-p fname))
3828 fname ; Fall back to match-plugin.
3829 (setq bn (if (> (length bn) 2) ; Normal completion on first 2 char.
3830 (mapconcat 'identity (split-string bn "" t) ".*") bn))
3831 (concat (file-name-directory fname) bn))))
3833 (defun anything-ff-save-history ()
3834 "Store the last value of `anything-ff-default-directory' \
3835 in `anything-ff-history'."
3836 (when (and anything-ff-default-directory
3837 (anything-file-completion-source-p))
3838 (push anything-ff-default-directory anything-ff-history)))
3839 (add-hook 'anything-cleanup-hook 'anything-ff-save-history)
3841 (defun anything-ff-valid-symlink-p (file)
3842 (file-exists-p (file-truename file)))
3844 (defun anything-ff-properties (candidate)
3845 "Show file properties of CANDIDATE in a tooltip or message."
3846 (let ((type (anything-ff-attributes candidate :type t))
3847 (dired-line (anything-ff-attributes candidate :dired t :human-size t)))
3848 (if (window-system)
3849 (tooltip-show
3850 (concat
3851 (anything-c-basename candidate) ": \n"
3852 "Type: " type "\n"
3853 (when (string= type "symlink")
3854 (format "True name: '%s'\n"
3855 (cond ((string-match "^\.#" (anything-c-basename candidate))
3856 "Autosave symlink")
3857 ((anything-ff-valid-symlink-p candidate)
3858 (file-truename candidate))
3859 (t "Invalid Symlink"))))
3860 dired-line))
3861 (message dired-line) (sit-for 5))))
3863 ;;;###autoload
3864 (defun anything-ff-properties-persistent ()
3865 "Show properties without quitting anything."
3866 (interactive)
3867 (anything-attrset 'properties-action 'anything-ff-properties)
3868 (anything-execute-persistent-action 'properties-action))
3870 ;;;###autoload
3871 (defun anything-ff-persistent-delete ()
3872 "Delete current candidate without quitting."
3873 (interactive)
3874 (anything-attrset 'quick-delete 'anything-ff-quick-delete)
3875 (anything-execute-persistent-action 'quick-delete))
3877 (defun anything-ff-dot-file-p (file)
3878 "Check if FILE is `.' or `..'."
3879 (member (anything-c-basename file) '("." "..")))
3881 (defun anything-ff-quick-delete (candidate)
3882 "Delete file CANDIDATE without quitting."
3883 (if (and anything-ff-signal-error-on-dot-files
3884 (anything-ff-dot-file-p candidate))
3885 (message "Error: Cannot operate on `.' or `..'")
3886 (let ((presel (prog1 (save-excursion
3887 (let (sel)
3888 (anything-next-line)
3889 (setq sel (anything-get-selection))
3890 (if (string= sel candidate)
3891 (progn (anything-previous-line)
3892 (anything-get-selection))
3893 sel)))
3894 (anything-mark-current-line))))
3895 (setq presel (if (and anything-ff-transformer-show-only-basename
3896 (not (anything-ff-dot-file-p presel)))
3897 (anything-c-basename presel) presel))
3898 (if anything-ff-quick-delete-dont-prompt-for-deletion
3899 (anything-c-delete-file candidate)
3900 (save-selected-window
3901 (when (y-or-n-p (format "Really Delete file `%s'? " candidate))
3902 (anything-c-delete-file candidate))))
3903 (anything-force-update presel))))
3905 (defun anything-ff-kill-buffer-fname (candidate)
3906 (let* ((buf (get-file-buffer candidate))
3907 (buf-name (buffer-name buf)))
3908 (if buf
3909 (progn
3910 (kill-buffer buf) (message "Buffer `%s' killed" buf))
3911 (message "No buffer to kill"))))
3913 (defun anything-ff-kill-or-find-buffer-fname (candidate)
3914 "Find file CANDIDATE or kill it's buffer if it is visible.
3915 Never kill `anything-current-buffer'.
3916 Never kill buffer modified.
3917 This is called normally on third hit of \
3918 \\<anything-map>\\[anything-execute-persistent-action]
3919 in `anything-find-files-persistent-action'."
3920 (let* ((buf (get-file-buffer candidate))
3921 (buf-name (buffer-name buf)))
3922 (if (and buf (get-buffer-window buf)
3923 (not (eq buf (get-buffer anything-current-buffer)))
3924 (not (buffer-modified-p buf)))
3925 (progn
3926 (kill-buffer buf) (message "Buffer `%s' killed" buf-name))
3927 (find-file candidate))))
3929 ;;;###autoload
3930 (defun anything-ff-run-kill-buffer-persistent ()
3931 "Execute `anything-ff-kill-buffer-fname' whitout quitting."
3932 (interactive)
3933 (anything-attrset 'kill-buffer-fname 'anything-ff-kill-buffer-fname)
3934 (anything-execute-persistent-action 'kill-buffer-fname))
3936 (defun anything-ff-human-size (size)
3937 "Return a string showing SIZE of a file in human readable form.
3938 SIZE can be an integer or a float depending it's value.
3939 `file-attributes' will take care of that to avoid overflow error.
3940 KBSIZE if a floating point number, default value is 1024.0."
3941 (let ((M (cons "M" (/ size (expt anything-ff-default-kbsize 2))))
3942 (G (cons "G" (/ size (expt anything-ff-default-kbsize 3))))
3943 (K (cons "K" (/ size anything-ff-default-kbsize)))
3944 (B (cons "B" size)))
3945 (loop with result = B
3946 for (a . b) in
3947 (loop for (x . y) in (list M G K B)
3948 unless (< y 1) collect (cons x y))
3949 when (< b (cdr result)) do (setq result (cons a b))
3950 finally return (if (string= (car result) "B")
3951 (format "%s" size)
3952 (format "%.1f%s" (cdr result) (car result))))))
3954 (defun* anything-ff-attributes
3955 (file &key type links uid gid access-time modif-time
3956 status size mode gid-change inode device-num dired human-size)
3957 "Easy interface for `file-attributes'."
3958 (let ((all (destructuring-bind
3959 (type links uid gid access-time modif-time
3960 status size mode gid-change inode device-num)
3961 (file-attributes file 'string)
3962 (list :type type
3963 :links links
3964 :uid uid
3965 :gid gid
3966 :access-time access-time
3967 :modif-time modif-time
3968 :status status
3969 :size size
3970 :mode mode
3971 :gid-change gid-change
3972 :inode inode
3973 :device-num device-num))))
3974 (cond (type
3975 (let ((result (getf all :type)))
3976 (cond ((stringp result)
3977 "symlink")
3978 (result "directory")
3979 (t "file"))))
3980 (links (getf all :links))
3981 (uid (getf all :uid))
3982 (gid (getf all :gid))
3983 (access-time
3984 (format-time-string "%Y-%m-%d %R" (getf all :access-time)))
3985 (modif-time
3986 (format-time-string "%Y-%m-%d %R" (getf all :modif-time)))
3987 (status
3988 (format-time-string "%Y-%m-%d %R" (getf all :status)))
3989 (size (if human-size (anything-ff-human-size (getf all :size))
3990 (getf all :size)))
3991 (mode (getf all :mode))
3992 (gid-change (getf all :gid-change))
3993 (inode (getf all :inode))
3994 (device-num (getf all :device-num))
3995 (dired
3996 (concat
3997 (getf all :mode) " "
3998 (number-to-string (getf all :links)) " "
3999 (getf all :uid) ":"
4000 (getf all :gid) " "
4001 (if human-size (anything-ff-human-size (getf all :size))
4002 (int-to-string (getf all :size))) " "
4003 (format-time-string "%Y-%m-%d %R" (getf all :modif-time))))
4004 (t all))))
4006 (defun anything-ff-prefix-filename (fname &optional file-or-symlinkp new-file)
4007 "Return filename FNAME maybe prefixed with [?] or [@].
4008 If FILE-OR-SYMLINKP is non--nil this mean we assume FNAME is an
4009 existing filename or valid symlink and there is no need to test it.
4010 NEW-FILE when non--nil mean FNAME is a non existing file and
4011 return FNAME prefixed with [?]."
4012 (let* ((prefix-new (propertize
4013 " " 'display
4014 (propertize "[?]" 'face 'anything-ff-prefix)))
4015 (prefix-url (propertize
4016 " " 'display
4017 (propertize "[@]" 'face 'anything-ff-prefix))))
4018 (cond ((or file-or-symlinkp (file-exists-p fname)) fname)
4019 ((string-match ffap-url-regexp fname)
4020 (concat prefix-url " " fname))
4021 ((or new-file (not (file-exists-p fname)))
4022 (concat prefix-new " " fname)))))
4024 (defun anything-c-find-files-transformer (files sources)
4025 "Transformer for `anything-c-source-find-files'.
4026 Tramp files are not highlighted unless `anything-ff-tramp-not-fancy'
4027 is non--nil."
4028 (if (and (string-match tramp-file-name-regexp anything-pattern)
4029 anything-ff-tramp-not-fancy)
4030 (if anything-ff-transformer-show-only-basename
4031 (loop for i in files collect
4032 (if (string-match "[.]\\{1,2\\}$" i)
4033 i (cons (anything-c-basename i) i)))
4034 files)
4035 (anything-ff-highlight-files files sources)))
4037 (defun anything-ff-highlight-files (files sources)
4038 "Candidate transformer for `anything-c-source-find-files' without icons."
4039 (loop for i in files
4040 for disp = (if (and anything-ff-transformer-show-only-basename
4041 (not (string-match "[.]\\{1,2\\}$" i))
4042 (not (string-match ffap-url-regexp i)))
4043 (anything-c-basename i) i)
4044 collect
4045 (cond ((and (stringp (car (file-attributes i)))
4046 (not (anything-ff-valid-symlink-p i))
4047 (not (string-match "^\.#" (anything-c-basename i))))
4048 (cons (anything-ff-prefix-filename
4049 (propertize disp 'face 'anything-ff-invalid-symlink) t)
4051 ((stringp (car (file-attributes i)))
4052 (cons (anything-ff-prefix-filename
4053 (propertize disp 'face 'anything-ff-symlink) t)
4055 ((eq t (car (file-attributes i)))
4056 (cons (anything-ff-prefix-filename
4057 (propertize disp 'face 'anything-ff-directory) t)
4059 ((file-executable-p i)
4060 (cons (anything-ff-prefix-filename
4061 (propertize disp 'face 'anything-ff-executable) t)
4063 ((file-exists-p i)
4064 (cons (anything-ff-prefix-filename
4065 (propertize disp 'face 'anything-ff-file) t)
4068 (cons (anything-ff-prefix-filename
4069 (propertize disp 'face 'anything-ff-file) nil 'new-file)
4070 i)))))
4072 (defun anything-find-files-action-transformer (actions candidate)
4073 "Action transformer for `anything-c-source-find-files'."
4074 (cond ((with-anything-current-buffer
4075 (eq major-mode 'message-mode))
4076 (append (subseq actions 0 4)
4077 '(("Gnus attach file(s)" . anything-ff-gnus-attach-files))
4078 (subseq actions 4)))
4079 ((string-match (image-file-name-regexp) candidate)
4080 (append (subseq actions 0 4)
4081 '(("Rotate image right `M-r'" . anything-ff-rotate-image-right)
4082 ("Rotate image left `M-l'" . anything-ff-rotate-image-left))
4083 (subseq actions 4)))
4084 ((string-match "\.el$" (anything-aif (anything-marked-candidates)
4085 (car it) candidate))
4086 (append (subseq actions 0 4)
4087 '(("Byte compile lisp file(s) `M-B, C-u to load'"
4088 . anything-find-files-byte-compile)
4089 ("Load File(s) `M-L'" . anything-find-files-load-files))
4090 (subseq actions 4)))
4091 ((and (string-match "\.html?$" candidate)
4092 (file-exists-p candidate))
4093 (append (subseq actions 0 4)
4094 '(("Browse url file" . browse-url-of-file))
4095 (subseq actions 5)))
4096 ((or (string= (file-name-extension candidate) "pdf")
4097 (string= (file-name-extension candidate) "PDF"))
4098 (append (subseq actions 0 4)
4099 '(("Pdfgrep File(s)" . anything-ff-pdfgrep))
4100 (subseq actions 5)))
4101 (t actions)))
4103 (defun anything-ff-gnus-attach-files (candidate)
4104 "Run `gnus-dired-attach' on `anything-marked-candidates' or CANDIDATE."
4105 (let ((flist (anything-marked-candidates)))
4106 (gnus-dired-attach flist)))
4108 (defun anything-ff-rotate-current-image-1 (file &optional num-arg)
4109 "Rotate current image at NUM-ARG degrees.
4110 This is a destructive operation on FILE made by external tool mogrify."
4111 (declare (special image-dired-display-image-buffer))
4112 (setq file (file-truename file)) ; For symlinked images.
4113 ;; When FILE is not an image-file, do nothing.
4114 (when (string-match (image-file-name-regexp) file)
4115 (if (executable-find "mogrify")
4116 (progn
4117 (shell-command (format "mogrify -rotate %s %s"
4118 (or num-arg 90)
4119 (shell-quote-argument file)))
4120 (when (buffer-live-p image-dired-display-image-buffer)
4121 (kill-buffer image-dired-display-image-buffer))
4122 (image-dired-display-image file)
4123 (message nil)
4124 (display-buffer (get-buffer image-dired-display-image-buffer)))
4125 (error "mogrify not found"))))
4127 (defun anything-ff-rotate-image-left (candidate)
4128 "Rotate image file CANDIDATE left.
4129 This affect directly file CANDIDATE."
4130 (anything-ff-rotate-current-image-1 candidate -90))
4132 (defun anything-ff-rotate-image-right (candidate)
4133 "Rotate image file CANDIDATE right.
4134 This affect directly file CANDIDATE."
4135 (anything-ff-rotate-current-image-1 candidate))
4137 (defun anything-ff-rotate-left-persistent ()
4138 "Rotate image left without quitting anything."
4139 (interactive)
4140 (anything-attrset 'image-action1 'anything-ff-rotate-image-left)
4141 (anything-execute-persistent-action 'image-action1))
4143 (defun anything-ff-rotate-right-persistent ()
4144 "Rotate image right without quitting anything."
4145 (interactive)
4146 (anything-attrset 'image-action2 'anything-ff-rotate-image-right)
4147 (anything-execute-persistent-action 'image-action2))
4149 (defun anything-ff-exif-data (candidate)
4150 "Extract exif data from file CANDIDATE using `anything-ff-exif-data-program'."
4151 (if (and anything-ff-exif-data-program
4152 (executable-find anything-ff-exif-data-program))
4153 (shell-command-to-string (format "%s %s %s"
4154 anything-ff-exif-data-program
4155 anything-ff-exif-data-program-args
4156 candidate))
4157 (format "No program %s found to extract exif"
4158 anything-ff-exif-data-program)))
4160 (defun anything-find-files-persistent-action (candidate)
4161 "Open subtree CANDIDATE without quitting anything.
4162 If CANDIDATE is not a directory expand CANDIDATE filename.
4163 If CANDIDATE is alone, open file CANDIDATE filename.
4164 That's mean:
4165 First hit on C-z expand CANDIDATE second hit open file.
4166 If a prefix arg is given or `anything-follow-mode' is on open file."
4167 (let ((follow (buffer-local-value
4168 'anything-follow-mode
4169 (get-buffer-create anything-buffer)))
4170 (new-pattern (anything-get-selection))
4171 (num-lines-buf (with-current-buffer anything-buffer
4172 (count-lines (point-min) (point-max)))))
4173 (flet ((insert-in-minibuffer (fname)
4174 (with-selected-window (minibuffer-window)
4175 (unless follow
4176 (delete-minibuffer-contents)
4177 (set-text-properties 0 (length fname) nil fname)
4178 (insert fname)))))
4179 (cond ((and (string= (anything-ff-set-pattern anything-pattern)
4180 "Invalid tramp file name")
4181 (string-match tramp-file-name-regexp candidate))
4182 ;; First hit insert hostname and
4183 ;; second hit insert ":" and expand.
4184 (if (string= candidate anything-pattern)
4185 (insert-in-minibuffer (concat candidate ":"))
4186 (insert-in-minibuffer candidate)))
4187 (;; A symlink directory, expand it's truename.
4188 (and (file-directory-p candidate) (file-symlink-p candidate))
4189 (insert-in-minibuffer (file-name-as-directory
4190 (file-truename
4191 (expand-file-name candidate)))))
4192 ;; A directory, open it.
4193 ((file-directory-p candidate)
4194 (when (string= (anything-c-basename candidate) "..")
4195 (setq anything-ff-last-expanded anything-ff-default-directory))
4196 (insert-in-minibuffer (file-name-as-directory
4197 (expand-file-name candidate))))
4198 ;; A symlink file, expand to it's true name. (first hit)
4199 ((and (file-symlink-p candidate) (not current-prefix-arg) (not follow))
4200 (insert-in-minibuffer (file-truename candidate)))
4201 ;; A regular file, expand it, (first hit)
4202 ((and (>= num-lines-buf 3) (not current-prefix-arg) (not follow))
4203 (insert-in-minibuffer new-pattern))
4204 ;; An image file and it is the second hit on C-z,
4205 ;; show the file in `image-dired'.
4206 ((string-match (image-file-name-regexp) candidate)
4207 (when (buffer-live-p image-dired-display-image-buffer)
4208 (kill-buffer image-dired-display-image-buffer))
4209 (image-dired-display-image candidate)
4210 (message nil)
4211 (anything-c-switch-to-buffer image-dired-display-image-buffer)
4212 (with-current-buffer image-dired-display-image-buffer
4213 (let ((exif-data (anything-ff-exif-data candidate)))
4214 (image-dired-update-property 'help-echo exif-data))))
4215 ;; Allow browsing archive on avfs fs.
4216 ;; Assume volume is already mounted with mountavfs.
4217 ((and anything-ff-avfs-directory
4218 (string-match
4219 (regexp-quote (expand-file-name anything-ff-avfs-directory))
4220 (file-name-directory candidate))
4221 (anything-ff-file-compressed-p candidate))
4222 (insert-in-minibuffer (concat candidate "#")))
4223 ;; On second hit we open file.
4224 ;; On Third hit we kill it's buffer maybe.
4226 (anything-ff-kill-or-find-buffer-fname candidate))))))
4228 (defun anything-ff-file-compressed-p (candidate)
4229 "Whether CANDIDATE is a compressed file or not."
4230 (member (file-name-extension candidate)
4231 anything-ff-file-compressed-list))
4233 (defun anything-c-insert-file-name-completion-at-point (candidate)
4234 "Insert file name completion at point."
4235 (with-anything-current-buffer
4236 (if buffer-read-only
4237 (error "Error: Buffer `%s' is read-only" (buffer-name))
4238 (let* ((end (point))
4239 (guess (substring-no-properties (thing-at-point 'filename)))
4240 (beg (- (point) (length guess)))
4241 (full-path-p (or (string-match-p (concat "^" (getenv "HOME")) guess)
4242 (string-match-p "^[^\~]" guess))))
4243 (set-text-properties 0 (length candidate) nil candidate)
4244 (if (and guess (not (string= guess ""))
4245 (string-match-p "^~\\|/.*" guess))
4246 (progn
4247 (delete-region beg end)
4248 (insert (if full-path-p
4249 (expand-file-name candidate)
4250 (abbreviate-file-name candidate))))
4251 (error "Aborting completion: No valid file name at point"))))))
4253 (defun* anything-find-files-history (&key (comp-read t))
4254 "The `anything-find-files' history.
4255 Show the first `anything-ff-history-max-length' elements of
4256 `anything-ff-history' in an `anything-comp-read'."
4257 (let ((history (when anything-ff-history
4258 (anything-fast-remove-dups anything-ff-history
4259 :test 'equal))))
4260 (when history
4261 (setq anything-ff-history
4262 (if (>= (length history) anything-ff-history-max-length)
4263 (subseq history 0 anything-ff-history-max-length)
4264 history))
4265 (if comp-read
4266 (anything-comp-read
4267 "Switch to Directory: "
4268 anything-ff-history
4269 :name "Anything Find Files History"
4270 :must-match t)
4271 anything-ff-history))))
4273 (defun anything-find-files-1 (fname &optional preselect)
4274 "Find FNAME with `anything' completion.
4275 Like `find-file' but with `anything' support.
4276 Use it for non--interactive calls of `anything-find-files'."
4277 (when (get-buffer anything-action-buffer)
4278 (kill-buffer anything-action-buffer))
4279 (let ((anything-mp-highlight-delay nil)
4280 ;; Be sure we don't erase the precedent minibuffer if some.
4281 (anything-ff-auto-update-initial-value
4282 (not (minibuffer-window-active-p (minibuffer-window))))
4283 anything-samewindow)
4284 (anything :sources 'anything-c-source-find-files
4285 :input fname
4286 :preselect preselect
4287 :keymap anything-find-files-map
4288 :prompt "Find Files or Url: "
4289 :buffer "*Anything Find Files*")))
4292 (defun anything-find-files-initial-input (&optional input)
4293 "Return INPUT if present, otherwise try to guess it."
4294 (or (and input (expand-file-name input))
4295 (anything-find-files-input
4296 (ffap-guesser)
4297 (thing-at-point 'filename))))
4299 (defun anything-find-files-input (fap tap)
4300 "Default input of `anything-find-files'."
4301 (let* ((def-dir (anything-c-current-directory))
4302 (lib (anything-find-library-at-point))
4303 (url (anything-ff-find-url-at-point))
4304 (file-p (and fap (not (string= fap ""))
4305 (file-exists-p fap)
4306 tap (not (string= tap ""))
4307 (file-exists-p
4308 (file-name-directory (expand-file-name tap def-dir))))))
4309 (cond (lib) ; e.g we are inside a require sexp.
4310 (url) ; String at point is an hyperlink.
4311 (file-p (expand-file-name tap def-dir))
4312 (t (and (not (string= fap "")) fap)))))
4314 (defun anything-c-current-directory ()
4315 "Return current-directory name at point.
4316 Useful in dired buffers when there is inserted subdirs."
4317 (if (eq major-mode 'dired-mode)
4318 (dired-current-directory)
4319 default-directory))
4321 (defun anything-ff-find-url-at-point ()
4322 "Try to find link to an url in text-property at point."
4323 (let* ((he (get-text-property (point) 'help-echo))
4324 (ov (overlays-at (point)))
4325 (ov-he (and ov (overlay-get
4326 (car (overlays-at (point))) 'help-echo)))
4327 (w3m-l (get-text-property (point) 'w3m-href-anchor))
4328 (nt-prop (get-text-property (point) 'nt-link)))
4329 ;; Org link.
4330 (when (and (stringp he) (string-match "^LINK: " he))
4331 (setq he (replace-match "" t t he)))
4332 (loop for i in (list he ov-he w3m-l nt-prop)
4333 thereis (and (stringp i) (string-match ffap-url-regexp i) i))))
4335 (defun anything-find-library-at-point ()
4336 "Try to find library path at point.
4337 Find inside `require' and `declare-function' sexp."
4338 (require 'find-func)
4339 (let* ((beg-sexp (save-excursion (search-backward "(" (point-at-bol) t)))
4340 (end-sexp (save-excursion (search-forward ")" (point-at-eol) t)))
4341 (sexp (and beg-sexp end-sexp
4342 (buffer-substring-no-properties
4343 (1+ beg-sexp) (1- end-sexp)))))
4344 (ignore-errors
4345 (cond ((and sexp (string-match "require \'.+[^)]" sexp))
4346 (find-library-name
4347 (replace-regexp-in-string
4348 "'\\|\)\\|\(" ""
4349 ;; If require use third arg, ignore it,
4350 ;; always use library path found in `load-path'.
4351 (second (split-string (match-string 0 sexp))))))
4352 ((and sexp (string-match-p "^declare-function" sexp))
4353 (find-library-name
4354 (replace-regexp-in-string
4355 "\"\\|ext:" ""
4356 (third (split-string sexp)))))
4357 (t nil)))))
4359 ;;; Anything completion for `write-file'.==> C-x C-w
4360 (defvar anything-c-source-write-file
4361 `((name . "Write File")
4362 (header-name . (lambda (name)
4363 (concat name anything-c-find-files-doc-header)))
4364 ;; It is needed for filenames with capital letters
4365 (disable-shortcuts)
4366 (candidates . anything-find-files-get-candidates)
4367 (filtered-candidate-transformer anything-c-find-files-transformer)
4368 (persistent-action . anything-find-files-persistent-action)
4369 (persistent-help . "Expand Candidate")
4370 (volatile)
4371 (action .
4372 (("Write File" . (lambda (candidate)
4373 (write-file candidate 'confirm)))))))
4375 ;;; Anything completion for `insert-file'.==> C-x i
4376 (defvar anything-c-source-insert-file
4377 `((name . "Insert File")
4378 (header-name . (lambda (name)
4379 (concat name anything-c-find-files-doc-header)))
4380 ;; It is needed for filenames with capital letters
4381 (disable-shortcuts)
4382 (candidates . anything-find-files-get-candidates)
4383 (filtered-candidate-transformer anything-c-find-files-transformer)
4384 (persistent-action . anything-find-files-persistent-action)
4385 (persistent-help . "Expand Candidate")
4386 (volatile)
4387 (action .
4388 (("Insert File" . (lambda (candidate)
4389 (when (y-or-n-p (format "Really insert %s in %s "
4390 candidate anything-current-buffer))
4391 (insert-file-contents candidate))))))))
4393 ;;; Anything completion for copy, rename and (rel)sym/hard/link files from dired.
4394 (defvar anything-c-source-copy-files
4395 `((name . "Copy Files")
4396 (header-name . (lambda (name)
4397 (concat name anything-c-find-files-doc-header)))
4398 ;; It is needed for filenames with capital letters
4399 (disable-shortcuts)
4400 (candidates . anything-find-files-get-candidates)
4401 (filtered-candidate-transformer anything-c-find-files-transformer)
4402 (persistent-action . anything-find-files-persistent-action)
4403 (persistent-help . "Expand Candidate")
4404 (volatile)
4405 (action .
4406 (("Copy File"
4407 . (lambda (candidate)
4408 (anything-dired-action candidate :action 'copy)))
4409 ("Copy and Follow"
4410 . (lambda (candidate)
4411 (anything-dired-action candidate :action 'copy :follow t)))))))
4414 (defvar anything-c-source-rename-files
4415 `((name . "Rename Files")
4416 (header-name . (lambda (name)
4417 (concat name anything-c-find-files-doc-header)))
4418 ;; It is needed for filenames with capital letters
4419 (disable-shortcuts)
4420 (candidates . anything-find-files-get-candidates)
4421 (filtered-candidate-transformer anything-c-find-files-transformer)
4422 (persistent-action . anything-find-files-persistent-action)
4423 (persistent-help . "Expand Candidate")
4424 (volatile)
4425 (action .
4426 (("Rename File"
4427 . (lambda (candidate)
4428 (anything-dired-action candidate :action 'rename)))
4429 ("Rename and Follow"
4430 . (lambda (candidate)
4431 (anything-dired-action candidate :action 'rename :follow t)))))))
4433 (defvar anything-c-source-symlink-files
4434 `((name . "Symlink Files")
4435 (header-name . (lambda (name)
4436 (concat name anything-c-find-files-doc-header)))
4437 ;; It is needed for filenames with capital letters
4438 (disable-shortcuts)
4439 (candidates . anything-find-files-get-candidates)
4440 (filtered-candidate-transformer anything-c-find-files-transformer)
4441 (persistent-action . anything-find-files-persistent-action)
4442 (persistent-help . "Expand Candidate")
4443 (volatile)
4444 (action
4445 . (("Symlink File"
4446 . (lambda (candidate)
4447 (anything-dired-action candidate :action 'symlink)))
4448 ("RelSymlink File"
4449 . (lambda (candidate)
4450 (anything-dired-action candidate :action 'relsymlink)))))))
4453 (defvar anything-c-source-hardlink-files
4454 `((name . "Hardlink Files")
4455 (header-name . (lambda (name)
4456 (concat name anything-c-find-files-doc-header)))
4457 ;; It is needed for filenames with capital letters
4458 (disable-shortcuts)
4459 (candidates . anything-find-files-get-candidates)
4460 (filtered-candidate-transformer anything-c-find-files-transformer)
4461 (persistent-action . anything-find-files-persistent-action)
4462 (persistent-help . "Expand Candidate")
4463 (volatile)
4464 (action
4465 . (("Hardlink File"
4466 . (lambda (candidate)
4467 (anything-dired-action candidate :action 'hardlink)))))))
4469 (defun* anything-dired-action (candidate &key action follow (files (dired-get-marked-files)))
4470 "Copy, rename or symlink file at point or marked files in dired to CANDIDATE.
4471 ACTION is a key that can be one of 'copy, 'rename, 'symlink, 'relsymlink."
4472 (when (get-buffer dired-log-buffer) (kill-buffer dired-log-buffer))
4473 (let ((fn (case action
4474 ('copy 'dired-copy-file)
4475 ('rename 'dired-rename-file)
4476 ('symlink 'make-symbolic-link)
4477 ('relsymlink 'dired-make-relative-symlink)
4478 ('hardlink 'dired-hardlink)))
4479 (marker (case action
4480 ((copy rename) dired-keep-marker-copy)
4481 ('symlink dired-keep-marker-symlink)
4482 ('relsymlink dired-keep-marker-relsymlink)
4483 ('hardlink dired-keep-marker-hardlink)))
4484 (dirflag (and (= (length files) 1)
4485 (file-directory-p (car files))
4486 (not (file-directory-p candidate)))))
4487 (dired-create-files
4488 fn (symbol-name action) files
4489 ;; CANDIDATE is the destination.
4490 (if (file-directory-p candidate)
4491 ;; When CANDIDATE is a directory, build file-name in this directory.
4492 ;; Else we use CANDIDATE.
4493 #'(lambda (from)
4494 (expand-file-name (file-name-nondirectory from) candidate))
4495 #'(lambda (from) candidate))
4496 marker)
4497 (push (file-name-as-directory
4498 (if (file-directory-p candidate)
4499 candidate (file-name-directory candidate)))
4500 anything-ff-history)
4501 (when (and follow (not (get-buffer dired-log-buffer)))
4502 (let ((target (directory-file-name candidate)))
4503 (unwind-protect
4504 (progn
4505 (setq anything-ff-cand-to-mark
4506 (anything-get-dest-fnames-from-list files candidate dirflag))
4507 (if (and dirflag (eq action 'rename))
4508 (anything-find-files-1 (file-name-directory target)
4509 (if anything-ff-transformer-show-only-basename
4510 (anything-c-basename target) target))
4511 (anything-find-files-1 (expand-file-name candidate))))
4512 (setq anything-ff-cand-to-mark nil))))))
4515 (defun anything-c-basename (fname)
4516 "Resolve basename of file or directory named FNAME."
4517 (file-name-nondirectory (directory-file-name fname)))
4519 (defun anything-get-dest-fnames-from-list (flist dest-cand rename-dir-flag)
4520 "Transform filenames of FLIST to abs of DEST-CAND.
4521 If RENAME-DIR-FLAG is non--nil collect the `directory-file-name' of transformed
4522 members of FLIST."
4523 ;; At this point files have been renamed/copied at destination.
4524 ;; That's mean DEST-CAND exists.
4525 (loop
4526 with dest = (expand-file-name dest-cand)
4527 for src in flist
4528 for basename-src = (anything-c-basename src)
4529 for fname = (cond (rename-dir-flag (directory-file-name dest))
4530 ((file-directory-p dest)
4531 (concat (file-name-as-directory dest) basename-src))
4532 (t dest))
4533 when (file-exists-p fname)
4534 collect fname into tmp-list
4535 finally return (sort tmp-list 'string<)))
4537 (defun anything-ff-maybe-mark-candidates ()
4538 "Mark all candidates of list `anything-ff-cand-to-mark'."
4539 (when (and (string= (assoc-default 'name (anything-get-current-source))
4540 (assoc-default 'name anything-c-source-find-files))
4541 anything-ff-cand-to-mark)
4542 (with-anything-window
4543 (while anything-ff-cand-to-mark
4544 (if (string= (car anything-ff-cand-to-mark) (anything-get-selection))
4545 (progn
4546 (anything-make-visible-mark)
4547 (anything-next-line)
4548 (setq anything-ff-cand-to-mark (cdr anything-ff-cand-to-mark)))
4549 (anything-next-line)))
4550 (unless (anything-this-visible-mark)
4551 (anything-prev-visible-mark)))))
4553 (add-hook 'anything-after-update-hook #'anything-ff-maybe-mark-candidates)
4555 (defun* anything-dired-do-action-on-file (&key action)
4556 (let* ((files (dired-get-marked-files))
4557 (len (length files))
4558 (fname (if (> len 1)
4559 (format "* %d Files" len)
4560 (car files)))
4561 (source (case action
4562 ('copy 'anything-c-source-copy-files)
4563 ('rename 'anything-c-source-rename-files)
4564 ('symlink 'anything-c-source-symlink-files)
4565 ('hardlink 'anything-c-source-hardlink-files)))
4566 (prompt-fm (case action
4567 ('copy "Copy %s to: ")
4568 ('rename "Rename %s to: ")
4569 ('symlink "Symlink %s to: ")
4570 ('hardlink "Hardlink %s to: ")))
4571 (buffer (case action
4572 ('copy "*Anything Copy Files*")
4573 ('rename "*Anything Rename Files*")
4574 ('symlink "*Anything Symlink Files*")
4575 ('hardlink "*Anything Hardlink Files*")))
4576 (anything-mp-highlight-delay nil))
4577 (anything :sources source
4578 :input (or (dired-dwim-target-directory)
4579 (expand-file-name (anything-c-current-directory)))
4580 :preselect (dired-get-filename)
4581 :prompt (format prompt-fm fname)
4582 :keymap anything-c-read-file-map
4583 :buffer buffer)))
4585 ;;;###autoload
4586 (define-minor-mode anything-dired-mode ()
4587 "Enable anything completion in Dired functions.
4588 Bindings affected are C, R, S, H.
4589 This is deprecated for Emacs24+ users, use `ac-mode' instead."
4590 :group 'anything-config
4591 :global t
4592 (if anything-dired-mode
4593 (progn
4594 (substitute-key-definition
4595 'dired-do-copy 'anything-dired-copy-file dired-mode-map)
4596 (substitute-key-definition
4597 'dired-do-rename 'anything-dired-rename-file dired-mode-map)
4598 (substitute-key-definition
4599 'dired-do-symlink 'anything-dired-symlink-file dired-mode-map)
4600 (substitute-key-definition
4601 'dired-do-hardlink 'anything-dired-hardlink-file dired-mode-map))
4602 (substitute-key-definition
4603 'anything-dired-copy-file 'dired-do-copy dired-mode-map)
4604 (substitute-key-definition
4605 'anything-dired-rename-file 'dired-do-rename dired-mode-map)
4606 (substitute-key-definition
4607 'anything-dired-symlink-file 'dired-do-symlink dired-mode-map)
4608 (substitute-key-definition
4609 'anything-dired-hardlink-file 'dired-do-hardlink dired-mode-map)))
4611 (defalias 'anything-dired-bindings 'anything-dired-mode)
4613 (defun* anything-c-read-file-name (prompt
4614 &key
4615 (name "Read File Name")
4616 (initial-input (expand-file-name default-directory))
4617 (buffer "*Anything Completions*")
4618 test
4619 (preselect nil)
4620 (history nil)
4621 (marked-candidates nil)
4622 (alistp t)
4623 (persistent-action 'anything-find-files-persistent-action)
4624 (persistent-help "Hit1 Expand Candidate, Hit2 or (C-u) Find file"))
4625 "Anything `read-file-name' emulation.
4626 INITIAL-INPUT is a valid path, TEST is a predicate that take one arg."
4627 (when (get-buffer anything-action-buffer)
4628 (kill-buffer anything-action-buffer))
4629 (let ((anything-mp-highlight-delay nil)
4630 ;; Be sure we don't erase the underlying minibuffer if some.
4631 (anything-ff-auto-update-initial-value
4632 (not (minibuffer-window-active-p (minibuffer-window))))
4633 anything-same-window
4634 (hist (and history (anything-comp-read-get-candidates
4635 history nil nil alistp))))
4636 (flet ((action-fn (candidate)
4637 (if marked-candidates
4638 (anything-marked-candidates)
4639 (identity candidate))))
4640 (or (anything
4641 :sources
4642 `(((name . ,(format "%s History" name))
4643 (header-name . (lambda (name)
4644 (concat name anything-c-find-files-doc-header)))
4645 (disable-shortcuts)
4646 (mode-line . anything-read-file-name-mode-line-string)
4647 (candidates . hist)
4648 (persistent-action . ,persistent-action)
4649 (persistent-help . ,persistent-help)
4650 (action . ,'action-fn))
4651 ((name . ,name)
4652 (header-name . (lambda (name)
4653 (concat name anything-c-find-files-doc-header)))
4654 (init . (lambda ()
4655 (setq anything-ff-auto-update-flag
4656 anything-ff-auto-update-initial-value)))
4657 ;; It is needed for filenames with capital letters
4658 (disable-shortcuts)
4659 (mode-line . anything-read-file-name-mode-line-string)
4660 (candidates . (lambda ()
4661 (let ((seq (anything-find-files-get-candidates)))
4662 (if test
4663 (loop for fname in seq
4664 when (funcall test fname) collect fname)
4665 seq))))
4666 (filtered-candidate-transformer anything-c-find-files-transformer)
4667 (persistent-action . ,persistent-action)
4668 (candidate-number-limit . 9999)
4669 (toggle-auto-update . anything-ff-toggle-auto-update)
4670 (persistent-help . ,persistent-help)
4671 (volatile)
4672 (action . ,'action-fn)))
4673 :input initial-input
4674 :prompt prompt
4675 :keymap anything-c-read-file-map
4676 :resume 'noresume
4677 :buffer buffer
4678 :preselect preselect)
4679 (keyboard-quit)))))
4682 ;;; File Cache
4683 (defvar anything-c-file-cache-initialized-p nil)
4685 (defvar anything-c-file-cache-files nil)
4687 (defvar anything-c-source-file-cache
4688 '((name . "File Cache")
4689 (init
4690 . (lambda ()
4691 (require 'filecache nil t)
4692 (unless anything-c-file-cache-initialized-p
4693 (setq anything-c-file-cache-files
4694 (loop for item in file-cache-alist append
4695 (destructuring-bind (base &rest dirs) item
4696 (loop for dir in dirs collect
4697 (concat dir base)))))
4698 (defadvice file-cache-add-file (after file-cache-list activate)
4699 (add-to-list 'anything-c-file-cache-files (expand-file-name file)))
4700 (setq anything-c-file-cache-initialized-p t))))
4701 (candidates . anything-c-file-cache-files)
4702 (match anything-c-match-on-basename)
4703 (type . file)))
4704 ;; (anything 'anything-c-source-file-cache)
4707 ;;; Locate
4710 ;; NOTE for WINDOZE users:
4711 ;; You have to install Everything with his command line interface here:
4712 ;; http://www.voidtools.com/download.php
4714 (defun anything-locate-1 (&optional localdb init)
4715 "Generic function to run Locate.
4716 if LOCALDB is non--nil search and use a local locate db file.
4717 INIT is a string to use as initial input in prompt.
4718 See `anything-locate-with-db' and `anything-locate'."
4719 (anything-locate-with-db
4720 (and localdb
4721 (anything-c-read-file-name
4722 "LocateDBFiles: "
4723 :marked-candidates t
4724 :preselect anything-locate-db-file-regexp
4725 :test #'(lambda (x)
4726 (if anything-locate-db-file-regexp
4727 ;; Select only locate db files and directories
4728 ;; to allow navigation.
4729 (or (string-match
4730 anything-locate-db-file-regexp x)
4731 (file-directory-p x))
4732 x))))
4733 init))
4734 ;; (anything-locate-1 t)
4736 (defun anything-locate-with-db (&optional db initial-input)
4737 "Run locate -d DB.
4738 If DB is not given or nil use locate without -d option.
4739 Argument DB can be given as a string or list of db files.
4740 Argument INITIAL-INPUT is a string to use as initial-input.
4741 See also `anything-locate'."
4742 (when (and db (stringp db)) (setq db (list db)))
4743 (let ((anything-c-locate-command
4744 (if db
4745 (replace-regexp-in-string
4746 "locate"
4747 (format "locate -d %s"
4748 (mapconcat 'identity
4749 ;; Remove eventually
4750 ;; marked directories by error.
4751 (loop for i in db
4752 unless (file-directory-p i)
4753 collect i) ":"))
4754 anything-c-locate-command)
4755 anything-c-locate-command)))
4756 (anything :sources 'anything-c-source-locate
4757 :buffer "*anything locate*"
4758 :input initial-input
4759 :keymap anything-generic-files-map)))
4760 ;; (anything-locate-with-db "~/locate.db")
4762 (defun anything-c-locate-init ()
4763 "Initialize async locate process for `anything-c-source-locate'."
4764 (setq mode-line-format
4765 '(" " mode-line-buffer-identification " "
4766 (line-number-mode "%l") " "
4767 (:eval (propertize "(Locate Process Running) "
4768 'face '((:foreground "red"))))))
4769 (prog1
4770 (start-process-shell-command "locate-process" nil
4771 (format anything-c-locate-command
4772 anything-pattern))
4773 (set-process-sentinel (get-process "locate-process")
4774 #'(lambda (process event)
4775 (when (string= event "finished\n")
4776 (with-anything-window
4777 (force-mode-line-update nil)
4778 (anything-update-move-first-line)))))))
4780 (defvar anything-c-source-locate
4781 '((name . "Locate")
4782 (candidates . anything-c-locate-init)
4783 (type . file)
4784 (requires-pattern . 3)
4785 (candidate-number-limit . 9999)
4786 (mode-line . anything-generic-file-mode-line-string)
4787 (delayed))
4788 "Find files matching the current input pattern with locate.")
4789 ;; (anything 'anything-c-source-locate)
4791 (defun anything-c-locate-read-file-name (prompt &optional init)
4792 "Search a file with locate and return it's filename.
4793 Use argument PROMPT and INIT for `anything' arguments
4794 prompt and input."
4795 (anything :sources
4796 '((name . "Locate")
4797 (candidates . anything-c-locate-init)
4798 (action . identity)
4799 (requires-pattern . 3)
4800 (candidate-number-limit . 9999)
4801 (mode-line . anything-generic-file-mode-line-string)
4802 (delayed))
4803 :prompt prompt
4804 :input init
4805 :buffer "*anything locate rfn*"))
4809 ;;; Anything Incremental Grep.
4812 ;; Allow to grep incrementally with anything interface.
4813 ;; It allow also to Grep files recursively without using 'find' shell command.
4814 ;; On Windows you will need at least Grep version 2.5.4 of Gnuwin32.
4815 (defvar anything-c-grep-default-command
4816 "grep -d skip %e -niH -e %p %f"
4817 "Default grep format command for `anything-do-grep-1'.
4818 Where:
4819 '%e' format spec is for --exclude or --include grep options.
4820 '%p' format spec is for pattern.
4821 '%f' format spec is for filenames.")
4823 (defvar anything-c-grep-default-recurse-command
4824 "grep -d recurse %e -niH -e %p %f"
4825 "Default recursive grep format command for `anything-do-grep-1'.
4826 See `anything-c-grep-default-command' for format specs.")
4828 (defvar anything-c-default-zgrep-command "zgrep -niH -e %p %f")
4830 (defvar anything-c-rzgrep-cache (make-hash-table :test 'equal))
4832 (defvar anything-c-grep-default-function 'anything-c-grep-init)
4834 (defvar anything-c-grep-debug-command-line nil
4835 "Turn on anything grep command-line debugging when non--nil.")
4837 (defvar anything-c-zgrep-recurse-flag nil)
4839 (defvar anything-c-grep-history nil)
4841 (defvar anything-c-grep-max-length-history 100
4842 "*Max number of elements to save in `anything-c-grep-history'.")
4844 (defun anything-c-grep-prepare-candidates (candidates)
4845 "Prepare filenames and directories CANDIDATES for grep command line."
4846 ;; If one or more candidate is a directory, search in all files
4847 ;; of this candidate (e.g /home/user/directory/*).
4848 ;; If r option is enabled search also in subdidrectories.
4849 ;; We need here to expand wildcards to support crap windows filenames
4850 ;; as grep don't accept quoted wildcards (e.g "dir/*.el").
4851 (if anything-c-zgrep-recurse-flag
4852 (mapconcat 'shell-quote-argument candidates " ")
4853 (loop for i in candidates append
4854 (cond ( ;; Candidate is a directory and we use recursion.
4855 (and (file-directory-p i)
4856 (anything-c-grep-recurse-p))
4857 (list (expand-file-name i)))
4858 ;; Candidate is a directory, search in all files.
4859 ((file-directory-p i)
4860 (file-expand-wildcards
4861 (concat (file-name-as-directory (expand-file-name i)) "*") t))
4862 ;; Candidate is a file or wildcard and we use recursion, use the
4863 ;; current directory instead of candidate.
4864 ((and (or (file-exists-p i) (string-match "\*" i))
4865 (anything-c-grep-recurse-p))
4866 (list (expand-file-name
4867 (directory-file-name ; Needed for windoze.
4868 (file-name-directory (directory-file-name i))))))
4869 ;; Candidate use wildcard.
4870 ((string-match "^\*" (anything-c-basename i))
4871 (file-expand-wildcards i t))
4872 ;; Else should be one or more file.
4873 (t (list i))) into all-files
4874 finally return
4875 (mapconcat 'shell-quote-argument all-files " "))))
4877 (defun anything-c-grep-recurse-p ()
4878 "Check if `anything-do-grep-1' have switched to recursive."
4879 (let ((args (replace-regexp-in-string
4880 "grep" "" anything-c-grep-default-command)))
4881 (string-match-p "r\\|recurse" args)))
4883 (defun anything-c-grep-init (only-files &optional include zgrep)
4884 "Start an asynchronous grep process in ONLY-FILES list."
4885 (let* ((fnargs (anything-c-grep-prepare-candidates
4886 (if (file-remote-p anything-ff-default-directory)
4887 (mapcar #'(lambda (x)
4888 (file-remote-p x 'localname))
4889 only-files)
4890 only-files)))
4891 (ignored-files (mapconcat
4892 #'(lambda (x)
4893 (concat "--exclude=" (shell-quote-argument x)))
4894 grep-find-ignored-files " "))
4895 (ignored-dirs (mapconcat
4896 ;; Need grep version 2.5.4 of Gnuwin32 on windoze.
4897 #'(lambda (x)
4898 (concat "--exclude-dir=" (shell-quote-argument x)))
4899 grep-find-ignored-directories " "))
4900 (exclude (if (anything-c-grep-recurse-p)
4901 (concat (or include ignored-files) " " ignored-dirs)
4902 ignored-files))
4903 (cmd-line (format-spec
4904 anything-c-grep-default-command
4905 (delq nil
4906 (list (unless zgrep (cons ?e exclude))
4907 (cons ?p (shell-quote-argument anything-pattern))
4908 (cons ?f fnargs))))))
4909 (when anything-c-grep-debug-command-line
4910 (with-current-buffer (get-buffer-create "*any grep debug*")
4911 (goto-char (point-max))
4912 (insert (concat ">>> " cmd-line "\n\n"))))
4913 (setq mode-line-format
4914 '(" " mode-line-buffer-identification " "
4915 (line-number-mode "%l") " "
4916 (:eval (when (get-process "grep-process")
4917 (propertize "[Grep Process Running] "
4918 'face 'anything-grep-running)))))
4919 (force-mode-line-update nil)
4920 (prog1
4921 (let ((default-directory anything-ff-default-directory))
4922 (start-file-process-shell-command "grep-process" nil cmd-line))
4923 (message nil)
4924 (set-process-sentinel
4925 (get-process "grep-process")
4926 #'(lambda (process event)
4927 (when (string= event "finished\n")
4928 (with-anything-window
4929 (anything-update-move-first-line)
4930 (setq mode-line-format
4931 '(" " mode-line-buffer-identification " "
4932 (line-number-mode "%l") " "
4933 (:eval (propertize
4934 (format "[Grep Process Finished - (%s results)] "
4935 (let ((nlines (1- (count-lines
4936 (point-min)
4937 (point-max)))))
4938 (if (> nlines 0) nlines 0)))
4939 'face 'anything-grep-finish))))
4940 (force-mode-line-update nil))))))))
4942 (defun anything-c-grep-action (candidate &optional where mark)
4943 "Define a default action for `anything-do-grep' on CANDIDATE.
4944 WHERE can be one of other-window, elscreen, other-frame."
4945 (let* ((split (anything-c-grep-split-line candidate))
4946 (lineno (string-to-number (nth 1 split)))
4947 (loc-fname (car split))
4948 (tramp-method (file-remote-p anything-ff-default-directory 'method))
4949 (tramp-host (file-remote-p anything-ff-default-directory 'host))
4950 (tramp-prefix (concat "/" tramp-method ":" tramp-host ":"))
4951 (fname (if tramp-host
4952 (concat tramp-prefix loc-fname) loc-fname)))
4953 (case where
4954 (other-window (find-file-other-window fname))
4955 (elscreen (anything-elscreen-find-file fname))
4956 (other-frame (find-file-other-frame fname))
4957 (t (find-file fname)))
4958 (anything-goto-line lineno)
4959 (when mark
4960 (set-marker (mark-marker) (point))
4961 (push-mark (point) 'nomsg))
4962 ;; Save history
4963 (unless (or anything-in-persistent-action
4964 (string= anything-pattern ""))
4965 (setq anything-c-grep-history
4966 (cons anything-pattern
4967 (delete anything-pattern anything-c-grep-history)))
4968 (when (> (length anything-c-grep-history)
4969 anything-c-grep-max-length-history)
4970 (setq anything-c-grep-history
4971 (delete (car (last anything-c-grep-history))
4972 anything-c-grep-history))))))
4974 (defun anything-c-grep-other-window (candidate)
4975 "Jump to result in other window from anything grep."
4976 (anything-c-grep-action candidate 'other-window))
4978 (defun anything-c-grep-other-frame (candidate)
4979 "Jump to result in other frame from anything grep."
4980 (anything-c-grep-action candidate 'other-frame))
4982 (defun anything-c-grep-jump-elscreen (candidate)
4983 "Jump to result in elscreen from anything grep."
4984 (anything-c-grep-action candidate 'elscreen))
4986 (defun anything-c-grep-save-results (candidate)
4987 "Save anything grep result in a `grep-mode' buffer."
4988 (let ((buf "*grep*")
4989 new-buf)
4990 (when (get-buffer buf)
4991 (setq new-buf (read-string "GrepBufferName: " buf))
4992 (loop for b in (anything-c-buffer-list)
4993 when (and (string= new-buf b)
4994 (not (y-or-n-p
4995 (format "Buffer `%s' already exists overwrite? "
4996 new-buf))))
4997 do (setq new-buf (read-string "GrepBufferName: " "*grep ")))
4998 (setq buf new-buf))
4999 (with-current-buffer (get-buffer-create buf)
5000 (let ((inhibit-read-only t))
5001 (erase-buffer)
5002 (insert "-*- mode: grep -*-\n\n"
5003 (format "Grep Results for `%s':\n\n" anything-pattern))
5004 (save-excursion
5005 (insert (with-current-buffer anything-buffer
5006 (forward-line 1)
5007 (buffer-substring (point) (point-max))))
5008 (grep-mode))))
5009 (message "Anything Grep Results saved in `%s' buffer" buf)))
5011 (defun anything-c-grep-persistent-action (candidate)
5012 "Persistent action for `anything-do-grep'.
5013 With a prefix arg record CANDIDATE in `mark-ring'."
5014 (if current-prefix-arg
5015 (anything-c-grep-action candidate nil 'mark)
5016 (anything-c-grep-action candidate))
5017 (anything-match-line-color-current-line))
5019 (defun anything-c-grep-guess-extensions (files)
5020 "Try to guess file extensions in FILES list when using grep recurse.
5021 These extensions will be added to command line with --include arg of grep."
5022 (loop
5023 with glob-list = nil
5024 with lst = (if (file-directory-p (car files))
5025 (directory-files
5026 (car files) nil
5027 directory-files-no-dot-files-regexp)
5028 files)
5029 for i in lst
5030 for ext = (file-name-extension i t)
5031 for glob = (and ext (not (string= ext ""))
5032 (concat "*" ext))
5033 unless (or (not glob)
5034 (member glob glob-list)
5035 (member glob grep-find-ignored-files))
5036 collect glob into glob-list
5037 finally return glob-list))
5039 (defun anything-do-grep-1 (only &optional recurse zgrep)
5040 "Launch grep with a list of ONLY files.
5041 When RECURSE is given use -r option of grep and prompt user
5042 to set the --include args of grep.
5043 You can give more than one arg separated by space.
5044 e.g *.el *.py *.tex.
5045 If it's empty --exclude `grep-find-ignored-files' is used instead."
5046 (let* ((anything-compile-source-functions
5047 ;; rule out anything-match-plugin because the input is one regexp.
5048 (delq 'anything-compile-source--match-plugin
5049 (copy-sequence anything-compile-source-functions)))
5050 (exts (anything-c-grep-guess-extensions only))
5051 (globs (and (not zgrep) (mapconcat 'identity exts " ")))
5052 (include-files (and recurse (not zgrep)
5053 (read-string "OnlyExt(*.[ext]): "
5054 globs)))
5055 ;; Set `minibuffer-history' AFTER includes-files
5056 ;; to avoid storing wild-cards here.
5057 (minibuffer-history anything-c-grep-history)
5058 (anything-c-grep-default-command (cond ((and recurse zgrep) anything-c-default-zgrep-command)
5059 (recurse anything-c-grep-default-recurse-command)
5060 (zgrep anything-c-default-zgrep-command)
5061 (t anything-c-grep-default-command)))
5062 ;; Disable match-plugin and use here own highlighting.
5063 (anything-mp-highlight-delay nil))
5064 (when include-files
5065 (setq include-files
5066 (and (not (string= include-files ""))
5067 (mapconcat #'(lambda (x)
5068 (concat "--include=" (shell-quote-argument x)))
5069 (split-string include-files) " "))))
5070 ;; When called as action from an other source e.g *-find-files
5071 ;; we have to kill action buffer.
5072 (when (get-buffer anything-action-buffer)
5073 (kill-buffer anything-action-buffer))
5074 ;; `anything-find-files' haven't already started,
5075 ;; give a default value to `anything-ff-default-directory'.
5076 (setq anything-ff-default-directory (or anything-ff-default-directory
5077 default-directory))
5078 (anything
5079 :sources
5080 `(((name . "Grep (C-c ? Help)")
5081 (candidates
5082 . (lambda ()
5083 (funcall anything-c-grep-default-function only include-files zgrep)))
5084 (filtered-candidate-transformer anything-c-grep-cand-transformer)
5085 (candidate-number-limit . 9999)
5086 (mode-line . anything-grep-mode-line-string)
5087 (action . ,(delq
5089 `(("Find File" . anything-c-grep-action)
5090 ("Find file other frame" . anything-c-grep-other-frame)
5091 ,(and (locate-library "elscreen")
5092 '("Find file in Elscreen"
5093 . anything-c-grep-jump-elscreen))
5094 ("Save results in grep buffer" . anything-c-grep-save-results)
5095 ("Find file other window" . anything-c-grep-other-window))))
5096 (persistent-action . anything-c-grep-persistent-action)
5097 (persistent-help . "Jump to line (`C-u' Record in mark ring)")
5098 (requires-pattern . 3)
5099 (delayed)))
5100 :keymap anything-c-grep-map
5101 :buffer "*anything grep*")))
5103 (defun anything-ff-zgrep-1 (flist recursive)
5104 (unwind-protect
5105 (let* ((def-dir (or anything-ff-default-directory
5106 default-directory))
5107 (only (if recursive
5108 (or (gethash def-dir anything-c-rzgrep-cache)
5109 (puthash
5110 def-dir
5111 (anything-c-walk-directory
5112 def-dir
5113 :directories nil
5114 :path 'full
5115 :match ".*\\(\.gz\\|\.bz\\|\.xz\\|\.lzma\\)$")
5116 anything-c-rzgrep-cache))
5117 flist)))
5118 (when recursive (setq anything-c-zgrep-recurse-flag t))
5119 (anything-do-grep-1 only recursive 'zgrep))
5120 (setq anything-c-zgrep-recurse-flag nil)))
5122 (defun anything-c-grep-split-line (line)
5123 "Split a grep output line."
5124 (let (beg fname lineno str)
5125 ;; Don't print until grep line is valid.
5126 (when (string-match "\\(.*\\)\\(:[0-9]+:\\)\\(.*\\)" line)
5127 (with-temp-buffer
5128 (insert line)
5129 (goto-char (point-min))
5130 (setq beg (point))
5131 (forward-char 2)
5132 (re-search-forward ":" nil t)
5133 (setq fname (buffer-substring-no-properties beg (1- (point))))
5134 (setq beg (point))
5135 (re-search-forward ":" nil t)
5136 (setq lineno (buffer-substring-no-properties beg (1- (point))))
5137 (setq str (buffer-substring-no-properties (point) (point-at-eol))))
5138 (list fname lineno str))))
5140 (defun anything-c-grep-cand-transformer (candidates sources)
5141 "Filtered candidate transformer function for `anything-do-grep'."
5142 (loop for i in candidates
5143 for split = (and i (anything-c-grep-split-line i))
5144 for fname = (car split)
5145 for lineno = (nth 1 split)
5146 for str = (nth 2 split)
5147 when (and fname lineno str)
5148 collect
5149 (cons (concat (propertize (file-name-nondirectory fname)
5150 'face 'anything-grep-file
5151 'help-echo fname) ":"
5152 (propertize lineno 'face 'anything-grep-lineno) ":"
5153 (anything-c-grep-highlight-match str))
5154 i)))
5156 (defun anything-c-grep-highlight-match (str)
5157 "Highlight in string STR all occurences matching `anything-pattern'."
5158 (condition-case nil
5159 (with-temp-buffer
5160 (insert str)
5161 (goto-char (point-min))
5162 (while (and (re-search-forward anything-pattern nil t)
5163 (> (- (match-end 0) (match-beginning 0)) 0))
5164 (add-text-properties
5165 (match-beginning 0) (match-end 0)
5166 '(face anything-grep-match)))
5167 (buffer-string))
5168 (error nil)))
5170 ;; Go to next or precedent file (common to etags and grep).
5171 (defun anything-c-goto-next-or-prec-file (n)
5172 "Go to next or precedent candidate file in anything grep/etags buffers.
5173 If N is positive go forward otherwise go backward."
5174 (with-anything-window
5175 (let* ((current-line-list (split-string
5176 (buffer-substring
5177 (point-at-bol)
5178 (point-at-eol)) ":"))
5179 (current-fname (nth 0 current-line-list))
5180 (fn-b-o-f (if (eq n 1) 'eobp 'bobp)))
5181 (catch 'break
5182 (while (not (funcall fn-b-o-f))
5183 (forward-line n) ; Go forward or backward depending of n value.
5184 (unless (search-forward current-fname (point-at-eol) t)
5185 (anything-mark-current-line)
5186 (throw 'break nil))))
5187 (cond ((and (eq n 1) (eobp))
5188 (re-search-backward ".")
5189 (forward-line 0)
5190 (anything-mark-current-line))
5191 ((and (< n 1) (bobp))
5192 (forward-line 1)
5193 (anything-mark-current-line))))))
5195 ;;;###autoload
5196 (defun anything-c-goto-precedent-file ()
5197 "Go to precedent file in anything grep/etags buffers."
5198 (interactive)
5199 (anything-c-goto-next-or-prec-file -1))
5201 ;;;###autoload
5202 (defun anything-c-goto-next-file ()
5203 "Go to precedent file in anything grep/etags buffers."
5204 (interactive)
5205 (anything-c-goto-next-or-prec-file 1))
5207 ;;;###autoload
5208 (defun anything-c-grep-run-persistent-action ()
5209 "Run grep persistent action from `anything-do-grep-1'."
5210 (interactive)
5211 (anything-attrset 'jump-persistent 'anything-c-grep-persistent-action)
5212 (anything-execute-persistent-action 'jump-persistent))
5214 ;;;###autoload
5215 (defun anything-c-grep-run-default-action ()
5216 "Run grep default action from `anything-do-grep-1'."
5217 (interactive)
5218 (anything-c-quit-and-execute-action 'anything-c-grep-action))
5220 ;;;###autoload
5221 (defun anything-c-grep-run-other-window-action ()
5222 "Run grep goto other window action from `anything-do-grep-1'."
5223 (interactive)
5224 (anything-c-quit-and-execute-action 'anything-c-grep-other-window))
5226 ;;;###autoload
5227 (defun anything-c-grep-run-save-buffer ()
5228 "Run grep save results action from `anything-do-grep-1'."
5229 (interactive)
5230 (anything-c-quit-and-execute-action 'anything-c-grep-save-results))
5232 ;; Grep buffers
5233 (defun anything-c-grep-buffers-1 (candidate &optional zgrep)
5234 "Run grep on all file--buffers or CANDIDATE if it is a file--buffer.
5235 If one of selected buffers is not a file--buffer,
5236 it is ignored and grep will run on all others file--buffers.
5237 If only one candidate is selected and it is not a file--buffer,
5238 switch to this buffer and run `anything-occur'.
5239 If a prefix arg is given run grep on all buffers ignoring non--file-buffers."
5240 (let* ((prefarg (or current-prefix-arg anything-current-prefix-arg))
5241 (cands (if prefarg
5242 (buffer-list)
5243 (anything-marked-candidates)))
5244 (win-conf (current-window-configuration))
5245 ;; Non--fname buffers are ignored.
5246 (bufs (loop for buf in cands
5247 for fname = (buffer-file-name (get-buffer buf))
5248 when fname
5249 collect (expand-file-name fname))))
5250 (if bufs
5251 (if zgrep
5252 (anything-do-grep-1 bufs nil 'zgrep)
5253 (anything-do-grep-1 bufs))
5254 ;; bufs is empty, thats mean we have only CANDIDATE
5255 ;; and it is not a buffer-filename, fallback to occur.
5256 (anything-c-switch-to-buffer candidate)
5257 (when (get-buffer anything-action-buffer)
5258 (kill-buffer anything-action-buffer))
5259 (anything-occur)
5260 (when (eq anything-exit-status 1)
5261 (set-window-configuration win-conf)))))
5263 (defun anything-c-grep-buffers (candidate)
5264 "Action to grep buffers."
5265 (anything-c-grep-buffers-1 candidate))
5267 (defun anything-c-zgrep-buffers (candidate)
5268 "Action to zgrep buffers."
5269 (anything-c-grep-buffers-1 candidate 'zgrep))
5272 ;;; Anything interface for pdfgrep
5273 ;; pdfgrep program <http://pdfgrep.sourceforge.net/>
5274 ;; and a pdf-reader (e.g xpdf) are needed.
5276 (defvar anything-c-pdfgrep-default-command "pdfgrep --color never -niH %s %s")
5277 (defvar anything-c-pdfgrep-default-function 'anything-c-pdfgrep-init)
5278 (defvar anything-c-pdfgrep-debug-command-line nil)
5280 (defun anything-c-pdfgrep-init (only-files)
5281 "Start an asynchronous pdfgrep process in ONLY-FILES list."
5282 (let* ((fnargs (anything-c-grep-prepare-candidates
5283 (if (file-remote-p anything-ff-default-directory)
5284 (mapcar #'(lambda (x)
5285 (file-remote-p x 'localname))
5286 only-files)
5287 only-files)))
5288 (cmd-line (format anything-c-pdfgrep-default-command
5289 anything-pattern
5290 fnargs)))
5291 (when anything-c-pdfgrep-debug-command-line
5292 (with-current-buffer (get-buffer-create "*any pdfgrep debug*")
5293 (goto-char (point-max))
5294 (insert (concat ">>> " cmd-line "\n\n"))))
5295 (setq mode-line-format
5296 '(" " mode-line-buffer-identification " "
5297 (line-number-mode "%l") " "
5298 (:eval (propertize "(Pdfgrep Process Running) "
5299 'face '((:foreground "red"))))))
5300 (prog1
5301 (let ((default-directory anything-ff-default-directory))
5302 (start-file-process-shell-command "pdfgrep-process" nil cmd-line))
5303 (message nil)
5304 (set-process-sentinel
5305 (get-process "pdfgrep-process")
5306 #'(lambda (process event)
5307 (when (string= event "finished\n")
5308 (with-anything-window
5309 (anything-update-move-first-line))
5310 (force-mode-line-update nil)))))))
5313 (defun anything-do-pdfgrep-1 (only)
5314 "Launch pdfgrep with a list of ONLY files."
5315 (unless (executable-find "pdfgrep")
5316 (error "Error: No such program `pdfgrep'."))
5317 (let* ((anything-compile-source-functions
5318 ;; rule out anything-match-plugin because the input is one regexp.
5319 (delq 'anything-compile-source--match-plugin
5320 (copy-sequence anything-compile-source-functions)))
5321 ;; Disable match-plugin and use here own highlighting.
5322 (anything-mp-highlight-delay nil))
5323 ;; When called as action from an other source e.g *-find-files
5324 ;; we have to kill action buffer.
5325 (when (get-buffer anything-action-buffer)
5326 (kill-buffer anything-action-buffer))
5327 ;; If `anything-find-files' haven't already started,
5328 ;; give a default value to `anything-ff-default-directory'.
5329 (setq anything-ff-default-directory (or anything-ff-default-directory
5330 default-directory))
5331 (anything
5332 :sources
5333 `(((name . "PdfGrep")
5334 (candidates
5335 . (lambda ()
5336 (funcall anything-c-pdfgrep-default-function only)))
5337 (filtered-candidate-transformer anything-c-grep-cand-transformer)
5338 (candidate-number-limit . 9999)
5339 (mode-line . anything-pdfgrep-mode-line-string)
5340 (action . anything-c-pdfgrep-action)
5341 (persistent-help . "Jump to PDF Page")
5342 (requires-pattern . 3)
5343 (delayed)))
5344 :keymap anything-c-pdfgrep-map
5345 :buffer "*anything grep*")))
5348 (defun anything-c-pdfgrep-action (candidate)
5349 (let* ((split (anything-c-grep-split-line candidate))
5350 (pageno (nth 1 split))
5351 (fname (car split)))
5352 (start-file-process-shell-command
5353 "pdf-reader" nil
5354 (format-spec anything-c-pdfgrep-default-read-command
5355 (list (cons ?f fname) (cons ?p pageno))))))
5357 (defun anything-do-pdfgrep ()
5358 (interactive)
5359 (let ((only (anything-c-read-file-name
5360 "Search in file(s): "
5361 :marked-candidates t
5362 :test #'(lambda (file)
5363 (or (string= (file-name-extension file) "pdf")
5364 (string= (file-name-extension file) "PDF")
5365 (file-directory-p file)))
5366 :preselect (or (dired-get-filename nil t)
5367 (buffer-file-name (current-buffer)))))
5368 (anything-c-grep-default-function 'anything-c-pdfgrep-init))
5369 (anything-do-pdfgrep-1 only)))
5372 ;; Yank text at point.
5375 ;; Internal
5376 (defvar anything-yank-point nil)
5378 ;;;###autoload
5379 (defun anything-yank-text-at-point ()
5380 "Yank text at point in minibuffer."
5381 (interactive)
5382 (let (input)
5383 (flet ((insert-in-minibuffer (word)
5384 (with-selected-window (minibuffer-window)
5385 (let ((str anything-pattern))
5386 (delete-minibuffer-contents)
5387 (set-text-properties 0 (length word) nil word)
5388 (insert (concat str word))))))
5389 (with-anything-current-buffer
5390 ;; Start to initial point if C-w have never been hit.
5391 (unless anything-yank-point (setq anything-yank-point (point)))
5392 (and anything-yank-point (goto-char anything-yank-point))
5393 (forward-word 1)
5394 (setq input (buffer-substring-no-properties anything-yank-point (point)))
5395 (setq anything-yank-point (point))) ; End of last forward-word
5396 (insert-in-minibuffer input))))
5398 (defun anything-reset-yank-point ()
5399 (setq anything-yank-point nil))
5401 (add-hook 'anything-after-persistent-action-hook 'anything-reset-yank-point)
5402 (add-hook 'anything-cleanup-hook 'anything-reset-yank-point)
5405 ;;; Recentf files
5408 (defvar anything-c-source-recentf
5409 '((name . "Recentf")
5410 (init . (lambda ()
5411 (require 'recentf)
5412 (or recentf-mode (recentf-mode 1))))
5413 (disable-shortcuts) ;; Needed for filenames with capitals letters.
5414 (candidates . recentf-list)
5415 (match anything-c-match-on-basename)
5416 (type . file))
5417 "See (info \"(emacs)File Conveniences\").
5418 Set `recentf-max-saved-items' to a bigger value if default is too small.")
5419 ;; (anything 'anything-c-source-recentf)
5421 ;;; ffap
5422 (eval-when-compile (require 'ffap))
5423 (defvar anything-c-source-ffap-guesser
5424 '((name . "File at point")
5425 (init . (lambda () (require 'ffap)))
5426 (candidates . (lambda ()
5427 (anything-aif
5428 (with-anything-current-buffer
5429 (ffap-guesser))
5430 (list it))))
5431 (type . file)))
5432 ;; (anything 'anything-c-source-ffap-guesser)
5434 ;;; ffap with line number
5435 (defun anything-c-ffap-file-line-at-point ()
5436 "Get (FILENAME . LINENO) at point."
5437 (anything-aif (let (ffap-alist) (ffap-file-at-point))
5438 (save-excursion
5439 (beginning-of-line)
5440 (when (and (search-forward it nil t)
5441 (looking-at ":\\([0-9]+\\)"))
5442 (cons it (string-to-number (match-string 1)))))))
5444 (defvar anything-c-ffap-line-location nil
5445 "(FILENAME . LINENO) used by `anything-c-source-ffap-line'.
5446 It is cleared after jumping line.")
5448 (defun anything-c-ffap-line-candidates ()
5449 (with-anything-current-buffer
5450 (setq anything-c-ffap-line-location (anything-c-ffap-file-line-at-point)))
5451 (when anything-c-ffap-line-location
5452 (destructuring-bind (file . line) anything-c-ffap-line-location
5453 (list (cons (format "%s (line %d)" file line) file)))))
5455 ;;; Goto line after opening file by `anything-c-source-ffap-line'.
5456 (defun anything-c-ffap-line-goto-line ()
5457 (when (car anything-c-ffap-line-location)
5458 (unwind-protect
5459 (ignore-errors
5460 (with-selected-window
5461 (get-buffer-window
5462 (get-file-buffer (car anything-c-ffap-line-location)))
5463 (anything-goto-line (cdr anything-c-ffap-line-location)))))))
5464 (add-hook 'anything-after-action-hook 'anything-c-ffap-line-goto-line)
5465 (add-hook 'anything-after-persistent-action-hook 'anything-c-ffap-line-goto-line)
5467 (defvar anything-c-source-ffap-line
5468 '((name . "File/Lineno at point")
5469 (init . (lambda () (require 'ffap)))
5470 (candidates . anything-c-ffap-line-candidates)
5471 (type . file)))
5472 ;; (anything 'anything-c-source-ffap-line)
5474 ;;; list of files gleaned from every dired buffer
5475 (defun anything-c-files-in-all-dired-candidates ()
5476 (save-excursion
5477 (mapcan
5478 (lambda (dir)
5479 (cond ((listp dir) ;filelist
5480 dir)
5481 ((equal "" (file-name-nondirectory dir)) ;dir
5482 (directory-files dir t))
5483 (t ;wildcard
5484 (file-expand-wildcards dir t))))
5485 (delq nil
5486 (mapcar (lambda (buf)
5487 (set-buffer buf)
5488 (when (eq major-mode 'dired-mode)
5489 (if (consp dired-directory)
5490 (cdr dired-directory) ;filelist
5491 dired-directory))) ;dir or wildcard
5492 (buffer-list))))))
5493 ;; (dired '("~/" "~/.emacs-custom.el" "~/.emacs.bmk"))
5495 (defvar anything-c-source-files-in-all-dired
5496 '((name . "Files in all dired buffer.")
5497 (candidates . anything-c-files-in-all-dired-candidates)
5498 (type . file)))
5499 ;; (anything 'anything-c-source-files-in-all-dired)
5501 (defvar anything-c-source-filelist
5502 '((name . "FileList")
5503 (grep-candidates . anything-c-filelist-file-name)
5504 (candidate-number-limit . 200)
5505 (requires-pattern . 4)
5506 (type . file))
5507 "Source to find files instantly.
5508 See `anything-c-filelist-file-name' docstring for usage.")
5511 ;;;; <info>
5512 ;;; Info pages
5513 (defvar anything-c-info-pages nil
5514 "All info pages on system.
5515 Will be calculated the first time you invoke anything with this
5516 source.")
5518 (defun anything-c-info-pages-init ()
5519 "Collect candidates for initial Info node Top."
5520 (if anything-c-info-pages
5521 anything-c-info-pages
5522 (let ((info-topic-regexp "\\* +\\([^:]+: ([^)]+)[^.]*\\)\\.")
5523 topics)
5524 (require 'info)
5525 (with-temp-buffer
5526 (Info-find-node "dir" "top")
5527 (goto-char (point-min))
5528 (while (re-search-forward info-topic-regexp nil t)
5529 (push (match-string-no-properties 1) topics))
5530 (kill-buffer))
5531 (setq anything-c-info-pages topics))))
5533 (defvar anything-c-source-info-pages
5534 `((name . "Info Pages")
5535 (init . anything-c-info-pages-init)
5536 (candidates . anything-c-info-pages)
5537 (action . (("Show with Info" .(lambda (node-str)
5538 (info (replace-regexp-in-string
5539 "^[^:]+: " "" node-str))))))
5540 (requires-pattern . 2)))
5541 ;; (anything 'anything-c-source-info-pages)
5544 ;; FIXME should be merged in anything.el with `anything-describe-anything-attribute'.
5545 (defun anything-c-describe-attributes (anything-attribute)
5546 "Display the full documentation of ANYTHING-ATTRIBUTE (a symbol).
5547 Same as `anything-describe-anything-attribute' but with anything completion."
5548 (interactive (list (intern
5549 (anything-comp-read
5550 "Describe anything attribute: "
5551 (mapcar 'symbol-name anything-additional-attributes)
5552 :must-match t
5553 :persistent-action
5554 #'(lambda (candidate)
5555 (with-output-to-temp-buffer "*Help*"
5556 (princ (get (intern candidate) 'anything-attrdoc))))))))
5557 (with-output-to-temp-buffer "*Help*"
5558 (princ (get anything-attribute 'anything-attrdoc))))
5561 ;;; Use info-index plug-in.
5564 ;; Note that `name' attribute is not needed since
5565 ;; `anything-c-insert-summary' have been removed.
5566 ;; Info Elisp
5567 (defvar anything-c-source-info-elisp
5568 '((name . "Info index: elisp")
5569 (info-index . "elisp")))
5570 ;; (anything 'anything-c-source-info-elisp)
5572 ;; Info-Common-Lisp
5573 (defvar anything-c-source-info-cl
5574 '((name . "Info index: cl")
5575 (info-index . "cl")))
5576 ;; (anything 'anything-c-source-info-cl)
5578 ;; Info Index org
5579 (defvar anything-c-source-info-org
5580 '((name . "Info index: org")
5581 (info-index . "org")))
5582 ;; (anything 'anything-c-source-info-org)
5584 ;; Info Index gnus
5585 (defvar anything-c-source-info-gnus
5586 '((name . "Info index: Gnus")
5587 (info-index . "gnus")))
5589 ;; Info Index ratpoison
5590 (defvar anything-c-source-info-ratpoison
5591 '((name . "Info index: ratpoison")
5592 (info-index . "ratpoison")))
5593 ;; (anything 'anything-c-source-info-ratpoison)
5595 ;; Info Index zsh
5596 (defvar anything-c-source-info-zsh
5597 '((name . "Info index: zsh")
5598 (info-index . "zsh")))
5599 ;; (anything 'anything-c-source-info-zsh)
5601 ;; Info Index bash
5602 (defvar anything-c-source-info-bash
5603 '((name . "Info index: bash")
5604 (info-index . "bash")))
5605 ;; (anything 'anything-c-source-info-bash)
5607 ;; Info Index coreutils
5608 (defvar anything-c-source-info-coreutils
5609 '((name . "Info index: coreutils")
5610 (info-index . "coreutils")))
5611 ;; (anything 'anything-c-source-info-coreutils)
5613 ;; Info Index fileutils
5614 (defvar anything-c-source-info-fileutils
5615 '((name . "Info index: fileutils")
5616 (info-index . "fileutils")))
5617 ;; (anything 'anything-c-source-info-fileutils)
5619 ;; Info Index find
5620 (defvar anything-c-source-info-find
5621 '((name . "Info index: find")
5622 (info-index . "find")))
5623 ;; (anything 'anything-c-source-info-find)
5625 ;; Info Index sh-utils
5626 (defvar anything-c-source-info-sh-utils
5627 '((name . "Info index: sh-utils")
5628 (info-index . "sh-utils")))
5629 ;; (anything 'anything-c-source-info-sh-utils)
5631 ;; Info Index textutils
5632 (defvar anything-c-source-info-textutils
5633 '((name . "Info index: textutils")
5634 (info-index . "textutils")))
5635 ;; (anything 'anything-c-source-info-textutils)
5637 ;; Info Index libc
5638 (defvar anything-c-source-info-libc
5639 '((name . "Info index: libc")
5640 (info-index . "libc")))
5641 ;; (anything 'anything-c-source-info-libc)
5643 ;; Info Index make
5644 (defvar anything-c-source-info-make
5645 '((name . "Info index: make")
5646 (info-index . "make")))
5647 ;; (anything 'anything-c-source-info-make)
5649 ;; Info Index automake
5650 (defvar anything-c-source-info-automake
5651 '((name . "Info index: automake")
5652 (info-index . "automake")))
5653 ;; (anything 'anything-c-source-info-automake)
5655 ;; Info Index autoconf
5656 (defvar anything-c-source-info-autoconf
5657 '((name . "Info index: autoconf")
5658 (info-index . "autoconf")))
5659 ;; (anything 'anything-c-source-info-autoconf)
5661 ;; Info Index emacs-lisp-intro
5662 (defvar anything-c-source-info-emacs-lisp-intro
5663 '((name . "Info index: emacs-lisp-intro")
5664 (info-index . "emacs-lisp-intro")))
5665 ;; (anything 'anything-c-source-info-emacs-lisp-intro)
5667 ;; Info Index emacs
5668 (defvar anything-c-source-info-emacs
5669 '((name . "Info index: emacs")
5670 (info-index . "emacs")))
5671 ;; (anything 'anything-c-source-info-emacs)
5673 ;; Info Index elib
5674 (defvar anything-c-source-info-elib
5675 '((name . "Info index: elib")
5676 (info-index . "elib")))
5677 ;; (anything 'anything-c-source-info-elib)
5679 ;; Info Index eieio
5680 (defvar anything-c-source-info-eieio
5681 '((name . "Info index: eieio")
5682 (info-index . "eieio")))
5683 ;; (anything 'anything-c-source-info-eieio)
5685 ;; Info Index gauche-refe
5686 (defvar anything-c-source-info-gauche-refe
5687 '((name . "Info index: gauche")
5688 (info-index . "gauche-refe")))
5689 ;; (anything 'anything-c-source-info-gauche-refe)
5691 ;; Info Index guile
5692 (defvar anything-c-source-info-guile
5693 '((name . "Info index: guile")
5694 (info-index . "guile")))
5695 ;; (anything 'anything-c-source-info-guile)
5697 ;; Info Index guile-tut
5698 (defvar anything-c-source-info-guile-tut
5699 '((name . "Info index: guile-tut")
5700 (info-index . "guile-tut")))
5701 ;; (anything 'anything-c-source-info-guile-tut)
5703 ;; Info Index goops
5704 (defvar anything-c-source-info-goops
5705 '((name . "Info index: goops")
5706 (info-index . "goops")))
5707 ;; (anything 'anything-c-source-info-goops)
5709 ;; Info Index screen
5710 (defvar anything-c-source-info-screen
5711 '((name . "Info index: screen")
5712 (info-index . "screen")
5713 (index-nodes "Concept Index" "Command Index" "Keystroke Index")))
5714 ;; (anything 'anything-c-source-info-screen)
5716 ;; Info Index latex
5717 (defvar anything-c-source-info-latex
5718 '((name . "Info index: latex")
5719 (info-index . "latex")))
5720 ;; (anything 'anything-c-source-info-latex)
5722 ;; Info Index gawk
5723 (defvar anything-c-source-info-gawk
5724 '((name . "Info index: gawk")
5725 (info-index . "gawk")))
5726 ;; (anything 'anything-c-source-info-gawk)
5728 ;; Info Index sed
5729 (defvar anything-c-source-info-sed
5730 '((name . "Info index: sed")
5731 (info-index . "sed")))
5732 ;; (anything 'anything-c-source-info-sed)
5734 ;; Info Index m4
5735 (defvar anything-c-source-info-m4
5736 '((name . "Info index: m4")
5737 (info-index . "m4")))
5738 ;; (anything 'anything-c-source-info-m4)
5740 ;; Info Index wget
5741 (defvar anything-c-source-info-wget
5742 '((name . "Info index: wget")
5743 (info-index . "wget")))
5744 ;; (anything 'anything-c-source-info-wget)
5746 ;; Info Index binutils
5747 (defvar anything-c-source-info-binutils
5748 '((name . "Info index: binutils")
5749 (info-index . "binutils")))
5750 ;; (anything 'anything-c-source-info-binutils)
5752 ;; Info Index as
5753 (defvar anything-c-source-info-as
5754 '((name . "Info index: as")
5755 (info-index . "as")))
5756 ;; (anything 'anything-c-source-info-as)
5758 ;; Info Index bfd
5759 (defvar anything-c-source-info-bfd
5760 '((name . "Info index: bfd")
5761 (info-index . "bfd")))
5762 ;; (anything 'anything-c-source-info-bfd)
5764 ;; Info Index gprof
5765 (defvar anything-c-source-info-gprof
5766 '((name . "Info index: gprof")
5767 (info-index . "gprof")))
5768 ;; (anything 'anything-c-source-info-gprof)
5770 ;; Info Index ld
5771 (defvar anything-c-source-info-ld
5772 '((name . "Info index: ld")
5773 (info-index . "ld")))
5774 ;; (anything 'anything-c-source-info-ld)
5776 ;; Info Index diff
5777 (defvar anything-c-source-info-diff
5778 '((name . "Info index: diff")
5779 (info-index . "diff")))
5780 ;; (anything 'anything-c-source-info-diff)
5782 ;; Info Index flex
5783 (defvar anything-c-source-info-flex
5784 '((name . "Info index: flex")
5785 (info-index . "flex")))
5786 ;; (anything 'anything-c-source-info-flex)
5788 ;; Info Index grep
5789 (defvar anything-c-source-info-grep
5790 '((name . "Info index: grep")
5791 (info-index . "grep")))
5792 ;; (anything 'anything-c-source-info-grep)
5794 ;; Info Index gzip
5795 (defvar anything-c-source-info-gzip
5796 '((name . "Info index: gzip")
5797 (info-index . "gzip")))
5798 ;; (anything 'anything-c-source-info-gzip)
5800 ;; Info Index libtool
5801 (defvar anything-c-source-info-libtool
5802 '((name . "Info index: libtool")
5803 (info-index . "libtool")))
5804 ;; (anything 'anything-c-source-info-libtool)
5806 ;; Info Index texinfo
5807 (defvar anything-c-source-info-texinfo
5808 '((name . "Info index: texinfo")
5809 (info-index . "texinfo")))
5810 ;; (anything 'anything-c-source-info-texinfo)
5812 ;; Info Index info
5813 (defvar anything-c-source-info-info
5814 '((name . "Info index: info")
5815 (info-index . "info")))
5816 ;; (anything 'anything-c-source-info-info)
5818 ;; Info Index gdb
5819 (defvar anything-c-source-info-gdb
5820 '((name . "Info index: gdb")
5821 (info-index . "gdb")))
5822 ;; (anything 'anything-c-source-info-gdb)
5824 ;; Info Index stabs
5825 (defvar anything-c-source-info-stabs
5826 '((name . "Info index: stabs")
5827 (info-index . "stabs")))
5828 ;; (anything 'anything-c-source-info-stabs)
5830 ;; Info Index cvsbook
5831 (defvar anything-c-source-info-cvsbook
5832 '((name . "Info index: cvsbook")
5833 (info-index . "cvsbook")))
5834 ;; (anything 'anything-c-source-info-cvsbook)
5836 ;; Info Index cvs
5837 (defvar anything-c-source-info-cvs
5838 '((name . "Info index: cvs")
5839 (info-index . "cvs")))
5840 ;; (anything 'anything-c-source-info-cvs)
5842 ;; Info Index bison
5843 (defvar anything-c-source-info-bison
5844 '((name . "Info index: bison")
5845 (info-index . "bison")))
5846 ;; (anything 'anything-c-source-info-bison)
5848 ;; Info Index id-utils
5849 (defvar anything-c-source-info-id-utils
5850 '((name . "Info index: id-utils")
5851 (info-index . "id-utils")))
5852 ;; (anything 'anything-c-source-info-id-utils)
5854 ;; Info Index global
5855 (defvar anything-c-source-info-global
5856 '((name . "Info index: global")
5857 (info-index . "global")))
5858 ;; (anything 'anything-c-source-info-global)
5861 ;;; Man and woman UI
5864 (defvar anything-c-man-pages nil
5865 "All man pages on system.
5866 Will be calculated the first time you invoke anything with this
5867 source.")
5869 (defun anything-c-man-default-action (candidate)
5870 "Default action for jumping to a woman or man page from anything."
5871 (let ((wfiles (woman-file-name-all-completions candidate)))
5872 (condition-case err
5873 (if (> (length wfiles) 1)
5874 (woman-find-file
5875 (anything-comp-read
5876 "ManFile: " wfiles :must-match t))
5877 (woman candidate))
5878 ;; If woman is unable to format correctly
5879 ;; use man instead.
5880 (error (kill-buffer) ; Kill woman buffer.
5881 (let ((Man-notify-method 'meek))
5882 (Man-getpage-in-background candidate))))))
5884 (defvar anything-c-source-man-pages
5885 `((name . "Manual Pages")
5886 (candidates . (lambda ()
5887 (if anything-c-man-pages
5888 anything-c-man-pages
5889 ;; XEmacs doesn't have a woman :)
5890 (setq anything-c-man-pages
5891 (ignore-errors
5892 (require 'woman)
5893 (woman-file-name "")
5894 (sort (mapcar 'car woman-topic-all-completions)
5895 'string-lessp))))))
5896 (action ("Show with Woman" . anything-c-man-default-action))
5897 ;; Woman does not work OS X
5898 ;; http://xahlee.org/emacs/modernization_man_page.html
5899 (action-transformer . (lambda (actions candidate)
5900 (if (eq system-type 'darwin)
5901 '(("Show with Man" . man))
5902 actions)))
5903 (requires-pattern . 2)))
5904 ;; (anything 'anything-c-source-man-pages)
5907 ;;;; <Command>
5908 ;;; Anything M-x - Enhanced M-x UI
5911 ;; Another replacement of `M-x' that act exactly like the
5912 ;; vanilla Emacs one, no problem of windows configuration, prefix args
5913 ;; can be passed before calling `M-x' (e.g C-u M-x..) but also during
5914 ;; anything invocation.
5915 ;; Documentation of commands available without quitting,
5916 ;; Show keybindings of commands.
5917 ;; Show history.
5918 (defvar anything-M-x-input-history nil)
5920 (defun* anything-M-x-get-major-mode-command-alist (mode-map)
5921 "Return alist of MODE-MAP."
5922 (loop for key being the key-seqs of mode-map using (key-bindings com)
5923 for str-key = (key-description key)
5924 for ismenu = (string-match "<menu-bar>" str-key)
5925 unless ismenu collect (cons str-key com)))
5927 (defun anything-get-mode-map-from-mode (mode)
5928 "Guess the mode-map name according to MODE.
5929 Some modes don't use conventional mode-map name
5930 so we need to guess mode-map name. e.g python-mode ==> py-mode-map.
5931 Return nil if no mode-map found."
5932 (loop
5933 ;; Start with a conventional mode-map name.
5934 with mode-map = (intern-soft (format "%s-map" mode))
5935 with mode-string = (symbol-name mode)
5936 with mode-name = (replace-regexp-in-string "-mode" "" mode-string)
5937 while (not mode-map)
5938 for count downfrom (length mode-name)
5939 ;; Return when no result after parsing entire string.
5940 when (eq count 0) return nil
5941 for sub-name = (substring mode-name 0 count)
5942 do (setq mode-map (intern-soft (format "%s-map" (concat sub-name "-mode"))))
5943 finally return mode-map))
5945 (defun anything-M-x-current-mode-map-alist ()
5946 "Return mode-map alist of current `major-mode'."
5947 (let ((map (anything-get-mode-map-from-mode major-mode)))
5948 (when (and map (boundp map))
5949 (anything-M-x-get-major-mode-command-alist (symbol-value map)))))
5952 (defun anything-M-x-transformer (candidates sources)
5953 "filtered-candidate-transformer to show bindings in emacs commands.
5954 Show global bindings and local bindings according to current `major-mode'."
5955 (with-anything-current-buffer
5956 (loop
5957 with local-map = (anything-M-x-current-mode-map-alist)
5958 for cand in candidates
5959 for local-key = (car (rassq cand local-map))
5960 for key = (substitute-command-keys (format "\\[%s]" cand))
5961 collect
5962 (cons (cond ((and (string-match "^M-x" key) local-key)
5963 (format "%s (%s)"
5964 cand (propertize
5965 local-key
5966 'face 'anything-M-x-key-face)))
5967 ((string-match "^M-x" key) cand)
5968 (t (format "%s (%s)"
5969 cand (propertize
5971 'face 'anything-M-x-key-face))))
5972 cand) into ls
5973 finally return
5974 (sort ls #'(lambda (x y) (string-lessp (car x) (car y)))))))
5977 ;;; Complex command history
5980 (defvar anything-c-source-complex-command-history
5981 '((name . "Complex Command History")
5982 (candidates . (lambda () (mapcar 'prin1-to-string command-history)))
5983 (type . sexp)))
5984 ;; (anything 'anything-c-source-complex-command-history)
5986 ;;; M-x history (not related to `anything-M-x')
5989 (defvar anything-c-source-extended-command-history
5990 '((name . "Emacs Commands History")
5991 (candidates
5992 . (lambda ()
5993 (anything-fast-remove-dups extended-command-history :test 'equal)))
5994 (type . command)))
5995 ;; (anything 'anything-c-source-extended-command-history)
5997 ;;; Emacs commands (Basic source for emacs commands)
6000 (defvar anything-c-source-emacs-commands
6001 '((name . "Emacs Commands")
6002 (candidates . (lambda ()
6003 (let (commands)
6004 (mapatoms (lambda (a)
6005 (if (commandp a)
6006 (push (symbol-name a)
6007 commands))))
6008 (sort commands 'string-lessp))))
6009 (type . command)
6010 (requires-pattern . 2))
6011 "Source for completing and invoking Emacs commands.
6012 A command is a function with interactive spec that can
6013 be invoked with `M-x'.
6015 To get non-interactive functions listed, use
6016 `anything-c-source-emacs-functions'.")
6017 ;; (anything 'anything-c-source-emacs-commands)
6020 ;;;; <Function>
6021 ;;; Emacs functions
6024 (defvar anything-c-source-emacs-functions
6025 '((name . "Emacs Functions")
6026 (candidates . (lambda ()
6027 (let (commands)
6028 (mapatoms (lambda (a)
6029 (if (functionp a)
6030 (push (symbol-name a) commands))))
6031 (sort commands 'string-lessp))))
6032 (type . function)
6033 (requires-pattern . 2))
6034 "Source for completing Emacs functions.")
6035 ;; (anything 'anything-c-source-emacs-functions)
6037 ;;; With abbrev expansion
6038 ;;; Similar to my exec-abbrev-cmd.el
6039 ;;; See http://www.tsdh.de/cgi-bin/wiki.pl/exec-abbrev-cmd.el
6040 (defvar anything-c-function-abbrev-regexp nil
6041 "The regexp for `anything-c-source-emacs-functions-with-abbrevs'.
6042 Regexp built from the current `anything-pattern' interpreting it
6043 as abbreviation.
6044 Only for internal use.")
6046 (defun anything-c-match-function-by-abbrev (candidate)
6047 "Return non-nil if `anything-pattern' is an abbreviation of the function CANDIDATE.
6049 Abbreviations are made by taking the first character from each
6050 word in the function's name, e.g. \"bb\" is an abbrev for
6051 `bury-buffer', \"stb\" is an abbrev for `anything-c-switch-to-buffer'."
6052 (string-match anything-c-function-abbrev-regexp candidate))
6054 (defvar anything-c-source-emacs-functions-with-abbrevs
6055 (append anything-c-source-emacs-functions
6056 '((match anything-c-match-function-by-abbrev
6057 anything-c-string-match))
6058 '((init
6059 . (lambda ()
6060 (defadvice anything-update
6061 (before anything-c-update-function-abbrev-regexp activate)
6062 (let ((char-list (append anything-pattern nil))
6063 (str "^"))
6064 (dolist (c char-list)
6065 (setq str (concat str (list c) "[^-]*-")))
6066 (setq str (concat (substring str 0 (1- (length str))) "$"))
6067 (setq anything-c-function-abbrev-regexp str))))))))
6068 ;; (anything 'anything-c-source-emacs-functions-with-abbrevs)
6070 (defvar anything-c-source-advice
6071 '((name . "Function Advice")
6072 (candidates . anything-c-advice-candidates)
6073 (action ("Toggle Enable/Disable" . anything-c-advice-toggle))
6074 (persistent-action . anything-c-advice-persistent-action)
6075 (multiline)
6076 (persistent-help . "Describe function / C-u C-z: Toggle advice")))
6077 ;; (anything 'anything-c-source-advice)
6078 ;; (let ((debug-on-signal t))(anything 'anything-c-source-advice))
6079 ;; (testadvice)
6081 (defun anything-c-advice-candidates ()
6082 (require 'advice)
6083 (loop for (fname) in ad-advised-functions
6084 for function = (intern fname)
6085 append
6086 (loop for class in ad-advice-classes append
6087 (loop for advice in (ad-get-advice-info-field function class)
6088 for enabled = (ad-advice-enabled advice)
6089 collect
6090 (cons (format
6091 "%s %s %s"
6092 (if enabled "Enabled " "Disabled")
6093 (propertize fname 'face 'font-lock-function-name-face)
6094 (ad-make-single-advice-docstring advice class nil))
6095 (list function class advice))))))
6097 (defun anything-c-advice-persistent-action (func-class-advice)
6098 (if current-prefix-arg
6099 (anything-c-advice-toggle func-class-advice)
6100 (describe-function (car func-class-advice))))
6102 (defun anything-c-advice-toggle (func-class-advice)
6103 (destructuring-bind (function class advice) func-class-advice
6104 (cond ((ad-advice-enabled advice)
6105 (ad-advice-set-enabled advice nil)
6106 (message "Disabled"))
6107 (t ;disabled
6108 (ad-advice-set-enabled advice t)
6109 (message "Enabled")))
6110 (ad-activate function)
6111 (and anything-in-persistent-action
6112 (anything-c-advice-update-current-display-string))))
6114 (defun anything-c-advice-update-current-display-string ()
6115 (anything-edit-current-selection
6116 (let ((newword (cond ((looking-at "Disabled") "Enabled")
6117 ((looking-at "Enabled") "Disabled")))
6118 realvalue)
6119 (when newword
6120 (delete-region (point) (progn (forward-word 1) (point)))
6121 (insert newword)))))
6124 ;;;; <Variable>
6125 ;;; Emacs variables
6128 (defvar anything-c-source-emacs-variables
6129 '((name . "Emacs Variables")
6130 (candidates . (lambda ()
6131 (sort (all-completions "" obarray 'boundp) 'string-lessp)))
6132 (type . variable)
6133 (requires-pattern . 2))
6134 "Source for completing Emacs variables.")
6135 ;; (anything 'anything-c-source-emacs-variables)
6138 ;;; LaCarte
6139 (defvar anything-c-source-lacarte
6140 '((name . "Lacarte")
6141 (init . (lambda () (require 'lacarte )))
6142 (candidates . (lambda () (delete '(nil) (lacarte-get-overall-menu-item-alist))))
6143 (candidate-number-limit . 9999)
6144 (action . anything-c-call-interactively))
6145 "Needs lacarte.el.
6147 http://www.emacswiki.org/cgi-bin/wiki/download/lacarte.el")
6148 ;; (anything 'anything-c-source-lacarte)
6151 ;;; Bookmarks
6154 ;; Bind some faces for bookmarks.
6155 (defvar anything-c-bookmarks-face1 'anything-ff-directory)
6156 (defvar anything-c-bookmarks-face2 'anything-ff-file)
6157 (defvar anything-c-bookmarks-face3 'anything-bookmarks-su-face)
6159 (eval-when-compile (require 'bookmark))
6160 (defvar anything-c-source-bookmarks
6161 '((name . "Bookmarks")
6162 (init . (lambda ()
6163 (require 'bookmark)))
6164 (candidates . bookmark-all-names)
6165 (type . bookmark))
6166 "See (info \"(emacs)Bookmarks\").")
6167 ;; (anything 'anything-c-source-bookmarks)
6169 ;;; bookmark-set
6170 (defvar anything-c-source-bookmark-set
6171 '((name . "Set Bookmark")
6172 (dummy)
6173 (action . bookmark-set))
6174 "See (info \"(emacs)Bookmarks\").")
6175 ;; (anything 'anything-c-source-bookmark-set)
6177 ;;; Visible Bookmarks
6178 ;; (install-elisp "http://cvs.savannah.gnu.org/viewvc/*checkout*/bm/bm/bm.el")
6181 ;; http://d.hatena.ne.jp/grandVin/20080911/1221114327
6182 (defvar anything-c-source-bm
6183 '((name . "Visible Bookmarks")
6184 (init . anything-c-bm-init)
6185 (candidates-in-buffer)
6186 (type . line))
6187 "Needs bm.el.
6189 http://www.nongnu.org/bm/")
6191 (defun anything-c-bm-init ()
6192 "Init function for `anything-c-source-bm'."
6193 (when (require 'bm nil t)
6194 (with-no-warnings
6195 (let ((bookmarks (bm-lists))
6196 (buf (anything-candidate-buffer 'global)))
6197 (dolist (bm (sort* (append (car bookmarks) (cdr bookmarks))
6198 '< :key 'overlay-start))
6199 (let ((start (overlay-start bm))
6200 (end (overlay-end bm))
6201 (annotation (or (overlay-get bm 'annotation) "")))
6202 (unless (< (- end start) 1) ; org => (if (< (- end start) 2)
6203 (let ((str (format "%5d: [%s]: %s\n"
6204 (line-number-at-pos start)
6205 annotation
6206 (buffer-substring start (1- end)))))
6207 (with-current-buffer buf (insert str))))))))))
6209 ;;; Special bookmarks
6210 (defvar anything-c-source-bookmarks-ssh
6211 '((name . "Bookmarks-ssh")
6212 (init . (lambda ()
6213 (require 'bookmark)))
6214 (candidates . (lambda () (anything-c-collect-bookmarks :ssh t)))
6215 (type . bookmark))
6216 "See (info \"(emacs)Bookmarks\").")
6217 ;; (anything 'anything-c-source-bookmarks-ssh)
6219 (defvar anything-c-source-bookmarks-su
6220 '((name . "Bookmarks-root")
6221 (init . (lambda ()
6222 (require 'bookmark)))
6223 (candidates . (lambda () (anything-c-collect-bookmarks :su t)))
6224 (filtered-candidate-transformer anything-c-highlight-bookmark-su)
6226 (type . bookmark))
6227 "See (info \"(emacs)Bookmarks\").")
6228 ;; (anything 'anything-c-source-bookmarks-su)
6230 (defvar anything-c-source-bookmarks-local
6231 '((name . "Bookmarks-Local")
6232 (init . (lambda ()
6233 (require 'bookmark)))
6234 (candidates . (lambda () (anything-c-collect-bookmarks :local t)))
6235 (filtered-candidate-transformer
6236 anything-c-adaptive-sort
6237 anything-c-highlight-bookmark)
6238 (type . bookmark))
6239 "See (info \"(emacs)Bookmarks\").")
6240 ;; (anything 'anything-c-source-bookmarks-local)
6242 (defun* anything-c-collect-bookmarks (&key local su sudo ssh)
6243 (let* ((lis-all (bookmark-all-names))
6244 (lis-loc (cond (local (loop for i in lis-all
6245 unless (string-match "^(ssh)\\|^(su)" i)
6246 collect i))
6247 (su (loop for i in lis-all
6248 when (string-match "^(su)" i)
6249 collect i))
6250 (sudo (loop for i in lis-all
6251 when (string-match "^(sudo)" i)
6252 collect i))
6253 (ssh (loop for i in lis-all
6254 when (string-match "^(ssh)" i)
6255 collect i)))))
6256 (sort lis-loc 'string-lessp)))
6258 (defun anything-c-bookmark-root-logged-p ()
6259 (catch 'break
6260 (dolist (i (mapcar #'buffer-name (buffer-list)))
6261 (when (string-match (format "*tramp/%s ." anything-su-or-sudo) i)
6262 (throw 'break t)))))
6264 (defun anything-c-highlight-bookmark-su (files source)
6265 (if (anything-c-bookmark-root-logged-p)
6266 (anything-c-highlight-bookmark files source)
6267 (anything-c-highlight-not-logged files source)))
6269 (defun anything-c-highlight-not-logged (files source)
6270 (loop for i in files
6271 collect (propertize i 'face anything-c-bookmarks-face3)))
6273 (defun anything-c-highlight-bookmark (bookmarks source)
6274 "Used as `candidate-transformer' to colorize bookmarks.
6275 Work both with standard Emacs bookmarks and bookmark-extensions.el."
6276 (loop for i in bookmarks
6277 for isfile = (bookmark-get-filename i)
6278 for bufp = (and (fboundp 'bmkext-get-buffer-name)
6279 (bmkext-get-buffer-name i))
6280 for handlerp = (and (fboundp 'bookmark-get-handler)
6281 (bookmark-get-handler i))
6282 for isw3m = (and (fboundp 'bmkext-w3m-bookmark-p)
6283 (bmkext-w3m-bookmark-p i))
6284 for isgnus = (and (fboundp 'bmkext-gnus-bookmark-p)
6285 (bmkext-gnus-bookmark-p i))
6286 for isman = (and (fboundp 'bmkext-man-bookmark-p) ; Man
6287 (bmkext-man-bookmark-p i))
6288 for iswoman = (and (fboundp 'bmkext-woman-bookmark-p) ; Woman
6289 (bmkext-woman-bookmark-p i))
6290 for handlerp = (bookmark-get-handler i)
6291 for isannotation = (bookmark-get-annotation i)
6292 for isabook = (string= (bookmark-prop-get i 'type) "addressbook")
6293 for isinfo = (eq handlerp 'Info-bookmark-jump)
6294 ;; Add a * if bookmark have annotation
6295 if (and isannotation (not (string-equal isannotation "")))
6296 do (setq i (concat "*" i))
6297 collect (cond (;; info buffers
6298 isinfo
6299 (propertize i 'face 'anything-bmkext-info 'help-echo isfile))
6300 (;; w3m buffers
6301 isw3m
6302 (propertize i 'face 'anything-bmkext-w3m 'help-echo isfile))
6303 (;; gnus buffers
6304 isgnus
6305 (propertize i 'face 'anything-bmkext-gnus 'help-echo isfile))
6306 (;; Man Woman
6307 (or iswoman isman)
6308 (propertize i 'face 'anything-bmkext-man 'help-echo isfile))
6309 (;; Addressbook
6310 isabook
6311 (propertize i 'face '((:foreground "Tomato"))))
6312 (;; directories
6313 (and isfile (file-directory-p isfile))
6314 (propertize i 'face anything-c-bookmarks-face1 'help-echo isfile))
6315 (;; regular files
6317 (propertize i 'face 'anything-bmkext-file 'help-echo isfile)))))
6321 ;;; Sources to filter bookmark-extensions bookmarks.
6324 ;; Dependency: http://mercurial.intuxication.org/hg/emacs-bookmark-extension
6325 ;; If you want to enable google-maps in addressbook you will need
6326 ;; Julien Danjou google-maps-el package available here:
6327 ;; http://julien.danjou.info/google-maps-el.html
6329 (defun anything-c-bmkext-filter-setup-alist (fn &rest args)
6330 "Return a filtered `bookmark-alist' sorted alphabetically."
6331 (loop
6332 with alist = (if args
6333 (apply #'(lambda (x) (funcall fn x)) args)
6334 (funcall fn))
6335 for i in alist
6336 for b = (car i)
6337 collect b into sa
6338 finally return (sort sa 'string-lessp)))
6340 ;;; Addressbook.
6343 (defvar anything-c-source-bmkext-addressbook
6344 '((name . "Bookmark Addressbook")
6345 (init . (lambda ()
6346 (require 'bookmark-extensions)
6347 (bookmark-maybe-load-default-file)))
6348 (candidates . anything-c-bmkext-addressbook-setup-alist)
6349 (persistent-action
6350 . (lambda (candidate)
6351 (let ((bmk (anything-bookmark-get-bookmark-from-name
6352 candidate)))
6353 (bookmark--jump-via bmk 'pop-to-buffer))))
6354 (persistent-help . "Show contact - Prefix with C-u to append")
6355 (filtered-candidate-transformer
6356 anything-c-adaptive-sort
6357 anything-c-highlight-bookmark)
6358 (action . (("Show Contact(s)"
6359 . (lambda (candidate)
6360 (let* ((contacts (anything-marked-candidates))
6361 (current-prefix-arg (or anything-current-prefix-arg
6362 (> (length contacts) 1))))
6363 (bookmark-jump
6364 (anything-bookmark-get-bookmark-from-name (car contacts)))
6365 (anything-aif (cdr contacts)
6366 (loop for bmk in it do
6367 (bookmark-jump
6368 (anything-bookmark-get-bookmark-from-name bmk)))))))
6369 ("Send Mail"
6370 . (lambda (candidate)
6371 (let* ((contacts (anything-marked-candidates))
6372 (bmk (anything-bookmark-get-bookmark-from-name
6373 (car contacts)))
6374 (append (message-buffers)))
6375 (if append
6376 (addressbook-set-mail-buffer1 bmk 'append)
6377 (addressbook-set-mail-buffer1 bmk))
6378 (setq contacts (cdr contacts))
6379 (when contacts
6380 (loop for bmk in contacts do
6381 (addressbook-set-mail-buffer1 bmk 'append))))))
6382 ("Edit Bookmark"
6383 . (lambda (candidate)
6384 (let ((bmk (anything-bookmark-get-bookmark-from-name
6385 candidate)))
6386 (addressbook-bookmark-edit
6387 (assoc bmk bookmark-alist)))))
6388 ("Insert Email at point"
6389 . (lambda (candidate)
6390 (let* ((bmk (anything-bookmark-get-bookmark-from-name
6391 candidate))
6392 (mlist (split-string
6393 (assoc-default
6394 'email (assoc bmk bookmark-alist))
6395 ", ")))
6396 (insert
6397 (if (> (length mlist) 1)
6398 (anything-comp-read
6399 "Insert Mail Address: " mlist :must-match t)
6400 (car mlist))))))
6401 ("Show annotation"
6402 . (lambda (candidate)
6403 (let ((bmk (anything-bookmark-get-bookmark-from-name
6404 candidate)))
6405 (bookmark-show-annotation bmk))))
6406 ("Edit annotation"
6407 . (lambda (candidate)
6408 (let ((bmk (anything-bookmark-get-bookmark-from-name
6409 candidate)))
6410 (bookmark-edit-annotation bmk))))
6411 ("Show Google map"
6412 . (lambda (candidate)
6413 (let* ((bmk (anything-bookmark-get-bookmark-from-name
6414 candidate))
6415 (full-bmk (assoc bmk bookmark-alist)))
6416 (addressbook-google-map full-bmk))))))))
6419 (defun anything-c-bmkext-addressbook-setup-alist ()
6420 "Specialized filter function for bookmarks w3m."
6421 (anything-c-bmkext-filter-setup-alist 'bmkext-addressbook-alist-only))
6423 ;; W3m bookmarks from bookmark-extensions.
6424 (defvar anything-c-source-bookmark-w3m
6425 '((name . "Bookmark W3m")
6426 (init . (lambda ()
6427 (require 'bookmark-extensions)
6428 (bookmark-maybe-load-default-file)))
6429 (candidates . anything-c-bookmark-w3m-setup-alist)
6430 (filtered-candidate-transformer
6431 anything-c-adaptive-sort
6432 anything-c-highlight-bookmark)
6433 (type . bookmark)))
6434 ;; (anything 'anything-c-source-bookmark-w3m)
6436 (defun anything-c-bookmark-w3m-setup-alist ()
6437 "Specialized filter function for bookmarks w3m."
6438 (anything-c-bmkext-filter-setup-alist 'bmkext-w3m-alist-only))
6440 ;; Images
6441 (defvar anything-c-source-bookmark-images
6442 '((name . "Bookmark Images")
6443 (init . (lambda ()
6444 (require 'bookmark-extensions)
6445 (bookmark-maybe-load-default-file)))
6446 (candidates . anything-c-bookmark-images-setup-alist)
6447 (filtered-candidate-transformer
6448 anything-c-adaptive-sort
6449 anything-c-highlight-bookmark)
6450 (type . bookmark)))
6451 ;; (anything 'anything-c-source-bookmark-images)
6453 (defun anything-c-bookmark-images-setup-alist ()
6454 "Specialized filter function for images bookmarks."
6455 (anything-c-bmkext-filter-setup-alist 'bmkext-image-file-alist-only))
6457 ;; Woman Man
6458 (defvar anything-c-source-bookmark-man
6459 '((name . "Bookmark Woman&Man")
6460 (init . (lambda ()
6461 (require 'bookmark-extensions)
6462 (bookmark-maybe-load-default-file)))
6463 (candidates . anything-c-bookmark-man-setup-alist)
6464 (filtered-candidate-transformer
6465 anything-c-adaptive-sort
6466 anything-c-highlight-bookmark)
6467 (type . bookmark)))
6468 ;; (anything 'anything-c-source-bookmark-man)
6470 (defun anything-c-bookmark-man-setup-alist ()
6471 "Specialized filter function for bookmarks w3m."
6472 (append (anything-c-bmkext-filter-setup-alist 'bmkext-man-alist-only)
6473 (anything-c-bmkext-filter-setup-alist 'bmkext-woman-alist-only)))
6475 ;; Gnus
6476 (defvar anything-c-source-bookmark-gnus
6477 '((name . "Bookmark Gnus")
6478 (init . (lambda ()
6479 (require 'bookmark-extensions)
6480 (bookmark-maybe-load-default-file)))
6481 (candidates . anything-c-bookmark-gnus-setup-alist)
6482 (filtered-candidate-transformer
6483 anything-c-adaptive-sort
6484 anything-c-highlight-bookmark)
6485 (type . bookmark)))
6486 ;; (anything 'anything-c-source-bookmark-gnus)
6488 (defun anything-c-bookmark-gnus-setup-alist ()
6489 "Specialized filter function for bookmarks gnus."
6490 (anything-c-bmkext-filter-setup-alist 'bmkext-gnus-alist-only))
6492 ;; Info
6493 (defvar anything-c-source-bookmark-info
6494 '((name . "Bookmark Info")
6495 (init . (lambda ()
6496 (require 'bookmark-extensions)
6497 (bookmark-maybe-load-default-file)))
6498 (candidates . anything-c-bookmark-info-setup-alist)
6499 (filtered-candidate-transformer
6500 anything-c-adaptive-sort
6501 anything-c-highlight-bookmark)
6502 (type . bookmark)))
6503 ;; (anything 'anything-c-source-bookmark-info)
6505 (defun anything-c-bookmark-info-setup-alist ()
6506 "Specialized filter function for bookmarks info."
6507 (anything-c-bmkext-filter-setup-alist 'bmkext-info-alist-only))
6509 ;; Local Files&directories
6510 (defvar anything-c-source-bookmark-files&dirs
6511 '((name . "Bookmark Files&Directories")
6512 (init . (lambda ()
6513 (require 'bookmark-extensions)
6514 (bookmark-maybe-load-default-file)))
6515 (candidates . anything-c-bookmark-local-files-setup-alist)
6516 (filtered-candidate-transformer
6517 anything-c-adaptive-sort
6518 anything-c-highlight-bookmark)
6519 (type . bookmark)))
6520 ;; (anything 'anything-c-source-bookmark-files&dirs)
6522 (defun anything-c-bookmark-local-files-setup-alist ()
6523 "Specialized filter function for bookmarks locals files."
6524 (anything-c-bmkext-filter-setup-alist 'bmkext-local-file-alist-only))
6526 ;; Su Files&directories
6527 (defvar anything-c-source-bookmark-su-files&dirs
6528 '((name . "Bookmark Root-Files&Directories")
6529 (init . (lambda ()
6530 (require 'bookmark-extensions)
6531 (bookmark-maybe-load-default-file)))
6532 (candidates . anything-c-bookmark-su-files-setup-alist)
6533 (filtered-candidate-transformer
6534 anything-c-adaptive-sort
6535 anything-c-highlight-bookmark-su)
6536 (type . bookmark)))
6537 ;; (anything 'anything-c-source-bookmark-su-files&dirs)
6539 (defun anything-c-bookmark-su-files-setup-alist ()
6540 "Specialized filter function for bookmarks su/sudo files."
6541 (declare (special bmkext-su-or-sudo-regexp))
6542 (loop
6543 with l = (anything-c-bmkext-filter-setup-alist 'bmkext-remote-file-alist-only)
6544 for i in l
6545 for isfile = (bookmark-get-filename i)
6546 for istramp = (and isfile (boundp 'tramp-file-name-regexp)
6547 (save-match-data
6548 (string-match tramp-file-name-regexp isfile)))
6549 for issu = (and istramp
6550 (string-match bmkext-su-or-sudo-regexp isfile))
6551 if issu
6552 collect i))
6554 ;; Ssh Files&directories
6555 (defvar anything-c-source-bookmark-ssh-files&dirs
6556 '((name . "Bookmark Ssh-Files&Directories")
6557 (init . (lambda ()
6558 (require 'bookmark-extensions)
6559 (bookmark-maybe-load-default-file)))
6560 (candidates . anything-c-bookmark-ssh-files-setup-alist)
6561 (filtered-candidate-transformer . anything-c-adaptive-sort)
6562 (type . bookmark)))
6563 ;; (anything 'anything-c-source-bookmark-ssh-files&dirs)
6565 (defun anything-c-bookmark-ssh-files-setup-alist ()
6566 "Specialized filter function for bookmarks ssh files."
6567 (loop
6568 with l = (anything-c-bmkext-filter-setup-alist 'bmkext-remote-file-alist-only)
6569 for i in l
6570 for isfile = (bookmark-get-filename i)
6571 for istramp = (and isfile (boundp 'tramp-file-name-regexp)
6572 (save-match-data
6573 (string-match tramp-file-name-regexp isfile)))
6574 for isssh = (and istramp
6575 (string-match "/ssh:" isfile))
6576 if isssh
6577 collect i))
6581 ;;; Firefox bookmarks
6584 ;; You will have to set firefox to import bookmarks in his html file bookmarks.html.
6585 ;; (only for firefox versions >=3)
6586 ;; To achieve that, open about:config in firefox and double click on this line to enable value
6587 ;; to true:
6588 ;; user_pref("browser.bookmarks.autoExportHTML", false);
6589 ;; You should have now:
6590 ;; user_pref("browser.bookmarks.autoExportHTML", true);
6592 (defvar anything-firefox-bookmark-url-regexp "\\(https\\|http\\|ftp\\|about\\|file\\)://[^ \"]*")
6593 (defvar anything-firefox-bookmarks-regexp ">\\([^><]+.[^</a>]\\)")
6595 (defun anything-get-firefox-user-init-dir ()
6596 "Guess the default Firefox user directory name."
6597 (let* ((moz-dir (concat (getenv "HOME") "/.mozilla/firefox/"))
6598 (moz-user-dir
6599 (with-current-buffer (find-file-noselect (concat moz-dir "profiles.ini"))
6600 (goto-char (point-min))
6601 (prog1
6602 (when (search-forward "Path=" nil t)
6603 (buffer-substring-no-properties (point) (point-at-eol)))
6604 (kill-buffer)))))
6605 (file-name-as-directory (concat moz-dir moz-user-dir))))
6607 (defun anything-guess-firefox-bookmark-file ()
6608 "Return the path of the Firefox bookmarks file."
6609 (concat (anything-get-firefox-user-init-dir) "bookmarks.html"))
6611 (defun anything-html-bookmarks-to-alist (file url-regexp bmk-regexp)
6612 "Parse html bookmark FILE and return an alist with (title . url) as elements."
6613 (let (bookmarks-alist url title)
6614 (with-temp-buffer
6615 (insert-file-contents file)
6616 (goto-char (point-min))
6617 (while (re-search-forward "href=\\|^ *<DT><A HREF=" nil t)
6618 (forward-line 0)
6619 (when (re-search-forward url-regexp nil t)
6620 (setq url (match-string 0)))
6621 (when (re-search-forward bmk-regexp nil t)
6622 (setq title (match-string 1)))
6623 (push (cons title url) bookmarks-alist)
6624 (forward-line)))
6625 (nreverse bookmarks-alist)))
6627 (defvar anything-c-firefox-bookmarks-alist nil)
6628 (defvar anything-c-source-firefox-bookmarks
6629 '((name . "Firefox Bookmarks")
6630 (init . (lambda ()
6631 (setq anything-c-firefox-bookmarks-alist
6632 (anything-html-bookmarks-to-alist
6633 (anything-guess-firefox-bookmark-file)
6634 anything-firefox-bookmark-url-regexp
6635 anything-firefox-bookmarks-regexp))))
6636 (candidates . (lambda ()
6637 (mapcar #'car anything-c-firefox-bookmarks-alist)))
6638 (filtered-candidate-transformer
6639 anything-c-adaptive-sort
6640 anything-c-highlight-firefox-bookmarks)
6641 (action . (("Browse Url Firefox"
6642 . (lambda (candidate)
6643 (browse-url-firefox
6644 (anything-c-firefox-bookmarks-get-value candidate))))
6645 ("Browse Url w3m"
6646 . (lambda (candidate)
6647 (w3m-browse-url
6648 (anything-c-firefox-bookmarks-get-value candidate))))
6649 ("Copy Url"
6650 . (lambda (elm)
6651 (kill-new (anything-c-w3m-bookmarks-get-value elm))))))))
6653 ;; (anything 'anything-c-source-firefox-bookmarks)
6655 (defun anything-c-firefox-bookmarks-get-value (elm)
6656 (assoc-default elm anything-c-firefox-bookmarks-alist))
6658 (defun anything-c-highlight-firefox-bookmarks (bookmarks source)
6659 (loop for i in bookmarks
6660 collect (propertize
6661 i 'face '((:foreground "YellowGreen"))
6662 'help-echo (anything-c-firefox-bookmarks-get-value i))))
6666 ;;; W3m bookmark - anything interface.
6669 ;; Some users have the emacs-w3m library in load-path
6670 ;; without having the w3m executable :-;
6671 ;; So check if w3m program is present before trying to load
6672 ;; emacs-w3m.
6673 (eval-when-compile
6674 (when (executable-find "w3m")
6675 (require 'w3m-bookmark nil t)))
6677 (defvar w3m-bookmark-file "~/.w3m/bookmark.html")
6678 (defvar anything-w3m-bookmarks-regexp ">\\([^><]+.[^</a>]\\)")
6679 (defvar anything-w3m-bookmark-url-regexp "\\(https\\|http\\|ftp\\|file\\)://[^>]*")
6680 (defvar anything-c-w3m-bookmarks-alist nil)
6681 (defvar anything-c-source-w3m-bookmarks
6682 '((name . "W3m Bookmarks")
6683 (init . (lambda ()
6684 (setq anything-c-w3m-bookmarks-alist
6685 (anything-html-bookmarks-to-alist
6686 w3m-bookmark-file
6687 anything-w3m-bookmark-url-regexp
6688 anything-w3m-bookmarks-regexp))))
6689 (candidates . (lambda ()
6690 (mapcar #'car anything-c-w3m-bookmarks-alist)))
6691 (filtered-candidate-transformer
6692 anything-c-adaptive-sort
6693 anything-c-highlight-w3m-bookmarks)
6694 (action . (("Browse Url"
6695 . (lambda (candidate)
6696 (anything-c-w3m-browse-bookmark candidate)))
6697 ("Copy Url"
6698 . (lambda (elm)
6699 (kill-new (anything-c-w3m-bookmarks-get-value elm))))
6700 ("Browse Url Firefox"
6701 . (lambda (candidate)
6702 (anything-c-w3m-browse-bookmark candidate t)))
6703 ("Delete Bookmark"
6704 . (lambda (candidate)
6705 (anything-c-w3m-delete-bookmark candidate)))
6706 ("Rename Bookmark"
6707 . (lambda (candidate)
6708 (anything-c-w3m-rename-bookmark candidate)))))
6709 (persistent-action . (lambda (candidate)
6710 (if current-prefix-arg
6711 (anything-c-w3m-browse-bookmark candidate t)
6712 (anything-c-w3m-browse-bookmark candidate nil t))))
6713 (persistent-help . "Open URL with emacs-w3m in new tab / \
6714 C-u \\[anything-execute-persistent-action]: Open URL with Firefox"))
6715 "Needs w3m and emacs-w3m.
6717 http://w3m.sourceforge.net/
6718 http://emacs-w3m.namazu.org/")
6720 ;; (anything 'anything-c-source-w3m-bookmarks)
6722 (defun anything-c-w3m-bookmarks-get-value (elm)
6723 (replace-regexp-in-string
6724 "\"" "" (cdr (assoc elm anything-c-w3m-bookmarks-alist))))
6726 (defun anything-c-w3m-browse-bookmark (elm &optional use-firefox new-tab)
6727 (let* ((fn (if use-firefox 'browse-url-firefox 'w3m-browse-url))
6728 (arg (and (eq fn 'w3m-browse-url) new-tab)))
6729 (funcall fn (anything-c-w3m-bookmarks-get-value elm) arg)))
6731 (defun anything-c-highlight-w3m-bookmarks (bookmarks source)
6732 (loop for i in bookmarks
6733 collect (propertize
6734 i 'face 'anything-w3m-bookmarks-face
6735 'help-echo (anything-c-w3m-bookmarks-get-value i))))
6738 (defun anything-c-w3m-delete-bookmark (elm)
6739 "Delete w3m bookmark from `w3m-bookmark-file'."
6740 (with-current-buffer
6741 (find-file-literally w3m-bookmark-file)
6742 (goto-char (point-min))
6743 (when (re-search-forward elm nil t)
6744 (beginning-of-line)
6745 (delete-region (point)
6746 (line-end-position))
6747 (delete-blank-lines))
6748 (save-buffer)
6749 (kill-buffer)))
6751 (defun anything-c-w3m-rename-bookmark (elm)
6752 "Rename w3m bookmark in `w3m-bookmark-file'."
6753 (let* ((old-title (replace-regexp-in-string ">" "" elm))
6754 (new-title (read-string "NewTitle: " old-title)))
6755 (with-current-buffer
6756 (find-file-literally w3m-bookmark-file)
6757 (goto-char (point-min))
6758 (when (re-search-forward (concat elm "<") nil t)
6759 (goto-char (1- (point)))
6760 (delete-char (- (length old-title)))
6761 (insert new-title))
6762 (save-buffer)
6763 (kill-buffer))))
6766 ;;;; <Library>
6767 ;;; Elisp library scan
6770 (defvar anything-c-source-elisp-library-scan
6771 '((name . "Elisp libraries (Scan)")
6772 (init . (anything-c-elisp-library-scan-init))
6773 (candidates-in-buffer)
6774 (action ("Find library"
6775 . (lambda (candidate) (find-file (find-library-name candidate))))
6776 ("Find library other window"
6777 . (lambda (candidate)
6778 (find-file-other-window (find-library-name candidate))))
6779 ("Load library"
6780 . (lambda (candidate) (load-library candidate))))))
6781 ;; (anything 'anything-c-source-elisp-library-scan)
6783 (defun anything-c-elisp-library-scan-init ()
6784 "Init anything buffer status."
6785 (let ((anything-buffer (anything-candidate-buffer 'global))
6786 (library-list (anything-c-elisp-library-scan-list)))
6787 (with-current-buffer anything-buffer
6788 (dolist (library library-list)
6789 (insert (format "%s\n" library))))))
6791 (defun anything-c-elisp-library-scan-list (&optional dirs string)
6792 "Do completion for file names passed to `locate-file'.
6793 DIRS is directory to search path.
6794 STRING is string to match."
6795 ;; Use `load-path' as path when ignore `dirs'.
6796 (or dirs (setq dirs load-path))
6797 ;; Init with blank when ignore `string'.
6798 (or string (setq string ""))
6799 ;; Get library list.
6800 (let ((string-dir (file-name-directory string))
6801 ;; File regexp that suffix match `load-file-rep-suffixes'.
6802 (match-regexp (format "^.*\\.el%s$" (regexp-opt load-file-rep-suffixes)))
6803 name
6804 names)
6805 (dolist (dir dirs)
6806 (unless dir
6807 (setq dir default-directory))
6808 (if string-dir
6809 (setq dir (expand-file-name string-dir dir)))
6810 (when (file-directory-p dir)
6811 (dolist (file (file-name-all-completions
6812 (file-name-nondirectory string) dir))
6813 ;; Suffixes match `load-file-rep-suffixes'.
6814 (setq name (if string-dir (concat string-dir file) file))
6815 (if (string-match match-regexp name)
6816 (add-to-list 'names name)))))
6817 names))
6820 ;;;; <Programming>
6824 ;;; Imenu
6827 (defvar anything-c-imenu-delimiter " / ")
6829 (defvar anything-c-imenu-index-filter nil)
6830 (make-variable-buffer-local 'anything-c-imenu-index-filter)
6832 (defvar anything-c-cached-imenu-alist nil)
6833 (make-variable-buffer-local 'anything-c-cached-imenu-alist)
6835 (defvar anything-c-cached-imenu-candidates nil)
6836 (make-variable-buffer-local 'anything-c-cached-imenu-candidates)
6838 (defvar anything-c-cached-imenu-tick nil)
6839 (make-variable-buffer-local 'anything-c-cached-imenu-tick)
6841 (eval-when-compile (require 'imenu))
6842 (setq imenu-auto-rescan t)
6844 (defun anything-imenu-create-candidates (entry)
6845 "Create candidates with ENTRY."
6846 (if (listp (cdr entry))
6847 (mapcan
6848 (lambda (sub)
6849 (if (consp (cdr sub))
6850 (mapcar
6851 (lambda (subentry)
6852 (concat (car entry) anything-c-imenu-delimiter subentry))
6853 (anything-imenu-create-candidates sub))
6854 (list (concat (car entry) anything-c-imenu-delimiter (car sub)))))
6855 (cdr entry))
6856 (list entry)))
6858 (defvar anything-c-source-imenu
6859 '((name . "Imenu")
6860 (init . (lambda () (require 'imenu)))
6861 (candidates . anything-c-imenu-candidates)
6862 (persistent-action . (lambda (elm)
6863 (anything-c-imenu-default-action elm)
6864 (unless (fboundp 'semantic-imenu-tag-overlay)
6865 (anything-match-line-color-current-line))))
6866 (persistent-help . "Show this entry")
6867 (action . anything-c-imenu-default-action))
6868 "See (info \"(emacs)Imenu\")")
6870 ;; (anything 'anything-c-source-imenu)
6872 (defun anything-c-imenu-candidates ()
6873 (with-anything-current-buffer
6874 (let ((tick (buffer-modified-tick)))
6875 (if (eq anything-c-cached-imenu-tick tick)
6876 anything-c-cached-imenu-candidates
6877 (setq imenu--index-alist nil)
6878 (setq anything-c-cached-imenu-tick tick
6879 anything-c-cached-imenu-candidates
6880 (ignore-errors
6881 (mapcan
6882 'anything-imenu-create-candidates
6883 (setq anything-c-cached-imenu-alist
6884 (let ((index (imenu--make-index-alist)))
6885 (if anything-c-imenu-index-filter
6886 (funcall anything-c-imenu-index-filter index)
6887 index))))))
6888 (setq anything-c-cached-imenu-candidates
6889 (mapcar #'(lambda (x)
6890 (if (stringp x)
6892 (car x)))
6893 anything-c-cached-imenu-candidates))))))
6895 (setq imenu-default-goto-function 'imenu-default-goto-function)
6896 (defun anything-c-imenu-default-action (elm)
6897 "The default action for `anything-c-source-imenu'."
6898 (let ((path (split-string elm anything-c-imenu-delimiter))
6899 (alist anything-c-cached-imenu-alist))
6900 (dolist (elm path)
6901 (setq alist (assoc elm alist)))
6902 (imenu alist)))
6906 ;;; Ctags
6909 (defvar anything-c-ctags-modes
6910 '( c-mode c++-mode awk-mode csharp-mode java-mode javascript-mode lua-mode
6911 makefile-mode pascal-mode perl-mode cperl-mode php-mode python-mode
6912 scheme-mode sh-mode slang-mode sql-mode tcl-mode ))
6914 (defun anything-c-source-ctags-init ()
6915 (when (and buffer-file-name
6916 (memq major-mode anything-c-ctags-modes)
6917 (anything-current-buffer-is-modified))
6918 (with-current-buffer (anything-candidate-buffer 'local)
6919 (call-process-shell-command
6920 (if (string-match "\\.el\\.gz$" anything-buffer-file-name)
6921 (format "ctags -e -u -f- --language-force=lisp --fields=n =(zcat %s) "
6922 anything-buffer-file-name)
6923 (format "ctags -e -u -f- --fields=n %s " anything-buffer-file-name))
6924 nil (current-buffer))
6925 (goto-char (point-min))
6926 (forward-line 2)
6927 (delete-region (point-min) (point))
6928 (loop while (and (not (eobp)) (search-forward "\001" (point-at-eol) t))
6929 for lineno-start = (point)
6930 for lineno = (buffer-substring
6931 lineno-start
6932 (1- (search-forward "," (point-at-eol) t)))
6934 (beginning-of-line)
6935 (insert (format "%5s:" lineno))
6936 (search-forward "\177" (point-at-eol) t)
6937 (delete-region (1- (point)) (point-at-eol))
6938 (forward-line 1)))))
6940 (defvar anything-c-source-ctags
6941 '((name . "Exuberant ctags")
6942 (init . anything-c-source-ctags-init)
6943 (candidates-in-buffer)
6944 (adjust)
6945 (type . line))
6946 "Needs Exuberant Ctags.
6948 http://ctags.sourceforge.net/")
6949 ;; (anything 'anything-c-source-ctags)
6952 ;;; Etags
6955 ;; anything-etags.el is deprecated, if this file is found,
6956 ;; warn user at compile time.
6957 (eval-when-compile
6958 (when (locate-library "anything-etags.el")
6959 (display-warning
6960 '(anything-config)
6961 "You are using obsolete library `anything-etags.el' and should remove it."
6962 :warning)))
6964 (defvar anything-c-etags-tag-file-dir nil
6965 "Etags file directory.")
6966 (defvar anything-c-etags-mtime-alist nil
6967 "Store the last modification time of etags files here.")
6968 (defvar anything-c-etags-cache (make-hash-table :test 'equal)
6969 "Cache content of etags files used here for faster access.")
6971 (defun anything-c-etags-get-tag-file (&optional directory)
6972 "Return the path of etags file if found."
6973 ;; Get tag file from `default-directory' or upper directory.
6974 (let ((current-dir (anything-c-etags-find-tag-file-directory
6975 (or directory default-directory))))
6976 ;; Return nil if not find tag file.
6977 (when current-dir
6978 ;; Set tag file directory.
6979 (setq anything-c-etags-tag-file-dir current-dir)
6980 (expand-file-name anything-c-etags-tag-file-name current-dir))))
6982 (defun anything-c-etags-find-tag-file-directory (current-dir)
6983 "Try to find the directory containing tag file.
6984 If not found in CURRENT-DIR search in upper directory."
6985 (flet ((file-exists? (dir)
6986 (let ((tag-path (expand-file-name
6987 anything-c-etags-tag-file-name dir)))
6988 (and (stringp tag-path)
6989 (file-exists-p tag-path)
6990 (file-readable-p tag-path)))))
6991 (loop with count = 0
6992 until (file-exists? current-dir)
6993 ;; Return nil if outside the value of
6994 ;; `anything-c-etags-tag-file-search-limit'.
6995 if (= count anything-c-etags-tag-file-search-limit)
6996 do (return nil)
6997 ;; Or search upper directories.
6998 else
6999 do (incf count)
7000 (setq current-dir (expand-file-name (concat current-dir "../")))
7001 finally return current-dir)))
7003 (defun anything-c-source-etags-header-name (x)
7004 "Create header name for this anything etags session."
7005 (concat "Etags in "
7006 (with-anything-current-buffer
7007 (anything-c-etags-get-tag-file))))
7009 (defmacro anything-c-etags-create-buffer (file)
7010 "Create the `anything-buffer' based on contents of etags tag FILE."
7011 `(let* ((tag-fname ,file)
7013 (split (with-current-buffer (find-file-noselect tag-fname)
7014 (prog1
7015 (split-string (buffer-string) "\n" 'omit-nulls)
7016 (setq max (line-number-at-pos (point-max)))
7017 (kill-buffer))))
7018 (progress-reporter (make-progress-reporter "Loading tag file..." 0 max)))
7019 (loop
7020 with fname
7021 with cand
7022 for i in split for count from 0
7023 for elm = (unless (string-match "^\x0c" i)
7024 (anything-aif (string-match "\177" i)
7025 (substring i 0 it)
7027 do (cond ((and elm (string-match "^\\(.+\\),[0-9]+" elm))
7028 (setq fname (match-string 1 elm)))
7029 (elm (setq cand (concat fname ": " elm)))
7030 (t (setq cand nil)))
7031 when cand do (progn
7032 (insert (concat cand "\n"))
7033 (progress-reporter-update progress-reporter count)))))
7035 (defun anything-c-etags-init ()
7036 "Feed `anything-buffer' using `anything-c-etags-cache' or tag file.
7037 If no entry in cache, create one."
7038 (let ((tagfile (anything-c-etags-get-tag-file)))
7039 (when tagfile
7040 (with-current-buffer (anything-candidate-buffer 'global)
7041 (anything-aif (gethash tagfile anything-c-etags-cache)
7042 ;; An entry is present in cache, insert it.
7043 (insert it)
7044 ;; No entry, create a new buffer using content of tag file (slower).
7045 (anything-c-etags-create-buffer tagfile)
7046 ;; Store content of buffer in cache.
7047 (puthash tagfile (buffer-string) anything-c-etags-cache)
7048 ;; Store or set the last modification of tag file.
7049 (anything-aif (assoc tagfile anything-c-etags-mtime-alist)
7050 ;; If an entry exists modify it.
7051 (setcdr it (anything-c-etags-mtime tagfile))
7052 ;; No entry create a new one.
7053 (add-to-list 'anything-c-etags-mtime-alist
7054 (cons tagfile (anything-c-etags-mtime tagfile)))))))))
7056 (defvar anything-c-source-etags-select
7057 '((name . "Etags")
7058 (header-name . anything-c-source-etags-header-name)
7059 (init . anything-c-etags-init)
7060 (candidates-in-buffer)
7061 (search . (anything-c-etags-search-fn))
7062 (mode-line . anything-etags-mode-line-string)
7063 (action . anything-c-etags-default-action)
7064 (persistent-action . (lambda (candidate)
7065 (anything-c-etags-default-action candidate)
7066 (anything-match-line-color-current-line))))
7067 "Anything source for Etags.")
7069 (defun anything-c-etags-search-fn (pattern)
7070 "Search function for `anything-c-source-etags-select'."
7071 (re-search-forward
7072 (if anything-c-etags-use-regexp-search
7073 (format anything-c-etags-search-regexp pattern)
7074 pattern)
7075 nil t))
7077 (defun anything-c-etags-default-action (candidate)
7078 "Anything default action to jump to an etags entry."
7079 (let* ((split (split-string candidate ": "))
7080 (fname (expand-file-name
7081 (car split) anything-c-etags-tag-file-dir))
7082 (elm (cadr split)))
7083 (find-file fname)
7084 (goto-char (point-min))
7085 (search-forward elm nil t)
7086 (goto-char (match-beginning 0))))
7088 (defun anything-c-etags-mtime (file)
7089 "Last modification time of etags tag FILE."
7090 (cadr (nth 5 (file-attributes file))))
7092 (defun anything-c-etags-file-modified-p (file)
7093 "Check if tag FILE have been modified in this session.
7094 If FILE is nil return nil."
7095 (let ((last-modif (and file
7096 (assoc-default file anything-c-etags-mtime-alist))))
7097 (and last-modif
7098 (/= last-modif (anything-c-etags-mtime file)))))
7102 ;;; Semantic
7105 (defvar anything-semantic-candidates nil)
7107 (defun anything-semantic-construct-candidates (tags depth)
7108 (when (require 'semantic nil t)
7109 (apply
7110 'append
7111 (mapcar
7112 (lambda (tag)
7113 (if (listp tag)
7114 (let ((type (semantic-tag-type tag))
7115 (class (semantic-tag-class tag)))
7116 (if (or (and (stringp type)
7117 (or (string= type "class")
7118 (string= type "namespace")))
7119 (eq class 'function)
7120 (eq class 'variable))
7121 (cons (cons (concat (make-string (* depth 2) ?\s)
7122 (semantic-format-tag-summarize tag nil t))
7123 tag)
7124 (anything-semantic-construct-candidates
7125 (semantic-tag-components tag) (1+ depth)))))))
7126 tags))))
7128 (defun anything-semantic-default-action (candidate)
7129 (let ((tag (cdr (assoc candidate anything-semantic-candidates))))
7130 (semantic-go-to-tag tag)))
7132 (defvar anything-c-source-semantic
7133 '((name . "Semantic Tags")
7134 (init . (lambda ()
7135 (setq anything-semantic-candidates
7136 (ignore-errors (anything-semantic-construct-candidates
7137 (semantic-fetch-tags) 0)))))
7138 (candidates . (lambda ()
7139 (if anything-semantic-candidates
7140 (mapcar 'car anything-semantic-candidates))))
7141 (persistent-action . (lambda (elm)
7142 (anything-semantic-default-action elm)
7143 (anything-match-line-color-current-line)))
7144 (persistent-help . "Show this entry")
7145 (action . anything-semantic-default-action)
7146 "Needs semantic in CEDET.
7148 http://cedet.sourceforge.net/semantic.shtml
7149 http://cedet.sourceforge.net/"))
7151 ;; (anything 'anything-c-source-semantic)
7154 ;;; Anything interface of `simple-call-tree.el'.
7156 ;; <http://www.emacswiki.org/cgi-bin/wiki/download/simple-call-tree.el>
7158 ;; Function is called by
7159 (defvar anything-c-source-simple-call-tree-functions-callers
7160 '((name . "Function is called by")
7161 (init . anything-c-simple-call-tree-functions-callers-init)
7162 (multiline)
7163 (candidates . anything-c-simple-call-tree-candidates)
7164 (persistent-action . anything-c-simple-call-tree-persistent-action)
7165 (persistent-help . "Show function definitions by rotation")
7166 (action ("Find definition selected by persistent-action" .
7167 anything-c-simple-call-tree-find-definition)))
7168 "Needs simple-call-tree.el.
7169 http://www.emacswiki.org/cgi-bin/wiki/download/simple-call-tree.el")
7171 (defvar anything-c-simple-call-tree-tick nil)
7172 (make-variable-buffer-local 'anything-c-simple-call-tree-tick)
7173 (defun anything-c-simple-call-tree-analyze-maybe ()
7174 (unless (eq (buffer-chars-modified-tick) anything-c-simple-call-tree-tick)
7175 (simple-call-tree-analyze)
7176 (setq anything-c-simple-call-tree-tick (buffer-chars-modified-tick))))
7178 (defun anything-c-simple-call-tree-init-base (function message)
7179 (require 'simple-call-tree)
7180 (with-no-warnings
7181 (when (anything-current-buffer-is-modified)
7182 (anything-c-simple-call-tree-analyze-maybe)
7183 (let ((list (funcall function simple-call-tree-alist)))
7184 (with-current-buffer (anything-candidate-buffer 'local)
7185 (dolist (entry list)
7186 (let ((funcs (concat " " (mapconcat #'identity (cdr entry) "\n "))))
7187 (insert (car entry) message
7188 (if (string= funcs " ")
7189 " no functions."
7190 funcs)
7191 "\n\n"))))))))
7193 (defun anything-c-simple-call-tree-functions-callers-init ()
7194 (anything-c-simple-call-tree-init-base 'simple-call-tree-invert
7195 " is called by\n"))
7197 (defun anything-c-simple-call-tree-candidates ()
7198 (with-current-buffer (anything-candidate-buffer)
7199 (split-string (buffer-string) "\n\n")))
7201 (defvar anything-c-simple-call-tree-related-functions nil)
7202 (defvar anything-c-simple-call-tree-function-index 0)
7203 (defun anything-c-simple-call-tree-persistent-action (candidate)
7204 (unless (eq last-command 'anything-execute-persistent-action)
7205 (setq anything-c-simple-call-tree-related-functions
7206 (delete "no functions."
7207 (split-string
7208 (replace-regexp-in-string " \\| is called by\\| calls "
7209 "" candidate)
7210 "\n")))
7211 (setq anything-c-simple-call-tree-function-index -1))
7212 (incf anything-c-simple-call-tree-function-index)
7213 (anything-c-simple-call-tree-find-definition candidate))
7215 (defun anything-c-simple-call-tree-find-definition (candidate)
7216 (find-function
7217 (intern
7218 (nth (mod anything-c-simple-call-tree-function-index
7219 (length anything-c-simple-call-tree-related-functions))
7220 anything-c-simple-call-tree-related-functions))))
7222 ;; (anything 'anything-c-source-simple-call-tree-functions-callers)
7224 ;;; Function calls
7225 (defvar anything-c-source-simple-call-tree-callers-functions
7226 '((name . "Function calls")
7227 (init . anything-c-simple-call-tree-callers-functions-init)
7228 (multiline)
7229 (candidates . anything-c-simple-call-tree-candidates)
7230 (persistent-action . anything-c-simple-call-tree-persistent-action)
7231 (persistent-help . "Show function definitions by rotation")
7232 (action ("Find definition selected by persistent-action" .
7233 anything-c-simple-call-tree-find-definition)))
7234 "Needs simple-call-tree.el.
7235 http://www.emacswiki.org/cgi-bin/wiki/download/simple-call-tree.el")
7237 (defun anything-c-simple-call-tree-callers-functions-init ()
7238 (anything-c-simple-call-tree-init-base 'identity " calls \n"))
7240 ;; (anything 'anything-c-source-simple-call-tree-callers-functions)
7244 ;;; Anything UI of auto-document.el
7246 ;; <http://www.emacswiki.org/cgi-bin/wiki/download/auto-document.el>
7248 ;; Commands/Options with doc
7249 (defvar anything-c-auto-document-data nil)
7250 (make-variable-buffer-local 'anything-c-auto-document-data)
7251 (defvar anything-c-source-commands-and-options-in-file
7252 '((name . "Commands/Options in file")
7253 (header-name
7254 . (lambda (x) (format "Commands/Options in %s"
7255 (buffer-local-value 'buffer-file-name
7256 anything-current-buffer))))
7257 (candidates . anything-command-and-options-candidates)
7258 (multiline)
7259 (action . imenu))
7260 "List Commands and Options with doc. It needs auto-document.el .
7262 http://www.emacswiki.org/cgi-bin/wiki/download/auto-document.el")
7264 (eval-when-compile (require 'auto-document nil t))
7265 (defun anything-command-and-options-candidates ()
7266 (with-anything-current-buffer
7267 (when (and (require 'auto-document nil t)
7268 (eq major-mode 'emacs-lisp-mode)
7269 (or (anything-current-buffer-is-modified)
7270 (not anything-c-auto-document-data)))
7271 (or imenu--index-alist (imenu--make-index-alist t))
7272 (setq anything-c-auto-document-data
7273 (destructuring-bind (commands options)
7274 (adoc-construct anything-current-buffer)
7275 (append
7276 (loop for (command . doc) in commands
7277 for cmdname = (symbol-name command)
7278 collect
7279 (cons
7280 (format "Command: %s\n %s"
7281 (propertize cmdname 'face font-lock-function-name-face)
7282 (adoc-first-line doc))
7283 (assoc cmdname imenu--index-alist)))
7284 (loop with var-alist = (cdr (assoc "Variables" imenu--index-alist))
7285 for (option doc default) in options
7286 for optname = (symbol-name option)
7287 collect
7288 (cons
7289 (format "Option: %s\n %s\n default = %s"
7290 (propertize optname 'face font-lock-variable-name-face)
7291 (adoc-first-line doc)
7292 (adoc-prin1-to-string default))
7293 (assoc optname
7294 var-alist)))))))
7295 anything-c-auto-document-data))
7297 ;; (anything 'anything-c-source-commands-and-options-in-file)
7300 ;;;; <Color and Face>
7303 ;;; Customize Face
7306 (defvar anything-c-source-customize-face
7307 '((name . "Customize Face")
7308 (init . (lambda ()
7309 (unless (anything-candidate-buffer)
7310 (save-selected-window
7311 (list-faces-display))
7312 (anything-candidate-buffer (get-buffer "*Faces*")))))
7313 (candidates-in-buffer)
7314 (get-line . buffer-substring)
7315 (action . (lambda (line)
7316 (customize-face (intern (car (split-string line))))))
7317 (requires-pattern . 3))
7318 "See (info \"(emacs)Faces\")")
7319 ;; (anything 'anything-c-source-customize-face)
7321 ;;; Colors browser
7324 (defvar anything-c-source-colors
7325 '((name . "Colors")
7326 (init . (lambda () (unless (anything-candidate-buffer)
7327 (save-selected-window
7328 (list-colors-display))
7329 (anything-candidate-buffer (get-buffer "*Colors*")))))
7330 (candidates-in-buffer)
7331 (get-line . buffer-substring)
7332 (action
7333 ("Copy Name" . (lambda (candidate)
7334 (kill-new (anything-c-colors-get-name candidate))))
7335 ("Copy RGB" . (lambda (candidate)
7336 (kill-new (anything-c-colors-get-rgb candidate))))
7337 ("Insert Name" . (lambda (candidate)
7338 (with-anything-current-buffer
7339 (insert (anything-c-colors-get-name candidate)))))
7340 ("Insert RGB" . (lambda (candidate)
7341 (with-anything-current-buffer
7342 (insert (anything-c-colors-get-rgb candidate))))))))
7343 ;; (anything 'anything-c-source-colors)
7345 (defun anything-c-colors-get-name (candidate)
7346 "Get color name."
7347 (replace-regexp-in-string
7348 " " ""
7349 (with-temp-buffer
7350 (insert (capitalize candidate))
7351 (goto-char (point-min))
7352 (search-forward-regexp "\\s-\\{2,\\}")
7353 (delete-region (point) (point-max))
7354 (buffer-string))))
7356 (defun anything-c-colors-get-rgb (candidate)
7357 "Get color RGB."
7358 (replace-regexp-in-string
7359 " " ""
7360 (with-temp-buffer
7361 (insert (capitalize candidate))
7362 (goto-char (point-max))
7363 (search-backward-regexp "\\s-\\{2,\\}")
7364 (delete-region (point) (point-min))
7365 (buffer-string))))
7368 ;;;; <Search Engine>
7369 ;;; Tracker desktop search
7370 (defvar anything-c-source-tracker-search
7371 '((name . "Tracker Search")
7372 (candidates . (lambda ()
7373 (start-process "tracker-search-process" nil
7374 "tracker-search"
7375 anything-pattern)))
7376 (type . file)
7377 (requires-pattern . 3)
7378 (delayed))
7379 "Source for retrieving files matching the current input pattern
7380 with the tracker desktop search.")
7381 ;; (anything 'anything-c-source-tracker-search)
7383 ;;; Spotlight (MacOS X desktop search)
7384 (defvar anything-c-source-mac-spotlight
7385 '((name . "mdfind")
7386 (candidates
7387 . (lambda () (start-process "mdfind-process" nil "mdfind" anything-pattern)))
7388 (type . file)
7389 (requires-pattern . 3)
7390 (delayed))
7391 "Source for retrieving files via Spotlight's command line
7392 utility mdfind.")
7393 ;; (anything 'anything-c-source-mac-spotlight)
7395 ;;; Picklist
7396 (defvar anything-c-source-picklist
7397 '((name . "Picklist")
7398 (candidates . (lambda () (mapcar 'car picklist-list)))
7399 (type . file)))
7400 ;; (anything 'anything-c-source-picklist)
7404 ;;; Kill ring
7407 (defvar anything-c-source-kill-ring
7408 '((name . "Kill Ring")
7409 (init . (lambda () (anything-attrset 'last-command last-command)))
7410 (candidates . anything-c-kill-ring-candidates)
7411 (filtered-candidate-transformer anything-c-kill-ring-transformer)
7412 (action . anything-c-kill-ring-action)
7413 (last-command)
7414 (migemo)
7415 (multiline))
7416 "Source for browse and insert contents of kill-ring.")
7418 (defun anything-c-kill-ring-candidates ()
7419 (loop for kill in (anything-fast-remove-dups kill-ring :test 'equal)
7420 unless (or (< (length kill) anything-kill-ring-threshold)
7421 (string-match "^[\\s\\t]+$" kill))
7422 collect kill))
7424 (defun anything-c-kill-ring-transformer (candidates source)
7425 "Display only the `anything-c-kill-ring-max-lines-number' lines of candidate."
7426 (loop for i in candidates
7427 for nlines = (with-temp-buffer (insert i) (count-lines (point-min) (point-max)))
7428 if (and anything-c-kill-ring-max-lines-number
7429 (> nlines anything-c-kill-ring-max-lines-number))
7430 collect (cons
7431 (with-temp-buffer
7432 (insert i)
7433 (goto-char (point-min))
7434 (concat
7435 (buffer-substring
7436 (point-min)
7437 (save-excursion
7438 (forward-line anything-c-kill-ring-max-lines-number)
7439 (point)))
7440 "[...]")) i)
7441 else collect i))
7443 (defun anything-c-kill-ring-action (str)
7444 "Insert STR in `kill-ring' and set STR to the head.
7445 If this action is executed just after `yank',
7446 replace with STR as yanked string."
7447 (setq kill-ring (delete str kill-ring))
7448 (if (not (eq (anything-attr 'last-command) 'yank))
7449 (insert-for-yank str)
7450 ;; from `yank-pop'
7451 (let ((inhibit-read-only t)
7452 (before (< (point) (mark t))))
7453 (if before
7454 (funcall (or yank-undo-function 'delete-region) (point) (mark t))
7455 (funcall (or yank-undo-function 'delete-region) (mark t) (point)))
7456 (setq yank-undo-function nil)
7457 (set-marker (mark-marker) (point) (current-buffer))
7458 (insert-for-yank str)
7459 ;; Set the window start back where it was in the yank command,
7460 ;; if possible.
7461 (set-window-start (selected-window) yank-window-start t)
7462 (if before
7463 ;; This is like exchange-point-and-mark, but doesn't activate the mark.
7464 ;; It is cleaner to avoid activation, even though the command
7465 ;; loop would deactivate the mark because we inserted text.
7466 (goto-char (prog1 (mark t)
7467 (set-marker (mark-marker) (point) (current-buffer)))))))
7468 (kill-new str))
7470 ;; (anything 'anything-c-source-kill-ring)
7473 ;;;; <Mark ring>
7474 ;; DO NOT include these sources in `anything-sources' use
7475 ;; the commands `anything-mark-ring', `anything-global-mark-ring' or
7476 ;; `anything-all-mark-rings' instead.
7478 (defun anything-c-source-mark-ring-candidates ()
7479 (flet ((get-marks (pos)
7480 (save-excursion
7481 (goto-char pos)
7482 (beginning-of-line)
7483 (let ((line (car (split-string (thing-at-point 'line) "[\n\r]"))))
7484 (when (string= "" line)
7485 (setq line "<EMPTY LINE>"))
7486 (format "%7d: %s" (line-number-at-pos) line)))))
7487 (with-anything-current-buffer
7488 (loop
7489 with marks = (if (mark) (cons (mark-marker) mark-ring) mark-ring)
7490 with recip = nil
7491 for i in marks
7492 for m = (get-marks i)
7493 unless (member m recip)
7494 collect m into recip
7495 finally return recip))))
7497 (defvar anything-mark-ring-cache nil)
7498 (defvar anything-c-source-mark-ring
7499 '((name . "mark-ring")
7500 (init . (lambda ()
7501 (setq anything-mark-ring-cache
7502 (ignore-errors (anything-c-source-mark-ring-candidates)))))
7503 (candidates . (lambda ()
7504 (anything-aif anything-mark-ring-cache
7505 it)))
7506 (action . (("Goto line"
7507 . (lambda (candidate)
7508 (anything-goto-line (string-to-number candidate))))))
7509 (persistent-action . (lambda (candidate)
7510 (anything-goto-line (string-to-number candidate))
7511 (anything-match-line-color-current-line)))
7512 (persistent-help . "Show this line")))
7514 ;; (anything 'anything-c-source-mark-ring)
7516 ;;; Global-mark-ring
7517 (defvar anything-c-source-global-mark-ring
7518 '((name . "global-mark-ring")
7519 (candidates . anything-c-source-global-mark-ring-candidates)
7520 (action . (("Goto line"
7521 . (lambda (candidate)
7522 (let ((items (split-string candidate ":")))
7523 (anything-c-switch-to-buffer (second items))
7524 (anything-goto-line (string-to-number (car items))))))))
7525 (persistent-action . (lambda (candidate)
7526 (let ((items (split-string candidate ":")))
7527 (anything-c-switch-to-buffer (second items))
7528 (anything-goto-line (string-to-number (car items)))
7529 (anything-match-line-color-current-line))))
7530 (persistent-help . "Show this line")))
7532 (defun anything-c-source-global-mark-ring-candidates ()
7533 (flet ((buf-fn (m)
7534 (with-current-buffer (marker-buffer m)
7535 (goto-char m)
7536 (beginning-of-line)
7537 (let (line)
7538 (if (string= "" line)
7539 (setq line "<EMPTY LINE>")
7540 (setq line (car (split-string (thing-at-point 'line)
7541 "[\n\r]"))))
7542 (format "%7d:%s: %s"
7543 (line-number-at-pos) (marker-buffer m) line)))))
7544 (loop
7545 with marks = global-mark-ring
7546 with recip = nil
7547 for i in marks
7548 for gm = (unless (or (string-match
7549 "^ " (format "%s" (marker-buffer i)))
7550 (null (marker-buffer i)))
7551 (buf-fn i))
7552 when (and gm (not (member gm recip)))
7553 collect gm into recip
7554 finally return recip)))
7556 ;; (anything 'anything-c-source-global-mark-ring)
7559 ;;;; <Register>
7560 ;;; Insert from register
7561 (defvar anything-c-source-register
7562 '((name . "Registers")
7563 (candidates . anything-c-register-candidates)
7564 (action-transformer . anything-c-register-action-transformer)
7565 (multiline)
7566 (action))
7567 "See (info \"(emacs)Registers\")")
7569 (defun anything-c-register-candidates ()
7570 "Collecting register contents and appropriate commands."
7571 (loop for (char . val) in register-alist
7572 for key = (single-key-description char)
7573 for string-actions =
7574 (cond
7575 ((numberp val)
7576 (list (int-to-string val)
7577 'insert-register
7578 'increment-register))
7579 ((markerp val)
7580 (let ((buf (marker-buffer val)))
7581 (if (null buf)
7582 (list "a marker in no buffer")
7583 (list (concat
7584 "a buffer position:"
7585 (buffer-name buf)
7586 ", position "
7587 (int-to-string (marker-position val)))
7588 'jump-to-register
7589 'insert-register))))
7590 ((and (consp val) (window-configuration-p (car val)))
7591 (list "window configuration."
7592 'jump-to-register))
7593 ((and (consp val) (frame-configuration-p (car val)))
7594 (list "frame configuration."
7595 'jump-to-register))
7596 ((and (consp val) (eq (car val) 'file))
7597 (list (concat "file:"
7598 (prin1-to-string (cdr val))
7599 ".")
7600 'jump-to-register))
7601 ((and (consp val) (eq (car val) 'file-query))
7602 (list (concat "file:a file-query reference: file "
7603 (car (cdr val))
7604 ", position "
7605 (int-to-string (car (cdr (cdr val))))
7606 ".")
7607 'jump-to-register))
7608 ((consp val)
7609 (let ((lines (format "%4d" (length val))))
7610 (list (format "%s: %s\n" lines
7611 (truncate-string-to-width
7612 (mapconcat 'identity (list (car val))
7613 ;; (mapconcat (lambda (y) y) val
7614 "^J") (- (window-width) 15)))
7615 'insert-register)))
7616 ((stringp val)
7617 (list ;; without properties
7618 (substring-no-properties val)
7619 'insert-register
7620 'append-to-register
7621 'prepend-to-register))
7623 "GARBAGE!"))
7624 collect (cons (format "register %3s: %s" key (car string-actions))
7625 (cons char (cdr string-actions)))))
7627 (defun anything-c-register-action-transformer (actions register-and-functions)
7628 "Decide actions by the contents of register."
7629 (loop with func-actions =
7630 '((insert-register
7631 "Insert Register" .
7632 (lambda (c) (insert-register (car c))))
7633 (jump-to-register
7634 "Jump to Register" .
7635 (lambda (c) (jump-to-register (car c))))
7636 (append-to-register
7637 "Append Region to Register" .
7638 (lambda (c) (append-to-register
7639 (car c) (region-beginning) (region-end))))
7640 (prepend-to-register
7641 "Prepend Region to Register" .
7642 (lambda (c) (prepend-to-register
7643 (car c) (region-beginning) (region-end))))
7644 (increment-register
7645 "Increment Prefix Arg to Register" .
7646 (lambda (c) (increment-register
7647 anything-current-prefix-arg (car c)))))
7648 for func in (cdr register-and-functions)
7649 for cell = (assq func func-actions)
7650 when cell
7651 collect (cdr cell)))
7653 ;; (anything 'anything-c-source-register)
7656 ;;; Latex completion
7657 (defun anything-c-latex-math-candidates ()
7658 "Collect candidates for latex math completion."
7659 (declare (special LaTeX-math-menu))
7660 (loop for i in (cddr LaTeX-math-menu)
7661 for elm = (loop for s in i when (vectorp s)
7662 collect (cons (aref s 0) (aref s 1)))
7663 append elm))
7665 (defvar anything-c-source-latex-math
7666 '((name . "Latex Math Menu")
7667 (init . (lambda ()
7668 (with-anything-current-buffer
7669 (LaTeX-math-mode 1))))
7670 (candidate-number-limit . 9999)
7671 (candidates . anything-c-latex-math-candidates)
7672 (action . (lambda (candidate)
7673 (call-interactively candidate)))))
7676 ;;;; <Headline Extraction>
7677 (defvar anything-c-source-fixme
7678 '((name . "TODO/FIXME/DRY comments")
7679 (headline . "^.*\\<\\(TODO\\|FIXME\\|DRY\\)\\>.*$")
7680 (adjust)
7681 (recenter))
7682 "Show TODO/FIXME/DRY comments in current file.")
7683 ;; (anything 'anything-c-source-fixme)
7685 (defvar anything-c-source-rd-headline
7686 '((name . "RD HeadLine")
7687 (headline "^= \\(.+\\)$" "^== \\(.+\\)$" "^=== \\(.+\\)$" "^==== \\(.+\\)$")
7688 (condition . (memq major-mode '(rdgrep-mode rd-mode)))
7689 (migemo)
7690 (subexp . 1))
7691 "Show RD headlines.
7693 RD is Ruby's POD.
7694 http://en.wikipedia.org/wiki/Ruby_Document_format")
7695 ;; (anything 'anything-c-source-rd-headline)
7697 (defvar anything-c-source-oddmuse-headline
7698 '((name . "Oddmuse HeadLine")
7699 (headline "^= \\(.+\\) =$" "^== \\(.+\\) ==$"
7700 "^=== \\(.+\\) ===$" "^==== \\(.+\\) ====$")
7701 (condition . (memq major-mode '(oddmuse-mode yaoddmuse-mode)))
7702 (migemo)
7703 (subexp . 1))
7704 "Show Oddmuse headlines, such as EmacsWiki.")
7705 ;; (anything 'anything-c-source-oddmuse-headline)
7707 (defvar anything-c-source-emacs-source-defun
7708 '((name . "Emacs Source DEFUN")
7709 (headline . "DEFUN\\|DEFVAR")
7710 (condition . (string-match "/emacs2[0-9].+/src/.+c$"
7711 (or buffer-file-name ""))))
7712 "Show DEFUN/DEFVAR in Emacs C source file.")
7713 ;; (anything 'anything-c-source-emacs-source-defun)
7715 (defvar anything-c-source-emacs-lisp-expectations
7716 '((name . "Emacs Lisp Expectations")
7717 (headline . "(desc[ ]\\|(expectations")
7718 (condition . (eq major-mode 'emacs-lisp-mode)))
7719 "Show descriptions (desc) in Emacs Lisp Expectations.
7721 http://www.emacswiki.org/cgi-bin/wiki/download/el-expectations.el")
7722 ;; (anything 'anything-c-source-emacs-lisp-expectations)
7724 (defvar anything-c-source-emacs-lisp-toplevels
7725 '((name . "Emacs Lisp Toplevel / Level 4 Comment / Linkd Star")
7726 (headline . "^(\\|(@\\*\\|^;;;;")
7727 (get-line . buffer-substring)
7728 (condition . (eq major-mode 'emacs-lisp-mode))
7729 (adjust))
7730 "Show top-level forms, level 4 comments and linkd stars (optional) in Emacs Lisp.
7731 linkd.el is optional because linkd stars are extracted by regexp.
7732 http://www.emacswiki.org/cgi-bin/wiki/download/linkd.el")
7733 ;; (anything 'anything-c-source-emacs-lisp-toplevels)
7736 ;;; Anything yaoddmuse
7738 ;; Be sure to have yaoddmuse.el installed
7739 ;; install-elisp may be required if you want to install elisp file from here.
7740 (defvar anything-yaoddmuse-use-cache-file nil)
7741 (defvar anything-c-yaoddmuse-cache-file "~/.emacs.d/yaoddmuse-cache.el")
7742 (defvar anything-c-yaoddmuse-ew-cache nil)
7744 (defun anything-yaoddmuse-get-candidates ()
7745 (declare (special yaoddmuse-pages-hash))
7746 (if anything-yaoddmuse-use-cache-file
7747 (ignore-errors
7748 (unless anything-c-yaoddmuse-ew-cache
7749 (load anything-c-yaoddmuse-cache-file)
7750 (setq anything-c-yaoddmuse-ew-cache
7751 (gethash "EmacsWiki" yaoddmuse-pages-hash)))
7752 anything-c-yaoddmuse-ew-cache)
7753 (yaoddmuse-update-pagename t)
7754 (gethash "EmacsWiki" yaoddmuse-pages-hash)))
7756 (defvar anything-c-source-yaoddmuse-emacswiki-edit-or-view
7757 '((name . "Yaoddmuse Edit or View (EmacsWiki)")
7758 (candidates . anything-yaoddmuse-get-candidates)
7759 (action . (("Edit page" . (lambda (candidate)
7760 (yaoddmuse-edit "EmacsWiki" candidate)))
7761 ("Browse page"
7762 . (lambda (candidate)
7763 (yaoddmuse-browse-page "EmacsWiki" candidate)))
7764 ("Browse page other window"
7765 . (lambda (candidate)
7766 (if (one-window-p)
7767 (split-window-vertically))
7768 (yaoddmuse-browse-page "EmacsWiki" candidate)))
7769 ("Browse diff"
7770 . (lambda (candidate)
7771 (yaoddmuse-browse-page-diff "EmacsWiki" candidate)))
7772 ("Copy URL"
7773 . (lambda (candidate)
7774 (kill-new (yaoddmuse-url "EmacsWiki" candidate))
7775 (message "Have copy page %s's URL to yank." candidate)))
7776 ("Create page"
7777 . (lambda (candidate)
7778 (yaoddmuse-edit "EmacsWiki" anything-input)))
7779 ("Update cache"
7780 . (lambda (candidate)
7781 (if anything-yaoddmuse-use-cache-file
7782 (progn
7783 (anything-yaoddmuse-cache-pages t)
7784 (setq anything-c-yaoddmuse-ew-cache
7785 (gethash "EmacsWiki" yaoddmuse-pages-hash)))
7786 (yaoddmuse-update-pagename))))))
7787 (action-transformer anything-c-yaoddmuse-action-transformer))
7788 "Needs yaoddmuse.el.
7790 http://www.emacswiki.org/emacs/download/yaoddmuse.el")
7792 ;; (anything 'anything-c-source-yaoddmuse-emacswiki-edit-or-view)
7794 (defvar anything-c-source-yaoddmuse-emacswiki-post-library
7795 '((name . "Yaoddmuse Post library (EmacsWiki)")
7796 (init . (anything-yaoddmuse-init))
7797 (candidates-in-buffer)
7798 (action . (("Post library and Browse"
7799 . (lambda (candidate)
7800 (yaoddmuse-post-file
7801 (find-library-name candidate)
7802 "EmacsWiki"
7803 (file-name-nondirectory (find-library-name candidate))
7804 nil t)))
7805 ("Post library"
7806 . (lambda (candidate)
7807 (yaoddmuse-post-file
7808 (find-library-name candidate)
7809 "EmacsWiki"
7810 (file-name-nondirectory
7811 (find-library-name candidate))))))))
7812 "Needs yaoddmuse.el.
7814 http://www.emacswiki.org/emacs/download/yaoddmuse.el")
7816 ;; (anything 'anything-c-source-yaoddmuse-emacswiki-post-library)
7818 (defun anything-c-yaoddmuse-action-transformer (actions candidate)
7819 "Allow the use of `install-elisp' only on elisp files."
7820 (if (string-match "\.el$" candidate)
7821 (append actions '(("Install Elisp"
7822 . (lambda (elm)
7823 (install-elisp-from-emacswiki elm)))))
7824 actions))
7826 ;;;###autoload
7827 (defun anything-yaoddmuse-cache-pages (&optional load)
7828 "Fetch the list of files on emacswiki and create cache file.
7829 If load is non--nil load the file and feed `yaoddmuse-pages-hash'."
7830 (interactive)
7831 (declare (special yaoddmuse-pages-hash))
7832 (yaoddmuse-update-pagename)
7833 (save-excursion
7834 (find-file anything-c-yaoddmuse-cache-file)
7835 (erase-buffer)
7836 (insert "(puthash \"EmacsWiki\" '(")
7837 (loop for i in (gethash "EmacsWiki" yaoddmuse-pages-hash)
7839 (insert (concat "(\"" (car i) "\") ")))
7840 (insert ") yaoddmuse-pages-hash)\n")
7841 (save-buffer)
7842 (kill-buffer (current-buffer))
7843 (when (or current-prefix-arg
7844 load)
7845 (load anything-c-yaoddmuse-cache-file))))
7847 (defun anything-yaoddmuse-init ()
7848 "Init anything buffer status."
7849 (let ((anything-buffer (anything-candidate-buffer 'global))
7850 (library-list (yaoddmuse-get-library-list)))
7851 (with-current-buffer anything-buffer
7852 ;; Insert library name.
7853 (dolist (library library-list)
7854 (insert (format "%s\n" library)))
7855 ;; Sort lines.
7856 (sort-lines nil (point-min) (point-max)))))
7859 ;;; Eev anchors
7860 (defvar anything-c-source-eev-anchor
7861 '((name . "Anchors")
7862 (candidates
7863 . (lambda ()
7864 (ignore-errors
7865 (with-anything-current-buffer
7866 (loop initially (goto-char (point-min))
7867 while (re-search-forward
7868 (format ee-anchor-format "\\([^\.].+\\)") nil t)
7869 for anchor = (match-string-no-properties 1)
7870 collect (cons (format "%5d:%s"
7871 (line-number-at-pos (match-beginning 0))
7872 (format ee-anchor-format anchor))
7873 anchor))))))
7874 (persistent-action . (lambda (item)
7875 (ee-to item)
7876 (anything-match-line-color-current-line)))
7877 (persistent-help . "Show this entry")
7878 (action . (("Goto link" . ee-to)))))
7879 ;; (anything 'anything-c-source-eev-anchor)
7882 ;;; Org headlines
7885 (defvar anything-c-source-org-headline
7886 `((name . "Org HeadLine")
7887 (headline
7888 ,@(mapcar
7889 (lambda (num)
7890 (format "^\\*\\{%d\\} \\(.+?\\)\\([ \t]*:[a-zA-Z0-9_@:]+:\\)?[ \t]*$"
7891 num))
7892 (number-sequence 1 8)))
7893 (condition . (eq major-mode 'org-mode))
7894 (migemo)
7895 (subexp . 1)
7896 (persistent-action . (lambda (elm)
7897 (anything-c-action-line-goto elm)
7898 (org-cycle)))
7899 (action-transformer
7900 . (lambda (actions candidate)
7901 '(("Go to Line" . anything-c-action-line-goto)
7902 ("Refile to this Headline" . anything-c-org-headline-refile)
7903 ("Insert Link to This Headline"
7904 . anything-c-org-headline-insert-link-to-headline)))))
7905 "Show Org headlines.
7906 org-mode is very very much extended text-mode/outline-mode.
7908 See (find-library \"org.el\")
7909 See http://orgmode.org for the latest version.")
7910 ;; (anything 'anything-c-source-org-headline)
7912 (defun anything-c-org-headline-insert-link-to-headline (lineno-and-content)
7913 (insert
7914 (save-excursion
7915 (anything-goto-line (car lineno-and-content))
7916 (and (looking-at org-complex-heading-regexp)
7917 (org-make-link-string (concat "*" (match-string 4)))))))
7919 (defun anything-c-org-headline-refile (lineno-and-content)
7920 "Refile current org entry to LINENO-AND-CONTENT."
7921 (with-anything-current-buffer
7922 (org-cut-subtree)
7923 (anything-goto-line (car lineno-and-content))
7924 (org-end-of-subtree t t)
7925 (let ((org-yank-adjusted-subtrees t))
7926 (org-yank))))
7929 ;;; Org keywords
7932 (defvar anything-c-source-org-keywords
7933 '((name . "Org Keywords")
7934 (init . anything-c-org-keywords-init)
7935 (candidates . anything-c-org-keywords-candidates)
7936 (action . anything-c-org-keywords-insert)
7937 (persistent-action . anything-c-org-keywords-show-help)
7938 (persistent-help . "Show an example and info page to describe this keyword.")
7939 (keywords-examples)
7940 (keywords)))
7941 ;; (anything 'anything-c-source-org-keywords)
7943 (defvar anything-c-org-keywords-info-location
7944 '(("#+TITLE:" . "(org)Export options")
7945 ("#+AUTHOR:" . "(org)Export options")
7946 ("#+DATE:" . "(org)Export options")
7947 ("#+EMAIL:" . "(org)Export options")
7948 ("#+DESCRIPTION:" . "(org)Export options")
7949 ("#+KEYWORDS:" . "(org)Export options")
7950 ("#+LANGUAGE:" . "(org)Export options")
7951 ("#+TEXT:" . "(org)Export options")
7952 ("#+TEXT:" . "(org)Export options")
7953 ("#+OPTIONS:" . "(org)Export options")
7954 ("#+BIND:" . "(org)Export options")
7955 ("#+LINK_UP:" . "(org)Export options")
7956 ("#+LINK_HOME:" . "(org)Export options")
7957 ("#+LATEX_HEADER:" . "(org)Export options")
7958 ("#+EXPORT_SELECT_TAGS:" . "(org)Export options")
7959 ("#+EXPORT_EXCLUDE_TAGS:" . "(org)Export options")
7960 ("#+INFOJS_OPT" . "(org)Javascript support")
7961 ("#+BEGIN_HTML" . "(org)Quoting HTML tags")
7962 ("#+BEGIN_LaTeX" . "(org)Quoting LaTeX code")
7963 ("#+ORGTBL" . "(org)Radio tables")
7964 ("#+HTML:" . "(org)Quoting HTML tags")
7965 ("#+LaTeX:" . "(org)Quoting LaTeX code")
7966 ("#+BEGIN:" . "(org)Dynamic blocks") ;clocktable columnview
7967 ("#+BEGIN_EXAMPLE" . "(org)Literal examples")
7968 ("#+BEGIN_QUOTE" . "(org)Paragraphs")
7969 ("#+BEGIN_VERSE" . "(org)Paragraphs")
7970 ("#+BEGIN_SRC" . "(org)Literal examples")
7971 ("#+CAPTION" . "(org)Tables in HTML export")
7972 ("#+LABEL" . "(org)Tables in LaTeX export")
7973 ("#+ATTR_HTML" . "(org)Links")
7974 ("#+ATTR_LaTeX" . "(org)Images in LaTeX export")))
7976 (defun anything-c-org-keywords-init ()
7977 (unless (anything-attr 'keywords-examples)
7978 (require 'org)
7979 (anything-attrset 'keywords-examples
7980 (append
7981 (mapcar
7982 (lambda (x)
7983 (string-match "^#\\+\\(\\([A-Z_]+:?\\).*\\)" x)
7984 (cons (match-string 2 x) (match-string 1 x)))
7985 (org-split-string (org-get-current-options) "\n"))
7986 (mapcar 'list org-additional-option-like-keywords)))
7987 (anything-attrset 'keywords (mapcar 'car (anything-attr 'keywords-examples)))))
7989 (defun anything-c-org-keywords-candidates ()
7990 (and (or (eq (buffer-local-value 'major-mode anything-current-buffer) 'org-mode)
7991 (eq (buffer-local-value 'major-mode anything-current-buffer) 'message-mode))
7992 (anything-attr 'keywords)))
7994 (defun anything-c-org-keywords-insert (keyword)
7995 (cond ((and (string-match "BEGIN" keyword)
7996 (anything-region-active-p))
7997 (let ((beg (region-beginning))
7998 (end (region-end)))
7999 (goto-char end)
8000 (insert "\n#+" (replace-regexp-in-string
8001 "BEGIN" "END" keyword) "\n")
8002 (goto-char beg)
8003 (insert "#+" keyword " ")
8004 (save-excursion (insert "\n"))))
8005 ((string-match "BEGIN" keyword)
8006 (insert "#+" keyword " ")
8007 (save-excursion
8008 (insert "\n#+" (replace-regexp-in-string
8009 "BEGIN" "END" keyword) "\n")))
8010 (t (insert "#+" keyword " "))))
8012 (defun anything-c-org-keywords-show-help (keyword)
8013 (info (or (assoc-default (concat "#+" keyword) anything-c-org-keywords-info-location)
8014 "(org)In-buffer settings"))
8015 (search-forward (concat "#+" keyword) nil t)
8016 (anything-persistent-highlight-point)
8017 (message "%s" (or (cdr (assoc keyword (anything-attr 'keywords-examples))) "")))
8021 ;;; bbdb
8024 (defvar bbdb-records)
8025 (defvar bbdb-buffer-name)
8027 (defun anything-c-bbdb-candidates ()
8028 "Return a list of all names in the bbdb database. The format
8029 is \"Firstname Lastname\"."
8030 (mapcar (lambda (bbdb-record)
8031 (replace-regexp-in-string
8032 "\\s-+$" ""
8033 (concat (aref bbdb-record 0) " " (aref bbdb-record 1))))
8034 (bbdb-records)))
8036 (defun anything-c-bbdb-create-contact (actions candidate)
8037 "Action transformer that returns only an entry to add the
8038 current `anything-pattern' as new contact. All other actions are
8039 removed."
8040 (if (string= candidate "*Add to contacts*")
8041 '(("Add to contacts" . (lambda (actions)
8042 (bbdb-create-internal
8043 (read-from-minibuffer "Name: " anything-c-bbdb-name)
8044 (read-from-minibuffer "Company: ")
8045 (read-from-minibuffer "Email: ")
8048 (read-from-minibuffer "Note: ")))))
8049 actions))
8051 (defun anything-c-bbdb-get-record (candidate)
8052 "Return record that match CANDIDATE."
8053 (bbdb candidate nil)
8054 (set-buffer "*BBDB*")
8055 (bbdb-current-record))
8057 (defvar anything-c-bbdb-name nil
8058 "Only for internal use.")
8060 (defvar anything-c-source-bbdb
8061 '((name . "BBDB")
8062 (candidates . anything-c-bbdb-candidates)
8063 (action ("Send a mail" . anything-c-bbdb-compose-mail)
8064 ("View person's data" . anything-c-bbdb-view-person-action))
8065 (filtered-candidate-transformer . (lambda (candidates source)
8066 (setq anything-c-bbdb-name anything-pattern)
8067 (if (not candidates)
8068 (list "*Add to contacts*")
8069 candidates)))
8070 (action-transformer . (lambda (actions candidate)
8071 (anything-c-bbdb-create-contact actions candidate))))
8072 "Needs BBDB.
8074 http://bbdb.sourceforge.net/")
8075 ;; (anything 'anything-c-source-bbdb)
8077 (defun anything-c-bbdb-view-person-action (candidate)
8078 "View BBDB data of single CANDIDATE or marked candidates."
8079 (anything-aif (anything-marked-candidates)
8080 (let ((bbdb-append-records (length it)))
8081 (dolist (i it)
8082 (bbdb-redisplay-one-record (anything-c-bbdb-get-record i))))
8083 (bbdb-redisplay-one-record (anything-c-bbdb-get-record candidate))))
8085 (defun anything-c-bbdb-collect-mail-addresses ()
8086 "Return a list of all mail addresses of records in bbdb buffer."
8087 (with-current-buffer bbdb-buffer-name
8088 (loop for i in bbdb-records
8089 if (bbdb-record-net (car i))
8090 collect (bbdb-dwim-net-address (car i)))))
8092 (defun anything-c-bbdb-compose-mail (candidate)
8093 "Compose a mail with all records of bbdb buffer."
8094 (anything-c-bbdb-view-person-action candidate)
8095 (let* ((address-list (anything-c-bbdb-collect-mail-addresses))
8096 (address-str (mapconcat 'identity address-list ",\n ")))
8097 (compose-mail address-str)))
8100 ;;; Evaluation Result
8103 ;; Internal
8104 (defvar anything-eldoc-active-minibuffers-list nil)
8105 (defvar anything-eval-expression-input-history nil)
8107 (defvar anything-c-source-evaluation-result
8108 '((name . "Evaluation Result")
8109 (disable-shortcuts)
8110 (dummy)
8111 (multiline)
8112 (mode-line . "C-RET: nl-and-indent, tab: reindent, C-tab:complete, C-p/n: next/prec-line.")
8113 (filtered-candidate-transformer . (lambda (candidates source)
8114 (list
8115 (condition-case nil
8116 (with-anything-current-buffer
8117 (pp-to-string
8118 (eval (read anything-pattern))))
8119 (error "Error")))))
8120 (action . (("Copy result to kill-ring" . (lambda (candidate)
8121 (with-current-buffer anything-buffer
8122 (let ((end (save-excursion
8123 (goto-char (point-max))
8124 (search-backward "\n")
8125 (point))))
8126 (kill-region (point) end)))))
8127 ("copy sexp to kill-ring" . (lambda (candidate)
8128 (kill-new anything-input)))))))
8129 ;; (anything 'anything-c-source-evaluation-result)
8131 (defun anything-eval-new-line-and-indent ()
8132 (interactive)
8133 (newline) (lisp-indent-line))
8135 (defun anything-eldoc-store-minibuffer ()
8136 "Store minibuffer buffer name in `anything-eldoc-active-minibuffers-list'."
8137 (with-selected-window (minibuffer-window)
8138 (push (buffer-name) anything-eldoc-active-minibuffers-list)))
8140 (defun anything-eldoc-show-in-eval ()
8141 "Return eldoc in mode-line for current minibuffer input."
8142 (let ((buf (with-selected-window (minibuffer-window)
8143 (buffer-name))))
8144 (when (member buf anything-eldoc-active-minibuffers-list)
8145 (let* ((str-all (with-current-buffer buf
8146 (minibuffer-completion-contents)))
8147 (sym (when str-all
8148 (with-temp-buffer
8149 (insert str-all)
8150 (goto-char (point-max))
8151 (unless (looking-back ")\\|\"") (forward-char -1))
8152 (eldoc-current-symbol))))
8153 (info-fn (eldoc-fnsym-in-current-sexp))
8154 (doc (or (eldoc-get-var-docstring sym)
8155 (eldoc-get-fnsym-args-string
8156 (car info-fn) (cadr info-fn)))))
8157 (when doc (funcall anything-c-eldoc-in-minibuffer-show-fn doc))))))
8159 (defun anything-c-show-info-in-mode-line (str)
8160 "Display string STR in mode-line."
8161 (save-selected-window
8162 (with-current-buffer anything-buffer
8163 (let ((mode-line-format (concat " " str)))
8164 (force-mode-line-update)
8165 (sit-for anything-c-show-info-in-mode-line-delay))
8166 (force-mode-line-update))))
8168 ;;; Calculation Result
8171 (defvar anything-c-source-calculation-result
8172 '((name . "Calculation Result")
8173 (dummy)
8174 (filtered-candidate-transformer . (lambda (candidates source)
8175 (list
8176 (condition-case nil
8177 (calc-eval anything-pattern)
8178 (error "error")))))
8179 (action ("Copy result to kill-ring" . kill-new))))
8180 ;; (anything 'anything-c-source-calculation-result)
8183 ;;; Google Suggestions
8186 ;; Internal
8187 (defvar anything-ggs-max-length-real-flag 0)
8188 (defvar anything-ggs-max-length-num-flag 0)
8190 (defun anything-c-google-suggest-fetch (input)
8191 "Fetch suggestions for INPUT from XML buffer.
8192 Return an alist with elements like (data . number_results)."
8193 (setq anything-ggs-max-length-real-flag 0
8194 anything-ggs-max-length-num-flag 0)
8195 (let ((request (concat anything-c-google-suggest-url
8196 (url-hexify-string input))))
8197 (flet ((fetch ()
8198 (loop
8199 with result-alist = (xml-get-children
8200 (car (xml-parse-region
8201 (point-min) (point-max)))
8202 'CompleteSuggestion)
8203 for i in result-alist
8204 for data = (cdr (caadr (assoc 'suggestion i)))
8205 for nqueries = (cdr (caadr (assoc 'num_queries i)))
8206 for lqueries = (length (anything-c-ggs-set-number-result
8207 nqueries))
8208 for ldata = (length data)
8210 (progn
8211 (when (> ldata anything-ggs-max-length-real-flag)
8212 (setq anything-ggs-max-length-real-flag ldata))
8213 (when (> lqueries anything-ggs-max-length-num-flag)
8214 (setq anything-ggs-max-length-num-flag lqueries)))
8215 collect (cons data nqueries) into cont
8216 finally return cont)))
8217 (if anything-google-suggest-use-curl-p
8218 (with-temp-buffer
8219 (call-process "curl" nil t nil request)
8220 (fetch))
8221 (with-current-buffer
8222 (url-retrieve-synchronously request)
8223 (fetch))))))
8225 (defun anything-c-google-suggest-set-candidates (&optional request-prefix)
8226 "Set candidates with result and number of google results found."
8227 (let ((suggestions
8228 (loop with suggested-results = (anything-c-google-suggest-fetch
8229 (or (and request-prefix
8230 (concat request-prefix " " anything-pattern))
8231 anything-pattern))
8232 for (real . numresult) in suggested-results
8233 ;; Prepare number of results with ","
8234 for fnumresult = (anything-c-ggs-set-number-result numresult)
8235 ;; Calculate number of spaces to add before fnumresult
8236 ;; if it is smaller than longest result
8237 ;; `anything-ggs-max-length-num-flag'.
8238 ;; e.g 1,234,567
8239 ;; 345,678
8240 ;; To be sure it is aligned properly.
8241 for nspaces = (if (< (length fnumresult) anything-ggs-max-length-num-flag)
8242 (- anything-ggs-max-length-num-flag (length fnumresult))
8244 ;; Add now the spaces before fnumresult.
8245 for align-fnumresult = (concat (make-string nspaces ? ) fnumresult)
8246 for interval = (- anything-ggs-max-length-real-flag (length real))
8247 for spaces = (make-string (+ 2 interval) ? )
8248 for display = (format "%s%s(%s results)" real spaces align-fnumresult)
8249 collect (cons display real))))
8250 (if (loop for (disp . dat) in suggestions
8251 thereis (equal dat anything-pattern))
8252 suggestions
8253 ;; if there is no suggestion exactly matching the input then
8254 ;; prepend a Search on Google item to the list
8255 (append
8256 suggestions
8257 (list (cons (concat "Search for " "'" anything-input "'" " on Google")
8258 anything-input))))))
8260 (defun anything-c-ggs-set-number-result (num)
8261 (if num
8262 (progn
8263 (and (numberp num) (setq num (number-to-string num)))
8264 (loop for i in (reverse (split-string num "" t))
8265 for count from 1
8266 append (list i) into C
8267 when (= count 3)
8268 append (list ",") into C
8269 and do (setq count 0)
8270 finally return
8271 (replace-regexp-in-string
8272 "^," "" (mapconcat 'identity (reverse C) ""))))
8273 "?"))
8275 (defvar anything-c-google-suggest-default-browser-function nil
8276 "*The browse url function you prefer to use with google suggest.
8277 When nil, use the first browser function available
8278 See `anything-browse-url-default-browser-alist'.")
8280 (defun anything-c-google-suggest-action (candidate)
8281 "Default action to jump to a google suggested candidate."
8282 (let ((arg (concat anything-c-google-suggest-search-url
8283 (url-hexify-string candidate))))
8284 (anything-aif anything-c-google-suggest-default-browser-function
8285 (funcall it arg)
8286 (anything-c-browse-url arg))))
8288 (defvar anything-c-google-suggest-default-function
8289 'anything-c-google-suggest-set-candidates
8290 "Default function to use in anything google suggest.")
8292 (defvar anything-c-source-google-suggest
8293 '((name . "Google Suggest")
8294 (candidates . (lambda ()
8295 (funcall anything-c-google-suggest-default-function)))
8296 (action . (("Google Search" . anything-c-google-suggest-action)))
8297 (volatile)
8298 (requires-pattern . 3)
8299 (delayed)))
8301 (defun anything-c-google-suggest-emacs-lisp ()
8302 "Try to emacs lisp complete with google suggestions."
8303 (anything-c-google-suggest-set-candidates "emacs lisp"))
8305 ;; (anything 'anything-c-source-google-suggest)
8307 ;;; Yahoo suggestions
8310 (defun anything-c-yahoo-suggest-fetch (input)
8311 "Fetch Yahoo suggestions for INPUT from XML buffer.
8312 Return an alist with elements like (data . number_results)."
8313 (let ((request (concat anything-c-yahoo-suggest-url
8314 (url-hexify-string input))))
8315 (flet ((fetch ()
8316 (loop
8317 with result-alist = (xml-get-children
8318 (car (xml-parse-region (point-min) (point-max)))
8319 'Result)
8320 for i in result-alist
8321 collect (caddr i))))
8322 (with-current-buffer
8323 (url-retrieve-synchronously request)
8324 (fetch)))))
8326 (defun anything-c-yahoo-suggest-set-candidates ()
8327 "Set candidates with Yahoo results found."
8328 (let ((suggestions (anything-c-yahoo-suggest-fetch anything-input)))
8329 (or suggestions
8330 (append
8331 suggestions
8332 (list (cons (concat "Search for " "'" anything-input "'" " on Yahoo")
8333 anything-input))))))
8335 (defun anything-c-yahoo-suggest-action (candidate)
8336 "Default action to jump to a Yahoo suggested candidate."
8337 (anything-c-browse-url (concat anything-c-yahoo-suggest-search-url
8338 (url-hexify-string candidate))))
8340 (defvar anything-c-source-yahoo-suggest
8341 '((name . "Yahoo Suggest")
8342 (candidates . anything-c-yahoo-suggest-set-candidates)
8343 (action . (("Yahoo Search" . anything-c-yahoo-suggest-action)))
8344 (volatile)
8345 (requires-pattern . 3)
8346 (delayed)))
8348 ;; (anything 'anything-c-source-yahoo-suggest)
8351 ;;; Web browser functions.
8354 (require 'browse-url)
8355 ;; If default setting of `w3m-command' is not
8356 ;; what you want you and you modify it, you will have to reeval
8357 ;; also `anything-browse-url-default-browser-alist'.
8358 (defvar w3m-command "/usr/bin/w3m")
8359 (defvar anything-c-home-url "http://www.google.fr"
8360 "*Default url to use as home url.")
8362 (defvar ac-browse-url-chromium-program "chromium-browser")
8363 (defvar ac-browse-url-uzbl-program "uzbl-browser")
8364 (defvar anything-browse-url-default-browser-alist
8365 `((,w3m-command . w3m-browse-url)
8366 (,browse-url-firefox-program . browse-url-firefox)
8367 (,ac-browse-url-chromium-program . ac-browse-url-chromium)
8368 (,ac-browse-url-uzbl-program . ac-browse-url-uzbl)
8369 (,browse-url-kde-program . browse-url-kde)
8370 (,browse-url-gnome-moz-program . browse-url-gnome-moz)
8371 (,browse-url-mozilla-program . browse-url-mozilla)
8372 (,browse-url-galeon-program . browse-url-galeon)
8373 (,browse-url-netscape-program . browse-url-netscape)
8374 (,browse-url-mosaic-program . browse-url-mosaic)
8375 (,browse-url-xterm-program . browse-url-text-xterm))
8376 "*Alist of \(executable . function\) to try to find a suitable url browser.")
8378 (defun* anything-c-generic-browser (url name &rest args)
8379 "Browse URL with NAME browser."
8380 (let ((proc (concat name " " url)))
8381 (message "Starting %s..." name)
8382 (apply 'start-process proc nil name
8383 (append args (list url)))
8384 (set-process-sentinel
8385 (get-process proc)
8386 #'(lambda (process event)
8387 (when (string= event "finished\n")
8388 (message "%s process %s" process event))))))
8390 (defun ac-browse-url-chromium (url)
8391 "Browse URL with google chrome browser."
8392 (interactive "sURL: ")
8393 (anything-c-generic-browser
8394 url ac-browse-url-chromium-program))
8396 (defun ac-browse-url-uzbl (url &optional ignore)
8397 "Browse URL with uzbl browser."
8398 (interactive "sURL: ")
8399 (anything-c-generic-browser url ac-browse-url-uzbl-program "-u"))
8401 (defun anything-browse-url-default-browser (url &rest args)
8402 "Find the first available browser and ask it to load URL."
8403 (let ((default-browser-fn
8404 (loop for (exe . fn) in anything-browse-url-default-browser-alist
8405 thereis (and exe (executable-find exe) fn))))
8406 (if default-browser-fn
8407 (apply default-browser-fn url args)
8408 (error "No usable browser found"))))
8410 (defun* anything-c-browse-url (&optional (url anything-c-home-url))
8411 "Default command to browse URL."
8412 (if browse-url-browser-function
8413 (browse-url url)
8414 (anything-browse-url-default-browser url)))
8417 ;;; Surfraw
8419 ;; Need external program surfraw.
8420 ;; <http://surfraw.alioth.debian.org/>
8422 (defvar anything-surfraw-default-browser-function nil
8423 "*The browse url function you prefer to use with surfraw.
8424 When nil, fallback to `browse-url-browser-function'.")
8426 ;; Internal
8427 (defvar anything-surfraw-engines-history nil)
8428 (defvar anything-surfraw-input-history nil)
8430 (defun anything-c-build-elvi-list ()
8431 "Return list of all engines and descriptions handled by surfraw."
8432 (cdr
8433 (with-temp-buffer
8434 (call-process "surfraw" nil t nil
8435 "-elvi")
8436 (split-string (buffer-string) "\n"))))
8439 ;;; Emms
8442 (defun anything-emms-stream-edit-bookmark (elm)
8443 "Change the information of current emms-stream bookmark from anything."
8444 (declare (special emms-stream-list))
8445 (let* ((cur-buf anything-current-buffer)
8446 (bookmark (assoc elm emms-stream-list))
8447 (name (read-from-minibuffer "Description: "
8448 (nth 0 bookmark)))
8449 (url (read-from-minibuffer "URL: "
8450 (nth 1 bookmark)))
8451 (fd (read-from-minibuffer "Feed Descriptor: "
8452 (int-to-string (nth 2 bookmark))))
8453 (type (read-from-minibuffer "Type (url, streamlist, or lastfm): "
8454 (format "%s" (car (last bookmark))))))
8455 (save-excursion
8456 (emms-streams)
8457 (when (re-search-forward (concat "^" name) nil t)
8458 (beginning-of-line)
8459 (emms-stream-delete-bookmark)
8460 (emms-stream-add-bookmark name url (string-to-number fd) type)
8461 (emms-stream-save-bookmarks-file)
8462 (emms-stream-quit)
8463 (anything-c-switch-to-buffer cur-buf)))))
8465 (defun anything-emms-stream-delete-bookmark (elm)
8466 "Delete an emms-stream bookmark from anything."
8467 (let* ((cur-buf anything-current-buffer)
8468 (bookmark (assoc elm emms-stream-list))
8469 (name (nth 0 bookmark)))
8470 (save-excursion
8471 (emms-streams)
8472 (when (re-search-forward (concat "^" name) nil t)
8473 (beginning-of-line)
8474 (emms-stream-delete-bookmark)
8475 (emms-stream-save-bookmarks-file)
8476 (emms-stream-quit)
8477 (anything-c-switch-to-buffer cur-buf)))))
8479 (defvar anything-c-source-emms-streams
8480 '((name . "Emms Streams")
8481 (init . (lambda ()
8482 (emms-stream-init)))
8483 (candidates . (lambda ()
8484 (declare (special emms-stream-list))
8485 (mapcar 'car emms-stream-list)))
8486 (action . (("Play" . (lambda (elm)
8487 (declare (special emms-stream-list))
8488 (let* ((stream (assoc elm emms-stream-list))
8489 (fn (intern (concat "emms-play-" (symbol-name (car (last stream))))))
8490 (url (second stream)))
8491 (funcall fn url))))
8492 ("Delete" . anything-emms-stream-delete-bookmark)
8493 ("Edit" . anything-emms-stream-edit-bookmark)))
8494 (filtered-candidate-transformer . anything-c-adaptive-sort)))
8495 ;; (anything 'anything-c-source-emms-streams)
8497 ;; Don't forget to set `emms-source-file-default-directory'
8498 (defvar anything-c-source-emms-dired
8499 '((name . "Music Directory")
8500 (candidates . (lambda ()
8501 (cddr (directory-files emms-source-file-default-directory))))
8502 (action .
8503 (("Play Directory" . (lambda (item)
8504 (emms-play-directory
8505 (expand-file-name
8506 item
8507 emms-source-file-default-directory))))
8508 ("Open dired in file's directory" . (lambda (item)
8509 (anything-c-open-dired
8510 (expand-file-name
8511 item
8512 emms-source-file-default-directory))))))
8513 (filtered-candidate-transformer . anything-c-adaptive-sort)))
8514 ;; (anything 'anything-c-source-emms-dired)
8517 (defun anything-c-emms-files-modifier (candidates source)
8518 (let ((current-playlist (with-current-emms-playlist
8519 (loop
8520 with cur-list = (emms-playlist-tracks-in-region
8521 (point-min) (point-max))
8522 for i in cur-list
8523 collect (assoc-default 'name i)))))
8524 (loop for i in candidates
8525 if (member (cdr i) current-playlist)
8526 collect (cons (propertize (car i)
8527 'face 'anything-emms-playlist)
8528 (cdr i)) into lis
8529 else collect i into lis
8530 finally return lis)))
8532 (defun anything-c-emms-play-current-playlist ()
8533 "Play current playlist."
8534 (with-current-emms-playlist
8535 (emms-playlist-first)
8536 (emms-playlist-mode-play-smart)))
8538 (defvar anything-c-source-emms-files
8539 '((name . "Emms files")
8540 (candidates . (lambda ()
8541 (loop for v being the hash-values in emms-cache-db
8542 for name = (assoc-default 'name v)
8543 for artist = (or (assoc-default 'info-artist v) "unknown")
8544 for genre = (or (assoc-default 'info-genre v) "unknown")
8545 for tracknum = (or (assoc-default 'info-tracknumber v) "unknown")
8546 for song = (or (assoc-default 'info-title v) "unknown")
8547 for info = (concat artist " - " genre " - " tracknum ": " song)
8548 unless (string-match "^http:" name) collect (cons info name))))
8549 (filtered-candidate-transformer . anything-c-emms-files-modifier)
8550 (action . (("Play file" . emms-play-file)
8551 ("Add to Playlist and play (C-u clear current)"
8552 . (lambda (candidate)
8553 (when anything-current-prefix-arg
8554 (emms-playlist-current-clear))
8555 (emms-playlist-new)
8556 (mapc 'emms-add-playlist-file (anything-marked-candidates))
8557 (unless emms-player-playing-p
8558 (anything-c-emms-play-current-playlist))))))))
8560 ;; (anything 'anything-c-source-emms-files)
8563 ;;; Jabber Contacts (jabber.el)
8564 (defun anything-c-jabber-online-contacts ()
8565 "List online Jabber contacts."
8566 (with-no-warnings
8567 (let (jids)
8568 (dolist (item (jabber-concat-rosters) jids)
8569 (when (get item 'connected)
8570 (push (if (get item 'name)
8571 (cons (get item 'name) item)
8572 (cons (symbol-name item) item)) jids))))))
8574 (defvar anything-c-source-jabber-contacts
8575 '((name . "Jabber Contacts")
8576 (init . (lambda () (require 'jabber)))
8577 (candidates . (lambda () (mapcar 'car (anything-c-jabber-online-contacts))))
8578 (action . (lambda (x)
8579 (jabber-chat-with
8580 (jabber-read-account)
8581 (symbol-name
8582 (cdr (assoc x (anything-c-jabber-online-contacts)))))))))
8583 ;; (anything 'anything-c-source-jabber-contacts)
8587 ;;; Call source.
8588 (defvar anything-source-select-buffer "*anything source select*")
8589 (defvar anything-c-source-call-source
8590 `((name . "Call anything source")
8591 (candidate-number-limit)
8592 (candidates
8593 . (lambda ()
8594 (loop for vname in (all-completions "anything-c-source-" obarray)
8595 for var = (intern vname)
8596 for name = (ignore-errors (assoc-default 'name (symbol-value var)))
8597 if name collect
8598 (cons (format "%s `%s'"
8599 name (propertize vname 'face 'font-lock-variable-name-face))
8600 var))))
8601 (action
8602 . (("Invoke anything with selected source"
8604 (lambda (candidate)
8605 (setq anything-candidate-number-limit 9999)
8606 (anything candidate nil nil nil nil
8607 anything-source-select-buffer)))
8608 ("Describe variable" . describe-variable)
8609 ("Find variable" . find-variable)))
8610 (persistent-action . describe-variable)
8611 (persistent-help . "Show description of this source")))
8612 ;; (anything 'anything-c-source-call-source)
8614 (defun anything-call-source-from-anything ()
8615 "Call anything source within `anything' session."
8616 (interactive)
8617 (setq anything-input-idle-delay 0)
8618 (anything-set-sources '(anything-c-source-call-source)))
8620 ;;; Execute Preconfigured anything.
8621 (defvar anything-c-source-anything-commands
8622 '((name . "Preconfigured Anything")
8623 (candidates . anything-c-anything-commands-candidates)
8624 (type . command)
8625 (candidate-number-limit)))
8626 ;; (anything 'anything-c-source-anything-commands)
8628 (defun anything-c-anything-commands-candidates ()
8629 (loop for (cmd . desc) in (anything-c-list-preconfigured-anything)
8630 collect (cons (if (where-is-internal cmd nil t)
8631 (substitute-command-keys (format "M-x %s (\\[%s]) : %s" cmd cmd desc))
8632 (substitute-command-keys (format "\\[%s] : %s" cmd desc)))
8633 cmd)))
8636 ;;; Occur
8639 (defun anything-c-occur-init ()
8640 "Create the initial anything occur buffer.
8641 If region is active use region as buffer contents
8642 instead of whole buffer."
8643 (with-current-buffer (anything-candidate-buffer 'global)
8644 (erase-buffer)
8645 (let ((buf-contents
8646 (with-anything-current-buffer
8647 (if (anything-region-active-p)
8648 (buffer-substring (region-beginning) (region-end))
8649 (buffer-substring (point-min) (point-max))))))
8650 (insert buf-contents))))
8652 (defun anything-c-occur-get-line (s e)
8653 (format "%7d:%s" (line-number-at-pos (1- s)) (buffer-substring s e)))
8655 (defun anything-c-occur-query-replace-regexp (candidate)
8656 "Query replace regexp starting from CANDIDATE.
8657 If region is active ignore CANDIDATE and replace only in region.
8658 With a prefix arg replace only matches surrounded by word boundaries,
8659 i.e Don't replace inside a word, regexp is surrounded with \\bregexp\\b."
8660 (let ((regexp anything-input))
8661 (unless (anything-region-active-p)
8662 (anything-c-action-line-goto candidate))
8663 (apply 'query-replace-regexp
8664 (anything-c-query-replace-args regexp))))
8666 (defvar anything-c-source-occur
8667 '((name . "Occur")
8668 (init . anything-c-occur-init)
8669 (candidates-in-buffer)
8670 (migemo)
8671 (get-line . anything-c-occur-get-line)
8672 (display-to-real . anything-c-display-to-real-line)
8673 (action . (("Go to Line" . anything-c-action-line-goto)
8674 ("Query replace regexp (C-u Not inside word.)"
8675 . anything-c-occur-query-replace-regexp)))
8676 (recenter)
8677 (requires-pattern . 1)
8678 (delayed)
8679 (volatile)))
8680 ;; (anything 'anything-c-source-occur)
8683 ;;; Anything browse code.
8684 (defun anything-c-browse-code-get-line (beg end)
8685 "Select line if it match the regexp corresponding to current `major-mode'.
8686 Line is parsed for BEG position to END position."
8687 (let ((str-line (buffer-substring beg end))
8688 (regexp (assoc-default major-mode
8689 anything-c-browse-code-regexp-alist))
8690 (num-line (if (string= anything-pattern "") beg (1- beg))))
8691 (when (and regexp (string-match regexp str-line))
8692 (format "%4d:%s" (line-number-at-pos num-line) str-line))))
8695 (defvar anything-c-source-browse-code
8696 '((name . "Browse code")
8697 (init . (lambda ()
8698 (anything-candidate-buffer anything-current-buffer)
8699 (with-anything-current-buffer
8700 (jit-lock-fontify-now))))
8701 (candidate-number-limit . 9999)
8702 (candidates-in-buffer)
8703 (get-line . anything-c-browse-code-get-line)
8704 (type . line)
8705 (recenter)))
8708 ;; Do many actions for input
8709 (defvar anything-c-source-create
8710 '((name . "Create")
8711 (dummy)
8712 (action)
8713 (action-transformer . anything-create--actions))
8714 "Do many create actions from `anything-pattern'.
8715 See also `anything-create--actions'.")
8716 ;; (anything 'anything-c-source-create)
8718 (defun anything-create-from-anything ()
8719 "Run `anything-create' from `anything' as a fallback."
8720 (interactive)
8721 (anything-run-after-quit 'anything-create nil anything-pattern))
8723 (defun anything-create--actions (&rest ignored)
8724 "Default actions for `anything-create' / `anything-c-source-create'."
8725 (remove-if-not
8726 (lambda (pair) (and (consp pair) (functionp (cdr pair))))
8727 (append anything-create--actions-private
8728 '(("find-file" . find-file)
8729 ("find-file other window" . find-file-other-window)
8730 ("New buffer" . anything-c-switch-to-buffer)
8731 ("New buffer other window" . switch-to-buffer-other-window)
8732 ("Bookmark Set" . bookmark-set)
8733 ("Set Register" .
8734 (lambda (x) (set-register (read-char "Register: ") x)))
8735 ("Insert Linkd star" . linkd-insert-star)
8736 ("Insert Linkd Tag" . linkd-insert-tag)
8737 ("Insert Linkd Link" . linkd-insert-link)
8738 ("Insert Linkd Lisp" . linkd-insert-lisp)
8739 ("Insert Linkd Wiki" . linkd-insert-wiki)
8740 ("Google Search" . google)))))
8743 ;; Minibuffer History
8746 (defvar anything-c-source-minibuffer-history
8747 '((name . "Minibuffer History")
8748 (header-name . (lambda (name)
8749 (format "%s (%s)" name minibuffer-history-variable)))
8750 (candidates
8751 . (lambda ()
8752 (let ((history (loop
8753 for i in (symbol-value minibuffer-history-variable)
8754 unless (string= "" i) collect i)))
8755 (if (consp (car history))
8756 (mapcar 'prin1-to-string history)
8757 history))))
8758 (migemo)
8759 (action . insert)))
8760 ;; (anything 'anything-c-source-minibuffer-history)
8763 ;;; Elscreen
8766 (defvar anything-c-source-elscreen
8767 '((name . "Elscreen")
8768 (candidates . (lambda ()
8769 (if (cdr (elscreen-get-screen-to-name-alist))
8770 (sort
8771 (loop for sname in (elscreen-get-screen-to-name-alist)
8772 append (list (format "[%d] %s" (car sname) (cdr sname))) into lst
8773 finally (return lst))
8774 #'(lambda (a b) (compare-strings a nil nil b nil nil))))))
8775 (action . (("Change Screen".
8776 (lambda (candidate)
8777 (elscreen-goto (- (aref candidate 1) (aref "0" 0)))))
8778 ("Kill Screen(s)".
8779 (lambda (candidate)
8780 (dolist (i (anything-marked-candidates))
8781 (elscreen-goto (- (aref i 1) (aref "0" 0)))
8782 (elscreen-kill))))
8783 ("Only Screen".
8784 (lambda (candidate)
8785 (elscreen-goto (- (aref candidate 1) (aref "0" 0)))
8786 (elscreen-kill-others)))))))
8787 ;; (anything 'anything-c-source-elscreen)
8790 ;;;; <System>
8792 ;;; Top (process)
8793 (defvar anything-c-top-command "COLUMNS=%s top -b -n 1"
8794 "Top command (batch mode). %s is replaced with `frame-width'.")
8795 (defvar anything-c-source-top
8796 '((name . "Top (Press C-c C-u to refresh)")
8797 (init . anything-c-top-init)
8798 (candidates-in-buffer)
8799 (display-to-real . anything-c-top-display-to-real)
8800 (update . anything-c-top-update)
8801 (persistent-action . anything-c-top-sh-persistent-action)
8802 (persistent-help . "SIGTERM")
8803 (action
8804 ("kill (TERM)" . (lambda (pid) (anything-c-top-sh (format "kill -TERM %s" pid))))
8805 ("kill (KILL)" . (lambda (pid) (anything-c-top-sh (format "kill -KILL %s" pid))))
8806 ("Copy PID" . (lambda (pid) (kill-new pid))))))
8807 ;; (anything 'anything-c-source-top)
8809 (defun anything-c-top-sh (cmd)
8810 (message "Executed %s\n%s" cmd (shell-command-to-string cmd)))
8812 (defun anything-c-top-sh-persistent-action (pid)
8813 (delete-other-windows)
8814 (anything-c-top-sh (format "kill -TERM %s" pid))
8815 (anything-force-update))
8817 (defun anything-c-top-init ()
8818 (with-current-buffer (anything-candidate-buffer 'global)
8819 (call-process-shell-command
8820 (format anything-c-top-command
8821 (- (frame-width) (if anything-enable-digit-shortcuts 4 0)))
8822 nil (current-buffer))))
8824 (defun anything-c-top-display-to-real (line)
8825 (car (split-string line)))
8827 (defun anything-c-top-update ()
8828 (let ((anything-source-name (assoc-default 'name anything-c-source-top))) ;UGLY HACK
8829 (anything-c-top-init)))
8831 ;;; Timers
8832 (defvar anything-c-source-absolute-time-timers
8833 '((name . "Absolute Time Timers")
8834 (candidates . timer-list)
8835 (type . timer)))
8836 ;; (anything 'anything-c-source-absolute-time-timers)
8838 (defvar anything-c-source-idle-time-timers
8839 '((name . "Idle Time Timers")
8840 (candidates . timer-idle-list)
8841 (type . timer)))
8842 ;; (anything 'anything-c-source-idle-time-timers)
8844 (defun anything-c-timer-real-to-display (timer)
8845 (destructuring-bind (triggered t1 t2 t3 repeat-delay func args idle-delay)
8846 (append timer nil) ;use `append' to convert vector->list
8847 (format "%s repeat=%5S %s(%s)"
8848 (let ((time (list t1 t2 t3)))
8849 (if idle-delay
8850 (format-time-string "idle-for=%5s" time)
8851 (format-time-string "%m/%d %T" time)))
8852 repeat-delay
8853 func
8854 (mapconcat 'prin1-to-string args " "))))
8856 ;;; X RandR resolution change
8857 ;;; FIXME I do not care multi-display.
8858 (defvar anything-c-xrandr-output "VGA")
8859 (defvar anything-c-xrandr-screen "0")
8860 (defvar anything-c-source-xrandr-change-resolution
8861 '((name . "Change Resolution")
8862 (candidates
8863 . (lambda ()
8864 (with-temp-buffer
8865 (call-process "xrandr" nil (current-buffer) nil
8866 "--screen" anything-c-xrandr-screen "-q")
8867 (goto-char 1)
8868 (loop while (re-search-forward " \\([0-9]+x[0-9]+\\)" nil t)
8869 collect (match-string 1)))))
8870 (action
8871 ("Change Resolution" . (lambda (mode)
8872 (call-process "xrandr" nil nil nil
8873 "--screen" anything-c-xrandr-screen
8874 "--output" anything-c-xrandr-output
8875 "--mode" mode))))))
8876 ;; (anything 'anything-c-source-xrandr-change-resolution)
8878 ;;; Xfont selection
8881 (defun anything-c-persistent-xfont-action (elm)
8882 "Show current font temporarily"
8883 (let ((current-font (cdr (assoc 'font (frame-parameters))))
8884 (default-font elm))
8885 (unwind-protect
8886 (progn (set-frame-font default-font 'keep-size) (sit-for 2))
8887 (set-frame-font current-font))))
8889 (defvar anything-c-xfonts-cache nil)
8890 (defvar anything-c-source-xfonts
8891 '((name . "X Fonts")
8892 (init . (lambda ()
8893 (unless anything-c-xfonts-cache
8894 (setq anything-c-xfonts-cache
8895 (x-list-fonts "*")))))
8896 (candidates . anything-c-xfonts-cache)
8897 (action . (("Copy to kill ring" . (lambda (elm)
8898 (kill-new elm)))
8899 ("Set Font" . (lambda (elm)
8900 (kill-new elm)
8901 (set-frame-font elm 'keep-size)
8902 (message "New font have been copied to kill ring")))))
8903 (persistent-action . anything-c-persistent-xfont-action)
8904 (persistent-help . "Switch to this font temporarily")))
8905 ;; (anything 'anything-c-source-xfonts)
8907 ;;; 𝕌𝕔𝕤 𝕊𝕪𝕞𝕓𝕠𝕝 𝕔𝕠𝕞𝕡𝕝𝕖𝕥𝕚𝕠𝕟
8910 (defvar anything-c-ucs-max-len 0)
8911 (defun anything-c-calculate-ucs-max-len ()
8912 "Calculate the length of longest `ucs-names' candidate."
8913 (loop with count = 0
8914 for (n . v) in (ucs-names)
8915 for len = (length n)
8916 if (> len count)
8917 do (setq count len)
8918 finally return count))
8920 (defun anything-c-ucs-init ()
8921 "Initialize an anything buffer with ucs symbols.
8922 Only math* symbols are collected."
8923 (unless (> anything-c-ucs-max-len 0)
8924 (setq anything-c-ucs-max-len
8925 (anything-c-calculate-ucs-max-len)))
8926 (with-current-buffer (anything-candidate-buffer
8927 (get-buffer-create "*anything ucs*"))
8928 ;; `ucs-names' fn will not run again, data is cached in
8929 ;; var `ucs-names'.
8930 (loop for (n . v) in (ucs-names)
8931 for len = (length n)
8932 for diff = (+ (- anything-c-ucs-max-len len) 2)
8933 unless (string= "" n)
8934 do (progn (insert (concat
8935 n ":"
8936 (make-string
8937 diff ? )))
8938 (ucs-insert v)
8939 (insert "\n")))))
8941 (defun anything-c-ucs-forward-char (candidate)
8942 (with-anything-current-buffer
8943 (forward-char 1)))
8945 (defun anything-c-ucs-backward-char (candidate)
8946 (with-anything-current-buffer
8947 (forward-char -1)))
8949 (defun anything-c-ucs-delete-backward (candidate)
8950 (with-anything-current-buffer
8951 (delete-char -1)))
8953 (defun anything-c-ucs-insert-char (candidate)
8954 (with-anything-current-buffer
8955 (insert
8956 (replace-regexp-in-string
8957 " " ""
8958 (cadr (split-string candidate ":"))))))
8960 (defun anything-c-ucs-persistent-insert ()
8961 (interactive)
8962 (anything-attrset 'action-insert 'anything-c-ucs-insert-char)
8963 (anything-execute-persistent-action 'action-insert))
8965 (defun anything-c-ucs-persistent-forward ()
8966 (interactive)
8967 (anything-attrset 'action-forward 'anything-c-ucs-forward-char)
8968 (anything-execute-persistent-action 'action-forward))
8970 (defun anything-c-ucs-persistent-backward ()
8971 (interactive)
8972 (anything-attrset 'action-back 'anything-c-ucs-backward-char)
8973 (anything-execute-persistent-action 'action-back))
8975 (defun anything-c-ucs-persistent-delete ()
8976 (interactive)
8977 (anything-attrset 'action-delete 'anything-c-ucs-delete-backward)
8978 (anything-execute-persistent-action 'action-delete))
8980 (defvar anything-c-source-ucs
8981 '((name . "Ucs names")
8982 (init . anything-c-ucs-init)
8983 (candidate-number-limit . 9999)
8984 (candidates-in-buffer)
8985 (mode-line . anything-c-ucs-mode-line-string)
8986 (action . (("Insert" . anything-c-ucs-insert-char)
8987 ("Forward char" . anything-c-ucs-forward-char)
8988 ("Backward char" . anything-c-ucs-backward-char)
8989 ("Delete char backward" . anything-c-ucs-delete-backward))))
8990 "Source for collecting `ucs-names' math symbols.")
8993 ;;; Emacs process
8996 (defvar anything-c-source-emacs-process
8997 '((name . "Emacs Process")
8998 (candidates . (lambda () (mapcar #'process-name (process-list))))
8999 (persistent-action . (lambda (elm)
9000 (delete-process (get-process elm))
9001 (anything-delete-current-selection)))
9002 (persistent-help . "Kill Process")
9003 (action ("Kill Process" . (lambda (elm)
9004 (delete-process (get-process elm)))))))
9005 ;; (anything 'anything-c-source-emacs-process)
9007 ;;; World time
9010 (defvar anything-c-source-time-world
9011 '((name . "Time World List")
9012 (init . (lambda ()
9013 (let ((anything-buffer (anything-candidate-buffer 'global)))
9014 (with-current-buffer anything-buffer
9015 (display-time-world-display display-time-world-list)))))
9016 (candidates-in-buffer)))
9020 ;;; Anything interface for Debian/Ubuntu packages (apt-*)
9023 (defvar anything-c-source-apt
9024 '((name . "APT")
9025 (init . anything-c-apt-init)
9026 (candidates-in-buffer)
9027 (candidate-transformer anything-c-apt-candidate-transformer)
9028 (display-to-real . anything-c-apt-display-to-real)
9029 (requires-pattern . 2)
9030 (update . anything-c-apt-refresh)
9031 (action
9032 ("Show package description" . anything-c-apt-cache-show)
9033 ("Install package" . anything-c-apt-install)
9034 ("Remove package" . anything-c-apt-uninstall)
9035 ("Purge package" . anything-c-apt-purge))
9036 (persistent-action . anything-c-apt-persistent-action)
9037 (persistent-help . "Show package description")))
9038 ;; (anything 'anything-c-source-apt)
9040 (defvar anything-c-apt-query "emacs")
9041 (defvar anything-c-apt-search-command "apt-cache search '%s'")
9042 (defvar anything-c-apt-show-command "apt-cache show '%s'")
9043 (defvar anything-c-apt-installed-packages nil)
9044 (defvar anything-c-apt-all-packages nil)
9045 (defvar anything-c-apt-input-history nil)
9047 (defun anything-c-apt-refresh ()
9048 "Refresh installed candidates list."
9049 (setq anything-c-apt-installed-packages nil)
9050 (setq anything-c-apt-all-packages nil))
9052 (defun anything-c-apt-persistent-action (candidate)
9053 "Persistent action for APT source."
9054 (anything-c-apt-cache-show candidate))
9056 (defun anything-c-apt-candidate-transformer (candidates)
9057 "Show installed candidates in a different color."
9058 (loop
9059 with all
9060 for cand in candidates
9061 for name = (anything-c-apt-display-to-real cand)
9062 if (member name anything-c-apt-installed-packages)
9063 collect (propertize cand 'face 'anything-apt-installed) into all
9064 else collect cand into all finally return all))
9066 (defun anything-c-apt-init ()
9067 "Initialize list of debian packages."
9068 (let ((query ""))
9069 (unless (and anything-c-apt-installed-packages
9070 anything-c-apt-all-packages)
9071 (message "Loading package list...")
9072 (setq anything-c-apt-installed-packages
9073 (with-temp-buffer
9074 (call-process-shell-command "dpkg --get-selections"
9075 nil (current-buffer))
9076 (loop for i in (split-string (buffer-string) "\n" t)
9077 collect (car (split-string i)))))
9078 (setq anything-c-apt-all-packages
9079 (with-current-buffer
9080 (anything-candidate-buffer
9081 (get-buffer-create (format "*anything-apt*")))
9082 (erase-buffer)
9083 (call-process-shell-command
9084 (format anything-c-apt-search-command query)
9085 nil (current-buffer))))
9086 (message "Loading package list done")
9087 (sit-for 0.5))))
9089 (defun anything-c-apt-display-to-real (line)
9090 "Return only name of a debian package.
9091 LINE is displayed like:
9092 package name - description."
9093 (car (split-string line " - ")))
9095 (defun anything-c-shell-command-if-needed (command)
9096 "Run shell command COMMAND to describe package.
9097 If a buffer named COMMAND already exists, just switch to it."
9098 (let ((buf (get-buffer command)))
9099 (anything-c-switch-to-buffer (get-buffer-create command))
9100 (unless buf (insert (shell-command-to-string command)))))
9102 (defun anything-c-apt-cache-show (package)
9103 "Show information on apt package PACKAGE."
9104 (anything-c-shell-command-if-needed
9105 (format anything-c-apt-show-command package)))
9107 (defun anything-c-apt-install (package)
9108 "Run 'apt-get install' shell command on PACKAGE."
9109 (anything-c-apt-generic-action :action 'install))
9111 (defun anything-c-apt-uninstall (package)
9112 "Run 'apt-get remove' shell command on PACKAGE."
9113 (anything-c-apt-generic-action :action 'uninstall))
9115 (defun anything-c-apt-purge (package)
9116 "Run 'apt-get purge' shell command on PACKAGE."
9117 (anything-c-apt-generic-action :action 'purge))
9119 (defun* anything-c-apt-generic-action (&key action)
9120 "Run 'apt-get ACTION'.
9121 Support install, remove and purge actions."
9122 (ansi-term (getenv "SHELL") "anything apt")
9123 (term-line-mode)
9124 (let ((command (case action
9125 ('install "sudo apt-get install ")
9126 ('uninstall "sudo apt-get remove ")
9127 ('purge "sudo apt-get purge ")
9128 (t (error "Unknow action"))))
9129 (beg (point))
9131 (cand-list (mapconcat #'(lambda (x) (format "'%s'" x))
9132 (anything-marked-candidates) " ")))
9133 (goto-char (point-max))
9134 (insert (concat command cand-list))
9135 (setq end (point))
9136 (if (y-or-n-p (format "%s package" (symbol-name action)))
9137 (progn
9138 (setq anything-c-external-commands-list nil)
9139 (setq anything-c-apt-installed-packages nil)
9140 (term-char-mode) (term-send-input))
9141 (delete-region beg end) (term-send-eof) (kill-buffer))))
9143 ;; (anything-c-apt-install "jed")
9146 ;;; Anything UI for gentoo portage.
9149 (defvar anything-c-gentoo-use-flags nil)
9150 (defvar anything-c-gentoo-buffer "*anything-gentoo-output*")
9151 (defvar anything-c-cache-gentoo nil)
9152 (defvar anything-c-cache-world nil)
9153 (defvar anything-c-source-gentoo
9154 '((name . "Portage sources")
9155 (init . (lambda ()
9156 (get-buffer-create anything-c-gentoo-buffer)
9157 (unless anything-c-cache-gentoo
9158 (anything-c-gentoo-setup-cache))
9159 (unless anything-c-cache-world
9160 (setq anything-c-cache-world (anything-c-gentoo-get-world)))
9161 (anything-c-gentoo-init-list)))
9162 (candidates-in-buffer)
9163 (match . identity)
9164 (candidate-transformer anything-c-highlight-world)
9165 (action . (("Show package" . (lambda (elm)
9166 (anything-c-gentoo-eshell-action elm "eix")))
9167 ("Show history" . (lambda (elm)
9168 (if (member elm anything-c-cache-world)
9169 (anything-c-gentoo-eshell-action elm "genlop -qe")
9170 (message "No infos on packages not yet installed"))))
9171 ("Copy in kill-ring" . kill-new)
9172 ("insert at point" . insert)
9173 ("Browse HomePage" . (lambda (elm)
9174 (let ((urls (anything-c-gentoo-get-url elm)))
9175 (browse-url (anything-comp-read "Url: " urls :must-match t)))))
9176 ("Show extra infos" . (lambda (elm)
9177 (if (member elm anything-c-cache-world)
9178 (anything-c-gentoo-eshell-action elm "genlop -qi")
9179 (message "No infos on packages not yet installed"))))
9180 ("Show use flags" . (lambda (elm)
9181 (anything-c-gentoo-default-action elm "equery" "-C" "u")
9182 (font-lock-add-keywords nil '(("^\+.*" . font-lock-variable-name-face)))
9183 (font-lock-mode 1)))
9184 ("Run emerge pretend" . (lambda (elm)
9185 (anything-c-gentoo-eshell-action elm "emerge -p")))
9186 ("Emerge" . (lambda (elm)
9187 (anything-gentoo-install elm :action 'install)))
9188 ("Unmerge" . (lambda (elm)
9189 (anything-gentoo-install elm :action 'uninstall)))
9190 ("Show dependencies" . (lambda (elm)
9191 (anything-c-gentoo-default-action elm "equery" "-C" "d")))
9192 ("Show related files" . (lambda (elm)
9193 (anything-c-gentoo-default-action elm "equery" "files")))
9194 ("Refresh" . (lambda (elm)
9195 (anything-c-gentoo-setup-cache)
9196 (setq anything-c-cache-world (anything-c-gentoo-get-world))))))))
9198 ;; (anything 'anything-c-source-gentoo)
9200 (defun* anything-gentoo-install (candidate &key action)
9201 (setq anything-c-external-commands-list nil)
9202 (ansi-term (getenv "SHELL") "Gentoo emerge")
9203 (term-line-mode)
9204 (let ((command (case action
9205 ('install "sudo emerge -av ")
9206 ('uninstall "sudo emerge -avC ")
9207 (t (error "Unknow action"))))
9208 (elms (mapconcat 'identity (anything-marked-candidates) " "))
9209 (beg (point)) end)
9210 (goto-char (point-max))
9211 (insert (concat command elms))
9212 (setq end (point))
9213 (term-char-mode) (term-send-input)))
9215 (defun anything-c-gentoo-default-action (elm command &rest args)
9216 "Gentoo default action that use `anything-c-gentoo-buffer'."
9217 (if (member elm anything-c-cache-world)
9218 (progn
9219 (anything-c-switch-to-buffer anything-c-gentoo-buffer)
9220 (erase-buffer)
9221 (let ((com-list (append args (list elm))))
9222 (apply #'call-process command nil t nil
9223 com-list)))
9224 (message "No infos on packages not yet installed")))
9226 (defvar anything-c-source-use-flags
9227 '((name . "Use Flags")
9228 (init . (lambda ()
9229 (unless anything-c-gentoo-use-flags
9230 (anything-c-gentoo-setup-use-flags-cache))
9231 (anything-c-gentoo-get-use)))
9232 (candidates-in-buffer)
9233 (match . identity)
9234 (candidate-transformer anything-c-highlight-local-use)
9235 (action . (("Description"
9236 . (lambda (elm)
9237 (anything-c-switch-to-buffer anything-c-gentoo-buffer)
9238 (erase-buffer)
9239 (apply #'call-process "euse" nil t nil
9240 `("-i"
9241 ,elm))
9242 (font-lock-add-keywords nil `((,elm . font-lock-variable-name-face)))
9243 (font-lock-mode 1)))
9244 ("Enable"
9245 . (lambda (elm)
9246 (anything-c-gentoo-eshell-action elm "*sudo -p Password: euse -E")))
9247 ("Disable"
9248 . (lambda (elm)
9249 (anything-c-gentoo-eshell-action elm "*sudo -p Password: euse -D")))
9250 ("Remove"
9251 . (lambda (elm)
9252 (anything-c-gentoo-eshell-action elm "*sudo -p Password: euse -P")))
9253 ("Show which dep use this flag"
9254 . (lambda (elm)
9255 (anything-c-switch-to-buffer anything-c-gentoo-buffer)
9256 (erase-buffer)
9257 (apply #'call-process "equery" nil t nil
9258 `("-C"
9260 ,elm))))))))
9263 ;; (anything 'anything-c-source-use-flags)
9265 (defun anything-c-gentoo-init-list ()
9266 "Initialize buffer with all packages in Portage."
9267 (let* ((portage-buf (get-buffer-create "*anything-gentoo*"))
9268 (buf (anything-candidate-buffer 'portage-buf)))
9269 (with-current-buffer buf
9270 (dolist (i anything-c-cache-gentoo)
9271 (insert (concat i "\n"))))))
9273 (defun anything-c-gentoo-setup-cache ()
9274 "Set up `anything-c-cache-gentoo'"
9275 (setq anything-c-cache-gentoo
9276 (split-string (with-temp-buffer
9277 (call-process "eix" nil t nil
9278 "--only-names")
9279 (buffer-string)))))
9281 (defun anything-c-gentoo-eshell-action (elm command)
9282 (when (get-buffer "*EShell Command Output*")
9283 (kill-buffer "*EShell Command Output*"))
9284 (message "Wait searching...")
9285 (let ((buf-fname (buffer-file-name anything-current-buffer)))
9286 (if (and buf-fname (string-match tramp-file-name-regexp buf-fname))
9287 (progn
9288 (save-window-excursion
9289 (pop-to-buffer "*scratch*")
9290 (eshell-command (format "%s %s" command elm)))
9291 (pop-to-buffer "*EShell Command Output*"))
9292 (eshell-command (format "%s %s" command elm)))))
9294 (defun anything-c-gentoo-get-use ()
9295 "Initialize buffer with all use flags."
9296 (let* ((use-buf (get-buffer-create "*anything-gentoo-use*"))
9297 (buf (anything-candidate-buffer 'use-buf)))
9298 (with-current-buffer buf
9299 (dolist (i anything-c-gentoo-use-flags)
9300 (insert (concat i "\n"))))))
9303 (defun anything-c-gentoo-setup-use-flags-cache ()
9304 "Setup `anything-c-gentoo-use-flags'"
9305 (setq anything-c-gentoo-use-flags
9306 (split-string (with-temp-buffer
9307 (call-process "eix" nil t nil
9308 "--print-all-useflags")
9309 (buffer-string)))))
9311 (defun anything-c-gentoo-get-url (elm)
9312 "Return a list of urls from eix output."
9313 (loop
9314 with url-list = (split-string
9315 (with-temp-buffer
9316 (call-process "eix" nil t nil
9317 elm "--format" "<homepage>\n")
9318 (buffer-string)))
9319 with all
9320 for i in url-list
9321 when (and (string-match "^http://.*" i)
9322 (not (member i all)))
9323 collect i into all
9324 finally return all))
9326 (defun anything-c-gentoo-get-world ()
9327 "Return list of all installed package on your system."
9328 (split-string (with-temp-buffer
9329 (call-process "qlist" nil t nil
9330 "-I")
9331 (buffer-string))))
9333 (defun anything-c-gentoo-get-local-use ()
9334 (split-string (with-temp-buffer
9335 (call-process "portageq" nil t nil
9336 "envvar"
9337 "USE")
9338 (buffer-string))))
9341 (defun anything-c-highlight-world (eix)
9342 "Highlight all installed package."
9343 (loop for i in eix
9344 if (member i anything-c-cache-world)
9345 collect (propertize i 'face 'anything-gentoo-match-face)
9346 else
9347 collect i))
9349 (defun anything-c-highlight-local-use (use-flags)
9350 (let ((local-uses (anything-c-gentoo-get-local-use)))
9351 (loop for i in use-flags
9352 if (member i local-uses)
9353 collect (propertize i 'face 'anything-gentoo-match-face)
9354 else
9355 collect i)))
9359 ;;; Anything ratpoison UI
9362 (defvar anything-c-source-ratpoison-commands
9363 '((name . "Ratpoison Commands")
9364 (init . anything-c-ratpoison-commands-init)
9365 (candidates-in-buffer)
9366 (action ("Execute the command" . anything-c-ratpoison-commands-execute))
9367 (display-to-real . anything-c-ratpoison-commands-display-to-real)
9368 (candidate-number-limit)))
9369 ;; (anything 'anything-c-source-ratpoison-commands)
9371 (defun anything-c-ratpoison-commands-init ()
9372 (unless (anything-candidate-buffer)
9373 (with-current-buffer (anything-candidate-buffer 'global)
9374 ;; with ratpoison prefix key
9375 (save-excursion
9376 (call-process "ratpoison" nil (current-buffer) nil "-c" "help"))
9377 (while (re-search-forward "^\\([^ ]+\\) \\(.+\\)$" nil t)
9378 (replace-match "<ratpoison> \\1: \\2"))
9379 (goto-char (point-max))
9380 ;; direct binding
9381 (save-excursion
9382 (call-process "ratpoison" nil (current-buffer) nil "-c" "help top"))
9383 (while (re-search-forward "^\\([^ ]+\\) \\(.+\\)$" nil t)
9384 (replace-match "\\1: \\2")))))
9386 (defun anything-c-ratpoison-commands-display-to-real (display)
9387 (and (string-match ": " display)
9388 (substring display (match-end 0))))
9390 (defun anything-c-ratpoison-commands-execute (candidate)
9391 (call-process "ratpoison" nil nil nil "-ic" candidate))
9395 ;;; Anything `completing-read' replacement
9398 (defun anything-comp-read-get-candidates (collection &optional test sort-fn alistp)
9399 "Convert COLLECTION to list removing elements that don't match TEST.
9400 See `anything-comp-read' about supported COLLECTION arguments.
9402 SORT-FN is a predicate to sort COLLECTION.
9404 ALISTP when non--nil will not use `all-completions' to collect
9405 candidates because it doesn't handle alists correctly for anything.
9406 i.e In `all-completions' the keys \(cars of elements\)
9407 are the possible completions. In anything we want to use the cdr instead
9408 like \(display . real\).
9412 \(setq A '((a . 1) (b . 2) (c . 3)))
9413 ==>((a . 1) (b . 2) (c . 3))
9414 \(anything-comp-read \"test: \" A :alistp nil
9415 :exec-when-only-one t
9416 :initial-input \"a\")
9417 ==>\"a\"
9418 \(anything-comp-read \"test: \" A :alistp t
9419 :exec-when-only-one t
9420 :initial-input \"1\")
9421 ==>\"1\"
9423 See docstring of `all-completions' for more info.
9425 If COLLECTION is an `obarray', a TEST should be needed. See `obarray'."
9426 (let ((cands
9427 (cond ((and (eq collection obarray) test)
9428 (all-completions "" collection test))
9429 ((and (vectorp collection) test)
9430 (loop for i across collection when (funcall test i) collect i))
9431 ((vectorp collection)
9432 (loop for i across collection collect i))
9433 ((and alistp test)
9434 (loop for i in collection when (funcall test i) collect i))
9435 ((and (symbolp collection) (boundp collection))
9436 (symbol-value collection))
9437 (alistp collection)
9438 ((and collection test)
9439 (all-completions "" collection test))
9440 (t (all-completions "" collection)))))
9441 (if sort-fn (sort cands sort-fn) cands)))
9443 (defun anything-cr-default-transformer (candidates source)
9444 "Default filter candidate function for `anything-comp-read'.
9445 Do nothing, just return candidate list unmodified."
9446 candidates)
9448 (defun* anything-comp-read (prompt collection
9449 &key
9450 test
9451 initial-input
9452 default
9453 preselect
9454 (buffer "*Anything Completions*")
9455 must-match
9456 (requires-pattern 0)
9457 (history nil)
9458 input-history
9459 (persistent-action nil)
9460 (persistent-help "DoNothing")
9461 (name "Anything Completions")
9462 candidates-in-buffer
9463 exec-when-only-one
9464 (volatile t)
9465 sort
9466 (fc-transformer 'anything-cr-default-transformer)
9467 (marked-candidates nil)
9468 (alistp t))
9469 "Read a string in the minibuffer, with anything completion.
9471 It is anything `completing-read' equivalent.
9473 - PROMPT is the prompt name to use.
9475 - COLLECTION can be a list, vector, obarray or hash-table.
9476 It can be also a function that receives three arguments:
9477 the values string, predicate and t. See `all-completions' for more details.
9479 Keys description:
9481 - TEST: A predicate called with one arg i.e candidate.
9483 - INITIAL-INPUT: Same as input arg in `anything'.
9485 - PRESELECT: See preselect arg of `anything'.
9487 - DEFAULT: This option is used only for compatibility with regular
9488 Emacs `completing-read'.
9490 - BUFFER: Name of anything-buffer.
9492 - MUST-MATCH: Candidate selected must be one of COLLECTION.
9494 - REQUIRES-PATTERN: Same as anything attribute, default is 0.
9496 - HISTORY: A list containing specific history, default is nil.
9497 When it is non--nil, all elements of HISTORY are displayed in
9498 a special source before COLLECTION.
9500 - INPUT-HISTORY: A symbol. the minibuffer input history will be
9501 stored there, if nil or not provided, `minibuffer-history'
9502 will be used instead.
9504 - PERSISTENT-ACTION: A function called with one arg i.e candidate.
9506 - PERSISTENT-HELP: A string to document PERSISTENT-ACTION.
9508 - NAME: The name related to this local source.
9510 - EXEC-WHEN-ONLY-ONE: Bound `anything-execute-action-at-once-if-one'
9511 to non--nil. (possibles values are t or nil).
9513 - VOLATILE: Use volatile attribute \(enabled by default\).
9515 - SORT: A predicate to give to `sort' e.g `string-lessp'.
9517 - FC-TRANSFORMER: A `filtered-candidate-transformer' function.
9519 - MARKED-CANDIDATES: If non--nil return candidate or marked candidates as a list.
9521 - ALISTP: \(default is non--nil\) See `anything-comp-read-get-candidates'.
9523 - CANDIDATES-IN-BUFFER: when non--nil use a source build with
9524 `anything-candidates-in-buffer' which is much faster.
9525 Argument VOLATILE have no effect when CANDIDATES-IN-BUFFER is non--nil.
9527 Any prefix args passed during `anything-comp-read' invocation will be recorded
9528 in `anything-current-prefix-arg', otherwise if prefix args were given before
9529 `anything-comp-read' invocation, the value of `current-prefix-arg' will be used.
9530 That's mean you can pass prefix args before or after calling a command
9531 that use `anything-comp-read' See `anything-M-x' for example."
9532 (when (get-buffer anything-action-buffer)
9533 (kill-buffer anything-action-buffer))
9534 (flet ((action-fn (candidate)
9535 (if marked-candidates
9536 (anything-marked-candidates)
9537 (identity candidate))))
9538 (let* ((src-hist `((name . ,(format "%s History" name))
9539 (candidates
9540 . (lambda ()
9541 (let ((all (anything-comp-read-get-candidates
9542 history nil nil ,alistp)))
9543 (anything-fast-remove-dups
9544 (if (and default (not (string= default "")))
9545 (delq nil (cons default (delete default all)))
9546 all)
9547 :test 'equal))))
9548 (filtered-candidate-transformer
9549 . (lambda (candidates sources)
9550 (loop for i in candidates
9551 do (set-text-properties 0 (length i) nil i)
9552 collect i)))
9553 (persistent-action . ,persistent-action)
9554 (persistent-help . ,persistent-help)
9555 (action . ,'action-fn)))
9556 (src `((name . ,name)
9557 (candidates
9558 . (lambda ()
9559 (let ((cands (anything-comp-read-get-candidates
9560 collection test sort alistp)))
9561 (unless (or must-match (string= anything-pattern ""))
9562 (setq cands (append (list anything-pattern) cands)))
9563 (if (and default (not (string= default "")))
9564 (delq nil (cons default (delete default cands)))
9565 cands))))
9566 (filtered-candidate-transformer ,fc-transformer)
9567 (requires-pattern . ,requires-pattern)
9568 (persistent-action . ,persistent-action)
9569 (persistent-help . ,persistent-help)
9570 (action . ,'action-fn)))
9571 (src-1 `((name . ,name)
9572 (init
9573 . (lambda ()
9574 (let ((cands (anything-comp-read-get-candidates
9575 collection test sort alistp)))
9576 (unless (or must-match (string= anything-pattern ""))
9577 (setq cands (append (list anything-pattern) cands)))
9578 (with-current-buffer (anything-candidate-buffer 'global)
9579 (loop for i in
9580 (if (and default (not (string= default "")))
9581 (delq nil (cons default (delete default cands)))
9582 cands)
9583 do (insert (concat i "\n")))))))
9584 (candidates-in-buffer)
9585 (filtered-candidate-transformer ,fc-transformer)
9586 (requires-pattern . ,requires-pattern)
9587 (persistent-action . ,persistent-action)
9588 (persistent-help . ,persistent-help)
9589 (action . ,'action-fn)))
9590 (src-list (list src-hist
9591 (if candidates-in-buffer
9592 src-1
9593 (if volatile
9594 (append src '((volatile)))
9595 src))))
9596 (anything-execute-action-at-once-if-one exec-when-only-one))
9598 (anything
9599 :sources src-list
9600 :input initial-input
9601 :default default
9602 :preselect preselect
9603 :prompt prompt
9604 :resume 'noresume
9605 :history input-history
9606 :buffer buffer)
9607 (unless (or (eq anything-exit-status 1) must-match)
9608 default)
9609 (keyboard-quit)))))
9611 ;; Generic completing-read
9613 ;; Support also function as collection.
9614 ;; e.g M-x man is supported.
9615 ;; Support hash-table and vectors as collection.
9616 ;; NOTE:
9617 ;; Some crap emacs functions may not be supported
9618 ;; like ffap-alternate-file (bad use of completing-read)
9619 ;; and maybe others.
9620 ;; Provide a mode `anything-completion-mode' which turn on
9621 ;; anything in all `completing-read' and `read-file-name' in Emacs.
9623 (defvar anything-completion-mode-string " AC")
9625 (defvar anything-completion-mode-quit-message
9626 "Anything completion disabled")
9628 (defvar anything-completion-mode-start-message
9629 "Anything completion enabled")
9631 ;;; Specialized handlers
9634 (defun anything-completing-read-symbols
9635 (prompt collection test require-match init
9636 hist default inherit-input-method name buffer)
9637 "Specialized function for fast symbols completion in `ac-mode'."
9639 (anything
9640 :sources `((name . ,name)
9641 (init . (lambda ()
9642 (with-current-buffer (anything-candidate-buffer 'global)
9643 (goto-char (point-min))
9644 (when (and default (stringp default)
9645 ;; Some defaults args result as
9646 ;; (symbol-name nil) == "nil".
9647 ;; e.g debug-on-entry.
9648 (not (string= default "nil"))
9649 (not (string= default "")))
9650 (insert (concat default "\n")))
9651 (loop with all = (all-completions "" collection test)
9652 for sym in all
9653 unless (and default (eq sym default))
9654 do (insert (concat sym "\n"))))))
9655 (persistent-action . anything-lisp-completion-persistent-action)
9656 (persistent-help . "Show brief doc in mode-line")
9657 (candidates-in-buffer)
9658 (action . identity))
9659 :prompt prompt
9660 :buffer buffer
9661 :input init
9662 :history hist
9663 :resume 'noresume
9664 :default (or default ""))
9665 (keyboard-quit)))
9668 ;;; Generic completing read
9671 (defun anything-completing-read-default-1
9672 (prompt collection test require-match
9673 init hist default inherit-input-method
9674 name buffer &optional cands-in-buffer exec-when-only-one)
9675 "Call `anything-comp-read' with same args as `completing-read'.
9676 Extra optional arg CANDS-IN-BUFFER mean use `candidates-in-buffer'
9677 method which is faster.
9678 It should be used when candidate list don't need to rebuild dynamically."
9679 (let ((history (or (car-safe hist) hist)))
9680 (anything-comp-read
9681 prompt collection
9682 :test test
9683 :history history
9684 :input-history history
9685 :must-match require-match
9686 :alistp nil ; Be sure `all-completions' is used.
9687 :name name
9688 :candidates-in-buffer cands-in-buffer
9689 :exec-when-only-one exec-when-only-one
9690 :buffer buffer
9691 ;; If DEF is not provided, fallback to empty string
9692 ;; to avoid `thing-at-point' to be appended on top of list
9693 :default (or default "")
9694 :initial-input init)))
9696 (defun anything-completing-read-with-cands-in-buffer
9697 (prompt collection test require-match
9698 init hist default inherit-input-method
9699 name buffer)
9700 "Same as `anything-completing-read-default-1' but use candidates-in-buffer."
9701 ;; Some commands like find-tag may use `read-file-name' from inside
9702 ;; the calculation of collection. in this case it clash with
9703 ;; candidates-in-buffer that reuse precedent data (files) which is wrong.
9704 ;; So (re)calculate collection outside of main anything-session.
9705 (let ((cands (all-completions "" collection)))
9706 (anything-completing-read-default-1 prompt cands test require-match
9707 init hist default inherit-input-method
9708 name buffer t)))
9710 (defun* anything-completing-read-default
9711 (prompt collection &optional
9712 predicate require-match
9713 initial-input hist def
9714 inherit-input-method)
9715 "An anything replacement of `completing-read'.
9716 This function should be used only as a `completing-read-function'.
9718 Don't use it directly, use instead `anything-comp-read' in your programs.
9720 See documentation of `completing-read' and `all-completions' for details."
9721 (declare (special anything-completion-mode))
9722 (let* ((current-command this-command)
9723 (str-command (symbol-name current-command))
9724 (buf-name (format "*ac-mode-%s*" str-command))
9725 (entry (assq current-command
9726 anything-completing-read-handlers-alist))
9727 (def-com (cdr-safe entry))
9728 (str-defcom (and def-com (symbol-name def-com)))
9729 (def-args (list prompt collection predicate require-match
9730 initial-input hist def inherit-input-method))
9731 ;; Append the two extra args needed to set the buffer and source name
9732 ;; in anything specialized functions.
9733 (any-args (append def-args (list str-command buf-name)))
9734 anything-completion-mode-start-message ; Be quiet
9735 anything-completion-mode-quit-message
9736 (minibuffer-completion-table collection)
9737 (minibuffer-completion-predicate predicate))
9738 (when (eq def-com 'ido) (setq def-com 'ido-completing-read))
9739 (unless (or (not entry) def-com)
9740 ;; An entry in *read-handlers-alist exists but have
9741 ;; a nil value, so we exit from here, disable `ac-mode'
9742 ;; and run the command again with it original behavior.
9743 ;; `ac-mode' will be restored on exit.
9744 (return-from anything-completing-read-default
9745 (unwind-protect
9746 (progn
9747 (ac-mode -1)
9748 (apply completing-read-function def-args))
9749 (ac-mode 1))))
9750 ;; If we use now `completing-read' we MUST turn off `ac-mode'
9751 ;; to avoid infinite recursion and CRASH. It will be reenabled on exit.
9752 (when (or (eq def-com 'completing-read)
9753 ;; All specialized functions are prefixed by "anything"
9754 (and (stringp str-defcom)
9755 (not (string-match "^anything" str-defcom))))
9756 (ac-mode -1))
9757 (unwind-protect
9758 (cond (;; An anything specialized function exists, run it.
9759 (and def-com anything-completion-mode)
9760 (apply def-com any-args))
9761 (;; Try to handle `ido-completing-read' everywhere.
9762 (and def-com (eq def-com 'ido-completing-read))
9763 (setcar (memq collection def-args)
9764 (all-completions "" collection predicate))
9765 (apply def-com def-args))
9766 (;; User set explicitely `completing-read' or something similar
9767 ;; in *read-handlers-alist, use this with exactly the same
9768 ;; args as in `completing-read'.
9769 ;; If we are here `anything-completion-mode' is now disabled.
9770 def-com
9771 (apply def-com def-args))
9772 (t ; Fall back to classic `anything-comp-read'.
9773 (anything-completing-read-default-1
9774 prompt collection predicate require-match
9775 initial-input hist def inherit-input-method
9776 str-command buf-name)))
9777 (ac-mode 1)
9778 ;; When exiting minibuffer, `this-command' is set to
9779 ;; `anything-exit-minibuffer', which is unwanted when starting
9780 ;; on another `completing-read', so restore `this-command' to
9781 ;; initial value when exiting.
9782 (setq this-command current-command))))
9784 (defun* anything-generic-read-file-name
9785 (prompt &optional dir default-filename mustmatch initial predicate)
9786 "An anything replacement of `read-file-name'."
9787 (declare (special anything-completion-mode))
9788 (let* ((default (and default-filename
9789 (if (listp default-filename)
9790 (car default-filename)
9791 default-filename)))
9792 (init (or default initial dir default-directory))
9793 (ini-input (and init (expand-file-name init)))
9794 (current-command this-command)
9795 (str-command (symbol-name current-command))
9796 (anything-file-completion-sources
9797 (cons str-command
9798 (remove str-command anything-file-completion-sources)))
9799 (buf-name (format "*ac-mode-%s*" str-command))
9800 (entry (assq current-command
9801 anything-completing-read-handlers-alist))
9802 (def-com (cdr-safe entry))
9803 (str-defcom (symbol-name def-com))
9804 (def-args (list prompt dir default-filename mustmatch initial predicate))
9805 ;; Append the two extra args needed to set the buffer and source name
9806 ;; in anything specialized functions.
9807 (any-args (append def-args (list str-command buf-name)))
9808 (ido-state ido-mode)
9809 anything-completion-mode-start-message ; Be quiet
9810 anything-completion-mode-quit-message ; Same here
9811 fname)
9812 ;; Some functions that normally call `completing-read' can switch
9813 ;; brutally to `read-file-name' (e.g find-tag), in this case
9814 ;; the anything specialized function will fail because it is build
9815 ;; for `completing-read', so set it to 'incompatible to be sure
9816 ;; we switch to `anything-c-read-file-name' and don't try to call it
9817 ;; with wrong number of args.
9818 (when (and def-com (> (length (help-function-arglist def-com)) 8))
9819 (setq def-com 'incompatible))
9820 (when (eq def-com 'ido) (setq def-com 'ido-read-file-name))
9821 (unless (or (not entry) def-com)
9822 (return-from anything-generic-read-file-name
9823 (unwind-protect
9824 (progn
9825 (ac-mode -1)
9826 (apply read-file-name-function def-args))
9827 (ac-mode 1))))
9828 ;; If we use now `read-file-name' we MUST turn off `ac-mode'
9829 ;; to avoid infinite recursion and CRASH. It will be reenabled on exit.
9830 (when (or (eq def-com 'read-file-name)
9831 (eq def-com 'ido-read-file-name)
9832 (and (stringp str-defcom)
9833 (not (string-match "^anything" str-defcom))))
9834 (ac-mode -1))
9835 (unwind-protect
9836 (setq fname
9837 (cond (;; A specialized function exists, run it
9838 ;; with the two extra args specific to anything..
9839 (and def-com anything-completion-mode
9840 (not (eq def-com 'ido-read-file-name))
9841 (not (eq def-com 'incompatible)))
9842 (apply def-com any-args))
9843 (;; Def-com value is `ido-read-file-name'
9844 ;; run it with default args.
9845 (and def-com (eq def-com 'ido-read-file-name))
9846 (ido-mode 1)
9847 (apply def-com def-args))
9848 (;; Def-com value is `read-file-name'
9849 ;; run it with default args.
9850 (eq def-com 'read-file-name)
9851 (apply def-com def-args))
9852 (t ; Fall back to classic `anything-c-read-file-name'.
9853 (anything-c-read-file-name
9854 prompt
9855 :name str-command
9856 :buffer buf-name
9857 :initial-input (expand-file-name init dir)
9858 :alistp nil
9859 :test predicate))))
9860 (ac-mode 1)
9861 (ido-mode (if ido-state 1 -1))
9862 ;; Same comment as in `anything-completing-read-default'.
9863 (setq this-command current-command))
9864 (if (and mustmatch (not (file-exists-p fname)))
9865 (if (y-or-n-p "File does not exists, create buffer?")
9866 fname (error "Abort file does not exists"))
9867 fname)))
9869 ;;;###autoload
9870 (define-minor-mode anything-completion-mode
9871 "Toggle generic anything completion.
9873 All functions in Emacs that use `completing-read'
9874 or `read-file-name' and friends will use anything interface
9875 when this mode is turned on.
9876 However you can modify this behavior for functions of your choice
9877 with `anything-completing-read-handlers-alist'.
9879 Called with a positive arg, turn on unconditionally, with a
9880 negative arg turn off.
9881 You can turn it on with `ac-mode'.
9883 Some crap emacs functions may not be supported,
9884 e.g `ffap-alternate-file' and maybe others
9885 You can add such functions to `anything-completing-read-handlers-alist'
9886 with a nil value.
9888 Note: This mode will work only partially on Emacs23."
9889 :group 'anything
9890 :global t
9891 :lighter anything-completion-mode-string
9892 (declare (special completing-read-function))
9893 (if anything-completion-mode
9894 (progn
9895 (setq completing-read-function 'anything-completing-read-default
9896 read-file-name-function 'anything-generic-read-file-name)
9897 (message anything-completion-mode-start-message))
9898 (setq completing-read-function (and (fboundp 'completing-read-default)
9899 'completing-read-default)
9900 read-file-name-function (and (fboundp 'read-file-name-default)
9901 'read-file-name-default))
9902 (message anything-completion-mode-quit-message)))
9904 (defalias 'ac-mode 'anything-completion-mode)
9908 ;;; Eshell completion.
9910 ;; Enable like this in .emacs:
9912 ;; (add-hook 'eshell-mode-hook
9913 ;; #'(lambda ()
9914 ;; (define-key eshell-mode-map [remap pcomplete] 'anything-esh-pcomplete)))
9916 (defvar anything-c-source-esh
9917 '((name . "Eshell completions")
9918 (init . (lambda ()
9919 (setq pcomplete-current-completions nil
9920 pcomplete-last-completion-raw nil)
9921 ;; Eshell-command add this hook in all minibuffers
9922 ;; Remove it for the anything one. (Fixed in Emacs24)
9923 (remove-hook 'minibuffer-setup-hook 'eshell-mode)))
9924 (candidates . anything-esh-get-candidates)
9925 (action . anything-ec-insert))
9926 "Anything source for Eshell completion.")
9928 ;; Internal.
9929 (defvar anything-ec-target "")
9930 (defun anything-ec-insert (candidate)
9931 "Insert CANDIDATE at point.
9932 This is the same as `ac-insert', just inlined here for compatibility."
9933 (let ((pt (point)))
9934 (when (and anything-ec-target
9935 (search-backward anything-ec-target nil t)
9936 (string= (buffer-substring (point) pt) anything-ec-target))
9937 (delete-region (point) pt)))
9938 (insert candidate))
9940 (defun anything-esh-get-candidates ()
9941 "Get candidates for eshell completion using `pcomplete'."
9942 (catch 'pcompleted
9943 (let* ((pcomplete-stub)
9944 pcomplete-seen pcomplete-norm-func
9945 pcomplete-args pcomplete-last pcomplete-index
9946 (pcomplete-autolist pcomplete-autolist)
9947 (pcomplete-suffix-list pcomplete-suffix-list))
9948 (with-anything-current-buffer
9949 (loop
9950 with table = (pcomplete-completions)
9951 with entry = (condition-case nil
9952 ;; For Emacs24
9953 (try-completion anything-pattern (pcomplete-entries))
9954 ;; Fall back to this in Emacs23 as pcomplete-entries seem broken.
9955 (error
9957 (let ((fc (car (last (pcomplete-parse-arguments)))))
9958 ;; Check if last arg require fname completion.
9959 (and (file-name-directory fc) fc))))
9960 for i in (if (listp table) table ; Emacs23 or commands.
9961 (all-completions pcomplete-stub table)) ; Emacs24
9962 for file-cand = (and entry
9963 (if (file-remote-p i) i
9964 (expand-file-name i (file-name-directory entry))))
9965 if (and file-cand (or (file-remote-p file-cand) (file-exists-p file-cand)))
9966 collect file-cand into ls
9967 else collect i into ls
9968 finally return
9969 (if (and entry (not (string= entry "")) (file-exists-p entry))
9970 (append (list (expand-file-name entry default-directory)) ls) ls))))))
9972 ;;; Eshell history.
9975 (defvar anything-c-source-eshell-history
9976 '((name . "Eshell history")
9977 (init . (lambda ()
9978 (let (eshell-hist-ignoredups)
9979 ;; Write the content's of ring to file.
9980 (eshell-write-history eshell-history-file-name t)
9981 (with-current-buffer (anything-candidate-buffer 'global)
9982 (insert-file-contents eshell-history-file-name)))
9983 ;; Same comment as in `anything-c-source-esh'
9984 (remove-hook 'minibuffer-setup-hook 'eshell-mode)))
9985 (candidates-in-buffer)
9986 (filtered-candidate-transformer . (lambda (candidates sources)
9987 (reverse candidates)))
9988 (candidate-number-limit . 9999)
9989 (action . (lambda (candidate)
9990 (eshell-kill-input)
9991 (insert candidate))))
9992 "Anything source for Eshell history.")
9995 ;;; Show completion - an alternative of anything-show-completion.el.
9997 ;; Provide show completion with macro `with-anything-show-completion'.
10000 ;; Called each time cursor move in anything-buffer.
10001 (defun anything-c-show-completion ()
10002 (with-anything-current-buffer
10003 (overlay-put anything-c-show-completion-overlay
10004 'display (anything-get-selection))))
10006 (defun anything-c-show-completion-init-overlay (beg end)
10007 (and anything-c-turn-on-show-completion
10008 (setq anything-c-show-completion-overlay (make-overlay beg end))
10009 (overlay-put anything-c-show-completion-overlay
10010 'face 'anything-lisp-show-completion)))
10012 (defmacro with-anything-show-completion (beg end &rest body)
10013 "Show anything candidate in an overlay at point.
10014 BEG and END are the beginning and end position of the current completion
10015 in `anything-current-buffer'.
10016 BODY is an anything call where we want to enable show completion.
10017 If `anything-c-turn-on-show-completion' is nil just do nothing."
10018 (declare (indent 2) (debug t))
10019 `(let ((anything-move-selection-after-hook
10020 (and anything-c-turn-on-show-completion
10021 (append (list 'anything-c-show-completion)
10022 anything-move-selection-after-hook))))
10023 (unwind-protect
10024 (progn (anything-c-show-completion-init-overlay ,beg ,end)
10025 ,@body)
10026 (and anything-c-turn-on-show-completion
10027 (delete-overlay anything-c-show-completion-overlay)))))
10030 ;;; Lisp symbol completion.
10033 ;;;###autoload
10034 (defun anything-lisp-completion-at-point ()
10035 "Anything lisp symbol completion at point."
10036 (interactive)
10037 (let* ((data (lisp-completion-at-point))
10038 (beg (car data))
10039 (end (point)) ; 'cadr data' is wrong when no space after point.
10040 (plist (nthcdr 3 data))
10041 (pred (plist-get plist :predicate))
10042 (lgst-len 0)
10043 (target (and beg end (buffer-substring-no-properties beg end)))
10044 (candidates (all-completions target (nth 2 data) pred))
10045 (anything-quit-if-no-candidate t)
10046 (anything-execute-action-at-once-if-one t)
10047 (anything-match-plugin-enabled
10048 (member 'anything-compile-source--match-plugin
10049 anything-compile-source-functions)))
10050 (if candidates
10051 (with-anything-show-completion beg end
10052 ;; Overlay is initialized now in anything-current-buffer.
10053 (anything
10054 :sources
10055 '((name . "Lisp completion")
10056 (init . (lambda ()
10057 (with-current-buffer (anything-candidate-buffer 'global)
10058 (loop for sym in candidates
10059 for len = (length sym)
10060 when (> len lgst-len) do (setq lgst-len len)
10061 do (insert (concat sym "\n"))))))
10062 (candidates-in-buffer)
10063 (persistent-action . anything-lisp-completion-persistent-action)
10064 (persistent-help . "Show brief doc in mode-line")
10065 (filtered-candidate-transformer anything-lisp-completion-transformer)
10066 (action . (lambda (candidate)
10067 (delete-region beg end)
10068 (insert candidate))))
10069 :input (if anything-match-plugin-enabled (concat target " ") target)))
10070 (message "[No Match]"))))
10072 (defun anything-lisp-completion-persistent-action (candidate)
10073 (let ((cursor-in-echo-area t)
10074 mode-line-in-non-selected-windows)
10075 (anything-c-show-info-in-mode-line
10076 (propertize
10077 (anything-c-get-first-line-documentation
10078 (intern candidate))
10079 'face 'anything-lisp-completion-info))))
10081 (defun anything-lisp-completion-transformer (candidates source)
10082 "Anything candidates transformer for lisp completion."
10083 (declare (special lgst-len))
10084 (loop for c in candidates
10085 for sym = (intern c)
10086 for annot = (cond ((commandp sym) " (Com)")
10087 ((fboundp sym) " (Fun)")
10088 ((boundp sym) " (Var)")
10089 ((facep sym) " (Face)"))
10090 for spaces = (make-string (- lgst-len (length c)) ? )
10091 collect (cons (concat c spaces annot) c)))
10093 (defun anything-c-get-first-line-documentation (sym)
10094 "Return first line documentation of symbol SYM.
10095 If SYM is not documented, return \"Not documented\"."
10096 (let ((doc (cond ((fboundp sym)
10097 (documentation sym t))
10098 ((boundp sym)
10099 (documentation-property sym 'variable-documentation t))
10100 ((facep sym)
10101 (face-documentation sym))
10102 (t nil))))
10103 (if (and doc (not (string= doc ""))
10104 ;; `documentation' return "\n\n(args...)"
10105 ;; for CL-style functions.
10106 (not (string-match-p "^\n\n" doc)))
10107 (car (split-string doc "\n"))
10108 "Not documented")))
10110 ;;; File completion.
10112 ;; Complete file name at point.
10113 (defun anything-c-thing-before-point ()
10114 "Get symbol name before point.
10115 Borrowed from anything-complete.el, inlined here for compatibility."
10116 (save-excursion
10117 (let ((beg (point)))
10118 ;; older regexp "\(\\|\\s-\\|^\\|\\_<\\|\r\\|'\\|#'"
10119 (when (re-search-backward
10120 "\\_<" (field-beginning nil nil (point-at-bol)) t)
10121 (buffer-substring-no-properties beg (match-end 0))))))
10123 ;;;###autoload
10124 (defun anything-c-complete-file-name-at-point ()
10125 "Complete file name at point."
10126 (interactive)
10127 (let* ((init (substring-no-properties (thing-at-point 'filename)))
10128 (end (point))
10129 (beg (- (point) (length init)))
10130 (anything-quit-if-no-candidate t)
10131 (anything-execute-action-at-once-if-one t)
10132 completion)
10133 (with-anything-show-completion beg end
10134 (setq completion (anything-c-read-file-name "FileName: "
10135 :initial-input init)))
10136 (anything-c-insert-file-name-completion-at-point completion)))
10138 ;; Internal
10139 (defvar anything-lisp-completion-counter 0)
10140 ;;;###autoload
10141 (defun anything-lisp-completion-at-point-or-indent (arg)
10142 "First call indent and second call complete lisp symbol.
10143 The second call should happen before `anything-lisp-completion-or-indent-delay',
10144 after this delay, next call will indent again.
10145 After completion, next call is always indent.
10146 See that like click and double mouse click.
10147 One hit indent, two quick hits maybe indent and complete."
10148 (interactive "P")
10149 ;; Be sure `indent-for-tab-command' will not try
10150 ;; to use `completion-at-point'.
10151 (let ((tab-always-indent (if (eq tab-always-indent 'complete)
10152 t tab-always-indent)))
10153 (incf anything-lisp-completion-counter)
10154 (unwind-protect
10155 (if (> anything-lisp-completion-counter 1)
10156 (anything-lisp-completion-or-file-name-at-point)
10157 (indent-for-tab-command arg))
10158 ;; After `anything-lisp-completion-or-indent-delay' seconds
10159 ;; reset to 0.
10160 (run-with-timer anything-lisp-completion-or-indent-delay nil
10161 #'(lambda ()
10162 (setq anything-lisp-completion-counter 0)))
10163 ;; Always reset to 0 at second hit.
10164 (when (eq anything-lisp-completion-counter 2)
10165 (setq anything-lisp-completion-counter 0)))))
10167 ;;;###autoload
10168 (defun anything-lisp-completion-or-file-name-at-point ()
10169 "Complete lisp symbol or filename at point.
10170 Filename completion happen if filename is started in
10171 or between double quotes."
10172 (interactive)
10173 (let ((tap (substring-no-properties (thing-at-point 'filename))))
10174 (if (and tap (string-match "^\\(~/\\|/\\|[a-zA-Z]\:/\\).*" tap)
10175 (save-excursion (search-backward "\"" (point-at-bol) t)))
10176 (anything-c-complete-file-name-at-point)
10177 (anything-lisp-completion-at-point))))
10179 (defun anything-c-apropos-init (test default)
10180 "Init candidates buffer for `anything-c-apropos' sources."
10181 (with-current-buffer (anything-candidate-buffer 'global)
10182 (goto-char (point-min))
10183 (when (and default (stringp default)
10184 ;; Some defaults args result as
10185 ;; (symbol-name nil) == "nil".
10186 ;; e.g debug-on-entry.
10187 (not (string= default "nil"))
10188 (funcall test (intern default)))
10189 (insert (concat default "\n")))
10190 (loop with all = (all-completions "" obarray test)
10191 for sym in all
10192 unless (and default (eq sym default))
10193 do (insert (concat sym "\n")))))
10196 ;;; Run Externals commands within Emacs with anything completion
10199 (defvar anything-external-command-history nil)
10201 (defun anything-c-external-commands-list-1 (&optional sort)
10202 "Returns a list of all external commands the user can execute.
10203 If `anything-c-external-commands-list' is non-nil it will
10204 return its contents. Else it calculates all external commands
10205 and sets `anything-c-external-commands-list'."
10206 (if anything-c-external-commands-list
10207 anything-c-external-commands-list
10208 (setq anything-c-external-commands-list
10209 (loop
10210 with paths = (split-string (getenv "PATH") path-separator)
10211 with completions = ()
10212 for dir in paths
10213 when (and (file-exists-p dir) (file-accessible-directory-p dir))
10214 for lsdir = (loop for i in (directory-files dir t)
10215 for bn = (file-name-nondirectory i)
10216 when (and (not (member bn completions))
10217 (not (file-directory-p i))
10218 (file-executable-p i))
10219 collect bn)
10220 append lsdir into completions
10221 finally return (if sort (sort completions 'string-lessp) completions)))))
10223 (defun anything-run-or-raise (exe &optional file)
10224 "Generic command that run asynchronously EXE.
10225 If EXE is already running just jump to his window if `anything-raise-command'
10226 is non--nil.
10227 When FILE argument is provided run EXE with FILE.
10228 In this case EXE must be provided as \"EXE %s\"."
10229 (lexical-let* ((real-com (car (split-string (replace-regexp-in-string
10230 "%s" "" exe))))
10231 (proc (if file (concat real-com " " file) real-com)))
10232 (if (get-process proc)
10233 (if anything-raise-command
10234 (shell-command (format anything-raise-command real-com))
10235 (error "Error: %s is already running" real-com))
10236 (when (loop for i in anything-c-external-commands-list thereis real-com)
10237 (message "Starting %s..." real-com)
10238 (if file
10239 (start-process-shell-command
10240 proc nil (format exe (shell-quote-argument file)))
10241 (start-process-shell-command proc nil real-com))
10242 (set-process-sentinel
10243 (get-process proc)
10244 #'(lambda (process event)
10245 (when (and (string= event "finished\n")
10246 anything-raise-command
10247 (not (anything-c-get-pid-from-process-name real-com)))
10248 (shell-command (format anything-raise-command "emacs")))
10249 (message "%s process...Finished." process))))
10250 (setq anything-c-external-commands-list
10251 (cons real-com
10252 (delete real-com anything-c-external-commands-list))))))
10256 ;;; Generic action functions
10259 (defun anything-c-file-buffers (filename)
10260 "Returns a list of buffer names corresponding to FILENAME."
10261 (let ((name (expand-file-name filename))
10262 (buf-list ()))
10263 (dolist (buf (buffer-list) buf-list)
10264 (let ((bfn (buffer-file-name buf)))
10265 (when (and bfn (string= name bfn))
10266 (push (buffer-name buf) buf-list))))))
10268 (defun anything-revert-buffer (candidate)
10269 (with-current-buffer candidate
10270 (when (or (buffer-modified-p)
10271 (not (verify-visited-file-modtime
10272 (get-buffer candidate))))
10273 (revert-buffer t t))))
10275 (defun anything-revert-marked-buffers (ignore)
10276 (mapc 'anything-revert-buffer (anything-marked-candidates)))
10278 (defun anything-kill-marked-buffers (ignore)
10279 (mapc 'kill-buffer (anything-marked-candidates)))
10281 (defun anything-c-delete-file (file &optional error-if-dot-file-p)
10282 "Delete the given file after querying the user.
10283 Ask to kill buffers associated with that file, too."
10284 (when (and error-if-dot-file-p
10285 (anything-ff-dot-file-p file))
10286 (error "Error: Cannot operate on `.' or `..'"))
10287 (let ((buffers (anything-c-file-buffers file)))
10288 (if (< emacs-major-version 24)
10289 ;; `dired-delete-file' in Emacs versions < 24
10290 ;; doesn't support delete-by-moving-to-trash
10291 ;; so use `delete-directory' and `delete-file'
10292 ;; that handle it.
10293 (cond ((and (not (file-symlink-p file))
10294 (file-directory-p file)
10295 (directory-files file t dired-re-no-dot))
10296 (when (y-or-n-p (format "Recursive delete of `%s'? " file))
10297 (delete-directory file 'recursive)))
10298 ((and (not (file-symlink-p file))
10299 (file-directory-p file))
10300 (delete-directory file))
10301 (t (delete-file file)))
10302 (dired-delete-file
10303 file 'dired-recursive-deletes delete-by-moving-to-trash))
10304 (when buffers
10305 (dolist (buf buffers)
10306 (when (y-or-n-p (format "Kill buffer %s, too? " buf))
10307 (kill-buffer buf))))))
10309 (defun anything-get-mailcap-for-file (filename)
10310 "Get the command to use for FILENAME from mailcap files.
10311 The command is like <command %s> and is meant to use with `format'."
10312 (mailcap-parse-mailcaps)
10313 (let* ((ext (file-name-extension filename))
10314 (mime (when ext (mailcap-extension-to-mime ext)))
10315 (result (when mime (mailcap-mime-info mime))))
10316 ;; If elisp file have no associations in .mailcap
10317 ;; `mailcap-maybe-eval' is returned, in this case just return nil.
10318 (when (stringp result) result)))
10320 (defun anything-get-default-program-for-file (filename)
10321 "Try to find a default program to open FILENAME.
10322 Try first in `anything-c-external-programs-associations' and then in mailcap file
10323 if nothing found return nil."
10324 (let* ((ext (file-name-extension filename))
10325 (def-prog (assoc-default ext anything-c-external-programs-associations)))
10326 (cond ((and def-prog (not (string= def-prog "")))
10327 (concat def-prog " %s"))
10328 ((and anything-c-default-external-file-browser
10329 (file-directory-p filename))
10330 (concat anything-c-default-external-file-browser " %s"))
10331 (t (anything-get-mailcap-for-file filename)))))
10333 (defun anything-c-open-file-externally (file)
10334 "Open FILE with an external program.
10335 Try to guess which program to use with `anything-get-default-program-for-file'.
10336 If not found or a prefix arg is given query the user which tool to use."
10337 (let* ((fname (expand-file-name file))
10338 (collection (anything-c-external-commands-list-1 'sort))
10339 (def-prog (anything-get-default-program-for-file fname))
10340 (real-prog-name (if (or anything-current-prefix-arg (not def-prog))
10341 ;; Prefix arg or no default program.
10342 (prog1
10343 (anything-comp-read
10344 "Program: " collection
10345 :must-match t
10346 :name "Open file Externally"
10347 :history anything-external-command-history)
10348 ;; Always prompt to set this program as default.
10349 (setq def-prog nil))
10350 ;; No prefix arg or default program exists.
10351 (replace-regexp-in-string " %s\\| '%s'" "" def-prog)))
10352 (program (concat real-prog-name " %s")))
10353 (unless (or def-prog ; Association exists, no need to record it.
10354 ;; Don't try to record non--filenames associations (e.g urls).
10355 (not (file-exists-p fname)))
10356 (when
10357 (y-or-n-p
10358 (format
10359 "Do you want to make `%s' the default program for this kind of files? "
10360 real-prog-name))
10361 (anything-aif (assoc (file-name-extension fname)
10362 anything-c-external-programs-associations)
10363 (setq anything-c-external-programs-associations
10364 (delete it anything-c-external-programs-associations)))
10365 (push (cons (file-name-extension fname)
10366 (read-string
10367 "Program (Add args maybe and confirm): " real-prog-name))
10368 anything-c-external-programs-associations)
10369 (customize-save-variable 'anything-c-external-programs-associations
10370 anything-c-external-programs-associations)))
10371 (anything-run-or-raise program file)
10372 (setq anything-external-command-history
10373 (cons real-prog-name
10374 (delete real-prog-name
10375 (loop for i in anything-external-command-history
10376 when (executable-find i) collect i))))))
10378 (defun anything-c-find-file-or-marked (candidate)
10379 "Open file CANDIDATE or open anything marked files in background."
10380 (let ((marked (anything-marked-candidates))
10381 (ffap-newfile-prompt anything-ff-newfile-prompt-p)
10382 (find-file-wildcards nil))
10383 (if (> (length marked) 1)
10384 ;; Open all marked files in background and display
10385 ;; the first one.
10386 (progn (mapc 'find-file-noselect (cdr marked))
10387 (find-file (car marked)))
10388 (if (and (not (file-exists-p candidate))
10389 (and ffap-url-regexp
10390 (not (string-match ffap-url-regexp candidate)))
10391 (string-match "/$" candidate))
10392 ;; A a non--existing filename ending with /
10393 ;; Create a directory and jump to it.
10394 (when (y-or-n-p (format "Create directory `%s'? " candidate))
10395 (let ((dirfname (directory-file-name candidate)))
10396 (if (file-exists-p dirfname)
10397 (error "Mkdir: Unable to create directory `%s': file exists."
10398 (anything-c-basename dirfname))
10399 (make-directory candidate 'parent)))
10400 (anything-find-files-1 candidate))
10401 ;; A non--existing filename NOT ending with / or
10402 ;; an existing filename, create or jump to it.
10403 (find-file-at-point (car marked))))))
10405 (defun anything-delete-marked-files (ignore)
10406 (let* ((files (anything-marked-candidates))
10407 (len (length files)))
10408 (if (not (y-or-n-p
10409 (format "Delete *%s File(s):\n%s"
10411 (mapconcat (lambda (f) (format "- %s\n" f)) files ""))))
10412 (message "(No deletions performed)")
10413 (dolist (i files)
10414 (set-text-properties 0 (length i) nil i)
10415 (anything-c-delete-file i anything-ff-signal-error-on-dot-files))
10416 (message "%s File(s) deleted" len))))
10418 (defun anything-ediff-marked-buffers (candidate &optional merge)
10419 "Ediff 2 marked buffers or CANDIDATE and `anything-current-buffer'.
10420 With optional arg MERGE call `ediff-merge-buffers'."
10421 (let ((lg-lst (length (anything-marked-candidates)))
10422 buf1 buf2)
10423 (case lg-lst
10425 (error "Error:You have to mark at least 1 buffer"))
10427 (setq buf1 anything-current-buffer
10428 buf2 (first (anything-marked-candidates))))
10430 (setq buf1 (first (anything-marked-candidates))
10431 buf2 (second (anything-marked-candidates))))
10433 (error "Error:To much buffers marked!")))
10434 (if merge
10435 (ediff-merge-buffers buf1 buf2)
10436 (ediff-buffers buf1 buf2))))
10438 (defun anything-ediff-marked-buffers-merge (candidate)
10439 "Ediff merge `anything-current-buffer' with CANDIDATE.
10440 See `anything-ediff-marked-buffers'."
10441 (anything-ediff-marked-buffers candidate t))
10443 (defun anything-bookmark-get-bookmark-from-name (bmk)
10444 "Return bookmark name even if it is a bookmark with annotation.
10445 e.g prepended with *.
10446 Return nil if bmk is not a valid bookmark."
10447 (let ((bookmark (replace-regexp-in-string "\*" "" bmk)))
10448 (if (assoc bookmark bookmark-alist)
10449 bookmark
10450 (when (assoc bmk bookmark-alist)
10451 bmk))))
10453 (defun anything-delete-marked-bookmarks (ignore)
10454 "Delete this bookmark or all marked bookmarks."
10455 (dolist (i (anything-marked-candidates))
10456 (bookmark-delete (anything-bookmark-get-bookmark-from-name i)
10457 'batch)))
10459 (defun anything-require-or-error (feature function)
10460 (or (require feature nil t)
10461 (error "Need %s to use `%s'." feature function)))
10463 (defun anything-find-buffer-on-elscreen (candidate)
10464 "Open buffer in new screen, if marked buffers open all in elscreens."
10465 (anything-require-or-error 'elscreen 'anything-find-buffer-on-elscreen)
10466 (anything-aif (anything-marked-candidates)
10467 (dolist (i it)
10468 (let ((target-screen (elscreen-find-screen-by-buffer
10469 (get-buffer i) 'create)))
10470 (elscreen-goto target-screen)))
10471 (let ((target-screen (elscreen-find-screen-by-buffer
10472 (get-buffer candidate) 'create)))
10473 (elscreen-goto target-screen))))
10475 (defun anything-elscreen-find-file (file)
10476 (anything-require-or-error 'elscreen 'anything-elscreen-find-file)
10477 (elscreen-find-file file))
10479 ;;;###autoload
10480 (defun w32-shell-execute-open-file (file)
10481 (interactive "fOpen file:")
10482 (with-no-warnings
10483 (w32-shell-execute "open" (replace-regexp-in-string ;for UNC paths
10484 "/" "\\"
10485 (replace-regexp-in-string ; strip cygdrive paths
10486 "/cygdrive/\\(.\\)" "\\1:"
10487 file nil nil) nil t))))
10489 (defun anything-c-open-file-with-default-tool (file)
10490 "Open FILE with the default tool on this platform."
10491 (if (eq system-type 'windows-nt)
10492 (w32-shell-execute-open-file file)
10493 (start-process "anything-c-open-file-with-default-tool"
10495 (cond ((eq system-type 'gnu/linux)
10496 "xdg-open")
10497 ((or (eq system-type 'darwin) ;; Mac OS X
10498 (eq system-type 'macos)) ;; Mac OS 9
10499 "open"))
10500 file)))
10502 (defun anything-c-open-dired (file)
10503 "Opens a dired buffer in FILE's directory. If FILE is a
10504 directory, open this directory."
10505 (if (file-directory-p file)
10506 (dired file)
10507 (dired (file-name-directory file))
10508 (dired-goto-file file)))
10510 (defun anything-c-display-to-real-line (candidate)
10511 (if (string-match "^ *\\([0-9]+\\):\\(.*\\)$" candidate)
10512 (list (string-to-number (match-string 1 candidate)) (match-string 2 candidate))
10513 (error "Line number not found")))
10515 (defun anything-c-action-line-goto (lineno-and-content)
10516 (apply #'anything-goto-file-line (anything-interpret-value (anything-attr 'target-file))
10517 (append lineno-and-content
10518 (list (if (and (anything-attr-defined 'target-file)
10519 (not anything-in-persistent-action))
10520 'find-file-other-window
10521 'find-file)))))
10523 (defun* anything-c-action-file-line-goto (file-line-content &optional (find-file-function #'find-file))
10524 (apply #'anything-goto-file-line
10525 (if (stringp file-line-content)
10526 ;; Case: filtered-candidate-transformer is skipped
10527 (cdr (anything-c-filtered-candidate-transformer-file-line-1 file-line-content))
10528 file-line-content)))
10530 (require 'compile)
10531 (defun anything-c-filtered-candidate-transformer-file-line (candidates source)
10532 (delq nil (mapcar 'anything-c-filtered-candidate-transformer-file-line-1 candidates)))
10534 (defun anything-c-filtered-candidate-transformer-file-line-1 (candidate)
10535 (when (string-match "^\\(.+?\\):\\([0-9]+\\):\\(.*\\)$" candidate)
10536 (let ((filename (match-string 1 candidate))
10537 (lineno (match-string 2 candidate))
10538 (content (match-string 3 candidate)))
10539 (cons (format "%s:%s\n %s"
10540 (propertize filename 'face compilation-info-face)
10541 (propertize lineno 'face compilation-line-face)
10542 content)
10543 (list (expand-file-name
10544 filename
10545 (or (anything-interpret-value (anything-attr 'default-directory))
10546 (and (anything-candidate-buffer)
10547 (buffer-local-value
10548 'default-directory (anything-candidate-buffer)))))
10549 (string-to-number lineno) content)))))
10551 (defun* anything-goto-file-line (file lineno content &optional (find-file-function #'find-file))
10552 (anything-aif (anything-attr 'before-jump-hook)
10553 (funcall it))
10554 (when file (funcall find-file-function file))
10555 (if (anything-attr-defined 'adjust)
10556 (anything-c-goto-line-with-adjustment lineno content)
10557 (anything-goto-line lineno))
10558 (unless (anything-attr-defined 'recenter)
10559 (set-window-start (get-buffer-window anything-current-buffer) (point)))
10560 (anything-aif (anything-attr 'after-jump-hook)
10561 (funcall it))
10562 (when anything-in-persistent-action
10563 (anything-match-line-color-current-line)))
10565 (defun anything-find-file-as-root (candidate)
10566 (find-file (concat "/" anything-su-or-sudo "::" (expand-file-name candidate))))
10568 (defun anything-find-many-files (ignore)
10569 (mapc 'find-file (anything-marked-candidates)))
10571 ;; borrowed from etags.el
10572 ;; (anything-c-goto-line-with-adjustment (line-number-at-pos) ";; borrowed from etags.el")
10573 (defun anything-c-goto-line-with-adjustment (line line-content)
10574 (let ((startpos)
10575 offset found pat)
10576 ;; This constant is 1/2 the initial search window.
10577 ;; There is no sense in making it too small,
10578 ;; since just going around the loop once probably
10579 ;; costs about as much as searching 2000 chars.
10580 (setq offset 1000
10581 found nil
10582 pat (concat (if (eq selective-display t)
10583 "\\(^\\|\^m\\) *" "^ *") ;allow indent
10584 (regexp-quote line-content)))
10585 ;; If no char pos was given, try the given line number.
10586 (setq startpos (progn (anything-goto-line line) (point)))
10587 (or startpos (setq startpos (point-min)))
10588 ;; First see if the tag is right at the specified location.
10589 (goto-char startpos)
10590 (setq found (looking-at pat))
10591 (while (and (not found)
10592 (progn
10593 (goto-char (- startpos offset))
10594 (not (bobp))))
10595 (setq found
10596 (re-search-forward pat (+ startpos offset) t)
10597 offset (* 3 offset))) ; expand search window
10598 (or found
10599 (re-search-forward pat nil t)
10600 (error "not found")))
10601 ;; Position point at the right place
10602 ;; if the search string matched an extra Ctrl-m at the beginning.
10603 (and (eq selective-display t)
10604 (looking-at "\^m")
10605 (forward-char 1))
10606 (beginning-of-line))
10608 (anything-document-attribute 'default-directory "type . file-line"
10609 "`default-directory' to interpret file.")
10610 (anything-document-attribute 'before-jump-hook "type . file-line / line"
10611 "Function to call before jumping to the target location.")
10612 (anything-document-attribute 'after-jump-hook "type . file-line / line"
10613 "Function to call after jumping to the target location.")
10614 (anything-document-attribute 'adjust "type . file-line"
10615 "Search around line matching line contents.")
10616 (anything-document-attribute 'recenter "type . file-line / line"
10617 "`recenter' after jumping.")
10618 (anything-document-attribute 'target-file "type . line"
10619 "Goto line of target-file.")
10621 ;;;###autoload
10622 (defun anything-c-call-interactively (cmd-or-name)
10623 "Execute CMD-OR-NAME as Emacs command.
10624 It is added to `extended-command-history'.
10625 `anything-current-prefix-arg' is used as the command's prefix argument."
10626 (setq extended-command-history
10627 (cons (anything-c-stringify cmd-or-name)
10628 (delete (anything-c-stringify cmd-or-name) extended-command-history)))
10629 (let ((current-prefix-arg anything-current-prefix-arg)
10630 (cmd (anything-c-symbolify cmd-or-name)))
10631 (if (stringp (symbol-function cmd))
10632 (execute-kbd-macro (symbol-function cmd))
10633 (setq this-command cmd)
10634 (call-interactively cmd))))
10636 ;;;###autoload
10637 (defun anything-c-set-variable (var)
10638 "Set value to VAR interactively."
10639 (interactive)
10640 (let ((sym (anything-c-symbolify var)))
10641 (set sym (eval-minibuffer (format "Set %s: " var)
10642 (prin1-to-string (symbol-value sym))))))
10643 ;; (setq hh 12)
10644 ;; (anything-c-set-variable 'hh)
10648 ;;; Persistent Action Helpers
10651 (defvar anything-match-line-overlay-face nil)
10652 (defvar anything-match-line-overlay nil)
10654 (defun anything-match-line-color-current-line (&optional start end buf face rec)
10655 "Highlight and underline current position"
10656 (let ((args (list (or start (line-beginning-position))
10657 (or end (1+ (line-end-position)))
10658 buf)))
10659 (if (not anything-match-line-overlay)
10660 (setq anything-match-line-overlay (apply 'make-overlay args))
10661 (apply 'move-overlay anything-match-line-overlay args)))
10662 (overlay-put anything-match-line-overlay
10663 'face (or face anything-match-line-overlay-face))
10664 (when rec
10665 (goto-char start)
10666 (recenter)))
10668 (defalias 'anything-persistent-highlight-point 'anything-match-line-color-current-line)
10671 (setq anything-match-line-overlay-face 'anything-overlay-line-face)
10673 (defun anything-match-line-cleanup ()
10674 (when anything-match-line-overlay
10675 (delete-overlay anything-match-line-overlay)
10676 (setq anything-match-line-overlay nil)))
10678 (defun anything-match-line-update ()
10679 (when anything-match-line-overlay
10680 (delete-overlay anything-match-line-overlay)
10681 (anything-match-line-color-current-line)))
10683 (add-hook 'anything-cleanup-hook 'anything-match-line-cleanup)
10684 (add-hook 'anything-after-persistent-action-hook 'anything-match-line-update)
10687 ;;; Actions Transformers
10690 ;;; Files
10691 (defun anything-c-transform-file-load-el (actions candidate)
10692 "Add action to load the file CANDIDATE if it is an emacs lisp
10693 file. Else return ACTIONS unmodified."
10694 (if (member (file-name-extension candidate) '("el" "elc"))
10695 (append actions '(("Load Emacs Lisp File" . load-file)))
10696 actions))
10698 (defun anything-c-transform-file-browse-url (actions candidate)
10699 "Add an action to browse the file CANDIDATE if it in a html
10700 file or URL. Else return ACTIONS unmodified."
10701 (let ((browse-action '("Browse with Browser" . browse-url)))
10702 (cond ((string-match "^http\\|^ftp" candidate)
10703 (cons browse-action actions))
10704 ((string-match "\\.html?$" candidate)
10705 (append actions (list browse-action)))
10706 (t actions))))
10708 ;;; Function
10709 (defun anything-c-transform-function-call-interactively (actions candidate)
10710 "Add an action to call the function CANDIDATE interactively if
10711 it is a command. Else return ACTIONS unmodified."
10712 (if (commandp (intern-soft candidate))
10713 (append actions '(("Call Interactively"
10715 anything-c-call-interactively)))
10716 actions))
10718 ;;;; S-Expressions
10719 (defun anything-c-transform-sexp-eval-command-sexp (actions candidate)
10720 "If CANDIDATE's `car' is a command, then add an action to
10721 evaluate it and put it onto the `command-history'."
10722 (if (commandp (car (read candidate)))
10723 ;; Make it first entry
10724 (cons '("Eval and put onto command-history" .
10725 (lambda (sexp)
10726 (let ((sym (read sexp)))
10727 (eval sym)
10728 (setq command-history
10729 (cons sym command-history)))))
10730 actions)
10731 actions))
10734 ;;; Candidate Transformers
10737 ;;; Buffers
10738 (defun anything-c-skip-boring-buffers (buffers)
10739 (anything-c-skip-entries buffers anything-c-boring-buffer-regexp))
10741 (defun anything-c-skip-current-buffer (buffers)
10742 (if anything-allow-skipping-current-buffer
10743 (remove (buffer-name anything-current-buffer) buffers)
10744 buffers))
10746 (defun anything-c-shadow-boring-buffers (buffers)
10747 "Buffers matching `anything-c-boring-buffer-regexp' will be
10748 displayed with the `file-name-shadow' face if available."
10749 (anything-c-shadow-entries buffers anything-c-boring-buffer-regexp))
10751 (defvar anything-c-buffer-display-string-functions
10752 '(anything-c-buffer-display-string--compilation
10753 anything-c-buffer-display-string--shell
10754 anything-c-buffer-display-string--eshell)
10755 "Functions to setup display string for buffer.
10757 Function has one argument, buffer name.
10758 If it returns string, use it.
10759 If it returns nil, display buffer name.
10760 See `anything-c-buffer-display-string--compilation' for example.")
10762 (defun anything-c-transform-buffer-display-string (buffers)
10763 "Setup display string for buffer candidates
10764 using `anything-c-buffer-display-string-functions'."
10765 (loop for buf in buffers
10766 if (consp buf)
10767 collect buf
10768 else
10769 for disp = (progn (set-buffer buf)
10770 (run-hook-with-args-until-success
10771 'anything-c-buffer-display-string-functions buf))
10772 collect (if disp (cons disp buf) buf)))
10774 (defun anything-c-buffer-display-string--compilation (buf)
10775 (anything-aif (car compilation-arguments)
10776 (format "%s: %s [%s]" buf it default-directory)))
10778 (defun anything-c-buffer-display-string--eshell (buf)
10779 (declare (special eshell-history-ring))
10780 (when (eq major-mode 'eshell-mode)
10781 (format "%s: %s [%s]" buf
10782 (ignore-errors (ring-ref eshell-history-ring 0))
10783 default-directory)))
10785 (defun anything-c-buffer-display-string--shell (buf)
10786 (when (eq major-mode 'shell-mode)
10787 (format "%s: %s [%s]" buf
10788 (ignore-errors (ring-ref comint-input-ring 0))
10789 default-directory)))
10791 ;;; Files
10792 (defun anything-c-shadow-boring-files (files)
10793 "Files matching `anything-c-boring-file-regexp' will be
10794 displayed with the `file-name-shadow' face if available."
10795 (anything-c-shadow-entries files anything-c-boring-file-regexp))
10797 (defun anything-c-skip-boring-files (files)
10798 "Files matching `anything-c-boring-file-regexp' will be skipped."
10799 (anything-c-skip-entries files anything-c-boring-file-regexp))
10800 ;; (anything-c-skip-boring-files '("README" "/src/.svn/hoge"))
10802 (defun anything-c-skip-current-file (files)
10803 "Current file will be skipped."
10804 (remove (buffer-file-name anything-current-buffer) files))
10806 (defun anything-c-w32-pathname-transformer (args)
10807 "Change undesirable features of windows pathnames to ones more acceptable to
10808 other candidate transformers."
10809 (if (eq system-type 'windows-nt)
10810 (mapcar (lambda (x)
10811 (replace-regexp-in-string "/cygdrive/\\(.\\)" "\\1:" x))
10812 (mapcar (lambda (y)
10813 (replace-regexp-in-string "\\\\" "/" y)) args))
10814 args))
10816 (defun anything-c-shorten-home-path (files)
10817 "Replaces /home/user with ~."
10818 (let ((home (replace-regexp-in-string "\\\\" "/" ; stupid Windows...
10819 (getenv "HOME"))))
10820 (mapcar (lambda (file)
10821 (if (and (stringp file) (string-match home file))
10822 (cons (replace-match "~" nil nil file) file)
10823 file))
10824 files)))
10826 ;;; Functions
10827 (defun anything-c-mark-interactive-functions (functions)
10828 "Mark interactive functions (commands) with (i) after the function name."
10829 (let (list)
10830 (loop for function in functions
10831 do (push (cons (concat function
10832 (when (commandp (intern-soft function)) " (i)"))
10833 function)
10834 list)
10835 finally (return (nreverse list)))))
10838 ;;; Adaptive Sorting of Candidates
10841 ;; Internal
10842 (defvar anything-c-adaptive-done nil
10843 "nil if history information is not yet stored for the current
10844 selection.")
10846 (defvar anything-c-adaptive-history nil
10847 "Contains the stored history information.
10848 Format: ((SOURCE-NAME (SELECTED-CANDIDATE (PATTERN . NUMBER-OF-USE) ...) ...) ...)")
10850 (defadvice anything-initial-setup (before anything-c-adaptive-initialize activate)
10851 "Reset `anything-c-adaptive-done' when anything is started."
10852 (when anything-c-use-adaptative-sorting
10853 (setq anything-c-adaptive-done nil)))
10855 (defadvice anything-exit-minibuffer (before anything-c-adaptive-exit-minibuffer activate)
10856 "Store history information when action is executed on selected candidate."
10857 (when anything-c-use-adaptative-sorting
10858 (anything-c-adaptive-store-selection)))
10860 (defadvice anything-select-action (before anything-c-adaptive-select-action activate)
10861 "Store history information when the user goes to the action buffer."
10862 (when anything-c-use-adaptative-sorting
10863 (anything-c-adaptive-store-selection)))
10865 (defun anything-c-source-use-adaptative-p (&optional source-name)
10866 "Return current source only if it use adaptative history, nil otherwise."
10867 (when anything-c-use-adaptative-sorting
10868 (let* ((source (or source-name (anything-get-current-source)))
10869 (adapt-source (or (assoc-default 'filtered-candidate-transformer
10870 (assoc (assoc-default 'type source)
10871 anything-type-attributes))
10872 (assoc-default 'candidate-transformer
10873 (assoc (assoc-default 'type source)
10874 anything-type-attributes))
10875 (assoc-default 'filtered-candidate-transformer source)
10876 (assoc-default 'candidate-transformer source))))
10877 (if (listp adapt-source)
10878 (when (member 'anything-c-adaptive-sort adapt-source) source)
10879 (when (eq adapt-source 'anything-c-adaptive-sort) source)))))
10881 (defun anything-c-adaptive-store-selection ()
10882 "Store history information for the selected candidate."
10883 (unless anything-c-adaptive-done
10884 (setq anything-c-adaptive-done t)
10885 (let ((source (anything-c-source-use-adaptative-p)))
10886 (when source
10887 (let* ((source-name (or (assoc-default 'type source)
10888 (assoc-default 'name source)))
10889 (source-info (or (assoc source-name anything-c-adaptive-history)
10890 (progn
10891 (push (list source-name) anything-c-adaptive-history)
10892 (car anything-c-adaptive-history))))
10893 (selection (anything-get-selection))
10894 (selection-info (progn
10895 (setcdr source-info
10896 (cons
10897 (let ((found (assoc selection (cdr source-info))))
10898 (if (not found)
10899 ;; new entry
10900 (list selection)
10902 ;; move entry to the beginning of the
10903 ;; list, so that it doesn't get
10904 ;; trimmed when the history is
10905 ;; truncated
10906 (setcdr source-info
10907 (delete found (cdr source-info)))
10908 found))
10909 (cdr source-info)))
10910 (cadr source-info)))
10911 (pattern-info (progn
10912 (setcdr selection-info
10913 (cons
10914 (let ((found (assoc anything-pattern (cdr selection-info))))
10915 (if (not found)
10916 ;; new entry
10917 (cons anything-pattern 0)
10919 ;; move entry to the beginning of the
10920 ;; list, so if two patterns used the
10921 ;; same number of times then the one
10922 ;; used last appears first in the list
10923 (setcdr selection-info
10924 (delete found (cdr selection-info)))
10925 found))
10926 (cdr selection-info)))
10927 (cadr selection-info))))
10929 ;; increase usage count
10930 (setcdr pattern-info (1+ (cdr pattern-info)))
10932 ;; truncate history if needed
10933 (if (> (length (cdr selection-info)) anything-c-adaptive-history-length)
10934 (setcdr selection-info
10935 (subseq (cdr selection-info) 0 anything-c-adaptive-history-length))))))))
10937 (defun anything-c-adaptative-maybe-load-history ()
10938 (when (and anything-c-use-adaptative-sorting
10939 (file-readable-p anything-c-adaptive-history-file))
10940 (load-file anything-c-adaptive-history-file)))
10942 (add-hook 'emacs-startup-hook 'anything-c-adaptative-maybe-load-history)
10943 (add-hook 'kill-emacs-hook 'anything-c-adaptive-save-history)
10945 (defun anything-c-adaptive-save-history (&optional arg)
10946 "Save history information to file given by `anything-c-adaptive-history-file'."
10947 (interactive "p")
10948 (when anything-c-use-adaptative-sorting
10949 (with-temp-buffer
10950 (insert
10951 ";; -*- mode: emacs-lisp -*-\n"
10952 ";; History entries used for anything adaptive display.\n")
10953 (prin1 `(setq anything-c-adaptive-history ',anything-c-adaptive-history)
10954 (current-buffer))
10955 (insert ?\n)
10956 (write-region (point-min) (point-max) anything-c-adaptive-history-file nil
10957 (unless arg 'quiet)))))
10959 (defun anything-c-adaptive-sort (candidates source)
10960 "Sort the CANDIDATES for SOURCE by usage frequency.
10961 This is a filtered candidate transformer you can use for the
10962 attribute `filtered-candidate-transformer' of a source in
10963 `anything-sources' or a type in `anything-type-attributes'."
10964 (let* ((source-name (or (assoc-default 'type source)
10965 (assoc-default 'name source)))
10966 (source-info (assoc source-name anything-c-adaptive-history)))
10967 (if source-info
10968 (let ((usage
10969 ;; ... assemble a list containing the (CANIDATE . USAGE-COUNT)
10970 ;; pairs
10971 (mapcar (lambda (candidate-info)
10972 (let ((count 0))
10973 (dolist (pattern-info (cdr candidate-info))
10974 (if (not (equal (car pattern-info)
10975 anything-pattern))
10976 (incf count (cdr pattern-info))
10978 ;; if current pattern is equal to the previously
10979 ;; used one then this candidate has priority
10980 ;; (that's why its count is boosted by 10000) and
10981 ;; it only has to compete with other candidates
10982 ;; which were also selected with the same pattern
10983 (setq count (+ 10000 (cdr pattern-info)))
10984 (return)))
10985 (cons (car candidate-info) count)))
10986 (cdr source-info)))
10987 sorted)
10988 (if (and usage (consp usage))
10989 ;; sort the list in descending order, so candidates with highest
10990 ;; priorty come first
10991 (progn
10992 (setq usage (sort usage (lambda (first second)
10993 (> (cdr first) (cdr second)))))
10995 ;; put those candidates first which have the highest usage count
10996 (dolist (info usage)
10997 (when (member* (car info) candidates
10998 :test 'anything-c-adaptive-compare)
10999 (push (car info) sorted)
11000 (setq candidates (remove* (car info) candidates
11001 :test 'anything-c-adaptive-compare))))
11003 ;; and append the rest
11004 (append (reverse sorted) candidates nil))
11005 (message "Your `%s' is maybe corrupted or too old, \
11006 you should reinitialize it with `anything-c-reset-adaptative-history'"
11007 anything-c-adaptive-history-file)
11008 (sit-for 1)
11009 candidates))
11010 ;; if there is no information stored for this source then do nothing
11011 candidates)))
11013 ;;;###autoload
11014 (defun anything-c-reset-adaptative-history ()
11015 "Delete all `anything-c-adaptive-history' and his file.
11016 Useful when you have a old or corrupted `anything-c-adaptive-history-file'."
11017 (interactive)
11018 (when (y-or-n-p "Really delete all your `anything-c-adaptive-history'? ")
11019 (setq anything-c-adaptive-history nil)
11020 (delete-file anything-c-adaptive-history-file)))
11022 (defun anything-c-adaptive-compare (x y)
11023 "Compare candidates X and Y taking into account that the
11024 candidate can be in (DISPLAY . REAL) format."
11025 (equal (if (listp x)
11026 (cdr x)
11028 (if (listp y)
11029 (cdr y)
11030 y)))
11034 ;;; Outliner
11037 (defvar anything-outline-goto-near-line-flag t)
11038 (defvar anything-outline-using nil)
11039 (defun anything-after-update-hook--outline ()
11040 (if (and (eq anything-outline-using t)
11041 (eq anything-outline-goto-near-line-flag t))
11042 (anything-outline-goto-near-line)))
11043 (add-hook 'anything-after-update-hook 'anything-after-update-hook--outline)
11045 (defun anything-outline-goto-near-line ()
11046 (with-anything-window
11047 ;; TODO need consideration whether to update position by every input.
11048 (when t ; (equal anything-pattern "")
11049 (anything-goto-line 2)
11050 (let ((lineno (with-anything-current-buffer
11051 (line-number-at-pos (car anything-current-position)))))
11052 (block exit
11053 (while (<= (progn (skip-chars-forward " ")
11054 (or (number-at-point) lineno))
11055 lineno)
11056 (forward-line 1)
11057 (when (eobp)
11058 (forward-line -1)
11059 (return-from exit))))
11060 (forward-line -1)
11061 (and (bobp) (forward-line 1))
11062 (and (anything-pos-header-line-p) (forward-line -2))
11063 (anything-mark-current-line)))))
11067 ;;; Plug-in
11070 ;; Plug-in: info-index
11071 (defun* anything-c-info-init (&optional (file (anything-attr 'info-file)))
11072 (let (result)
11073 (unless (anything-candidate-buffer)
11074 (save-window-excursion
11075 (info file)
11076 (let (Info-history
11077 (tobuf (anything-candidate-buffer 'global))
11078 (infobuf (current-buffer))
11079 s e)
11080 (dolist (node (or (anything-attr 'index-nodes) (Info-index-nodes)))
11081 (Info-goto-node node)
11082 (goto-char (point-min))
11083 (while (search-forward "\n* " nil t)
11084 (unless (search-forward "Menu:\n" (1+ (point-at-eol)) t)
11085 '(save-current-buffer (buffer-substring-no-properties (point-at-bol) (point-at-eol)) result)
11086 (setq s (point-at-bol)
11087 e (point-at-eol))
11088 (with-current-buffer tobuf
11089 (insert-buffer-substring infobuf s e)
11090 (insert "\n"))))))))))
11092 (defun anything-c-info-goto (node-line)
11093 (Info-goto-node (car node-line))
11094 (anything-goto-line (cdr node-line)))
11096 (defun anything-c-info-display-to-real (line)
11097 (and (string-match
11098 ;; This regexp is stolen from Info-apropos-matches
11099 "\\* +\\([^\n]*.+[^\n]*\\):[ \t]+\\([^\n]*\\)\\.\\(?:[ \t\n]*(line +\\([0-9]+\\))\\)?" line)
11100 (cons (format "(%s)%s" (anything-attr 'info-file) (match-string 2 line))
11101 (string-to-number (or (match-string 3 line) "1")))))
11103 (defun anything-c-make-info-source (source file)
11104 `(,@source
11105 (name . ,(concat "Info Index: " file))
11106 (info-file . ,file)
11107 (init . anything-c-info-init)
11108 (display-to-real . anything-c-info-display-to-real)
11109 (get-line . buffer-substring)
11110 (candidates-in-buffer)
11111 (action ("Goto node" . anything-c-info-goto))))
11113 (defun anything-compile-source--info-index (source)
11114 (anything-aif (anything-interpret-value (assoc-default 'info-index source))
11115 (anything-c-make-info-source source it)
11116 source))
11117 (add-to-list 'anything-compile-source-functions 'anything-compile-source--info-index)
11119 (anything-document-attribute 'info-index "info-index plugin"
11120 "Create a source of info index very easily.
11122 ex. (defvar anything-c-source-info-wget '((info-index . \"wget\"))")
11124 (anything-document-attribute 'index-nodes "info-index plugin (optional)"
11125 "Index nodes of info file.
11127 If it is omitted, `Info-index-nodes' is used to collect index nodes.
11128 Some info files are missing index specification.
11130 ex. See `anything-c-source-info-screen'.")
11132 ;; Plug-in: candidates-file
11133 (defun anything-compile-source--candidates-file (source)
11134 (if (assoc-default 'candidates-file source)
11135 `((init anything-p-candidats-file-init
11136 ,@(let ((orig-init (assoc-default 'init source)))
11137 (cond ((null orig-init) nil)
11138 ((functionp orig-init) (list orig-init))
11139 (t orig-init))))
11140 (candidates-in-buffer)
11141 ,@source)
11142 source))
11143 (add-to-list 'anything-compile-source-functions 'anything-compile-source--candidates-file)
11145 (defun anything-p-candidats-file-init ()
11146 (destructuring-bind (file &optional updating)
11147 (anything-mklist (anything-attr 'candidates-file))
11148 (setq file (anything-interpret-value file))
11149 (with-current-buffer (anything-candidate-buffer (find-file-noselect file))
11150 (when updating
11151 (buffer-disable-undo)
11152 (font-lock-mode -1)
11153 (auto-revert-mode 1)))))
11155 (anything-document-attribute 'candidates-file "candidates-file plugin"
11156 "Use a file as the candidates buffer.
11158 1st argument is a filename, string or function name or variable name.
11159 If optional 2nd argument is non-nil, the file opened with `auto-revert-mode'.")
11161 ;; Plug-in: headline
11162 (defun anything-compile-source--anything-headline (source)
11163 (if (assoc-default 'headline source)
11164 (append '((init . anything-headline-init)
11165 (get-line . buffer-substring)
11166 (type . line))
11167 source
11168 '((candidates-in-buffer)
11169 (persistent-help . "Show this line")))
11170 source))
11171 (add-to-list 'anything-compile-source-functions 'anything-compile-source--anything-headline)
11173 (defun anything-headline-init ()
11174 (when (and (anything-current-buffer-is-modified)
11175 (with-anything-current-buffer
11176 (eval (or (anything-attr 'condition) t))))
11177 (anything-headline-make-candidate-buffer
11178 (anything-interpret-value (anything-attr 'headline))
11179 (anything-interpret-value (anything-attr 'subexp)))))
11181 (anything-document-attribute 'headline "Headline plug-in"
11182 "Regexp string for anything-headline to scan.")
11183 (anything-document-attribute 'condition "Headline plug-in"
11184 "A sexp representing the condition to use anything-headline.")
11185 (anything-document-attribute 'subexp "Headline plug-in"
11186 "Display (match-string-no-properties subexp).")
11188 ;; Le Wang: Note on how `anything-head-line-get-candidates' works with a list
11189 ;; of regexps.
11191 ;; 1. Create list of ((title . start-of-match) . hiearchy)
11192 ;; 2. Sort this list by start-of-match.
11193 ;; 3. Go through sorted list and return titles that reflect full hiearchy.
11195 ;; It's quite brilliantly written.
11199 (defun anything-headline-get-candidates (regexp subexp)
11200 (with-anything-current-buffer
11201 (save-excursion
11202 (goto-char (point-min))
11203 (if (functionp regexp) (setq regexp (funcall regexp)))
11204 (let (hierarchy curhead)
11205 (flet ((matched ()
11206 (if (numberp subexp)
11207 (cons (match-string-no-properties subexp) (match-beginning subexp))
11208 (cons (buffer-substring (point-at-bol) (point-at-eol))
11209 (point-at-bol))))
11210 (hierarchies (headlines)
11211 (1+ (loop for (_ . hierarchy) in headlines
11212 maximize hierarchy)))
11213 (vector-0-n (v n)
11214 (loop for i from 0 to hierarchy
11215 collecting (aref curhead i)))
11216 (arrange (headlines)
11217 (unless (null headlines) ; FIX headlines empty bug!
11218 (loop with curhead = (make-vector (hierarchies headlines) "")
11219 for ((str . pt) . hierarchy) in headlines
11220 do (aset curhead hierarchy str)
11221 collecting
11222 (cons
11223 (format "H%d:%s" (1+ hierarchy)
11224 (mapconcat 'identity (vector-0-n curhead hierarchy) " / "))
11225 pt)))))
11226 (if (listp regexp)
11227 (arrange
11228 (sort
11229 (loop for re in regexp
11230 for hierarchy from 0
11231 do (goto-char (point-min))
11232 appending
11233 (loop
11234 while (re-search-forward re nil t)
11235 collect (cons (matched) hierarchy)))
11236 (lambda (a b) (> (cdar b) (cdar a)))))
11237 (loop while (re-search-forward regexp nil t)
11238 collect (matched))))))))
11241 (defun anything-headline-make-candidate-buffer (regexp subexp)
11242 (with-current-buffer (anything-candidate-buffer 'local)
11243 (loop for (content . pos) in (anything-headline-get-candidates regexp subexp)
11244 do (insert
11245 (format "%5d:%s\n"
11246 (with-anything-current-buffer
11247 (line-number-at-pos pos))
11248 content)))))
11250 (defun anything-headline-goto-position (pos recenter)
11251 (goto-char pos)
11252 (unless recenter
11253 (set-window-start (get-buffer-window anything-current-buffer) (point))))
11256 ;; Plug-in: persistent-help
11257 (defun anything-compile-source--persistent-help (source)
11258 (append source '((header-line . anything-persistent-help-string))))
11259 (add-to-list 'anything-compile-source-functions 'anything-compile-source--persistent-help)
11261 (defun anything-persistent-help-string ()
11262 (substitute-command-keys
11263 (concat "\\<anything-map>\\[anything-execute-persistent-action]: "
11264 (or (anything-interpret-value (anything-attr 'persistent-help))
11265 (anything-aif (or (assoc-default 'persistent-action
11266 (anything-get-current-source))
11267 (assoc-default 'action
11268 (anything-get-current-source)))
11269 (cond ((symbolp it) (symbol-name it))
11270 ((listp it) (or (ignore-errors (caar it)) ""))))
11272 " (keeping session)")))
11274 (anything-document-attribute 'persistent-help "persistent-help plug-in"
11275 "A string to explain persistent-action of this source.
11276 It also accepts a function or a variable name.")
11278 ;;; (anything '(((name . "persistent-help test")(candidates "a")(persistent-help . "TEST"))))
11280 ;; Plug-in: Type customize
11281 (defun anything-c-uniq-list (lst)
11282 "Like `remove-duplicates' in CL.
11283 But cut deeper duplicates and test by `equal'. "
11284 (reverse (remove-duplicates (reverse lst) :test 'equal)))
11285 (defvar anything-additional-type-attributes nil)
11286 (defun anything-c-arrange-type-attribute (type spec)
11287 "Override type attributes by `define-anything-type-attribute'.
11289 The SPEC is like source. The symbol `REST' is replaced with original attribute value.
11291 Example: Set `play-sound-file' as default action
11292 (anything-c-arrange-type-attribute 'file
11293 '((action (\"Play sound\" . play-sound-file)
11294 REST ;; Rest of actions (find-file, find-file-other-window, ...)
11297 (add-to-list 'anything-additional-type-attributes
11298 (cons type
11299 (loop with typeattr = (assoc-default type anything-type-attributes)
11300 for (attr . value) in spec
11301 if (listp value)
11302 collect (cons attr
11303 (anything-c-uniq-list
11304 (loop for v in value
11305 if (eq v 'REST)
11306 append (assoc-default attr typeattr)
11307 else
11308 collect v)))
11309 else
11310 collect (cons attr value)))))
11311 (put 'anything-c-arrange-type-attribute 'lisp-indent-function 1)
11313 (defun anything-compile-source--type-customize (source)
11314 (anything-aif (assoc-default (assoc-default 'type source) anything-additional-type-attributes)
11315 (append it source)
11316 source))
11317 (add-to-list 'anything-compile-source-functions 'anything-compile-source--type-customize t)
11319 ;; Plug-in: default-action
11320 (defun anything-compile-source--default-action (source)
11321 (anything-aif (assoc-default 'default-action source)
11322 (append `((action ,it ,@(remove it (assoc-default 'action source))))
11323 source)
11324 source))
11325 (add-to-list 'anything-compile-source-functions 'anything-compile-source--default-action t)
11326 (anything-document-attribute 'default-action "default-action plug-in"
11327 "Default action.")
11330 ;;; Toggle anything-match-plugin
11333 (defvar anything-mp-initial-highlight-delay nil)
11335 ;;;###autoload
11336 (defun anything-c-toggle-match-plugin ()
11337 "Toggle anything-match-plugin."
11338 (interactive)
11339 (let ((anything-match-plugin-enabled
11340 (member 'anything-compile-source--match-plugin
11341 anything-compile-source-functions)))
11342 (flet ((disable-match-plugin ()
11343 (setq anything-compile-source-functions
11344 (delq 'anything-compile-source--match-plugin
11345 anything-compile-source-functions))
11346 (setq anything-mp-initial-highlight-delay
11347 anything-mp-highlight-delay)
11348 (setq anything-mp-highlight-delay nil))
11349 (enable-match-plugin ()
11350 (require 'anything-match-plugin)
11351 (unless anything-mp-initial-highlight-delay
11352 (setq anything-mp-initial-highlight-delay
11353 anything-mp-highlight-delay))
11354 (setq anything-compile-source-functions
11355 (cons 'anything-compile-source--match-plugin
11356 anything-compile-source-functions))
11357 (unless anything-mp-highlight-delay
11358 (setq anything-mp-highlight-delay
11359 anything-mp-initial-highlight-delay))))
11360 (if anything-match-plugin-enabled
11361 (when (y-or-n-p "Really disable match-plugin? ")
11362 (disable-match-plugin)
11363 (message "Anything-match-plugin disabled"))
11364 (when (y-or-n-p "Really enable match-plugin? ")
11365 (enable-match-plugin)
11366 (message "Anything-match-plugin enabled"))))))
11370 ;;; Type Attributes
11373 (define-anything-type-attribute 'buffer
11374 `((action
11375 ("Switch to buffer" . anything-c-switch-to-buffer)
11376 ,(and (locate-library "popwin") '("Switch to buffer in popup window" . popwin:popup-buffer))
11377 ("Switch to buffer other window" . switch-to-buffer-other-window)
11378 ("Switch to buffer other frame" . switch-to-buffer-other-frame)
11379 ,(and (locate-library "elscreen") '("Display buffer in Elscreen" . anything-find-buffer-on-elscreen))
11380 ("Query replace regexp" . anything-c-buffer-query-replace-regexp)
11381 ("Query replace" . anything-c-buffer-query-replace)
11382 ("View buffer" . view-buffer)
11383 ("Display buffer" . display-buffer)
11384 ("Grep buffers (C-u grep all buffers)" . anything-c-grep-buffers)
11385 ("Revert buffer(s)" . anything-revert-marked-buffers)
11386 ("Insert buffer" . insert-buffer)
11387 ("Kill buffer(s)" . anything-kill-marked-buffers)
11388 ("Diff with file" . diff-buffer-with-file)
11389 ("Ediff Marked buffers" . anything-ediff-marked-buffers)
11390 ("Ediff Merge marked buffers" . (lambda (candidate)
11391 (anything-ediff-marked-buffers candidate t))))
11392 (persistent-help . "Show this buffer")
11393 (candidate-transformer anything-c-skip-current-buffer
11394 anything-c-skip-boring-buffers
11395 anything-c-transform-buffer-display-string))
11396 "Buffer or buffer name.")
11398 (define-anything-type-attribute 'file
11399 `((action
11400 ("Find file" . anything-find-many-files)
11401 ,(and (locate-library "popwin") '("Find file in popup window" . popwin:find-file))
11402 ("Find file as root" . anything-find-file-as-root)
11403 ("Find file other window" . find-file-other-window)
11404 ("Find file other frame" . find-file-other-frame)
11405 ("Open dired in file's directory" . anything-c-open-dired)
11406 ("Grep File(s) `C-u recurse'" . anything-find-files-grep)
11407 ("Zgrep File(s) `C-u Recurse'" . anything-ff-zgrep)
11408 ("Pdfgrep File(s)" . anything-ff-pdfgrep)
11409 ("Checksum File" . anything-ff-checksum)
11410 ("Ediff File" . anything-find-files-ediff-files)
11411 ("Ediff Merge File" . anything-find-files-ediff-merge-files)
11412 ("View file" . view-file)
11413 ("Insert file" . insert-file)
11414 ("Delete file(s)" . anything-delete-marked-files)
11415 ("Open file externally (C-u to choose)" . anything-c-open-file-externally)
11416 ("Open file with default tool" . anything-c-open-file-with-default-tool)
11417 ("Find file in hex dump" . hexl-find-file))
11418 (persistent-help . "Show this file")
11419 (action-transformer anything-c-transform-file-load-el
11420 anything-c-transform-file-browse-url)
11421 (candidate-transformer anything-c-w32-pathname-transformer
11422 anything-c-skip-current-file
11423 anything-c-skip-boring-files
11424 anything-c-shorten-home-path))
11425 "File name.")
11427 (let ((actions '(("Describe command" . describe-function)
11428 ("Add command to kill ring" . anything-c-kill-new)
11429 ("Go to command's definition" . find-function)
11430 ("Debug on entry" . debug-on-entry)
11431 ("Cancel debug on entry" . cancel-debug-on-entry)
11432 ("Trace function" . trace-function)
11433 ("Trace function (background)" . trace-function-background)
11434 ("Untrace function" . untrace-function))))
11435 (define-anything-type-attribute 'command
11436 `((action ("Call interactively" . anything-c-call-interactively)
11437 ,@actions)
11438 ;; Sort commands according to their usage count.
11439 ;(filtered-candidate-transformer . anything-c-adaptive-sort)
11440 (coerce . anything-c-symbolify)
11441 (persistent-action . describe-function))
11442 "Command. (string or symbol)")
11444 (define-anything-type-attribute 'function
11445 `((action . ,actions)
11446 (action-transformer anything-c-transform-function-call-interactively)
11447 (candidate-transformer anything-c-mark-interactive-functions)
11448 (coerce . anything-c-symbolify))
11449 "Function. (string or symbol)"))
11451 (define-anything-type-attribute 'variable
11452 '((action ("Describe variable" . describe-variable)
11453 ("Add variable to kill ring" . anything-c-kill-new)
11454 ("Go to variable's definition" . find-variable)
11455 ("Set variable" . anything-c-set-variable))
11456 (coerce . anything-c-symbolify))
11457 "Variable.")
11459 (define-anything-type-attribute 'sexp
11460 '((action ("Eval s-expression" . (lambda (c) (eval (read c))))
11461 ("Add s-expression to kill ring" . kill-new))
11462 (action-transformer anything-c-transform-sexp-eval-command-sexp))
11463 "String representing S-Expressions.")
11465 (define-anything-type-attribute 'bookmark
11466 `((coerce . anything-bookmark-get-bookmark-from-name)
11467 (action
11468 ("Jump to bookmark" . (lambda (bookmark)
11469 (let ((current-prefix-arg anything-current-prefix-arg))
11470 (bookmark-jump bookmark))
11471 (anything-update)))
11472 ("Jump to BM other window" . (lambda (bookmark)
11473 (bookmark-jump-other-window bookmark)
11474 (anything-update)))
11475 ("Bookmark edit annotation" . bookmark-edit-annotation)
11476 ("Bookmark show annotation" . bookmark-show-annotation)
11477 ("Delete bookmark(s)" . anything-delete-marked-bookmarks)
11478 ,@(and (locate-library "bookmark-extensions")
11479 `(("Edit Bookmark" . bmkext-edit-bookmark)))
11480 ("Rename bookmark" . bookmark-rename)
11481 ("Relocate bookmark" . bookmark-relocate)))
11482 "Bookmark name.")
11484 (define-anything-type-attribute 'line
11485 '((display-to-real . anything-c-display-to-real-line)
11486 (action ("Go to Line" . anything-c-action-line-goto)))
11487 "LINENO:CONTENT string, eg. \" 16:foo\".
11489 Optional `target-file' attribute is a name of target file.
11491 Optional `before-jump-hook' attribute is a function with no
11492 arguments which is called before jumping to position.
11494 Optional `after-jump-hook' attribute is a function with no
11495 arguments which is called after jumping to position.
11497 If `adjust' attribute is specified, searches the line whose
11498 content is CONTENT near the LINENO.
11500 If `recenter' attribute is specified, the line is displayed at
11501 the center of window, otherwise at the top of window.
11504 (define-anything-type-attribute 'file-line
11505 `((filtered-candidate-transformer anything-c-filtered-candidate-transformer-file-line)
11506 (multiline)
11507 (action ("Go to" . anything-c-action-file-line-goto)))
11508 "FILENAME:LINENO:CONTENT string, eg. \"~/.emacs:16:;; comment\".
11510 Optional `default-directory' attribute is a default-directory
11511 FILENAME is interpreted.
11513 Optional `before-jump-hook' attribute is a function with no
11514 arguments which is called before jumping to position.
11516 Optional `after-jump-hook' attribute is a function with no
11517 arguments which is called after jumping to position.
11519 If `adjust' attribute is specified, searches the line whose
11520 content is CONTENT near the LINENO.
11522 If `recenter' attribute is specified, the line is displayed at
11523 the center of window, otherwise at the top of window.
11526 (define-anything-type-attribute 'timer
11527 '((real-to-display . anything-c-timer-real-to-display)
11528 (action ("Cancel Timer" . cancel-timer)
11529 ("Describe Function" . (lambda (tm) (describe-function (timer--function tm))))
11530 ("Find Function" . (lambda (tm) (find-function (timer--function tm)))))
11531 (persistent-action . (lambda (tm) (describe-function (timer--function tm))))
11532 (persistent-help . "Describe Function"))
11533 "Timer.")
11536 ;;; Default `anything-sources'
11537 ;; Setting `anything-sources' is DEPRECATED, but it seems that newbies
11538 ;; tend to invoke M-x anything directly. So I offer default setting.
11539 (setq anything-sources
11540 '(anything-c-source-buffers-list
11541 anything-c-source-recentf
11542 anything-c-source-files-in-current-dir+))
11545 ;;; Preconfigured Anything
11548 ;;;###autoload
11549 (defun anything-mini ()
11550 "Preconfigured `anything' lightweight version \(buffer -> recentf\)."
11551 (interactive)
11552 (anything-other-buffer '(anything-c-source-buffers-list
11553 anything-c-source-recentf
11554 anything-c-source-buffer-not-found)
11555 "*anything mini*"))
11556 ;;;###autoload
11557 (defun anything-for-files ()
11558 "Preconfigured `anything' for opening files.
11559 ffap -> recentf -> buffer -> bookmark -> file-cache -> files-in-current-dir -> locate."
11560 (interactive)
11561 (anything-other-buffer anything-for-files-prefered-list "*anything for files*"))
11563 ;;;###autoload
11564 (defun anything-recentf ()
11565 "Preconfigured `anything' for `recentf'."
11566 (interactive)
11567 (anything-other-buffer 'anything-c-source-recentf "*anything recentf*"))
11569 ;;;###autoload
11570 (defun anything-info-at-point (arg)
11571 "Preconfigured `anything' for searching info at point.
11572 With a prefix-arg insert symbol at point."
11573 (interactive "P")
11574 (let ((anything-c-google-suggest-default-function
11575 'anything-c-google-suggest-emacs-lisp))
11576 (anything :sources '(anything-c-source-info-elisp
11577 anything-c-source-info-cl
11578 anything-c-source-info-pages
11579 anything-c-source-google-suggest)
11580 :input (and arg (thing-at-point 'symbol))
11581 :buffer "*anything info*")))
11583 ;;;###autoload
11584 (defun anything-info-emacs ()
11585 "Preconfigured anything for Emacs manual index."
11586 (interactive)
11587 (anything-other-buffer 'anything-c-source-info-emacs "*info emacs*"))
11589 ;;;###autoload
11590 (defun anything-show-kill-ring ()
11591 "Preconfigured `anything' for `kill-ring'.
11592 It is drop-in replacement of `yank-pop'.
11593 You may bind this command to M-y.
11594 First call open the kill-ring browser, next calls move to next line."
11595 (interactive)
11596 (let ((buf "*anything kill-ring*"))
11597 (if (get-buffer-window buf)
11598 (with-anything-window
11599 (if (eq (overlay-end anything-selection-overlay) (point-max))
11600 (anything-beginning-of-buffer)
11601 (anything-next-line)))
11602 (anything-other-buffer 'anything-c-source-kill-ring buf))))
11604 ;;;###autoload
11605 (defun anything-minibuffer-history ()
11606 "Preconfigured `anything' for `minibuffer-history'."
11607 (interactive)
11608 (let ((enable-recursive-minibuffers t))
11609 (anything-other-buffer 'anything-c-source-minibuffer-history
11610 "*anything minibuffer-history*")))
11612 ;;;###autoload
11613 (defun anything-gentoo ()
11614 "Preconfigured `anything' for gentoo linux."
11615 (interactive)
11616 (anything-other-buffer '(anything-c-source-gentoo
11617 anything-c-source-use-flags)
11618 "*anything gentoo*"))
11620 ;;;###autoload
11621 (defun anything-imenu ()
11622 "Preconfigured `anything' for `imenu'."
11623 (interactive)
11624 (anything :sources 'anything-c-source-imenu
11625 :buffer "*anything imenu*"))
11627 ;;;###autoload
11628 (defun anything-google-suggest ()
11629 "Preconfigured `anything' for google search with google suggest."
11630 (interactive)
11631 (anything-other-buffer 'anything-c-source-google-suggest "*anything google*"))
11633 ;;;###autoload
11634 (defun anything-yahoo-suggest ()
11635 "Preconfigured `anything' for Yahoo searching with Yahoo suggest."
11636 (interactive)
11637 (anything-other-buffer 'anything-c-source-yahoo-suggest "*anything yahoo*"))
11639 ;;; Converted from anything-show-*-only
11640 ;;;###autoload
11641 (defun anything-for-buffers ()
11642 "Preconfigured `anything' for buffer."
11643 (interactive)
11644 (anything-other-buffer 'anything-c-source-buffers "*anything for buffers*"))
11646 ;;;###autoload
11647 (defun anything-buffers-list ()
11648 "Enhanced preconfigured `anything' for buffer."
11649 (interactive)
11650 (anything :sources '(anything-c-source-buffers-list
11651 anything-c-source-buffer-not-found)
11652 :buffer "*anything buffers*" :keymap anything-c-buffer-map))
11654 ;;;###autoload
11655 (defun anything-bbdb ()
11656 "Preconfigured `anything' for BBDB.
11658 Needs BBDB.
11660 http://bbdb.sourceforge.net/"
11661 (interactive)
11662 (anything-other-buffer 'anything-c-source-bbdb "*anything bbdb*"))
11664 ;;;###autoload
11665 (defun anything-locate (arg)
11666 "Preconfigured `anything' for Locate.
11667 Note: you can add locate options after entering pattern.
11668 See 'man locate' for valid options.
11670 You can specify a specific database with prefix argument ARG \(C-u\).
11671 Many databases can be used: navigate and mark them.
11672 See also `anything-locate-with-db'.
11674 To create a user specific db, use
11675 \"updatedb -l 0 -o db_path -U directory\".
11676 Where db_path is a filename matched by
11677 `anything-locate-db-file-regexp'."
11678 (interactive "P")
11679 (anything-locate-1 arg))
11681 ;;;###autoload
11682 (defun anything-w3m-bookmarks ()
11683 "Preconfigured `anything' for w3m bookmark.
11685 Needs w3m and emacs-w3m.
11687 http://w3m.sourceforge.net/
11688 http://emacs-w3m.namazu.org/"
11689 (interactive)
11690 (anything-other-buffer 'anything-c-source-w3m-bookmarks
11691 "*anything w3m bookmarks*"))
11693 ;;;###autoload
11694 (defun anything-firefox-bookmarks ()
11695 "Preconfigured `anything' for firefox bookmark.
11696 You will have to enable html bookmarks in firefox:
11697 open about:config in firefox and double click on this line to enable value \
11698 to true:
11700 user_pref(\"browser.bookmarks.autoExportHTML\", false);
11702 You should have now:
11704 user_pref(\"browser.bookmarks.autoExportHTML\", true);
11706 After closing firefox, you will be able to browse you bookmarks.
11708 (interactive)
11709 (anything-other-buffer 'anything-c-source-firefox-bookmarks
11710 "*Anything Firefox*"))
11712 ;;;###autoload
11713 (defun anything-colors ()
11714 "Preconfigured `anything' for color."
11715 (interactive)
11716 (anything-other-buffer
11717 '(anything-c-source-colors anything-c-source-customize-face)
11718 "*anything colors*"))
11720 ;;;###autoload
11721 (defun anything-bookmarks ()
11722 "Preconfigured `anything' for bookmarks."
11723 (interactive)
11724 (anything-other-buffer 'anything-c-source-bookmarks "*anything bookmarks*"))
11726 ;;;###autoload
11727 (defun anything-c-pp-bookmarks ()
11728 "Preconfigured `anything' for bookmarks (pretty-printed)."
11729 (interactive)
11730 (anything-other-buffer '(anything-c-source-bookmarks-local
11731 anything-c-source-bookmarks-su
11732 anything-c-source-bookmarks-ssh)
11733 "*anything pp bookmarks*"))
11735 ;;;###autoload
11736 (defun anything-c-insert-latex-math ()
11737 "Preconfigured anything for latex math symbols completion."
11738 (interactive)
11739 (anything-other-buffer 'anything-c-source-latex-math "*anything latex*"))
11741 ;;;###autoload
11742 (defun anything-register ()
11743 "Preconfigured `anything' for Emacs registers."
11744 (interactive)
11745 (anything-other-buffer 'anything-c-source-register "*anything register*"))
11747 ;;;###autoload
11748 (defun anything-man-woman ()
11749 "Preconfigured `anything' for Man and Woman pages."
11750 (interactive)
11751 (anything-other-buffer 'anything-c-source-man-pages "*Anything man woman*"))
11753 ;;;###autoload
11754 (defun anything-org-keywords ()
11755 "Preconfigured `anything' for org keywords."
11756 (interactive)
11757 (anything-other-buffer 'anything-c-source-org-keywords "*org keywords*"))
11759 ;;;###autoload
11760 (defun anything-emms ()
11761 "Preconfigured `anything' for emms sources."
11762 (interactive)
11763 (anything :sources '(anything-c-source-emms-streams
11764 anything-c-source-emms-files
11765 anything-c-source-emms-dired)
11766 :buffer "*Anything Emms*"))
11768 ;;;###autoload
11769 (defun anything-eev-anchors ()
11770 "Preconfigured `anything' for eev anchors."
11771 (interactive)
11772 (anything-other-buffer 'anything-c-source-eev-anchor "*Anything eev anchors*"))
11774 ;;;###autoload
11775 (defun anything-bm-list ()
11776 "Preconfigured `anything' for visible bookmarks.
11778 Needs bm.el
11780 http://cvs.savannah.gnu.org/viewvc/*checkout*/bm/bm/bm.el"
11781 (interactive)
11782 (let ((anything-outline-using t))
11783 (anything-other-buffer 'anything-c-source-bm "*anything bm list*")))
11785 ;;;###autoload
11786 (defun anything-timers ()
11787 "Preconfigured `anything' for timers."
11788 (interactive)
11789 (anything-other-buffer '(anything-c-source-absolute-time-timers
11790 anything-c-source-idle-time-timers)
11791 "*anything timers*"))
11793 ;;;###autoload
11794 (defun anything-list-emacs-process ()
11795 "Preconfigured `anything' for emacs process."
11796 (interactive)
11797 (anything-other-buffer 'anything-c-source-emacs-process "*anything process*"))
11799 ;;;###autoload
11800 (defun anything-occur ()
11801 "Preconfigured Anything for Occur source.
11802 If region is active, search only in region,
11803 otherwise search in whole buffer."
11804 (interactive)
11805 (let ((anything-compile-source-functions
11806 ;; rule out anything-match-plugin because the input is one regexp.
11807 (delq 'anything-compile-source--match-plugin
11808 (copy-sequence anything-compile-source-functions))))
11809 (anything-other-buffer 'anything-c-source-occur "*Anything Occur*")))
11811 ;;;###autoload
11812 (defun anything-browse-code ()
11813 "Preconfigured anything to browse code."
11814 (interactive)
11815 (anything :sources 'anything-c-source-browse-code
11816 :buffer "*anything browse code*"
11817 :default (thing-at-point 'symbol)))
11819 ;;;###autoload
11820 (defun anything-org-headlines ()
11821 "Preconfigured anything to show org headlines."
11822 (interactive)
11823 (anything-other-buffer 'anything-c-source-org-headline "*org headlines*"))
11825 ;;;###autoload
11826 (defun anything-info-gnus ()
11827 "Preconfigured anything to browse Gnus Manual."
11828 (interactive)
11829 (anything-other-buffer 'anything-c-source-info-gnus "*info Gnus*"))
11831 ;;;###autoload
11832 (defun anything-regexp ()
11833 "Preconfigured anything to build regexps.
11834 `query-replace-regexp' can be run from there against found regexp."
11835 (interactive)
11836 (save-restriction
11837 (let ((anything-compile-source-functions
11838 ;; rule out anything-match-plugin because the input is one regexp.
11839 (delq 'anything-compile-source--match-plugin
11840 (copy-sequence anything-compile-source-functions))))
11841 (when (and (anything-region-active-p)
11842 ;; Don't narrow to region if buffer is already narrowed.
11843 (not (anything-current-buffer-narrowed-p)))
11844 (narrow-to-region (region-beginning) (region-end)))
11845 (anything :sources anything-c-source-regexp
11846 :buffer "*anything regexp*"
11847 :prompt "Regexp: "
11848 :history 'anything-build-regexp-history))))
11850 ;;;###autoload
11851 (defun anything-c-copy-files-async ()
11852 "Preconfigured anything to copy file list FLIST to DEST asynchronously."
11853 (interactive)
11854 (let* ((flist (anything-c-read-file-name
11855 "Copy File async: "
11856 :marked-candidates t))
11857 (dest (anything-c-read-file-name
11858 "Copy File async To: "
11859 :preselect (car flist)
11860 :initial-input (car anything-ff-history)
11861 :history (anything-find-files-history :comp-read nil))))
11862 (anything-c-copy-async-with-log flist dest)))
11864 ;;;###autoload
11865 (defun anything-find-files (arg)
11866 "Preconfigured `anything' for anything implementation of `find-file'.
11867 Called with a prefix arg show history if some.
11868 Don't call it from programs, use `anything-find-files-1' instead.
11869 This is the starting point for nearly all actions you can do on files."
11870 (interactive "P")
11871 (let ((any-input (if (and arg anything-ff-history)
11872 (anything-find-files-history)
11873 (anything-find-files-initial-input)))
11874 (presel (buffer-file-name (current-buffer))))
11875 (when (and (eq major-mode 'org-agenda-mode)
11876 org-directory
11877 (not any-input))
11878 (setq any-input (expand-file-name org-directory)))
11879 (set-text-properties 0 (length any-input) nil any-input)
11880 (if any-input
11881 (anything-find-files-1 any-input)
11882 (setq any-input (expand-file-name (anything-c-current-directory)))
11883 (anything-find-files-1
11884 any-input (if anything-ff-transformer-show-only-basename
11885 (and presel (anything-c-basename presel))
11886 presel)))))
11888 ;;;###autoload
11889 (defun anything-write-file ()
11890 "Preconfigured `anything' providing completion for `write-file'."
11891 (interactive)
11892 (let ((anything-mp-highlight-delay nil))
11893 (anything :sources 'anything-c-source-write-file
11894 :input (expand-file-name default-directory)
11895 :prompt "Write buffer to file: "
11896 :buffer "*Anything write file*")))
11898 ;;;###autoload
11899 (defun anything-insert-file ()
11900 "Preconfigured `anything' providing completion for `insert-file'."
11901 (interactive)
11902 (let ((anything-mp-highlight-delay nil))
11903 (anything :sources 'anything-c-source-insert-file
11904 :input (expand-file-name default-directory)
11905 :prompt "Insert file: "
11906 :buffer "*Anything insert file*")))
11908 ;;;###autoload
11909 (defun anything-dired-rename-file ()
11910 "Preconfigured `anything' to rename files from dired."
11911 (interactive)
11912 (anything-dired-do-action-on-file :action 'rename))
11914 ;;;###autoload
11915 (defun anything-dired-copy-file ()
11916 "Preconfigured `anything' to copy files from dired."
11917 (interactive)
11918 (anything-dired-do-action-on-file :action 'copy))
11920 ;;;###autoload
11921 (defun anything-dired-symlink-file ()
11922 "Preconfigured `anything' to symlink files from dired."
11923 (interactive)
11924 (anything-dired-do-action-on-file :action 'symlink))
11926 ;;;###autoload
11927 (defun anything-dired-hardlink-file ()
11928 "Preconfigured `anything' to hardlink files from dired."
11929 (interactive)
11930 (anything-dired-do-action-on-file :action 'hardlink))
11932 ;;;###autoload
11933 (defun anything-do-grep ()
11934 "Preconfigured anything for grep.
11935 Contrarily to Emacs `grep' no default directory is given, but
11936 the full path of candidates in ONLY.
11937 That allow to grep different files not only in `default-directory' but anywhere
11938 by marking them (C-<SPACE>). If one or more directory is selected
11939 grep will search in all files of these directories.
11940 You can use also wildcard in the base name of candidate.
11941 If a prefix arg is given use the -r option of grep.
11942 The prefix arg can be passed before or after start.
11943 See also `anything-do-grep-1'."
11944 (interactive)
11945 (let ((only (anything-c-read-file-name
11946 "Search in file(s): "
11947 :marked-candidates t
11948 :preselect (or (dired-get-filename nil t)
11949 (buffer-file-name (current-buffer)))))
11950 (prefarg (or current-prefix-arg anything-current-prefix-arg)))
11951 (anything-do-grep-1 only prefarg)))
11953 ;;;###autoload
11954 (defun anything-do-zgrep (candidate)
11955 "Preconfigured anything for zgrep."
11956 (let ((prefarg (or current-prefix-arg anything-current-prefix-arg))
11957 (ls (anything-c-read-file-name
11958 "Search in file(s): "
11959 :marked-candidates t
11960 :preselect (or (dired-get-filename nil t)
11961 (buffer-file-name (current-buffer))))))
11962 (anything-ff-zgrep-1 ls prefarg)))
11964 (defun anything-c-etags-select (arg)
11965 "Preconfigured anything for etags.
11966 Called with one prefix arg use symbol at point as initial input.
11967 Called with two prefix arg reinitialize cache.
11968 If tag file have been modified reinitialize cache."
11969 (interactive "P")
11970 (let ((tag (anything-c-etags-get-tag-file))
11971 (init (and (equal arg '(4)) (thing-at-point 'symbol)))
11972 (anything-quit-if-no-candidate t)
11973 (anything-execute-action-at-once-if-one t)
11974 (anything-compile-source-functions
11975 (if anything-c-etags-use-regexp-search
11976 ;; rule out anything-match-plugin because the input is one regexp.
11977 (delq 'anything-compile-source--match-plugin
11978 (copy-sequence anything-compile-source-functions))
11979 anything-compile-source-functions)))
11980 (when (or (equal arg '(16))
11981 (and anything-c-etags-mtime-alist
11982 (anything-c-etags-file-modified-p tag)))
11983 (remhash tag anything-c-etags-cache))
11984 (if (and tag (file-exists-p tag))
11985 (anything :sources 'anything-c-source-etags-select
11986 :keymap anything-c-etags-map
11987 :input init
11988 :buffer "*anything etags*")
11989 (message "Error: No tag file found, please create one with etags shell command."))))
11991 ;;;###autoload
11992 (defun anything-filelist ()
11993 "Preconfigured `anything' to open files instantly.
11995 See `anything-c-filelist-file-name' docstring for usage."
11996 (interactive)
11997 (anything-other-buffer 'anything-c-source-filelist "*anything file list*"))
11999 ;;;###autoload
12000 (defun anything-filelist+ ()
12001 "Preconfigured `anything' to open files/buffers/bookmarks instantly.
12003 This is a replacement for `anything-for-files'.
12004 See `anything-c-filelist-file-name' docstring for usage."
12005 (interactive)
12006 (anything-other-buffer
12007 '(anything-c-source-ffap-line
12008 anything-c-source-ffap-guesser
12009 anything-c-source-buffers-list
12010 anything-c-source-recentf
12011 anything-c-source-bookmarks
12012 anything-c-source-file-cache
12013 anything-c-source-filelist)
12014 "*anything file list*"))
12016 ;;;###autoload
12017 (defun anything-M-x ()
12018 "Preconfigured `anything' for Emacs commands.
12019 It is `anything' replacement of regular `M-x' `execute-extended-command'."
12020 (interactive)
12021 (let* (in-help
12022 help-cand
12023 special-display-buffer-names
12024 special-display-regexps
12025 anything-persistent-action-use-special-display
12026 (history (loop with hist
12027 for i in extended-command-history
12028 for com = (intern i)
12029 when (fboundp com)
12030 collect i into hist finally return hist)))
12031 (flet ((pers-help (candidate)
12032 (let ((hbuf (get-buffer (help-buffer))))
12033 (if (and in-help (string= candidate help-cand))
12034 (progn
12035 ;; When M-x is started from a help buffer,
12036 ;; Don't kill it as it is anything-current-buffer.
12037 (unless (equal hbuf anything-current-buffer)
12038 (kill-buffer hbuf))
12039 (setq in-help nil))
12040 ;; Be sure anything-current-buffer
12041 ;; have not a dedicated window.
12042 (set-window-dedicated-p
12043 (get-buffer-window anything-current-buffer) nil)
12044 (describe-function (intern candidate))
12045 (message nil) ; Erase the new stupid message Type "q"[...]
12046 (setq in-help t))
12047 (setq help-cand candidate))))
12048 (let* ((command
12050 (anything
12051 :sources
12052 `(((name . "Emacs Commands history")
12053 (candidates . ,history)
12054 (filtered-candidate-transformer
12055 . (lambda (candidates sources)
12056 (loop for i in candidates
12057 do (set-text-properties 0 (length i) nil i)
12058 collect i)))
12059 (persistent-action . pers-help)
12060 (persistent-help . "Describe this command")
12061 (action . identity))
12062 ((name . "Emacs Commands")
12063 (init
12064 . (lambda ()
12065 (with-current-buffer (anything-candidate-buffer 'global)
12066 (goto-char (point-min))
12067 (loop for sym in
12068 (all-completions "" obarray 'commandp)
12069 do (insert (concat sym "\n"))))))
12070 (persistent-action . pers-help)
12071 (persistent-help . "Describe this command")
12072 (filtered-candidate-transformer . anything-M-x-transformer)
12073 (candidates-in-buffer)
12074 (action . identity)))
12075 :resume 'noresume
12076 :prompt "M-x "
12077 :history 'anything-M-x-input-history
12078 :buffer "*anything M-x*")
12079 (keyboard-quit)))
12080 (sym-com (intern command)))
12081 (unless current-prefix-arg
12082 (setq current-prefix-arg anything-current-prefix-arg))
12083 ;; Avoid having `this-command' set to *exit-minibuffer.
12084 (setq this-command sym-com)
12085 (call-interactively sym-com)
12086 (setq extended-command-history
12087 (cons command (delete command history)))))))
12089 ;;;###autoload
12090 (defun anything-manage-advice ()
12091 "Preconfigured `anything' to disable/enable function advices."
12092 (interactive)
12093 (anything-other-buffer 'anything-c-source-advice "*anything advice*"))
12095 ;;;###autoload
12096 (defun anything-bookmark-ext ()
12097 "Preconfigured `anything' for bookmark-extensions sources.
12098 Needs bookmark-ext.el:
12099 <http://mercurial.intuxication.org/hg/emacs-bookmark-extension>.
12100 Contain also `anything-c-source-google-suggest'."
12101 (interactive)
12102 (anything
12103 :sources
12104 '(anything-c-source-bookmark-files&dirs
12105 anything-c-source-bookmark-w3m
12106 anything-c-source-google-suggest
12107 anything-c-source-bmkext-addressbook
12108 anything-c-source-bookmark-gnus
12109 anything-c-source-bookmark-info
12110 anything-c-source-bookmark-man
12111 anything-c-source-bookmark-images
12112 anything-c-source-bookmark-su-files&dirs
12113 anything-c-source-bookmark-ssh-files&dirs)
12114 :prompt "SearchBookmark: "
12115 :buffer "*anything bmkext*"))
12117 ;;;###autoload
12118 (defun anything-simple-call-tree ()
12119 "Preconfigured `anything' for simple-call-tree. List function relationships.
12121 Needs simple-call-tree.el.
12122 http://www.emacswiki.org/cgi-bin/wiki/download/simple-call-tree.el"
12123 (interactive)
12124 (anything-other-buffer
12125 '(anything-c-source-simple-call-tree-functions-callers
12126 anything-c-source-simple-call-tree-callers-functions)
12127 "*anything simple-call-tree*"))
12129 ;;;###autoload
12130 (defun anything-mark-ring ()
12131 "Preconfigured `anything' for `anything-c-source-mark-ring'."
12132 (interactive)
12133 (anything :sources 'anything-c-source-mark-ring))
12135 ;;;###autoload
12136 (defun anything-global-mark-ring ()
12137 "Preconfigured `anything' for `anything-c-source-global-mark-ring'."
12138 (interactive)
12139 (anything :sources 'anything-c-source-global-mark-ring))
12141 ;;;###autoload
12142 (defun anything-all-mark-rings ()
12143 "Preconfigured `anything' for `anything-c-source-global-mark-ring' and \
12144 `anything-c-source-mark-ring'."
12145 (interactive)
12146 (anything :sources '(anything-c-source-mark-ring
12147 anything-c-source-global-mark-ring)))
12149 ;;;###autoload
12150 (defun anything-yaoddmuse-emacswiki-edit-or-view ()
12151 "Preconfigured `anything' to edit or view EmacsWiki page.
12153 Needs yaoddmuse.el.
12155 http://www.emacswiki.org/emacs/download/yaoddmuse.el"
12156 (interactive)
12157 (anything :sources 'anything-c-source-yaoddmuse-emacswiki-edit-or-view))
12159 ;;;###autoload
12160 (defun anything-yaoddmuse-emacswiki-post-library ()
12161 "Preconfigured `anything' to post library to EmacsWiki.
12163 Needs yaoddmuse.el.
12165 http://www.emacswiki.org/emacs/download/yaoddmuse.el"
12166 (interactive)
12167 (anything :sources 'anything-c-source-yaoddmuse-emacswiki-post-library))
12169 ;;;###autoload
12170 (defun anything-eval-expression (arg)
12171 "Preconfigured anything for `anything-c-source-evaluation-result'."
12172 (interactive "P")
12173 (anything :sources 'anything-c-source-evaluation-result
12174 :input (when arg (thing-at-point 'sexp))
12175 :buffer "*anything eval*"
12176 :history 'anything-eval-expression-input-history
12177 :keymap anything-eval-expression-map))
12179 ;;;###autoload
12180 (defun anything-eval-expression-with-eldoc ()
12181 "Preconfigured anything for `anything-c-source-evaluation-result' with `eldoc' support. "
12182 (interactive)
12183 (declare (special eldoc-idle-delay))
12184 (let ((timer (run-with-idle-timer eldoc-idle-delay
12185 'repeat 'anything-eldoc-show-in-eval))
12186 (minibuffer-completing-symbol t) ; Enable lisp completion.
12187 (completion-cycle-threshold t)) ; Always cycle, no pesty completion buffer (emacs24 only).
12188 (unwind-protect
12189 (minibuffer-with-setup-hook
12190 'anything-eldoc-store-minibuffer
12191 (call-interactively 'anything-eval-expression))
12192 (and timer (cancel-timer timer))
12193 (setq anything-eldoc-active-minibuffers-list
12194 (cdr anything-eldoc-active-minibuffers-list)))))
12196 ;;;###autoload
12197 (defun anything-calcul-expression ()
12198 "Preconfigured anything for `anything-c-source-calculation-result'."
12199 (interactive)
12200 (anything-other-buffer 'anything-c-source-calculation-result "*anything calcul*"))
12202 ;;;###autoload
12203 (defun anything-surfraw (pattern engine)
12204 "Preconfigured `anything' to search PATTERN with search ENGINE."
12205 (interactive (list (read-string "SearchFor: "
12206 nil 'anything-surfraw-input-history)
12207 (anything-comp-read
12208 "Engine: "
12209 (anything-c-build-elvi-list)
12210 :must-match t
12211 :name "Surfraw Search Engines"
12212 :history anything-surfraw-engines-history)))
12213 (let* ((engine-nodesc (car (split-string engine)))
12214 (url (with-temp-buffer
12215 (apply 'call-process "surfraw" nil t nil
12216 ;;JAVE
12217 (append (list engine-nodesc "-p") (split-string pattern)))
12218 (replace-regexp-in-string
12219 "\n" "" (buffer-string))))
12220 (browse-url-browser-function (or anything-surfraw-default-browser-function
12221 browse-url-browser-function)))
12222 (if (string= engine-nodesc "W")
12223 (anything-c-browse-url)
12224 (anything-c-browse-url url)
12225 (setq anything-surfraw-engines-history
12226 (cons engine (delete engine anything-surfraw-engines-history))))))
12228 ;;;###autoload
12229 (defun anything-call-source ()
12230 "Preconfigured `anything' to call anything source."
12231 (interactive)
12232 (anything :sources 'anything-c-source-call-source
12233 :buffer anything-source-select-buffer))
12235 ;;;###autoload
12236 (defun anything-execute-anything-command ()
12237 "Preconfigured `anything' to execute preconfigured `anything'."
12238 (interactive)
12239 (anything-other-buffer 'anything-c-source-anything-commands
12240 "*anything commands*"))
12242 ;;;###autoload
12243 (defun anything-create (&optional string initial-input)
12244 "Preconfigured `anything' to do many create actions from STRING.
12245 See also `anything-create--actions'."
12246 (interactive)
12247 (setq string (or string (read-string "Create Anything: " initial-input)))
12248 (anything :sources '(((name . "Anything Create")
12249 (header-name . (lambda (_) (format "Action for \"%s\"" string)))
12250 (candidates . anything-create--actions)
12251 (candidate-number-limit)
12252 (action . (lambda (func) (funcall func string)))))))
12254 ;;;###autoload
12255 (defun anything-top ()
12256 "Preconfigured `anything' for top command."
12257 (interactive)
12258 (let ((anything-samewindow t)
12259 (anything-enable-shortcuts)
12260 (anything-display-function 'anything-default-display-buffer)
12261 (anything-candidate-number-limit 9999))
12262 (save-window-excursion
12263 (delete-other-windows)
12264 (anything-other-buffer 'anything-c-source-top "*anything top*"))))
12266 ;;;###autoload
12267 (defun anything-select-xfont ()
12268 "Preconfigured `anything' to select Xfont."
12269 (interactive)
12270 (anything-other-buffer 'anything-c-source-xfonts "*anything select* xfont"))
12272 ;;;###autoload
12273 (defun anything-world-time ()
12274 "Preconfigured `anything' to show world time."
12275 (interactive)
12276 (anything-other-buffer 'anything-c-source-time-world "*anything world time*"))
12278 ;;;###autoload
12279 (defun anything-apt (arg)
12280 "Preconfigured `anything' : frontend of APT package manager.
12281 With a prefix arg reload cache."
12282 (interactive "P")
12283 (let ((query (read-string "Search Package: " nil 'anything-c-apt-input-history)))
12284 (when arg (anything-c-apt-refresh))
12285 (anything :sources 'anything-c-source-apt
12286 :prompt "Search Package: "
12287 :input query
12288 :history 'anything-c-apt-input-history)))
12290 ;;;###autoload
12291 (defun anything-esh-pcomplete ()
12292 "Preconfigured anything to provide anything completion in eshell."
12293 (interactive)
12294 (let* ((anything-quit-if-no-candidate t)
12295 (anything-execute-action-at-once-if-one t)
12296 (target (thing-at-point 'symbol))
12297 (end (point))
12298 (beg (or (and target (- end (length target)))
12299 ;; Nothing at point.
12300 (progn (insert " ") (point)))))
12301 (setq anything-ec-target (or target " "))
12302 (with-anything-show-completion beg end
12303 (anything :sources 'anything-c-source-esh
12304 :input (anything-ff-set-pattern ; Handle tramp filenames.
12305 (car (last (ignore-errors ; Needed in lisp symbols completion.
12306 (pcomplete-parse-arguments)))))))))
12308 ;;;###autoload
12309 (defun anything-eshell-history ()
12310 "Preconfigured anything for eshell history."
12311 (interactive)
12312 (let* ((end (point))
12313 (beg (save-excursion (eshell-bol) (point)))
12314 flag-empty)
12315 (when (eq beg end)
12316 (insert " ")
12317 (setq flag-empty t)
12318 (setq end (point)))
12319 (unwind-protect
12320 (with-anything-show-completion beg end
12321 (anything :sources 'anything-c-source-eshell-history
12322 :buffer "*Eshell history*"))
12323 (when (and flag-empty
12324 (looking-back " "))
12325 (delete-char -1)))))
12327 ;;;###autoload
12328 (defun anything-c-run-external-command (program)
12329 "Preconfigured `anything' to run External PROGRAM asyncronously from Emacs.
12330 If program is already running exit with error.
12331 You can set your own list of commands with
12332 `anything-c-external-commands-list'."
12333 (interactive (list
12334 (anything-comp-read
12335 "RunProgram: "
12336 (anything-c-external-commands-list-1 'sort)
12337 :must-match t
12338 :name "External Commands"
12339 :history anything-external-command-history)))
12340 (anything-run-or-raise program)
12341 (setq anything-external-command-history
12342 (cons program (delete program
12343 (loop for i in anything-external-command-history
12344 when (executable-find i) collect i)))))
12346 ;;;###autoload
12347 (defun anything-ratpoison-commands ()
12348 "Preconfigured `anything' to execute ratpoison commands."
12349 (interactive)
12350 (anything-other-buffer 'anything-c-source-ratpoison-commands
12351 "*anything ratpoison commands*"))
12353 ;;;###autoload
12354 (defun anything-ucs ()
12355 "Preconfigured anything for `ucs-names' math symbols."
12356 (interactive)
12357 (anything :sources 'anything-c-source-ucs
12358 :keymap anything-c-ucs-map))
12360 ;;;###autoload
12361 (defun anything-c-apropos ()
12362 "Preconfigured anything to describe commands, functions, variables and faces."
12363 (interactive)
12364 (let ((default (thing-at-point 'symbol)))
12365 (anything :sources
12366 `(((name . "Commands")
12367 (init . (lambda ()
12368 (anything-c-apropos-init 'commandp ,default)))
12369 (persistent-action . anything-lisp-completion-persistent-action)
12370 (persistent-help . "Show brief doc in mode-line")
12371 (candidates-in-buffer)
12372 (action . (lambda (candidate)
12373 (describe-function (intern candidate)))))
12374 ((name . "Functions")
12375 (init . (lambda ()
12376 (anything-c-apropos-init #'(lambda (x) (and (fboundp x)
12377 (not (commandp x))))
12378 ,default)))
12379 (persistent-action . anything-lisp-completion-persistent-action)
12380 (persistent-help . "Show brief doc in mode-line")
12381 (candidates-in-buffer)
12382 (action . (lambda (candidate)
12383 (describe-function (intern candidate)))))
12384 ((name . "Variables")
12385 (init . (lambda ()
12386 (anything-c-apropos-init 'boundp ,default)))
12387 (persistent-action . anything-lisp-completion-persistent-action)
12388 (persistent-help . "Show brief doc in mode-line")
12389 (candidates-in-buffer)
12390 (action . (lambda (candidate)
12391 (describe-variable (intern candidate)))))
12392 ((name . "Faces")
12393 (init . (lambda ()
12394 (anything-c-apropos-init 'facep ,default)))
12395 (persistent-action . anything-lisp-completion-persistent-action)
12396 (persistent-help . "Show brief doc in mode-line")
12397 (candidates-in-buffer)
12398 (filtered-candidate-transformer . (lambda (candidates source)
12399 (loop for c in candidates
12400 collect (propertize c 'face (intern c)))))
12401 (action . (lambda (candidate)
12402 (describe-face (intern candidate)))))
12403 ((name . "Anything attributes")
12404 (candidates . (lambda ()
12405 (mapcar 'symbol-name anything-additional-attributes)))
12406 (action . (lambda (candidate)
12407 (with-output-to-temp-buffer "*Help*"
12408 (princ (get (intern candidate) 'anything-attrdoc))))))))))
12411 ;;; Unit tests are now in ../developer-tools/unit-test-anything-config.el.
12414 (provide 'anything-config)
12416 ;;; Local Variables:
12417 ;;; time-stamp-format: "%:y-%02m-%02d %02H:%02M:%02S (%Z) %u"
12418 ;;; End:
12420 ;; How to save (DO NOT REMOVE!!)
12421 ;; (progn (magit-push) (emacswiki-post "anything-config.el"))
12422 ;;; anything-config.el ends here
12424 ;;; LocalWords: Tassilo Patrovics Vagn Johansen Dahl Clementson infos
12425 ;;; LocalWords: Kamphausen informations McBrayer Volpiatto bbdb bb
12426 ;;; LocalWords: iswitchb imenu Recentf sym samewindow pos bol eol
12427 ;;; LocalWords: aif str lst func attrib recentf lessp prin mapatoms commandp
12428 ;;; LocalWords: cmd stb Picklist picklist mapcan subentry destructuring dirs
12429 ;;; LocalWords: darwin locat MacOS mdfind Firstname Lastname calc prepend jids
12430 ;;; LocalWords: dotimes Thierry online vname
12431 ;;; LocalWords: csharp javascript lua makefile cperl zcat lineno buf
12432 ;;; LocalWords: multiline href fn cand NewTitle cwd filepath thru ret
12433 ;;; LocalWords: bfn fOpen UNC cygdrive nt xdg macos FILE's elc rx svn hg
12434 ;;; LocalWords: CANDIDATE's darcs facep pathname args pathnames subseq priorty
12435 ;;; LocalWords: Vokes rfind berkeley JST ffap lacarte bos
12436 ;;; LocalWords: Lacarte Minibuf epp LaCarte bm attrset migemo attr conf mklist
12437 ;;; LocalWords: startpos noselect dont desc