anything-config.el

   1 ;;; anything-config.el --- Applications libary for `anything.el'
   2
   3 ;; Filename: anything-config.el
   4
   5 ;; Description: Applications libary for `anything.el'
   6
   7 ;; Author: Tassilo Horn <tassilo@member.fsf.org>
   8
   9 ;; Maintainer: Tassilo Horn <tassilo@member.fsf.org>
  10 ;;             rubikitch    <rubikitch@ruby-lang.org>
  11 ;;             Thierry Volpiatto <thierry.volpiatto@gmail.com>
  12 ;; Copyright (C) 2007 ~ 2011, Tassilo Horn, all rights reserved.
  13 ;; Copyright (C) 2009, Andy Stewart, all rights reserved.
  14 ;; Copyright (C) 2009 ~ 2012, rubikitch, all rights reserved.
  15 ;; Copyright (C) 2009 ~ 2012, Thierry Volpiatto, all rights reserved.
  16
  17 ;; Created: 2009-02-16 21:38:23
  18
  19 ;; X-URL: <http://repo.or.cz/w/anything-config.git>
  20
  21 ;; MailingList: <https://groups.google.com/group/emacs-anything?hl=en>
  22
  23 ;; Keywords: anything, anything-config
  24
  25 ;; Compatibility: GNU Emacs 22 ~ 24
  26
  27 ;; Dependencies: `anything.el', `anything-match-plugin.el'.
  28
  29 ;;; This file is NOT part of GNU Emacs
  30
  31 ;;; License
  32 ;;
  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.
  37
  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.
  42
  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.
  47
  48 ;;; Commentary:
  49 ;;
  50 ;; Predefined configurations for `anything.el'
  51 ;;
  52 ;; For quick start, try `anything-for-files' to open files.
  53 ;;
  54 ;; To configure anything you should define anything command
  55 ;; with your favorite sources, like below:
  56 ;;
  57 ;; (defun my-anything ()
  58 ;;   (interactive)
  59 ;;   (anything-other-buffer
  60 ;;    '(anything-c-source-buffers
  61 ;;      anything-c-source-file-name-history
  62 ;;      anything-c-source-info-pages
  63 ;;      anything-c-source-info-elisp
  64 ;;      anything-c-source-man-pages
  65 ;;      anything-c-source-locate
  66 ;;      anything-c-source-emacs-commands)
  67 ;;    " *my-anything*"))
  68 ;;
  69 ;; Then type M-x my-anything to use sources.
  70 ;;
  71 ;; Defining own command is better than setup `anything-sources'
  72 ;; directly, because you can define multiple anything commands with
  73 ;; different sources. Each anything command should have own anything
  74 ;; buffer, because M-x anything-resume revives anything command.
  75
  76 ;; NOTE: What you find on Emacswiki is mostly deprecated and not maintained,
  77 ;;       don't complain if you use such code or configuration and something
  78 ;;       doesn't work.
  79
  80 \f
  81 ;;; Autodoc documentation:
  82 ;;  ---------------------
  83
  84 ;;  * Commands defined here are:
  85 ;; [EVAL] (autodoc-document-lisp-buffer :type 'command :prefix "anything-" :docstring t)
  86 ;; `anything-configuration'
  87 ;; Customize `anything'.
  88 ;; `anything-c-buffer-help'
  89 ;; Help command for anything buffers.
  90 ;; `anything-ff-help'
  91 ;; Help command for `anything-find-files'.
  92 ;; `anything-read-file-name-help'
  93 ;; Not documented.
  94 ;; `anything-generic-file-help'
  95 ;; Not documented.
  96 ;; `anything-grep-help'
  97 ;; Not documented.
  98 ;; `anything-pdfgrep-help'
  99 ;; Not documented.
 100 ;; `anything-etags-help'
 101 ;; The help function for etags.
 102 ;; `anything-c-ucs-help'
 103 ;; Help command for `anything-ucs'.
 104 ;; `anything-c-bookmark-help'
 105 ;; Help command for bookmarks.
 106 ;; `anything-show-this-source-only'
 107 ;; Show all candidates of this source.
 108 ;; `anything-test-sources'
 109 ;; List all anything sources for test.
 110 ;; `anything-select-source'
 111 ;; [OBSOLETE] Select source.
 112 ;; `anything-insert-buffer-name'
 113 ;; Insert buffer name.
 114 ;; `anything-quit-and-find-file'
 115 ;; Drop into `anything-find-files' from `anything'.
 116 ;; `anything-mark-all'
 117 ;; Mark all visible unmarked candidates in current source.
 118 ;; `anything-unmark-all'
 119 ;; Unmark all candidates in all sources of current anything session.
 120 ;; `anything-toggle-all-marks'
 121 ;; Toggle all marks.
 122 ;; `anything-buffer-diff-persistent'
 123 ;; Toggle diff buffer without quitting anything.
 124 ;; `anything-buffer-revert-persistent'
 125 ;; Revert buffer without quitting anything.
 126 ;; `anything-buffer-save-persistent'
 127 ;; Save buffer without quitting anything.
 128 ;; `anything-buffer-run-kill-buffers'
 129 ;; Run kill buffer action from `anything-c-source-buffers-list'.
 130 ;; `anything-buffer-run-grep'
 131 ;; Run Grep action from `anything-c-source-buffers-list'.
 132 ;; `anything-buffer-run-zgrep'
 133 ;; Run Grep action from `anything-c-source-buffers-list'.
 134 ;; `anything-buffer-run-query-replace-regexp'
 135 ;; Run Query replace regexp action from `anything-c-source-buffers-list'.
 136 ;; `anything-buffer-run-query-replace'
 137 ;; Run Query replace action from `anything-c-source-buffers-list'.
 138 ;; `anything-buffer-switch-other-window'
 139 ;; Run switch to other window action from `anything-c-source-buffers-list'.
 140 ;; `anything-buffer-switch-other-frame'
 141 ;; Run switch to other frame action from `anything-c-source-buffers-list'.
 142 ;; `anything-buffer-switch-to-elscreen'
 143 ;; Run switch to elscreen  action from `anything-c-source-buffers-list'.
 144 ;; `anything-buffer-run-ediff'
 145 ;; Run ediff action from `anything-c-source-buffers-list'.
 146 ;; `anything-buffer-run-ediff-merge'
 147 ;; Run ediff action from `anything-c-source-buffers-list'.
 148 ;; `anything-ff-run-toggle-auto-update'
 149 ;; Not documented.
 150 ;; `anything-ff-run-switch-to-history'
 151 ;; Run Switch to history action from `anything-c-source-find-files'.
 152 ;; `anything-ff-run-grep'
 153 ;; Run Grep action from `anything-c-source-find-files'.
 154 ;; `anything-ff-run-pdfgrep'
 155 ;; Run Pdfgrep action from `anything-c-source-find-files'.
 156 ;; `anything-ff-run-zgrep'
 157 ;; Run Grep action from `anything-c-source-find-files'.
 158 ;; `anything-ff-run-copy-file'
 159 ;; Run Copy file action from `anything-c-source-find-files'.
 160 ;; `anything-ff-run-rename-file'
 161 ;; Run Rename file action from `anything-c-source-find-files'.
 162 ;; `anything-ff-run-byte-compile-file'
 163 ;; Run Byte compile file action from `anything-c-source-find-files'.
 164 ;; `anything-ff-run-load-file'
 165 ;; Run Load file action from `anything-c-source-find-files'.
 166 ;; `anything-ff-run-eshell-command-on-file'
 167 ;; Run eshell command on file action from `anything-c-source-find-files'.
 168 ;; `anything-ff-run-ediff-file'
 169 ;; Run Ediff file action from `anything-c-source-find-files'.
 170 ;; `anything-ff-run-ediff-merge-file'
 171 ;; Run Ediff merge file action from `anything-c-source-find-files'.
 172 ;; `anything-ff-run-symlink-file'
 173 ;; Run Symlink file action from `anything-c-source-find-files'.
 174 ;; `anything-ff-run-hardlink-file'
 175 ;; Run Hardlink file action from `anything-c-source-find-files'.
 176 ;; `anything-ff-run-delete-file'
 177 ;; Run Delete file action from `anything-c-source-find-files'.
 178 ;; `anything-ff-run-complete-fn-at-point'
 179 ;; Run complete file name action from `anything-c-source-find-files'.
 180 ;; `anything-ff-run-switch-to-eshell'
 181 ;; Run switch to eshell action from `anything-c-source-find-files'.
 182 ;; `anything-ff-run-switch-other-window'
 183 ;; Run switch to other window action from `anything-c-source-find-files'.
 184 ;; `anything-ff-run-switch-other-frame'
 185 ;; Run switch to other frame action from `anything-c-source-find-files'.
 186 ;; `anything-ff-run-open-file-externally'
 187 ;; Run open file externally command action from `anything-c-source-find-files'.
 188 ;; `anything-ff-run-locate'
 189 ;; Run locate action from `anything-c-source-find-files'.
 190 ;; `anything-ff-run-gnus-attach-files'
 191 ;; Run gnus attach files command action from `anything-c-source-find-files'.
 192 ;; `anything-ff-run-etags'
 193 ;; Run Etags command action from `anything-c-source-find-files'.
 194 ;; `anything-ff-run-print-file'
 195 ;; Run Print file action from `anything-c-source-find-files'.
 196 ;; `anything-ff-run-toggle-basename'
 197 ;; Not documented.
 198 ;; `anything-find-files-down-one-level'
 199 ;; Go down one level like unix command `cd ..'.
 200 ;; `anything-ff-properties-persistent'
 201 ;; Show properties without quitting anything.
 202 ;; `anything-ff-persistent-delete'
 203 ;; Delete current candidate without quitting.
 204 ;; `anything-ff-run-kill-buffer-persistent'
 205 ;; Execute `anything-ff-kill-buffer-fname' whitout quitting.
 206 ;; `anything-ff-rotate-left-persistent'
 207 ;; Rotate image left without quitting anything.
 208 ;; `anything-ff-rotate-right-persistent'
 209 ;; Rotate image right without quitting anything.
 210 ;; `anything-c-goto-precedent-file'
 211 ;; Go to precedent file in anything grep/etags buffers.
 212 ;; `anything-c-goto-next-file'
 213 ;; Go to precedent file in anything grep/etags buffers.
 214 ;; `anything-c-grep-run-persistent-action'
 215 ;; Run grep persistent action from `anything-do-grep-1'.
 216 ;; `anything-c-grep-run-default-action'
 217 ;; Run grep default action from `anything-do-grep-1'.
 218 ;; `anything-c-grep-run-other-window-action'
 219 ;; Run grep goto other window action from `anything-do-grep-1'.
 220 ;; `anything-c-grep-run-save-buffer'
 221 ;; Run grep save results action from `anything-do-grep-1'.
 222 ;; `anything-yank-text-at-point'
 223 ;; Yank text at point in minibuffer.
 224 ;; `anything-c-bookmark-run-jump-other-window'
 225 ;; Jump to bookmark from keyboard.
 226 ;; `anything-c-bookmark-run-delete'
 227 ;; Delete bookmark from keyboard.
 228 ;; `anything-c-bmkext-run-edit'
 229 ;; Run `bmkext-edit-bookmark' from keyboard.
 230 ;; `anything-yaoddmuse-cache-pages'
 231 ;; Fetch the list of files on emacswiki and create cache file.
 232 ;; `anything-eval-new-line-and-indent'
 233 ;; Not documented.
 234 ;; `anything-call-source-from-anything'
 235 ;; Call anything source within `anything' session.
 236 ;; `anything-create-from-anything'
 237 ;; Run `anything-create' from `anything' as a fallback.
 238 ;; `anything-c-ucs-persistent-insert'
 239 ;; Not documented.
 240 ;; `anything-c-ucs-persistent-forward'
 241 ;; Not documented.
 242 ;; `anything-c-ucs-persistent-backward'
 243 ;; Not documented.
 244 ;; `anything-c-ucs-persistent-delete'
 245 ;; Not documented.
 246 ;; `anything-lisp-completion-at-point'
 247 ;; Anything lisp symbol completion at point.
 248 ;; `anything-c-complete-file-name-at-point'
 249 ;; Complete file name at point.
 250 ;; `anything-lisp-completion-at-point-or-indent'
 251 ;; First call indent and second call complete lisp symbol.
 252 ;; `anything-lisp-completion-or-file-name-at-point'
 253 ;; Complete lisp symbol or filename at point.
 254 ;; `anything-w32-shell-execute-open-file'
 255 ;; Not documented.
 256 ;; `anything-c-set-variable'
 257 ;; Set value to VAR interactively.
 258 ;; `anything-c-adaptive-save-history'
 259 ;; Save history information to file given by `anything-c-adaptive-history-file'.
 260 ;; `anything-c-reset-adaptative-history'
 261 ;; Delete all `anything-c-adaptive-history' and his file.
 262 ;; `anything-mini'
 263 ;; Preconfigured `anything' lightweight version (buffer -> recentf).
 264 ;; `anything-for-files'
 265 ;; Preconfigured `anything' for opening files.
 266 ;; `anything-recentf'
 267 ;; Preconfigured `anything' for `recentf'.
 268 ;; `anything-info-at-point'
 269 ;; Preconfigured `anything' for searching info at point.
 270 ;; `anything-show-kill-ring'
 271 ;; Preconfigured `anything' for `kill-ring'.
 272 ;; `anything-minibuffer-history'
 273 ;; Preconfigured `anything' for `minibuffer-history'.
 274 ;; `anything-gentoo'
 275 ;; Preconfigured `anything' for gentoo linux.
 276 ;; `anything-imenu'
 277 ;; Preconfigured `anything' for `imenu'.
 278 ;; `anything-google-suggest'
 279 ;; Preconfigured `anything' for google search with google suggest.
 280 ;; `anything-yahoo-suggest'
 281 ;; Preconfigured `anything' for Yahoo searching with Yahoo suggest.
 282 ;; `anything-for-buffers'
 283 ;; Preconfigured `anything' for buffers.
 284 ;; `anything-buffers-list'
 285 ;; Preconfigured `anything' to list buffers.
 286 ;; `anything-bbdb'
 287 ;; Preconfigured `anything' for BBDB.
 288 ;; `anything-locate'
 289 ;; Preconfigured `anything' for Locate.
 290 ;; `anything-w3m-bookmarks'
 291 ;; Preconfigured `anything' for w3m bookmark.
 292 ;; `anything-firefox-bookmarks'
 293 ;; Preconfigured `anything' for firefox bookmark.
 294 ;; `anything-colors'
 295 ;; Preconfigured `anything' for color.
 296 ;; `anything-bookmarks'
 297 ;; Preconfigured `anything' for bookmarks.
 298 ;; `anything-c-pp-bookmarks'
 299 ;; Preconfigured `anything' for bookmarks       (pretty-printed).
 300 ;; `anything-c-insert-latex-math'
 301 ;; Preconfigured anything for latex math symbols completion.
 302 ;; `anything-register'
 303 ;; Preconfigured `anything' for Emacs registers.
 304 ;; `anything-man-woman'
 305 ;; Preconfigured `anything' for Man and Woman pages.
 306 ;; `anything-org-keywords'
 307 ;; Preconfigured `anything' for org keywords.
 308 ;; `anything-emms'
 309 ;; Preconfigured `anything' for emms sources.
 310 ;; `anything-eev-anchors'
 311 ;; Preconfigured `anything' for eev anchors.
 312 ;; `anything-bm-list'
 313 ;; Preconfigured `anything' for visible bookmarks.
 314 ;; `anything-timers'
 315 ;; Preconfigured `anything' for timers.
 316 ;; `anything-list-emacs-process'
 317 ;; Preconfigured `anything' for emacs process.
 318 ;; `anything-occur'
 319 ;; Preconfigured Anything for Occur source.
 320 ;; `anything-browse-code'
 321 ;; Preconfigured anything to browse code.
 322 ;; `anything-org-headlines'
 323 ;; Preconfigured anything to show org headlines.
 324 ;; `anything-regexp'
 325 ;; Preconfigured anything to build regexps.
 326 ;; `anything-c-copy-files-async'
 327 ;; Preconfigured anything to copy file list FLIST to DEST asynchronously.
 328 ;; `anything-find-files'
 329 ;; Preconfigured `anything' for anything implementation of `find-file'.
 330 ;; `anything-write-file'
 331 ;; Preconfigured `anything' providing completion for `write-file'.
 332 ;; `anything-insert-file'
 333 ;; Preconfigured `anything' providing completion for `insert-file'.
 334 ;; `anything-dired-rename-file'
 335 ;; Preconfigured `anything' to rename files from dired.
 336 ;; `anything-dired-copy-file'
 337 ;; Preconfigured `anything' to copy files from dired.
 338 ;; `anything-dired-symlink-file'
 339 ;; Preconfigured `anything' to symlink files from dired.
 340 ;; `anything-dired-hardlink-file'
 341 ;; Preconfigured `anything' to hardlink files from dired.
 342 ;; `anything-do-grep'
 343 ;; Preconfigured anything for grep.
 344 ;; `anything-do-pdfgrep'
 345 ;; Preconfigured anything for pdfgrep.
 346 ;; `anything-c-etags-select'
 347 ;; Preconfigured anything for etags.
 348 ;; `anything-filelist'
 349 ;; Preconfigured `anything' to open files instantly.
 350 ;; `anything-filelist+'
 351 ;; Preconfigured `anything' to open files/buffers/bookmarks instantly.
 352 ;; `anything-M-x'
 353 ;; Preconfigured `anything' for Emacs commands.
 354 ;; `anything-manage-advice'
 355 ;; Preconfigured `anything' to disable/enable function advices.
 356 ;; `anything-bookmark-ext'
 357 ;; Preconfigured `anything' for bookmark-extensions sources.
 358 ;; `anything-simple-call-tree'
 359 ;; Preconfigured `anything' for simple-call-tree. List function relationships.
 360 ;; `anything-mark-ring'
 361 ;; Preconfigured `anything' for `anything-c-source-mark-ring'.
 362 ;; `anything-global-mark-ring'
 363 ;; Preconfigured `anything' for `anything-c-source-global-mark-ring'.
 364 ;; `anything-all-mark-rings'
 365 ;; Preconfigured `anything' for `anything-c-source-global-mark-ring' and `anything-c-source-mark-ring'.
 366 ;; `anything-yaoddmuse-emacswiki-edit-or-view'
 367 ;; Preconfigured `anything' to edit or view EmacsWiki page.
 368 ;; `anything-yaoddmuse-emacswiki-post-library'
 369 ;; Preconfigured `anything' to post library to EmacsWiki.
 370 ;; `anything-eval-expression'
 371 ;; Preconfigured anything for `anything-c-source-evaluation-result'.
 372 ;; `anything-eval-expression-with-eldoc'
 373 ;; Preconfigured anything for `anything-c-source-evaluation-result' with `eldoc' support.
 374 ;; `anything-calcul-expression'
 375 ;; Preconfigured anything for `anything-c-source-calculation-result'.
 376 ;; `anything-surfraw'
 377 ;; Preconfigured `anything' to search PATTERN with search ENGINE.
 378 ;; `anything-call-source'
 379 ;; Preconfigured `anything' to call anything source.
 380 ;; `anything-execute-anything-command'
 381 ;; Preconfigured `anything' to execute preconfigured `anything'.
 382 ;; `anything-create'
 383 ;; Preconfigured `anything' to do many create actions from STRING.
 384 ;; `anything-top'
 385 ;; Preconfigured `anything' for top command.
 386 ;; `anything-select-xfont'
 387 ;; Preconfigured `anything' to select Xfont.
 388 ;; `anything-world-time'
 389 ;; Preconfigured `anything' to show world time.
 390 ;; `anything-apt'
 391 ;; Preconfigured `anything' : frontend of APT package manager.
 392 ;; `anything-esh-pcomplete'
 393 ;; Preconfigured anything to provide anything completion in eshell.
 394 ;; `anything-eshell-history'
 395 ;; Preconfigured anything for eshell history.
 396 ;; `anything-c-run-external-command'
 397 ;; Preconfigured `anything' to run External PROGRAM asyncronously from Emacs.
 398 ;; `anything-ratpoison-commands'
 399 ;; Preconfigured `anything' to execute ratpoison commands.
 400 ;; `anything-ucs'
 401 ;; Preconfigured anything for `ucs-names' math symbols.
 402 ;; `anything-c-apropos'
 403 ;; Preconfigured anything to describe commands, functions, variables and faces.
 404 ;; `anything-xrandr-set'
 405 ;; Not documented.
 406
 407 ;;  * User variables defined here:
 408 ;; [EVAL] (autodoc-document-lisp-buffer :type 'user-variable :prefix "anything-" :var-value t)
 409 ;; `anything-c-adaptive-history-file'
 410 ;; Default Value: "~/.emacs.d/anything-c-adaptive-history"
 411 ;; `anything-c-adaptive-history-length'
 412 ;; Default Value: 50
 413 ;; `anything-c-google-suggest-url'
 414 ;; Default Value: "http://google.com/complete/search?output=toolbar&q="
 415 ;; `anything-c-google-suggest-search-url'
 416 ;; Default Value: "http://www.google.com/search?ie=utf-8&oe=utf-8&q="
 417 ;; `anything-google-suggest-use-curl-p'
 418 ;; Default Value: nil
 419 ;; `anything-c-yahoo-suggest-url'
 420 ;; Default Value: "http://search.yahooapis.com/WebSearchService/V1/relatedSuggestion?appid=G [...]
 421 ;; `anything-c-yahoo-suggest-search-url'
 422 ;; Default Value: "http://search.yahoo.com/search?&ei=UTF-8&fr&h=c&p="
 423 ;; `anything-c-boring-buffer-regexp'
 424 ;; Default Value: "\\   (\\` \\)\\|\\*anything\\|\\*ac-mode\\| \\*Echo Area\\| \\*Minibuf"
 425 ;; `anything-c-boring-file-regexp'
 426 ;; Default Value: "/\\  (?:\\(?:\\.\\(?:git\\|hg\\|svn\\)\\|CVS\\|_darcs\\)\\)\\(?:/\\|$\\)\\| [...]
 427 ;; `anything-kill-ring-threshold'
 428 ;; Default Value: 10
 429 ;; `anything-c-kill-ring-max-lines-number'
 430 ;; Default Value: nil
 431 ;; `anything-su-or-sudo'
 432 ;; Default Value: "su"
 433 ;; `anything-for-files-prefered-list'
 434 ;; Default Value:       (anything-c-source-ffap-line anything-c-source-ffap-guesser anything-c-sou [...]
 435 ;; `anything-create--actions-private'
 436 ;; Default Value: nil
 437 ;; `anything-allow-skipping-current-buffer'
 438 ;; Default Value: nil
 439 ;; `anything-c-enable-eval-defun-hack'
 440 ;; Default Value: t
 441 ;; `anything-tramp-verbose'
 442 ;; Default Value: 0
 443 ;; `anything-raise-command'
 444 ;; Default Value: nil
 445 ;; `anything-command-map-prefix-key'
 446 ;; Default Value: "<f5> a"
 447 ;; `anything-c-browse-code-regexp-lisp'
 448 ;; Default Value: "^ *  (def\\(un\\|subst\\|macro\\|face\\|alias\\|advice\\|struct\\|type\\|th [...]
 449 ;; `anything-c-browse-code-regexp-python'
 450 ;; Default Value: "\\<def\\>\\|\\<class\\>"
 451 ;; `anything-c-browse-code-regexp-alist'
 452 ;; Default Value:       ((lisp-interaction-mode . "^ *(def\\(un\\|subst\\|macro\\|face\\|alias\\|a [...]
 453 ;; `anything-c-external-programs-associations'
 454 ;; Default Value: nil
 455 ;; `anything-ff-auto-update-initial-value'
 456 ;; Default Value: t
 457 ;; `anything-c-copy-async-prefered-emacs'
 458 ;; Default Value: "emacs"
 459 ;; `anything-ff-lynx-style-map'
 460 ;; Default Value: t
 461 ;; `anything-ff-history-max-length'
 462 ;; Default Value: 100
 463 ;; `anything-ff-smart-completion'
 464 ;; Default Value: t
 465 ;; `anything-ff-default-kbsize'
 466 ;; Default Value: 1024.0
 467 ;; `anything-ff-tramp-not-fancy'
 468 ;; Default Value: t
 469 ;; `anything-ff-exif-data-program'
 470 ;; Default Value: "exiftran"
 471 ;; `anything-ff-exif-data-program-args'
 472 ;; Default Value: "-d"
 473 ;; `anything-c-grep-use-ioccur-style-keys'
 474 ;; Default Value: t
 475 ;; `anything-c-pdfgrep-default-read-command'
 476 ;; Default Value: "xpdf '%f' %p"
 477 ;; `anything-c-etags-tag-file-name'
 478 ;; Default Value: "TAGS"
 479 ;; `anything-c-etags-tag-file-search-limit'
 480 ;; Default Value: 10
 481 ;; `anything-c-etags-use-regexp-search'
 482 ;; Default Value: nil
 483 ;; `anything-c-etags-search-regexp'
 484 ;; Default Value: "^.+: .+ \\<%s"
 485 ;; `anything-c-filelist-file-name'
 486 ;; Default Value: nil
 487 ;; `anything-c-eldoc-in-minibuffer-show-fn'
 488 ;; Default Value: anything-c-show-info-in-mode-line
 489 ;; `anything-c-turn-on-show-completion'
 490 ;; Default Value: t
 491 ;; `anything-c-show-completion-use-special-display'
 492 ;; Default Value: t
 493 ;; `anything-c-show-completion-min-window-height'
 494 ;; Default Value: 7
 495 ;; `anything-lisp-completion-or-indent-delay'
 496 ;; Default Value: 0.6
 497 ;; `anything-c-default-external-file-browser'
 498 ;; Default Value: "nautilus"
 499 ;; `anything-c-use-adaptative-sorting'
 500 ;; Default Value: nil
 501 ;; `anything-ff-newfile-prompt-p'
 502 ;; Default Value: t
 503 ;; `anything-ff-avfs-directory'
 504 ;; Default Value: nil
 505 ;; `anything-ff-file-compressed-list'
 506 ;; Default Value:       ("gz" "bz2" "zip" "7z")
 507 ;; `anything-locate-db-file-regexp'
 508 ;; Default Value: "m?locate.db$"
 509 ;; `anything-c-locate-command'
 510 ;; Default Value: nil
 511 ;; `anything-c-show-info-in-mode-line-delay'
 512 ;; Default Value: 12
 513 ;; `anything-c-copy-files-async-log-file'
 514 ;; Default Value: "/tmp/dired.log"
 515 ;; `anything-ff-printer-list'
 516 ;; Default Value: nil
 517 ;; `anything-ff-transformer-show-only-basename'
 518 ;; Default Value: nil
 519 ;; `anything-ff-quick-delete-dont-prompt-for-deletion'
 520 ;; Default Value: nil
 521 ;; `anything-ff-signal-error-on-dot-files'
 522 ;; Default Value: t
 523 ;; `anything-completing-read-handlers-alist'
 524 ;; Default Value:       ((describe-function . anything-completing-read-symbols)  (describe-variabl [...]
 525
 526 ;;  * Anything sources defined here:
 527 ;; [EVAL] (autodoc-document-lisp-buffer :type 'anything-source :prefix "anything-" :any-sname t)
 528 ;; `anything-c-source-regexp'                                   (Regexp Builder)
 529 ;; `anything-c-source-buffers'                                  (Buffers)
 530 ;; `anything-c-source-buffer-not-found'                         (Create buffer)
 531 ;; `anything-c-source-buffers-list'                             (Buffers)
 532 ;; `anything-c-source-file-name-history'                        (File Name History)
 533 ;; `anything-c-source-files-in-current-dir'                     (Files from Current Directory)
 534 ;; `anything-c-source-files-in-current-dir+'                    (Files from Current Directory)
 535 ;; `anything-c-source-find-files'                               (Find Files)
 536 ;; `anything-c-source-write-file'                               (Write File)
 537 ;; `anything-c-source-insert-file'                              (Insert File)
 538 ;; `anything-c-source-copy-files'                               (Copy Files)
 539 ;; `anything-c-source-symlink-files'                            (Symlink Files)
 540 ;; `anything-c-source-hardlink-files'                           (Hardlink Files)
 541 ;; `anything-c-source-file-cache'                               (File Cache)
 542 ;; `anything-c-source-locate'                                   (Locate)
 543 ;; `anything-c-source-recentf'                                  (Recentf)
 544 ;; `anything-c-source-ffap-guesser'                             (File at point)
 545 ;; `anything-c-source-ffap-line'                                (File/Lineno at point)
 546 ;; `anything-c-source-files-in-all-dired'                       (Files in all dired buffer.)
 547 ;; `anything-c-source-filelist'                                 (FileList)
 548 ;; `anything-c-source-info-pages'                               (Info Pages)
 549 ;; `anything-c-source-man-pages'                                (Manual Pages)
 550 ;; `anything-c-source-complex-command-history'                  (Complex Command History)
 551 ;; `anything-c-source-extended-command-history'                 (Emacs Commands History)
 552 ;; `anything-c-source-emacs-commands'                           (Emacs Commands)
 553 ;; `anything-c-source-emacs-functions'                          (Emacs Functions)
 554 ;; `anything-c-source-emacs-functions-with-abbrevs'             (Emacs Functions)
 555 ;; `anything-c-source-advice'                                   (Function Advice)
 556 ;; `anything-c-source-emacs-variables'                          (Emacs Variables)
 557 ;; `anything-c-source-lacarte'                                  (Lacarte)
 558 ;; `anything-c-source-bookmarks'                                (Bookmarks)
 559 ;; `anything-c-source-bookmark-set'                             (Set Bookmark)
 560 ;; `anything-c-source-bm'                                       (Visible Bookmarks)
 561 ;; `anything-c-source-bookmarks-ssh'                            (Bookmarks-ssh)
 562 ;; `anything-c-source-bookmarks-su'                             (Bookmarks-root)
 563 ;; `anything-c-source-bookmarks-local'                          (Bookmarks-Local)
 564 ;; `anything-c-source-bmkext-addressbook'                       (Bookmark Addressbook)
 565 ;; `anything-c-source-bookmark-w3m'                             (Bookmark W3m)
 566 ;; `anything-c-source-bookmark-images'                          (Bookmark Images)
 567 ;; `anything-c-source-bookmark-man'                             (Bookmark Woman&Man)
 568 ;; `anything-c-source-bookmark-gnus'                            (Bookmark Gnus)
 569 ;; `anything-c-source-bookmark-info'                            (Bookmark Info)
 570 ;; `anything-c-source-bookmark-files&dirs'                      (Bookmark Files&Directories)
 571 ;; `anything-c-source-bookmark-su-files&dirs'                   (Bookmark Root-Files&Directories)
 572 ;; `anything-c-source-bookmark-ssh-files&dirs'                  (Bookmark Ssh-Files&Directories)
 573 ;; `anything-c-source-firefox-bookmarks'                        (Firefox Bookmarks)
 574 ;; `anything-c-source-w3m-bookmarks'                            (W3m Bookmarks)
 575 ;; `anything-c-source-elisp-library-scan'                       (Elisp libraries (Scan))
 576 ;; `anything-c-source-imenu'                                    (Imenu)
 577 ;; `anything-c-source-ctags'                                    (Exuberant ctags)
 578 ;; `anything-c-source-etags-select'                             (Etags)
 579 ;; `anything-c-source-semantic'                                 (Semantic Tags)
 580 ;; `anything-c-source-simple-call-tree-functions-callers'       (Function is called by)
 581 ;; `anything-c-source-simple-call-tree-callers-functions'       (Function calls)
 582 ;; `anything-c-source-commands-and-options-in-file'             (Commands/Options in file)
 583 ;; `anything-c-source-customize-face'                           (Customize Face)
 584 ;; `anything-c-source-colors'                                   (Colors)
 585 ;; `anything-c-source-tracker-search'                           (Tracker Search)
 586 ;; `anything-c-source-mac-spotlight'                            (mdfind)
 587 ;; `anything-c-source-picklist'                                 (Picklist)
 588 ;; `anything-c-source-kill-ring'                                (Kill Ring)
 589 ;; `anything-c-source-mark-ring'                                (mark-ring)
 590 ;; `anything-c-source-global-mark-ring'                         (global-mark-ring)
 591 ;; `anything-c-source-register'                                 (Registers)
 592 ;; `anything-c-source-latex-math'                               (Latex Math Menu)
 593 ;; `anything-c-source-fixme'                                    (TODO/FIXME/DRY comments)
 594 ;; `anything-c-source-rd-headline'                              (RD HeadLine)
 595 ;; `anything-c-source-oddmuse-headline'                         (Oddmuse HeadLine)
 596 ;; `anything-c-source-emacs-source-defun'                       (Emacs Source DEFUN)
 597 ;; `anything-c-source-emacs-lisp-expectations'                  (Emacs Lisp Expectations)
 598 ;; `anything-c-source-emacs-lisp-toplevels'                     (Emacs Lisp Toplevel / Level 4 Comment / Linkd Star)
 599 ;; `anything-c-source-yaoddmuse-emacswiki-edit-or-view'         (Yaoddmuse Edit or View (EmacsWiki))
 600 ;; `anything-c-source-yaoddmuse-emacswiki-post-library'         (Yaoddmuse Post library (EmacsWiki))
 601 ;; `anything-c-source-eev-anchor'                               (Anchors)
 602 ;; `anything-c-source-org-headline'                             (Org HeadLine)
 603 ;; `anything-c-source-org-keywords'                             (Org Keywords)
 604 ;; `anything-c-source-bbdb'                                     (BBDB)
 605 ;; `anything-c-source-evaluation-result'                        (Evaluation Result)
 606 ;; `anything-c-source-calculation-result'                       (Calculation Result)
 607 ;; `anything-c-source-google-suggest'                           (Google Suggest)
 608 ;; `anything-c-source-yahoo-suggest'                            (Yahoo Suggest)
 609 ;; `anything-c-source-emms-streams'                             (Emms Streams)
 610 ;; `anything-c-source-emms-dired'                               (Music Directory)
 611 ;; `anything-c-source-emms-files'                               (Emms files)
 612 ;; `anything-c-source-jabber-contacts'                          (Jabber Contacts)
 613 ;; `anything-c-source-call-source'                              (Call anything source)
 614 ;; `anything-c-source-anything-commands'                        (Preconfigured Anything)
 615 ;; `anything-c-source-occur'                                    (Occur)
 616 ;; `anything-c-source-browse-code'                              (Browse code)
 617 ;; `anything-c-source-create'                                   (Create)
 618 ;; `anything-c-source-minibuffer-history'                       (Minibuffer History)
 619 ;; `anything-c-source-elscreen'                                 (Elscreen)
 620 ;; `anything-c-source-top'                                      (Top (Press C-c C-u to refresh))
 621 ;; `anything-c-source-absolute-time-timers'                     (Absolute Time Timers)
 622 ;; `anything-c-source-idle-time-timers'                         (Idle Time Timers)
 623 ;; `anything-c-source-xrandr-change-resolution'                 (Change Resolution)
 624 ;; `anything-c-source-xfonts'                                   (X Fonts)
 625 ;; `anything-c-source-ucs'                                      (Ucs names)
 626 ;; `anything-c-source-emacs-process'                            (Emacs Process)
 627 ;; `anything-c-source-time-world'                               (Time World List)
 628 ;; `anything-c-source-apt'                                      (APT)
 629 ;; `anything-c-source-gentoo'                                   (Portage sources)
 630 ;; `anything-c-source-use-flags'                                (Use Flags)
 631 ;; `anything-c-source-ratpoison-commands'                       (Ratpoison Commands)
 632 ;; `anything-c-source-esh'                                      (Eshell completions)
 633 ;; `anything-c-source-eshell-history'                           (Eshell history)
 634
 635 ;;  *** END auto-documentation
 636
 637 ;;; For Maintainers:
 638 ;;
 639 ;; Install developer-tools/autodoc.el and
 640 ;; Evaluate (autodoc-update-all) before commit or run it interactively.
 641 ;; This function generates anything-c-source-* / functions / options list.
 642 ;;
 643 ;; [EVAL IT] (autodoc-update-all)
 644 ;;
 645 ;; Please write details documentation about function, then others will
 646 ;; read code more easier.   -- Andy Stewart
 647 ;;
 648
 649 \f
 650 ;;; Change log:
 651 ;;
 652 ;;  Change log of this file is found at
 653 ;;  http://repo.or.cz/w/anything-config.git/history/master:/anything-config.el
 654 ;;
 655 ;;  Change log of this project is found at
 656 ;;  http://repo.or.cz/w/anything-config.git?a=shortlog
 657
 658 ;;; Contributors:
 659 ;;
 660 ;;     Tamas Patrovics
 661 ;;     Tassilo Horn <tassilo@member.fsf.org>
 662 ;;     Vagn Johansen <gonz808@hotmail.com>
 663 ;;     Mathias Dahl <mathias.dahl@gmail.com>
 664 ;;     Bill Clementson <billclem@gmail.com>
 665 ;;     Stefan Kamphausen (see http://www.skamphausen.de for more informations)
 666 ;;     Drew Adams <drew.adams@oracle.com>
 667 ;;     Jason McBrayer <jmcbray@carcosa.net>
 668 ;;     Andy Stewart <lazycat.manatee@gmail.com>
 669 ;;     Thierry Volpiatto <thierry.volpiatto@gmail.com>
 670 ;;     rubikitch <rubikitch@ruby-lang.org>
 671 ;;     Scott Vokes <vokes.s@gmail.com>
 672 ;;     Kenichirou Oyama <k1lowxb@gmail.com>
 673
 674
 675 ;;; TODO
 676 ;;
 677 ;; - Fix documentation, now many functions haven't documentations.
 678 ;;
 679
 680 \f
 681 ;;; Code:
 682
 683 ;;; Require
 684 ;;
 685 ;;
 686 (require 'anything)
 687 (require 'thingatpt)
 688 (require 'ffap)
 689 (require 'cl)
 690 (eval-when-compile (require 'dired))
 691 (require 'dired-aux)
 692 (require 'dired-x)
 693 (require 'tramp)
 694 (require 'grep)
 695 (require 'url)
 696 (require 'xml)
 697 (eval-when-compile (require 'org)) ; Shut up byte compiler about org-directory.
 698 (eval-when-compile (require 'semantic nil t))
 699 (require 'anything-match-plugin)
 700
 701
 702 \f
 703 ;;; Declare external functions
 704 ;;
 705 ;;
 706 (declare-function gnus-dired-attach "ext:gnus-dired.el" (files-to-attach))
 707 (declare-function image-dired-display-image "image-dired.el" (file &optional original-size))
 708 (declare-function image-dired-update-property "image-dired.el" (prop value))
 709 (declare-function woman-file-name-all-completions "woman.el" (topic))
 710 (declare-function Man-getpage-in-background "man.el" (topic))
 711 (declare-function simple-call-tree-analyze "ext:simple-call-tree.el" (&optional test))
 712 (declare-function yaoddmuse-update-pagename "ext:yaoddmuse.el" (&optional unforced))
 713 (declare-function yaoddmuse-get-library-list "ext:yaoddmuse.el" (&optional dirs string))
 714 (declare-function org-get-current-options "ext:org-exp.el")
 715 (declare-function emms-streams "ext:emms-streams")
 716 (declare-function emms-stream-delete-bookmark "ext:emms-streams")
 717 (declare-function emms-stream-add-bookmark "ext:emms-streams" (name url fd type))
 718 (declare-function emms-stream-save-bookmarks-file "ext:emms-streams")
 719 (declare-function emms-stream-quit "ext:emms-streams")
 720 (declare-function with-current-emms-playlist "ext:emms" (&rest body))
 721 (declare-function emms-playlist-tracks-in-region "ext:emms" (beg end))
 722 (declare-function emms-playlist-first "ext:emms")
 723 (declare-function emms-playlist-mode-play-smart "ext:emms-playlist-mode")
 724 (declare-function term-line-mode "term")
 725 (declare-function term-char-mode "term")
 726 (declare-function term-send-input "term")
 727 (declare-function term-send-eof "term")
 728 (declare-function Info-index-nodes "info" (&optional file))
 729 (declare-function Info-goto-node "info" (&optional fork))
 730 (declare-function Info-find-node "info.el" (filename nodename &optional no-going-back))
 731 (declare-function elscreen-find-screen-by-buffer "ext:elscreen.el" (buffer &optional create))
 732 (declare-function elscreen-find-file "ext:elscreen.el" (filename))
 733 (declare-function elscreen-goto "ext:elscreen.el" (screen))
 734 (declare-function semantic-format-tag-summarize "ext:format.el" (tag &optional parent color) t)
 735 (declare-function semantic-tag-components "ext:tag.el" (tag) t)
 736 (declare-function semantic-go-to-tag "ext:tag-file.el" (tag) t)
 737 (declare-function semantic-tag-type "ext:tag-file.el" (tag) t)
 738 (declare-function semantic-tag-class "ext:tag-file.el" (tag) t)
 739 (declare-function bbdb "ext:bbdb-com")
 740 (declare-function bbdb-current-record "ext:bbdb-com")
 741 (declare-function bbdb-redisplay-one-record "ext:bbdb-com")
 742 (declare-function bbdb-record-net "ext:bbdb-com" (string) t)
 743 (declare-function bbdb-current-record "ext:bbdb-com")
 744 (declare-function bbdb-dwim-net-address "ext:bbdb-com")
 745 (declare-function bbdb-records "ext:bbdb-com"
 746                   (&optional dont-check-disk already-in-db-buffer))
 747 (declare-function eshell-read-aliases-list "em-alias")
 748 (declare-function eshell-send-input "esh-mode" (&optional use-region queue-p no-newline))
 749 (declare-function eshell-bol "esh-mode")
 750 (declare-function eldoc-current-symbol "eldoc")
 751 (declare-function eldoc-get-fnsym-args-string "eldoc" (sym &optional index))
 752 (declare-function eldoc-get-var-docstring "eldoc" (sym))
 753 (declare-function eldoc-fnsym-in-current-sexp "eldoc")
 754 (declare-function find-library-name "find-func.el" (library))
 755 (declare-function adoc-construct "ext:auto-document.el" (buf))
 756 (declare-function adoc-first-line "ext:auto-document.el" (str))
 757 (declare-function adoc-prin1-to-string "ext:auto-document.el" (object))
 758 (declare-function secure-hash "ext:fns.c" (algorithm object &optional start end binary))
 759 (declare-function w32-shell-execute "ext:w32fns.c" (operation document &optional parameters show-flag))
 760 (declare-function undo-tree-restore-state-from-register "ext:undo-tree.el" (register))
 761
 762 \f
 763 ;;; compatibility
 764 ;;
 765 ;;
 766 (unless (fboundp 'window-system)
 767   (defun window-system (&optional arg)
 768     window-system))
 769
 770 (unless (fboundp 'make-composed-keymap)
 771   (defun make-composed-keymap (maps &optional parent)
 772     "Construct a new keymap composed of MAPS and inheriting from PARENT.
 773 When looking up a key in the returned map, the key is looked in each
 774 keymap of MAPS in turn until a binding is found.
 775 If no binding is found in MAPS, the lookup continues in PARENT, if non-nil.
 776 As always with keymap inheritance, a nil binding in MAPS overrides
 777 any corresponding binding in PARENT, but it does not override corresponding
 778 bindings in other keymaps of MAPS.
 779 MAPS can be a list of keymaps or a single keymap.
 780 PARENT if non-nil should be a keymap."
 781     `(keymap
 782       ,@(if (keymapp maps) (list maps) maps)
 783       ,@parent)))
 784
 785 (unless (fboundp 'apply-partially)
 786   (defun apply-partially (fun &rest args)
 787     "Return a function that is a partial application of FUN to ARGS.
 788 ARGS is a list of the first N arguments to pass to FUN.
 789 The result is a new function which does the same as FUN, except that
 790 the first N arguments are fixed at the values with which this function
 791 was called."
 792     (lexical-let ((fun fun) (args1 args))
 793       (lambda (&rest args2) (apply fun (append args1 args2))))))
 794
 795 \f
 796 ;;; Customize
 797 ;;
 798 ;;
 799 (defgroup anything-config nil
 800   "Predefined configurations for `anything.el'."
 801   :group 'anything)
 802
 803 (defcustom anything-c-adaptive-history-file
 804   "~/.emacs.d/anything-c-adaptive-history"
 805   "Path of file where history information is stored."
 806   :type 'string
 807   :group 'anything-config)
 808
 809 (defcustom anything-c-adaptive-history-length 50
 810   "Maximum number of candidates stored for a source."
 811   :type 'number
 812   :group 'anything-config)
 813
 814 (defcustom anything-c-google-suggest-url
 815   "http://google.com/complete/search?output=toolbar&q="
 816   "URL used for looking up Google suggestions."
 817   :type 'string
 818   :group 'anything-config)
 819
 820 (defcustom anything-c-google-suggest-search-url
 821   "http://www.google.com/search?ie=utf-8&oe=utf-8&q="
 822   "URL used for Google searching."
 823   :type 'string
 824   :group 'anything-config)
 825
 826 (defcustom anything-google-suggest-use-curl-p nil
 827   "When non--nil use CURL to get info from `anything-c-google-suggest-url'.
 828 Otherwise `url-retrieve-synchronously' is used."
 829   :type 'boolean
 830   :group 'anything-config)
 831
 832 (defcustom anything-c-yahoo-suggest-url
 833   "http://search.yahooapis.com/WebSearchService/V1/relatedSuggestion?appid=Generic&query="
 834   "Url used for looking up Yahoo suggestions."
 835   :type 'string
 836   :group 'anything-config)
 837
 838 (defcustom anything-c-yahoo-suggest-search-url
 839   "http://search.yahoo.com/search?&ei=UTF-8&fr&h=c&p="
 840   "Url used for Yahoo searching."
 841   :type 'string
 842   :group 'anything-config)
 843
 844 (defcustom anything-c-boring-buffer-regexp
 845   (rx (or
 846        (group bos  " ")
 847        ;; anything-buffers
 848        "*anything" "*ac-mode"
 849        ;; echo area
 850        " *Echo Area" " *Minibuf"))
 851   "The regexp that match boring buffers.
 852 Buffer candidates matching this regular expression will be
 853 filtered from the list of candidates if the
 854 `anything-c-skip-boring-buffers' candidate transformer is used, or
 855 they will be displayed with face `file-name-shadow' if
 856 `anything-c-shadow-boring-buffers' is used."
 857   :type 'string
 858   :group 'anything-config)
 859 ;; (string-match anything-c-boring-buffer-regexp "buf")
 860 ;; (string-match anything-c-boring-buffer-regexp " hidden")
 861 ;; (string-match anything-c-boring-buffer-regexp " *Minibuf-1*")
 862
 863 (defcustom anything-c-boring-file-regexp
 864   (rx (or
 865        ;; Boring directories
 866        (and "/" (or ".svn" "CVS" "_darcs" ".git" ".hg") (or "/" eol))
 867        ;; Boring files
 868        (and line-start  ".#")
 869        (and (or ".class" ".la" ".o" "~") eol)))
 870   "The regexp that match boring files.
 871 File candidates matching this regular expression will be
 872 filtered from the list of candidates if the
 873 `anything-c-skip-boring-files' candidate transformer is used, or
 874 they will be displayed with face `file-name-shadow' if
 875 `anything-c-shadow-boring-files' is used."
 876   :type 'string
 877   :group 'anything-config)
 878
 879 (defcustom anything-kill-ring-threshold 10
 880   "Minimum length to be listed by `anything-c-source-kill-ring'."
 881   :type 'integer
 882   :group 'anything-config)
 883
 884 (defcustom anything-c-kill-ring-max-lines-number nil
 885   "Max number of lines displayed per candidate in kill-ring browser.
 886 If nil or zero, don't truncate candidate, show all."
 887   :type 'integer
 888   :group 'anything-config)
 889
 890 (defcustom anything-su-or-sudo "su"
 891   "What command to use for root access."
 892   :type 'string
 893   :group 'anything-config)
 894
 895 (defcustom anything-for-files-prefered-list
 896   '(anything-c-source-ffap-line
 897     anything-c-source-ffap-guesser
 898     anything-c-source-buffers-list
 899     anything-c-source-recentf
 900     anything-c-source-bookmarks
 901     anything-c-source-file-cache
 902     anything-c-source-files-in-current-dir+
 903     anything-c-source-locate)
 904   "Your prefered sources to find files."
 905   :type 'list
 906   :group 'anything-config)
 907
 908 (defcustom anything-create--actions-private nil
 909   "User defined actions for `anything-create' / `anything-c-source-create'.
 910 It is a list of (DISPLAY . FUNCTION) pairs like `action'
 911 attribute of `anything-sources'.
 912
 913 It is prepended to predefined pairs."
 914   :type 'list
 915   :group 'anything-config)
 916
 917 (defcustom anything-allow-skipping-current-buffer nil
 918   "Show current buffer or not in anything buffer"
 919   :type 'boolean
 920   :group 'anything-config)
 921
 922 (defcustom anything-c-enable-eval-defun-hack t
 923   "If non-nil, execute `anything' using the source at point when C-M-x is pressed.
 924 This hack is invoked when pressing C-M-x in the form \
 925  (defvar anything-c-source-XXX ...) or (setq anything-c-source-XXX ...)."
 926   :type 'boolean
 927   :group 'anything-config)
 928
 929 (defcustom anything-tramp-verbose 0
 930   "Just like `tramp-verbose' but specific to anything.
 931 When set to 0 don't show tramp messages in anything.
 932 If you want to have the default tramp messages set it to 3."
 933   :type 'integer
 934   :group 'anything-config)
 935
 936 (defcustom anything-raise-command nil
 937   "A shell command to jump to a window running specific program.
 938 Need external program wmctrl.
 939 This will be use with `format', so use something like \"wmctrl -xa %s\"."
 940   :type 'string
 941   :group 'anything-config)
 942
 943 (defun anything-set-anything-command-map-prefix-key (var key)
 944   "The customize set function for `anything-command-map-prefix-key'."
 945   (when (boundp var)
 946     (define-key global-map (read-kbd-macro (symbol-value var)) nil))
 947   (set var key)
 948   (define-key global-map
 949       (read-kbd-macro (symbol-value var)) 'anything-command-map))
 950
 951 (defcustom anything-command-map-prefix-key "C-x c"
 952   "The prefix key for all `anything-command-map' commands."
 953   :type  'string
 954   :set   'anything-set-anything-command-map-prefix-key
 955   :group 'anything-config)
 956
 957 (defcustom anything-c-browse-code-regexp-lisp
 958   "^ *\(def\\(un\\|subst\\|macro\\|face\\|alias\\|advice\\|struct\\|\
 959 type\\|theme\\|var\\|group\\|custom\\|const\\|method\\|class\\)"
 960   "Regexp used to parse lisp buffer when browsing code."
 961   :type 'string
 962   :group 'anything-config)
 963
 964 (defcustom anything-c-browse-code-regexp-python
 965   "\\<def\\>\\|\\<class\\>"
 966   "Regexp used to parse python buffer when browsing code."
 967   :type 'string
 968   :group 'anything-config)
 969
 970 (defcustom anything-c-browse-code-regexp-alist
 971   `((lisp-interaction-mode . ,anything-c-browse-code-regexp-lisp)
 972     (emacs-lisp-mode . ,anything-c-browse-code-regexp-lisp)
 973     (lisp-mode . ,anything-c-browse-code-regexp-lisp)
 974     (python-mode . ,anything-c-browse-code-regexp-python))
 975   "Alist to store regexps for browsing code corresponding \
 976 to a specific `major-mode'."
 977   :type 'list
 978   :group 'anything-config)
 979
 980 (defcustom anything-c-external-programs-associations nil
 981   "Alist to store externals programs associated with file extension.
 982 This variable overhide setting in .mailcap file.
 983 e.g : '\(\(\"jpg\" . \"gqview\"\) (\"pdf\" . \"xpdf\"\)\) "
 984   :type 'list
 985   :group 'anything-config)
 986
 987 (defcustom anything-ff-auto-update-initial-value t
 988   "Auto update when only one candidate directory is matched.
 989 This is the default value when starting `anything-find-files'."
 990   :group 'anything-config
 991   :type  'boolean)
 992
 993 (defcustom anything-c-copy-async-prefered-emacs "emacs"
 994   "Path to the emacs you want to use for copying async.
 995 Emacs versions < 24 fail to copy directory due to a bug not fixed
 996 in `copy-directory'."
 997   :group 'anything-config
 998   :type 'string)
 999
1000 (defcustom anything-ff-lynx-style-map t
1001   "Use arrow keys to navigate with `anything-find-files'.
1002 You will have to restart Emacs or reeval `anything-find-files-map'
1003 and `anything-c-read-file-map' for this take effect."
1004   :group 'anything-config
1005   :type 'boolean)
1006
1007 (defcustom anything-ff-history-max-length 100
1008   "Number of elements shown in `anything-find-files' history."
1009   :group 'anything-config
1010   :type 'integer)
1011
1012 (defcustom anything-ff-smart-completion t
1013   "Try to complete filenames smarter when non--nil.
1014 See `anything-ff-transform-fname-for-completion' for more info."
1015   :group 'anything-config
1016   :type 'boolean)
1017
1018 (defcustom anything-ff-default-kbsize 1024.0
1019   "Default Kbsize to use for showing files size.
1020 It is a float, usually 1024.0 but could be 1000.0 on some systems."
1021   :group 'anything-config
1022   :type 'float)
1023
1024 (defcustom anything-ff-tramp-not-fancy t
1025   "No colors when listing remote files when set to non--nil.
1026 This make listing much faster, specially on slow machines."
1027   :group 'anything-config
1028   :type  'boolean)
1029
1030 (defcustom anything-ff-exif-data-program "exiftran"
1031   "Program used to extract exif data of an image file."
1032   :group 'anything-config
1033   :type 'string)
1034
1035 (defcustom anything-ff-exif-data-program-args "-d"
1036   "*Arguments used for `anything-ff-exif-data-program'."
1037   :group 'anything-config
1038   :type 'string)
1039
1040 (defcustom anything-c-grep-use-ioccur-style-keys t
1041   "Use Arrow keys to jump to occurences."
1042   :group 'anything-config
1043   :type  'boolean)
1044
1045 (defcustom anything-c-pdfgrep-default-read-command "xpdf '%f' %p"
1046   "Default command to read pdf files from pdfgrep.
1047 Where '%f' format spec is filename and '%p' is page number"
1048   :group 'anything-config
1049   :type  'string)
1050
1051 (defcustom anything-c-etags-tag-file-name "TAGS"
1052   "Etags tag file name."
1053   :type  'string
1054   :group 'anything-config)
1055
1056 (defcustom anything-c-etags-tag-file-search-limit 10
1057   "The limit level of directory to search tag file.
1058 Don't search tag file deeply if outside this value."
1059   :type  'number
1060   :group 'anything-config)
1061
1062 (defcustom anything-c-etags-use-regexp-search nil
1063   "When non--nil search etags candidates by regexp.
1064 This disable anything-match-plugin when enabled.
1065 When nil search is performed directly on patter and *match-plugin is used
1066 if available.  You can customize `anything-c-etags-search-regexp'."
1067   :group 'anything-config
1068   :type  'boolean)
1069
1070 (defcustom anything-c-etags-search-regexp "^.+: .+ \\<%s"
1071   "Regexp that match tags in an anything etags buffer.
1072 The format spec is replaced by pattern.
1073 This regexp have no effect when `anything-c-etags-use-regexp-search'
1074 is nil."
1075   :group 'anything-config
1076   :type  'regexp)
1077
1078 (defcustom anything-c-filelist-file-name nil
1079   "Filename of file list.
1080 Accept a list of string for multiple files.
1081
1082 This file tend to be very large \(> 100MB\) and recommend to be in ramdisk for speed.
1083 File list is created by make-filelist.rb script.
1084
1085 Usage:
1086   ruby make-filelist.rb > /tmp/all.filelist
1087
1088 Then
1089  ;; Assume that /tmp is ramdisk or tmpfs
1090  \(setq anything-grep-candidates-fast-directory-regexp \"^/tmp/\"\)
1091  \(setq anything-c-filelist-file-name \"/tmp/all.filelist\"\)
1092 "
1093   :type 'string
1094   :group 'anything-config)
1095
1096 (defcustom anything-c-eldoc-in-minibuffer-show-fn
1097   'anything-c-show-info-in-mode-line
1098   "A function to display eldoc info.
1099 Should take one arg: the string to display."
1100   :group 'anything-config
1101   :type  'symbol)
1102
1103 (defcustom anything-c-turn-on-show-completion t
1104   "Display candidate in buffer while moving selection when non--nil."
1105   :group 'anything-config
1106   :type  'boolean)
1107
1108 (defcustom anything-c-show-completion-use-special-display t
1109   "A special display will be used in lisp completion if non--nil.
1110 All functions that are wrapped in macro `with-anything-show-completion'
1111 will be affected."
1112   :group 'anything-config
1113   :type  'boolean)
1114
1115 (defcustom anything-c-show-completion-min-window-height 7
1116   "Minimum completion window height used in show completion.
1117 This is used in macro `with-anything-show-completion'."
1118   :group 'anything-config
1119   :type  'integer)
1120
1121 (defcustom anything-lisp-completion-or-indent-delay 0.6
1122   "After this delay `anything-lisp-completion-counter' is reset to 0.
1123 This allow to indent again without completing lisp symbol after this delay.
1124 Default is 0.6 seconds."
1125   :group 'anything-config
1126   :type  'number)
1127
1128 (defcustom anything-c-default-external-file-browser "nautilus"
1129   "Default external file browser for your system.
1130 Directories will be opened externally with it when
1131 opening file externally in `anything-find-files'.
1132 Set to nil if you do not have external file browser
1133 or do not want to use it.
1134 Windows users should set that to \"explorer.exe\"."
1135   :group 'anything-config
1136   :type  'string)
1137
1138 (defcustom anything-c-use-adaptative-sorting nil
1139   "Wheter to use or not adaptative sorting.
1140 Even if a source use it, it will have no effect when set to nil."
1141   :type 'boolean
1142   :group 'anything-config)
1143
1144 (defcustom anything-ff-newfile-prompt-p t
1145   "Whether Prompt or not when creating new file.
1146 This set `ffap-newfile-prompt'."
1147   :type  'boolean
1148   :group 'anything-config)
1149
1150
1151 (defcustom anything-ff-avfs-directory nil
1152   "The default avfs directory, usually '.avfs'.
1153 When this is set you will be able to expand archive filenames with `C-z'
1154 inside an avfs directory mounted with mountavfs.
1155 See <http://sourceforge.net/projects/avf/>."
1156   :type  'boolean
1157   :group 'anything-config)
1158
1159 (defcustom anything-ff-file-compressed-list '("gz" "bz2" "zip" "7z")
1160   "Minimal list of compressed files extension."
1161   :type  'list
1162   :group 'anything-config)
1163
1164 (defcustom anything-locate-db-file-regexp "m?locate\.db$"
1165   "Default regexp to match locate database.
1166 If nil Search in all files."
1167   :type  'string
1168   :group 'anything-config)
1169
1170 (defcustom anything-ff-locate-db-filename "locate.db"
1171   "The basename of the locatedb file you use locally in your directories.
1172 When this is set and `anything' find such a file in the directory from
1173 where you launch locate, it will use this file and will not prompt you
1174 for a db file.
1175 Note that this happen only when locate is launched with a prefix arg."
1176   :group 'anything-config
1177   :type 'string)
1178
1179 (defcustom anything-c-locate-command nil
1180   "A list of arguments for locate program.
1181 If nil it will be calculated when `anything-locate' startup
1182 with these default values for different systems:
1183
1184 Gnu/linux: \"locate -i -r %s\"
1185 berkeley-unix: \"locate -i %s\"
1186 windows-nt: \"es -i -r %s\"
1187 Others: \"locate %s\"
1188
1189 This string will be passed to format so it should end with `%s'.
1190 The \"-r\" option must be the last option."
1191   :type 'string
1192   :group 'anything-config)
1193
1194 (defcustom anything-c-show-info-in-mode-line-delay 12
1195   "Eldoc will show info in mode-line during this delay if user is idle."
1196   :type  'integer
1197   :group 'anything-config)
1198
1199 (defcustom anything-c-copy-files-async-log-file "/tmp/dired.log"
1200   "The file used to communicate with two emacs when copying files async."
1201   :type  'string
1202   :group 'anything-config)
1203
1204 (defcustom anything-ff-printer-list nil
1205   "A list of available printers on your system.
1206 When non--nil let you choose a printer to print file.
1207 Otherwise when nil the variable `printer-name' will be used.
1208 On Unix based systems (lpstat command needed) you don't need to set this,
1209 `anything-ff-find-printers' will find a list of available printers for you."
1210   :type 'list
1211   :group 'anything-config)
1212
1213 (defcustom anything-ff-transformer-show-only-basename nil
1214   "Show only basename of candidates in `anything-find-files'.
1215 This can be toggled at anytime from `anything-find-files' with \
1216 \\<anything-find-files-map>0\\[anything-ff-run-toggle-basename]."
1217   :type 'boolean
1218   :group 'anything-config)
1219
1220 (defcustom anything-ff-quick-delete-dont-prompt-for-deletion nil
1221   "Don't ask in persistent deletion of files when non--nil."
1222   :group 'anything-config
1223   :type 'boolean)
1224
1225 (defcustom anything-ff-signal-error-on-dot-files t
1226   "Signal error when file is `.' or `..' on file deletion when non--nil.
1227 Default is non--nil.
1228 WARNING: Setting this to nil is unsafe and can cause deletion of a whole tree."
1229   :group 'anything-config
1230   :type 'boolean)
1231
1232 (defcustom anything-completing-read-handlers-alist
1233   '((describe-function . anything-completing-read-symbols)
1234     (describe-variable . anything-completing-read-symbols)
1235     (debug-on-entry . anything-completing-read-symbols)
1236     (find-function . anything-completing-read-symbols)
1237     (trace-function . anything-completing-read-symbols)
1238     (trace-function-background . anything-completing-read-symbols)
1239     (find-tag . anything-completing-read-with-cands-in-buffer)
1240     (ffap-alternate-file . nil))
1241   "Alist of handlers to replace `completing-read', `read-file-name' in `ac-mode'.
1242 Each entry is a cons cell like \(emacs_command . completing-read_handler\)
1243 where key and value are symbols.
1244
1245 Each key is an Emacs command that use originaly `completing-read'.
1246
1247 Each value maybe an anything function that take same arguments as
1248 `completing-read' plus NAME and BUFFER, where NAME is the name of the new
1249 anything source and BUFFER the name of the buffer we will use.
1250 This function prefix name must start by \"anything\".
1251
1252 See `anything-completing-read-symbols' for example.
1253
1254 If the value of an entry is nil completion will fall back to
1255 emacs vanilla behavior.
1256 e.g If you want to disable anything completion for `describe-function':
1257 \(describe-function . nil\).
1258
1259 Ido is also supported, you can use `ido-completing-read' and
1260 `ido-read-file-name' as value of an entry or just 'ido.
1261 e.g ido completion for `find-file':
1262 \(find-file . ido\)
1263 same as
1264 \(find-file . ido-read-file-name\)
1265 Note that you don't need to enable `ido-mode' for this to work."
1266   :group 'anything-config
1267   :type '(alist :key-type symbol :value-type symbol))
1268
1269 (defcustom anything-M-x-requires-pattern 2
1270   "Value of requires-pattern for `anything-M-x'.
1271 Set it to 0 to disable requires-pattern in `anything-M-x'."
1272   :group 'anything-config
1273   :type 'boolean)
1274
1275 ;;; Build info-index sources with info-index plug-in.
1276 ;;
1277 ;;
1278 (defun anything-c-build-info-index-command (name doc source buffer)
1279   "Define an anything command NAME with documentation DOC.
1280 Arg SOURCE will be an existing anything source named
1281 `anything-c-source-info-<NAME>' and BUFFER a string buffer name."
1282   (eval (list 'defun name nil doc
1283               (list 'interactive)
1284               (list 'anything
1285                     :sources source
1286                     :buffer buffer
1287                     :candidate-number-limit 1000))))
1288
1289 (defun anything-c-define-info-index-sources (var-value &optional commands)
1290   "Define anything sources named anything-c-source-info-<NAME>.
1291 Sources are generated for all entries of `anything-c-default-info-index-list'.
1292 If COMMANDS arg is non--nil build also commands named `anything-info<NAME>'.
1293 Where NAME is one of `anything-c-default-info-index-list'."
1294   (loop with symbols = (loop for str in var-value
1295                              collect
1296                              (intern (concat "anything-c-source-info-" str)))
1297         for sym in symbols
1298         for str in var-value
1299         do (set sym (list (cons 'name (format "Info index: %s" str))
1300                           (cons 'info-index str)))
1301         when commands
1302         do (let ((com (intern (concat "anything-info-" str))))
1303              (anything-c-build-info-index-command com
1304                (format "Predefined anything for %s info." str) sym
1305                (format "*anything info %s*" str)))))
1306
1307 (defun anything-info-index-set (var value)
1308   (set var value)
1309   (anything-c-define-info-index-sources value t))
1310
1311 (defcustom anything-c-default-info-index-list
1312   '("elisp" "cl" "org" "gnus" "tramp" "ratpoison"
1313     "zsh" "bash" "coreutils" "fileutils"
1314     "find" "sh-utils" "textutils" "libc"
1315     "make" "automake" "autoconf" "emacs-lisp-intro"
1316     "emacs" "elib" "eieio" "gauche-refe" "guile"
1317     "guile-tut" "goops" "screen" "latex" "gawk"
1318     "sed" "m4" "wget" "binutils" "as" "bfd" "gprof"
1319     "ld" "diff" "flex" "grep" "gzip" "libtool"
1320     "texinfo" "info" "gdb" "stabs" "cvsbook" "cvs"
1321     "bison" "id-utils" "global")
1322   "Info Manual entries to use for building anything info index commands."
1323   :group 'anything-config
1324   :type 'list
1325   :set 'anything-info-index-set)
1326
1327 (defcustom anything-c-register-max-offset 160
1328   "Max size of string register entries before truncating."
1329   :group 'anything-config
1330   :type 'integer)
1331
1332 \f
1333 ;;; General internal variables
1334 ;;
1335 ;; Some internals variable that need to be loaded
1336 ;; here to avoid compiler warnings.
1337 (defvar anything-c-external-commands-list nil
1338   "A list of all external commands the user can execute.  If this
1339 variable is not set by the user, it will be calculated
1340 automatically.")
1341
1342 (defvar anything-c-show-completion-overlay nil)
1343
1344
1345 \f
1346 ;;; Faces
1347 ;;
1348 ;;
1349 (defface anything-buffer-saved-out
1350     '((t (:foreground "red")))
1351   "*Face used for buffer files modified outside of emacs."
1352   :group 'anything-config)
1353
1354 (defface anything-buffer-not-saved
1355     '((t (:foreground "Indianred2")))
1356   "*Face used for buffer files not already saved on disk."
1357   :group 'anything-config)
1358
1359 (defface anything-ff-prefix
1360     '((t (:background "yellow" :foreground "black")))
1361   "*Face used to prefix new file or url paths in `anything-find-files'."
1362   :group 'anything-config)
1363
1364 (defface anything-ff-executable
1365     '((t (:foreground "green")))
1366   "*Face used for executable files in `anything-find-files'."
1367   :group 'anything-config)
1368
1369 (defface anything-ff-directory
1370     '((t (:foreground "DarkRed" :background "LightGray")))
1371   "*Face used for directories in `anything-find-files'."
1372   :group 'anything-config)
1373
1374 (defface anything-ff-symlink
1375     '((t (:foreground "DarkOrange")))
1376   "*Face used for symlinks in `anything-find-files'."
1377   :group 'anything-config)
1378
1379 (defface anything-ff-invalid-symlink
1380     '((t (:foreground "black" :background "red")))
1381   "*Face used for invalid symlinks in `anything-find-files'."
1382   :group 'anything-config)
1383
1384 (defface anything-ff-file
1385     '((t (:foreground "CadetBlue" :underline t)))
1386   "*Face used for file names in `anything-find-files'."
1387   :group 'anything-config)
1388
1389 (defface anything-grep-match
1390     '((t (:inherit match)))
1391   "Face used to highlight grep matches."
1392   :group 'anything-config)
1393
1394 (defface anything-grep-file
1395     '((t (:foreground "BlueViolet" :underline t)))
1396   "Face used to highlight grep results filenames."
1397   :group 'anything-config)
1398
1399 (defface anything-grep-lineno
1400     '((t (:foreground "Darkorange1")))
1401   "Face used to highlight grep number lines."
1402   :group 'anything-config)
1403
1404 (defface anything-grep-running
1405     '((t (:foreground "Red")))
1406   "Face used in mode line when grep is running."
1407   :group 'anything-config)
1408
1409 (defface anything-grep-finish
1410     '((t (:foreground "Green")))
1411   "Face used in mode line when grep is finish."
1412   :group 'anything-config)
1413
1414 (defface anything-M-x-key-face '((t (:foreground "orange" :underline t)))
1415   "*Face used in anything-M-x to show keybinding."
1416   :group 'anything)
1417
1418 (defface anything-bmkext-info
1419     '((t (:foreground "green")))
1420   "*Face used for W3m Emacs bookmarks (not w3m bookmarks)."
1421   :group 'anything)
1422
1423 (defface anything-bmkext-w3m
1424     '((t (:foreground "yellow")))
1425   "*Face used for W3m Emacs bookmarks (not w3m bookmarks)."
1426   :group 'anything)
1427
1428 (defface anything-bmkext-gnus
1429     '((t (:foreground "magenta")))
1430   "*Face used for Gnus bookmarks."
1431   :group 'anything)
1432
1433 (defface anything-bmkext-man
1434     '((t (:foreground "Orange4")))
1435   "*Face used for Woman/man bookmarks."
1436   :group 'anything)
1437
1438 (defface anything-bmkext-no--file
1439     '((t (:foreground "grey")))
1440   "*Face used for non--file bookmarks."
1441   :group 'anything)
1442
1443 (defface anything-bmkext-file
1444     '((t (:foreground "Deepskyblue2")))
1445   "*Face used for non--file bookmarks."
1446   :group 'anything)
1447
1448 (defface anything-bookmarks-su-face '((t (:foreground "red")))
1449   "Face for su/sudo bookmarks."
1450   :group 'anything)
1451
1452 (defface anything-w3m-bookmarks-face '((t (:foreground "cyan1" :underline t)))
1453   "Face for w3m bookmarks" :group 'anything)
1454
1455 (defface anything-emms-playlist
1456     '((t (:foreground "Springgreen4" :underline t)))
1457   "*Face used for tracks in current emms playlist."
1458   :group 'anything)
1459
1460 (defface anything-apt-installed
1461     '((t (:foreground "green")))
1462   "*Face used for apt installed candidates."
1463   :group 'anything)
1464
1465 (defface anything-apt-deinstalled
1466     '((t (:foreground "DimGray")))
1467   "*Face used for apt deinstalled candidates."
1468   :group 'anything)
1469
1470 (defface anything-gentoo-match-face '((t (:foreground "red")))
1471   "Face for anything-gentoo installed packages."
1472   :group 'traverse-faces)
1473
1474 (defface anything-lisp-show-completion
1475     '((t (:background "DarkSlateGray")))
1476   "*Face used for showing candidates in `anything-lisp-completion'."
1477   :group 'anything-config)
1478
1479 (defface anything-lisp-completion-info
1480     '((t (:foreground "red")))
1481   "*Face used for showing info in `anything-lisp-completion'."
1482   :group 'anything-config)
1483
1484 (defface anything-overlay-line-face '((t (:background "IndianRed4" :underline t)))
1485   "Face for source header in the anything buffer." :group 'anything)
1486
1487 ;;;###autoload
1488 (defun anything-configuration ()
1489   "Customize `anything'."
1490   (interactive)
1491   (customize-group "anything-config"))
1492
1493
1494 \f
1495 ;;; Anything-command-map
1496 ;;
1497 ;;
1498 ;;;###autoload
1499 (defvar anything-command-map)
1500 (define-prefix-command 'anything-command-map)
1501
1502
1503 (define-key anything-command-map (kbd "<SPC>")     'anything-execute-anything-command)
1504 (define-key anything-command-map (kbd "a")         'anything-c-apropos)
1505 (define-key anything-command-map (kbd "e")         'anything-c-etags-select)
1506 (define-key anything-command-map (kbd "l")         'anything-locate)
1507 (define-key anything-command-map (kbd "s")         'anything-surfraw)
1508 (define-key anything-command-map (kbd "r")         'anything-regexp)
1509 (define-key anything-command-map (kbd "w")         'anything-w3m-bookmarks)
1510 (define-key anything-command-map (kbd "x")         'anything-firefox-bookmarks)
1511 (define-key anything-command-map (kbd "#")         'anything-emms)
1512 (define-key anything-command-map (kbd "m")         'anything-man-woman)
1513 (define-key anything-command-map (kbd "t")         'anything-top)
1514 (define-key anything-command-map (kbd "i")         'anything-imenu)
1515 (define-key anything-command-map (kbd "<tab>")     'anything-lisp-completion-at-point)
1516 (define-key anything-command-map (kbd "p")         'anything-list-emacs-process)
1517 (define-key anything-command-map (kbd "C-x r b")   'anything-c-pp-bookmarks)
1518 (define-key anything-command-map (kbd "M-y")       'anything-show-kill-ring)
1519 (define-key anything-command-map (kbd "C-c <SPC>") 'anything-all-mark-rings)
1520 (define-key anything-command-map (kbd "C-x C-f")   'anything-find-files)
1521 (define-key anything-command-map (kbd "f")         'anything-for-files)
1522 (define-key anything-command-map (kbd "C-:")       'anything-eval-expression-with-eldoc)
1523 (define-key anything-command-map (kbd "C-,")       'anything-calcul-expression)
1524 (define-key anything-command-map (kbd "M-x")       'anything-M-x)
1525 (define-key anything-command-map (kbd "C-x C-w")   'anything-write-file)
1526 (define-key anything-command-map (kbd "C-x i")     'anything-insert-file)
1527 (define-key anything-command-map (kbd "M-s o")     'anything-occur)
1528 (define-key anything-command-map (kbd "M-g s")     'anything-do-grep)
1529 (define-key anything-command-map (kbd "c")         'anything-colors)
1530 (define-key anything-command-map (kbd "F")         'anything-select-xfont)
1531 (define-key anything-command-map (kbd "C-c f")     'anything-recentf)
1532 (define-key anything-command-map (kbd "C-c g")     'anything-google-suggest)
1533 (define-key anything-command-map (kbd "h i")       'anything-info-at-point)
1534 (define-key anything-command-map (kbd "h r")       'anything-info-emacs)
1535 (define-key anything-command-map (kbd "h g")       'anything-info-gnus)
1536 (define-key anything-command-map (kbd "C-x C-b")   'anything-buffers-list)
1537 (define-key anything-command-map (kbd "C-c C-b")   'anything-browse-code)
1538 (define-key anything-command-map (kbd "C-x r i")   'anything-register)
1539 (define-key anything-command-map (kbd "C-c C-x")   'anything-c-run-external-command)
1540
1541 ;; In Emacs 23.1.50, minibuffer-local-must-match-filename-map was renamed to
1542 ;; minibuffer-local-filename-must-match-map.
1543 (defvar minibuffer-local-filename-must-match-map (make-sparse-keymap)) ;; Emacs 23.1.+
1544 (defvar minibuffer-local-must-match-filename-map (make-sparse-keymap)) ;; Older Emacsen
1545 (dolist (map (list minibuffer-local-filename-completion-map
1546                    minibuffer-local-completion-map
1547                    minibuffer-local-must-match-filename-map
1548                    minibuffer-local-filename-must-match-map
1549                    minibuffer-local-map
1550                    minibuffer-local-isearch-map
1551                    minibuffer-local-must-match-map
1552                    minibuffer-local-ns-map))
1553   (define-key map "\C-r" 'anything-minibuffer-history))
1554
1555
1556 \f
1557 ;;; Menu
1558 ;;
1559 ;;
1560 (easy-menu-define nil global-map
1561   "`anything' menu"
1562   '("Anything"
1563     ["All anything commands" anything-execute-anything-command t]
1564     ["Find any Files/Buffers" anything-for-files t]
1565     ["Anything Everywhere (Toggle)" ac-mode t]
1566     "----"
1567     ("Files:"
1568      ["Find files" anything-find-files t]
1569      ["Recent Files" anything-recentf t]
1570      ["Locate" anything-locate t]
1571      ["Bookmarks" anything-c-pp-bookmarks t])
1572     ("Buffers:"
1573      ["Find buffers" anything-buffers-list t])
1574     ("Commands:"
1575      ["Emacs Commands" anything-M-x t]
1576      ["Externals Commands" anything-c-run-external-command t])
1577     ("Help:"
1578      ["Anything Apropos" anything-c-apropos t])
1579     ("Info:"
1580      ["Info at point" anything-info-at-point t]
1581      ["Emacs Manual index" anything-info-emacs t]
1582      ["Gnus Manual index" anything-info-gnus t])
1583     ("Org:"
1584      ["Org keywords" anything-org-keywords t]
1585      ["Org headlines" anything-org-headlines t])
1586     ("Tools:"
1587      ["Occur" anything-occur t]
1588      ["Grep" anything-do-grep t]
1589      ["Etags" anything-c-etags-select t]
1590      ["Lisp complete at point" anything-lisp-completion-at-point t]
1591      ["Browse Kill ring" anything-show-kill-ring t]
1592      ["Browse register" anything-register t]
1593      ["Browse code" anything-browse-code t]
1594      ["Mark Ring" anything-all-mark-rings t]
1595      ["Regexp handler" anything-regexp t]
1596      ["Colors & Faces" anything-colors t]
1597      ["Show xfonts" anything-select-xfont t]
1598      ["Ucs Symbols" anything-ucs t]
1599      ["Imenu" anything-imenu t]
1600      ["Google Suggest" anything-google-suggest t]
1601      ["Eval expression" anything-eval-expression-with-eldoc t]
1602      ["Calcul expression" anything-calcul-expression t]
1603      ["Man pages" anything-man-woman t]
1604      ["Top externals process" anything-top t]
1605      ["Emacs internals process" anything-list-emacs-process t])
1606     "----"
1607     ["Prefered Options" anything-configuration t]))
1608
1609 ;;; Anything map add ons
1610 ;;
1611 ;;
1612 (define-key anything-map (kbd "C-x C-f") 'anything-quit-and-find-file)
1613 (define-key anything-map (kbd "M-m")     'anything-toggle-all-marks)
1614 (define-key anything-map (kbd "C-w")     'anything-yank-text-at-point)
1615
1616 \f
1617 ;;; Specialized keymaps
1618 ;;
1619 ;;
1620 (defun anything-c-make-child-map (parent)
1621   (let ((map (make-sparse-keymap)))
1622     (set-keymap-parent map parent)
1623     map))
1624
1625 (defvar anything-c-buffer-map
1626   (let ((map (anything-c-make-child-map anything-map)))
1627     (define-key map (kbd "C-c ?")     'anything-c-buffer-help)
1628     ;; No need to have separate command for grep and zgrep
1629     ;; as we don't use recursivity for buffers.
1630     ;; So use zgrep for both as it is capable to handle non--compressed files.
1631     (define-key map (kbd "M-g s")     'anything-buffer-run-zgrep)
1632     (define-key map (kbd "C-c o")     'anything-buffer-switch-other-window)
1633     (define-key map (kbd "C-c C-o")   'anything-buffer-switch-other-frame)
1634     (define-key map (kbd "C-c =")     'anything-buffer-run-ediff)
1635     (define-key map (kbd "M-=")       'anything-buffer-run-ediff-merge)
1636     (define-key map (kbd "C-=")       'anything-buffer-diff-persistent)
1637     (define-key map (kbd "M-U")       'anything-buffer-revert-persistent)
1638     (define-key map (kbd "M-D")       'anything-buffer-run-kill-buffers)
1639     (define-key map (kbd "C-x C-s")   'anything-buffer-save-persistent)
1640     (define-key map (kbd "C-M-%")     'anything-buffer-run-query-replace-regexp)
1641     (define-key map (kbd "M-%")       'anything-buffer-run-query-replace)
1642     (define-key map (kbd "M-m")       'anything-toggle-all-marks)
1643     (define-key map (kbd "M-a")       'anything-mark-all)
1644     (when (locate-library "elscreen")
1645       (define-key map (kbd "<C-tab>") 'anything-buffer-switch-to-elscreen))
1646     (delq nil map))
1647   "Keymap for buffer sources in anything.")
1648
1649 (defvar anything-find-files-map
1650   (let ((map (anything-c-make-child-map anything-map)))
1651     (define-key map (kbd "C-]")           'anything-ff-run-toggle-basename)
1652     (define-key map (kbd "C-x C-f")       'anything-ff-run-locate)
1653     (define-key map (kbd "M-g s")         'anything-ff-run-grep)
1654     (define-key map (kbd "M-g p")         'anything-ff-run-pdfgrep)
1655     (define-key map (kbd "M-g z")         'anything-ff-run-zgrep)
1656     (define-key map (kbd "M-.")           'anything-ff-run-etags)
1657     (define-key map (kbd "M-R")           'anything-ff-run-rename-file)
1658     (define-key map (kbd "M-C")           'anything-ff-run-copy-file)
1659     (define-key map (kbd "M-B")           'anything-ff-run-byte-compile-file)
1660     (define-key map (kbd "M-L")           'anything-ff-run-load-file)
1661     (define-key map (kbd "M-S")           'anything-ff-run-symlink-file)
1662     (define-key map (kbd "M-H")           'anything-ff-run-hardlink-file)
1663     (define-key map (kbd "M-D")           'anything-ff-run-delete-file)
1664     (define-key map (kbd "M-K")           'anything-ff-run-kill-buffer-persistent)
1665     (define-key map (kbd "C-d")           'anything-ff-persistent-delete)
1666     (define-key map (kbd "M-e")           'anything-ff-run-switch-to-eshell)
1667     (define-key map (kbd "<M-tab>")       'anything-ff-run-complete-fn-at-point)
1668     (define-key map (kbd "C-c o")         'anything-ff-run-switch-other-window)
1669     (define-key map (kbd "C-c C-o")       'anything-ff-run-switch-other-frame)
1670     (define-key map (kbd "C-c C-x")       'anything-ff-run-open-file-externally)
1671     (define-key map (kbd "M-!")           'anything-ff-run-eshell-command-on-file)
1672     (define-key map (kbd "C-=")           'anything-ff-run-ediff-file)
1673     (define-key map (kbd "C-c =")         'anything-ff-run-ediff-merge-file)
1674     (define-key map (kbd "M-p")           'anything-ff-run-switch-to-history)
1675     (define-key map (kbd "M-i")           'anything-ff-properties-persistent)
1676     (define-key map (kbd "C-c ?")         'anything-ff-help)
1677     (define-key map (kbd "C-}")           'anything-narrow-window)
1678     (define-key map (kbd "C-{")           'anything-enlarge-window)
1679     (define-key map (kbd "C-<backspace>") 'anything-ff-run-toggle-auto-update)
1680     (define-key map (kbd "M-a")           'anything-mark-all)
1681     (define-key map (kbd "M-m")           'anything-toggle-all-marks)
1682     (define-key map (kbd "M-u")           'anything-unmark-all)
1683     (define-key map (kbd "C-c C-a")       'anything-ff-run-gnus-attach-files)
1684     (define-key map (kbd "C-c p")         'anything-ff-run-print-file)
1685     ;; Next 2 have no effect if candidate is not an image file.
1686     (define-key map (kbd "M-l")           'anything-ff-rotate-left-persistent)
1687     (define-key map (kbd "M-r")           'anything-ff-rotate-right-persistent)
1688     (define-key map (kbd "C-.")           'anything-find-files-down-one-level)
1689     (define-key map (kbd "C-l")           'anything-find-files-down-one-level)
1690     (define-key map (kbd "C-h C-b")       'anything-send-bug-report-from-anything)
1691     (define-key map (kbd "C-h C-d")       'anything-debug-output)
1692     (when anything-ff-lynx-style-map
1693       (define-key map (kbd "<left>")      'anything-find-files-down-one-level)
1694       (define-key map (kbd "<right>")     'anything-execute-persistent-action))
1695     (delq nil map))
1696   "Keymap for `anything-find-files'.")
1697
1698 (defvar anything-c-read-file-map
1699   (let ((map (anything-c-make-child-map anything-map)))
1700     (define-key map (kbd "C-]")           'anything-ff-run-toggle-basename)
1701     (define-key map (kbd "C-.")           'anything-find-files-down-one-level)
1702     (define-key map (kbd "C-l")           'anything-find-files-down-one-level)
1703     (define-key map (kbd "C-<backspace>") 'anything-ff-run-toggle-auto-update)
1704     (define-key map (kbd "C-c ?")         'anything-read-file-name-help)
1705     (when anything-ff-lynx-style-map
1706       (define-key map (kbd "<left>")      'anything-find-files-down-one-level)
1707       (define-key map (kbd "<right>")     'anything-execute-persistent-action)
1708       (define-key map (kbd "C-o")         nil)
1709       (define-key map (kbd "<M-left>")    'anything-previous-source)
1710       (define-key map (kbd "<M-right>")   'anything-next-source))
1711     (delq nil map))
1712   "Keymap for `anything-c-read-file-name'.")
1713
1714 (defvar anything-generic-files-map
1715   (let ((map (anything-c-make-child-map anything-map)))
1716     (define-key map (kbd "M-g s")   'anything-ff-run-grep)
1717     (define-key map (kbd "M-g z")   'anything-ff-run-zgrep)
1718     (define-key map (kbd "M-g p")   'anything-ff-run-pdfgrep)
1719     (define-key map (kbd "M-D")     'anything-ff-run-delete-file)
1720     (define-key map (kbd "C-=")     'anything-ff-run-ediff-file)
1721     (define-key map (kbd "C-c =")   'anything-ff-run-ediff-merge-file)
1722     (define-key map (kbd "C-c o")   'anything-ff-run-switch-other-window)
1723     (define-key map (kbd "M-i")     'anything-ff-properties-persistent)
1724     (define-key map (kbd "C-c C-x") 'anything-ff-run-open-file-externally)
1725     (define-key map (kbd "C-w")     'anything-yank-text-at-point)
1726     (define-key map (kbd "C-c ?")   'anything-generic-file-help)
1727     map)
1728   "Generic Keymap for files.")
1729
1730 (defvar anything-c-grep-map
1731   (let ((map (anything-c-make-child-map anything-map)))
1732     (define-key map (kbd "M-<down>") 'anything-c-goto-next-file)
1733     (define-key map (kbd "M-<up>")   'anything-c-goto-precedent-file)
1734     (define-key map (kbd "C-c o")    'anything-c-grep-run-other-window-action)
1735     (define-key map (kbd "C-w")      'anything-yank-text-at-point)
1736     (define-key map (kbd "C-x C-s")  'anything-c-grep-run-save-buffer)
1737     (when anything-c-grep-use-ioccur-style-keys
1738       (define-key map (kbd "<right>")  'anything-c-grep-run-persistent-action)
1739       (define-key map (kbd "<left>")  'anything-c-grep-run-default-action))
1740     (define-key map (kbd "C-c ?")    'anything-grep-help)
1741     (delq nil map))
1742   "Keymap used in Grep sources.")
1743
1744 (defvar anything-c-pdfgrep-map
1745   (let ((map (anything-c-make-child-map anything-map)))
1746     (define-key map (kbd "M-<down>") 'anything-c-goto-next-file)
1747     (define-key map (kbd "M-<up>")   'anything-c-goto-precedent-file)
1748     (define-key map (kbd "C-w")      'anything-yank-text-at-point)
1749     (define-key map (kbd "C-c ?")    'anything-pdfgrep-help)
1750     map)
1751   "Keymap used in pdfgrep.")
1752
1753 (defvar anything-c-etags-map
1754   (let ((map (anything-c-make-child-map anything-map)))
1755     (define-key map (kbd "M-<down>") 'anything-c-goto-next-file)
1756     (define-key map (kbd "M-<up>")   'anything-c-goto-precedent-file)
1757     (define-key map (kbd "C-w")      'anything-yank-text-at-point)
1758     (define-key map (kbd "C-c ?")    'anything-etags-help)
1759     map)
1760   "Keymap used in Etags.")
1761
1762 (defvar anything-eval-expression-map
1763   (let ((map (anything-c-make-child-map anything-map)))
1764     (define-key map (kbd "<C-return>") 'anything-eval-new-line-and-indent)
1765     (define-key map (kbd "<tab>")      'lisp-indent-line)
1766     (define-key map (kbd "<C-tab>")    'lisp-complete-symbol)
1767     (define-key map (kbd "C-p")        'previous-line)
1768     (define-key map (kbd "C-n")        'next-line)
1769     (define-key map (kbd "<up>")       'previous-line)
1770     (define-key map (kbd "<down>")     'next-line)
1771     (define-key map (kbd "<right>")    'forward-char)
1772     (define-key map (kbd "<left>")     'backward-char)
1773     map))
1774
1775 (defvar anything-c-ucs-map
1776   (let ((map (anything-c-make-child-map anything-map)))
1777     (define-key map (kbd "<C-backspace>") 'anything-c-ucs-persistent-delete)
1778     (define-key map (kbd "<C-left>")      'anything-c-ucs-persistent-backward)
1779     (define-key map (kbd "<C-right>")     'anything-c-ucs-persistent-forward)
1780     (define-key map (kbd "<C-return>")    'anything-c-ucs-persistent-insert)
1781     (define-key map (kbd "C-c ?")         'anything-c-ucs-help)
1782     map)
1783   "Keymap for `anything-ucs'.")
1784
1785 (defvar anything-c-bookmark-map
1786   (let ((map (anything-c-make-child-map anything-map)))
1787     (define-key map (kbd "C-c o") 'anything-c-bookmark-run-jump-other-window)
1788     (define-key map (kbd "C-d")   'anything-c-bookmark-run-delete)
1789     (when (locate-library "bookmark-extensions")
1790       (define-key map (kbd "M-e") 'anything-c-bmkext-run-edit))
1791     (define-key map (kbd "C-c ?") 'anything-c-bookmark-help)
1792     (delq nil map))
1793   "Generic Keymap for emacs bookmark sources.")
1794
1795 (defvar anything-esh-on-file-map
1796   (let ((map (anything-c-make-child-map anything-map)))
1797     (define-key map (kbd "C-c ?")    'anything-esh-help)
1798     map)
1799   "Keymap for `anything-find-files-eshell-command-on-file'.")
1800
1801 (defvar anything-eshell-history-map
1802   (let ((map (anything-c-make-child-map anything-map)))
1803     (define-key map (kbd "M-p") 'anything-next-line)
1804     map)
1805   "Keymap for `anything-eshell-history'.")
1806
1807 (defvar anything-kill-ring-map
1808   (let ((map (anything-c-make-child-map anything-map)))
1809     (define-key map (kbd "M-y") 'anything-next-line)
1810     (define-key map (kbd "M-u") 'anything-previous-line)
1811     map)
1812   "Keymap for `anything-show-kill-ring'.")
1813
1814 (defvar anything-occur-map
1815   (let ((map (anything-c-make-child-map anything-map)))
1816     (define-key map (kbd "C-M-%") 'anything-occur-run-query-replace-regexp)
1817     map)
1818   "Keymap for `anything-occur'.")
1819
1820 \f
1821 ;;; Embeded documentation.
1822 ;;
1823 ;;
1824 (defun anything-c-list-preconfigured-anything ()
1825   "Collect preconfigured anything functions in this file."
1826   (loop with doc
1827         with sym
1828         for entry in (cdr (assoc
1829                            (file-truename (locate-library "anything-config"))
1830                            load-history))
1831         if (and (consp entry)
1832                 (eq (car entry) 'defun)
1833                 (string-match "^Preconfigured.+$"
1834                               (setq doc (or (documentation (setq sym (cdr entry)))
1835                                             ""))))
1836         collect (cons sym (match-string 0 doc))))
1837
1838 (defun anything-c-format-preconfigured-anything ()
1839   (mapcar (lambda (x) (format "\\[%s] : %s\n" (car x) (cdr x)))
1840           (anything-c-list-preconfigured-anything)))
1841
1842 ;;; Global help message - Used by `anything-help'
1843 ;;
1844 ;;
1845 (setq anything-help-message
1846       (lambda ()
1847         (concat
1848          "\\<anything-map>"
1849          "`anything' is QuickSilver-like candidate-selection framework.
1850
1851 Narrow the list by typing some pattern,
1852 Multiple patterns are allowed by splitting by space.
1853 Select with natural Emacs operations, choose with RET.
1854
1855 If you have any problems, press C-c C-x C-b!!
1856 Feel free to send bug reports. I'll fix them.
1857 The steps are described in the beginning of anything.el file.
1858
1859 == Basic Operations ==
1860 C-p, Up: Previous Line
1861 C-n, Down : Next Line
1862 M-v, PageUp : Previous Page
1863 C-v, PageDown : Next Page
1864 Enter : Execute first (default) action / Select
1865 M-< : First Line
1866 M-> : Last Line
1867 M-PageUp, C-M-S-v, C-M-y : Previous Page (other-window)
1868 M-PageDown, C-M-v : Next Page (other-window)
1869
1870 Tab, C-i : Show action list
1871 Left : Previous Source
1872 Right, C-o : Next Source
1873 C-k : Delete pattern
1874 C-z : Persistent Action (Execute action with anything session kept)
1875 C-c C-x C-b: Send a bug report
1876
1877 == Shortcuts For 2nd/3rd Action ==
1878 \\[anything-select-2nd-action-or-end-of-line] : Execute 2nd Action (if the minibuffer cursor is at end of line)
1879 \\[anything-select-3rd-action] : Execute 3rd Action
1880
1881 == Visible Marks ==
1882 Visible marks store candidate. Some actions uses marked candidates.
1883
1884 \\[anything-toggle-visible-mark] : Toggle Visible Mark
1885 \\[anything-prev-visible-mark] : Previous Mark
1886 \\[anything-next-visible-mark] : Next Mark
1887
1888 == Miscellaneous Commands ==
1889 \\[anything-toggle-resplit-window] : Toggle vertical/horizontal split anything window
1890 \\[anything-quit-and-find-file] : Drop into `find-file'
1891 \\[anything-delete-current-selection] : Delete Selected Item (visually)
1892 \\[anything-kill-selection-and-quit] : Set Item Into the kill-ring And Quit
1893 \\[anything-yank-selection] : Yank Selected Item Into Pattern
1894 \\[anything-follow-mode] : Toggle Automatical Execution Of Persistent Action
1895 \\[anything-force-update] : Recalculate And Redisplay Candidates
1896
1897 == Global Commands ==
1898 \\<global-map>\\[anything-resume] revives last `anything' session.
1899 It is very useful, so you should bind any key.
1900
1901 Single source is executed by \\[anything-call-source].
1902
1903 == Preconfigured `anything' ==
1904 Preconfigured `anything' is commands that uses `anything' interface.
1905 You can use them without configuration.
1906
1907 "
1908          (apply 'concat (anything-c-format-preconfigured-anything))
1909          "
1910 Enjoy!")))
1911
1912 ;;; `anything-buffer-list' help
1913 ;;
1914 ;;
1915 (defvar anything-c-buffer-help-message
1916   "== Anything Buffer ==
1917 \nTips:
1918 You can enter a partial name of major-mode (e.g lisp, sh) to narrow down buffers.
1919 Enter then a space and a pattern to narrow down to buffers matching this pattern.
1920 \nSpecific commands for `anything-buffers-list':
1921 \\<anything-c-buffer-map>
1922 \\[anything-buffer-run-zgrep]\t\t->Grep Buffer(s) works as zgrep too. (C-u grep all buffers but non--file buffers).
1923 \\[anything-buffer-switch-other-window]\t\t->Switch other window.
1924 \\[anything-buffer-switch-other-frame]\t\t->Switch other frame.
1925 \\[anything-buffer-run-query-replace-regexp]\t\t->Query replace regexp in marked buffers.
1926 \\[anything-buffer-run-query-replace]\t\t->Query replace in marked buffers.
1927 \\[anything-buffer-switch-to-elscreen]\t\t->Find buffer in Elscreen.
1928 \\[anything-buffer-run-ediff]\t\t->Ediff current buffer with candidate.  If two marked buffers ediff those buffers.
1929 \\[anything-buffer-run-ediff-merge]\t\t->Ediff merge current buffer with candidate.  If two marked buffers ediff merge those buffers.
1930 \\[anything-buffer-diff-persistent]\t\t->Toggle Diff buffer with saved file without quitting.
1931 \\[anything-buffer-revert-persistent]\t\t->Revert buffer without quitting.
1932 \\[anything-buffer-save-persistent]\t\t->Save buffer without quitting.
1933 \\[anything-buffer-run-kill-buffers]\t\t->Delete marked buffers and quit.
1934 \\[anything-toggle-all-marks]\t\t->Toggle all marks.
1935 \\[anything-mark-all]\t\t->Mark all.
1936 \\[anything-c-buffer-help]\t\t->Display this help.
1937 \n== Anything Map ==
1938 \\{anything-map}")
1939
1940 ;;;###autoload
1941 (defun anything-c-buffer-help ()
1942   "Help command for anything buffers."
1943   (interactive)
1944   (let ((anything-help-message anything-c-buffer-help-message))
1945     (anything-help)))
1946
1947 ;;; Find files help (`anything-find-files')
1948 ;;
1949 ;;
1950 (defvar anything-ff-help-message
1951   "== Anything Find Files ==
1952 \nTips:
1953 \n- Enter `~/' at end of pattern to quickly reach home directory.
1954 - Enter `/' at end of pattern to quickly reach root of your file system.
1955 - Enter `./' at end of pattern to quickly reach `default-directory' (initial start of session).
1956 - You can complete with partial basename \(e.g \"fb\" will complete \"foobar\"\).
1957 - Use `C-u C-z' to watch an image.
1958 - To browse images directories turn on `anything-follow-mode' and navigate with arrow keys.
1959 - When entered ediff, hitting `C-g' will ask you to use locate to find the file to ediff with.
1960
1961 \nSpecific commands for `anything-find-files':
1962 \\<anything-find-files-map>
1963 \\[anything-ff-run-locate]\t\t->Run Locate on basename of candidate (C-u to specify locate db).
1964 \\[anything-ff-run-grep]\t\t->Run Grep (C-u Recursive).
1965 \\[anything-ff-run-pdfgrep]\t\t->Run Pdfgrep on marked files.
1966 \\[anything-ff-run-zgrep]\t\t->Run zgrep (C-u Recursive).
1967 \\[anything-ff-run-etags]\t\t->Run Etags (C-u use thing-at-point `C-u C-u' reload cache)
1968 \\[anything-ff-run-rename-file]\t\t->Rename File (C-u Follow).
1969 \\[anything-ff-run-copy-file]\t\t->Copy File (C-u Follow).
1970 \\[anything-ff-run-byte-compile-file]\t\t->Byte Compile File (C-u Load).
1971 \\[anything-ff-run-load-file]\t\t->Load File.
1972 \\[anything-ff-run-symlink-file]\t\t->Symlink File.
1973 \\[anything-ff-run-hardlink-file]\t\t->Hardlink file.
1974 \\[anything-ff-run-delete-file]\t\t->Delete File.
1975 \\[anything-ff-run-kill-buffer-persistent]\t\t->Kill buffer candidate without quitting.
1976 \\[anything-ff-persistent-delete]\t\t->Delete file without quitting.
1977 \\[anything-ff-run-switch-to-eshell]\t\t->Switch to Eshell.
1978 \\[anything-ff-run-eshell-command-on-file]\t\t->Eshell command on file (C-u Run on all marked files at once).
1979 \\[anything-ff-run-ediff-file]\t\t->Ediff file.
1980 \\[anything-ff-run-ediff-merge-file]\t\t->Ediff merge file.
1981 \\[anything-ff-run-complete-fn-at-point]\t\t->Complete file name at point.
1982 \\[anything-ff-run-switch-other-window]\t\t->Switch other window.
1983 \\[anything-ff-run-switch-other-frame]\t\t->Switch other frame.
1984 \\[anything-ff-run-open-file-externally]\t\t->Open file with external program (C-u to choose).
1985 \\[anything-ff-rotate-left-persistent]\t\t->Rotate Image Left.
1986 \\[anything-ff-rotate-right-persistent]\t\t->Rotate Image Right.
1987 \\[anything-find-files-down-one-level]\t\t->Go down precedent directory.
1988 \\[anything-ff-run-switch-to-history]\t\t->Switch to anything find-files history.
1989 \\[anything-ff-properties-persistent]\t\t->Show file properties in a tooltip.
1990 \\[anything-mark-all]\t\t->Mark all visibles candidates.
1991 \\[anything-ff-run-toggle-auto-update]\t->Toggle auto expansion of directories.
1992 \\[anything-unmark-all]\t\t->Unmark all candidates, visibles and invisibles.
1993 \\[anything-ff-run-gnus-attach-files]\t\t->Gnus attach files to message buffer.
1994 \\[anything-ff-run-print-file]\t\t->Print file, (C-u to refresh printers list).
1995 \\[anything-enlarge-window]\t\t->Enlarge anything window.
1996 \\[anything-narrow-window]\t\t->Narrow anything window.
1997 \\[anything-ff-run-toggle-basename]\t\t->Toggle basename/fullpath.
1998 \\[anything-send-bug-report-from-anything]\t\t->Send Bug report.
1999 \\[anything-ff-help]\t\t->Display this help info.
2000 \n== Anything Map ==
2001 \\{anything-map}")
2002
2003 ;;;###autoload
2004 (defun anything-ff-help ()
2005   "Help command for `anything-find-files'."
2006   (interactive)
2007   (let ((anything-help-message anything-ff-help-message))
2008     (anything-help)))
2009
2010 ;;; Help for `anything-c-read-file-name'
2011 ;;
2012 ;;
2013 (defvar anything-read-file-name-help-message
2014   "== Anything read file name Map ==\
2015 \nSpecific commands for anything-c-read-file-name:
2016 \\<anything-c-read-file-map>
2017 \\[anything-find-files-down-one-level]\t\t->Go down precedent directory.
2018 \\[anything-ff-run-toggle-auto-update]\t->Toggle auto expansion of directories.
2019 \\[anything-next-source]\t->Goto next source.
2020 \\[anything-previous-source]\t->Goto previous source.
2021 \\[anything-read-file-name-help]\t\t->Display this help info.
2022 \n== Anything Map ==
2023 \\{anything-map}")
2024
2025 ;;;###autoload
2026 (defun anything-read-file-name-help ()
2027   (interactive)
2028   (let ((anything-help-message anything-read-file-name-help-message))
2029     (anything-help)))
2030
2031 ;;; Generic file help - Used by locate.
2032 ;;
2033 ;;
2034 (defvar anything-generic-file-help-message
2035   "== Anything Generic files Map ==\
2036 \nSpecific commands for anything locate and others files sources:
2037 \\<anything-generic-files-map>
2038 \\[anything-ff-run-grep]\t\t->Run grep (C-u recurse).
2039 \\[anything-ff-run-pdfgrep]\t\t->Run Pdfgrep on marked files.
2040 \\[anything-ff-run-delete-file]\t\t->Delete file.
2041 \\[anything-ff-run-ediff-file]\t\t->Ediff file.
2042 \\[anything-ff-run-ediff-merge-file]\t\t->Ediff merge file.
2043 \\[anything-ff-run-switch-other-window]\t\t->Switch other window.
2044 \\[anything-ff-properties-persistent]\t\t->Show file properties.
2045 \\[anything-yank-text-at-point]\t\t->Yank text at point.
2046 \\[anything-ff-run-open-file-externally]\t\t->Open file with external program (C-u to choose).
2047 \nLocate tips:
2048 You can add after writing search pattern any of the locate command line options.
2049 e.g -b, -e, -n <number>...etc.
2050 See Man locate for more infos.
2051 \n== Anything Map ==
2052 \\{anything-map}")
2053
2054 ;;;###autoload
2055 (defun anything-generic-file-help ()
2056   (interactive)
2057   (let ((anything-help-message anything-generic-file-help-message))
2058     (anything-help)))
2059
2060 ;;; Grep help
2061 ;;
2062 ;;
2063 (defvar anything-grep-help-message
2064   "== Anything Grep Map ==\
2065 \nAnything Grep tips:
2066 You can start grep with a prefix arg to recurse in subdirectories.
2067 You can use wild card when selecting files (e.g *.el)
2068 You can grep in many differents directories by marking files or wild cards.
2069 You can save your results in a grep-mode buffer, see below.
2070
2071 \nSpecific commands for Anything Grep:
2072 \\<anything-c-grep-map>
2073 \\[anything-c-goto-next-file]\t->Next File.
2074 \\[anything-c-goto-precedent-file]\t\t->Precedent File.
2075 \\[anything-yank-text-at-point]\t\t->Yank Text at point in minibuffer.
2076 \\[anything-c-grep-run-other-window-action]\t\t->Jump other window.
2077 \\[anything-c-grep-run-persistent-action]\t\t->Run persistent action (Same as `C-z').
2078 \\[anything-c-grep-run-default-action]\t\t->Run default action (Same as RET).
2079 \\[anything-c-grep-run-save-buffer]\t\t->Save to a `grep-mode' enabled buffer.
2080 \\[anything-grep-help]\t\t->Show this help.
2081 \n== Anything Map ==
2082 \\{anything-map}")
2083
2084 ;;;###autoload
2085 (defun anything-grep-help ()
2086   (interactive)
2087   (let ((anything-help-message anything-grep-help-message))
2088     (anything-help)))
2089
2090 ;;; Pdf grep help
2091 ;;
2092 ;;
2093 (defvar anything-pdfgrep-help-message
2094   "== Anything PdfGrep Map ==\
2095 \nSpecific commands for Pdf Grep:
2096 \\<anything-c-pdfgrep-map>
2097 \\[anything-c-goto-next-file]\t->Next File.
2098 \\[anything-c-goto-precedent-file]\t\t->Precedent File.
2099 \\[anything-yank-text-at-point]\t\t->Yank Text at point in minibuffer.
2100 \\[anything-pdfgrep-help]\t\t->Show this help.
2101 \n== Anything Map ==
2102 \\{anything-map}")
2103
2104 ;;;###autoload
2105 (defun anything-pdfgrep-help ()
2106   (interactive)
2107   (let ((anything-help-message anything-pdfgrep-help-message))
2108     (anything-help)))
2109
2110 ;;; Etags help
2111 ;;
2112 ;;
2113 (defvar anything-etags-help-message
2114   "== Anything Etags Map ==\
2115 \nSpecific commands for Etags:
2116 \\<anything-c-etags-map>
2117 \\[anything-c-goto-next-file]\t->Next File.
2118 \\[anything-c-goto-precedent-file]\t\t->Precedent File.
2119 \\[anything-yank-text-at-point]\t\t->Yank Text at point in minibuffer.
2120 \\[anything-etags-help]\t\t->Show this help.
2121 \n== Anything Map ==
2122 \\{anything-map}")
2123
2124 ;;;###autoload
2125 (defun anything-etags-help ()
2126   "The help function for etags."
2127   (interactive)
2128   (let ((anything-help-message anything-etags-help-message))
2129     (anything-help)))
2130
2131 ;;; Ucs help
2132 ;;
2133 ;;
2134 (defvar anything-c-ucs-help-message
2135   "== Anything Ucs ==
2136 \nSpecific commands for `anything-ucs':
2137 \\<anything-c-ucs-map>
2138 \\[anything-c-ucs-persistent-insert]\t->Insert char.
2139 \\[anything-c-ucs-persistent-forward]\t->Forward char.
2140 \\[anything-c-ucs-persistent-backward]\t->Backward char.
2141 \\[anything-c-ucs-persistent-delete]\t->Delete char backward.
2142 \\[anything-c-ucs-help]\t\t->Show this help.
2143
2144 \n== Anything Map ==
2145 \\{anything-map}")
2146
2147 (defun anything-c-ucs-help ()
2148   "Help command for `anything-ucs'."
2149   (interactive)
2150   (let ((anything-help-message anything-c-ucs-help-message))
2151     (anything-help)))
2152
2153 ;;; Bookmark help
2154 ;;
2155 ;;
2156 (defvar anything-bookmark-help-message
2157   "== Anything bookmark name Map ==\
2158 \nSpecific commands for bookmarks:
2159 \\<anything-c-bookmark-map>
2160 \\[anything-c-bookmark-run-jump-other-window]\t\t->Jump other window.
2161 \\[anything-c-bookmark-run-delete]\t\t->Delete bookmark.
2162 \\[anything-c-bmkext-run-edit]\t\t->Edit bookmark (only for bmkext).
2163 \\[anything-c-bookmark-help]\t\t->Run this help.
2164 \n== Anything Map ==
2165 \\{anything-map}")
2166
2167 (defun anything-c-bookmark-help ()
2168   "Help command for bookmarks."
2169   (interactive)
2170   (let ((anything-help-message anything-bookmark-help-message))
2171     (anything-help)))
2172
2173 ;;; Eshell command on file help
2174 ;;
2175 ;;
2176 (defvar anything-c-esh-help-message
2177   "== Anything eshell on file ==
2178 \nTips:
2179
2180 - Passing extra args after filename:
2181
2182 Normally your command or alias will be called with file as argument.
2183
2184 e.g <command> 'candidate_file'
2185
2186 But you can also pass an argument or more after 'candidate_file' like this:
2187
2188 <command> %s [extra_args]\n
2189
2190 'candidate_file' will be inserted at '%s' and your command will look at this:
2191
2192 <command> 'candidate_file' [args]
2193
2194 - Specify many files as args (marked files):
2195
2196 e.g <command> file1 file2 ...
2197
2198 Please restart and use a prefix arg to call `anything-find-files-eshell-command-on-file'.
2199 Otherwise your command will be called many times like this:
2200
2201 <command> file1 <command> file2 etc...
2202
2203 \nSpecific commands for `anything-find-files-eshell-command-on-file':
2204 \\<anything-esh-on-file-map>
2205 \\[anything-esh-help]\t\t->Display this help.
2206 \n== Anything Map ==
2207 \\{anything-map}")
2208
2209 (defun anything-esh-help ()
2210   "Help command for `anything-find-files-eshell-command-on-file'."
2211   (interactive)
2212   (let ((anything-help-message anything-c-esh-help-message))
2213     (anything-help)))
2214
2215 \f
2216 ;;; Mode line strings
2217 ;;
2218 ;;
2219 (defvar anything-buffer-mode-line-string
2220   '("Buffer(s)"
2221     "\\<anything-c-buffer-map>\
2222 \\[anything-c-buffer-help]:Help, \
2223 \\<anything-map>\
2224 \\[anything-select-action]:Acts,\
2225 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
2226 \\[anything-select-3rd-action]:NthAct,\
2227 \\[anything-send-bug-report-from-anything]:BugReport."
2228     "String displayed in mode-line in `anything-c-source-buffers-list'"))
2229
2230 (defvar anything-ff-mode-line-string
2231   "\\<anything-find-files-map>\
2232 \\[anything-ff-help]:Help, \
2233 \\[anything-send-bug-report-from-anything]:BugReport, \
2234 \\<anything-map>\
2235 \\[anything-select-action]:Acts, \
2236 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
2237 \\[anything-select-3rd-action]:NthAct"
2238   "String displayed in mode-line in `anything-c-source-find-files'")
2239
2240 (defvar anything-read-file-name-mode-line-string
2241   "\\<anything-c-read-file-map>\
2242 \\[anything-read-file-name-help]:Help, \
2243 \\<anything-map>\
2244 \\[anything-select-action]:Acts,\
2245 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
2246 \\[anything-select-3rd-action]:NthAct"
2247   "String displayed in mode-line in `anything-c-source-find-files'")
2248
2249 (defvar anything-generic-file-mode-line-string
2250   "\\<anything-generic-files-map>\
2251 \\[anything-generic-file-help]:Help, \
2252 \\<anything-map>\
2253 \\[anything-select-action]:Acts,\
2254 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
2255 \\[anything-select-3rd-action]:NthAct,\
2256 \\[anything-send-bug-report-from-anything]:BugReport."
2257   "String displayed in mode-line in Locate.")
2258
2259 (defvar anything-grep-mode-line-string
2260   "\\<anything-c-grep-map>\
2261 \\[anything-grep-help]:Help,\
2262 \\<anything-map>\
2263 \\[anything-select-action]:Acts,\
2264 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
2265 \\[anything-select-3rd-action]:NthAct,\
2266 \\[anything-send-bug-report-from-anything]:BugReport."
2267   "String displayed in mode-line in `anything-do-grep'.")
2268
2269 (defvar anything-pdfgrep-mode-line-string
2270   "\\<anything-c-pdfgrep-map>\
2271 \\[anything-pdfgrep-help]:Help,\
2272 \\<anything-map>\
2273 \\[anything-select-action]:Acts,\
2274 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
2275 \\[anything-select-3rd-action]:NthAct,\
2276 \\[anything-send-bug-report-from-anything]:BugReport."
2277   "String displayed in mode-line in `anything-do-pdfgrep'.")
2278
2279 (defvar anything-etags-mode-line-string
2280   "\\<anything-c-etags-map>\
2281 \\[anything-etags-help]:Help,\
2282 \\<anything-map>\
2283 \\[anything-select-action]:Acts,\
2284 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
2285 \\[anything-select-3rd-action]:NthAct,\
2286 \\[anything-send-bug-report-from-anything]:BugReport."
2287   "String displayed in mode-line in `anything-c-etags-select'.")
2288
2289
2290 (defvar anything-c-ucs-mode-line-string
2291   "\\<anything-c-ucs-map>\
2292 \\[anything-c-ucs-help]:Help, \
2293 \\<anything-map>\
2294 \\[anything-select-action]:Acts,\
2295 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
2296 \\[anything-select-3rd-action]:NthAct."
2297   "String displayed in mode-line in `anything-ucs'.")
2298
2299 (defvar anything-bookmark-mode-line-string
2300   '("Bookmark(s)"
2301     "\\<anything-c-bookmark-map>\
2302 \\[anything-c-bookmark-help]:Help, \
2303 \\<anything-map>\
2304 \\[anything-select-action]:Acts,\
2305 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
2306 \\[anything-select-3rd-action]:NthAct,\
2307 \\[anything-send-bug-report-from-anything]:BugReport."
2308     "String displayed in mode-line in `anything-c-source-buffers-list'"))
2309
2310 (defvar anything-occur-mode-line
2311   "\\<anything-map>\
2312 \\[anything-help]:Help,\
2313 \\<anything-occur-map>\
2314 \\[anything-occur-run-query-replace-regexp]:Query replace regexp,\
2315 \\<anything-map>\
2316 \\[anything-select-action]:Acts,\
2317 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
2318 \\[anything-select-3rd-action]:NthAct,\
2319 \\[anything-send-bug-report-from-anything]:BugReport.")
2320
2321 \f
2322 ;;; Utilities Functions
2323 ;;
2324 ;;
2325 (defun anything-ff-find-printers ()
2326   "Return a list of available printers on Unix systems."
2327   (when (executable-find "lpstat")
2328     (let ((printer-list (with-temp-buffer
2329                           (call-process "lpstat" nil t nil "-a")
2330                           (split-string (buffer-string) "\n"))))
2331       (loop for p in printer-list
2332             for printer = (car (split-string p))
2333             when printer
2334             collect printer))))
2335
2336 ;; Shut up byte compiler in emacs24*.
2337 (defun anything-c-switch-to-buffer (buffer-or-name)
2338   "Same as `switch-to-buffer' whithout warnings at compile time."
2339   (with-no-warnings
2340     (switch-to-buffer buffer-or-name)))
2341
2342 (defun* anything-c-position (item seq &key (test 'eq) all)
2343   "A simple and faster replacement of CL `position'.
2344 Return position of first occurence of ITEM found in SEQ.
2345 Argument SEQ can be a string, in this case ITEM have to be a char.
2346 Argument ALL, if non--nil specify to return a list of positions of
2347 all ITEM found in SEQ."
2348   (let ((key (if (stringp seq) 'across 'in)))
2349     (eval
2350      `(loop for c ,key seq
2351             for index from 0
2352             when (funcall test c item)
2353             if all collect index into ls
2354             else return index
2355             finally return ls))))
2356
2357 (defun anything-c-get-pid-from-process-name (process-name)
2358   "Get pid from running process PROCESS-NAME."
2359   (loop with process-list = (list-system-processes)
2360         for pid in process-list
2361         for process = (assoc-default 'comm (process-attributes pid))
2362         when (and process (string-match process-name process))
2363         return pid))
2364
2365 (defun* anything-current-buffer-narrowed-p (&optional
2366                                             (buffer anything-current-buffer))
2367   "Check if BUFFER is narrowed.
2368 Default is `anything-current-buffer'."
2369   (with-current-buffer buffer
2370     (let ((beg (point-min))
2371           (end (point-max))
2372           (total (buffer-size)))
2373       (or (/= beg 1) (/= end (1+ total))))))
2374
2375 (defun anything-region-active-p ()
2376   (and transient-mark-mode mark-active (/= (mark) (point))))
2377
2378 (defun anything-goto-char (loc)
2379   "Go to char, revealing if necessary."
2380   (goto-char loc)
2381   (when (or (eq major-mode 'org-mode)
2382             (and (boundp 'outline-minor-mode)
2383                  outline-minor-mode))
2384     (require 'org) ; On some old Emacs versions org may not be loaded.
2385     (org-reveal)))
2386
2387 (defun anything-goto-line (lineno &optional noanim show-top)
2388   "Goto LINENO opening only outline headline if needed.
2389 Animation is used unless NOANIM is non--nil."
2390   (goto-char (point-min))
2391   (anything-goto-char (point-at-bol lineno))
2392   (when show-top
2393     (set-window-start (get-buffer-window) (point)))
2394   (unless noanim
2395     (anything-match-line-color-current-line)
2396     (sit-for 0.3)
2397     (anything-match-line-cleanup)))
2398
2399 (defun anything-show-this-source-only ()
2400   "Show all candidates of this source."
2401   (interactive)
2402   (let (anything-candidate-number-limit)
2403     (anything-set-source-filter
2404      (list (assoc-default 'name (anything-get-current-source))))))
2405
2406 ;;;###autoload
2407 (defun anything-test-sources ()
2408   "List all anything sources for test.
2409 The output is sexps which are evaluated by \\[eval-last-sexp]."
2410   (interactive)
2411   (with-output-to-temp-buffer "*Anything Test Sources*"
2412     (mapc (lambda (s) (princ (format ";; (anything '%s)\n" s)))
2413           (apropos-internal "^anything-c-source" #'boundp))
2414     (pop-to-buffer standard-output)))
2415
2416 (defun anything-displaying-source-names ()
2417   "Display sources name."
2418   (with-current-buffer anything-buffer
2419     (goto-char (point-min))
2420     (loop with pos
2421           while (setq pos (next-single-property-change (point) 'anything-header))
2422           do (goto-char pos)
2423           collect (buffer-substring-no-properties (point-at-bol)(point-at-eol))
2424           do (forward-line 1))))
2425
2426 ;; [Obsolete]
2427 (defun anything-select-source ()
2428   "[OBSOLETE] Select source."
2429   (interactive)
2430   (let ((default (assoc-default 'name (anything-get-current-source)))
2431         (source-names (anything-displaying-source-names))
2432         (all-source-names (mapcar (lambda (s) (assoc-default 'name s))
2433                                   (anything-get-sources))))
2434     (setq anything-candidate-number-limit 9999)
2435     (anything-aif
2436         (let (anything-source-filter)
2437           (anything-nest '(((name . "Anything Source")
2438                             (candidates . source-names)
2439                             (action . identity))
2440                            ((name . "Anything Source (ALL)")
2441                             (candidates . all-source-names)
2442                             (action . identity)))
2443                          nil "Source: " nil
2444                          default "*anything select source*"))
2445         (anything-set-source-filter (list it))
2446       (anything-set-source-filter nil))))
2447
2448 (defun anything-insert-string (str)
2449   "Insert STR."
2450   (anything-set-pattern str 'noupdate))
2451
2452 ;;;###autoload
2453 (defun anything-insert-buffer-name ()
2454   "Insert buffer name."
2455   (interactive)
2456   (anything-set-pattern
2457    (with-anything-current-buffer
2458      (if buffer-file-name (file-name-nondirectory buffer-file-name)
2459        (buffer-name)))))
2460
2461 (defalias 'anything-insert-symbol 'next-history-element)
2462 (defalias 'anything-insert-selection 'anything-yank-selection)
2463
2464 (defun anything-c-match-on-file-name (candidate)
2465   "Return non-nil if `anything-pattern' match basename of filename CANDIDATE."
2466   (string-match anything-pattern (file-name-nondirectory candidate)))
2467
2468 (defun anything-c-match-on-directory-name (candidate)
2469   "Return non-nil if `anything-pattern' match directory part of CANDIDATE."
2470   (anything-aif (file-name-directory candidate)
2471       (string-match anything-pattern it)))
2472
2473 (defun anything-c-match-on-basename (candidate)
2474   "Return non-nil if `anything-pattern' match basename of filename CANDIDATE."
2475   (string-match anything-pattern (anything-c-basename candidate)))
2476
2477 (defun anything-c-string-match (candidate)
2478   "Return non-nil if `anything-pattern' match CANDIDATE.
2479 The match is done with `string-match'."
2480   (string-match anything-pattern candidate))
2481
2482 (defun anything-c-skip-entries (list regexp)
2483   "Remove entries which matches REGEXP from LIST."
2484   (remove-if (lambda (x) (and (stringp x) (string-match regexp x)))
2485              list))
2486
2487 (defun anything-c-shadow-entries (list regexp)
2488   "Display elements of LIST matching REGEXP with the `file-name-shadow' face."
2489   (mapcar (lambda (file)
2490             ;; Add shadow face property to boring files.
2491             (let ((face (if (facep 'file-name-shadow)
2492                             'file-name-shadow
2493                             ;; fall back to default on XEmacs
2494                             'default)))
2495               (if (string-match regexp file)
2496                   (setq file (propertize file 'face face))))
2497             file)
2498           list))
2499
2500 (defsubst anything-c-stringify (str-or-sym)
2501   "Get string of STR-OR-SYM."
2502   (if (stringp str-or-sym)
2503       str-or-sym
2504       (symbol-name str-or-sym)))
2505
2506 (defsubst anything-c-symbolify (str-or-sym)
2507   "Get symbol of STR-OR-SYM."
2508   (if (symbolp str-or-sym)
2509       str-or-sym
2510       (intern str-or-sym)))
2511
2512 (defun anything-c-describe-function (func)
2513   "FUNC is symbol or string."
2514   (describe-function (anything-c-symbolify func)))
2515
2516 (defun anything-c-describe-variable (var)
2517   "VAR is symbol or string."
2518   (describe-variable (anything-c-symbolify var)))
2519
2520 (defun anything-c-find-function (func)
2521   "FUNC is symbol or string."
2522   (find-function (anything-c-symbolify func)))
2523
2524 (defun anything-c-find-variable (var)
2525   "VAR is symbol or string."
2526   (find-variable (anything-c-symbolify var)))
2527
2528 (defun anything-c-kill-new (candidate &optional replace)
2529   "CANDIDATE is symbol or string.
2530 See `kill-new' for argument REPLACE."
2531   (kill-new (anything-c-stringify candidate) replace))
2532
2533 (defun* anything-fast-remove-dups (seq &key (test 'eq))
2534   "Remove duplicates elements in list SEQ.
2535 This is same as `remove-duplicates' but with memoisation.
2536 It is much faster, especially in large lists.
2537 A test function can be provided with TEST argument key.
2538 Default is `eq'."
2539   (loop with cont = (make-hash-table :test test)
2540         for elm in seq
2541         unless (gethash elm cont)
2542         do (puthash elm elm cont)
2543         finally return
2544         (loop for i being the hash-values in cont collect i)))
2545
2546 (defadvice eval-defun (after anything-source-hack activate)
2547   "Allow immediate execution of anything source when evaling it.
2548 See `anything-c-enable-eval-defun-hack'."
2549   (when anything-c-enable-eval-defun-hack
2550     (let ((varsym (save-excursion
2551                     (beginning-of-defun)
2552                     (forward-char 1)
2553                     (when (memq (read (current-buffer)) '(defvar setq))
2554                       (read (current-buffer))))))
2555       (when (string-match "^anything-c-source-" (symbol-name varsym))
2556         (anything varsym)))))
2557 ;; (progn (ad-disable-advice 'eval-defun 'after 'anything-source-hack) (ad-update 'eval-defun))
2558
2559
2560 ;; Move this function from anything.el and redefine here
2561 ;; to avoid an unneeded defadvice.
2562 (defun anything-quit-and-find-file ()
2563   "Drop into `anything-find-files' from `anything'.
2564 If current selection is a buffer or a file, `anything-find-files'
2565 from its directory."
2566   (interactive)
2567   (anything-run-after-quit
2568    (lambda (f)
2569      (if (file-exists-p f)
2570          (anything-find-files-1 (file-name-directory f)
2571                                 (if anything-ff-transformer-show-only-basename
2572                                     (anything-c-basename f) f))
2573          (anything-find-files-1 f)))
2574    (anything-aif (get-buffer (anything-get-selection))
2575        (or (buffer-file-name it)
2576            (car (rassoc it dired-buffers))
2577            (and (with-current-buffer it
2578                   (eq major-mode 'org-agenda-mode))
2579                 org-directory
2580                 (expand-file-name org-directory))
2581            default-directory)
2582      (let ((sel (anything-get-selection)))
2583        (cond ((or (file-remote-p sel)
2584                   (file-exists-p sel))
2585               (expand-file-name sel))
2586              ((string-match ffap-url-regexp sel)
2587               sel)
2588              (t default-directory))))))
2589
2590
2591 (defmacro* anything-c-walk-directory (directory &key path (directories t) match)
2592   "Walk through DIRECTORY tree.
2593 PATH can be one of basename, relative, or full.
2594 DIRECTORIES when non--nil (default) return also directories names, otherwise
2595 skip directories names.
2596 MATCH match only filenames matching regexp MATCH."
2597   `(let (result
2598          (fn (case ,path
2599                (basename 'file-name-nondirectory)
2600                (relative 'file-relative-name)
2601                (full     'identity)
2602                (t        'file-name-nondirectory))))
2603      (labels ((ls-R (dir)
2604                 (loop with ls = (directory-files dir t directory-files-no-dot-files-regexp)
2605                       for f in ls
2606                       if (file-directory-p f)
2607                       do (progn (when ,directories
2608                                   (push (funcall fn f) result))
2609                                 ;; Don't recurse in directory symlink.
2610                                 (unless (file-symlink-p f)
2611                                   (ls-R f)))
2612                       else do
2613                       (unless (and ,match (not (string-match ,match (file-name-nondirectory f))))
2614                         (push (funcall fn f) result)))))
2615        (ls-R ,directory)
2616        (nreverse result))))
2617
2618 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Anything Applications ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2619
2620 ;;; Anything regexp.
2621 ;;
2622 ;;
2623 (defvar anything-build-regexp-history nil)
2624 (defun anything-c-query-replace-regexp (candidate)
2625   "Query replace regexp from `anything-regexp'.
2626 With a prefix arg replace only matches surrounded by word boundaries,
2627 i.e Don't replace inside a word, regexp is surrounded with \\bregexp\\b."
2628   (let ((regexp (funcall (anything-attr 'regexp))))
2629     (apply 'query-replace-regexp
2630            (anything-c-query-replace-args regexp))))
2631
2632 (defun anything-c-kill-regexp-as-sexp (candidate)
2633   "Kill regexp in a format usable in lisp code."
2634   (anything-c-regexp-kill-new
2635    (prin1-to-string (funcall (anything-attr 'regexp)))))
2636
2637 (defun anything-c-kill-regexp (candidate)
2638   "Kill regexp as it is in `anything-pattern'."
2639   (anything-c-regexp-kill-new (funcall (anything-attr 'regexp))))
2640
2641 (defun anything-c-query-replace-args (regexp)
2642   "create arguments of `query-replace-regexp' action in `anything-regexp'."
2643   (let ((region-only (anything-region-active-p)))
2644     (list
2645      regexp
2646      (query-replace-read-to regexp
2647                             (format "Query replace %sregexp %s"
2648                                     (if anything-current-prefix-arg "word " "")
2649                                     (if region-only "in region " ""))
2650                             t)
2651      anything-current-prefix-arg
2652      (when region-only (region-beginning))
2653      (when region-only (region-end)))))
2654
2655 (defvar anything-c-source-regexp
2656   '((name . "Regexp Builder")
2657     (init . (lambda ()
2658               (anything-candidate-buffer anything-current-buffer)))
2659     (candidates-in-buffer)
2660     (get-line . anything-c-regexp-get-line)
2661     (persistent-action . anything-c-regexp-persistent-action)
2662     (persistent-help . "Show this line")
2663     (multiline)
2664     (delayed)
2665     (requires-pattern . 2)
2666     (mode-line . "Press TAB to select action.")
2667     (regexp . (lambda () anything-input))
2668     (action . (("Kill Regexp as sexp" . anything-c-kill-regexp-as-sexp)
2669                ("Query Replace Regexp (C-u Not inside word.)"
2670                 . anything-c-query-replace-regexp)
2671                ("Kill Regexp" . anything-c-kill-regexp)))))
2672
2673 (defun anything-c-regexp-get-line (s e)
2674   (propertize
2675    (apply 'concat
2676           ;; Line contents
2677           (format "%5d: %s" (line-number-at-pos (1- s)) (buffer-substring s e))
2678           ;; subexps
2679           (loop for i from 0 to (1- (/ (length (match-data)) 2))
2680                 collect (format "\n         %s'%s'"
2681                                 (if (zerop i) "Group 0: " (format "Group %d: " i))
2682                                 (match-string i))))
2683    ;; match beginning
2684    ;; KLUDGE: point of anything-candidate-buffer is +1 than that of anything-current-buffer.
2685    ;; It is implementation problem of candidates-in-buffer.
2686    'anything-realvalue
2687    (1- s)))
2688
2689 (defun anything-c-regexp-persistent-action (pt)
2690   (anything-goto-char pt)
2691   (anything-persistent-highlight-point))
2692
2693 (defun anything-c-regexp-kill-new (input)
2694   (kill-new input)
2695   (message "Killed: %s" input))
2696
2697 (defun anything-quote-whitespace (candidate)
2698   "Quote whitespace, if some, in string CANDIDATE."
2699   (replace-regexp-in-string " " "\\\\ " candidate))
2700
2701 \f
2702 ;;; Toggle all marks.
2703 ;;
2704 ;;
2705 ;;;###autoload
2706 (defun anything-mark-all ()
2707   "Mark all visible unmarked candidates in current source."
2708   (interactive)
2709   (with-anything-window
2710     (save-excursion
2711       (goto-char (anything-get-previous-header-pos))
2712       (anything-next-line)
2713       (let* ((next-head (anything-get-next-header-pos))
2714              (end       (and next-head
2715                              (save-excursion
2716                                (goto-char next-head)
2717                                (forward-line -1)
2718                                (point))))
2719              (maxpoint  (or end (point-max))))
2720         (while (< (point) maxpoint)
2721           (anything-mark-current-line)
2722           (let* ((prefix (get-text-property (point-at-bol) 'display))
2723                  (cand   (anything-get-selection))
2724                  (bn     (and (anything-file-completion-source-p)
2725                               (anything-c-basename cand)))
2726                  (src    (assoc-default 'name (anything-get-current-source))))
2727             (when (and (not (anything-this-visible-mark))
2728                        (not (or (string= prefix "[?]")
2729                                 (string= prefix "[@]"))))
2730               ;; Don't mark possibles directories ending with . or ..
2731               ;; autosave files/links and non--existent file.
2732               (unless
2733                   (and (or (anything-file-completion-source-p)
2734                            (equal src "Files from Current Directory"))
2735                        (or (string-match "^\\.#.*\\|^#.*#$\\|\\.$" bn)
2736                            ;; We need to test here when not using a transformer
2737                            ;; that tag prefix (i.e on tramp)
2738                            (not (file-exists-p cand))))
2739                 (anything-make-visible-mark))))
2740           (forward-line 1) (end-of-line))))
2741     (anything-mark-current-line)
2742     (message "%s candidates marked" (length anything-marked-candidates))))
2743
2744 ;;;###autoload
2745 (defun anything-unmark-all ()
2746   "Unmark all candidates in all sources of current anything session."
2747   (interactive)
2748   (with-anything-window
2749     (let ((len (length anything-marked-candidates)))
2750       (save-excursion
2751         (anything-clear-visible-mark))
2752       (setq anything-marked-candidates nil)
2753       (anything-mark-current-line)
2754       (message "%s candidates unmarked" len))))
2755
2756 ;;;###autoload
2757 (defun anything-toggle-all-marks ()
2758   "Toggle all marks.
2759 Mark all visible candidates of current source or unmark all candidates
2760 visible or invisible in all sources of current anything session"
2761   (interactive)
2762   (let ((marked (anything-marked-candidates)))
2763     (if (and (>= (length marked) 1)
2764              (with-anything-window anything-visible-mark-overlays))
2765         (anything-unmark-all)
2766         (anything-mark-all))))
2767
2768
2769 \f
2770 ;;; Buffers
2771 ;;
2772 ;;
2773 (defun anything-c-buffer-list ()
2774   "Return a list of buffer names.
2775 The first buffer in the list will be the last recently used
2776 buffer that is not the current buffer unless
2777 `anything-allow-skipping-current-buffer' is nil."
2778   (let ((buffers (mapcar 'buffer-name (buffer-list))))
2779     (if anything-allow-skipping-current-buffer
2780         (progn
2781           (setq buffers (remove (buffer-name anything-current-buffer) buffers))
2782           (append (cdr buffers) (list (car buffers))))
2783         buffers)))
2784
2785 (defvar anything-c-source-buffers
2786   '((name . "Buffers")
2787     (candidates . anything-c-buffer-list)
2788     (type . buffer)))
2789
2790 (defvar anything-c-source-buffer-not-found
2791   `((name . "Create buffer")
2792     (dummy)
2793     (filtered-candidate-transformer (lambda (cands source)
2794                                       (list anything-pattern)))
2795     (keymap . ,anything-map)
2796     (action . (lambda (candidate)
2797                 (anything-c-switch-to-buffer (get-buffer-create candidate))))))
2798
2799 ;;; Buffers-list (was buffers+)
2800 ;;
2801 ;;
2802 (defun anything-c-highlight-buffers (buffers)
2803   "Transformer function to highlight BUFFERS list.
2804 Should be called after others transformers i.e (boring buffers)."
2805   (loop with buflist = (if anything-allow-skipping-current-buffer
2806                            buffers
2807                            (cons (pop (cdr buffers)) buffers))
2808         for i in buflist
2809         for buf = (get-buffer i)
2810         for bfname = (buffer-file-name buf)
2811         collect
2812         (cond (;; A dired buffer.
2813                (rassoc buf dired-buffers)
2814                (propertize i 'face 'anything-ff-directory
2815                            'help-echo (car (rassoc buf dired-buffers))))
2816               ;; A buffer file modified somewhere outside of emacs.
2817               ((and bfname (not (file-remote-p bfname))
2818                     (file-exists-p bfname)
2819                     (not (verify-visited-file-modtime buf)))
2820                (propertize i 'face 'anything-buffer-saved-out
2821                            'help-echo bfname))
2822               ;; A new buffer file not already saved on disk.
2823               ((and bfname (not (file-remote-p bfname))
2824                     (not (verify-visited-file-modtime buf)))
2825                (propertize i 'face 'anything-buffer-not-saved
2826                            'help-echo bfname))
2827               ;; A Remote buffer file modified and not saved on disk.
2828               ((and bfname (file-remote-p bfname) (buffer-modified-p buf))
2829                (let ((prefix (propertize
2830                               " " 'display
2831                               (propertize "@ " 'face 'anything-ff-prefix))))
2832                  (cons (concat prefix (propertize i 'face 'anything-ff-symlink
2833                                                   'help-echo bfname)) i)))
2834               ;; A buffer file modified and not saved on disk.
2835               ((and bfname (buffer-modified-p buf))
2836                (propertize i 'face 'anything-ff-symlink
2837                            'help-echo bfname))
2838               ;; A remote buffer file not modified and saved on disk.
2839               ((and bfname (file-remote-p bfname))
2840                (let ((prefix (propertize
2841                               " " 'display
2842                               (propertize "@ " 'face 'anything-ff-prefix))))
2843                  (cons (concat prefix (propertize i 'face 'font-lock-type-face
2844                                                   'help-echo bfname)) i)))
2845               ;; A buffer file not modified and saved on disk.
2846               (bfname
2847                (propertize i 'face 'font-lock-type-face
2848                            'help-echo bfname))
2849               ;; Any non--file buffer.
2850               (t (propertize i 'face 'italic)))))
2851
2852
2853 (defvar anything-c-source-buffers-list
2854   `((name . "Buffers")
2855     (candidates . anything-c-buffer-list)
2856     (type . buffer)
2857     (match anything-c-buffer-match-major-mode)
2858     (candidate-transformer anything-c-skip-boring-buffers
2859                            anything-c-highlight-buffers)
2860     (persistent-action . anything-c-buffers-list-persistent-action)
2861     (keymap . ,anything-c-buffer-map)
2862     (volatile)
2863     (mode-line . anything-buffer-mode-line-string)
2864     (persistent-help . "Show this buffer / C-u \\[anything-execute-persistent-action]: Kill this buffer")))
2865
2866 (defvaralias 'anything-c-source-buffers+ 'anything-c-source-buffers-list)
2867
2868 (defun anything-c-buffer-match-major-mode (candidate)
2869   "Match maybe buffer by major-mode.
2870 If you give a major-mode or partial major-mode,
2871 it will list all buffers of this major-mode and/or buffers with name
2872 matching this major-mode.
2873 If you add a space after major-mode and then a space,
2874 it will match all buffers of the major-mode
2875 before space matching pattern after space.
2876 If you give a pattern which doesn't match a major-mode, it will search buffer
2877 with name matching pattern."
2878   (let* ((cand (replace-regexp-in-string "^\\s-\\{1\\}" "" candidate))
2879          (buf  (get-buffer cand)))
2880     (when buf
2881       (with-current-buffer buf
2882         (let ((mjm   (symbol-name major-mode))
2883               (split (split-string anything-pattern)))
2884           (cond ((string-match "\\s-$" anything-pattern)
2885                  (string-match (car split) mjm))
2886                 ((string-match "\\s-" anything-pattern)
2887                  (and (string-match (car split) mjm)
2888                       (string-match (cadr split) cand)))
2889                 (t (or (string-match anything-pattern mjm)
2890                        (string-match anything-pattern cand)))))))))
2891
2892 (defun anything-c-buffer-query-replace-1 (&optional regexp-flag)
2893   "Query replace in marked buffers.
2894 If REGEXP-FLAG is given use `query-replace-regexp'."
2895   (let ((fn     (if regexp-flag 'query-replace-regexp 'query-replace))
2896         (prompt (if regexp-flag "Query replace regexp" "Query replace"))
2897         (bufs   (anything-marked-candidates)))
2898     (loop
2899           with replace = (query-replace-read-from prompt regexp-flag)
2900           with tostring = (unless (consp replace)
2901                             (query-replace-read-to
2902                              replace prompt regexp-flag))
2903           for buf in bufs
2904           do
2905           (save-window-excursion
2906             (anything-c-switch-to-buffer buf)
2907             (save-excursion
2908               (let ((case-fold-search t))
2909                 (goto-char (point-min))
2910                 (if (consp replace)
2911                     (apply fn (list (car replace) (cdr replace)))
2912                     (apply fn (list replace tostring)))))))))
2913
2914 (defun anything-c-buffer-query-replace-regexp (candidate)
2915   (anything-c-buffer-query-replace-1 'regexp))
2916
2917 (defun anything-c-buffer-query-replace (candidate)
2918   (anything-c-buffer-query-replace-1))
2919
2920 (defun anything-buffer-toggle-diff (candidate)
2921   "Toggle diff buffer CANDIDATE with it's file."
2922   (if (get-buffer-window "*Diff*")
2923       (kill-buffer "*Diff*")
2924       (diff-buffer-with-file (get-buffer candidate))))
2925
2926 ;;;###autoload
2927 (defun anything-buffer-diff-persistent ()
2928   "Toggle diff buffer without quitting anything."
2929   (interactive)
2930   (anything-attrset 'diff-action 'anything-buffer-toggle-diff)
2931   (anything-execute-persistent-action 'diff-action))
2932
2933 (defun anything-buffer-revert-and-update (candidate)
2934   (let ((marked (anything-marked-candidates)))
2935     (loop for buf in marked do (anything-revert-buffer buf))
2936     (anything-force-update candidate)))
2937
2938 ;;;###autoload
2939 (defun anything-buffer-revert-persistent ()
2940   "Revert buffer without quitting anything."
2941   (interactive)
2942   (anything-attrset 'revert-action 'anything-buffer-revert-and-update)
2943   (anything-execute-persistent-action 'revert-action 'onewindow))
2944
2945 (defun anything-buffer-save-and-update (candidate)
2946   (let ((marked (anything-marked-candidates))
2947         (enable-recursive-minibuffers t))
2948     (loop for buf in marked do
2949           (with-current-buffer (get-buffer buf)
2950             (save-buffer)))
2951     (anything-force-update candidate)))
2952
2953 ;;;###autoload
2954 (defun anything-buffer-save-persistent ()
2955   "Save buffer without quitting anything."
2956   (interactive)
2957   (anything-attrset 'save-action 'anything-buffer-save-and-update)
2958   (anything-execute-persistent-action 'save-action 'onewindow))
2959
2960 ;;;###autoload
2961 (defun anything-buffer-run-kill-buffers ()
2962   "Run kill buffer action from `anything-c-source-buffers-list'."
2963   (interactive)
2964   (anything-c-quit-and-execute-action 'anything-kill-marked-buffers))
2965
2966 ;;;###autoload
2967 (defun anything-buffer-run-grep ()
2968   "Run Grep action from `anything-c-source-buffers-list'."
2969   (interactive)
2970   (anything-c-quit-and-execute-action 'anything-c-grep-buffers))
2971
2972 ;;;###autoload
2973 (defun anything-buffer-run-zgrep ()
2974   "Run Grep action from `anything-c-source-buffers-list'."
2975   (interactive)
2976   (anything-c-quit-and-execute-action 'anything-c-zgrep-buffers))
2977
2978 ;;;###autoload
2979 (defun anything-buffer-run-query-replace-regexp ()
2980   "Run Query replace regexp action from `anything-c-source-buffers-list'."
2981   (interactive)
2982   (anything-c-quit-and-execute-action 'anything-c-buffer-query-replace-regexp))
2983
2984 ;;;###autoload
2985 (defun anything-buffer-run-query-replace ()
2986   "Run Query replace action from `anything-c-source-buffers-list'."
2987   (interactive)
2988   (anything-c-quit-and-execute-action 'anything-c-buffer-query-replace))
2989
2990 ;;;###autoload
2991 (defun anything-buffer-switch-other-window ()
2992   "Run switch to other window action from `anything-c-source-buffers-list'."
2993   (interactive)
2994   (anything-c-quit-and-execute-action 'switch-to-buffer-other-window))
2995
2996 ;;;###autoload
2997 (defun anything-buffer-switch-other-frame ()
2998   "Run switch to other frame action from `anything-c-source-buffers-list'."
2999   (interactive)
3000   (anything-c-quit-and-execute-action 'switch-to-buffer-other-frame))
3001
3002 ;;;###autoload
3003 (defun anything-buffer-switch-to-elscreen ()
3004   "Run switch to elscreen  action from `anything-c-source-buffers-list'."
3005   (interactive)
3006   (anything-c-quit-and-execute-action 'anything-find-buffer-on-elscreen))
3007
3008 ;;;###autoload
3009 (defun anything-buffer-run-ediff ()
3010   "Run ediff action from `anything-c-source-buffers-list'."
3011   (interactive)
3012   (anything-c-quit-and-execute-action 'anything-ediff-marked-buffers))
3013
3014 (defun anything-buffer-run-ediff-merge ()
3015   "Run ediff action from `anything-c-source-buffers-list'."
3016   (interactive)
3017   (anything-c-quit-and-execute-action 'anything-ediff-marked-buffers-merge))
3018
3019 (defun anything-c-buffers-persistent-kill (buffer)
3020   "Persistent action to kill buffer."
3021   (with-current-buffer (get-buffer buffer)
3022     (if (and (buffer-modified-p)
3023              (buffer-file-name (current-buffer)))
3024         (progn
3025           (save-buffer)
3026           (kill-buffer buffer))
3027         (kill-buffer buffer)))
3028   (anything-delete-current-selection))
3029
3030 (defun anything-c-buffers-list-persistent-action (candidate)
3031   (if current-prefix-arg
3032       (anything-c-buffers-persistent-kill candidate)
3033       (anything-c-switch-to-buffer candidate)))
3034
3035 \f
3036 ;;;; <File>
3037 ;;
3038 ;;
3039 ;;; File name history
3040 (defvar anything-c-source-file-name-history
3041   '((name . "File Name History")
3042     (candidates . file-name-history)
3043     (match anything-c-match-on-basename)
3044     (type . file)))
3045
3046 ;;; Files in current dir
3047 ;;
3048 ;;
3049 (defvar anything-c-source-files-in-current-dir
3050   '((name . "Files from Current Directory")
3051     (candidates . (lambda ()
3052                     (with-anything-current-buffer
3053                       (directory-files (anything-c-current-directory)))))
3054     ;; volatile is not needed, I think.
3055     (type . file)))
3056
3057 (defun anything-c-highlight-files (files)
3058   (loop for i in files
3059         if (file-directory-p i)
3060         collect (propertize (file-name-nondirectory i)
3061                             'face 'anything-ff-directory
3062                             'help-echo (expand-file-name i))
3063         else
3064         collect (propertize (file-name-nondirectory i)
3065                             'face 'anything-ff-file
3066                             'help-echo (expand-file-name i))))
3067
3068 (defvar anything-c-source-files-in-current-dir+
3069   `((name . "Files from Current Directory")
3070     (candidates . (lambda ()
3071                     (with-anything-current-buffer
3072                       (directory-files (anything-c-current-directory) t))))
3073     (keymap . ,anything-generic-files-map)
3074     (help-message . anything-generic-file-help-message)
3075     (mode-line . anything-generic-file-mode-line-string)
3076     (candidate-transformer anything-c-highlight-files)
3077     ;; volatile is not needed, I think.
3078     (type . file)))
3079
3080
3081 \f
3082 ;;; Anything-find-files - The anything files browser.
3083 ;;
3084 ;;
3085 ;; Internal.
3086 (defvar anything-c-find-files-doc-header " (`C-l': Go to precedent level)"
3087   "*The doc that is inserted in the Name header of a find-files or dired source.")
3088 (defvar anything-ff-auto-update-flag nil
3089   "Internal, flag to turn on/off auto-update in `anything-find-files'.
3090 Don't set it directly, use instead `anything-ff-auto-update-initial-value'.")
3091 (defvar anything-ff-last-expanded nil
3092   "Store last expanded directory or file.")
3093 (defvar anything-ff-default-directory nil)
3094 (defvar anything-ff-history nil)
3095 (defvar anything-ff-cand-to-mark nil)
3096 (defvar anything-ff-url-regexp
3097   "\\`\\(news\\(post\\)?:\\|nntp:\\|mailto:\\|file:\\|\\(ftp\\|https?\\|telnet\\|gopher\\|www\\|wais\\):/?/?\\).*"
3098   "Same as `ffap-url-regexp' but match earlier possible url.")
3099
3100 (defvar anything-c-source-find-files
3101   `((name . "Find Files")
3102     (header-name . (lambda (name)
3103                      (concat name anything-c-find-files-doc-header)))
3104     ;; It is needed for filenames with capital letters
3105     (disable-shortcuts)
3106     (init . (lambda ()
3107               (setq anything-ff-auto-update-flag
3108                     anything-ff-auto-update-initial-value)))
3109     (candidates . anything-find-files-get-candidates)
3110     (filtered-candidate-transformer anything-c-find-files-transformer)
3111     (persistent-action . anything-find-files-persistent-action)
3112     (persistent-help . "Hit1 Expand Candidate, Hit2 or (C-u) Find file")
3113     (mode-line . anything-ff-mode-line-string)
3114     (volatile)
3115     (candidate-number-limit . 9999)
3116     (action-transformer . anything-find-files-action-transformer)
3117     (action
3118      . ,(delq
3119          nil
3120          `(("Find File" . anything-c-find-file-or-marked)
3121            ("Find file in Dired" . anything-c-point-file-in-dired)
3122            ,(and (locate-library "elscreen")
3123                  '("Find file in Elscreen"  . anything-elscreen-find-file))
3124            ,(and (locate-library "popwin")
3125                  '("Find file in popup window" . popwin:find-file))
3126            ("Checksum File" . anything-ff-checksum)
3127            ("Complete at point `M-tab'"
3128             . anything-c-insert-file-name-completion-at-point)
3129            ("Open file externally `C-c C-x, C-u to choose'"
3130             . anything-c-open-file-externally)
3131            ("Grep File(s) `M-g s, C-u Recurse'" . anything-find-files-grep)
3132            ("Zgrep File(s) `M-g z, C-u Recurse'" . anything-ff-zgrep)
3133            ("Switch to Eshell `M-e'" . anything-ff-switch-to-eshell)
3134            ("Etags `M-., C-u tap, C-u C-u reload tag file'" . anything-ff-etags-select)
3135            ("Eshell command on file(s) `M-!, C-u run on all marked at once.'"
3136             . anything-find-files-eshell-command-on-file)
3137            ("Find file as root" . anything-find-file-as-root)
3138            ("Find file in hex dump" . hexl-find-file)
3139            ("Ediff File `C-='" . anything-find-files-ediff-files)
3140            ("Ediff Merge File `C-c ='" . anything-find-files-ediff-merge-files)
3141            ("Delete File(s) `M-D'" . anything-delete-marked-files)
3142            ("Copy file(s) `M-C, C-u to follow'" . anything-find-files-copy)
3143            ("Copy file(s) Async" . anything-ff-copy-async)
3144            ("Rename file(s) `M-R, C-u to follow'" . anything-find-files-rename)
3145            ("Serial rename files" . anything-ff-serial-rename)
3146            ("Serial rename by symlinking files" . anything-ff-serial-rename-by-symlink)
3147            ("Serial rename by copying files" . anything-ff-serial-rename-by-copying)
3148            ("Symlink files(s) `M-S, C-u to follow'" . anything-find-files-symlink)
3149            ("Relsymlink file(s) `C-u to follow'" . anything-find-files-relsymlink)
3150            ("Hardlink file(s) `M-H, C-u to follow'" . anything-find-files-hardlink)
3151            ("Find file other window `C-o'" . find-file-other-window)
3152            ("Switch to history `M-p'" . anything-find-files-switch-to-hist)
3153            ("Find file other frame `C-c C-o'" . find-file-other-frame)
3154            ("Print File `C-c p, C-u to refresh'" . anything-ff-print)
3155            ("Locate `C-x C-f, C-u to specify locate db'" . anything-ff-locate))))))
3156
3157 (defun anything-find-files-set-prompt-for-action (action files)
3158   "Set prompt for action ACTION for FILES."
3159   (let ((len (length files)))
3160     (format "%s *%s File(s)\n%s to: "
3161             action len
3162             (mapconcat (lambda (f)
3163                          (format "- %s\n" f)) files ""))))
3164
3165 (defun anything-dwim-target-directory ()
3166   "Return value of `default-directory' of buffer in other window.
3167 If there is only one window return the value ot `default-directory'
3168 for current buffer."
3169   (with-anything-current-buffer
3170     (let ((num-windows (length (window-list))))
3171       (if (> num-windows 1)
3172           (save-selected-window
3173             (other-window 1)
3174             default-directory)
3175           (car anything-ff-history)))))
3176
3177 (defun anything-find-files-do-action (action)
3178   "Generic function for creating action from `anything-c-source-find-files'.
3179 ACTION must be an action supported by `anything-dired-action'."
3180   (let* ((ifiles (mapcar 'expand-file-name ; Allow modify '/foo/.' -> '/foo'
3181                          (anything-marked-candidates)))
3182          (cand   (anything-get-selection)) ; Target
3183          (prompt (anything-find-files-set-prompt-for-action
3184                   (capitalize (symbol-name action)) ifiles))
3185          (parg   anything-current-prefix-arg)
3186          (dest   (anything-c-read-file-name
3187                   prompt
3188                   :preselect (if anything-ff-transformer-show-only-basename
3189                                  (anything-c-basename cand) cand)
3190                   :initial-input (anything-dwim-target-directory)
3191                   :history (anything-find-files-history :comp-read nil))))
3192     (anything-dired-action
3193      dest :files ifiles :action action :follow parg)))
3194
3195 (defun anything-find-files-copy (candidate)
3196   "Copy files from `anything-find-files'."
3197   (anything-find-files-do-action 'copy))
3198
3199 (defun anything-find-files-rename (candidate)
3200   "Rename files from `anything-find-files'."
3201   (anything-find-files-do-action 'rename))
3202
3203 (defun anything-find-files-symlink (candidate)
3204   "Symlink files from `anything-find-files'."
3205   (anything-find-files-do-action 'symlink))
3206
3207 (defun anything-find-files-relsymlink (candidate)
3208   "Relsymlink files from `anything-find-files'."
3209   (anything-find-files-do-action 'relsymlink))
3210
3211 (defun anything-find-files-hardlink (candidate)
3212   "Hardlink files from `anything-find-files'."
3213   (anything-find-files-do-action 'hardlink))
3214
3215 (defun anything-find-files-byte-compile (candidate)
3216   "Byte compile elisp files from `anything-find-files'."
3217   (let ((files    (anything-marked-candidates))
3218         (parg     anything-current-prefix-arg))
3219     (loop for fname in files
3220           do (byte-compile-file fname parg))))
3221
3222 (defun anything-find-files-load-files (candidate)
3223   "Load elisp files from `anything-find-files'."
3224   (let ((files    (anything-marked-candidates)))
3225     (loop for fname in files
3226           do (load fname))))
3227
3228 (defun anything-find-files-ediff-files-1 (candidate &optional merge)
3229   "Generic function to ediff/merge files in `anything-find-files'."
3230   (let ((bname  (anything-c-basename candidate))
3231         (prompt (if merge "Ediff Merge `%s' With File: "
3232                     "Ediff `%s' With File: "))
3233         (fun    (if merge 'ediff-merge-files 'ediff-files)))
3234     (funcall fun
3235              candidate
3236              (condition-case quit
3237                  (anything-c-read-file-name
3238                   (format prompt bname))
3239                (quit ;; Hit C-g ask user to fallback to locate.
3240                 (if (y-or-n-p "Search file for ediff with locate? ")
3241                     (anything-c-locate-read-file-name
3242                      (format prompt bname)
3243                      ;; Check if -b option is available.
3244                      (if (and (eq system-type 'windows-nt)
3245                               (string-match "^es" anything-c-locate-command))
3246                          bname
3247                          (concat bname " -b")))
3248                     (error "Error: Ediff Operation aborted")))))))
3249
3250 (defun anything-find-files-ediff-files (candidate)
3251   (anything-find-files-ediff-files-1 candidate))
3252
3253 (defun anything-find-files-ediff-merge-files (candidate)
3254   (anything-find-files-ediff-files-1 candidate 'merge))
3255
3256 (defun anything-find-files-grep (candidate)
3257   "Default action to grep files from `anything-find-files'."
3258   (anything-do-grep-1 (anything-marked-candidates)
3259                       anything-current-prefix-arg))
3260
3261 (defun anything-ff-zgrep (candidate)
3262   "Default action to zgrep files from `anything-find-files'."
3263   (let ((prefarg anything-current-prefix-arg)
3264         (ls      (anything-marked-candidates)))
3265     (anything-ff-zgrep-1 ls prefarg)))
3266
3267 (defun anything-ff-pdfgrep (candidate)
3268   "Default action to pdfgrep files from `anything-find-files'."
3269   (let ((cands (loop for file in (anything-marked-candidates)
3270                      if (or (string= (file-name-extension file) "pdf")
3271                             (string= (file-name-extension file) "PDF"))
3272                      collect file))
3273         (anything-c-pdfgrep-default-function 'anything-c-pdfgrep-init))
3274     (when cands
3275       (anything-do-pdfgrep-1 cands))))
3276
3277 (defun anything-ff-etags-select (candidate)
3278   "Default action to jump to etags from `anything-find-files'."
3279   (when (get-buffer anything-action-buffer)
3280     (kill-buffer anything-action-buffer))
3281   (let ((default-directory anything-ff-default-directory))
3282     (anything-c-etags-select anything-current-prefix-arg)))
3283
3284 (defun anything-find-files-switch-to-hist (candidate)
3285   "Switch to anything-find-files history."
3286   (anything-find-files t))
3287
3288 ;;; Asynchronous copy of files.
3289 ;;
3290 ;;
3291 (defun anything-c-copy-files-async-1 (flist dest)
3292   "Copy a list of Files FLIST to DEST asynchronously.
3293 It use another emacs process to do the job.
3294 Communication with background emacs is done with temp file
3295 `anything-c-copy-files-async-log-file'."
3296   (start-file-process "emacs-batch" nil anything-c-copy-async-prefered-emacs
3297                       "-Q" "--batch" "--eval"
3298                       (format "(progn
3299   (require 'dired) (require 'cl)
3300   (let ((dired-recursive-copies 'always)
3301         failures success
3302         (ovw-count 0)
3303         (cpf-count 0))
3304     (dolist (f '%S)
3305        (condition-case err
3306              (let ((file-exists (file-exists-p
3307                                  (expand-file-name
3308                                   (file-name-nondirectory (directory-file-name f))
3309                                    (file-name-directory
3310                                      (file-name-as-directory \"%s\"))))))
3311                 (dired-copy-file f \"%s\" t)
3312                 (if file-exists
3313                     (progn (push (cons \"Overwriting\" f) success)
3314                            (incf ovw-count))
3315                     (push (cons \"Copying\" f) success)
3316                     (incf cpf-count)))
3317           (file-error
3318            (push (dired-make-relative
3319                    (expand-file-name
3320                      (file-name-nondirectory (directory-file-name f))
3321                      (file-name-directory \"%s\")))
3322                  failures))))
3323     (with-current-buffer (find-file-noselect \"%s\")
3324        (erase-buffer)
3325        (when failures
3326          (dolist (fail (reverse failures))
3327            (insert (concat \"Failed to copy \" fail \"\n\"))))
3328        (when success
3329          (loop for (a . s) in (reverse success) do
3330            (insert (concat a \" \" s  \" to %s done\n\"))))
3331        (and (/= cpf-count 0) (insert (concat (int-to-string cpf-count) \" File(s) Copied\n\")))
3332        (and (/= ovw-count 0) (insert (concat (int-to-string ovw-count) \" File(s) Overwrited\n\")))
3333        (and failures (insert (concat (int-to-string (length failures)) \" File(s) Failed to copy\n\")))
3334        (save-buffer))))"
3335                               flist dest dest dest anything-c-copy-files-async-log-file dest)))
3336
3337 (defun anything-c-copy-async-with-log (flist dest)
3338   "Copy file list FLIST to DEST showing log.
3339 Log is send to `anything-c-copy-files-async-log-file'.
3340 Copying is done asynchronously with `anything-c-copy-files-async-1'."
3341   (declare (special auto-revert-interval))
3342   (pop-to-buffer (find-file-noselect anything-c-copy-files-async-log-file))
3343   (set (make-local-variable 'auto-revert-interval) 1)
3344   (erase-buffer)
3345   (insert "Wait copying files...\n")
3346   (sit-for 0.5) (save-buffer)
3347   (goto-char (point-max))
3348   (auto-revert-mode 1)
3349   (anything-c-copy-files-async-1 flist dest))
3350
3351 (defun anything-ff-copy-async (candidate)
3352   "Anything find files action to copy files async.
3353 Copying is done asynchronously with `anything-c-copy-files-async-1'."
3354   (let* ((flist (anything-marked-candidates))
3355          (dest  (anything-c-read-file-name
3356                  (anything-find-files-set-prompt-for-action
3357                   "Copy Async" flist)
3358                  :preselect candidate
3359                  :initial-input (car anything-ff-history)
3360                  :history (anything-find-files-history :comp-read nil))))
3361     (anything-c-copy-async-with-log flist dest)))
3362
3363 (defvar eshell-command-aliases-list nil)
3364 (defvar anything-eshell-command-on-file-input-history nil)
3365 (defun anything-find-files-eshell-command-on-file-1 (candidate &optional map)
3366   "Run `eshell-command' on CANDIDATE or marked candidates.
3367 This is done possibly with an eshell alias, if no alias found, you can type in
3368 an eshell command.
3369
3370 Basename of CANDIDATE can be a wild-card.
3371 e.g you can do \"eshell-command command *.el\"
3372 Where \"*.el\" is the CANDIDATE.
3373
3374 It is possible to do eshell-command command <CANDIDATE> <some more args>
3375 like this: \"command %s some more args\".
3376
3377 If MAP is given run `eshell-command' on all marked files at once,
3378 Otherwise, run `eshell-command' on each marked files.
3379 In other terms, with a prefix arg do on the three marked files
3380 \"foo\" \"bar\" \"baz\":
3381
3382 \"eshell-command command foo bar baz\"
3383
3384 otherwise do
3385
3386 \"eshell-command command foo\"
3387 \"eshell-command command bar\"
3388 \"eshell-command command baz\"
3389
3390 Note:
3391 If `eshell' or `eshell-command' have not been run once,
3392 or if you have no eshell aliases `eshell-command-aliases-list'
3393 will not be loaded first time you use this."
3394   (when (or eshell-command-aliases-list
3395             (y-or-n-p "Eshell is not loaded, run eshell-command without alias anyway? "))
3396     (and eshell-command-aliases-list (eshell-read-aliases-list))
3397     (let* ((cand-list (anything-marked-candidates))
3398            (default-directory (or anything-ff-default-directory
3399                                   ;; If candidate is an url *-ff-default-directory is nil
3400                                   ;; so keep value of default-directory.
3401                                   default-directory))
3402            (command (anything-comp-read
3403                      "Command: "
3404                      (loop for (a . c) in eshell-command-aliases-list
3405                            when (string-match "\\(\\$1\\|\\$\\*\\)$" (car c))
3406                            collect (propertize a 'help-echo (car c)) into ls
3407                            finally return (sort ls 'string<))
3408                      :buffer "*esh command on file*"
3409                      :name "Eshell command"
3410                      :keymap anything-esh-on-file-map
3411                      :mode-line
3412                      '("Eshell alias"
3413                        "C-c ?: Help, \\[universal-argument]: Insert output at point")
3414                      :input-history
3415                      'anything-eshell-command-on-file-input-history))
3416            (alias-value (car (assoc-default command eshell-command-aliases-list))))
3417       (when (and (= (length cand-list) 1)
3418                  (string-match "[*]" (anything-c-basename (car cand-list))))
3419         (setq cand-list (file-expand-wildcards (car cand-list) t)))
3420       ;; Be sure output don't go in current buffer
3421       ;; but allow sending output to current buffer
3422       ;; if a prefix arg have been passed during the
3423       ;; `anything-comp-read' call.
3424       (setq current-prefix-arg anything-current-prefix-arg)
3425       ;; MAP have been set before calling `anything-comp-read'
3426       ;; by `anything-current-prefix-arg'.
3427       (if (and (or map ; prefix-arg
3428                    (and alias-value
3429                         ;; If command is an alias be sure it accept
3430                         ;; more than one arg i.e $*.
3431                         (string-match "\\$\\*$" alias-value)))
3432                (> (length cand-list) 1))
3433
3434           ;; Run eshell-command with ALL marked files as arguments.
3435           (let ((mapfiles (mapconcat 'shell-quote-argument cand-list " ")))
3436             (if (string-match "'%s'\\|\"%s\"\\|%s" command)
3437                 (eshell-command (format command mapfiles)) ; See [1]
3438                 (eshell-command (format "%s %s" command mapfiles))))
3439
3440           ;; Run eshell-command on EACH marked files.
3441           (loop for i in cand-list
3442                 for bn = (anything-c-basename i)
3443                 for files = (format "'%s'" i)
3444                 for com = (if (string-match "'%s'\\|\"%s\"\\|%s" command)
3445                               ;; [1] This allow to enter other args AFTER filename
3446                               ;; i.e <command %s some_more_args>
3447                               (format command files)
3448                               (format "%s %s" command files))
3449                 do (eshell-command com))))))
3450
3451 (defun anything-find-files-eshell-command-on-file (candidate)
3452   "Run `eshell-command' on CANDIDATE or marked candidates.
3453 See `anything-find-files-eshell-command-on-file-1' for more info."
3454   (anything-find-files-eshell-command-on-file-1
3455    candidate anything-current-prefix-arg))
3456
3457 (defun anything-ff-switch-to-eshell (candidate)
3458   "Switch to eshell and cd to `anything-ff-default-directory'."
3459   (flet ((cd-eshell ()
3460            (goto-char (point-max))
3461            (insert
3462             (format "cd '%s'" anything-ff-default-directory))
3463            (eshell-send-input)))
3464     (if (get-buffer "*eshell*")
3465         (progn
3466           (anything-c-switch-to-buffer "*eshell*")
3467           (cd-eshell))
3468         (call-interactively 'eshell)
3469         (cd-eshell))))
3470
3471 (defun anything-ff-serial-rename-action (method)
3472   "Rename all marked files to `anything-ff-default-directory' with METHOD.
3473 See `anything-ff-serial-rename-1'."
3474   (let* ((cands     (anything-marked-candidates))
3475          (def-name  (car cands))
3476          (name      (read-string "NewName: "
3477                                  (replace-regexp-in-string
3478                                   "[0-9]+$" ""
3479                                   (anything-c-basename
3480                                    def-name
3481                                    (file-name-extension def-name)))))
3482          (start     (read-number "StartAtNumber: "))
3483          (extension (read-string "Extension: "
3484                                  (file-name-extension (car cands))))
3485          (dir       (expand-file-name
3486                      (anything-c-read-file-name
3487                       "Serial Rename to directory: "
3488                       :initial-input
3489                       (expand-file-name anything-ff-default-directory)
3490                       :test 'file-directory-p
3491                       :must-match t)))
3492          (res       (loop for f in cands
3493                           for bn = (anything-c-basename f)
3494                           for count from start
3495                           concat (format "%s <-> %s%s.%s\n"
3496                                          bn name count extension))))
3497     (if (y-or-n-p
3498          (format "Result:\n %sRename like this to <%s> ? " res dir))
3499         (progn
3500           (anything-ff-serial-rename-1
3501            dir cands name start extension :method method)
3502           (message nil)
3503           (anything-find-files-1 dir))
3504         (message "Operation aborted"))))
3505
3506 (defun anything-ff-member-directory-p (file directory)
3507   (let ((dir-file (expand-file-name
3508                    (file-name-as-directory (file-name-directory file))))
3509         (cur-dir  (expand-file-name (file-name-as-directory directory))))
3510     (string= dir-file cur-dir)))
3511
3512 (defun* anything-ff-serial-rename-1
3513     (directory collection new-name start-at-num extension &key (method 'rename))
3514   "rename files in COLLECTION to DIRECTORY with the prefix name NEW-NAME.
3515 Rename start at number START-AT-NUM - ex: prefixname-01.jpg.
3516 EXTENSION is the file extension to use, in empty prompt,
3517 reuse the original extension of file.
3518 METHOD can be one of rename, copy or symlink.
3519 Files will be renamed if they are files of current directory, otherwise they
3520 will be treated with METHOD.
3521 Default METHOD is rename."
3522   ;; Maybe remove directories selected by error in collection.
3523   (setq collection (remove-if 'file-directory-p collection))
3524   (flet ((symlink-file (file dest)
3525            (let ((flist (list file)))
3526              (anything-dired-action
3527               dest :action 'symlink :files flist))))
3528
3529     (let* ((tmp-dir  (file-name-as-directory
3530                       (concat (file-name-as-directory directory)
3531                               (symbol-name (gensym "tmp")))))
3532            (fn       (case method
3533                        (copy    'copy-file)
3534                        (symlink 'symlink-file)
3535                        (rename  'rename-file)
3536                        (t (error "Error: Unknow method %s" method)))))
3537       (make-directory tmp-dir)
3538       (unwind-protect
3539            (progn
3540              ;; Rename all files to tmp-dir with new-name.
3541              ;; If files are not from start directory, use method
3542              ;; to move files to tmp-dir.
3543              (loop for i in collection
3544                    for count from start-at-num
3545                    for fnum = (if (< count 10) "0%s" "%s")
3546                    for nname = (concat tmp-dir new-name (format fnum count)
3547                                        (if (not (string= extension ""))
3548                                            (format ".%s" (replace-regexp-in-string
3549                                                           "[.]" "" extension))
3550                                            (file-name-extension i 'dot)))
3551                    do (if (anything-ff-member-directory-p i directory)
3552                           (rename-file i nname)
3553                           (funcall fn i nname)))
3554              ;; Now move all from tmp-dir to destination.
3555              (loop with dirlist = (directory-files
3556                                    tmp-dir t directory-files-no-dot-files-regexp)
3557                    for f in dirlist do
3558                    (if (file-symlink-p f)
3559                        (symlink-file (file-truename f)
3560                                      (concat (file-name-as-directory directory)
3561                                              (anything-c-basename f)))
3562                        (rename-file f directory))))
3563         (delete-directory tmp-dir t)))))
3564
3565 (defun anything-ff-serial-rename (candidate)
3566   "Serial rename all marked files to `anything-ff-default-directory'.
3567 Rename only file of current directory, and symlink files coming from
3568 other directories.
3569 See `anything-ff-serial-rename-1'."
3570   (anything-ff-serial-rename-action 'rename))
3571
3572 (defun anything-ff-serial-rename-by-symlink (candidate)
3573   "Serial rename all marked files to `anything-ff-default-directory'.
3574 Rename only file of current directory, and symlink files coming from
3575 other directories.
3576 See `anything-ff-serial-rename-1'."
3577   (anything-ff-serial-rename-action 'symlink))
3578
3579 (defun anything-ff-serial-rename-by-copying (candidate)
3580   "Serial rename all marked files to `anything-ff-default-directory'.
3581 Rename only file of current directory, and copy files coming from
3582 other directories.
3583 See `anything-ff-serial-rename-1'."
3584   (anything-ff-serial-rename-action 'copy))
3585
3586 (defun anything-c-quit-and-execute-action (action)
3587   "Quit current anything session and execute ACTION."
3588   (setq anything-saved-action action)
3589   (anything-exit-minibuffer))
3590
3591 (defun anything-ff-toggle-auto-update (candidate)
3592   (setq anything-ff-auto-update-flag (not anything-ff-auto-update-flag))
3593   (message "[Auto expansion %s]"
3594            (if anything-ff-auto-update-flag "enabled" "disabled")))
3595
3596 ;;;###autoload
3597 (defun anything-ff-run-toggle-auto-update ()
3598   (interactive)
3599   (when (anything-file-completion-source-p)
3600     (anything-attrset 'toggle-auto-update 'anything-ff-toggle-auto-update)
3601     (anything-execute-persistent-action 'toggle-auto-update)))
3602
3603 ;;;###autoload
3604 (defun anything-ff-run-switch-to-history ()
3605   "Run Switch to history action from `anything-c-source-find-files'."
3606   (interactive)
3607   (when (anything-file-completion-source-p)
3608     (anything-c-quit-and-execute-action 'anything-find-files-switch-to-hist)))
3609
3610 ;;;###autoload
3611 (defun anything-ff-run-grep ()
3612   "Run Grep action from `anything-c-source-find-files'."
3613   (interactive)
3614   (when (anything-file-completion-source-p)
3615     (anything-c-quit-and-execute-action 'anything-find-files-grep)))
3616
3617 ;;;###autoload
3618 (defun anything-ff-run-pdfgrep ()
3619   "Run Pdfgrep action from `anything-c-source-find-files'."
3620   (interactive)
3621   (when (anything-file-completion-source-p)
3622     (anything-c-quit-and-execute-action 'anything-ff-pdfgrep)))
3623
3624 ;;;###autoload
3625 (defun anything-ff-run-zgrep ()
3626   "Run Grep action from `anything-c-source-find-files'."
3627   (interactive)
3628   (when (anything-file-completion-source-p)
3629     (anything-c-quit-and-execute-action 'anything-ff-zgrep)))
3630
3631 ;;;###autoload
3632 (defun anything-ff-run-copy-file ()
3633   "Run Copy file action from `anything-c-source-find-files'."
3634   (interactive)
3635   (when (anything-file-completion-source-p)
3636     (anything-c-quit-and-execute-action 'anything-find-files-copy)))
3637
3638 ;;;###autoload
3639 (defun anything-ff-run-rename-file ()
3640   "Run Rename file action from `anything-c-source-find-files'."
3641   (interactive)
3642   (when (anything-file-completion-source-p)
3643     (anything-c-quit-and-execute-action 'anything-find-files-rename)))
3644
3645 ;;;###autoload
3646 (defun anything-ff-run-byte-compile-file ()
3647   "Run Byte compile file action from `anything-c-source-find-files'."
3648   (interactive)
3649   (when (anything-file-completion-source-p)
3650     (anything-c-quit-and-execute-action 'anything-find-files-byte-compile)))
3651
3652 ;;;###autoload
3653 (defun anything-ff-run-load-file ()
3654   "Run Load file action from `anything-c-source-find-files'."
3655   (interactive)
3656   (when (anything-file-completion-source-p)
3657     (anything-c-quit-and-execute-action 'anything-find-files-load-files)))
3658
3659 ;;;###autoload
3660 (defun anything-ff-run-eshell-command-on-file ()
3661   "Run eshell command on file action from `anything-c-source-find-files'."
3662   (interactive)
3663   (when (anything-file-completion-source-p)
3664     (anything-c-quit-and-execute-action
3665      'anything-find-files-eshell-command-on-file)))
3666
3667 ;;;###autoload
3668 (defun anything-ff-run-ediff-file ()
3669   "Run Ediff file action from `anything-c-source-find-files'."
3670   (interactive)
3671   (when (anything-file-completion-source-p)
3672     (anything-c-quit-and-execute-action 'anything-find-files-ediff-files)))
3673
3674 ;;;###autoload
3675 (defun anything-ff-run-ediff-merge-file ()
3676   "Run Ediff merge file action from `anything-c-source-find-files'."
3677   (interactive)
3678   (when (anything-file-completion-source-p)
3679     (anything-c-quit-and-execute-action
3680      'anything-find-files-ediff-merge-files)))
3681
3682 ;;;###autoload
3683 (defun anything-ff-run-symlink-file ()
3684   "Run Symlink file action from `anything-c-source-find-files'."
3685   (interactive)
3686   (when (anything-file-completion-source-p)
3687     (anything-c-quit-and-execute-action 'anything-find-files-symlink)))
3688
3689 ;;;###autoload
3690 (defun anything-ff-run-hardlink-file ()
3691   "Run Hardlink file action from `anything-c-source-find-files'."
3692   (interactive)
3693   (when (anything-file-completion-source-p)
3694     (anything-c-quit-and-execute-action 'anything-find-files-hardlink)))
3695
3696 ;;;###autoload
3697 (defun anything-ff-run-delete-file ()
3698   "Run Delete file action from `anything-c-source-find-files'."
3699   (interactive)
3700   (when (anything-file-completion-source-p)
3701     (anything-c-quit-and-execute-action 'anything-delete-marked-files)))
3702
3703 ;;;###autoload
3704 (defun anything-ff-run-complete-fn-at-point ()
3705   "Run complete file name action from `anything-c-source-find-files'."
3706   (interactive)
3707   (when (anything-file-completion-source-p)
3708     (anything-c-quit-and-execute-action
3709      'anything-c-insert-file-name-completion-at-point)))
3710
3711 ;;;###autoload
3712 (defun anything-ff-run-switch-to-eshell ()
3713   "Run switch to eshell action from `anything-c-source-find-files'."
3714   (interactive)
3715   (when (anything-file-completion-source-p)
3716     (anything-c-quit-and-execute-action 'anything-ff-switch-to-eshell)))
3717
3718 ;;;###autoload
3719 (defun anything-ff-run-switch-other-window ()
3720   "Run switch to other window action from `anything-c-source-find-files'."
3721   (interactive)
3722   (when (anything-file-completion-source-p)
3723     (anything-c-quit-and-execute-action 'find-file-other-window)))
3724
3725 ;;;###autoload
3726 (defun anything-ff-run-switch-other-frame ()
3727   "Run switch to other frame action from `anything-c-source-find-files'."
3728   (interactive)
3729   (when (anything-file-completion-source-p)
3730     (anything-c-quit-and-execute-action 'find-file-other-frame)))
3731
3732 ;;;###autoload
3733 (defun anything-ff-run-open-file-externally ()
3734   "Run open file externally command action from `anything-c-source-find-files'."
3735   (interactive)
3736   (when (anything-file-completion-source-p)
3737     (anything-c-quit-and-execute-action 'anything-c-open-file-externally)))
3738
3739 (defun anything-ff-locate (candidate)
3740   "Locate action function for `anything-find-files'."
3741   (let ((input (concat (anything-c-basename
3742                         (expand-file-name
3743                          candidate
3744                          anything-ff-default-directory))
3745                        ;; The locate '-b' option doesn't exists
3746                        ;; in everything.
3747                        (unless (and (eq system-type 'windows-nt)
3748                                     (string-match "^es" anything-c-locate-command))
3749                          " -b")))
3750         (anything-mp-highlight-delay 0.7))
3751     (anything-locate-1 anything-current-prefix-arg input 'from-ff)))
3752
3753 ;;;###autoload
3754 (defun anything-ff-run-locate ()
3755   "Run locate action from `anything-c-source-find-files'."
3756   (interactive)
3757   (when (anything-file-completion-source-p)
3758     (anything-c-quit-and-execute-action 'anything-ff-locate)))
3759
3760 ;;;###autoload
3761 (defun anything-ff-run-gnus-attach-files ()
3762   "Run gnus attach files command action from `anything-c-source-find-files'."
3763   (interactive)
3764   (when (anything-file-completion-source-p)
3765     (anything-c-quit-and-execute-action 'anything-ff-gnus-attach-files)))
3766
3767 ;;;###autoload
3768 (defun anything-ff-run-etags ()
3769   "Run Etags command action from `anything-c-source-find-files'."
3770   (interactive)
3771   (when (anything-file-completion-source-p)
3772     (anything-c-quit-and-execute-action 'anything-ff-etags-select)))
3773
3774 (defun anything-ff-print (candidate)
3775   "Print marked files.
3776 You have to set in order
3777 variables `lpr-command',`lpr-switches' and/or `printer-name'.
3778
3779 e.g:
3780 \(setq lpr-command \"gtklp\"\)
3781 \(setq lpr-switches '(\"-P\")\)
3782 \(setq printer-name \"Epson-Stylus-Photo-R265\"\)
3783
3784 Same as `dired-do-print' but for anything."
3785   (when (or anything-current-prefix-arg
3786             (not anything-ff-printer-list))
3787     (setq anything-ff-printer-list
3788           (anything-ff-find-printers)))
3789   (let* ((file-list (anything-marked-candidates))
3790          (len (length file-list))
3791          (printer-name (if anything-ff-printer-list
3792                            (anything-comp-read
3793                             "Printer: " anything-ff-printer-list)
3794                            printer-name))
3795          (command (read-string
3796                    (format "Print *%s File(s):\n%s with: "
3797                            len
3798                            (mapconcat
3799                             (lambda (f) (format "- %s\n" f))
3800                             file-list ""))
3801                    (when (and lpr-command
3802                               (or lpr-switches
3803                                   printer-name))
3804                      (mapconcat 'identity
3805                                 (cons lpr-command
3806                                       (append (if (stringp lpr-switches)
3807                                                   (list lpr-switches)
3808                                                   lpr-switches)
3809                                               (list printer-name)))
3810                                 " "))))
3811          (file-args (mapconcat #'(lambda (x)
3812                                    (format "'%s'" x))
3813                                file-list " "))
3814          (cmd-line (concat command " " file-args)))
3815     (if command
3816         (start-process-shell-command "anything-print" nil cmd-line)
3817         (error "Error: Please verify your printer settings in Emacs."))))
3818
3819 ;;;###autoload
3820 (defun anything-ff-run-print-file ()
3821   "Run Print file action from `anything-c-source-find-files'."
3822   (interactive)
3823   (when (anything-file-completion-source-p)
3824     (anything-c-quit-and-execute-action 'anything-ff-print)))
3825
3826 (defun anything-ff-checksum (file)
3827   "Calculate the checksum of FILE.
3828 Provide completion on different algorithms to use on Emacs24.
3829 On Emacs23 only 'sha1' is available.
3830 The checksum is copied to kill-ring."
3831   (let ((algo-list (and (fboundp 'secure-hash)
3832                         '(md5 sha1 sha224 sha256 sha384 sha512))))
3833     (kill-new
3834      (if algo-list
3835          (secure-hash (intern
3836                        (anything-comp-read
3837                         "Algorithm: " algo-list))
3838                       file)
3839          (sha1 (with-temp-buffer
3840                  (insert-file-contents file)
3841                  (buffer-string)))))
3842     (message "Checksum copied to kill-ring.")))
3843
3844 (defun anything-ff-toggle-basename (candidate)
3845   (setq anything-ff-transformer-show-only-basename
3846         (not anything-ff-transformer-show-only-basename))
3847   (let ((target (if anything-ff-transformer-show-only-basename
3848                     (anything-c-basename candidate) candidate)))
3849     (anything-force-update target)))
3850
3851 (defun anything-ff-run-toggle-basename ()
3852   (interactive)
3853   (when (anything-file-completion-source-p)
3854     (anything-attrset 'toggle-basename 'anything-ff-toggle-basename)
3855     (anything-execute-persistent-action 'toggle-basename)))
3856
3857 (defun* anything-reduce-file-name (fname level &key unix-close expand)
3858   "Reduce FNAME by LEVEL from end or beginning depending LEVEL value.
3859 If LEVEL is positive reduce from end else from beginning.
3860 If UNIX-CLOSE is non--nil close filename with /.
3861 If EXPAND is non--nil expand-file-name."
3862   (let* ((exp-fname  (expand-file-name fname))
3863          (fname-list (split-string (if (or (string= fname "~/") expand)
3864                                        exp-fname fname) "/" t))
3865          (len        (length fname-list))
3866          (pop-list   (if (< level 0)
3867                          (subseq fname-list (* level -1))
3868                          (subseq fname-list 0 (- len level))))
3869          (result     (mapconcat 'identity pop-list "/"))
3870          (empty      (string= result "")))
3871     (when unix-close (setq result (concat result "/")))
3872     (if (string-match "^~" result)
3873         (if (string= result "~/") "~/" result)
3874         (if (< level 0)
3875             (if empty "../" (concat "../" result))
3876             (cond ((eq system-type 'windows-nt)
3877                    (if empty (expand-file-name "/") ; Expand to "/" or "c:/".
3878                        result))
3879                   (empty "/")
3880                   (t
3881                    (concat "/" result)))))))
3882
3883 ;; Internal
3884 (defvar anything-file-completion-sources
3885   '("Find Files" "Read File Name"
3886     "Read File Name History" "Copy Files"
3887     "Rename Files" "Symlink Files"
3888     "Hardlink Files" "Write File" "Insert File")
3889   "Sources that use the *find-files mechanism can be added here.
3890 Sources generated by `ac-mode' don't need to be added here, it will
3891 be done automatically.
3892 You should not modify this yourself unless you know what you do.")
3893
3894 (defun anything-file-completion-source-p ()
3895   "Return non--nil if current source is a file completion source.
3896 A source is a file completion source if it is
3897 one of `anything-file-completion-sources'.
3898 Return nil if anything is not running."
3899   (let ((cur-source (cdr (assoc 'name (anything-get-current-source)))))
3900     (loop for i in anything-file-completion-sources
3901           thereis (string= cur-source i))))
3902
3903 (defun anything-find-files-down-one-level (arg)
3904   "Go down one level like unix command `cd ..'.
3905 If prefix numeric arg is given go ARG level down."
3906   (interactive "p")
3907   (when (and (anything-file-completion-source-p)
3908              (not (anything-ff-invalid-tramp-name-p)))
3909     (with-anything-window
3910       (setq anything-follow-mode nil))
3911     ;; When going to precedent level we want to be at the line
3912     ;; corresponding to actual directory, so store this info
3913     ;; in `anything-ff-last-expanded'.
3914     (if (and (not (file-directory-p anything-pattern))
3915              (file-exists-p anything-pattern))
3916         (setq anything-ff-last-expanded anything-pattern)
3917         (setq anything-ff-last-expanded anything-ff-default-directory))
3918     (let ((new-pattern (anything-reduce-file-name anything-pattern arg
3919                                                   :unix-close t :expand t)))
3920       (anything-set-pattern new-pattern))))
3921
3922 (defun anything-ff-retrieve-last-expanded ()
3923   "Move overlay to last visited directory `anything-ff-last-expanded'.
3924 This happen after using `anything-find-files-down-one-level',
3925 or hitting C-z on \"..\"."
3926   (when (and anything-ff-last-expanded
3927              (anything-file-completion-source-p))
3928     (let ((presel (if anything-ff-transformer-show-only-basename
3929                        (anything-c-basename
3930                         (directory-file-name anything-ff-last-expanded))
3931                        (directory-file-name anything-ff-last-expanded))))
3932       (with-anything-window
3933         (when (re-search-forward
3934                (concat "^" (regexp-quote presel) "$") nil t)
3935           (forward-line 0)
3936           (anything-mark-current-line)))
3937       (setq anything-ff-last-expanded nil))))
3938 (add-hook 'anything-after-update-hook 'anything-ff-retrieve-last-expanded)
3939
3940 ;; Auto-update - anything-find-files auto expansion of directories.
3941 ;;
3942 (defun anything-ff-update-when-only-one-matched ()
3943   "Expand to directory when sole completion.
3944 When only one candidate is remaining and it is a directory,
3945 expand to this directory."
3946   (when (and anything-ff-auto-update-flag
3947              (anything-file-completion-source-p)
3948              (not (anything-ff-invalid-tramp-name-p)))
3949     (let* ((history-p   (string= (assoc-default
3950                                   'name (anything-get-current-source))
3951                                  "Read File Name History"))
3952            (pat         (if (string-match tramp-file-name-regexp
3953                                           anything-pattern)
3954                             (anything-create-tramp-name anything-pattern)
3955                             anything-pattern))
3956            (completed-p (string= (file-name-as-directory pat)
3957                                  anything-ff-default-directory)))
3958       (when (and (or
3959                   ;; Only one candidate remaining
3960                   ;; and at least 2 char in basename.
3961                   (and (<= (anything-approximate-candidate-number) 2)
3962                        (>= (length (anything-c-basename anything-pattern)) 2))
3963                   ;; Already completed.
3964                   completed-p)
3965                  (not history-p)) ; Don't try to auto complete in history.
3966         (with-anything-window
3967           (let ((cur-cand (prog2
3968                               (unless completed-p
3969                                 ;; Only one non--existing candidate
3970                                 ;; and one directory candidate, move to it.
3971                                 (anything-next-line))
3972                               (anything-get-selection))))
3973             (when (and (stringp cur-cand) (file-directory-p cur-cand))
3974               (if (and (not (string-match "^.*[.]\\{1,2\\}$" cur-cand)) ; [1]
3975                        ;; Maybe we are here because completed-p is true
3976                        ;; but check this again to be sure. (Windows fix)
3977                        (<= (anything-approximate-candidate-number) 2)) ; [2]
3978                   ;; If after going to next line the candidate
3979                   ;; is not one of "." or ".." [1]
3980                   ;; and only one candidate is remaining [2],
3981                   ;; assume candidate is a new directory to expand, and do it.
3982                   (anything-set-pattern (file-name-as-directory cur-cand))
3983                   ;; The candidate is one of "." or ".."
3984                   ;; that mean we have entered the last letter of the directory name
3985                   ;; in prompt, so expansion is already done, just add the "/" at end
3986                   ;; of name unless anything-pattern ends with "."
3987                   ;; (i.e we are writing something starting with ".")
3988                   (unless (string-match "^.*[.]\\{1\\}$" anything-pattern)
3989                     (anything-set-pattern
3990                      ;; Need to expand-file-name to avoid e.g /ssh:host:./ in prompt.
3991                      (expand-file-name (file-name-as-directory anything-pattern)))))
3992               (anything-check-minibuffer-input-1))))))))
3993 (add-hook 'anything-after-update-hook 'anything-ff-update-when-only-one-matched)
3994
3995 ;; Allow expanding to home directory or root
3996 ;; when entering respectively "~/" or "//" at end of pattern.
3997 ;; e.g /home/thierry/labo/anything-config-qp/~/
3998 ;; will expand to "~/"
3999 ;; and /home/thierry/labo/anything-config-qp//
4000 ;; will expand to "/"
4001 (defun anything-ff-auto-expand-to-home-or-root ()
4002   "Goto home, root or default directory when pattern ends with ~/, /, or ./.
4003 This happen only in function using sources that are
4004 `anything-file-completion-source-p' compliant."
4005   (when (and (anything-file-completion-source-p)
4006              (string-match ".*\\(/~/\\|/\\{2\\}\\|/[.]\\{1\\}/\\)$"
4007                            anything-pattern)
4008              (not (string-match anything-ff-url-regexp anything-pattern)))
4009     (let ((match (match-string 1 anything-pattern)))
4010       (cond ((string= match "//")
4011              ;; Expand to "/" or "c:/"
4012              (setq anything-pattern (expand-file-name "/")))
4013             ((string= match "/~/")
4014              (if (eq system-type 'windows-nt)
4015                  (setq anything-pattern (file-name-as-directory (getenv "HOME")))
4016                  (setq anything-pattern "~/")))
4017             ((string= match "/./")
4018              (setq anything-pattern
4019                    (with-anything-current-buffer
4020                      (expand-file-name default-directory))))))
4021     (setq anything-ff-default-directory anything-pattern)
4022     ;; For some reasons, i must use here with-current-buffer => mini buffer
4023     ;; and not `anything-set-pattern' that use with-selected-window => mini win.
4024     (with-current-buffer (window-buffer (minibuffer-window))
4025       (delete-minibuffer-contents)
4026       (insert anything-pattern))))
4027
4028 (add-hook 'anything-after-update-hook 'anything-ff-auto-expand-to-home-or-root)
4029
4030 (defun anything-c-point-file-in-dired (file)
4031   "Put point on filename FILE in dired buffer."
4032   (dired (file-name-directory file))
4033   (dired-goto-file file))
4034
4035 (defun anything-create-tramp-name (fname)
4036   "Build filename for `anything-pattern' like /su:: or /sudo::."
4037   (apply #'tramp-make-tramp-file-name
4038          (loop with v = (tramp-dissect-file-name fname)
4039                for i across v collect i)))
4040
4041 (defun* anything-ff-tramp-hostnames (&optional (pattern anything-pattern))
4042   "Get a list of hosts for tramp method found in `anything-pattern'.
4043 Argument PATTERN default to `anything-pattern', it is here only for debugging
4044 purpose."
4045   (when (string-match tramp-file-name-regexp pattern)
4046     (let ((method      (match-string 1 pattern))
4047           (tn          (match-string 0 pattern))
4048           (all-methods (mapcar 'car tramp-methods)))
4049       (anything-fast-remove-dups
4050        (loop for (f . h) in (tramp-get-completion-function method)
4051              append (loop for e in (funcall f (car h))
4052                           for host = (and (consp e) (cadr e))
4053                           when (and host (not (member host all-methods)))
4054                           collect (concat tn host)))
4055        :test 'equal))))
4056
4057 (defun anything-ff-before-action-hook-fn ()
4058   "Exit anything when user try to execute action on an invalid tramp fname."
4059   (let ((cand (anything-get-selection)))
4060     (when (and (anything-file-completion-source-p)
4061                (anything-ff-invalid-tramp-name-p cand) ; Check candidate.
4062                (anything-ff-invalid-tramp-name-p)) ; check anything-pattern.
4063       (error "Error: Unknow file or directory `%s'" cand))))
4064 (add-hook 'anything-before-action-hook 'anything-ff-before-action-hook-fn)
4065
4066 (defun* anything-ff-invalid-tramp-name-p (&optional (pattern anything-pattern))
4067   "Return non--nil when PATTERN is an invalid tramp filename."
4068   (string= (anything-ff-set-pattern pattern)
4069            "Invalid tramp file name"))
4070
4071 (defun anything-ff-set-pattern (pattern)
4072   "Handle tramp filenames in `anything-pattern'."
4073   (let ((methods (mapcar 'car tramp-methods))
4074         (reg "\\`/\\([^[/:]+\\|[^/]+]\\):.*:")
4075         cur-method tramp-name)
4076     (cond ((string= pattern "") "")
4077           ((string-match ".*\\(~?/?[.]\\{1\\}/\\)$" pattern)
4078            (with-anything-current-buffer
4079              (expand-file-name default-directory)))
4080           ((and (string-match ".*\\(~//\\|//\\)$" pattern)
4081                 (not (string-match anything-ff-url-regexp anything-pattern)))
4082            (expand-file-name "/") ; Expand to "/" or "c:/"
4083            )
4084           ((string-match "^~\\|.*/~/$" pattern)
4085            (let* ((home (expand-file-name (getenv "HOME"))))
4086              (replace-match home nil t pattern)))
4087           ;; Match "/method:maybe_hostname:"
4088           ((and (string-match reg pattern)
4089                 (setq cur-method (match-string 1 pattern))
4090                 (member cur-method methods))
4091            (setq tramp-name (anything-create-tramp-name
4092                              (match-string 0 pattern)))
4093            (replace-match tramp-name nil t pattern))
4094           ;; Match "/hostname:"
4095           ((and (string-match  tramp-file-name-regexp pattern)
4096                 (setq cur-method (match-string 1 pattern))
4097                 (and cur-method (not (member cur-method methods))))
4098            (setq tramp-name (anything-create-tramp-name
4099                              (match-string 0 pattern)))
4100            (replace-match tramp-name nil t pattern))
4101           ;; Match "/method:" in this case don't try to connect.
4102           ((and (not (string-match reg pattern))
4103                 (string-match tramp-file-name-regexp pattern)
4104                 (member (match-string 1 pattern) methods))
4105            "Invalid tramp file name")   ; Write in anything-buffer.
4106           ;; PATTERN is a directory, end it with "/".
4107           ;; This will make PATTERN not ending yet with "/"
4108           ;; candidate for `anything-ff-default-directory',
4109           ;; allowing `anything-ff-retrieve-last-expanded' to retrieve it
4110           ;; when descending level.
4111           ((file-directory-p pattern)
4112            (file-name-as-directory pattern))
4113           ;; Return PATTERN unchanged.
4114           (t pattern))))
4115
4116 (defun anything-find-files-get-candidates (&optional require-match)
4117   "Create candidate list for `anything-c-source-find-files'."
4118   (let* ((path          (anything-ff-set-pattern anything-pattern))
4119          (path-name-dir (if (file-directory-p path)
4120                             (file-name-as-directory path)
4121                             (file-name-directory path)))
4122          (tramp-verbose anything-tramp-verbose)) ; No tramp message when 0.
4123     (set-text-properties 0 (length path) nil path)
4124     ;; Don't set now `anything-pattern' if `path' == "Invalid tramp file name"
4125     ;; like that the actual value (e.g /ssh:) is passed to
4126     ;; `anything-ff-tramp-hostnames'.
4127     (unless (string= path "Invalid tramp file name")
4128       (setq anything-pattern (anything-ff-transform-fname-for-completion path)))
4129     (setq anything-ff-default-directory
4130           (if (string= anything-pattern "")
4131               (expand-file-name "/") ; Expand to "/" or "c:/"
4132               ;; If path is an url *default-directory have to be nil.
4133               (unless (or (string-match anything-ff-url-regexp path)
4134                           (string-match ffap-url-regexp path))
4135                 path-name-dir)))
4136     (cond ((string= path "Invalid tramp file name")
4137            (or (anything-ff-tramp-hostnames) ; Hostnames completion.
4138                (prog2
4139                    ;; `anything-pattern' have not been modified yet.
4140                    ;; Set it here to the value of `path' that should be now
4141                    ;; "Invalid tramp file name" and set the candidates list
4142                    ;; to ("Invalid tramp file name") to make `anything-pattern'
4143                    ;; match single candidate "Invalid tramp file name".
4144                    (setq anything-pattern path)
4145                    ;; "Invalid tramp file name" is now printed
4146                    ;; in `anything-buffer'.
4147                    (list path))))
4148           ((or (file-regular-p path)
4149                ;; `ffap-url-regexp' don't match until url is complete.
4150                (string-match anything-ff-url-regexp path)
4151                (and (not (file-exists-p path)) (string-match "/$" path))
4152                (and ffap-url-regexp (string-match ffap-url-regexp path)))
4153            (list path))
4154           ((string= path "") (anything-ff-directory-files "/" t))
4155           ((and (file-directory-p path) (not (file-readable-p path)))
4156            (list (format "Opening directory: access denied, `%s'" path)))
4157           ((file-directory-p path) (anything-ff-directory-files path t))
4158           (t
4159            (append (list path) ; No need to check for must-match.
4160                    (anything-ff-directory-files path-name-dir t))))))
4161
4162 (defun anything-ff-directory-files (directory &optional full)
4163   "List contents of DIRECTORY.
4164 Argument FULL mean absolute path.
4165 It is same as `directory-files' but always returns the
4166 dotted filename '.' and '..' on root directories on Windows
4167 systems."
4168   (setq directory (expand-file-name directory))
4169   (let ((ls (directory-files directory full))
4170         dot dot2 lsdir)
4171     (if (or
4172          ;; A windows volume.
4173          (string-match "^[a-zA-Z]\\{1\\}:/$" directory)
4174          ;; Empty directories on ftp hosts may have no dot dirs.
4175          (and (file-remote-p directory)
4176               (string-match "^/ftp:" directory)))
4177         (progn (setq dot (concat directory "."))
4178                (setq dot2 (concat directory ".."))
4179                (setq lsdir (remove dot2 (remove dot ls)))
4180                (append (list dot dot2) lsdir))
4181         ls)))
4182
4183 (defun anything-ff-transform-fname-for-completion (fname)
4184   "Return FNAME with it's basename modified as a regexp.
4185 e.g foo => f.*o.*o .
4186 If basename contain one or more space or FNAME is a valid directory name
4187 return FNAME unchanged."
4188   (let ((bn (anything-c-basename fname)))
4189     (if (or (not anything-ff-smart-completion)
4190             (string-match "\\s-" bn)
4191             (string-match "/$" fname) ; Allow mkdir.
4192             (file-directory-p fname)
4193             (string-match anything-ff-url-regexp fname))
4194         fname ; Fall back to match-plugin.
4195         (setq bn (if (> (length bn) 2) ; Normal completion on first 2 char.
4196                      (mapconcat 'identity (split-string bn "" t) ".*") bn))
4197         (concat (file-name-directory fname) bn))))
4198
4199 (defun anything-ff-save-history ()
4200   "Store the last value of `anything-ff-default-directory' \
4201 in `anything-ff-history'."
4202   (when (and anything-ff-default-directory
4203              (anything-file-completion-source-p))
4204     (push anything-ff-default-directory anything-ff-history)))
4205 (add-hook 'anything-cleanup-hook 'anything-ff-save-history)
4206
4207 (defun anything-ff-valid-symlink-p (file)
4208   (file-exists-p (file-truename file)))
4209
4210 (defun anything-ff-properties (candidate)
4211   "Show file properties of CANDIDATE in a tooltip or message."
4212   (let ((type       (anything-ff-attributes candidate :type t))
4213         (dired-line (anything-ff-attributes candidate :dired t :human-size t)))
4214     (if (window-system)
4215         (tooltip-show
4216          (concat
4217           (anything-c-basename candidate) "\n"
4218           "Type: " type "\n"
4219           (when (string= type "symlink")
4220             (format "True name: '%s'\n"
4221                     (cond ((string-match "^\.#" (anything-c-basename candidate))
4222                            "Autosave symlink")
4223                           ((anything-ff-valid-symlink-p candidate)
4224                            (file-truename candidate))
4225                           (t "Invalid Symlink"))))
4226           dired-line))
4227         (message dired-line) (sit-for 5))))
4228
4229 ;;;###autoload
4230 (defun anything-ff-properties-persistent ()
4231   "Show properties without quitting anything."
4232   (interactive)
4233   (anything-attrset 'properties-action 'anything-ff-properties)
4234   (anything-execute-persistent-action 'properties-action))
4235
4236 ;;;###autoload
4237 (defun anything-ff-persistent-delete ()
4238   "Delete current candidate without quitting."
4239   (interactive)
4240   (anything-attrset 'quick-delete 'anything-ff-quick-delete)
4241   (anything-execute-persistent-action 'quick-delete))
4242
4243 (defun anything-ff-dot-file-p (file)
4244   "Check if FILE is `.' or `..'."
4245   (member (anything-c-basename file) '("." "..")))
4246
4247 (defun anything-ff-quick-delete (candidate)
4248   "Delete file CANDIDATE without quitting."
4249   (let ((presel (prog1 (save-excursion
4250                          (let (sel)
4251                            (anything-next-line)
4252                            (setq sel (anything-get-selection))
4253                            (if (string= sel candidate)
4254                                (progn (anything-previous-line)
4255                                       (anything-get-selection))
4256                                sel)))
4257                   (anything-mark-current-line))))
4258     (setq presel (if (and anything-ff-transformer-show-only-basename
4259                           (not (anything-ff-dot-file-p presel)))
4260                      (anything-c-basename presel) presel))
4261     (if anything-ff-quick-delete-dont-prompt-for-deletion
4262         (anything-c-delete-file candidate
4263                                 anything-ff-signal-error-on-dot-files)
4264         (save-selected-window
4265           (when (y-or-n-p (format "Really Delete file `%s'? " candidate))
4266             (anything-c-delete-file candidate
4267                                     anything-ff-signal-error-on-dot-files)
4268             (message nil))))
4269     (anything-force-update presel)))
4270
4271 (defun anything-ff-kill-buffer-fname (candidate)
4272   (let* ((buf (get-file-buffer candidate))
4273          (buf-name (buffer-name buf)))
4274     (if buf
4275         (progn
4276           (kill-buffer buf) (message "Buffer `%s' killed" buf))
4277         (message "No buffer to kill"))))
4278
4279 (defun anything-ff-kill-or-find-buffer-fname (candidate)
4280   "Find file CANDIDATE or kill it's buffer if it is visible.
4281 Never kill `anything-current-buffer'.
4282 Never kill buffer modified.
4283 This is called normally on third hit of \
4284 \\<anything-map>\\[anything-execute-persistent-action]
4285 in `anything-find-files-persistent-action'."
4286   (let* ((buf      (get-file-buffer candidate))
4287          (buf-name (buffer-name buf)))
4288     (if (and buf (get-buffer-window buf)
4289              (not (eq buf (get-buffer anything-current-buffer)))
4290              (not (buffer-modified-p buf)))
4291         (progn
4292           (kill-buffer buf) (message "Buffer `%s' killed" buf-name))
4293         (find-file candidate))))
4294
4295 ;;;###autoload
4296 (defun anything-ff-run-kill-buffer-persistent ()
4297   "Execute `anything-ff-kill-buffer-fname' whitout quitting."
4298   (interactive)
4299   (when (anything-file-completion-source-p)
4300     (anything-attrset 'kill-buffer-fname 'anything-ff-kill-buffer-fname)
4301     (anything-execute-persistent-action 'kill-buffer-fname)))
4302
4303 (defun anything-ff-human-size (size)
4304   "Return a string showing SIZE of a file in human readable form.
4305 SIZE can be an integer or a float depending it's value.
4306 `file-attributes' will take care of that to avoid overflow error.
4307 KBSIZE if a floating point number, default value is 1024.0."
4308   (let ((M (cons "M" (/ size (expt anything-ff-default-kbsize 2))))
4309         (G (cons "G" (/ size (expt anything-ff-default-kbsize 3))))
4310         (K (cons "K" (/ size anything-ff-default-kbsize)))
4311         (B (cons "B" size)))
4312     (loop with result = B
4313           for (a . b) in
4314           (loop for (x . y) in (list M G K B)
4315                 unless (< y 1) collect (cons x y))
4316           when (< b (cdr result)) do (setq result (cons a b))
4317           finally return (if (string= (car result) "B")
4318                              (format "%s" size)
4319                              (format "%.1f%s" (cdr result) (car result))))))
4320
4321 (defun* anything-ff-attributes
4322     (file &key type links uid gid access-time modif-time
4323           status size mode gid-change inode device-num dired human-size)
4324   "Easy interface for `file-attributes'."
4325   (let ((all (destructuring-bind
4326                    (type links uid gid access-time modif-time
4327                          status size mode gid-change inode device-num)
4328                  (file-attributes file 'string)
4329                (list :type        type
4330                      :links       links
4331                      :uid         uid
4332                      :gid         gid
4333                      :access-time access-time
4334                      :modif-time  modif-time
4335                      :status      status
4336                      :size        size
4337                      :mode        mode
4338                      :gid-change  gid-change
4339                      :inode       inode
4340                      :device-num  device-num))))
4341     (cond (type
4342            (let ((result (getf all :type)))
4343              (cond ((stringp result)
4344                     "symlink")
4345                    (result "directory")
4346                    (t "file"))))
4347           (links (getf all :links))
4348           (uid   (getf all :uid))
4349           (gid   (getf all :gid))
4350           (access-time
4351            (format-time-string "%Y-%m-%d %R" (getf all :access-time)))
4352           (modif-time
4353            (format-time-string "%Y-%m-%d %R" (getf all :modif-time)))
4354           (status
4355            (format-time-string "%Y-%m-%d %R" (getf all :status)))
4356           (size (if human-size (anything-ff-human-size (getf all :size))
4357                     (getf all :size)))
4358           (mode (getf all :mode))
4359           (gid-change (getf all :gid-change))
4360           (inode (getf all :inode))
4361           (device-num (getf all :device-num))
4362           (dired
4363            (concat
4364             (getf all :mode) " "
4365             (number-to-string (getf all :links)) " "
4366             (getf all :uid) ":"
4367             (getf all :gid) " "
4368             (if human-size (anything-ff-human-size (getf all :size))
4369                 (int-to-string (getf all :size))) " "
4370                 (format-time-string "%Y-%m-%d %R" (getf all :modif-time))))
4371           (t all))))
4372
4373 (defun anything-ff-prefix-filename (fname &optional file-or-symlinkp new-file)
4374   "Return filename FNAME maybe prefixed with [?] or [@].
4375 If FILE-OR-SYMLINKP is non--nil this mean we assume FNAME is an
4376 existing filename or valid symlink and there is no need to test it.
4377 NEW-FILE when non--nil mean FNAME is a non existing file and
4378 return FNAME prefixed with [?]."
4379   (let* ((prefix-new (propertize
4380                       " " 'display
4381                       (propertize "[?]" 'face 'anything-ff-prefix)))
4382          (prefix-url (propertize
4383                       " " 'display
4384                       (propertize "[@]" 'face 'anything-ff-prefix))))
4385     (cond ((or file-or-symlinkp (file-exists-p fname)) fname)
4386           ((or (string-match anything-ff-url-regexp fname)
4387                (string-match ffap-url-regexp fname))
4388            (concat prefix-url " " fname))
4389           ((or new-file (not (file-exists-p fname)))
4390            (concat prefix-new " " fname)))))
4391
4392 (defun anything-c-find-files-transformer (files sources)
4393   "Transformer for `anything-c-source-find-files'.
4394 Tramp files are not highlighted unless `anything-ff-tramp-not-fancy'
4395 is non--nil."
4396   (if (and (string-match tramp-file-name-regexp anything-pattern)
4397            anything-ff-tramp-not-fancy)
4398       (if anything-ff-transformer-show-only-basename
4399           (loop for i in files collect
4400                 (if (string-match "[.]\\{1,2\\}$" i)
4401                     i (cons (anything-c-basename i) i)))
4402           files)
4403       (anything-ff-highlight-files files sources)))
4404
4405 (defun anything-ff-highlight-files (files sources)
4406   "Candidate transformer for `anything-c-source-find-files' without icons."
4407   (loop for i in files
4408         for disp = (if (and anything-ff-transformer-show-only-basename
4409                             (not (string-match "[.]\\{1,2\\}$" i))
4410                             (not (string-match ffap-url-regexp i))
4411                             (not (string-match anything-ff-url-regexp i)))
4412                        (anything-c-basename i) i)
4413         collect
4414         (cond ((and (stringp (car (file-attributes i)))
4415                     (not (anything-ff-valid-symlink-p i))
4416                     (not (string-match "^\.#" (anything-c-basename i))))
4417                (cons (anything-ff-prefix-filename
4418                       (propertize disp 'face 'anything-ff-invalid-symlink) t)
4419                      i))
4420               ((stringp (car (file-attributes i)))
4421                (cons (anything-ff-prefix-filename
4422                       (propertize disp 'face 'anything-ff-symlink) t)
4423                      i))
4424               ((eq t (car (file-attributes i)))
4425                (cons (anything-ff-prefix-filename
4426                       (propertize disp 'face 'anything-ff-directory) t)
4427                      i))
4428               ((file-executable-p i)
4429                (cons (anything-ff-prefix-filename
4430                       (propertize disp 'face 'anything-ff-executable) t)
4431                      i))
4432               ((file-exists-p i)
4433                (cons (anything-ff-prefix-filename
4434                       (propertize disp 'face 'anything-ff-file) t)
4435                      i))
4436               (t
4437                (cons (anything-ff-prefix-filename
4438                       (propertize disp 'face 'anything-ff-file) nil 'new-file)
4439                      i)))))
4440
4441 (defun anything-find-files-action-transformer (actions candidate)
4442   "Action transformer for `anything-c-source-find-files'."
4443   (cond ((with-anything-current-buffer
4444            (eq major-mode 'message-mode))
4445          (append (subseq actions 0 4)
4446                  '(("Gnus attach file(s)" . anything-ff-gnus-attach-files))
4447                  (subseq actions 4)))
4448         ((string-match (image-file-name-regexp) candidate)
4449          (append (subseq actions 0 4)
4450                  '(("Rotate image right `M-r'" . anything-ff-rotate-image-right)
4451                    ("Rotate image left `M-l'" . anything-ff-rotate-image-left))
4452                  (subseq actions 4)))
4453         ((string-match "\.el$" (anything-aif (anything-marked-candidates)
4454                                    (car it) candidate))
4455          (append (subseq actions 0 4)
4456                  '(("Byte compile lisp file(s) `M-B, C-u to load'"
4457                     . anything-find-files-byte-compile)
4458                    ("Load File(s) `M-L'" . anything-find-files-load-files))
4459                  (subseq actions 4)))
4460         ((and (string-match "\.html?$" candidate)
4461               (file-exists-p candidate))
4462          (append (subseq actions 0 4)
4463                  '(("Browse url file" . browse-url-of-file))
4464                  (subseq actions 5)))
4465         ((or (string= (file-name-extension candidate) "pdf")
4466              (string= (file-name-extension candidate) "PDF"))
4467          (append (subseq actions 0 4)
4468                  '(("Pdfgrep File(s)" . anything-ff-pdfgrep))
4469                  (subseq actions 5)))
4470         (t actions)))
4471
4472 (defun anything-ff-gnus-attach-files (candidate)
4473   "Run `gnus-dired-attach' on `anything-marked-candidates' or CANDIDATE."
4474   (let ((flist (anything-marked-candidates)))
4475     (gnus-dired-attach flist)))
4476
4477 (defun anything-ff-rotate-current-image-1 (file &optional num-arg)
4478   "Rotate current image at NUM-ARG degrees.
4479 This is a destructive operation on FILE made by external tool mogrify."
4480   (declare (special image-dired-display-image-buffer))
4481   (setq file (file-truename file)) ; For symlinked images.
4482   ;; When FILE is not an image-file, do nothing.
4483   (when (string-match (image-file-name-regexp) file)
4484     (if (executable-find "mogrify")
4485         (progn
4486           (shell-command (format "mogrify -rotate %s %s"
4487                                  (or num-arg 90)
4488                                  (shell-quote-argument file)))
4489           (when (buffer-live-p image-dired-display-image-buffer)
4490             (kill-buffer image-dired-display-image-buffer))
4491           (image-dired-display-image file)
4492           (message nil)
4493           (display-buffer (get-buffer image-dired-display-image-buffer)))
4494         (error "mogrify not found"))))
4495
4496 (defun anything-ff-rotate-image-left (candidate)
4497   "Rotate image file CANDIDATE left.
4498 This affect directly file CANDIDATE."
4499   (anything-ff-rotate-current-image-1 candidate -90))
4500
4501 (defun anything-ff-rotate-image-right (candidate)
4502   "Rotate image file CANDIDATE right.
4503 This affect directly file CANDIDATE."
4504   (anything-ff-rotate-current-image-1 candidate))
4505
4506 (defun anything-ff-rotate-left-persistent ()
4507   "Rotate image left without quitting anything."
4508   (interactive)
4509   (anything-attrset 'image-action1 'anything-ff-rotate-image-left)
4510   (anything-execute-persistent-action 'image-action1))
4511
4512 (defun anything-ff-rotate-right-persistent ()
4513   "Rotate image right without quitting anything."
4514   (interactive)
4515   (anything-attrset 'image-action2 'anything-ff-rotate-image-right)
4516   (anything-execute-persistent-action 'image-action2))
4517
4518 (defun anything-ff-exif-data (candidate)
4519   "Extract exif data from file CANDIDATE using `anything-ff-exif-data-program'."
4520   (if (and anything-ff-exif-data-program
4521            (executable-find anything-ff-exif-data-program))
4522       (shell-command-to-string (format "%s %s %s"
4523                                        anything-ff-exif-data-program
4524                                        anything-ff-exif-data-program-args
4525                                        candidate))
4526       (format "No program %s found to extract exif"
4527               anything-ff-exif-data-program)))
4528
4529 (defun anything-find-files-persistent-action (candidate)
4530   "Open subtree CANDIDATE without quitting anything.
4531 If CANDIDATE is not a directory expand CANDIDATE filename.
4532 If CANDIDATE is alone, open file CANDIDATE filename.
4533 That's mean:
4534 First hit on C-z expand CANDIDATE second hit open file.
4535 If a prefix arg is given or `anything-follow-mode' is on open file."
4536   (let ((follow        (buffer-local-value
4537                         'anything-follow-mode
4538                         (get-buffer-create anything-buffer)))
4539         (new-pattern   (anything-get-selection))
4540         (num-lines-buf (with-current-buffer anything-buffer
4541                          (count-lines (point-min) (point-max)))))
4542     (flet ((insert-in-minibuffer (fname)
4543              (with-selected-window (minibuffer-window)
4544                (unless follow
4545                  (delete-minibuffer-contents)
4546                  (set-text-properties 0 (length fname) nil fname)
4547                  (insert fname)))))
4548       (cond ((and (string= (anything-ff-set-pattern anything-pattern)
4549                            "Invalid tramp file name")
4550                   (string-match tramp-file-name-regexp candidate))
4551              ;; First hit insert hostname and
4552              ;; second hit insert ":" and expand.
4553              (if (string= candidate anything-pattern)
4554                  (insert-in-minibuffer (concat candidate ":"))
4555                  (insert-in-minibuffer candidate)))
4556             (;; A symlink directory, expand it's truename.
4557              (and (file-directory-p candidate) (file-symlink-p candidate))
4558              (insert-in-minibuffer (file-name-as-directory
4559                                     (file-truename
4560                                      (expand-file-name candidate)))))
4561             ;; A directory, open it.
4562             ((file-directory-p candidate)
4563              (when (string= (anything-c-basename candidate) "..")
4564                (setq anything-ff-last-expanded anything-ff-default-directory))
4565              (insert-in-minibuffer (file-name-as-directory
4566                                     (expand-file-name candidate))))
4567             ;; A symlink file, expand to it's true name. (first hit)
4568             ((and (file-symlink-p candidate) (not current-prefix-arg) (not follow))
4569              (insert-in-minibuffer (file-truename candidate)))
4570             ;; A regular file, expand it, (first hit)
4571             ((and (>= num-lines-buf 3) (not current-prefix-arg) (not follow))
4572              (insert-in-minibuffer new-pattern))
4573             ;; An image file and it is the second hit on C-z,
4574             ;; show the file in `image-dired'.
4575             ((string-match (image-file-name-regexp) candidate)
4576              (when (buffer-live-p image-dired-display-image-buffer)
4577                (kill-buffer image-dired-display-image-buffer))
4578              (image-dired-display-image candidate)
4579              (message nil)
4580              (anything-c-switch-to-buffer image-dired-display-image-buffer)
4581              (with-current-buffer image-dired-display-image-buffer
4582                (let ((exif-data (anything-ff-exif-data candidate)))
4583                  (image-dired-update-property 'help-echo exif-data))))
4584             ;; Allow browsing archive on avfs fs.
4585             ;; Assume volume is already mounted with mountavfs.
4586             ((and anything-ff-avfs-directory
4587                   (string-match
4588                    (regexp-quote (expand-file-name anything-ff-avfs-directory))
4589                    (file-name-directory candidate))
4590                   (anything-ff-file-compressed-p candidate))
4591              (insert-in-minibuffer (concat candidate "#")))
4592             ;; On second hit we open file.
4593             ;; On Third hit we kill it's buffer maybe.
4594             (t
4595              (anything-ff-kill-or-find-buffer-fname candidate))))))
4596
4597 (defun anything-ff-file-compressed-p (candidate)
4598   "Whether CANDIDATE is a compressed file or not."
4599   (member (file-name-extension candidate)
4600           anything-ff-file-compressed-list))
4601
4602 (defun anything-c-insert-file-name-completion-at-point (candidate)
4603   "Insert file name completion at point."
4604   (with-anything-current-buffer
4605     (if buffer-read-only
4606         (error "Error: Buffer `%s' is read-only" (buffer-name))
4607         (let* ((end         (point))
4608                (guess       (substring-no-properties (thing-at-point 'filename)))
4609                (beg         (- (point) (length guess)))
4610                (full-path-p (or (string-match-p (concat "^" (getenv "HOME")) guess)
4611                                 (string-match-p "^[^\~]" guess))))
4612           (set-text-properties 0 (length candidate) nil candidate)
4613           (if (and guess (not (string= guess ""))
4614                    (string-match-p "^~\\|/.*" guess))
4615               (progn
4616                 (delete-region beg end)
4617                 (insert (if full-path-p
4618                             (expand-file-name candidate)
4619                             (abbreviate-file-name candidate))))
4620               (error "Aborting completion: No valid file name at point"))))))
4621
4622 (defun* anything-find-files-history (&key (comp-read t))
4623   "The `anything-find-files' history.
4624 Show the first `anything-ff-history-max-length' elements of
4625 `anything-ff-history' in an `anything-comp-read'."
4626   (let ((history (when anything-ff-history
4627                    (anything-fast-remove-dups anything-ff-history
4628                                               :test 'equal))))
4629     (when history
4630       (setq anything-ff-history
4631             (if (>= (length history) anything-ff-history-max-length)
4632                 (subseq history 0 anything-ff-history-max-length)
4633                 history))
4634       (if comp-read
4635           (anything-comp-read
4636            "Switch to Directory: "
4637            anything-ff-history
4638            :name "Anything Find Files History"
4639            :must-match t)
4640           anything-ff-history))))
4641
4642 (defun anything-find-files-1 (fname &optional preselect)
4643   "Find FNAME with `anything' completion.
4644 Like `find-file' but with `anything' support.
4645 Use it for non--interactive calls of `anything-find-files'."
4646   (when (get-buffer anything-action-buffer)
4647     (kill-buffer anything-action-buffer))
4648   (let ((anything-mp-highlight-delay nil)
4649         ;; Be sure we don't erase the precedent minibuffer if some.
4650         (anything-ff-auto-update-initial-value
4651          (and anything-ff-auto-update-initial-value
4652               (not (minibuffer-window-active-p (minibuffer-window)))))
4653         anything-samewindow)
4654     (anything :sources 'anything-c-source-find-files
4655               :input fname
4656               :preselect preselect
4657               :keymap anything-find-files-map
4658               :prompt "Find Files or Url: "
4659               :buffer "*Anything Find Files*")))
4660
4661
4662 (defun anything-find-files-initial-input (&optional input)
4663   "Return INPUT if present, otherwise try to guess it."
4664   (or (and input (or (and (file-remote-p input) input)
4665                      (expand-file-name input)))
4666       (anything-find-files-input
4667        (ffap-guesser)
4668        (thing-at-point 'filename))))
4669
4670 (defun anything-find-files-input (fap tap)
4671   "Default input of `anything-find-files'."
4672   (let* ((def-dir (anything-c-current-directory))
4673          (lib     (anything-find-library-at-point))
4674          (url     (anything-ff-find-url-at-point))
4675          (remp    (and fap (file-remote-p fap)))
4676          (file-p  (and (not remp)
4677                        fap
4678                        (not (string= fap ""))
4679                        (file-exists-p fap)
4680                        tap (not (string= tap ""))
4681                        (file-exists-p
4682                         (file-name-directory (expand-file-name tap def-dir))))))
4683     (cond (lib) ; e.g we are inside a require sexp.
4684           (url) ; String at point is an hyperlink.
4685           (remp fap)
4686           (file-p (expand-file-name tap def-dir))
4687           (t (and (not (string= fap "")) fap)))))
4688
4689 (defun anything-c-current-directory ()
4690   "Return current-directory name at point.
4691 Useful in dired buffers when there is inserted subdirs."
4692   (if (eq major-mode 'dired-mode)
4693       (dired-current-directory)
4694       default-directory))
4695
4696 (defun anything-ff-find-url-at-point ()
4697   "Try to find link to an url in text-property at point."
4698   (let* ((he      (get-text-property (point) 'help-echo))
4699          (ov      (overlays-at (point)))
4700          (ov-he   (and ov (overlay-get
4701                            (car (overlays-at (point))) 'help-echo)))
4702          (w3m-l   (get-text-property (point) 'w3m-href-anchor))
4703          (nt-prop (get-text-property (point) 'nt-link)))
4704     ;; Org link.
4705     (when (and (stringp he) (string-match "^LINK: " he))
4706       (setq he (replace-match "" t t he)))
4707     (loop for i in (list he ov-he w3m-l nt-prop)
4708           thereis (and (stringp i) (string-match ffap-url-regexp i) i))))
4709
4710 (defun anything-find-library-at-point ()
4711   "Try to find library path at point.
4712 Find inside `require' and `declare-function' sexp."
4713   (require 'find-func)
4714   (let* ((beg-sexp (save-excursion (search-backward "(" (point-at-bol) t)))
4715          (end-sexp (save-excursion (search-forward ")" (point-at-eol) t)))
4716          (sexp     (and beg-sexp end-sexp
4717                         (buffer-substring-no-properties
4718                          (1+ beg-sexp) (1- end-sexp)))))
4719     (ignore-errors
4720       (cond ((and sexp (string-match "require \'.+[^)]" sexp))
4721              (find-library-name
4722               (replace-regexp-in-string
4723                "'\\|\)\\|\(" ""
4724                ;; If require use third arg, ignore it,
4725                ;; always use library path found in `load-path'.
4726                (second (split-string (match-string 0 sexp))))))
4727             ((and sexp (string-match-p "^declare-function" sexp))
4728              (find-library-name
4729               (replace-regexp-in-string
4730                "\"\\|ext:" ""
4731                (third (split-string sexp)))))
4732             (t nil)))))
4733
4734 ;;; Anything completion for `write-file'.==> C-x C-w
4735 (defvar anything-c-source-write-file
4736   `((name . "Write File")
4737     (header-name . (lambda (name)
4738                      (concat name anything-c-find-files-doc-header)))
4739     ;; It is needed for filenames with capital letters
4740     (disable-shortcuts)
4741     (candidates . anything-find-files-get-candidates)
4742     (filtered-candidate-transformer anything-c-find-files-transformer)
4743     (persistent-action . anything-find-files-persistent-action)
4744     (persistent-help . "Expand Candidate")
4745     (volatile)
4746     (action .
4747             (("Write File" . (lambda (candidate)
4748                                (write-file candidate 'confirm)))))))
4749
4750 ;;; Anything completion for `insert-file'.==> C-x i
4751 (defvar anything-c-source-insert-file
4752   `((name . "Insert File")
4753     (header-name . (lambda (name)
4754                      (concat name anything-c-find-files-doc-header)))
4755     ;; It is needed for filenames with capital letters
4756     (disable-shortcuts)
4757     (candidates . anything-find-files-get-candidates)
4758     (filtered-candidate-transformer anything-c-find-files-transformer)
4759     (persistent-action . anything-find-files-persistent-action)
4760     (persistent-help . "Expand Candidate")
4761     (volatile)
4762     (action .
4763             (("Insert File" . (lambda (candidate)
4764                                 (when (y-or-n-p (format "Really insert %s in %s "
4765                                                         candidate anything-current-buffer))
4766                                   (insert-file-contents candidate))))))))
4767
4768 ;;; Anything completion for copy, rename and (rel)sym/hard/link files from dired.
4769 (defvar anything-c-source-copy-files
4770   `((name . "Copy Files")
4771     (header-name . (lambda (name)
4772                      (concat name anything-c-find-files-doc-header)))
4773     ;; It is needed for filenames with capital letters
4774     (disable-shortcuts)
4775     (candidates . anything-find-files-get-candidates)
4776     (filtered-candidate-transformer anything-c-find-files-transformer)
4777     (persistent-action . anything-find-files-persistent-action)
4778     (persistent-help . "Expand Candidate")
4779     (volatile)
4780     (action .
4781             (("Copy File"
4782               . (lambda (candidate)
4783                   (anything-dired-action candidate :action 'copy)))
4784              ("Copy and Follow"
4785               . (lambda (candidate)
4786                   (anything-dired-action candidate :action 'copy :follow t)))))))
4787
4788
4789 (defvar  anything-c-source-rename-files
4790   `((name . "Rename Files")
4791     (header-name . (lambda (name)
4792                      (concat name anything-c-find-files-doc-header)))
4793     ;; It is needed for filenames with capital letters
4794     (disable-shortcuts)
4795     (candidates . anything-find-files-get-candidates)
4796     (filtered-candidate-transformer anything-c-find-files-transformer)
4797     (persistent-action . anything-find-files-persistent-action)
4798     (persistent-help . "Expand Candidate")
4799     (volatile)
4800     (action .
4801             (("Rename File"
4802               . (lambda (candidate)
4803                   (anything-dired-action candidate :action 'rename)))
4804              ("Rename and Follow"
4805               . (lambda (candidate)
4806                   (anything-dired-action candidate :action 'rename :follow t)))))))
4807
4808 (defvar anything-c-source-symlink-files
4809   `((name . "Symlink Files")
4810     (header-name . (lambda (name)
4811                      (concat name anything-c-find-files-doc-header)))
4812     ;; It is needed for filenames with capital letters
4813     (disable-shortcuts)
4814     (candidates . anything-find-files-get-candidates)
4815     (filtered-candidate-transformer anything-c-find-files-transformer)
4816     (persistent-action . anything-find-files-persistent-action)
4817     (persistent-help . "Expand Candidate")
4818     (volatile)
4819     (action
4820      . (("Symlink File"
4821          . (lambda (candidate)
4822              (anything-dired-action candidate :action 'symlink)))
4823         ("RelSymlink File"
4824          . (lambda (candidate)
4825              (anything-dired-action candidate :action 'relsymlink)))))))
4826
4827
4828 (defvar anything-c-source-hardlink-files
4829   `((name . "Hardlink Files")
4830     (header-name . (lambda (name)
4831                      (concat name anything-c-find-files-doc-header)))
4832     ;; It is needed for filenames with capital letters
4833     (disable-shortcuts)
4834     (candidates . anything-find-files-get-candidates)
4835     (filtered-candidate-transformer anything-c-find-files-transformer)
4836     (persistent-action . anything-find-files-persistent-action)
4837     (persistent-help . "Expand Candidate")
4838     (volatile)
4839     (action
4840      . (("Hardlink File"
4841          . (lambda (candidate)
4842              (anything-dired-action candidate :action 'hardlink)))))))
4843
4844 (defun* anything-dired-action (candidate &key action follow (files (dired-get-marked-files)))
4845   "Copy, rename or symlink file at point or marked files in dired to CANDIDATE.
4846 ACTION is a key that can be one of 'copy, 'rename, 'symlink, 'relsymlink."
4847   (when (get-buffer dired-log-buffer) (kill-buffer dired-log-buffer))
4848   (let ((fn     (case action
4849                   ('copy       'dired-copy-file)
4850                   ('rename     'dired-rename-file)
4851                   ('symlink    'make-symbolic-link)
4852                   ('relsymlink 'dired-make-relative-symlink)
4853                   ('hardlink   'dired-hardlink)))
4854         (marker (case action
4855                   ((copy rename)   dired-keep-marker-copy)
4856                   ('symlink        dired-keep-marker-symlink)
4857                   ('relsymlink     dired-keep-marker-relsymlink)
4858                   ('hardlink       dired-keep-marker-hardlink)))
4859         (dirflag (and (= (length files) 1)
4860                       (file-directory-p (car files))
4861                       (not (file-directory-p candidate)))))
4862     (dired-create-files
4863      fn (symbol-name action) files
4864      ;; CANDIDATE is the destination.
4865      (if (file-directory-p candidate)
4866          ;; When CANDIDATE is a directory, build file-name in this directory.
4867          ;; Else we use CANDIDATE.
4868          #'(lambda (from)
4869              (expand-file-name (file-name-nondirectory from) candidate))
4870          #'(lambda (from) candidate))
4871      marker)
4872     (push (file-name-as-directory
4873            (if (file-directory-p candidate)
4874                (expand-file-name candidate)
4875                (file-name-directory candidate)))
4876            anything-ff-history)
4877     (when (and follow (not (get-buffer dired-log-buffer)))
4878       (let ((target (directory-file-name candidate)))
4879         (unwind-protect
4880              (progn
4881                (setq anything-ff-cand-to-mark
4882                      (anything-get-dest-fnames-from-list files candidate dirflag))
4883                (if (and dirflag (eq action 'rename))
4884                    (anything-find-files-1 (file-name-directory target)
4885                                           (if anything-ff-transformer-show-only-basename
4886                                               (anything-c-basename target) target))
4887                    (anything-find-files-1 (expand-file-name candidate))))
4888           (setq anything-ff-cand-to-mark nil))))))
4889
4890 (defun anything-c-basename (fname &optional ext)
4891   "Print FNAME  with any  leading directory  components removed.
4892 If specified, also remove filename extension EXT."
4893   (if (and ext (or (string= (file-name-extension fname) ext)
4894                    (string= (file-name-extension fname t) ext))
4895            (not (file-directory-p fname)))
4896       (file-name-sans-extension (file-name-nondirectory fname))
4897       (file-name-nondirectory (directory-file-name fname))))
4898
4899 (defun anything-get-dest-fnames-from-list (flist dest-cand rename-dir-flag)
4900   "Transform filenames of FLIST to abs of DEST-CAND.
4901 If RENAME-DIR-FLAG is non--nil collect the `directory-file-name' of transformed
4902 members of FLIST."
4903   ;; At this point files have been renamed/copied at destination.
4904   ;; That's mean DEST-CAND exists.
4905   (loop
4906         with dest = (expand-file-name dest-cand)
4907         for src in flist
4908         for basename-src = (anything-c-basename src)
4909         for fname = (cond (rename-dir-flag (directory-file-name dest))
4910                           ((file-directory-p dest)
4911                            (concat (file-name-as-directory dest) basename-src))
4912                           (t dest))
4913         when (file-exists-p fname)
4914         collect fname into tmp-list
4915         finally return (sort tmp-list 'string<)))
4916
4917 (defun anything-ff-maybe-mark-candidates ()
4918   "Mark all candidates of list `anything-ff-cand-to-mark'."
4919   (when (and (string= (assoc-default 'name (anything-get-current-source))
4920                       (assoc-default 'name anything-c-source-find-files))
4921              anything-ff-cand-to-mark)
4922     (with-anything-window
4923       (while anything-ff-cand-to-mark
4924         (if (string= (car anything-ff-cand-to-mark) (anything-get-selection))
4925             (progn
4926               (anything-make-visible-mark)
4927               (anything-next-line)
4928               (setq anything-ff-cand-to-mark (cdr anything-ff-cand-to-mark)))
4929             (anything-next-line)))
4930       (unless (anything-this-visible-mark)
4931         (anything-prev-visible-mark)))))
4932
4933 (add-hook 'anything-after-update-hook #'anything-ff-maybe-mark-candidates)
4934
4935 (defun* anything-dired-do-action-on-file (&key action)
4936   (let* ((files     (dired-get-marked-files))
4937          (len       (length files))
4938          (fname     (if (> len 1)
4939                         (format "* %d Files" len)
4940                         (car files)))
4941          (source    (case action
4942                       ('copy     'anything-c-source-copy-files)
4943                       ('rename   'anything-c-source-rename-files)
4944                       ('symlink  'anything-c-source-symlink-files)
4945                       ('hardlink 'anything-c-source-hardlink-files)))
4946          (prompt-fm (case action
4947                       ('copy     "Copy %s to: ")
4948                       ('rename   "Rename %s to: ")
4949                       ('symlink  "Symlink %s to: ")
4950                       ('hardlink "Hardlink %s to: ")))
4951          (buffer    (case action
4952                       ('copy     "*Anything Copy Files*")
4953                       ('rename   "*Anything Rename Files*")
4954                       ('symlink  "*Anything Symlink Files*")
4955                       ('hardlink "*Anything Hardlink Files*")))
4956          (anything-mp-highlight-delay     nil))
4957     (anything :sources source
4958               :input (or (dired-dwim-target-directory)
4959                          (expand-file-name (anything-c-current-directory)))
4960               :preselect (dired-get-filename)
4961               :prompt (format prompt-fm fname)
4962               :keymap anything-c-read-file-map
4963               :buffer buffer)))
4964
4965 ;;;###autoload
4966 (define-minor-mode anything-dired-mode ()
4967   "Enable anything completion in Dired functions.
4968 Bindings affected are C, R, S, H.
4969 This is deprecated for Emacs24+ users, use `ac-mode' instead."
4970   :group 'anything-config
4971   :global t
4972   (if anything-dired-mode
4973       (progn
4974         (substitute-key-definition
4975          'dired-do-copy 'anything-dired-copy-file dired-mode-map)
4976         (substitute-key-definition
4977          'dired-do-rename 'anything-dired-rename-file dired-mode-map)
4978         (substitute-key-definition
4979          'dired-do-symlink 'anything-dired-symlink-file dired-mode-map)
4980         (substitute-key-definition
4981          'dired-do-hardlink 'anything-dired-hardlink-file dired-mode-map))
4982       (substitute-key-definition
4983        'anything-dired-copy-file 'dired-do-copy dired-mode-map)
4984       (substitute-key-definition
4985        'anything-dired-rename-file 'dired-do-rename dired-mode-map)
4986       (substitute-key-definition
4987        'anything-dired-symlink-file 'dired-do-symlink dired-mode-map)
4988       (substitute-key-definition
4989        'anything-dired-hardlink-file 'dired-do-hardlink dired-mode-map)))
4990
4991 (defalias 'anything-dired-bindings 'anything-dired-mode)
4992
4993 (defun* anything-c-read-file-name
4994     (prompt
4995      &key
4996      (name "Read File Name")
4997      (initial-input (expand-file-name default-directory))
4998      (buffer "*Anything Completions*")
4999      test
5000      (preselect nil)
5001      (history nil)
5002      must-match
5003      (marked-candidates nil)
5004      (alistp t)
5005      (persistent-action 'anything-find-files-persistent-action)
5006      (persistent-help "Hit1 Expand Candidate, Hit2 or (C-u) Find file"))
5007   "Read a file name with anything completion.
5008 It is anything `read-file-name' emulation.
5009
5010 Argument PROMPT is the default prompt to use.
5011
5012 Keys description:
5013
5014 - NAME: Source name, default to \"Read File Name\".
5015
5016 - INITIAL-INPUT: Where to start read file name, default to `default-directory'.
5017
5018 - BUFFER: `anything-buffer' name default to \"*Anything Completions*\".
5019
5020 - TEST: A predicate called with one arg 'candidate'.
5021
5022 - PRESELECT: anything preselection.
5023
5024 - HISTORY: Display HISTORY in a special source.
5025
5026 - MUST-MATCH: Can be 'confirm, nil, or t.
5027
5028 - MARKED-CANDIDATES: When non--nil return a list of marked candidates.
5029
5030 - ALISTP: Don't use `all-completions' in history (take effect only on history).
5031
5032 - PERSISTENT-ACTION: a persistent action function.
5033
5034 - PERSISTENT-HELP: persistent help message."
5035   (when (get-buffer anything-action-buffer)
5036     (kill-buffer anything-action-buffer))
5037
5038   ;; Assume completion have been already required,
5039   ;; so always use 'confirm.
5040   (when (eq must-match 'confirm-after-completion)
5041     (setq must-match 'confirm))
5042
5043   (flet ((action-fn (candidate)
5044            (if marked-candidates
5045                (anything-marked-candidates)
5046                (identity candidate))))
5047
5048     (let* ((anything-mp-highlight-delay nil)
5049            ;; Be sure we don't erase the underlying minibuffer if some.
5050            (anything-ff-auto-update-initial-value
5051             (and anything-ff-auto-update-initial-value
5052                  (not (minibuffer-window-active-p (minibuffer-window)))))
5053            anything-same-window
5054            (hist (and history (anything-comp-read-get-candidates
5055                                history nil nil alistp)))
5056            (minibuffer-completion-confirm must-match)
5057            (must-match-map (when must-match
5058                              (let ((map (make-sparse-keymap)))
5059                                (define-key map (kbd "RET")
5060                                  'anything-confirm-and-exit-minibuffer)
5061                                map)))
5062            (anything-map (if must-match-map
5063                              (make-composed-keymap
5064                               must-match-map anything-c-read-file-map)
5065                              anything-c-read-file-map)))
5066
5067       (or (anything
5068            :sources
5069            `(((name . ,(format "%s History" name))
5070               (header-name . (lambda (name)
5071                                (concat name anything-c-find-files-doc-header)))
5072               (disable-shortcuts)
5073               (mode-line . anything-read-file-name-mode-line-string)
5074               (candidates . hist)
5075               (persistent-action . ,persistent-action)
5076               (persistent-help . ,persistent-help)
5077               (action . ,'action-fn))
5078              ((name . ,name)
5079               (header-name . (lambda (name)
5080                                (concat name anything-c-find-files-doc-header)))
5081               (init . (lambda ()
5082                         (setq anything-ff-auto-update-flag
5083                               anything-ff-auto-update-initial-value)))
5084               ;; It is needed for filenames with capital letters
5085               (disable-shortcuts)
5086               (mode-line . anything-read-file-name-mode-line-string)
5087               (candidates
5088                . (lambda ()
5089                    (if test
5090                        (loop with hn = (anything-ff-tramp-hostnames)
5091                              for i in (anything-find-files-get-candidates
5092                                        must-match)
5093                              when (or (member i hn)            ; A tramp host
5094                                       (funcall test i)         ; Test ok
5095                                       (not (file-exists-p i))) ; A new file.
5096                              collect i)
5097                        (anything-find-files-get-candidates must-match))))
5098               (filtered-candidate-transformer anything-c-find-files-transformer)
5099               (persistent-action . ,persistent-action)
5100               (candidate-number-limit . 9999)
5101               (toggle-auto-update . anything-ff-toggle-auto-update)
5102               (persistent-help . ,persistent-help)
5103               (volatile)
5104               (action . ,'action-fn)))
5105            :input initial-input
5106            :prompt prompt
5107            :resume 'noresume
5108            :buffer buffer
5109            :preselect preselect)
5110           (when (and (not (string= anything-pattern ""))
5111                      (eq anything-exit-status 0)
5112                      (eq must-match 'confirm))
5113             (identity anything-pattern))
5114           (keyboard-quit)))))
5115
5116 \f
5117 ;;; File Cache
5118 (defvar anything-c-file-cache-initialized-p nil)
5119
5120 (defvar anything-c-file-cache-files nil)
5121
5122 (defvar anything-c-source-file-cache
5123   `((name . "File Cache")
5124     (init
5125      . (lambda ()
5126          (require 'filecache nil t)
5127          (unless anything-c-file-cache-initialized-p
5128            (setq anything-c-file-cache-files
5129                  (loop for item in file-cache-alist append
5130                        (destructuring-bind (base &rest dirs) item
5131                          (loop for dir in dirs collect
5132                                (concat dir base)))))
5133            (defadvice file-cache-add-file (after file-cache-list activate)
5134              (add-to-list 'anything-c-file-cache-files (expand-file-name file)))
5135            (setq anything-c-file-cache-initialized-p t))))
5136     (keymap . ,anything-generic-files-map)
5137     (help-message . anything-generic-file-help-message)
5138     (mode-line . anything-generic-file-mode-line-string)
5139     (candidates . anything-c-file-cache-files)
5140     (match anything-c-match-on-basename)
5141     (type . file)))
5142
5143 \f
5144 ;;; Locate
5145 ;;
5146 ;;
5147 ;; NOTE for WINDOZE users:
5148 ;; You have to install Everything with his command line interface here:
5149 ;; http://www.voidtools.com/download.php
5150
5151 (defun anything-ff-find-locatedb (&optional from-ff)
5152   "Try to find if a local locatedb file is available.
5153 The search is done in `anything-ff-default-directory' or
5154 fall back to `default-directory' if FROM-FF is nil."
5155   (when anything-ff-locate-db-filename
5156     (cond ((and anything-ff-default-directory
5157                 from-ff
5158                 (file-exists-p (expand-file-name
5159                                 anything-ff-locate-db-filename
5160                                 anything-ff-default-directory))
5161                 (expand-file-name
5162                  anything-ff-locate-db-filename
5163                  anything-ff-default-directory)))
5164           ((and (not from-ff)
5165                 (file-exists-p (expand-file-name
5166                                 anything-ff-locate-db-filename
5167                                 default-directory))
5168                 (expand-file-name
5169                  anything-ff-locate-db-filename
5170                  default-directory))))))
5171
5172 (defun anything-locate-1 (&optional localdb init from-ff)
5173   "Generic function to run Locate.
5174 if LOCALDB is non--nil search and use a local locate db file.
5175 INIT is a string to use as initial input in prompt.
5176 See `anything-locate-with-db' and `anything-locate'."
5177   (anything-locate-with-db
5178    (and localdb
5179         (or (anything-ff-find-locatedb from-ff)
5180             (anything-c-read-file-name
5181              "LocateDBFiles: "
5182              :initial-input (or anything-ff-default-directory
5183                                 default-directory)
5184              :marked-candidates t
5185              :preselect anything-locate-db-file-regexp
5186              :test #'(lambda (x)
5187                        (if anything-locate-db-file-regexp
5188                            ;; Select only locate db files and directories
5189                            ;; to allow navigation.
5190                            (or (string-match
5191                                 anything-locate-db-file-regexp x)
5192                                (file-directory-p x))
5193                            x)))))
5194    init))
5195 ;; (anything-locate-1 t)
5196
5197 (defun anything-locate-with-db (&optional db initial-input)
5198   "Run locate -d DB.
5199 If DB is not given or nil use locate without -d option.
5200 Argument DB can be given as a string or list of db files.
5201 Argument INITIAL-INPUT is a string to use as initial-input.
5202 See also `anything-locate'."
5203   (when (and db (stringp db)) (setq db (list db)))
5204   (unless anything-c-locate-command
5205     (setq anything-c-locate-command
5206           (case system-type
5207             ('gnu/linux "locate -i -r %s")
5208             ('berkeley-unix "locate -i %s")
5209             ('windows-nt "es -i -r %s")
5210             (t "locate %s"))))
5211   (let ((anything-c-locate-command
5212          (if db
5213              (replace-regexp-in-string
5214               "locate"
5215               (format "locate -d %s"
5216                       (mapconcat 'identity
5217                                  ;; Remove eventually
5218                                  ;; marked directories by error.
5219                                  (loop for i in db
5220                                        unless (file-directory-p i)
5221                                        collect i) ":"))
5222               anything-c-locate-command)
5223              anything-c-locate-command)))
5224     (anything :sources 'anything-c-source-locate
5225               :buffer "*anything locate*"
5226               :input initial-input
5227               :keymap anything-generic-files-map)))
5228 ;; (anything-locate-with-db "~/locate.db")
5229
5230 (defun anything-c-locate-init ()
5231   "Initialize async locate process for `anything-c-source-locate'."
5232   (setq mode-line-format
5233         '(" " mode-line-buffer-identification " "
5234           (line-number-mode "%l") " "
5235           (:eval (propertize "(Locate Process Running) "
5236                   'face '((:foreground "red"))))))
5237   (prog1
5238       (start-process-shell-command "locate-process" nil
5239                                    (format anything-c-locate-command
5240                                            anything-pattern))
5241     (set-process-sentinel (get-process "locate-process")
5242                           #'(lambda (process event)
5243                               (when (string= event "finished\n")
5244                                 (with-anything-window
5245                                   (force-mode-line-update nil)
5246                                   (anything-update-move-first-line)))))))
5247
5248 (defvar anything-c-source-locate
5249   `((name . "Locate")
5250     (candidates . anything-c-locate-init)
5251     (type . file)
5252     (requires-pattern . 3)
5253     (keymap . ,anything-generic-files-map)
5254     (help-message . anything-generic-file-help-message)
5255     (candidate-number-limit . 9999)
5256     (mode-line . anything-generic-file-mode-line-string)
5257     (delayed))
5258   "Find files matching the current input pattern with locate.")
5259
5260 (defun anything-c-locate-read-file-name (prompt &optional init)
5261   "Search a file with locate and return it's filename.
5262 Use argument PROMPT and INIT for `anything' arguments
5263 prompt and input."
5264   (anything :sources
5265             '((name . "Locate")
5266               (candidates . anything-c-locate-init)
5267               (action . identity)
5268               (requires-pattern . 3)
5269               (candidate-number-limit . 9999)
5270               (mode-line . anything-generic-file-mode-line-string)
5271               (delayed))
5272             :prompt prompt
5273             :input init
5274             :buffer "*anything locate rfn*"))
5275
5276
5277 \f
5278 ;;; Anything Incremental Grep.
5279 ;;
5280 ;;
5281 ;; Allow to grep incrementally with anything interface.
5282 ;; It allow also to Grep files recursively without using 'find' shell command.
5283 ;; On Windows you will need at least Grep version 2.5.4 of Gnuwin32.
5284 (defvar anything-c-grep-default-command
5285   "grep -d skip %e -niH -e %p %f"
5286   "Default grep format command for `anything-do-grep-1'.
5287 Where:
5288 '%e' format spec is for --exclude or --include grep options.
5289 '%p' format spec is for pattern.
5290 '%f' format spec is for filenames.")
5291
5292 (defvar anything-c-grep-default-recurse-command
5293   "grep -d recurse %e -niH -e %p %f"
5294   "Default recursive grep format command for `anything-do-grep-1'.
5295 See `anything-c-grep-default-command' for format specs.")
5296
5297 (defvar anything-c-default-zgrep-command "zgrep -niH -e %p %f")
5298
5299 (defvar anything-c-rzgrep-cache (make-hash-table :test 'equal))
5300
5301 (defvar anything-c-grep-default-function 'anything-c-grep-init)
5302
5303 (defvar anything-c-grep-debug-command-line nil
5304   "Turn on anything grep command-line debugging when non--nil.")
5305
5306 (defvar anything-c-zgrep-recurse-flag nil)
5307
5308 (defvar anything-c-grep-history nil)
5309
5310 (defvar anything-c-grep-max-length-history 100
5311   "*Max number of elements to save in `anything-c-grep-history'.")
5312
5313 (defun anything-c-grep-prepare-candidates (candidates)
5314   "Prepare filenames and directories CANDIDATES for grep command line."
5315   ;; If one or more candidate is a directory, search in all files
5316   ;; of this candidate (e.g /home/user/directory/*).
5317   ;; If r option is enabled search also in subdidrectories.
5318   ;; We need here to expand wildcards to support crap windows filenames
5319   ;; as grep doesn't accept quoted wildcards (e.g "dir/*.el").
5320   (if anything-c-zgrep-recurse-flag
5321       (mapconcat 'shell-quote-argument candidates " ")
5322       (loop for i in candidates append
5323             (cond ( ;; Candidate is a directory and we use recursion.
5324                    (and (file-directory-p i)
5325                         (anything-c-grep-recurse-p))
5326                    (list (expand-file-name i)))
5327                   ;; Candidate is a directory, search in all files.
5328                   ((file-directory-p i)
5329                    (file-expand-wildcards
5330                     (concat (file-name-as-directory (expand-file-name i)) "*") t))
5331                   ;; Candidate is a file or wildcard and we use recursion, use the
5332                   ;; current directory instead of candidate.
5333                   ((and (or (file-exists-p i) (string-match "\*" i))
5334                         (anything-c-grep-recurse-p))
5335                    (list (expand-file-name
5336                           (directory-file-name ; Needed for windoze.
5337                            (file-name-directory (directory-file-name i))))))
5338                   ;; Candidate use wildcard.
5339                   ((string-match "^\*" (anything-c-basename i))
5340                    (file-expand-wildcards i t))
5341                   ;; Else should be one or more file.
5342                   (t (list i))) into all-files
5343             finally return
5344             (mapconcat 'shell-quote-argument all-files " "))))
5345
5346 (defun anything-c-grep-recurse-p ()
5347   "Check if `anything-do-grep-1' have switched to recursive."
5348   (let ((args (replace-regexp-in-string
5349                "grep" "" anything-c-grep-default-command)))
5350     (string-match-p "r\\|recurse" args)))
5351
5352 (defun anything-c-grep-init (only-files &optional include zgrep)
5353   "Start an asynchronous grep process in ONLY-FILES list."
5354   (let* ((fnargs        (anything-c-grep-prepare-candidates
5355                          (if (file-remote-p anything-ff-default-directory)
5356                              (mapcar #'(lambda (x)
5357                                          (file-remote-p x 'localname))
5358                                      only-files)
5359                              only-files)))
5360          (ignored-files (mapconcat
5361                          #'(lambda (x)
5362                              (concat "--exclude=" (shell-quote-argument x)))
5363                          grep-find-ignored-files " "))
5364          (ignored-dirs  (mapconcat
5365                          ;; Need grep version >=2.5.4 of Gnuwin32 on windoze.
5366                          #'(lambda (x)
5367                              (concat "--exclude-dir=" (shell-quote-argument x)))
5368                          grep-find-ignored-directories " "))
5369          (exclude       (if (anything-c-grep-recurse-p)
5370                             (concat (or include ignored-files) " " ignored-dirs)
5371                             ignored-files))
5372          (cmd-line      (format-spec
5373                          anything-c-grep-default-command
5374                          (delq nil
5375                                (list (unless zgrep (cons ?e exclude))
5376                                      (cons ?p (shell-quote-argument anything-pattern))
5377                                      (cons ?f fnargs))))))
5378     (when anything-c-grep-debug-command-line
5379       (with-current-buffer (get-buffer-create "*any grep debug*")
5380         (goto-char (point-max))
5381         (insert (concat ">>> " cmd-line "\n\n"))))
5382     (setq mode-line-format
5383           '(" " mode-line-buffer-identification " "
5384             (line-number-mode "%l") " "
5385             (:eval (when (get-process "grep-process")
5386                      (propertize "[Grep Process Running] "
5387                                  'face 'anything-grep-running)))))
5388     (force-mode-line-update nil)
5389     (prog1
5390         (let ((default-directory anything-ff-default-directory))
5391           (start-file-process-shell-command "grep-process" nil cmd-line))
5392       (message nil)
5393       (set-process-sentinel
5394        (get-process "grep-process")
5395        #'(lambda (process event)
5396            (when (string= event "finished\n")
5397              (with-anything-window
5398                (anything-update-move-first-line)
5399                (setq mode-line-format
5400                      '(" " mode-line-buffer-identification " "
5401                        (line-number-mode "%l") " "
5402                        (:eval (propertize
5403                                (format "[Grep Process Finished - (%s results)] "
5404                                        (let ((nlines (1- (count-lines
5405                                                           (point-min)
5406                                                           (point-max)))))
5407                                          (if (> nlines 0) nlines 0)))
5408                                'face 'anything-grep-finish))))
5409                (force-mode-line-update nil))))))))
5410
5411 (defun anything-c-grep-action (candidate &optional where mark)
5412   "Define a default action for `anything-do-grep' on CANDIDATE.
5413 WHERE can be one of other-window, elscreen, other-frame."
5414   (let* ((split        (anything-c-grep-split-line candidate))
5415          (lineno       (string-to-number (nth 1 split)))
5416          (loc-fname    (car split))
5417          (tramp-method (file-remote-p anything-ff-default-directory 'method))
5418          (tramp-host   (file-remote-p anything-ff-default-directory 'host))
5419          (tramp-prefix (concat "/" tramp-method ":" tramp-host ":"))
5420          (fname        (if tramp-host
5421                            (concat tramp-prefix loc-fname) loc-fname)))
5422     (case where
5423       (other-window (find-file-other-window fname))
5424       (elscreen     (anything-elscreen-find-file fname))
5425       (other-frame  (find-file-other-frame fname))
5426       (grep         (anything-c-grep-save-results-1))
5427       (t (find-file fname)))
5428     (unless (eq where 'grep)
5429       (anything-goto-line lineno))
5430     (when mark
5431       (set-marker (mark-marker) (point))
5432       (push-mark (point) 'nomsg))
5433     ;; Save history
5434     (unless (or anything-in-persistent-action
5435                 (string= anything-pattern ""))
5436       (setq anything-c-grep-history
5437             (cons anything-pattern
5438                   (delete anything-pattern anything-c-grep-history)))
5439       (when (> (length anything-c-grep-history)
5440                anything-c-grep-max-length-history)
5441         (setq anything-c-grep-history
5442               (delete (car (last anything-c-grep-history))
5443                       anything-c-grep-history))))))
5444
5445 (defun anything-c-grep-other-window (candidate)
5446   "Jump to result in other window from anything grep."
5447   (anything-c-grep-action candidate 'other-window))
5448
5449 (defun anything-c-grep-other-frame (candidate)
5450   "Jump to result in other frame from anything grep."
5451   (anything-c-grep-action candidate 'other-frame))
5452
5453 (defun anything-c-grep-jump-elscreen (candidate)
5454   "Jump to result in elscreen from anything grep."
5455   (anything-c-grep-action candidate 'elscreen))
5456
5457 (defun anything-c-grep-save-results (_candidate)
5458   (anything-c-grep-action _candidate 'grep))
5459
5460 (defun anything-c-grep-save-results-1 ()
5461   "Save anything grep result in a `grep-mode' buffer."
5462   (let ((buf "*grep*")
5463         new-buf)
5464     (when (get-buffer buf)
5465       (setq new-buf (read-string "GrepBufferName: " buf))
5466       (loop for b in (anything-c-buffer-list)
5467             when (and (string= new-buf b)
5468                       (not (y-or-n-p
5469                             (format "Buffer `%s' already exists overwrite? "
5470                                     new-buf))))
5471             do (setq new-buf (read-string "GrepBufferName: " "*grep ")))
5472       (setq buf new-buf))
5473     (with-current-buffer (get-buffer-create buf)
5474       (let ((inhibit-read-only t))
5475         (erase-buffer)
5476         (insert "-*- mode: grep -*-\n\n"
5477                 (format "Grep Results for `%s':\n\n" anything-pattern))
5478         (save-excursion
5479           (insert (with-current-buffer anything-buffer
5480                     (goto-char (point-min)) (forward-line 1)
5481                     (buffer-substring (point) (point-max))))
5482           (grep-mode))))
5483     (message "Anything Grep Results saved in `%s' buffer" buf)))
5484
5485 (defun anything-c-grep-persistent-action (candidate)
5486   "Persistent action for `anything-do-grep'.
5487 With a prefix arg record CANDIDATE in `mark-ring'."
5488   (if current-prefix-arg
5489       (anything-c-grep-action candidate nil 'mark)
5490       (anything-c-grep-action candidate))
5491   (anything-match-line-color-current-line))
5492
5493 (defun anything-c-grep-guess-extensions (files)
5494   "Try to guess file extensions in FILES list when using grep recurse.
5495 These extensions will be added to command line with --include arg of grep."
5496   (loop
5497         with glob-list = nil
5498         with lst = (if (file-directory-p (car files))
5499                        (directory-files
5500                         (car files) nil
5501                         directory-files-no-dot-files-regexp)
5502                        files)
5503         for i in lst
5504         for ext = (file-name-extension i t)
5505         for glob = (and ext (not (string= ext ""))
5506                         (concat "*" ext))
5507         unless (or (not glob)
5508                    (member glob glob-list)
5509                    (member glob grep-find-ignored-files))
5510         collect glob into glob-list
5511         finally return glob-list))
5512
5513 (defun anything-do-grep-1 (only &optional recurse zgrep)
5514   "Launch grep with a list of ONLY files.
5515 When RECURSE is given use -r option of grep and prompt user
5516 to set the --include args of grep.
5517 You can give more than one arg separated by space.
5518 e.g *.el *.py *.tex.
5519 If it's empty --exclude `grep-find-ignored-files' is used instead."
5520   (let* ((anything-compile-source-functions
5521           ;; rule out anything-match-plugin because the input is one regexp.
5522           (delq 'anything-compile-source--match-plugin
5523                 (copy-sequence anything-compile-source-functions)))
5524          (exts (anything-c-grep-guess-extensions only))
5525          (globs (and (not zgrep) (mapconcat 'identity exts " ")))
5526          (include-files (and recurse (not zgrep)
5527                              (read-string "OnlyExt(*.[ext]): "
5528                                           globs)))
5529          ;; Set `minibuffer-history' AFTER includes-files
5530          ;; to avoid storing wild-cards here.
5531          (minibuffer-history anything-c-grep-history)
5532          (anything-c-grep-default-command (cond ((and recurse zgrep) anything-c-default-zgrep-command)
5533                                                 (recurse anything-c-grep-default-recurse-command)
5534                                                 (zgrep anything-c-default-zgrep-command)
5535                                                 (t anything-c-grep-default-command)))
5536          ;; Disable match-plugin and use here own highlighting.
5537          (anything-mp-highlight-delay     nil))
5538     (when include-files
5539       (setq include-files
5540             (and (not (string= include-files ""))
5541                  (mapconcat #'(lambda (x)
5542                                 (concat "--include=" (shell-quote-argument x)))
5543                             (split-string include-files) " "))))
5544     ;; When called as action from an other source e.g *-find-files
5545     ;; we have to kill action buffer.
5546     (when (get-buffer anything-action-buffer)
5547       (kill-buffer anything-action-buffer))
5548     ;; `anything-find-files' haven't already started,
5549     ;; give a default value to `anything-ff-default-directory'.
5550     (setq anything-ff-default-directory (or anything-ff-default-directory
5551                                             default-directory))
5552     (anything
5553      :sources
5554      `(((name . "Grep")
5555         (header-name . (lambda (name)
5556                          (concat name "(C-c ? Help)")))
5557         (candidates
5558          . (lambda ()
5559              (funcall anything-c-grep-default-function only include-files zgrep)))
5560         (filtered-candidate-transformer anything-c-grep-cand-transformer)
5561         (candidate-number-limit . 9999)
5562         (mode-line . anything-grep-mode-line-string)
5563         (keymap . ,anything-c-grep-map)
5564         (action . ,(delq
5565                     nil
5566                     `(("Find File" . anything-c-grep-action)
5567                       ("Find file other frame" . anything-c-grep-other-frame)
5568                       ,(and (locate-library "elscreen")
5569                             '("Find file in Elscreen"
5570                               . anything-c-grep-jump-elscreen))
5571                       ("Save results in grep buffer" . anything-c-grep-save-results)
5572                       ("Find file other window" . anything-c-grep-other-window))))
5573         (persistent-action . anything-c-grep-persistent-action)
5574         (persistent-help . "Jump to line (`C-u' Record in mark ring)")
5575         (requires-pattern . 3)
5576         (delayed)))
5577      :buffer "*anything grep*")))
5578
5579 (defun anything-ff-zgrep-1 (flist recursive)
5580   (unwind-protect
5581        (let* ((def-dir (or anything-ff-default-directory
5582                            default-directory))
5583               (only    (if recursive
5584                            (or (gethash def-dir anything-c-rzgrep-cache)
5585                                (puthash
5586                                 def-dir
5587                                 (anything-c-walk-directory
5588                                  def-dir
5589                                  :directories nil
5590                                  :path 'full
5591                                  :match ".*\\(\.gz\\|\.bz\\|\.xz\\|\.lzma\\)$")
5592                                 anything-c-rzgrep-cache))
5593                            flist)))
5594          (when recursive (setq anything-c-zgrep-recurse-flag t))
5595          (anything-do-grep-1 only recursive 'zgrep))
5596     (setq anything-c-zgrep-recurse-flag nil)))
5597
5598 (defun anything-c-grep-split-line (line)
5599   "Split a grep output line."
5600   (let (beg fname lineno str)
5601     ;; Don't print until grep line is valid.
5602     (when (string-match "\\(.*\\)\\(:[0-9]+:\\)\\(.*\\)" line)
5603       (with-temp-buffer
5604         (insert line)
5605         (goto-char (point-min))
5606         (setq beg (point))
5607         (forward-char 2)
5608         (re-search-forward ":" nil t)
5609         (setq fname (buffer-substring-no-properties beg (1- (point))))
5610         (setq beg (point))
5611         (re-search-forward ":" nil t)
5612         (setq lineno (buffer-substring-no-properties beg (1- (point))))
5613         (setq str (buffer-substring-no-properties (point) (point-at-eol))))
5614       (list fname lineno str))))
5615
5616 (defun anything-c-grep-cand-transformer (candidates sources)
5617   "Filtered candidate transformer function for `anything-do-grep'."
5618   (loop for i in candidates
5619         for split  = (and i (anything-c-grep-split-line i))
5620         for fname  = (car split)
5621         for lineno = (nth 1 split)
5622         for str    = (nth 2 split)
5623         when (and fname lineno str)
5624         collect
5625         (cons (concat (propertize (file-name-nondirectory fname)
5626                                   'face 'anything-grep-file
5627                                   'help-echo fname) ":"
5628                                   (propertize lineno 'face 'anything-grep-lineno) ":"
5629                                   (anything-c-grep-highlight-match str))
5630               i)))
5631
5632 (defun anything-c-grep-highlight-match (str)
5633   "Highlight in string STR all occurences matching `anything-pattern'."
5634   (condition-case nil
5635       (with-temp-buffer
5636         (insert str)
5637         (goto-char (point-min))
5638         (while (and (re-search-forward anything-pattern nil t)
5639                     (> (- (match-end 0) (match-beginning 0)) 0))
5640           (add-text-properties
5641            (match-beginning 0) (match-end 0)
5642            '(face anything-grep-match)))
5643         (buffer-string))
5644     (error nil)))
5645
5646 ;; Go to next or precedent file (common to etags and grep).
5647 (defun anything-c-goto-next-or-prec-file (n)
5648   "Go to next or precedent candidate file in anything grep/etags buffers.
5649 If N is positive go forward otherwise go backward."
5650   (with-anything-window
5651     (let* ((current-line-list  (split-string
5652                                 (buffer-substring
5653                                  (point-at-bol)
5654                                  (point-at-eol)) ":"))
5655            (current-fname      (nth 0 current-line-list))
5656            (fn-b-o-f           (if (eq n 1) 'eobp 'bobp)))
5657       (catch 'break
5658         (while (not (funcall fn-b-o-f))
5659           (forward-line n) ; Go forward or backward depending of n value.
5660           (unless (search-forward current-fname (point-at-eol) t)
5661             (anything-mark-current-line)
5662             (throw 'break nil))))
5663       (cond ((and (eq n 1) (eobp))
5664              (re-search-backward ".")
5665              (forward-line 0)
5666              (anything-mark-current-line))
5667             ((and (< n 1) (bobp))
5668              (forward-line 1)
5669              (anything-mark-current-line))))))
5670
5671 ;;;###autoload
5672 (defun anything-c-goto-precedent-file ()
5673   "Go to precedent file in anything grep/etags buffers."
5674   (interactive)
5675   (anything-c-goto-next-or-prec-file -1))
5676
5677 ;;;###autoload
5678 (defun anything-c-goto-next-file ()
5679   "Go to precedent file in anything grep/etags buffers."
5680   (interactive)
5681   (anything-c-goto-next-or-prec-file 1))
5682
5683 ;;;###autoload
5684 (defun anything-c-grep-run-persistent-action ()
5685   "Run grep persistent action from `anything-do-grep-1'."
5686   (interactive)
5687   (anything-attrset 'jump-persistent 'anything-c-grep-persistent-action)
5688   (anything-execute-persistent-action 'jump-persistent))
5689
5690 ;;;###autoload
5691 (defun anything-c-grep-run-default-action ()
5692   "Run grep default action from `anything-do-grep-1'."
5693   (interactive)
5694   (anything-c-quit-and-execute-action 'anything-c-grep-action))
5695
5696 ;;;###autoload
5697 (defun anything-c-grep-run-other-window-action ()
5698   "Run grep goto other window action from `anything-do-grep-1'."
5699   (interactive)
5700   (anything-c-quit-and-execute-action 'anything-c-grep-other-window))
5701
5702 ;;;###autoload
5703 (defun anything-c-grep-run-save-buffer ()
5704   "Run grep save results action from `anything-do-grep-1'."
5705   (interactive)
5706   (anything-c-quit-and-execute-action 'anything-c-grep-save-results))
5707
5708 ;; Grep buffers
5709 (defun anything-c-grep-buffers-1 (candidate &optional zgrep)
5710   "Run grep on all file--buffers or CANDIDATE if it is a file--buffer.
5711 If one of selected buffers is not a file--buffer,
5712 it is ignored and grep will run on all others file--buffers.
5713 If only one candidate is selected and it is not a file--buffer,
5714 switch to this buffer and run `anything-occur'.
5715 If a prefix arg is given run grep on all buffers ignoring non--file-buffers."
5716   (let* ((prefarg (or current-prefix-arg anything-current-prefix-arg))
5717          (cands (if prefarg
5718                     (buffer-list)
5719                     (anything-marked-candidates)))
5720          (win-conf (current-window-configuration))
5721          ;; Non--fname buffers are ignored.
5722          (bufs (loop for buf in cands
5723                      for fname = (buffer-file-name (get-buffer buf))
5724                      when fname
5725                      collect (expand-file-name fname))))
5726     (if bufs
5727         (if zgrep
5728             (anything-do-grep-1 bufs nil 'zgrep)
5729             (anything-do-grep-1 bufs))
5730         ;; bufs is empty, thats mean we have only CANDIDATE
5731         ;; and it is not a buffer-filename, fallback to occur.
5732         (anything-c-switch-to-buffer candidate)
5733         (when (get-buffer anything-action-buffer)
5734           (kill-buffer anything-action-buffer))
5735         (anything-occur)
5736         (when (eq anything-exit-status 1)
5737           (set-window-configuration win-conf)))))
5738
5739 (defun anything-c-grep-buffers (candidate)
5740   "Action to grep buffers."
5741   (anything-c-grep-buffers-1 candidate))
5742
5743 (defun anything-c-zgrep-buffers (candidate)
5744   "Action to zgrep buffers."
5745   (anything-c-grep-buffers-1 candidate 'zgrep))
5746
5747 \f
5748 ;;; Anything interface for pdfgrep
5749 ;;  pdfgrep program <http://pdfgrep.sourceforge.net/>
5750 ;;  and a pdf-reader (e.g xpdf) are needed.
5751 ;;
5752 (defvar anything-c-pdfgrep-default-command "pdfgrep --color never -niH %s %s")
5753 (defvar anything-c-pdfgrep-default-function 'anything-c-pdfgrep-init)
5754 (defvar anything-c-pdfgrep-debug-command-line nil)
5755
5756 (defun anything-c-pdfgrep-init (only-files)
5757   "Start an asynchronous pdfgrep process in ONLY-FILES list."
5758   (let* ((fnargs   (anything-c-grep-prepare-candidates
5759                     (if (file-remote-p anything-ff-default-directory)
5760                         (mapcar #'(lambda (x)
5761                                     (file-remote-p x 'localname))
5762                                 only-files)
5763                         only-files)))
5764          (cmd-line (format anything-c-pdfgrep-default-command
5765                            anything-pattern
5766                            fnargs)))
5767     (when anything-c-pdfgrep-debug-command-line
5768       (with-current-buffer (get-buffer-create "*any pdfgrep debug*")
5769         (goto-char (point-max))
5770         (insert (concat ">>> " cmd-line "\n\n"))))
5771     (setq mode-line-format
5772           '(" " mode-line-buffer-identification " "
5773             (line-number-mode "%l") " "
5774             (:eval (propertize "(Pdfgrep Process Running) "
5775                     'face '((:foreground "red"))))))
5776     (prog1
5777         (let ((default-directory anything-ff-default-directory))
5778           (start-file-process-shell-command "pdfgrep-process" nil cmd-line))
5779       (message nil)
5780       (set-process-sentinel
5781        (get-process "pdfgrep-process")
5782        #'(lambda (process event)
5783            (when (string= event "finished\n")
5784              (with-anything-window
5785                (anything-update-move-first-line))
5786              (force-mode-line-update nil)))))))
5787
5788
5789 (defun anything-do-pdfgrep-1 (only)
5790   "Launch pdfgrep with a list of ONLY files."
5791   (unless (executable-find "pdfgrep")
5792     (error "Error: No such program `pdfgrep'."))
5793   (let* ((anything-compile-source-functions
5794           ;; rule out anything-match-plugin because the input is one regexp.
5795           (delq 'anything-compile-source--match-plugin
5796                 (copy-sequence anything-compile-source-functions)))
5797          ;; Disable match-plugin and use here own highlighting.
5798          (anything-mp-highlight-delay nil))
5799     ;; When called as action from an other source e.g *-find-files
5800     ;; we have to kill action buffer.
5801     (when (get-buffer anything-action-buffer)
5802       (kill-buffer anything-action-buffer))
5803     ;; If `anything-find-files' haven't already started,
5804     ;; give a default value to `anything-ff-default-directory'.
5805     (setq anything-ff-default-directory (or anything-ff-default-directory
5806                                             default-directory))
5807     (anything
5808      :sources
5809      `(((name . "PdfGrep")
5810         (candidates
5811          . (lambda ()
5812              (funcall anything-c-pdfgrep-default-function only)))
5813         (filtered-candidate-transformer anything-c-grep-cand-transformer)
5814         (candidate-number-limit . 9999)
5815         (mode-line . anything-pdfgrep-mode-line-string)
5816         (action . anything-c-pdfgrep-action)
5817         (persistent-help . "Jump to PDF Page")
5818         (requires-pattern . 3)
5819         (delayed)))
5820      :keymap anything-c-pdfgrep-map
5821      :buffer "*anything grep*")))
5822
5823
5824 (defun anything-c-pdfgrep-action (candidate)
5825   (let* ((split  (anything-c-grep-split-line candidate))
5826          (pageno (nth 1 split))
5827          (fname  (car split)))
5828     (start-file-process-shell-command
5829      "pdf-reader" nil
5830      (format-spec anything-c-pdfgrep-default-read-command
5831                   (list (cons ?f fname) (cons ?p pageno))))))
5832
5833 \f
5834 ;; Yank text at point.
5835 ;;
5836 ;;
5837 ;; Internal
5838 (defvar anything-yank-point nil)
5839
5840 ;;;###autoload
5841 (defun anything-yank-text-at-point ()
5842   "Yank text at point in minibuffer."
5843   (interactive)
5844   (let (input)
5845     (flet ((insert-in-minibuffer (word)
5846              (with-selected-window (minibuffer-window)
5847                (let ((str anything-pattern))
5848                  (delete-minibuffer-contents)
5849                  (set-text-properties 0 (length word) nil word)
5850                  (insert (concat str word))))))
5851       (with-anything-current-buffer
5852         ;; Start to initial point if C-w have never been hit.
5853         (unless anything-yank-point (setq anything-yank-point (point)))
5854         (and anything-yank-point (goto-char anything-yank-point))
5855         (forward-word 1)
5856         (setq input (buffer-substring-no-properties anything-yank-point (point)))
5857         (setq anything-yank-point (point))) ; End of last forward-word
5858       (insert-in-minibuffer input))))
5859
5860 (defun anything-reset-yank-point ()
5861   (setq anything-yank-point nil))
5862
5863 (add-hook 'anything-after-persistent-action-hook 'anything-reset-yank-point)
5864 (add-hook 'anything-cleanup-hook 'anything-reset-yank-point)
5865
5866 \f
5867 ;;; Recentf files
5868 ;;
5869 ;;
5870 (defvar anything-c-source-recentf
5871   `((name . "Recentf")
5872     (init . (lambda ()
5873               (require 'recentf)
5874               (or recentf-mode (recentf-mode 1))))
5875     ;; Needed for filenames with capitals letters.
5876     (disable-shortcuts)
5877     (candidates . recentf-list)
5878     (keymap . ,anything-generic-files-map)
5879     (help-message . anything-generic-file-help-message)
5880     (mode-line . anything-generic-file-mode-line-string)
5881     (match anything-c-match-on-basename)
5882     (type . file))
5883   "See (info \"(emacs)File Conveniences\").
5884 Set `recentf-max-saved-items' to a bigger value if default is too small.")
5885
5886 ;;; ffap
5887 (eval-when-compile (require 'ffap))
5888 (defvar anything-c-source-ffap-guesser
5889   `((name . "File at point")
5890     (init . (lambda () (require 'ffap)))
5891     (candidates . (lambda ()
5892                     (anything-aif
5893                         (with-anything-current-buffer
5894                           (ffap-guesser))
5895                         (list it))))
5896     (keymap . ,anything-generic-files-map)
5897     (help-message . anything-generic-file-help-message)
5898     (mode-line . anything-generic-file-mode-line-string)
5899     (type . file)))
5900
5901 ;;; ffap with line number
5902 (defun anything-c-ffap-file-line-at-point ()
5903   "Get (FILENAME . LINENO) at point."
5904   (anything-aif (let (ffap-alist) (ffap-file-at-point))
5905       (save-excursion
5906         (beginning-of-line)
5907         (when (and (search-forward it nil t)
5908                    (looking-at ":\\([0-9]+\\)"))
5909           (cons it (string-to-number (match-string 1)))))))
5910
5911 (defun anything-c-ffap-line-candidates ()
5912   (with-anything-current-buffer
5913     (anything-attrset 'ffap-line-location (anything-c-ffap-file-line-at-point)))
5914   (anything-aif (anything-attr 'ffap-line-location)
5915     (destructuring-bind (file . line) it
5916       (list (cons (format "%s (line %d)" file line) file)))))
5917
5918 ;;; Goto line after opening file by `anything-c-source-ffap-line'.
5919 (defun anything-c-ffap-line-goto-line ()
5920   (when (car (anything-attr 'ffap-line-location))
5921     (unwind-protect
5922         (ignore-errors
5923           (with-selected-window
5924               (get-buffer-window
5925                (get-file-buffer (car (anything-attr 'ffap-line-location))))
5926             (anything-goto-line (cdr (anything-attr 'ffap-line-location)))))
5927       (anything-attrset 'ffap-line-location nil))))
5928 (add-hook 'anything-after-action-hook 'anything-c-ffap-line-goto-line)
5929 (add-hook 'anything-after-persistent-action-hook 'anything-c-ffap-line-goto-line)
5930
5931 (defvar anything-c-source-ffap-line
5932   `((name . "File/Lineno at point")
5933     (init . (lambda () (require 'ffap)))
5934     (candidates . anything-c-ffap-line-candidates)
5935     (keymap . ,anything-map)
5936     (type . file)))
5937
5938 ;;; list of files gleaned from every dired buffer
5939 (defun anything-c-files-in-all-dired-candidates ()
5940   (save-excursion
5941     (mapcan
5942      (lambda (dir)
5943        (cond ((listp dir)               ;filelist
5944               dir)
5945              ((equal "" (file-name-nondirectory dir)) ;dir
5946               (directory-files dir t))
5947              (t                         ;wildcard
5948               (file-expand-wildcards dir t))))
5949      (delq nil
5950            (mapcar (lambda (buf)
5951                      (set-buffer buf)
5952                      (when (eq major-mode 'dired-mode)
5953                        (if (consp dired-directory)
5954                            (cdr dired-directory) ;filelist
5955                            dired-directory))) ;dir or wildcard
5956                    (buffer-list))))))
5957 ;; (dired '("~/" "~/.emacs-custom.el" "~/.emacs.bmk"))
5958
5959 (defvar anything-c-source-files-in-all-dired
5960   '((name . "Files in all dired buffer.")
5961     (candidates . anything-c-files-in-all-dired-candidates)
5962     (type . file)))
5963
5964 (defvar anything-c-source-filelist
5965   '((name . "FileList")
5966     (grep-candidates . anything-c-filelist-file-name)
5967     (candidate-number-limit . 200)
5968     (requires-pattern . 4)
5969     (type . file))
5970   "Source to find files instantly.
5971 See `anything-c-filelist-file-name' docstring for usage.")
5972
5973 \f
5974 ;;;; <info>
5975 ;;; Info pages
5976 (defvar anything-c-info-pages nil
5977   "All info pages on system.
5978 Will be calculated the first time you invoke anything with this
5979 source.")
5980
5981 (defun anything-c-info-pages-init ()
5982   "Collect candidates for initial Info node Top."
5983   (if anything-c-info-pages
5984       anything-c-info-pages
5985       (let ((info-topic-regexp "\\* +\\([^:]+: ([^)]+)[^.]*\\)\\.")
5986             topics)
5987         (require 'info)
5988         (with-temp-buffer
5989           (Info-find-node "dir" "top")
5990           (goto-char (point-min))
5991           (while (re-search-forward info-topic-regexp nil t)
5992             (push (match-string-no-properties 1) topics))
5993           (kill-buffer))
5994         (setq anything-c-info-pages topics))))
5995
5996 (defvar anything-c-source-info-pages
5997   `((name . "Info Pages")
5998     (init . anything-c-info-pages-init)
5999     (candidates . anything-c-info-pages)
6000     (action . (("Show with Info" .(lambda (node-str)
6001                                     (info (replace-regexp-in-string
6002                                            "^[^:]+: " "" node-str))))))
6003     (requires-pattern . 2)))
6004
6005 \f
6006 ;;; Man and woman UI
6007 ;;
6008 ;;
6009 (defvar anything-c-man-pages nil
6010   "All man pages on system.
6011 Will be calculated the first time you invoke anything with this
6012 source.")
6013
6014 (defun anything-c-man-default-action (candidate)
6015   "Default action for jumping to a woman or man page from anything."
6016   (let ((wfiles (woman-file-name-all-completions candidate)))
6017     (condition-case err
6018         (if (> (length wfiles) 1)
6019             (woman-find-file
6020              (anything-comp-read
6021               "ManFile: " wfiles :must-match t))
6022             (woman candidate))
6023       ;; If woman is unable to format correctly
6024       ;; use man instead.
6025       (error (kill-buffer) ; Kill woman buffer.
6026              (let ((Man-notify-method 'meek))
6027                (Man-getpage-in-background candidate))))))
6028
6029 (defvar anything-c-source-man-pages
6030   `((name . "Manual Pages")
6031     (candidates . (lambda ()
6032                     (if anything-c-man-pages
6033                         anything-c-man-pages
6034                         ;; XEmacs doesn't have a woman :)
6035                         (setq anything-c-man-pages
6036                               (ignore-errors
6037                                 (require 'woman)
6038                                 (woman-file-name "")
6039                                 (sort (mapcar 'car woman-topic-all-completions)
6040                                       'string-lessp))))))
6041     (action  ("Show with Woman" . anything-c-man-default-action))
6042     ;; Woman does not work OS X
6043     ;; http://xahlee.org/emacs/modernization_man_page.html
6044     (action-transformer . (lambda (actions candidate)
6045                             (if (eq system-type 'darwin)
6046                                 '(("Show with Man" . man))
6047                                 actions)))
6048     (requires-pattern . 2)))
6049
6050 \f
6051 ;;;; <Command>
6052 ;;; Anything M-x - Enhanced M-x UI
6053 ;;
6054 ;;
6055 ;; Another replacement of `M-x' that act exactly like the
6056 ;; vanilla Emacs one, no problem of windows configuration, prefix args
6057 ;; can be passed before calling `M-x' (e.g C-u M-x..) but also during
6058 ;; anything invocation.
6059 ;; Documentation of commands available without quitting,
6060 ;; Show keybindings of commands.
6061 ;; Show history.
6062 (defvar anything-M-x-input-history nil)
6063
6064 (defun* anything-M-x-get-major-mode-command-alist (mode-map)
6065   "Return alist of MODE-MAP."
6066   (loop for key being the key-seqs of mode-map using (key-bindings com)
6067         for str-key  = (key-description key)
6068         for ismenu   = (string-match "<menu-bar>" str-key)
6069         unless ismenu collect (cons str-key com)))
6070
6071 (defun anything-get-mode-map-from-mode (mode)
6072   "Guess the mode-map name according to MODE.
6073 Some modes don't use conventional mode-map name
6074 so we need to guess mode-map name. e.g python-mode ==> py-mode-map.
6075 Return nil if no mode-map found."
6076   (loop
6077         ;; Start with a conventional mode-map name.
6078         with mode-map    = (intern-soft (format "%s-map" mode))
6079         with mode-string = (symbol-name mode)
6080         with mode-name   = (replace-regexp-in-string "-mode" "" mode-string)
6081         while (not mode-map)
6082         for count downfrom (length mode-name)
6083         ;; Return when no result after parsing entire string.
6084         when (eq count 0) return nil
6085         for sub-name = (substring mode-name 0 count)
6086         do (setq mode-map (intern-soft (format "%s-map" (concat sub-name "-mode"))))
6087         finally return mode-map))
6088
6089 (defun anything-M-x-current-mode-map-alist ()
6090   "Return mode-map alist of current `major-mode'."
6091   (let ((map (anything-get-mode-map-from-mode major-mode)))
6092     (when (and map (boundp map))
6093       (anything-M-x-get-major-mode-command-alist (symbol-value map)))))
6094
6095
6096 (defun anything-M-x-transformer (candidates sources)
6097   "filtered-candidate-transformer to show bindings in emacs commands.
6098 Show global bindings and local bindings according to current `major-mode'."
6099   (with-anything-current-buffer
6100     (loop with local-map = (anything-M-x-current-mode-map-alist)
6101           for cand in candidates
6102           for local-key  = (car (rassq cand local-map))
6103           for key        = (substitute-command-keys (format "\\[%s]" cand))
6104           collect
6105           (cons (cond ((and (string-match "^M-x" key) local-key)
6106                        (format "%s (%s)"
6107                                cand (propertize
6108                                      local-key
6109                                      'face 'anything-M-x-key-face)))
6110                       ((string-match "^M-x" key) cand)
6111                       (t (format "%s (%s)"
6112                                  cand (propertize
6113                                        key
6114                                        'face 'anything-M-x-key-face))))
6115                 cand) into ls
6116           finally return
6117           (sort ls #'(lambda (x y) (string-lessp (car x) (car y)))))))
6118
6119 \f
6120 ;;; Complex command history
6121 ;;
6122 ;;
6123 (defvar anything-c-source-complex-command-history
6124   '((name . "Complex Command History")
6125     (candidates . (lambda () (mapcar 'prin1-to-string command-history)))
6126     (type . sexp)))
6127
6128 ;;; M-x history (not related to `anything-M-x')
6129 ;;
6130 ;;
6131 (defvar anything-c-source-extended-command-history
6132   '((name . "Emacs Commands History")
6133     (candidates
6134      . (lambda ()
6135          (anything-fast-remove-dups extended-command-history :test 'equal)))
6136     (type . command)))
6137
6138 ;;; Emacs commands (Basic source for emacs commands)
6139 ;;
6140 ;;
6141 (defvar anything-c-source-emacs-commands
6142   '((name . "Emacs Commands")
6143     (candidates . (lambda ()
6144                     (let (commands)
6145                       (mapatoms (lambda (a)
6146                                   (if (commandp a)
6147                                       (push (symbol-name a)
6148                                             commands))))
6149                       (sort commands 'string-lessp))))
6150     (type . command)
6151     (requires-pattern . 2))
6152   "Source for completing and invoking Emacs commands.
6153 A command is a function with interactive spec that can
6154 be invoked with `M-x'.
6155
6156 To get non-interactive functions listed, use
6157 `anything-c-source-emacs-functions'.")
6158
6159 \f
6160 ;;;; <Function>
6161 ;;; Emacs functions
6162 ;;
6163 ;;
6164 (defvar anything-c-source-emacs-functions
6165   '((name . "Emacs Functions")
6166     (candidates . (lambda ()
6167                     (let (commands)
6168                       (mapatoms (lambda (a)
6169                                   (if (functionp a)
6170                                       (push (symbol-name a) commands))))
6171                       (sort commands 'string-lessp))))
6172     (type . function)
6173     (requires-pattern . 2))
6174   "Source for completing Emacs functions.")
6175
6176 ;;; With abbrev expansion
6177 ;;; Similar to my exec-abbrev-cmd.el
6178 ;;; See http://www.tsdh.de/cgi-bin/wiki.pl/exec-abbrev-cmd.el
6179 (defvar anything-c-function-abbrev-regexp nil
6180   "The regexp for `anything-c-source-emacs-functions-with-abbrevs'.
6181 Regexp built from the current `anything-pattern' interpreting it
6182 as abbreviation.
6183 Only for internal use.")
6184
6185 (defun anything-c-match-function-by-abbrev (candidate)
6186   "Return non-nil if `anything-pattern' is an abbreviation of the function CANDIDATE.
6187
6188 Abbreviations are made by taking the first character from each
6189 word in the function's name, e.g. \"bb\" is an abbrev for
6190 `bury-buffer', \"stb\" is an abbrev for `anything-c-switch-to-buffer'."
6191   (string-match anything-c-function-abbrev-regexp candidate))
6192
6193 (defvar anything-c-source-emacs-functions-with-abbrevs
6194   (append anything-c-source-emacs-functions
6195           '((match anything-c-match-function-by-abbrev
6196              anything-c-string-match))
6197           '((init
6198              . (lambda ()
6199                  (defadvice anything-update
6200                      (before anything-c-update-function-abbrev-regexp activate)
6201                    (let ((char-list (append anything-pattern nil))
6202                          (str "^"))
6203                      (dolist (c char-list)
6204                        (setq str (concat str (list c) "[^-]*-")))
6205                      (setq str (concat (substring str 0 (1- (length str))) "$"))
6206                      (setq anything-c-function-abbrev-regexp str))))))))
6207
6208 (defvar anything-c-source-advice
6209   '((name . "Function Advice")
6210     (candidates . anything-c-advice-candidates)
6211     (action ("Toggle Enable/Disable" . anything-c-advice-toggle))
6212     (persistent-action . anything-c-advice-persistent-action)
6213     (multiline)
6214     (persistent-help . "Describe function / C-u C-z: Toggle advice")))
6215 ;; (let ((debug-on-signal t))(anything 'anything-c-source-advice))
6216 ;; (testadvice)
6217
6218 (defun anything-c-advice-candidates ()
6219   (require 'advice)
6220   (loop for (fname) in ad-advised-functions
6221         for function = (intern fname)
6222         append
6223         (loop for class in ad-advice-classes append
6224               (loop for advice in (ad-get-advice-info-field function class)
6225                     for enabled = (ad-advice-enabled advice)
6226                     collect
6227                     (cons (format
6228                            "%s %s %s"
6229                            (if enabled "Enabled " "Disabled")
6230                            (propertize fname 'face 'font-lock-function-name-face)
6231                            (ad-make-single-advice-docstring advice class nil))
6232                           (list function class advice))))))
6233
6234 (defun anything-c-advice-persistent-action (func-class-advice)
6235   (if current-prefix-arg
6236       (anything-c-advice-toggle func-class-advice)
6237       (describe-function (car func-class-advice))))
6238
6239 (defun anything-c-advice-toggle (func-class-advice)
6240   (destructuring-bind (function class advice) func-class-advice
6241     (cond ((ad-advice-enabled advice)
6242            (ad-advice-set-enabled advice nil)
6243            (message "Disabled"))
6244           (t                            ;disabled
6245            (ad-advice-set-enabled advice t)
6246            (message "Enabled")))
6247     (ad-activate function)
6248     (and anything-in-persistent-action
6249          (anything-c-advice-update-current-display-string))))
6250
6251 (defun anything-c-advice-update-current-display-string ()
6252   (anything-edit-current-selection
6253     (let ((newword (cond ((looking-at "Disabled") "Enabled")
6254                          ((looking-at "Enabled")  "Disabled")))
6255           realvalue)
6256       (when newword
6257         (delete-region (point) (progn (forward-word 1) (point)))
6258         (insert newword)))))
6259
6260 \f
6261 ;;;; <Variable>
6262 ;;; Emacs variables
6263 ;;
6264 ;;
6265 (defvar anything-c-source-emacs-variables
6266   '((name . "Emacs Variables")
6267     (candidates . (lambda ()
6268                     (sort (all-completions "" obarray 'boundp) 'string-lessp)))
6269     (type . variable)
6270     (requires-pattern . 2))
6271   "Source for completing Emacs variables.")
6272
6273 \f
6274 ;;; LaCarte
6275 (defvar anything-c-source-lacarte
6276   '((name . "Lacarte")
6277     (init . (lambda () (require 'lacarte )))
6278     (candidates . (lambda () (delete '(nil) (lacarte-get-overall-menu-item-alist))))
6279     (candidate-number-limit . 9999)
6280     (action . anything-c-call-interactively))
6281   "Needs lacarte.el.
6282
6283 http://www.emacswiki.org/cgi-bin/wiki/download/lacarte.el")
6284
6285 \f
6286 ;;; Bookmarks
6287 ;;
6288 ;;
6289 ;; Bind some faces for bookmarks.
6290 (defvar anything-c-bookmarks-face1 'anything-ff-directory)
6291 (defvar anything-c-bookmarks-face2 'anything-ff-file)
6292 (defvar anything-c-bookmarks-face3 'anything-bookmarks-su-face)
6293
6294 (eval-when-compile (require 'bookmark))
6295 (defvar anything-c-source-bookmarks
6296   `((name . "Bookmarks")
6297     (init . (lambda ()
6298               (require 'bookmark)))
6299     (candidates . bookmark-all-names)
6300     (type . bookmark))
6301   "See (info \"(emacs)Bookmarks\").")
6302
6303 ;;; bookmark-set
6304 (defvar anything-c-source-bookmark-set
6305   '((name . "Set Bookmark")
6306     (dummy)
6307     (action . bookmark-set))
6308   "See (info \"(emacs)Bookmarks\").")
6309
6310 ;;; Visible Bookmarks
6311 ;; (install-elisp "http://cvs.savannah.gnu.org/viewvc/*checkout*/bm/bm/bm.el")
6312
6313
6314 ;; http://d.hatena.ne.jp/grandVin/20080911/1221114327
6315 (defvar anything-c-source-bm
6316   '((name . "Visible Bookmarks")
6317     (init . anything-c-bm-init)
6318     (candidates-in-buffer)
6319     (type . line))
6320   "Needs bm.el.
6321
6322 http://www.nongnu.org/bm/")
6323
6324 (defun anything-c-bm-init ()
6325   "Init function for `anything-c-source-bm'."
6326   (when (require 'bm nil t)
6327     (with-no-warnings
6328       (let ((bookmarks (bm-lists))
6329             (buf (anything-candidate-buffer 'global)))
6330         (dolist (bm (sort* (append (car bookmarks) (cdr bookmarks))
6331                            '< :key 'overlay-start))
6332           (let ((start (overlay-start bm))
6333                 (end (overlay-end bm))
6334                 (annotation (or (overlay-get bm 'annotation) "")))
6335             (unless (< (- end start) 1) ; org => (if (< (- end start) 2)
6336               (let ((str (format "%5d: [%s]: %s\n"
6337                                  (line-number-at-pos start)
6338                                  annotation
6339                                  (buffer-substring start (1- end)))))
6340                 (with-current-buffer buf (insert str))))))))))
6341
6342 ;;; Special bookmarks
6343 (defvar anything-c-source-bookmarks-ssh
6344   '((name . "Bookmarks-ssh")
6345     (init . (lambda ()
6346               (require 'bookmark)))
6347     (candidates . (lambda () (anything-c-collect-bookmarks :ssh t)))
6348     (type . bookmark))
6349   "See (info \"(emacs)Bookmarks\").")
6350
6351 (defvar anything-c-source-bookmarks-su
6352   '((name . "Bookmarks-root")
6353     (init . (lambda ()
6354               (require 'bookmark)))
6355     (candidates . (lambda () (anything-c-collect-bookmarks :su t)))
6356     (filtered-candidate-transformer anything-c-highlight-bookmark-su)
6357
6358     (type . bookmark))
6359   "See (info \"(emacs)Bookmarks\").")
6360
6361 (defvar anything-c-source-bookmarks-local
6362   '((name . "Bookmarks-Local")
6363     (init . (lambda ()
6364               (require 'bookmark)))
6365     (candidates . (lambda () (anything-c-collect-bookmarks :local t)))
6366     (filtered-candidate-transformer
6367      anything-c-adaptive-sort
6368      anything-c-highlight-bookmark)
6369     (type . bookmark))
6370   "See (info \"(emacs)Bookmarks\").")
6371
6372 (defun* anything-c-collect-bookmarks (&key local su sudo ssh)
6373   (let* ((lis-all (bookmark-all-names))
6374          (lis-loc (cond (local (loop for i in lis-all
6375                                      unless (string-match "^(ssh)\\|^(su)" i)
6376                                      collect i))
6377                         (su (loop for i in lis-all
6378                                   when (string-match "^(su)" i)
6379                                   collect i))
6380                         (sudo (loop for i in lis-all
6381                                     when (string-match "^(sudo)" i)
6382                                     collect i))
6383                         (ssh (loop for i in lis-all
6384                                    when (string-match "^(ssh)" i)
6385                                    collect i)))))
6386     (sort lis-loc 'string-lessp)))
6387
6388 (defun anything-c-bookmark-root-logged-p ()
6389   (catch 'break
6390     (dolist (i (mapcar #'buffer-name (buffer-list)))
6391       (when (string-match (format "*tramp/%s ." anything-su-or-sudo) i)
6392         (throw 'break t)))))
6393
6394 (defun anything-c-highlight-bookmark-su (files source)
6395   (if (anything-c-bookmark-root-logged-p)
6396       (anything-c-highlight-bookmark files source)
6397       (anything-c-highlight-not-logged files source)))
6398
6399 (defun anything-c-highlight-not-logged (files source)
6400   (loop for i in files
6401         collect (propertize i 'face anything-c-bookmarks-face3)))
6402
6403 (defun anything-c-highlight-bookmark (bookmarks source)
6404   "Used as `candidate-transformer' to colorize bookmarks.
6405 Work both with standard Emacs bookmarks and bookmark-extensions.el."
6406   (loop for i in bookmarks
6407         for isfile        = (bookmark-get-filename i)
6408         for bufp          = (and (fboundp 'bmkext-get-buffer-name)
6409                                  (bmkext-get-buffer-name i))
6410         for handlerp      = (and (fboundp 'bookmark-get-handler)
6411                                  (bookmark-get-handler i))
6412         for isw3m         = (and (fboundp 'bmkext-w3m-bookmark-p)
6413                                  (bmkext-w3m-bookmark-p i))
6414         for isgnus        = (and (fboundp 'bmkext-gnus-bookmark-p)
6415                                  (bmkext-gnus-bookmark-p i))
6416         for isman         = (and (fboundp 'bmkext-man-bookmark-p) ; Man
6417                                  (bmkext-man-bookmark-p i))
6418         for iswoman       = (and (fboundp 'bmkext-woman-bookmark-p) ; Woman
6419                                  (bmkext-woman-bookmark-p i))
6420         for handlerp      = (bookmark-get-handler i)
6421         for isannotation  = (bookmark-get-annotation i)
6422         for isabook       = (string= (bookmark-prop-get i 'type) "addressbook")
6423         for isinfo        = (eq handlerp 'Info-bookmark-jump)
6424         ;; Add a * if bookmark have annotation
6425         if (and isannotation (not (string-equal isannotation "")))
6426         do (setq i (concat "*" i))
6427         collect (cond (;; info buffers
6428                        isinfo
6429                        (propertize i 'face 'anything-bmkext-info 'help-echo isfile))
6430                       (;; w3m buffers
6431                        isw3m
6432                        (propertize i 'face 'anything-bmkext-w3m 'help-echo isfile))
6433                       (;; gnus buffers
6434                        isgnus
6435                        (propertize i 'face 'anything-bmkext-gnus 'help-echo isfile))
6436                       (;; Man Woman
6437                        (or iswoman isman)
6438                        (propertize i 'face 'anything-bmkext-man 'help-echo isfile))
6439                       (;; Addressbook
6440                        isabook
6441                        (propertize i 'face '((:foreground "Tomato"))))
6442                       (;; directories
6443                        (and isfile (file-directory-p isfile))
6444                        (propertize i 'face anything-c-bookmarks-face1 'help-echo isfile))
6445                       (;; regular files
6446                        t
6447                        (propertize i 'face 'anything-bmkext-file 'help-echo isfile)))))
6448
6449 (defun anything-c-bookmark-jump (candidate)
6450   "Jump to bookmark from keyboard."
6451   (let ((current-prefix-arg anything-current-prefix-arg))
6452     (bookmark-jump candidate)))
6453
6454 ;;;###autoload
6455 (defun anything-c-bookmark-run-jump-other-window ()
6456   "Jump to bookmark from keyboard."
6457   (interactive)
6458   (anything-c-quit-and-execute-action 'bookmark-jump-other-window))
6459
6460 ;;;###autoload
6461 (defun anything-c-bookmark-run-delete ()
6462   "Delete bookmark from keyboard."
6463   (interactive)
6464   (when (y-or-n-p "Delete bookmark?")
6465     (anything-c-quit-and-execute-action 'anything-delete-marked-bookmarks)))
6466
6467 \f
6468 ;;; Sources to filter bookmark-extensions bookmarks.
6469 ;;
6470 ;;
6471 ;; Dependency: http://mercurial.intuxication.org/hg/emacs-bookmark-extension
6472 ;; If you want to enable google-maps in addressbook you will need
6473 ;; Julien Danjou google-maps-el package available here:
6474 ;; http://julien.danjou.info/google-maps-el.html
6475
6476 (defun anything-c-bmkext-filter-setup-alist (fn &rest args)
6477   "Return a filtered `bookmark-alist' sorted alphabetically."
6478   (loop
6479         with alist = (if args
6480                          (apply #'(lambda (x) (funcall fn x)) args)
6481                          (funcall fn))
6482         for i in alist
6483         for b = (car i)
6484         collect b into sa
6485         finally return (sort sa 'string-lessp)))
6486
6487 ;;;###autoload
6488 (defun anything-c-bmkext-run-edit ()
6489   "Run `bmkext-edit-bookmark' from keyboard."
6490   (interactive)
6491   (anything-c-quit-and-execute-action 'bmkext-edit-bookmark))
6492
6493 ;;; Addressbook.
6494 ;;
6495 ;;
6496 (defvar anything-c-source-bmkext-addressbook
6497   '((name . "Bookmark Addressbook")
6498     (init . (lambda ()
6499               (require 'bookmark-extensions)
6500               (bookmark-maybe-load-default-file)))
6501     (candidates . anything-c-bmkext-addressbook-setup-alist)
6502     (persistent-action
6503      . (lambda (candidate)
6504          (let ((bmk (anything-bookmark-get-bookmark-from-name
6505                      candidate)))
6506            (bookmark--jump-via bmk 'pop-to-buffer))))
6507     (persistent-help . "Show contact - Prefix with C-u to append")
6508     (filtered-candidate-transformer
6509      anything-c-adaptive-sort
6510      anything-c-highlight-bookmark)
6511     (action . (("Show Contact(s)"
6512                 . (lambda (candidate)
6513                     (let* ((contacts (anything-marked-candidates))
6514                            (current-prefix-arg (or anything-current-prefix-arg
6515                                                    (> (length contacts) 1))))
6516                       (bookmark-jump
6517                        (anything-bookmark-get-bookmark-from-name (car contacts)))
6518                       (anything-aif (cdr contacts)
6519                           (loop for bmk in it do
6520                                 (bookmark-jump
6521                                  (anything-bookmark-get-bookmark-from-name bmk)))))))
6522                ("Send Mail"
6523                 . (lambda (candidate)
6524                     (let* ((contacts (anything-marked-candidates))
6525                            (bmk      (anything-bookmark-get-bookmark-from-name
6526                                       (car contacts)))
6527                            (append   (message-buffers)))
6528                       (if append
6529                           (addressbook-set-mail-buffer1 bmk 'append)
6530                           (addressbook-set-mail-buffer1 bmk))
6531                       (setq contacts (cdr contacts))
6532                       (when contacts
6533                         (loop for bmk in contacts do
6534                               (addressbook-set-mail-buffer1 bmk 'append))))))
6535                ("Edit Bookmark"
6536                 . (lambda (candidate)
6537                     (let ((bmk (anything-bookmark-get-bookmark-from-name
6538                                 candidate)))
6539                       (addressbook-bookmark-edit
6540                        (assoc bmk bookmark-alist)))))
6541                ("Insert Email at point"
6542                 . (lambda (candidate)
6543                     (let* ((bmk   (anything-bookmark-get-bookmark-from-name
6544                                    candidate))
6545                            (mlist (split-string
6546                                    (assoc-default
6547                                     'email (assoc bmk bookmark-alist))
6548                                    ", ")))
6549                       (insert
6550                        (if (> (length mlist) 1)
6551                            (anything-comp-read
6552                             "Insert Mail Address: " mlist :must-match t)
6553                            (car mlist))))))
6554                ("Show annotation"
6555                 . (lambda (candidate)
6556                     (let ((bmk (anything-bookmark-get-bookmark-from-name
6557                                 candidate)))
6558                       (bookmark-show-annotation bmk))))
6559                ("Edit annotation"
6560                 . (lambda (candidate)
6561                     (let ((bmk (anything-bookmark-get-bookmark-from-name
6562                                 candidate)))
6563                       (bookmark-edit-annotation bmk))))
6564                ("Show Google map"
6565                 . (lambda (candidate)
6566                     (let* ((bmk (anything-bookmark-get-bookmark-from-name
6567                                  candidate))
6568                            (full-bmk (assoc bmk bookmark-alist)))
6569                       (addressbook-google-map full-bmk))))))))
6570
6571
6572 (defun anything-c-bmkext-addressbook-setup-alist ()
6573   "Specialized filter function for bookmarks w3m."
6574   (anything-c-bmkext-filter-setup-alist 'bmkext-addressbook-alist-only))
6575
6576 ;; W3m bookmarks from bookmark-extensions.
6577 (defvar anything-c-source-bookmark-w3m
6578   '((name . "Bookmark W3m")
6579     (init . (lambda ()
6580               (require 'bookmark-extensions)
6581               (bookmark-maybe-load-default-file)))
6582     (candidates . anything-c-bookmark-w3m-setup-alist)
6583     (filtered-candidate-transformer
6584      anything-c-adaptive-sort
6585      anything-c-highlight-bookmark)
6586     (type . bookmark)))
6587
6588 (defun anything-c-bookmark-w3m-setup-alist ()
6589   "Specialized filter function for bookmarks w3m."
6590   (anything-c-bmkext-filter-setup-alist 'bmkext-w3m-alist-only))
6591
6592 ;; Images
6593 (defvar anything-c-source-bookmark-images
6594   '((name . "Bookmark Images")
6595     (init . (lambda ()
6596               (require 'bookmark-extensions)
6597               (bookmark-maybe-load-default-file)))
6598     (candidates . anything-c-bookmark-images-setup-alist)
6599     (filtered-candidate-transformer
6600      anything-c-adaptive-sort
6601      anything-c-highlight-bookmark)
6602     (type . bookmark)))
6603
6604 (defun anything-c-bookmark-images-setup-alist ()
6605   "Specialized filter function for images bookmarks."
6606   (anything-c-bmkext-filter-setup-alist 'bmkext-image-file-alist-only))
6607
6608 ;; Woman Man
6609 (defvar anything-c-source-bookmark-man
6610   '((name . "Bookmark Woman&Man")
6611     (init . (lambda ()
6612               (require 'bookmark-extensions)
6613               (bookmark-maybe-load-default-file)))
6614     (candidates . anything-c-bookmark-man-setup-alist)
6615     (filtered-candidate-transformer
6616      anything-c-adaptive-sort
6617      anything-c-highlight-bookmark)
6618     (type . bookmark)))
6619
6620 (defun anything-c-bookmark-man-setup-alist ()
6621   "Specialized filter function for bookmarks w3m."
6622   (append (anything-c-bmkext-filter-setup-alist 'bmkext-man-alist-only)
6623           (anything-c-bmkext-filter-setup-alist 'bmkext-woman-alist-only)))
6624
6625 ;; Gnus
6626 (defvar anything-c-source-bookmark-gnus
6627   '((name . "Bookmark Gnus")
6628     (init . (lambda ()
6629               (require 'bookmark-extensions)
6630               (bookmark-maybe-load-default-file)))
6631     (candidates . anything-c-bookmark-gnus-setup-alist)
6632     (filtered-candidate-transformer
6633      anything-c-adaptive-sort
6634      anything-c-highlight-bookmark)
6635     (type . bookmark)))
6636
6637 (defun anything-c-bookmark-gnus-setup-alist ()
6638   "Specialized filter function for bookmarks gnus."
6639   (anything-c-bmkext-filter-setup-alist 'bmkext-gnus-alist-only))
6640
6641 ;; Info
6642 (defvar anything-c-source-bookmark-info
6643   '((name . "Bookmark Info")
6644     (init . (lambda ()
6645               (require 'bookmark-extensions)
6646               (bookmark-maybe-load-default-file)))
6647     (candidates . anything-c-bookmark-info-setup-alist)
6648     (filtered-candidate-transformer
6649      anything-c-adaptive-sort
6650      anything-c-highlight-bookmark)
6651     (type . bookmark)))
6652
6653 (defun anything-c-bookmark-info-setup-alist ()
6654   "Specialized filter function for bookmarks info."
6655   (anything-c-bmkext-filter-setup-alist 'bmkext-info-alist-only))
6656
6657 ;; Local Files&directories
6658 (defvar anything-c-source-bookmark-files&dirs
6659   '((name . "Bookmark Files&Directories")
6660     (init . (lambda ()
6661               (require 'bookmark-extensions)
6662               (bookmark-maybe-load-default-file)))
6663     (candidates . anything-c-bookmark-local-files-setup-alist)
6664     (filtered-candidate-transformer
6665      anything-c-adaptive-sort
6666      anything-c-highlight-bookmark)
6667     (type . bookmark)))
6668
6669 (defun anything-c-bookmark-local-files-setup-alist ()
6670   "Specialized filter function for bookmarks locals files."
6671   (anything-c-bmkext-filter-setup-alist 'bmkext-local-file-alist-only))
6672
6673 ;; Su Files&directories
6674 (defvar anything-c-source-bookmark-su-files&dirs
6675   '((name . "Bookmark Root-Files&Directories")
6676     (init . (lambda ()
6677               (require 'bookmark-extensions)
6678               (bookmark-maybe-load-default-file)))
6679     (candidates . anything-c-bookmark-su-files-setup-alist)
6680     (filtered-candidate-transformer
6681      anything-c-adaptive-sort
6682      anything-c-highlight-bookmark-su)
6683     (type . bookmark)))
6684
6685 (defun anything-c-bookmark-su-files-setup-alist ()
6686   "Specialized filter function for bookmarks su/sudo files."
6687   (declare (special bmkext-su-or-sudo-regexp))
6688   (loop
6689         with l = (anything-c-bmkext-filter-setup-alist 'bmkext-remote-file-alist-only)
6690         for i in l
6691         for isfile = (bookmark-get-filename i)
6692         for istramp = (and isfile (boundp 'tramp-file-name-regexp)
6693                            (save-match-data
6694                              (string-match tramp-file-name-regexp isfile)))
6695         for issu = (and istramp
6696                         (string-match bmkext-su-or-sudo-regexp isfile))
6697         if issu
6698         collect i))
6699
6700 ;; Ssh Files&directories
6701 (defvar anything-c-source-bookmark-ssh-files&dirs
6702   '((name . "Bookmark Ssh-Files&Directories")
6703     (init . (lambda ()
6704               (require 'bookmark-extensions)
6705               (bookmark-maybe-load-default-file)))
6706     (candidates . anything-c-bookmark-ssh-files-setup-alist)
6707     (filtered-candidate-transformer . anything-c-adaptive-sort)
6708     (type . bookmark)))
6709
6710 (defun anything-c-bookmark-ssh-files-setup-alist ()
6711   "Specialized filter function for bookmarks ssh files."
6712   (loop
6713         with l = (anything-c-bmkext-filter-setup-alist 'bmkext-remote-file-alist-only)
6714         for i in l
6715         for isfile = (bookmark-get-filename i)
6716         for istramp = (and isfile (boundp 'tramp-file-name-regexp)
6717                            (save-match-data
6718                              (string-match tramp-file-name-regexp isfile)))
6719         for isssh = (and istramp
6720                          (string-match "/ssh:" isfile))
6721         if isssh
6722         collect i))
6723
6724
6725 \f
6726 ;;; Firefox bookmarks
6727 ;;
6728 ;;
6729 ;; You will have to set firefox to import bookmarks in his html file bookmarks.html.
6730 ;; (only for firefox versions >=3)
6731 ;; To achieve that, open about:config in firefox and double click on this line to enable value
6732 ;; to true:
6733 ;; user_pref("browser.bookmarks.autoExportHTML", false);
6734 ;; You should have now:
6735 ;; user_pref("browser.bookmarks.autoExportHTML", true);
6736 ;; NOTE: This is also working in the same way for mozilla aka seamonkey.
6737
6738 (defvar anything-firefox-bookmark-url-regexp "\\(https\\|http\\|ftp\\|about\\|file\\)://[^ \"]*")
6739 (defvar anything-firefox-bookmarks-regexp ">\\([^><]+.[^</a>]\\)")
6740
6741 (defun anything-get-firefox-user-init-dir ()
6742   "Guess the default Firefox user directory name."
6743   (let* ((moz-dir (concat (getenv "HOME") "/.mozilla/firefox/"))
6744          (moz-user-dir
6745           (with-current-buffer (find-file-noselect (concat moz-dir "profiles.ini"))
6746             (goto-char (point-min))
6747             (prog1
6748                 (when (search-forward "Path=" nil t)
6749                   (buffer-substring-no-properties (point) (point-at-eol)))
6750               (kill-buffer)))))
6751     (file-name-as-directory (concat moz-dir moz-user-dir))))
6752
6753 (defun anything-guess-firefox-bookmark-file ()
6754   "Return the path of the Firefox bookmarks file."
6755   (concat (anything-get-firefox-user-init-dir) "bookmarks.html"))
6756
6757 (defun anything-html-bookmarks-to-alist (file url-regexp bmk-regexp)
6758   "Parse html bookmark FILE and return an alist with (title . url) as elements."
6759   (let (bookmarks-alist url title)
6760     (with-temp-buffer
6761       (insert-file-contents file)
6762       (goto-char (point-min))
6763       (while (re-search-forward "href=\\|^ *<DT><A HREF=" nil t)
6764         (forward-line 0)
6765         (when (re-search-forward url-regexp nil t)
6766           (setq url (match-string 0)))
6767         (when (re-search-forward bmk-regexp nil t)
6768           (setq title (match-string 1)))
6769         (push (cons title url) bookmarks-alist)
6770         (forward-line)))
6771     (nreverse bookmarks-alist)))
6772
6773 (defvar anything-c-firefox-bookmarks-alist nil)
6774 (defvar anything-c-source-firefox-bookmarks
6775   '((name . "Firefox Bookmarks")
6776     (init . (lambda ()
6777               (setq anything-c-firefox-bookmarks-alist
6778                     (anything-html-bookmarks-to-alist
6779                      (anything-guess-firefox-bookmark-file)
6780                      anything-firefox-bookmark-url-regexp
6781                      anything-firefox-bookmarks-regexp))))
6782     (candidates . (lambda ()
6783                     (mapcar #'car anything-c-firefox-bookmarks-alist)))
6784     (filtered-candidate-transformer
6785      anything-c-adaptive-sort
6786      anything-c-highlight-firefox-bookmarks)
6787     (action . (("Browse Url"
6788                 . (lambda (candidate)
6789                     (anything-c-browse-url
6790                      (anything-c-firefox-bookmarks-get-value candidate))))
6791                ("Copy Url"
6792                 . (lambda (elm)
6793                     (kill-new (anything-c-w3m-bookmarks-get-value elm))))))))
6794
6795
6796 (defun anything-c-firefox-bookmarks-get-value (elm)
6797   (assoc-default elm anything-c-firefox-bookmarks-alist))
6798
6799 (defun anything-c-highlight-firefox-bookmarks (bookmarks source)
6800   (loop for i in bookmarks
6801         collect (propertize
6802                  i 'face '((:foreground "YellowGreen"))
6803                  'help-echo (anything-c-firefox-bookmarks-get-value i))))
6804
6805
6806 \f
6807 ;;; W3m bookmark - anything interface.
6808 ;;
6809 ;;
6810 ;; Some users have the emacs-w3m library in load-path
6811 ;; without having the w3m executable :-;
6812 ;; So check if w3m program is present before trying to load
6813 ;; emacs-w3m.
6814 (eval-when-compile
6815   (when (executable-find "w3m")
6816     (require 'w3m-bookmark nil t)))
6817
6818 (defvar w3m-bookmark-file "~/.w3m/bookmark.html")
6819 (defvar anything-w3m-bookmarks-regexp ">\\([^><]+.[^</a>]\\)")
6820 (defvar anything-w3m-bookmark-url-regexp "\\(https\\|http\\|ftp\\|file\\)://[^>]*")
6821 (defvar anything-c-w3m-bookmarks-alist nil)
6822 (defvar anything-c-source-w3m-bookmarks
6823   '((name . "W3m Bookmarks")
6824     (init . (lambda ()
6825               (setq anything-c-w3m-bookmarks-alist
6826                     (anything-html-bookmarks-to-alist
6827                      w3m-bookmark-file
6828                      anything-w3m-bookmark-url-regexp
6829                      anything-w3m-bookmarks-regexp))))
6830     (candidates . (lambda ()
6831                     (mapcar #'car anything-c-w3m-bookmarks-alist)))
6832     (filtered-candidate-transformer
6833      anything-c-adaptive-sort
6834      anything-c-highlight-w3m-bookmarks)
6835     (action . (("Browse Url"
6836                 . (lambda (candidate)
6837                     (anything-c-w3m-browse-bookmark candidate)))
6838                ("Copy Url"
6839                 . (lambda (elm)
6840                     (kill-new (anything-c-w3m-bookmarks-get-value elm))))
6841                ("Browse Url Externally"
6842                 . (lambda (candidate)
6843                     (anything-c-w3m-browse-bookmark candidate t)))
6844                ("Delete Bookmark"
6845                 . (lambda (candidate)
6846                     (anything-c-w3m-delete-bookmark candidate)))
6847                ("Rename Bookmark"
6848                 . (lambda (candidate)
6849                     (anything-c-w3m-rename-bookmark candidate)))))
6850     (persistent-action . (lambda (candidate)
6851                            (if current-prefix-arg
6852                                (anything-c-w3m-browse-bookmark candidate t)
6853                                (anything-c-w3m-browse-bookmark candidate nil t))))
6854     (persistent-help . "Open URL with emacs-w3m in new tab / \
6855 C-u \\[anything-execute-persistent-action]: Open URL with Firefox"))
6856   "Needs w3m and emacs-w3m.
6857
6858 http://w3m.sourceforge.net/
6859 http://emacs-w3m.namazu.org/")
6860
6861
6862 (defun anything-c-w3m-bookmarks-get-value (elm)
6863   (replace-regexp-in-string
6864    "\"" "" (cdr (assoc elm anything-c-w3m-bookmarks-alist))))
6865
6866 (defun anything-c-w3m-browse-bookmark (elm &optional use-external new-tab)
6867   (let* ((fn  (if use-external 'anything-c-browse-url 'w3m-browse-url))
6868          (arg (and (eq fn 'w3m-browse-url) new-tab)))
6869     (funcall fn (anything-c-w3m-bookmarks-get-value elm) arg)))
6870
6871 (defun anything-c-highlight-w3m-bookmarks (bookmarks source)
6872   (loop for i in bookmarks
6873         collect (propertize
6874                  i 'face 'anything-w3m-bookmarks-face
6875                  'help-echo (anything-c-w3m-bookmarks-get-value i))))
6876
6877
6878 (defun anything-c-w3m-delete-bookmark (elm)
6879   "Delete w3m bookmark from `w3m-bookmark-file'."
6880   (with-current-buffer
6881       (find-file-literally w3m-bookmark-file)
6882     (goto-char (point-min))
6883     (when (re-search-forward elm nil t)
6884       (beginning-of-line)
6885       (delete-region (point)
6886                      (line-end-position))
6887       (delete-blank-lines))
6888     (save-buffer)
6889     (kill-buffer)))
6890
6891 (defun anything-c-w3m-rename-bookmark (elm)
6892   "Rename w3m bookmark in `w3m-bookmark-file'."
6893   (let* ((old-title (replace-regexp-in-string ">" "" elm))
6894          (new-title (read-string "NewTitle: " old-title)))
6895     (with-current-buffer
6896         (find-file-literally w3m-bookmark-file)
6897       (goto-char (point-min))
6898       (when (re-search-forward (concat elm "<") nil t)
6899         (goto-char (1- (point)))
6900         (delete-char (- (length old-title)))
6901         (insert new-title))
6902       (save-buffer)
6903       (kill-buffer))))
6904
6905 \f
6906 ;;;; <Library>
6907 ;;; Elisp library scan
6908 ;;
6909 ;;
6910 (defvar anything-c-source-elisp-library-scan
6911   '((name . "Elisp libraries (Scan)")
6912     (init . (anything-c-elisp-library-scan-init))
6913     (candidates-in-buffer)
6914     (action ("Find library"
6915              . (lambda (candidate) (find-file (find-library-name candidate))))
6916      ("Find library other window"
6917       . (lambda (candidate)
6918           (find-file-other-window (find-library-name candidate))))
6919      ("Load library"
6920       . (lambda (candidate) (load-library candidate))))))
6921
6922 (defun anything-c-elisp-library-scan-init ()
6923   "Init anything buffer status."
6924   (let ((anything-buffer (anything-candidate-buffer 'global))
6925         (library-list (anything-c-elisp-library-scan-list)))
6926     (with-current-buffer anything-buffer
6927       (dolist (library library-list)
6928         (insert (format "%s\n" library))))))
6929
6930 (defun anything-c-elisp-library-scan-list (&optional dirs string)
6931   "Do completion for file names passed to `locate-file'.
6932 DIRS is directory to search path.
6933 STRING is string to match."
6934   ;; Use `load-path' as path when ignore `dirs'.
6935   (or dirs (setq dirs load-path))
6936   ;; Init with blank when ignore `string'.
6937   (or string (setq string ""))
6938   ;; Get library list.
6939   (let ((string-dir (file-name-directory string))
6940         ;; File regexp that suffix match `load-file-rep-suffixes'.
6941         (match-regexp (format "^.*\\.el%s$" (regexp-opt load-file-rep-suffixes)))
6942         name
6943         names)
6944     (dolist (dir dirs)
6945       (unless dir
6946         (setq dir default-directory))
6947       (if string-dir
6948           (setq dir (expand-file-name string-dir dir)))
6949       (when (file-directory-p dir)
6950         (dolist (file (file-name-all-completions
6951                        (file-name-nondirectory string) dir))
6952           ;; Suffixes match `load-file-rep-suffixes'.
6953           (setq name (if string-dir (concat string-dir file) file))
6954           (if (string-match match-regexp name)
6955               (add-to-list 'names name)))))
6956     names))
6957
6958 \f
6959 ;;;; <Programming>
6960 ;;
6961 ;;
6962
6963 ;;; Imenu
6964 ;;
6965 ;;
6966 (defvar anything-c-imenu-delimiter " / ")
6967
6968 (defvar anything-c-imenu-index-filter nil)
6969 (make-variable-buffer-local 'anything-c-imenu-index-filter)
6970
6971 (defvar anything-c-cached-imenu-alist nil)
6972 (make-variable-buffer-local 'anything-c-cached-imenu-alist)
6973
6974 (defvar anything-c-cached-imenu-candidates nil)
6975 (make-variable-buffer-local 'anything-c-cached-imenu-candidates)
6976
6977 (defvar anything-c-cached-imenu-tick nil)
6978 (make-variable-buffer-local 'anything-c-cached-imenu-tick)
6979
6980 (eval-when-compile (require 'imenu))
6981 (setq imenu-auto-rescan t)
6982
6983 (defun anything-imenu-create-candidates (entry)
6984   "Create candidates with ENTRY."
6985   (if (listp (cdr entry))
6986       (mapcan
6987        (lambda (sub)
6988          (if (consp (cdr sub))
6989              (mapcar
6990               (lambda (subentry)
6991                 (concat (car entry) anything-c-imenu-delimiter subentry))
6992               (anything-imenu-create-candidates sub))
6993              (list (concat (car entry) anything-c-imenu-delimiter (car sub)))))
6994        (cdr entry))
6995       (list entry)))
6996
6997 (defvar anything-c-source-imenu
6998   '((name . "Imenu")
6999     (init . (lambda () (require 'imenu)))
7000     (candidates . anything-c-imenu-candidates)
7001     (persistent-action . (lambda (elm)
7002                            (anything-c-imenu-default-action elm)
7003                            (unless (fboundp 'semantic-imenu-tag-overlay)
7004                              (anything-match-line-color-current-line))))
7005     (persistent-help . "Show this entry")
7006     (action . anything-c-imenu-default-action))
7007   "See (info \"(emacs)Imenu\")")
7008
7009
7010 (defun anything-c-imenu-candidates ()
7011   (with-anything-current-buffer
7012     (let ((tick (buffer-modified-tick)))
7013       (if (eq anything-c-cached-imenu-tick tick)
7014           anything-c-cached-imenu-candidates
7015           (setq imenu--index-alist nil)
7016           (setq anything-c-cached-imenu-tick tick
7017                 anything-c-cached-imenu-candidates
7018                 (ignore-errors
7019                   (mapcan
7020                    'anything-imenu-create-candidates
7021                    (setq anything-c-cached-imenu-alist
7022                          (let ((index (imenu--make-index-alist)))
7023                            (if anything-c-imenu-index-filter
7024                                (funcall anything-c-imenu-index-filter index)
7025                                index))))))
7026           (setq anything-c-cached-imenu-candidates
7027                 (mapcar #'(lambda (x)
7028                             (if (stringp x)
7029                                 x
7030                                 (car x)))
7031                         anything-c-cached-imenu-candidates))))))
7032
7033 (setq imenu-default-goto-function 'imenu-default-goto-function)
7034 (defun anything-c-imenu-default-action (elm)
7035   "The default action for `anything-c-source-imenu'."
7036   (let ((path (split-string elm anything-c-imenu-delimiter))
7037         (alist anything-c-cached-imenu-alist))
7038     (dolist (elm path)
7039       (setq alist (assoc elm alist)))
7040     (imenu alist)))
7041
7042
7043 \f
7044 ;;; Ctags
7045 ;;
7046 ;;
7047 (defvar anything-c-ctags-modes
7048   '( c-mode c++-mode awk-mode csharp-mode java-mode javascript-mode lua-mode
7049     makefile-mode pascal-mode perl-mode cperl-mode php-mode python-mode
7050     scheme-mode sh-mode slang-mode sql-mode tcl-mode ))
7051
7052 (defun anything-c-source-ctags-init ()
7053   (when (and buffer-file-name
7054              (memq major-mode anything-c-ctags-modes)
7055              (anything-current-buffer-is-modified))
7056     (with-current-buffer (anything-candidate-buffer 'local)
7057       (call-process-shell-command
7058        (if (string-match "\\.el\\.gz$" anything-buffer-file-name)
7059            (format "ctags -e -u -f- --language-force=lisp --fields=n =(zcat %s) "
7060                    anything-buffer-file-name)
7061            (format "ctags -e -u -f- --fields=n %s " anything-buffer-file-name))
7062        nil (current-buffer))
7063       (goto-char (point-min))
7064       (forward-line 2)
7065       (delete-region (point-min) (point))
7066       (loop while (and (not (eobp)) (search-forward "\001" (point-at-eol) t))
7067             for lineno-start = (point)
7068             for lineno = (buffer-substring
7069                           lineno-start
7070                           (1- (search-forward "," (point-at-eol) t)))
7071             do
7072             (beginning-of-line)
7073             (insert (format "%5s:" lineno))
7074             (search-forward "\177" (point-at-eol) t)
7075             (delete-region (1- (point)) (point-at-eol))
7076             (forward-line 1)))))
7077
7078 (defvar anything-c-source-ctags
7079   '((name . "Exuberant ctags")
7080     (init . anything-c-source-ctags-init)
7081     (candidates-in-buffer)
7082     (adjust)
7083     (type . line))
7084   "Needs Exuberant Ctags.
7085
7086 http://ctags.sourceforge.net/")
7087
7088 \f
7089 ;;; Etags
7090 ;;
7091 ;;
7092 ;; anything-etags.el is deprecated, if this file is found,
7093 ;; warn user at compile time.
7094 (eval-when-compile
7095   (when (locate-library "anything-etags.el")
7096     (display-warning
7097      '(anything-config)
7098      "You are using obsolete library `anything-etags.el' and should remove it."
7099      :warning)))
7100
7101 (defvar anything-c-etags-tag-file-dir nil
7102   "Etags file directory.")
7103 (defvar anything-c-etags-mtime-alist nil
7104   "Store the last modification time of etags files here.")
7105 (defvar anything-c-etags-cache (make-hash-table :test 'equal)
7106   "Cache content of etags files used here for faster access.")
7107
7108 (defun anything-c-etags-get-tag-file (&optional directory)
7109   "Return the path of etags file if found."
7110   ;; Get tag file from `default-directory' or upper directory.
7111   (let ((current-dir (anything-c-etags-find-tag-file-directory
7112                       (or directory default-directory))))
7113     ;; Return nil if not find tag file.
7114     (when current-dir
7115       ;; Set tag file directory.
7116       (setq anything-c-etags-tag-file-dir current-dir)
7117       (expand-file-name anything-c-etags-tag-file-name current-dir))))
7118
7119 (defun anything-c-etags-find-tag-file-directory (current-dir)
7120   "Try to find the directory containing tag file.
7121 If not found in CURRENT-DIR search in upper directory."
7122   (flet ((file-exists? (dir)
7123            (let ((tag-path (expand-file-name
7124                             anything-c-etags-tag-file-name dir)))
7125              (and (stringp tag-path)
7126                   (file-regular-p tag-path)
7127                   (file-readable-p tag-path)))))
7128     (loop with count = 0
7129           until (file-exists? current-dir)
7130           ;; Return nil if outside the value of
7131           ;; `anything-c-etags-tag-file-search-limit'.
7132           if (= count anything-c-etags-tag-file-search-limit)
7133           do (return nil)
7134           ;; Or search upper directories.
7135           else
7136           do (incf count)
7137           (setq current-dir (expand-file-name (concat current-dir "../")))
7138           finally return current-dir)))
7139
7140 (defun anything-c-source-etags-header-name (x)
7141   "Create header name for this anything etags session."
7142   (concat "Etags in "
7143           (with-anything-current-buffer
7144             (anything-c-etags-get-tag-file))))
7145
7146 (defmacro anything-c-etags-create-buffer (file)
7147   "Create the `anything-buffer' based on contents of etags tag FILE."
7148   `(let* ((tag-fname ,file)
7149           max
7150           (split (with-current-buffer (find-file-noselect tag-fname)
7151                    (prog1
7152                        (split-string (buffer-string) "\n" 'omit-nulls)
7153                      (setq max (line-number-at-pos (point-max)))
7154                      (kill-buffer))))
7155           (progress-reporter (make-progress-reporter "Loading tag file..." 0 max)))
7156      (loop
7157            with fname
7158            with cand
7159            for i in split for count from 0
7160            for elm = (unless (string-match "^\x0c" i)
7161                        (anything-aif (string-match "\177" i)
7162                            (substring i 0 it)
7163                          i))
7164            do (cond ((and elm (string-match "^\\(.+\\),[0-9]+" elm))
7165                      (setq fname (match-string 1 elm)))
7166                     (elm (setq cand (concat fname ": " elm)))
7167                     (t (setq cand nil)))
7168            when cand do (progn
7169                           (insert (concat cand "\n"))
7170                           (progress-reporter-update progress-reporter count)))))
7171
7172 (defun anything-c-etags-init ()
7173   "Feed `anything-buffer' using `anything-c-etags-cache' or tag file.
7174 If no entry in cache, create one."
7175   (let ((tagfile (anything-c-etags-get-tag-file)))
7176     (when tagfile
7177       (with-current-buffer (anything-candidate-buffer 'global)
7178         (anything-aif (gethash tagfile anything-c-etags-cache)
7179             ;; An entry is present in cache, insert it.
7180             (insert it)
7181           ;; No entry, create a new buffer using content of tag file (slower).
7182           (anything-c-etags-create-buffer tagfile)
7183           ;; Store content of buffer in cache.
7184           (puthash tagfile (buffer-string) anything-c-etags-cache)
7185           ;; Store or set the last modification of tag file.
7186           (anything-aif (assoc tagfile anything-c-etags-mtime-alist)
7187               ;; If an entry exists modify it.
7188               (setcdr it (anything-c-etags-mtime tagfile))
7189             ;; No entry create a new one.
7190             (add-to-list 'anything-c-etags-mtime-alist
7191                          (cons tagfile (anything-c-etags-mtime tagfile)))))))))
7192
7193 (defvar anything-c-source-etags-select
7194   '((name . "Etags")
7195     (header-name . anything-c-source-etags-header-name)
7196     (init . anything-c-etags-init)
7197     (candidates-in-buffer)
7198     (search . (anything-c-etags-search-fn))
7199     (mode-line . anything-etags-mode-line-string)
7200     (action . anything-c-etags-default-action)
7201     (persistent-action . (lambda (candidate)
7202                            (anything-c-etags-default-action candidate)
7203                            (anything-match-line-color-current-line))))
7204   "Anything source for Etags.")
7205
7206 (defun anything-c-etags-search-fn (pattern)
7207   "Search function for `anything-c-source-etags-select'."
7208   (re-search-forward
7209    (if anything-c-etags-use-regexp-search
7210        (format anything-c-etags-search-regexp pattern)
7211        pattern)
7212    nil t))
7213
7214 (defun anything-c-etags-default-action (candidate)
7215   "Anything default action to jump to an etags entry."
7216   (let* ((split (split-string candidate ": "))
7217          (fname (expand-file-name
7218                  (car split) anything-c-etags-tag-file-dir))
7219          (elm   (cadr split)))
7220     (find-file fname)
7221     (goto-char (point-min))
7222     (search-forward elm nil t)
7223     (goto-char (match-beginning 0))))
7224
7225 (defun anything-c-etags-mtime (file)
7226   "Last modification time of etags tag FILE."
7227   (cadr (nth 5 (file-attributes file))))
7228
7229 (defun anything-c-etags-file-modified-p (file)
7230   "Check if tag FILE have been modified in this session.
7231 If FILE is nil return nil."
7232   (let ((last-modif (and file
7233                          (assoc-default file anything-c-etags-mtime-alist))))
7234     (and last-modif
7235          (/= last-modif (anything-c-etags-mtime file)))))
7236
7237
7238 \f
7239 ;;; Semantic
7240 ;;
7241 ;;
7242 (defvar anything-semantic-candidates nil)
7243
7244 (defun anything-semantic-construct-candidates (tags depth)
7245   (when (require 'semantic nil t)
7246     (apply
7247      'append
7248      (mapcar
7249       (lambda (tag)
7250         (if (listp tag)
7251             (let ((type (semantic-tag-type tag))
7252                   (class (semantic-tag-class tag)))
7253               (if (or (and (stringp type)
7254                            (or (string= type "class")
7255                                (string= type "namespace")))
7256                       (eq class 'function)
7257                       (eq class 'variable))
7258                   (cons (cons (concat (make-string (* depth 2) ?\s)
7259                                       (semantic-format-tag-summarize tag nil t))
7260                               tag)
7261                         (anything-semantic-construct-candidates
7262                          (semantic-tag-components tag) (1+ depth)))))))
7263       tags))))
7264
7265 (defun anything-semantic-default-action (candidate)
7266   (let ((tag (cdr (assoc candidate anything-semantic-candidates))))
7267     (semantic-go-to-tag tag)))
7268
7269 (defvar anything-c-source-semantic
7270   '((name . "Semantic Tags")
7271     (init . (lambda ()
7272               (setq anything-semantic-candidates
7273                     (ignore-errors (anything-semantic-construct-candidates
7274                                     (semantic-fetch-tags) 0)))))
7275     (candidates . (lambda ()
7276                     (if anything-semantic-candidates
7277                         (mapcar 'car anything-semantic-candidates))))
7278     (persistent-action . (lambda (elm)
7279                            (anything-semantic-default-action elm)
7280                            (anything-match-line-color-current-line)))
7281     (persistent-help . "Show this entry")
7282     (action . anything-semantic-default-action)
7283     "Needs semantic in CEDET.
7284
7285 http://cedet.sourceforge.net/semantic.shtml
7286 http://cedet.sourceforge.net/"))
7287
7288
7289 \f
7290 ;;; Anything interface of `simple-call-tree.el'.
7291 ;;
7292 ;; <http://www.emacswiki.org/cgi-bin/wiki/download/simple-call-tree.el>
7293 ;;
7294 ;; Function is called by
7295 (defvar anything-c-source-simple-call-tree-functions-callers
7296   '((name . "Function is called by")
7297     (init . anything-c-simple-call-tree-functions-callers-init)
7298     (multiline)
7299     (candidates . anything-c-simple-call-tree-candidates)
7300     (persistent-action . anything-c-simple-call-tree-persistent-action)
7301     (persistent-help . "Show function definitions by rotation")
7302     (action ("Find definition selected by persistent-action" .
7303              anything-c-simple-call-tree-find-definition)))
7304   "Needs simple-call-tree.el.
7305 http://www.emacswiki.org/cgi-bin/wiki/download/simple-call-tree.el")
7306
7307 (defvar anything-c-simple-call-tree-tick nil)
7308 (make-variable-buffer-local 'anything-c-simple-call-tree-tick)
7309 (defun anything-c-simple-call-tree-analyze-maybe ()
7310   (unless (eq (buffer-chars-modified-tick) anything-c-simple-call-tree-tick)
7311     (simple-call-tree-analyze)
7312     (setq anything-c-simple-call-tree-tick (buffer-chars-modified-tick))))
7313
7314 (defun anything-c-simple-call-tree-init-base (function message)
7315   (require 'simple-call-tree)
7316   (with-no-warnings
7317     (when (anything-current-buffer-is-modified)
7318       (anything-c-simple-call-tree-analyze-maybe)
7319       (let ((list (funcall function simple-call-tree-alist)))
7320         (with-current-buffer (anything-candidate-buffer 'local)
7321           (dolist (entry list)
7322             (let ((funcs (concat "  " (mapconcat #'identity (cdr entry) "\n  "))))
7323               (insert (car entry) message
7324                       (if (string= funcs "  ")
7325                           "  no functions."
7326                           funcs)
7327                       "\n\n"))))))))
7328
7329 (defun anything-c-simple-call-tree-functions-callers-init ()
7330   (anything-c-simple-call-tree-init-base 'simple-call-tree-invert
7331                                          " is called by\n"))
7332
7333 (defun anything-c-simple-call-tree-candidates ()
7334   (with-current-buffer (anything-candidate-buffer)
7335     (split-string (buffer-string) "\n\n")))
7336
7337 (defvar anything-c-simple-call-tree-related-functions nil)
7338 (defvar anything-c-simple-call-tree-function-index 0)
7339 (defun anything-c-simple-call-tree-persistent-action (candidate)
7340   (unless (eq last-command 'anything-execute-persistent-action)
7341     (setq anything-c-simple-call-tree-related-functions
7342           (delete "no functions."
7343                   (split-string
7344                    (replace-regexp-in-string "  \\| is called by\\| calls "
7345                                              "" candidate)
7346                    "\n")))
7347     (setq anything-c-simple-call-tree-function-index -1))
7348   (incf anything-c-simple-call-tree-function-index)
7349   (anything-c-simple-call-tree-find-definition candidate))
7350
7351 (defun anything-c-simple-call-tree-find-definition (candidate)
7352   (find-function
7353    (intern
7354     (nth (mod anything-c-simple-call-tree-function-index
7355               (length anything-c-simple-call-tree-related-functions))
7356          anything-c-simple-call-tree-related-functions))))
7357
7358
7359 ;;; Function calls
7360 (defvar anything-c-source-simple-call-tree-callers-functions
7361   '((name . "Function calls")
7362     (init . anything-c-simple-call-tree-callers-functions-init)
7363     (multiline)
7364     (candidates . anything-c-simple-call-tree-candidates)
7365     (persistent-action . anything-c-simple-call-tree-persistent-action)
7366     (persistent-help . "Show function definitions by rotation")
7367     (action ("Find definition selected by persistent-action" .
7368              anything-c-simple-call-tree-find-definition)))
7369   "Needs simple-call-tree.el.
7370 http://www.emacswiki.org/cgi-bin/wiki/download/simple-call-tree.el")
7371
7372 (defun anything-c-simple-call-tree-callers-functions-init ()
7373   (anything-c-simple-call-tree-init-base 'identity " calls \n"))
7374
7375
7376
7377 \f
7378 ;;; Anything UI of auto-document.el
7379 ;;
7380 ;; <http://www.emacswiki.org/cgi-bin/wiki/download/auto-document.el>
7381 ;;
7382 ;; Commands/Options with doc
7383 (defvar anything-c-auto-document-data nil)
7384 (make-variable-buffer-local 'anything-c-auto-document-data)
7385 (defvar anything-c-source-commands-and-options-in-file
7386   '((name . "Commands/Options in file")
7387     (header-name
7388      . (lambda (x) (format "Commands/Options in %s"
7389                            (buffer-local-value 'buffer-file-name
7390                                                anything-current-buffer))))
7391     (candidates . anything-command-and-options-candidates)
7392     (multiline)
7393     (action . imenu))
7394   "List Commands and Options with doc. It needs auto-document.el .
7395
7396 http://www.emacswiki.org/cgi-bin/wiki/download/auto-document.el")
7397
7398 (eval-when-compile (require 'auto-document nil t))
7399 (defun anything-command-and-options-candidates ()
7400   (with-anything-current-buffer
7401     (when (and (require 'auto-document nil t)
7402                (eq major-mode 'emacs-lisp-mode)
7403                (or (anything-current-buffer-is-modified)
7404                    (not anything-c-auto-document-data)))
7405       (or imenu--index-alist (imenu--make-index-alist t))
7406       (setq anything-c-auto-document-data
7407             (destructuring-bind (commands options)
7408                 (adoc-construct anything-current-buffer)
7409               (append
7410                (loop for (command . doc) in commands
7411                      for cmdname = (symbol-name command)
7412                      collect
7413                      (cons
7414                       (format "Command: %s\n %s"
7415                               (propertize cmdname 'face font-lock-function-name-face)
7416                               (adoc-first-line doc))
7417                       (assoc cmdname imenu--index-alist)))
7418                (loop with var-alist = (cdr (assoc "Variables" imenu--index-alist))
7419                      for (option doc default) in options
7420                      for optname = (symbol-name option)
7421                      collect
7422                      (cons
7423                       (format "Option: %s\n %s\n default = %s"
7424                               (propertize optname 'face font-lock-variable-name-face)
7425                               (adoc-first-line doc)
7426                               (adoc-prin1-to-string default))
7427                       (assoc optname
7428                              var-alist)))))))
7429     anything-c-auto-document-data))
7430
7431
7432 \f
7433 ;;;; <Color and Face>
7434 ;;
7435
7436 ;;; Customize Face
7437 ;;
7438 ;;
7439 (defvar anything-c-source-customize-face
7440   '((name . "Customize Face")
7441     (init . (lambda ()
7442               (unless (anything-candidate-buffer)
7443                 (save-selected-window
7444                   (list-faces-display))
7445                 (anything-candidate-buffer (get-buffer "*Faces*")))))
7446     (candidates-in-buffer)
7447     (get-line . buffer-substring)
7448     (action . (lambda (line)
7449                 (customize-face (intern (car (split-string line))))))
7450     (requires-pattern . 3))
7451   "See (info \"(emacs)Faces\")")
7452
7453 ;;; Colors browser
7454 ;;
7455 ;;
7456 (defvar anything-c-source-colors
7457   '((name . "Colors")
7458     (init . (lambda () (unless (anything-candidate-buffer)
7459                          (save-selected-window
7460                            (list-colors-display))
7461                          (anything-candidate-buffer (get-buffer "*Colors*")))))
7462     (candidates-in-buffer)
7463     (get-line . buffer-substring)
7464     (action
7465      ("Copy Name" . (lambda (candidate)
7466                       (kill-new (anything-c-colors-get-name candidate))))
7467      ("Copy RGB" . (lambda (candidate)
7468                      (kill-new (anything-c-colors-get-rgb candidate))))
7469      ("Insert Name" . (lambda (candidate)
7470                         (with-anything-current-buffer
7471                           (insert (anything-c-colors-get-name candidate)))))
7472      ("Insert RGB" . (lambda (candidate)
7473                        (with-anything-current-buffer
7474                          (insert (anything-c-colors-get-rgb candidate))))))))
7475
7476 (defun anything-c-colors-get-name (candidate)
7477   "Get color name."
7478   (replace-regexp-in-string
7479    " " ""
7480    (with-temp-buffer
7481      (insert (capitalize candidate))
7482      (goto-char (point-min))
7483      (search-forward-regexp "\\s-\\{2,\\}")
7484      (delete-region (point) (point-max))
7485      (buffer-string))))
7486
7487 (defun anything-c-colors-get-rgb (candidate)
7488   "Get color RGB."
7489   (replace-regexp-in-string
7490    " " ""
7491    (with-temp-buffer
7492      (insert (capitalize candidate))
7493      (goto-char (point-max))
7494      (search-backward-regexp "\\s-\\{2,\\}")
7495      (delete-region (point) (point-min))
7496      (buffer-string))))
7497
7498 \f
7499 ;;;; <Search Engine>
7500 ;;; Tracker desktop search
7501 (defvar anything-c-source-tracker-search
7502   '((name . "Tracker Search")
7503     (candidates . (lambda ()
7504                     (start-process "tracker-search-process" nil
7505                                    "tracker-search"
7506                                    anything-pattern)))
7507     (type . file)
7508     (requires-pattern . 3)
7509     (delayed))
7510   "Source for retrieving files matching the current input pattern
7511 with the tracker desktop search.")
7512
7513 ;;; Spotlight (MacOS X desktop search)
7514 (defvar anything-c-source-mac-spotlight
7515   '((name . "mdfind")
7516     (candidates
7517      . (lambda () (start-process "mdfind-process" nil "mdfind" anything-pattern)))
7518     (type . file)
7519     (requires-pattern . 3)
7520     (delayed))
7521   "Source for retrieving files via Spotlight's command line
7522 utility mdfind.")
7523
7524 ;;; Picklist
7525 (defvar anything-c-source-picklist
7526   '((name . "Picklist")
7527     (candidates . (lambda () (mapcar 'car picklist-list)))
7528     (type . file)))
7529
7530
7531 \f
7532 ;;; Kill ring
7533 ;;
7534 ;;
7535 (defvar anything-c-source-kill-ring
7536   `((name . "Kill Ring")
7537     (init . (lambda () (anything-attrset 'last-command last-command)))
7538     (candidates . anything-c-kill-ring-candidates)
7539     (filtered-candidate-transformer anything-c-kill-ring-transformer)
7540     (action . anything-c-kill-ring-action)
7541     (keymap . ,anything-kill-ring-map)
7542     (last-command)
7543     (migemo)
7544     (multiline))
7545   "Source for browse and insert contents of kill-ring.")
7546
7547 (defun anything-c-kill-ring-candidates ()
7548   (loop for kill in (anything-fast-remove-dups kill-ring :test 'equal)
7549         unless (or (< (length kill) anything-kill-ring-threshold)
7550                    (string-match "^[\\s\\t]+$" kill))
7551         collect kill))
7552
7553 (defun anything-c-kill-ring-transformer (candidates source)
7554   "Display only the `anything-c-kill-ring-max-lines-number' lines of candidate."
7555   (loop for i in candidates
7556         for nlines = (with-temp-buffer (insert i) (count-lines (point-min) (point-max)))
7557         if (and anything-c-kill-ring-max-lines-number
7558                 (> nlines anything-c-kill-ring-max-lines-number))
7559         collect (cons
7560                  (with-temp-buffer
7561                    (insert i)
7562                    (goto-char (point-min))
7563                    (concat
7564                     (buffer-substring
7565                      (point-min)
7566                      (save-excursion
7567                        (forward-line anything-c-kill-ring-max-lines-number)
7568                        (point)))
7569                     "[...]")) i)
7570         else collect i))
7571
7572 (defun anything-c-kill-ring-action (str)
7573   "Insert STR in `kill-ring' and set STR to the head.
7574 If this action is executed just after `yank',
7575 replace with STR as yanked string."
7576   (setq kill-ring (delete str kill-ring))
7577   (if (not (eq (anything-attr 'last-command) 'yank))
7578       (insert-for-yank str)
7579       ;; from `yank-pop'
7580       (let ((inhibit-read-only t)
7581             (before (< (point) (mark t))))
7582         (if before
7583             (funcall (or yank-undo-function 'delete-region) (point) (mark t))
7584             (funcall (or yank-undo-function 'delete-region) (mark t) (point)))
7585         (setq yank-undo-function nil)
7586         (set-marker (mark-marker) (point) (current-buffer))
7587         (insert-for-yank str)
7588         ;; Set the window start back where it was in the yank command,
7589         ;; if possible.
7590         (set-window-start (selected-window) yank-window-start t)
7591         (if before
7592             ;; This is like exchange-point-and-mark, but doesn't activate the mark.
7593             ;; It is cleaner to avoid activation, even though the command
7594             ;; loop would deactivate the mark because we inserted text.
7595             (goto-char (prog1 (mark t)
7596                          (set-marker (mark-marker) (point) (current-buffer)))))))
7597   (kill-new str))
7598
7599
7600 \f
7601 ;;;; <Mark ring>
7602 ;; DO NOT include these sources in `anything-sources' use
7603 ;; the commands `anything-mark-ring', `anything-global-mark-ring' or
7604 ;; `anything-all-mark-rings' instead.
7605
7606 (defun anything-c-source-mark-ring-candidates ()
7607   (flet ((get-marks (pos)
7608            (save-excursion
7609              (goto-char pos)
7610              (beginning-of-line)
7611              (let ((line  (car (split-string (thing-at-point 'line) "[\n\r]"))))
7612                (when (string= "" line)
7613                  (setq line  "<EMPTY LINE>"))
7614                (format "%7d: %s" (line-number-at-pos) line)))))
7615     (with-anything-current-buffer
7616       (loop
7617             with marks = (if (mark) (cons (mark-marker) mark-ring) mark-ring)
7618             with recip = nil
7619             for i in marks
7620             for m = (get-marks i)
7621             unless (member m recip)
7622             collect m into recip
7623             finally return recip))))
7624
7625 (defvar anything-mark-ring-cache nil)
7626 (defvar anything-c-source-mark-ring
7627   '((name . "mark-ring")
7628     (init . (lambda ()
7629               (setq anything-mark-ring-cache
7630                     (ignore-errors (anything-c-source-mark-ring-candidates)))))
7631     (candidates . (lambda ()
7632                     (anything-aif anything-mark-ring-cache
7633                         it)))
7634     (action . (("Goto line"
7635                 . (lambda (candidate)
7636                     (anything-goto-line (string-to-number candidate))))))
7637     (persistent-action . (lambda (candidate)
7638                            (anything-goto-line (string-to-number candidate))
7639                            (anything-match-line-color-current-line)))
7640     (persistent-help . "Show this line")))
7641
7642
7643 ;;; Global-mark-ring
7644 (defvar anything-c-source-global-mark-ring
7645   '((name . "global-mark-ring")
7646     (candidates . anything-c-source-global-mark-ring-candidates)
7647     (action . (("Goto line"
7648                 . (lambda (candidate)
7649                     (let ((items (split-string candidate ":")))
7650                       (anything-c-switch-to-buffer (second items))
7651                       (anything-goto-line (string-to-number (car items))))))))
7652     (persistent-action . (lambda (candidate)
7653                            (let ((items (split-string candidate ":")))
7654                              (anything-c-switch-to-buffer (second items))
7655                              (anything-goto-line (string-to-number (car items)))
7656                              (anything-match-line-color-current-line))))
7657     (persistent-help . "Show this line")))
7658
7659 (defun anything-c-source-global-mark-ring-candidates ()
7660   (flet ((buf-fn (m)
7661            (with-current-buffer (marker-buffer m)
7662              (goto-char m)
7663              (beginning-of-line)
7664              (let (line)
7665                (if (string= "" line)
7666                    (setq line  "<EMPTY LINE>")
7667                    (setq line (car (split-string (thing-at-point 'line)
7668                                                  "[\n\r]"))))
7669                (format "%7d:%s:    %s"
7670                        (line-number-at-pos) (marker-buffer m) line)))))
7671     (loop
7672           with marks = global-mark-ring
7673           with recip = nil
7674           for i in marks
7675           for gm = (unless (or (string-match
7676                                 "^ " (format "%s" (marker-buffer i)))
7677                                (null (marker-buffer i)))
7678                      (buf-fn i))
7679           when (and gm (not (member gm recip)))
7680           collect gm into recip
7681           finally return recip)))
7682
7683
7684 \f
7685 ;;;; <Register>
7686 ;;; Insert from register
7687 (defvar anything-c-source-register
7688   '((name . "Registers")
7689     (candidates . anything-c-register-candidates)
7690     (action-transformer . anything-c-register-action-transformer)
7691     (multiline)
7692     (action))
7693   "See (info \"(emacs)Registers\")")
7694
7695 (defun anything-c-register-candidates ()
7696   "Collecting register contents and appropriate commands."
7697   (loop for (char . val) in register-alist
7698         for key    = (single-key-description char)
7699         for string-actions =
7700         (cond
7701           ((numberp val)
7702            (list (int-to-string val)
7703                  'insert-register
7704                  'increment-register))
7705           ((markerp val)
7706            (let ((buf (marker-buffer val)))
7707              (if (null buf)
7708                  (list "a marker in no buffer")
7709                  (list (concat
7710                         "a buffer position:"
7711                         (buffer-name buf)
7712                         ", position "
7713                         (int-to-string (marker-position val)))
7714                        'jump-to-register
7715                        'insert-register))))
7716           ((and (consp val) (window-configuration-p (car val)))
7717            (list "window configuration."
7718                  'jump-to-register))
7719           ((and (consp val) (frame-configuration-p (car val)))
7720            (list "frame configuration."
7721                  'jump-to-register))
7722           ((and (consp val) (eq (car val) 'file))
7723            (list (concat "file:"
7724                          (prin1-to-string (cdr val))
7725                          ".")
7726                  'jump-to-register))
7727           ((and (consp val) (eq (car val) 'file-query))
7728            (list (concat "file:a file-query reference: file "
7729                          (car (cdr val))
7730                          ", position "
7731                          (int-to-string (car (cdr (cdr val))))
7732                          ".")
7733                  'jump-to-register))
7734           ((consp val)
7735            (let ((lines (format "%4d" (length val))))
7736              (list (format "%s: %s\n" lines
7737                            (truncate-string-to-width
7738                             (mapconcat 'identity (list (car val))
7739                                        "^J") (- (window-width) 15)))
7740                    'insert-register)))
7741           ((stringp val)
7742            (list
7743             ;; without properties
7744             (concat (substring-no-properties
7745                      val 0 (min (length val) anything-c-register-max-offset))
7746                     (if (> (length val) anything-c-register-max-offset)
7747                         "[...]" ""))
7748             'insert-register
7749             'append-to-register
7750             'prepend-to-register))
7751           ((vectorp val)
7752            (list
7753             "Undo-tree entry."
7754             'undo-tree-restore-state-from-register))
7755           (t
7756            "GARBAGE!"))
7757         collect (cons (format "register %3s: %s" key (car string-actions))
7758                       (cons char (cdr string-actions)))))
7759
7760 (defun anything-c-register-action-transformer (actions register-and-functions)
7761   "Decide actions by the contents of register."
7762   (loop with func-actions =
7763         '((insert-register
7764            "Insert Register" .
7765            (lambda (c) (insert-register (car c))))
7766           (jump-to-register
7767            "Jump to Register" .
7768            (lambda (c) (jump-to-register (car c))))
7769           (append-to-register
7770            "Append Region to Register" .
7771            (lambda (c) (append-to-register
7772                         (car c) (region-beginning) (region-end))))
7773           (prepend-to-register
7774            "Prepend Region to Register" .
7775            (lambda (c) (prepend-to-register
7776                         (car c) (region-beginning) (region-end))))
7777           (increment-register
7778            "Increment Prefix Arg to Register" .
7779            (lambda (c) (increment-register
7780                         anything-current-prefix-arg (car c))))
7781           (undo-tree-restore-state-from-register
7782            "Restore Undo-tree register"
7783            (lambda (c) (and (fboundp 'undo-tree-restore-state-from-register)
7784                             (undo-tree-restore-state-from-register (car c))))))
7785         for func in (cdr register-and-functions)
7786         for cell = (assq func func-actions)
7787         when cell
7788         collect (cdr cell)))
7789
7790
7791 \f
7792 ;;; Latex completion
7793 (defun anything-c-latex-math-candidates ()
7794   "Collect candidates for latex math completion."
7795   (declare (special LaTeX-math-menu))
7796   (loop for i in (cddr LaTeX-math-menu)
7797         for elm = (loop for s in i when (vectorp s)
7798                         collect (cons (aref s 0) (aref s 1)))
7799         append elm))
7800
7801 (defvar anything-c-source-latex-math
7802   '((name . "Latex Math Menu")
7803     (init . (lambda ()
7804               (with-anything-current-buffer
7805                 (LaTeX-math-mode 1))))
7806     (candidate-number-limit . 9999)
7807     (candidates . anything-c-latex-math-candidates)
7808     (action . (lambda (candidate)
7809                 (call-interactively candidate)))))
7810
7811 \f
7812 ;;;; <Headline Extraction>
7813 (defvar anything-c-source-fixme
7814   '((name . "TODO/FIXME/DRY comments")
7815     (headline . "^.*\\<\\(TODO\\|FIXME\\|DRY\\)\\>.*$")
7816     (adjust)
7817     (recenter))
7818   "Show TODO/FIXME/DRY comments in current file.")
7819
7820 (defvar anything-c-source-rd-headline
7821   '((name . "RD HeadLine")
7822     (headline  "^= \\(.+\\)$" "^== \\(.+\\)$" "^=== \\(.+\\)$" "^==== \\(.+\\)$")
7823     (condition . (memq major-mode '(rdgrep-mode rd-mode)))
7824     (migemo)
7825     (subexp . 1))
7826   "Show RD headlines.
7827
7828 RD is Ruby's POD.
7829 http://en.wikipedia.org/wiki/Ruby_Document_format")
7830
7831 (defvar anything-c-source-oddmuse-headline
7832   '((name . "Oddmuse HeadLine")
7833     (headline  "^= \\(.+\\) =$" "^== \\(.+\\) ==$"
7834      "^=== \\(.+\\) ===$" "^==== \\(.+\\) ====$")
7835     (condition . (memq major-mode '(oddmuse-mode yaoddmuse-mode)))
7836     (migemo)
7837     (subexp . 1))
7838   "Show Oddmuse headlines, such as EmacsWiki.")
7839
7840 (defvar anything-c-source-emacs-source-defun
7841   '((name . "Emacs Source DEFUN")
7842     (headline . "DEFUN\\|DEFVAR")
7843     (condition . (string-match "/emacs2[0-9].+/src/.+c$"
7844                   (or buffer-file-name ""))))
7845   "Show DEFUN/DEFVAR in Emacs C source file.")
7846
7847 (defvar anything-c-source-emacs-lisp-expectations
7848   '((name . "Emacs Lisp Expectations")
7849     (headline . "(desc[ ]\\|(expectations")
7850     (condition . (eq major-mode 'emacs-lisp-mode)))
7851   "Show descriptions (desc) in Emacs Lisp Expectations.
7852
7853 http://www.emacswiki.org/cgi-bin/wiki/download/el-expectations.el")
7854
7855 (defvar anything-c-source-emacs-lisp-toplevels
7856   '((name . "Emacs Lisp Toplevel / Level 4 Comment / Linkd Star")
7857     (headline . "^(\\|(@\\*\\|^;;;;")
7858     (get-line . buffer-substring)
7859     (condition . (eq major-mode 'emacs-lisp-mode))
7860     (adjust))
7861   "Show top-level forms, level 4 comments and linkd stars (optional) in Emacs Lisp.
7862 linkd.el is optional because linkd stars are extracted by regexp.
7863 http://www.emacswiki.org/cgi-bin/wiki/download/linkd.el")
7864
7865 \f
7866 ;;; Anything yaoddmuse
7867 ;;
7868 ;; Be sure to have yaoddmuse.el installed
7869 ;; install-elisp may be required if you want to install elisp file from here.
7870 (defvar anything-yaoddmuse-use-cache-file nil)
7871 (defvar anything-c-yaoddmuse-cache-file "~/.emacs.d/yaoddmuse-cache.el")
7872 (defvar anything-c-yaoddmuse-ew-cache nil)
7873
7874 (defun anything-yaoddmuse-get-candidates ()
7875   (declare (special yaoddmuse-pages-hash))
7876   (if anything-yaoddmuse-use-cache-file
7877       (ignore-errors
7878         (unless anything-c-yaoddmuse-ew-cache
7879           (load anything-c-yaoddmuse-cache-file)
7880           (setq anything-c-yaoddmuse-ew-cache
7881                 (gethash "EmacsWiki" yaoddmuse-pages-hash)))
7882         anything-c-yaoddmuse-ew-cache)
7883       (yaoddmuse-update-pagename t)
7884       (gethash "EmacsWiki" yaoddmuse-pages-hash)))
7885
7886 (defvar anything-c-source-yaoddmuse-emacswiki-edit-or-view
7887   '((name . "Yaoddmuse Edit or View (EmacsWiki)")
7888     (candidates . anything-yaoddmuse-get-candidates)
7889     (action . (("Edit page" . (lambda (candidate)
7890                                 (yaoddmuse-edit "EmacsWiki" candidate)))
7891                ("Browse page"
7892                 . (lambda (candidate)
7893                     (yaoddmuse-browse-page "EmacsWiki" candidate)))
7894                ("Browse page other window"
7895                 . (lambda (candidate)
7896                     (if (one-window-p)
7897                         (split-window-vertically))
7898                     (yaoddmuse-browse-page "EmacsWiki" candidate)))
7899                ("Browse diff"
7900                 . (lambda (candidate)
7901                     (yaoddmuse-browse-page-diff "EmacsWiki" candidate)))
7902                ("Copy URL"
7903                 . (lambda (candidate)
7904                     (kill-new (yaoddmuse-url "EmacsWiki" candidate))
7905                     (message "Have copy page %s's URL to yank." candidate)))
7906                ("Create page"
7907                 . (lambda (candidate)
7908                     (yaoddmuse-edit "EmacsWiki" anything-input)))
7909                ("Update cache"
7910                 . (lambda (candidate)
7911                     (if anything-yaoddmuse-use-cache-file
7912                         (progn
7913                           (anything-yaoddmuse-cache-pages t)
7914                           (setq anything-c-yaoddmuse-ew-cache
7915                                 (gethash "EmacsWiki" yaoddmuse-pages-hash)))
7916                         (yaoddmuse-update-pagename))))))
7917     (action-transformer anything-c-yaoddmuse-action-transformer))
7918   "Needs yaoddmuse.el.
7919
7920 http://www.emacswiki.org/emacs/download/yaoddmuse.el")
7921
7922
7923 (defvar anything-c-source-yaoddmuse-emacswiki-post-library
7924   '((name . "Yaoddmuse Post library (EmacsWiki)")
7925     (init . (anything-yaoddmuse-init))
7926     (candidates-in-buffer)
7927     (action . (("Post library and Browse"
7928                 . (lambda (candidate)
7929                     (yaoddmuse-post-file
7930                      (find-library-name candidate)
7931                      "EmacsWiki"
7932                      (file-name-nondirectory (find-library-name candidate))
7933                      nil t)))
7934                ("Post library"
7935                 . (lambda (candidate)
7936                     (yaoddmuse-post-file
7937                      (find-library-name candidate)
7938                      "EmacsWiki"
7939                      (file-name-nondirectory
7940                       (find-library-name candidate))))))))
7941   "Needs yaoddmuse.el.
7942
7943 http://www.emacswiki.org/emacs/download/yaoddmuse.el")
7944
7945
7946 (defun anything-c-yaoddmuse-action-transformer (actions candidate)
7947   "Allow the use of `install-elisp' only on elisp files."
7948   (if (string-match "\.el$" candidate)
7949       (append actions '(("Install Elisp"
7950                          . (lambda (elm)
7951                              (install-elisp-from-emacswiki elm)))))
7952       actions))
7953
7954 ;;;###autoload
7955 (defun anything-yaoddmuse-cache-pages (&optional load)
7956   "Fetch the list of files on emacswiki and create cache file.
7957 If load is non--nil load the file and feed `yaoddmuse-pages-hash'."
7958   (interactive)
7959   (declare (special yaoddmuse-pages-hash))
7960   (yaoddmuse-update-pagename)
7961   (save-excursion
7962     (find-file anything-c-yaoddmuse-cache-file)
7963     (erase-buffer)
7964     (insert "(puthash \"EmacsWiki\" '(")
7965     (loop for i in (gethash "EmacsWiki" yaoddmuse-pages-hash)
7966           do
7967           (insert (concat "(\"" (car i) "\") ")))
7968     (insert ") yaoddmuse-pages-hash)\n")
7969     (save-buffer)
7970     (kill-buffer (current-buffer))
7971     (when (or current-prefix-arg
7972               load)
7973       (load anything-c-yaoddmuse-cache-file))))
7974
7975 (defun anything-yaoddmuse-init ()
7976   "Init anything buffer status."
7977   (let ((anything-buffer (anything-candidate-buffer 'global))
7978         (library-list (yaoddmuse-get-library-list)))
7979     (with-current-buffer anything-buffer
7980       ;; Insert library name.
7981       (dolist (library library-list)
7982         (insert (format "%s\n" library)))
7983       ;; Sort lines.
7984       (sort-lines nil (point-min) (point-max)))))
7985
7986 \f
7987 ;;; Eev anchors
7988 (defvar anything-c-source-eev-anchor
7989   '((name . "Anchors")
7990     (candidates
7991      . (lambda ()
7992          (ignore-errors
7993            (with-anything-current-buffer
7994              (loop initially (goto-char (point-min))
7995                    while (re-search-forward
7996                           (format ee-anchor-format "\\([^\.].+\\)") nil t)
7997                    for anchor = (match-string-no-properties 1)
7998                    collect (cons (format "%5d:%s"
7999                                          (line-number-at-pos (match-beginning 0))
8000                                          (format ee-anchor-format anchor))
8001                                  anchor))))))
8002     (persistent-action . (lambda (item)
8003                            (ee-to item)
8004                            (anything-match-line-color-current-line)))
8005     (migemo)
8006     (persistent-help . "Show this entry")
8007     (action . (("Goto link" . ee-to)))))
8008
8009 \f
8010 ;;; Org headlines
8011 ;;
8012 ;;
8013 (defvar anything-c-source-org-headline
8014   `((name . "Org HeadLine")
8015     (headline
8016      ,@(mapcar
8017         (lambda (num)
8018           (format "^\\*\\{%d\\} \\(.+?\\)\\([ \t]*:[a-zA-Z0-9_@:]+:\\)?[ \t]*$"
8019                   num))
8020         (number-sequence 1 8)))
8021     (condition . (eq major-mode 'org-mode))
8022     (migemo)
8023     (subexp . 1)
8024     (persistent-action . (lambda (elm)
8025                            (anything-c-action-line-goto elm)
8026                            (org-cycle)))
8027     (action-transformer
8028      . (lambda (actions candidate)
8029          '(("Go to Line" . anything-c-action-line-goto)
8030            ("Refile to this Headline" . anything-c-org-headline-refile)
8031            ("Insert Link to This Headline"
8032             . anything-c-org-headline-insert-link-to-headline)))))
8033   "Show Org headlines.
8034 org-mode is very very much extended text-mode/outline-mode.
8035
8036 See (find-library \"org.el\")
8037 See http://orgmode.org for the latest version.")
8038
8039 (defun anything-c-org-headline-insert-link-to-headline (lineno-and-content)
8040   (insert
8041    (save-excursion
8042      (anything-goto-line (car lineno-and-content))
8043      (and (looking-at org-complex-heading-regexp)
8044           (org-make-link-string (concat "*" (match-string 4)))))))
8045
8046 (defun anything-c-org-headline-refile (lineno-and-content)
8047   "Refile current org entry to LINENO-AND-CONTENT."
8048   (with-anything-current-buffer
8049     (org-cut-subtree)
8050     (anything-goto-line (car lineno-and-content))
8051     (org-end-of-subtree t t)
8052     (let ((org-yank-adjusted-subtrees t))
8053       (org-yank))))
8054
8055
8056 ;;; Org keywords
8057 ;;
8058 ;;
8059 (defvar anything-c-source-org-keywords
8060   '((name . "Org Keywords")
8061     (init . anything-c-org-keywords-init)
8062     (candidates . anything-c-org-keywords-candidates)
8063     (action . anything-c-org-keywords-insert)
8064     (persistent-action . anything-c-org-keywords-show-help)
8065     (persistent-help . "Show an example and info page to describe this keyword.")
8066     (keywords-examples)
8067     (keywords)))
8068
8069 (defvar anything-c-org-keywords-info-location
8070   '(("#+TITLE:" . "(org)Export options")
8071     ("#+AUTHOR:" . "(org)Export options")
8072     ("#+DATE:" . "(org)Export options")
8073     ("#+EMAIL:" . "(org)Export options")
8074     ("#+DESCRIPTION:" . "(org)Export options")
8075     ("#+KEYWORDS:" . "(org)Export options")
8076     ("#+LANGUAGE:" . "(org)Export options")
8077     ("#+TEXT:" . "(org)Export options")
8078     ("#+TEXT:" . "(org)Export options")
8079     ("#+OPTIONS:" . "(org)Export options")
8080     ("#+BIND:" . "(org)Export options")
8081     ("#+LINK_UP:" . "(org)Export options")
8082     ("#+LINK_HOME:" . "(org)Export options")
8083     ("#+LATEX_HEADER:" . "(org)Export options")
8084     ("#+EXPORT_SELECT_TAGS:" . "(org)Export options")
8085     ("#+EXPORT_EXCLUDE_TAGS:" . "(org)Export options")
8086     ("#+INFOJS_OPT" . "(org)Javascript support")
8087     ("#+BEGIN_HTML" . "(org)Quoting HTML tags")
8088     ("#+BEGIN_LaTeX" . "(org)Quoting LaTeX code")
8089     ("#+ORGTBL" . "(org)Radio tables")
8090     ("#+HTML:" . "(org)Quoting HTML tags")
8091     ("#+LaTeX:" . "(org)Quoting LaTeX code")
8092     ("#+BEGIN:" . "(org)Dynamic blocks") ;clocktable columnview
8093     ("#+BEGIN_EXAMPLE" . "(org)Literal examples")
8094     ("#+BEGIN_QUOTE" . "(org)Paragraphs")
8095     ("#+BEGIN_VERSE" . "(org)Paragraphs")
8096     ("#+BEGIN_SRC" . "(org)Literal examples")
8097     ("#+CAPTION" . "(org)Tables in HTML export")
8098     ("#+LABEL" . "(org)Tables in LaTeX export")
8099     ("#+ATTR_HTML" . "(org)Links")
8100     ("#+ATTR_LaTeX" . "(org)Images in LaTeX export")))
8101
8102 (defun anything-c-org-keywords-init ()
8103   (unless (anything-attr 'keywords-examples)
8104     (require 'org)
8105     (anything-attrset 'keywords-examples
8106                       (append
8107                        (mapcar
8108                         (lambda (x)
8109                           (string-match "^#\\+\\(\\([A-Z_]+:?\\).*\\)" x)
8110                           (cons (match-string 2 x) (match-string 1 x)))
8111                         (org-split-string (org-get-current-options) "\n"))
8112                        (mapcar 'list org-additional-option-like-keywords)))
8113     (anything-attrset 'keywords (mapcar 'car (anything-attr 'keywords-examples)))))
8114
8115 (defun anything-c-org-keywords-candidates ()
8116   (and (or (eq (buffer-local-value 'major-mode anything-current-buffer) 'org-mode)
8117            (eq (buffer-local-value 'major-mode anything-current-buffer) 'message-mode))
8118        (anything-attr 'keywords)))
8119
8120 (defun anything-c-org-keywords-insert (keyword)
8121   (cond ((and (string-match "BEGIN" keyword)
8122               (anything-region-active-p))
8123          (let ((beg (region-beginning))
8124                (end (region-end)))
8125            (goto-char end)
8126            (insert "\n#+" (replace-regexp-in-string
8127                            "BEGIN" "END" keyword) "\n")
8128            (goto-char beg)
8129            (insert "#+" keyword " ")
8130            (save-excursion (insert "\n"))))
8131         ((string-match "BEGIN" keyword)
8132          (insert "#+" keyword " ")
8133          (save-excursion
8134            (insert "\n#+" (replace-regexp-in-string
8135                            "BEGIN" "END" keyword) "\n")))
8136         (t (insert "#+" keyword " "))))
8137
8138 (defun anything-c-org-keywords-show-help (keyword)
8139   (info (or (assoc-default (concat "#+" keyword) anything-c-org-keywords-info-location)
8140             "(org)In-buffer settings"))
8141   (search-forward (concat "#+" keyword) nil t)
8142   (anything-persistent-highlight-point)
8143   (message "%s" (or (cdr (assoc keyword (anything-attr 'keywords-examples))) "")))
8144
8145
8146 \f
8147 ;;; bbdb
8148 ;;
8149 ;;
8150 (defvar bbdb-records)
8151 (defvar bbdb-buffer-name)
8152
8153 (defun anything-c-bbdb-candidates ()
8154   "Return a list of all names in the bbdb database.  The format
8155 is \"Firstname Lastname\"."
8156   (mapcar (lambda (bbdb-record)
8157             (replace-regexp-in-string
8158              "\\s-+$" ""
8159              (concat (aref bbdb-record 0) " " (aref bbdb-record 1))))
8160           (bbdb-records)))
8161
8162 (defun anything-c-bbdb-create-contact (actions candidate)
8163   "Action transformer that returns only an entry to add the
8164 current `anything-pattern' as new contact.  All other actions are
8165 removed."
8166   (if (string= candidate "*Add to contacts*")
8167       '(("Add to contacts" . (lambda (actions)
8168                                (bbdb-create-internal
8169                                 (read-from-minibuffer "Name: " anything-c-bbdb-name)
8170                                 (read-from-minibuffer "Company: ")
8171                                 (read-from-minibuffer "Email: ")
8172                                 nil
8173                                 nil
8174                                 (read-from-minibuffer "Note: ")))))
8175       actions))
8176
8177 (defun anything-c-bbdb-get-record (candidate)
8178   "Return record that match CANDIDATE."
8179   (bbdb candidate nil)
8180   (set-buffer "*BBDB*")
8181   (bbdb-current-record))
8182
8183 (defvar anything-c-bbdb-name nil
8184   "Only for internal use.")
8185
8186 (defvar anything-c-source-bbdb
8187   '((name . "BBDB")
8188     (candidates . anything-c-bbdb-candidates)
8189     (action ("Send a mail" . anything-c-bbdb-compose-mail)
8190      ("View person's data" . anything-c-bbdb-view-person-action))
8191     (filtered-candidate-transformer . (lambda (candidates source)
8192                                         (setq anything-c-bbdb-name anything-pattern)
8193                                         (if (not candidates)
8194                                             (list "*Add to contacts*")
8195                                             candidates)))
8196     (action-transformer . (lambda (actions candidate)
8197                             (anything-c-bbdb-create-contact actions candidate))))
8198   "Needs BBDB.
8199
8200 http://bbdb.sourceforge.net/")
8201
8202 (defun anything-c-bbdb-view-person-action (candidate)
8203   "View BBDB data of single CANDIDATE or marked candidates."
8204   (anything-aif (anything-marked-candidates)
8205       (let ((bbdb-append-records (length it)))
8206         (dolist (i it)
8207           (bbdb-redisplay-one-record (anything-c-bbdb-get-record i))))
8208     (bbdb-redisplay-one-record (anything-c-bbdb-get-record candidate))))
8209
8210 (defun anything-c-bbdb-collect-mail-addresses ()
8211   "Return a list of all mail addresses of records in bbdb buffer."
8212   (with-current-buffer bbdb-buffer-name
8213     (loop for i in bbdb-records
8214           if (bbdb-record-net (car i))
8215           collect (bbdb-dwim-net-address (car i)))))
8216
8217 (defun anything-c-bbdb-compose-mail (candidate)
8218   "Compose a mail with all records of bbdb buffer."
8219   (anything-c-bbdb-view-person-action candidate)
8220   (let* ((address-list (anything-c-bbdb-collect-mail-addresses))
8221          (address-str  (mapconcat 'identity address-list ",\n    ")))
8222     (compose-mail address-str)))
8223
8224 \f
8225 ;;; Evaluation Result
8226 ;;
8227 ;;
8228 ;; Internal
8229 (defvar anything-eldoc-active-minibuffers-list nil)
8230 (defvar anything-eval-expression-input-history nil)
8231
8232 (defvar anything-c-source-evaluation-result
8233   '((name . "Evaluation Result")
8234     (disable-shortcuts)
8235     (dummy)
8236     (multiline)
8237     (mode-line . "C-RET: nl-and-indent, tab: reindent, C-tab:complete, C-p/n: next/prec-line.")
8238     (filtered-candidate-transformer . (lambda (candidates source)
8239                                         (list
8240                                          (condition-case nil
8241                                              (with-anything-current-buffer
8242                                                (pp-to-string
8243                                                 (eval (read anything-pattern))))
8244                                            (error "Error")))))
8245     (action . (("Copy result to kill-ring" . (lambda (candidate)
8246                                                (with-current-buffer anything-buffer
8247                                                  (let ((end (save-excursion
8248                                                               (goto-char (point-max))
8249                                                               (search-backward "\n")
8250                                                               (point))))
8251                                                    (kill-region (point) end)))))
8252                ("copy sexp to kill-ring" . (lambda (candidate)
8253                                              (kill-new anything-input)))))))
8254
8255 (defun anything-eval-new-line-and-indent ()
8256   (interactive)
8257   (newline) (lisp-indent-line))
8258
8259 (defun anything-eldoc-store-minibuffer ()
8260   "Store minibuffer buffer name in `anything-eldoc-active-minibuffers-list'."
8261   (with-selected-window (minibuffer-window)
8262     (push (buffer-name) anything-eldoc-active-minibuffers-list)))
8263
8264 (defun anything-eldoc-show-in-eval ()
8265   "Return eldoc in mode-line for current minibuffer input."
8266   (let ((buf (with-selected-window (minibuffer-window)
8267                (buffer-name))))
8268     (when (member buf anything-eldoc-active-minibuffers-list)
8269       (let* ((str-all (with-current-buffer buf
8270                         (minibuffer-completion-contents)))
8271              (sym     (when str-all
8272                         (with-temp-buffer
8273                           (insert str-all)
8274                           (goto-char (point-max))
8275                           (unless (looking-back ")\\|\"") (forward-char -1))
8276                           (eldoc-current-symbol))))
8277              (info-fn (eldoc-fnsym-in-current-sexp))
8278              (doc     (or (eldoc-get-var-docstring sym)
8279                           (eldoc-get-fnsym-args-string
8280                            (car info-fn) (cadr info-fn)))))
8281         (when doc (funcall anything-c-eldoc-in-minibuffer-show-fn doc))))))
8282
8283 (defun anything-c-show-info-in-mode-line (str)
8284   "Display string STR in mode-line."
8285   (save-selected-window
8286     (with-current-buffer anything-buffer
8287       (let ((mode-line-format (concat " " str)))
8288         (force-mode-line-update)
8289         (sit-for anything-c-show-info-in-mode-line-delay))
8290       (force-mode-line-update))))
8291
8292 ;;; Calculation Result
8293 ;;
8294 ;;
8295 (defvar anything-c-source-calculation-result
8296   '((name . "Calculation Result")
8297     (dummy)
8298     (filtered-candidate-transformer . (lambda (candidates source)
8299                                         (list
8300                                          (condition-case nil
8301                                              (calc-eval anything-pattern)
8302                                            (error "error")))))
8303     (action ("Copy result to kill-ring" . kill-new))))
8304
8305 \f
8306 ;;; Google Suggestions
8307 ;;
8308 ;;
8309 ;; Internal
8310 (defvar anything-ggs-max-length-real-flag 0)
8311 (defvar anything-ggs-max-length-num-flag 0)
8312
8313 (defun anything-c-google-suggest-fetch (input)
8314   "Fetch suggestions for INPUT from XML buffer.
8315 Return an alist with elements like (data . number_results)."
8316   (setq anything-ggs-max-length-real-flag 0
8317         anything-ggs-max-length-num-flag 0)
8318   (let ((request (concat anything-c-google-suggest-url
8319                          (url-hexify-string input))))
8320     (flet ((fetch ()
8321              (loop
8322                    with result-alist = (xml-get-children
8323                                         (car (xml-parse-region
8324                                               (point-min) (point-max)))
8325                                         'CompleteSuggestion)
8326                    for i in result-alist
8327                    for data = (cdr (caadr (assoc 'suggestion i)))
8328                    for nqueries = (cdr (caadr (assoc 'num_queries i)))
8329                    for lqueries = (length (anything-c-ggs-set-number-result
8330                                            nqueries))
8331                    for ldata = (length data)
8332                    do
8333                    (progn
8334                      (when (> ldata anything-ggs-max-length-real-flag)
8335                        (setq anything-ggs-max-length-real-flag ldata))
8336                      (when (> lqueries anything-ggs-max-length-num-flag)
8337                        (setq anything-ggs-max-length-num-flag lqueries)))
8338                    collect (cons data nqueries) into cont
8339                    finally return cont)))
8340       (if anything-google-suggest-use-curl-p
8341           (with-temp-buffer
8342             (call-process "curl" nil t nil request)
8343             (fetch))
8344           (with-current-buffer
8345               (url-retrieve-synchronously request)
8346             (fetch))))))
8347
8348 (defun anything-c-google-suggest-set-candidates (&optional request-prefix)
8349   "Set candidates with result and number of google results found."
8350   (let ((suggestions
8351          (loop with suggested-results = (anything-c-google-suggest-fetch
8352                                          (or (and request-prefix
8353                                                   (concat request-prefix
8354                                                           " " anything-pattern))
8355                                              anything-pattern))
8356                for (real . numresult) in suggested-results
8357                ;; Prepare number of results with ","
8358                for fnumresult = (anything-c-ggs-set-number-result numresult)
8359                ;; Calculate number of spaces to add before fnumresult
8360                ;; if it is smaller than longest result
8361                ;; `anything-ggs-max-length-num-flag'.
8362                ;; e.g 1,234,567
8363                ;;       345,678
8364                ;; To be sure it is aligned properly.
8365                for nspaces = (if (< (length fnumresult)
8366                                     anything-ggs-max-length-num-flag)
8367                                  (- anything-ggs-max-length-num-flag
8368                                     (length fnumresult))
8369                                  0)
8370                ;; Add now the spaces before fnumresult.
8371                for align-fnumresult = (concat (make-string nspaces ? )
8372                                               fnumresult)
8373                for interval = (- anything-ggs-max-length-real-flag
8374                                  (length real))
8375                for spaces   = (make-string (+ 2 interval) ? )
8376                for display = (format "%s%s(%s results)"
8377                                      real spaces align-fnumresult)
8378                collect (cons display real))))
8379     (if (loop for (disp . dat) in suggestions
8380               thereis (equal dat anything-pattern))
8381         suggestions
8382         ;; if there is no suggestion exactly matching the input then
8383         ;; prepend a Search on Google item to the list
8384         (append
8385          suggestions
8386          (list (cons (concat "Search for " "'" anything-input "'" " on Google")
8387                      anything-input))))))
8388
8389 (defun anything-c-ggs-set-number-result (num)
8390   (if num
8391       (progn
8392         (and (numberp num) (setq num (number-to-string num)))
8393         (loop for i in (reverse (split-string num "" t))
8394               for count from 1
8395               append (list i) into C
8396               when (= count 3)
8397               append (list ",") into C
8398               and do (setq count 0)
8399               finally return
8400               (replace-regexp-in-string
8401                "^," "" (mapconcat 'identity (reverse C) ""))))
8402       "?"))
8403
8404 (defvar anything-c-google-suggest-default-browser-function nil
8405   "*The browse url function you prefer to use with google suggest.
8406 When nil, use the first browser function available
8407 See `anything-browse-url-default-browser-alist'.")
8408
8409 (defun anything-c-google-suggest-action (candidate)
8410   "Default action to jump to a google suggested candidate."
8411   (let ((arg (concat anything-c-google-suggest-search-url
8412                      (url-hexify-string candidate))))
8413     (anything-aif anything-c-google-suggest-default-browser-function
8414         (funcall it arg)
8415       (anything-c-browse-url arg))))
8416
8417 (defvar anything-c-google-suggest-default-function
8418   'anything-c-google-suggest-set-candidates
8419   "Default function to use in anything google suggest.")
8420
8421 (defvar anything-c-source-google-suggest
8422   '((name . "Google Suggest")
8423     (candidates . (lambda ()
8424                     (funcall anything-c-google-suggest-default-function)))
8425     (action . (("Google Search" . anything-c-google-suggest-action)))
8426     (volatile)
8427     (requires-pattern . 3)
8428     (delayed)))
8429
8430 (defun anything-c-google-suggest-emacs-lisp ()
8431   "Try to emacs lisp complete with google suggestions."
8432   (anything-c-google-suggest-set-candidates "emacs lisp"))
8433
8434
8435 ;;; Yahoo suggestions
8436 ;;
8437 ;;
8438 (defun anything-c-yahoo-suggest-fetch (input)
8439   "Fetch Yahoo suggestions for INPUT from XML buffer.
8440 Return an alist with elements like (data . number_results)."
8441   (let ((request (concat anything-c-yahoo-suggest-url
8442                          (url-hexify-string input))))
8443     (flet ((fetch ()
8444              (loop
8445                    with result-alist = (xml-get-children
8446                                         (car (xml-parse-region
8447                                               (point-min) (point-max)))
8448                                         'Result)
8449                    for i in result-alist
8450                    collect (caddr i))))
8451       (with-current-buffer
8452           (url-retrieve-synchronously request)
8453         (fetch)))))
8454
8455 (defun anything-c-yahoo-suggest-set-candidates ()
8456   "Set candidates with Yahoo results found."
8457   (let ((suggestions (anything-c-yahoo-suggest-fetch anything-input)))
8458     (or suggestions
8459         (append
8460          suggestions
8461          (list (cons (concat "Search for " "'" anything-input "'" " on Yahoo")
8462                      anything-input))))))
8463
8464 (defun anything-c-yahoo-suggest-action (candidate)
8465   "Default action to jump to a Yahoo suggested candidate."
8466   (anything-c-browse-url (concat anything-c-yahoo-suggest-search-url
8467                                  (url-hexify-string candidate))))
8468
8469 (defvar anything-c-source-yahoo-suggest
8470   '((name . "Yahoo Suggest")
8471     (candidates . anything-c-yahoo-suggest-set-candidates)
8472     (action . (("Yahoo Search" . anything-c-yahoo-suggest-action)))
8473     (volatile)
8474     (requires-pattern . 3)
8475     (delayed)))
8476
8477
8478 \f
8479 ;;; Web browser functions.
8480 ;;
8481 ;;
8482 (require 'browse-url)
8483 ;; If default setting of `w3m-command' is not
8484 ;; what you want you and you modify it, you will have to reeval
8485 ;; also `anything-browse-url-default-browser-alist'.
8486 (defvar w3m-command "/usr/bin/w3m")
8487 (defvar anything-c-home-url "http://www.google.fr"
8488   "*Default url to use as home url.")
8489
8490 (defvar ac-browse-url-chromium-program "chromium-browser")
8491 (defvar ac-browse-url-uzbl-program "uzbl-browser")
8492 (defvar anything-browse-url-default-browser-alist
8493   `((,w3m-command . w3m-browse-url)
8494     (,browse-url-firefox-program . browse-url-firefox)
8495     (,ac-browse-url-chromium-program . ac-browse-url-chromium)
8496     (,ac-browse-url-uzbl-program . ac-browse-url-uzbl)
8497     (,browse-url-kde-program . browse-url-kde)
8498     (,browse-url-gnome-moz-program . browse-url-gnome-moz)
8499     (,browse-url-mozilla-program . browse-url-mozilla)
8500     (,browse-url-galeon-program . browse-url-galeon)
8501     (,browse-url-netscape-program . browse-url-netscape)
8502     (,browse-url-mosaic-program . browse-url-mosaic)
8503     (,browse-url-xterm-program . browse-url-text-xterm))
8504   "*Alist of \(executable . function\) to try to find a suitable url browser.")
8505
8506 (defun* anything-c-generic-browser (url name &rest args)
8507   "Browse URL with NAME browser."
8508   (let ((proc (concat name " " url)))
8509     (message "Starting %s..." name)
8510     (apply 'start-process proc nil name
8511            (append args (list url)))
8512     (set-process-sentinel
8513      (get-process proc)
8514      #'(lambda (process event)
8515          (when (string= event "finished\n")
8516            (message "%s process %s" process event))))))
8517
8518 (defun ac-browse-url-chromium (url)
8519   "Browse URL with google chrome browser."
8520   (interactive "sURL: ")
8521   (anything-c-generic-browser
8522    url ac-browse-url-chromium-program))
8523
8524 (defun ac-browse-url-uzbl (url &optional ignore)
8525   "Browse URL with uzbl browser."
8526   (interactive "sURL: ")
8527   (anything-c-generic-browser url ac-browse-url-uzbl-program "-u"))
8528
8529 (defun anything-browse-url-default-browser (url &rest args)
8530   "Find the first available browser and ask it to load URL."
8531   (let ((default-browser-fn
8532          (loop for (exe . fn) in anything-browse-url-default-browser-alist
8533                thereis (and exe (executable-find exe) fn))))
8534     (if default-browser-fn
8535         (apply default-browser-fn url args)
8536         (error "No usable browser found"))))
8537
8538 (defun anything-c-browse-url (url &rest args)
8539   "Default command to browse URL."
8540   (if browse-url-browser-function
8541       (browse-url url args)
8542       (anything-browse-url-default-browser url args)))
8543
8544 \f
8545 ;;; Surfraw
8546 ;;
8547 ;; Need external program surfraw.
8548 ;; <http://surfraw.alioth.debian.org/>
8549
8550 (defvar anything-surfraw-default-browser-function nil
8551   "*The browse url function you prefer to use with surfraw.
8552 When nil, fallback to `browse-url-browser-function'.")
8553
8554 ;; Internal
8555 (defvar anything-surfraw-engines-history nil)
8556 (defvar anything-surfraw-input-history nil)
8557
8558 (defun anything-c-build-elvi-list ()
8559   "Return list of all engines and descriptions handled by surfraw."
8560   (cdr
8561    (with-temp-buffer
8562      (call-process "surfraw" nil t nil
8563                    "-elvi")
8564      (split-string (buffer-string) "\n"))))
8565
8566 \f
8567 ;;; Emms
8568 ;;
8569 ;;
8570 (defun anything-emms-stream-edit-bookmark (elm)
8571   "Change the information of current emms-stream bookmark from anything."
8572   (declare (special emms-stream-list))
8573   (let* ((cur-buf anything-current-buffer)
8574          (bookmark (assoc elm emms-stream-list))
8575          (name     (read-from-minibuffer "Description: "
8576                                          (nth 0 bookmark)))
8577          (url      (read-from-minibuffer "URL: "
8578                                          (nth 1 bookmark)))
8579          (fd       (read-from-minibuffer "Feed Descriptor: "
8580                                          (int-to-string (nth 2 bookmark))))
8581          (type     (read-from-minibuffer "Type (url, streamlist, or lastfm): "
8582                                          (format "%s" (car (last bookmark))))))
8583     (save-window-excursion
8584       (emms-streams)
8585       (when (re-search-forward (concat "^" name) nil t)
8586         (beginning-of-line)
8587         (emms-stream-delete-bookmark)
8588         (emms-stream-add-bookmark name url (string-to-number fd) type)
8589         (emms-stream-save-bookmarks-file)
8590         (emms-stream-quit)
8591         (anything-c-switch-to-buffer cur-buf)))))
8592
8593 (defun anything-emms-stream-delete-bookmark (candidate)
8594   "Delete emms-streams bookmarks from anything."
8595   (let* ((cands   (anything-marked-candidates))
8596          (bmks    (loop for bm in cands collect
8597                         (car (assoc bm emms-stream-list))))
8598          (bmk-reg (mapconcat 'regexp-quote bmks "\\|^")))
8599     (when (y-or-n-p (format "Really delete radios\n -%s: ? "
8600                             (mapconcat 'identity bmks "\n -")))
8601       (save-window-excursion
8602         (emms-streams)
8603         (goto-char (point-min))
8604         (loop while (re-search-forward bmk-reg nil t)
8605               do (progn (beginning-of-line)
8606                         (emms-stream-delete-bookmark))
8607               finally do (progn
8608                            (emms-stream-save-bookmarks-file)
8609                            (emms-stream-quit)))))))
8610
8611 (defvar anything-c-source-emms-streams
8612   '((name . "Emms Streams")
8613     (init . (lambda ()
8614               (emms-stream-init)))
8615     (candidates . (lambda ()
8616                     (declare (special emms-stream-list))
8617                     (mapcar 'car emms-stream-list)))
8618     (action . (("Play" . (lambda (elm)
8619                            (declare (special emms-stream-list))
8620                            (let* ((stream (assoc elm emms-stream-list))
8621                                   (fn (intern (concat "emms-play-" (symbol-name (car (last stream))))))
8622                                   (url (second stream)))
8623                              (funcall fn url))))
8624                ("Delete" . anything-emms-stream-delete-bookmark)
8625                ("Edit" . anything-emms-stream-edit-bookmark)))
8626     (filtered-candidate-transformer . anything-c-adaptive-sort)))
8627
8628 ;; Don't forget to set `emms-source-file-default-directory'
8629 (defvar anything-c-source-emms-dired
8630   '((name . "Music Directory")
8631     (candidates . (lambda ()
8632                     (cddr (directory-files emms-source-file-default-directory))))
8633     (action .
8634      (("Play Directory" . (lambda (item)
8635                             (emms-play-directory
8636                              (expand-file-name
8637                               item
8638                               emms-source-file-default-directory))))
8639       ("Open dired in file's directory" . (lambda (item)
8640                                             (anything-c-open-dired
8641                                              (expand-file-name
8642                                               item
8643                                               emms-source-file-default-directory))))))
8644     (filtered-candidate-transformer . anything-c-adaptive-sort)))
8645
8646
8647 (defun anything-c-emms-files-modifier (candidates source)
8648   (let ((current-playlist (with-current-emms-playlist
8649                               (loop with cur-list = (emms-playlist-tracks-in-region
8650                                                      (point-min) (point-max))
8651                                     for i in cur-list
8652                                     for name = (assoc-default 'name i)
8653                                     when name
8654                                     collect name))))
8655     (loop for i in candidates
8656           if (member (cdr i) current-playlist)
8657           collect (cons (propertize (car i)
8658                                     'face 'anything-emms-playlist)
8659                         (cdr i)) into lis
8660           else collect i into lis
8661           finally return (reverse lis))))
8662
8663 (defun anything-c-emms-play-current-playlist ()
8664   "Play current playlist."
8665   (with-current-emms-playlist
8666       (emms-playlist-first)
8667     (emms-playlist-mode-play-smart)))
8668
8669 (defvar anything-c-source-emms-files
8670   '((name . "Emms files")
8671     (candidates . (lambda ()
8672                     (loop for v being the hash-values in emms-cache-db
8673                           for name      = (assoc-default 'name v)
8674                           for artist    = (or (assoc-default 'info-artist v) "unknown")
8675                           for genre     = (or (assoc-default 'info-genre v) "unknown")
8676                           for tracknum  = (or (assoc-default 'info-tracknumber v) "unknown")
8677                           for song      = (or (assoc-default 'info-title v) "unknown")
8678                           for info      = (concat artist " - " genre " - " tracknum ": " song)
8679                           unless (string-match "^\\(http\\|mms\\):" name)
8680                           collect (cons info name))))
8681     (filtered-candidate-transformer . anything-c-emms-files-modifier)
8682     (candidate-number-limit . 9999)
8683     (action . (("Play file" . emms-play-file)
8684                ("Add to Playlist and play (C-u clear current)"
8685                 . (lambda (candidate)
8686                     (when anything-current-prefix-arg
8687                       (emms-playlist-current-clear))
8688                     (emms-playlist-new)
8689                     (mapc 'emms-add-playlist-file (anything-marked-candidates))
8690                     (unless emms-player-playing-p
8691                       (anything-c-emms-play-current-playlist))))))))
8692
8693
8694 \f
8695 ;;; Jabber Contacts (jabber.el)
8696 (defun anything-c-jabber-online-contacts ()
8697   "List online Jabber contacts."
8698   (with-no-warnings
8699     (let (jids)
8700       (dolist (item (jabber-concat-rosters) jids)
8701         (when (get item 'connected)
8702           (push (if (get item 'name)
8703                     (cons (get item 'name) item)
8704                     (cons (symbol-name item) item)) jids))))))
8705
8706 (defvar anything-c-source-jabber-contacts
8707   '((name . "Jabber Contacts")
8708     (init . (lambda () (require 'jabber)))
8709     (candidates . (lambda () (mapcar 'car (anything-c-jabber-online-contacts))))
8710     (action . (lambda (x)
8711                 (jabber-chat-with
8712                  (jabber-read-account)
8713                  (symbol-name
8714                   (cdr (assoc x (anything-c-jabber-online-contacts)))))))))
8715
8716
8717 \f
8718 ;;; Call source.
8719 (defvar anything-source-select-buffer "*anything source select*")
8720 (defvar anything-c-source-call-source
8721   `((name . "Call anything source")
8722     (candidate-number-limit)
8723     (candidates
8724      . (lambda ()
8725          (loop for vname in (all-completions "anything-c-source-" obarray)
8726                for var = (intern vname)
8727                for name = (ignore-errors (assoc-default 'name (symbol-value var)))
8728                if name collect
8729                (cons (format "%s `%s'"
8730                              name (propertize vname 'face 'font-lock-variable-name-face))
8731                      var))))
8732     (action
8733      . (("Invoke anything with selected source"
8734          .
8735          (lambda (candidate)
8736            (setq anything-candidate-number-limit 9999)
8737            (anything candidate nil nil nil nil
8738                      anything-source-select-buffer)))
8739         ("Describe variable" . describe-variable)
8740         ("Find variable" . find-variable)))
8741     (persistent-action . describe-variable)
8742     (persistent-help . "Show description of this source")))
8743
8744 (defun anything-call-source-from-anything ()
8745   "Call anything source within `anything' session."
8746   (interactive)
8747   (setq anything-input-idle-delay 0)
8748   (anything-set-sources '(anything-c-source-call-source)))
8749
8750 ;;; Execute Preconfigured anything.
8751 (defvar anything-c-source-anything-commands
8752   '((name . "Preconfigured Anything")
8753     (candidates . anything-c-anything-commands-candidates)
8754     (type . command)
8755     (candidate-number-limit)))
8756
8757 (defun anything-c-anything-commands-candidates ()
8758   (loop for (cmd . desc) in (anything-c-list-preconfigured-anything)
8759         collect (cons (if (where-is-internal cmd nil t)
8760                           (substitute-command-keys (format "M-x %s (\\[%s]) : %s" cmd cmd desc))
8761                           (substitute-command-keys (format "\\[%s] : %s" cmd desc)))
8762                       cmd)))
8763
8764 \f
8765 ;;; Occur
8766 ;;
8767 ;;
8768 (defun anything-c-occur-init ()
8769   "Create the initial anything occur buffer.
8770 If region is active use region as buffer contents
8771 instead of whole buffer."
8772   (with-current-buffer (anything-candidate-buffer 'global)
8773     (erase-buffer)
8774     (let ((buf-contents
8775            (with-anything-current-buffer
8776              (if (anything-region-active-p)
8777                  (buffer-substring (region-beginning) (region-end))
8778                  (buffer-substring (point-min) (point-max))))))
8779       (insert buf-contents))))
8780
8781 (defun anything-c-occur-get-line (s e)
8782   (format "%7d:%s" (line-number-at-pos (1- s)) (buffer-substring s e)))
8783
8784 (defun anything-c-occur-query-replace-regexp (candidate)
8785   "Query replace regexp starting from CANDIDATE.
8786 If region is active ignore CANDIDATE and replace only in region.
8787 With a prefix arg replace only matches surrounded by word boundaries,
8788 i.e Don't replace inside a word, regexp is surrounded with \\bregexp\\b."
8789   (let ((regexp anything-input))
8790     (unless (anything-region-active-p)
8791       (anything-c-action-line-goto candidate))
8792     (apply 'query-replace-regexp
8793            (anything-c-query-replace-args regexp))))
8794
8795 (defun anything-occur-run-query-replace-regexp ()
8796   "Run `query-replace-regexp' in anything occur from keymap."
8797   (interactive)
8798   (anything-c-quit-and-execute-action
8799    'anything-c-occur-query-replace-regexp))
8800
8801 (defvar anything-c-source-occur
8802   `((name . "Occur")
8803     (init . anything-c-occur-init)
8804     (candidates-in-buffer)
8805     (migemo)
8806     (get-line . anything-c-occur-get-line)
8807     (display-to-real . anything-c-display-to-real-line)
8808     (action . (("Go to Line" . anything-c-action-line-goto)
8809                ("Query replace regexp (C-u Not inside word.)"
8810                 . anything-c-occur-query-replace-regexp)))
8811     (recenter)
8812     (mode-line . anything-occur-mode-line)
8813     (keymap . ,anything-occur-map)
8814     (requires-pattern . 1)
8815     (delayed)))
8816
8817 \f
8818 ;;; Anything browse code.
8819 (defun anything-c-browse-code-get-line (beg end)
8820   "Select line if it match the regexp corresponding to current `major-mode'.
8821 Line is parsed for BEG position to END position."
8822   (let ((str-line (buffer-substring beg end))
8823         (regexp   (assoc-default major-mode
8824                                  anything-c-browse-code-regexp-alist))
8825         (num-line (if (string= anything-pattern "") beg (1- beg))))
8826     (when (and regexp (string-match regexp str-line))
8827       (format "%4d:%s" (line-number-at-pos num-line) str-line))))
8828
8829
8830 (defvar anything-c-source-browse-code
8831   '((name . "Browse code")
8832     (init . (lambda ()
8833               (anything-candidate-buffer anything-current-buffer)
8834               (with-anything-current-buffer
8835                 (jit-lock-fontify-now))))
8836     (candidate-number-limit . 9999)
8837     (candidates-in-buffer)
8838     (get-line . anything-c-browse-code-get-line)
8839     (type . line)
8840     (recenter)))
8841
8842 \f
8843 ;; Do many actions for input
8844 (defvar anything-c-source-create
8845   '((name . "Create")
8846     (dummy)
8847     (action)
8848     (action-transformer . anything-create--actions))
8849   "Do many create actions from `anything-pattern'.
8850 See also `anything-create--actions'.")
8851
8852 (defun anything-create-from-anything ()
8853   "Run `anything-create' from `anything' as a fallback."
8854   (interactive)
8855   (anything-run-after-quit 'anything-create nil anything-pattern))
8856
8857 (defun anything-create--actions (&rest ignored)
8858   "Default actions for `anything-create' / `anything-c-source-create'."
8859   (remove-if-not
8860    (lambda (pair) (and (consp pair) (functionp (cdr pair))))
8861    (append anything-create--actions-private
8862            '(("find-file" . find-file)
8863              ("find-file other window" . find-file-other-window)
8864              ("New buffer" . anything-c-switch-to-buffer)
8865              ("New buffer other window" . switch-to-buffer-other-window)
8866              ("Bookmark Set" . bookmark-set)
8867              ("Set Register" .
8868               (lambda (x) (set-register (read-char "Register: ") x)))
8869              ("Insert Linkd star" . linkd-insert-star)
8870              ("Insert Linkd Tag" . linkd-insert-tag)
8871              ("Insert Linkd Link" . linkd-insert-link)
8872              ("Insert Linkd Lisp" . linkd-insert-lisp)
8873              ("Insert Linkd Wiki" . linkd-insert-wiki)
8874              ("Google Search" . google)))))
8875
8876 \f
8877 ;; Minibuffer History
8878 ;;
8879 ;;
8880 (defvar anything-c-source-minibuffer-history
8881   '((name . "Minibuffer History")
8882     (header-name . (lambda (name)
8883                      (format "%s (%s)" name minibuffer-history-variable)))
8884     (candidates
8885      . (lambda ()
8886          (let ((history (loop for i in
8887                               (symbol-value minibuffer-history-variable)
8888                               unless (string= "" i) collect i)))
8889            (if (consp (car history))
8890                (mapcar 'prin1-to-string history)
8891                history))))
8892     (migemo)
8893     (action . (lambda (candidate)
8894                 (delete-minibuffer-contents)
8895                 (insert candidate)))))
8896
8897 \f
8898 ;;; Elscreen
8899 ;;
8900 ;;
8901 (defvar anything-c-source-elscreen
8902   '((name . "Elscreen")
8903     (candidates
8904      . (lambda ()
8905          (if (cdr (elscreen-get-screen-to-name-alist))
8906              (sort
8907               (loop for sname in (elscreen-get-screen-to-name-alist)
8908                     append (list (format "[%d] %s" (car sname) (cdr sname))))
8909               #'(lambda (a b) (compare-strings a nil nil b nil nil))))))
8910     (action
8911      . (("Change Screen" .
8912                          (lambda (candidate)
8913                            (elscreen-goto (- (aref candidate 1) (aref "0" 0)))))
8914         ("Kill Screen(s)" .
8915                           (lambda (candidate)
8916                             (dolist (i (anything-marked-candidates))
8917                               (elscreen-goto (- (aref i 1) (aref "0" 0)))
8918                               (elscreen-kill))))
8919         ("Only Screen" .
8920                        (lambda (candidate)
8921                          (elscreen-goto (- (aref candidate 1) (aref "0" 0)))
8922                          (elscreen-kill-others)))))))
8923
8924 \f
8925 ;;;; <System>
8926
8927 ;;; Top (process)
8928 (defvar anything-c-top-command "COLUMNS=%s top -b -n 1"
8929   "Top command (batch mode). %s is replaced with `frame-width'.")
8930 (defvar anything-c-source-top
8931   '((name . "Top (Press C-c C-u to refresh)")
8932     (init . anything-c-top-init)
8933     (candidates-in-buffer)
8934     (display-to-real . anything-c-top-display-to-real)
8935     (persistent-action . anything-c-top-sh-persistent-action)
8936     (persistent-help . "SIGTERM")
8937     (action
8938      ("kill (TERM)" . (lambda (pid)
8939                         (anything-c-top-sh (format "kill -TERM %s" pid))))
8940      ("kill (KILL)" . (lambda (pid)
8941                         (anything-c-top-sh (format "kill -KILL %s" pid))))
8942      ("Copy PID" . (lambda (pid) (kill-new pid))))))
8943
8944 (defun anything-c-top-sh (cmd)
8945   (message "Executed %s\n%s" cmd (shell-command-to-string cmd)))
8946
8947 (defun anything-c-top-sh-persistent-action (pid)
8948   (delete-other-windows)
8949   (anything-c-top-sh (format "kill -TERM %s" pid))
8950   (anything-force-update))
8951
8952 (defun anything-c-top-init ()
8953   (with-current-buffer (anything-candidate-buffer 'global)
8954     (call-process-shell-command
8955      (format anything-c-top-command
8956              (- (frame-width) (if anything-enable-digit-shortcuts 4 0)))
8957      nil (current-buffer))))
8958
8959 (defun anything-c-top-display-to-real (line)
8960   (car (split-string line)))
8961
8962 ;;; Timers
8963 (defvar anything-c-source-absolute-time-timers
8964   '((name . "Absolute Time Timers")
8965     (candidates . timer-list)
8966     (type . timer)))
8967
8968 (defvar anything-c-source-idle-time-timers
8969   '((name . "Idle Time Timers")
8970     (candidates . timer-idle-list)
8971     (type . timer)))
8972
8973 (defun anything-c-timer-real-to-display (timer)
8974   (destructuring-bind (triggered t1 t2 t3 repeat-delay func args idle-delay)
8975       (append timer nil)                ;use `append' to convert vector->list
8976     (format "%s repeat=%5S %s(%s)"
8977             (let ((time (list t1 t2 t3)))
8978               (if idle-delay
8979                   (format-time-string "idle-for=%5s" time)
8980                   (format-time-string "%m/%d %T" time)))
8981             repeat-delay
8982             func
8983             (mapconcat 'prin1-to-string args " "))))
8984
8985 ;;; X RandR resolution change
8986 ;;
8987 ;;
8988 ;;; FIXME I do not care multi-display.
8989
8990 (defun anything-c-xrandr-info ()
8991   "Return a pair with current X screen number and current X display name."
8992   (with-temp-buffer
8993     (call-process "xrandr" nil (current-buffer) nil
8994                   "--current")
8995     (let (screen output)
8996       (goto-char (point-min))
8997       (save-excursion
8998         (when (re-search-forward "\\(^Screen \\)\\([0-9]\\):" nil t)
8999           (setq screen (match-string 2))))
9000       (when (re-search-forward "^\\(.*\\) connected" nil t)
9001         (setq output (match-string 1)))
9002       (list screen output))))
9003
9004 (defun anything-c-xrandr-screen ()
9005   "Return current X screen number."
9006   (car (anything-c-xrandr-info)))
9007
9008 (defun anything-c-xrandr-output ()
9009   "Return current X display name."
9010   (cadr (anything-c-xrandr-info)))
9011
9012 (defvar anything-c-source-xrandr-change-resolution
9013   '((name . "Change Resolution")
9014     (candidates
9015      . (lambda ()
9016          (with-temp-buffer
9017            (call-process "xrandr" nil (current-buffer) nil
9018                          "--screen" (anything-c-xrandr-screen) "-q")
9019            (goto-char 1)
9020            (loop with modes = nil
9021                  while (re-search-forward "   \\([0-9]+x[0-9]+\\)" nil t)
9022                  for mode = (match-string 1)
9023                  unless (member mode modes)
9024                  collect mode into modes
9025                  finally return modes))))
9026     (action
9027      ("Change Resolution"
9028       . (lambda (mode)
9029           (call-process "xrandr" nil nil nil
9030                         "--screen" (anything-c-xrandr-screen)
9031                         "--output" (anything-c-xrandr-output)
9032                         "--mode" mode))))))
9033
9034 ;;; Xfont selection
9035 ;;
9036 ;;
9037 (defun anything-c-persistent-xfont-action (elm)
9038   "Show current font temporarily"
9039   (let ((current-font (cdr (assoc 'font (frame-parameters))))
9040         (default-font elm))
9041     (unwind-protect
9042          (progn (set-frame-font default-font 'keep-size) (sit-for 2))
9043       (set-frame-font current-font))))
9044
9045 (defvar anything-c-xfonts-cache nil)
9046 (defvar anything-c-source-xfonts
9047   '((name . "X Fonts")
9048     (init . (lambda ()
9049               (unless anything-c-xfonts-cache
9050                 (setq anything-c-xfonts-cache
9051                       (x-list-fonts "*")))))
9052     (candidates . anything-c-xfonts-cache)
9053     (action . (("Copy to kill ring" . (lambda (elm)
9054                                         (kill-new elm)))
9055                ("Set Font" . (lambda (elm)
9056                                (kill-new elm)
9057                                (set-frame-font elm 'keep-size)
9058                                (message "New font have been copied to kill ring")))))
9059     (persistent-action . anything-c-persistent-xfont-action)
9060     (persistent-help . "Switch to this font temporarily")))
9061
9062 ;;; 𝕌𝕔𝕤 𝕊𝕪𝕞𝕓𝕠𝕝 𝕔𝕠𝕞𝕡𝕝𝕖𝕥𝕚𝕠𝕟
9063 ;;
9064 ;;
9065 (defvar anything-c-ucs-max-len 0)
9066 (defun anything-c-calculate-ucs-max-len ()
9067   "Calculate the length of longest `ucs-names' candidate."
9068   (loop with count = 0
9069         for (n . v) in (ucs-names)
9070         for len = (length n)
9071         if (> len count)
9072         do (setq count len)
9073         finally return count))
9074
9075 (defun anything-c-ucs-init ()
9076   "Initialize an anything buffer with ucs symbols.
9077 Only math* symbols are collected."
9078   (unless (> anything-c-ucs-max-len 0)
9079     (setq anything-c-ucs-max-len
9080           (anything-c-calculate-ucs-max-len)))
9081   (with-current-buffer (anything-candidate-buffer
9082                         (get-buffer-create "*anything ucs*"))
9083     ;; `ucs-names' fn will not run again, data is cached in
9084     ;; var `ucs-names'.
9085     (loop for (n . v) in (ucs-names)
9086           for len = (length n)
9087           for diff = (+ (- anything-c-ucs-max-len len) 2)
9088           unless (string= "" n)
9089           do (progn (insert (concat
9090                              n ":"
9091                              (make-string
9092                               diff ? )))
9093                     (ucs-insert v)
9094                     (insert "\n")))))
9095
9096 (defun anything-c-ucs-forward-char (candidate)
9097   (with-anything-current-buffer
9098     (forward-char 1)))
9099
9100 (defun anything-c-ucs-backward-char (candidate)
9101   (with-anything-current-buffer
9102     (forward-char -1)))
9103
9104 (defun anything-c-ucs-delete-backward (candidate)
9105   (with-anything-current-buffer
9106     (delete-char -1)))
9107
9108 (defun anything-c-ucs-insert-char (candidate)
9109   (with-anything-current-buffer
9110     (insert
9111      (replace-regexp-in-string
9112       " " ""
9113       (cadr (split-string candidate ":"))))))
9114
9115 (defun anything-c-ucs-persistent-insert ()
9116   (interactive)
9117   (anything-attrset 'action-insert 'anything-c-ucs-insert-char)
9118   (anything-execute-persistent-action 'action-insert))
9119
9120 (defun anything-c-ucs-persistent-forward ()
9121   (interactive)
9122   (anything-attrset 'action-forward 'anything-c-ucs-forward-char)
9123   (anything-execute-persistent-action 'action-forward))
9124
9125 (defun anything-c-ucs-persistent-backward ()
9126   (interactive)
9127   (anything-attrset 'action-back 'anything-c-ucs-backward-char)
9128   (anything-execute-persistent-action 'action-back))
9129
9130 (defun anything-c-ucs-persistent-delete ()
9131   (interactive)
9132   (anything-attrset 'action-delete 'anything-c-ucs-delete-backward)
9133   (anything-execute-persistent-action 'action-delete))
9134
9135 (defvar anything-c-source-ucs
9136   '((name . "Ucs names")
9137     (init . anything-c-ucs-init)
9138     (candidate-number-limit . 9999)
9139     (candidates-in-buffer)
9140     (mode-line . anything-c-ucs-mode-line-string)
9141     (action . (("Insert" . anything-c-ucs-insert-char)
9142                ("Forward char" . anything-c-ucs-forward-char)
9143                ("Backward char" . anything-c-ucs-backward-char)
9144                ("Delete char backward" . anything-c-ucs-delete-backward))))
9145   "Source for collecting `ucs-names' math symbols.")
9146
9147
9148 ;;; Emacs process
9149 ;;
9150 ;;
9151 (defvar anything-c-source-emacs-process
9152   '((name . "Emacs Process")
9153     (candidates . (lambda () (mapcar #'process-name (process-list))))
9154     (persistent-action . (lambda (elm)
9155                            (delete-process (get-process elm))
9156                            (anything-delete-current-selection)))
9157     (persistent-help . "Kill Process")
9158     (action ("Kill Process" . (lambda (elm)
9159                                 (delete-process (get-process elm)))))))
9160
9161 ;;; World time
9162 ;;
9163 ;;
9164 (defvar anything-c-source-time-world
9165   '((name . "Time World List")
9166     (init . (lambda ()
9167               (let ((anything-buffer (anything-candidate-buffer 'global)))
9168                 (with-current-buffer anything-buffer
9169                   (display-time-world-display display-time-world-list)))))
9170     (candidates-in-buffer)))
9171
9172
9173 \f
9174 ;;; Anything interface for Debian/Ubuntu packages (apt-*)
9175 ;;
9176 ;;
9177 (defvar anything-c-source-apt
9178   '((name . "APT")
9179     (init . anything-c-apt-init)
9180     (candidates-in-buffer)
9181     (candidate-transformer anything-c-apt-candidate-transformer)
9182     (display-to-real . anything-c-apt-display-to-real)
9183     (requires-pattern . 2)
9184     (update . anything-c-apt-refresh)
9185     (action
9186      ("Show package description" . anything-c-apt-cache-show)
9187      ("Install package" . anything-c-apt-install)
9188      ("Reinstall package" . anything-c-apt-reinstall)
9189      ("Remove package" . anything-c-apt-uninstall)
9190      ("Purge package" . anything-c-apt-purge))
9191     (persistent-action . anything-c-apt-persistent-action)
9192     (persistent-help . "Show package description")))
9193
9194 (defvar anything-c-apt-query "emacs")
9195 (defvar anything-c-apt-search-command "apt-cache search '%s'")
9196 (defvar anything-c-apt-show-command "apt-cache show '%s'")
9197 (defvar anything-c-apt-installed-packages nil)
9198 (defvar anything-c-apt-all-packages nil)
9199 (defvar anything-c-apt-input-history nil)
9200
9201 (defun anything-c-apt-refresh ()
9202   "Refresh installed candidates list."
9203   (setq anything-c-apt-installed-packages nil)
9204   (setq anything-c-apt-all-packages nil))
9205
9206 (defun anything-c-apt-persistent-action (candidate)
9207   "Persistent action for APT source."
9208   (anything-c-apt-cache-show candidate))
9209
9210 (defun anything-c-apt-candidate-transformer (candidates)
9211   "Show installed CANDIDATES and the ones to deinstall in a different color."
9212   (loop for cand in candidates
9213         for name = (anything-c-apt-display-to-real cand)
9214         collect (cond ((string= (assoc-default
9215                                  name anything-c-apt-installed-packages)
9216                                 "deinstall")
9217                        (propertize cand 'face 'anything-apt-deinstalled))
9218                       ((string= (assoc-default
9219                                  name anything-c-apt-installed-packages)
9220                                 "install")
9221                        (propertize cand 'face 'anything-apt-installed))
9222                       (t cand))))
9223
9224 (defun anything-c-apt-init ()
9225   "Initialize list of debian packages."
9226   (let ((query ""))
9227     (unless (and anything-c-apt-installed-packages
9228                  anything-c-apt-all-packages)
9229       (message "Loading package list...")
9230       (setq anything-c-apt-installed-packages
9231             (with-temp-buffer
9232               (call-process-shell-command "dpkg --get-selections"
9233                                           nil (current-buffer))
9234               (loop for i in (split-string (buffer-string) "\n" t)
9235                     for p = (split-string i)
9236                     collect (cons (car p) (cadr p)))))
9237       (setq anything-c-apt-all-packages
9238             (with-current-buffer
9239                 (anything-candidate-buffer
9240                  (get-buffer-create (format "*anything-apt*")))
9241               (erase-buffer)
9242               (call-process-shell-command
9243                (format anything-c-apt-search-command query)
9244                nil (current-buffer))))
9245       (message "Loading package list done")
9246       (sit-for 0.5))))
9247
9248 (defun anything-c-apt-display-to-real (line)
9249   "Return only name of a debian package.
9250 LINE is displayed like:
9251 package name - description."
9252   (car (split-string line " - ")))
9253
9254 (defun anything-c-shell-command-if-needed (command)
9255   "Run shell command COMMAND to describe package.
9256 If a buffer named COMMAND already exists, just switch to it."
9257   (let ((buf (get-buffer command)))
9258     (anything-c-switch-to-buffer (get-buffer-create command))
9259     (unless buf (insert (shell-command-to-string command)))))
9260
9261 (defun anything-c-apt-cache-show (package)
9262   "Show information on apt package PACKAGE."
9263   (anything-c-shell-command-if-needed
9264    (format anything-c-apt-show-command package)))
9265
9266 (defun anything-c-apt-install (package)
9267   "Run 'apt-get install' shell command on PACKAGE."
9268   (anything-c-apt-generic-action :action 'install))
9269
9270 (defun anything-c-apt-reinstall (package)
9271   "Run 'apt-get install --reinstall' shell command on PACKAGE."
9272   (anything-c-apt-generic-action :action 'reinstall))
9273
9274 (defun anything-c-apt-uninstall (package)
9275   "Run 'apt-get remove' shell command on PACKAGE."
9276   (anything-c-apt-generic-action :action 'uninstall))
9277
9278 (defun anything-c-apt-purge (package)
9279   "Run 'apt-get purge' shell command on PACKAGE."
9280   (anything-c-apt-generic-action :action 'purge))
9281
9282 (defun* anything-c-apt-generic-action (&key action)
9283   "Run 'apt-get ACTION'.
9284 Support install, remove and purge actions."
9285   (ansi-term (getenv "SHELL") "anything apt")
9286   (term-line-mode)
9287   (let ((command   (case action
9288                      ('install   "sudo apt-get install ")
9289                      ('reinstall "sudo apt-get install --reinstall ")
9290                      ('uninstall "sudo apt-get remove ")
9291                      ('purge     "sudo apt-get purge ")
9292                      (t          (error "Unknow action"))))
9293         (beg       (point))
9294         end
9295         (cand-list (mapconcat #'(lambda (x) (format "'%s'" x))
9296                               (anything-marked-candidates) " ")))
9297     (goto-char (point-max))
9298     (insert (concat command cand-list))
9299     (setq end (point))
9300     (if (y-or-n-p (format "%s package" (symbol-name action)))
9301         (progn
9302           (setq anything-c-external-commands-list nil)
9303           (setq anything-c-apt-installed-packages nil)
9304           (term-char-mode) (term-send-input))
9305         (delete-region beg end) (term-send-eof) (kill-buffer))))
9306
9307 ;; (anything-c-apt-install "jed")
9308
9309 \f
9310 ;;; Anything UI for gentoo portage.
9311 ;;
9312 ;;
9313 (defvar anything-c-gentoo-use-flags nil)
9314 (defvar anything-c-gentoo-buffer "*anything-gentoo-output*")
9315 (defvar anything-c-cache-gentoo nil)
9316 (defvar anything-c-cache-world nil)
9317 (defvar anything-c-source-gentoo
9318   '((name . "Portage sources")
9319     (init . (lambda ()
9320               (get-buffer-create anything-c-gentoo-buffer)
9321               (unless anything-c-cache-gentoo
9322                 (anything-c-gentoo-setup-cache))
9323               (unless anything-c-cache-world
9324                 (setq anything-c-cache-world (anything-c-gentoo-get-world)))
9325               (anything-c-gentoo-init-list)))
9326     (candidates-in-buffer)
9327     (match . identity)
9328     (candidate-transformer anything-c-highlight-world)
9329     (action . (("Show package" . (lambda (elm)
9330                                    (anything-c-gentoo-eshell-action elm "eix")))
9331                ("Show history" . (lambda (elm)
9332                                    (if (member elm anything-c-cache-world)
9333                                        (anything-c-gentoo-eshell-action elm "genlop -qe")
9334                                        (message "No infos on packages not yet installed"))))
9335                ("Copy in kill-ring" . kill-new)
9336                ("insert at point" . insert)
9337                ("Browse HomePage" . (lambda (elm)
9338                                       (let ((urls (anything-c-gentoo-get-url elm)))
9339                                         (browse-url (anything-comp-read "Url: " urls :must-match t)))))
9340                ("Show extra infos" . (lambda (elm)
9341                                        (if (member elm anything-c-cache-world)
9342                                            (anything-c-gentoo-eshell-action elm "genlop -qi")
9343                                            (message "No infos on packages not yet installed"))))
9344                ("Show use flags" . (lambda (elm)
9345                                      (anything-c-gentoo-default-action elm "equery" "-C" "u")
9346                                      (font-lock-add-keywords nil '(("^\+.*" . font-lock-variable-name-face)))
9347                                      (font-lock-mode 1)))
9348                ("Run emerge pretend" . (lambda (elm)
9349                                          (anything-c-gentoo-eshell-action elm "emerge -p")))
9350                ("Emerge" . (lambda (elm)
9351                              (anything-gentoo-install elm :action 'install)))
9352                ("Unmerge" . (lambda (elm)
9353                               (anything-gentoo-install elm :action 'uninstall)))
9354                ("Show dependencies" . (lambda (elm)
9355                                         (anything-c-gentoo-default-action elm "equery" "-C" "d")))
9356                ("Show related files" . (lambda (elm)
9357                                          (anything-c-gentoo-default-action elm "equery" "files")))
9358                ("Refresh" . (lambda (elm)
9359                               (anything-c-gentoo-setup-cache)
9360                               (setq anything-c-cache-world (anything-c-gentoo-get-world))))))))
9361
9362
9363 (defun* anything-gentoo-install (candidate &key action)
9364   (setq anything-c-external-commands-list nil)
9365   (ansi-term (getenv "SHELL") "Gentoo emerge")
9366   (term-line-mode)
9367   (let ((command (case action
9368                    ('install "sudo emerge -av ")
9369                    ('uninstall "sudo emerge -avC ")
9370                    (t (error "Unknow action"))))
9371         (elms (mapconcat 'identity (anything-marked-candidates) " "))
9372         (beg (point)) end)
9373     (goto-char (point-max))
9374     (insert (concat command elms))
9375     (setq end (point))
9376     (term-char-mode) (term-send-input)))
9377
9378 (defun anything-c-gentoo-default-action (elm command &rest args)
9379   "Gentoo default action that use `anything-c-gentoo-buffer'."
9380   (if (member elm anything-c-cache-world)
9381       (progn
9382         (anything-c-switch-to-buffer anything-c-gentoo-buffer)
9383         (erase-buffer)
9384         (let ((com-list (append args (list elm))))
9385           (apply #'call-process command nil t nil
9386                  com-list)))
9387       (message "No infos on packages not yet installed")))
9388
9389 (defvar anything-c-source-use-flags
9390   '((name . "Use Flags")
9391     (init . (lambda ()
9392               (unless anything-c-gentoo-use-flags
9393                 (anything-c-gentoo-setup-use-flags-cache))
9394               (anything-c-gentoo-get-use)))
9395     (candidates-in-buffer)
9396     (match . identity)
9397     (candidate-transformer anything-c-highlight-local-use)
9398     (action . (("Description"
9399                 . (lambda (elm)
9400                     (anything-c-switch-to-buffer anything-c-gentoo-buffer)
9401                     (erase-buffer)
9402                     (apply #'call-process "euse" nil t nil
9403                            `("-i"
9404                              ,elm))
9405                     (font-lock-add-keywords nil `((,elm . font-lock-variable-name-face)))
9406                     (font-lock-mode 1)))
9407                ("Enable"
9408                 . (lambda (elm)
9409                     (anything-c-gentoo-eshell-action elm "*sudo -p Password: euse -E")))
9410                ("Disable"
9411                 . (lambda (elm)
9412                     (anything-c-gentoo-eshell-action elm "*sudo -p Password: euse -D")))
9413                ("Remove"
9414                 . (lambda (elm)
9415                     (anything-c-gentoo-eshell-action elm "*sudo -p Password: euse -P")))
9416                ("Show which dep use this flag"
9417                 . (lambda (elm)
9418                     (anything-c-switch-to-buffer anything-c-gentoo-buffer)
9419                     (erase-buffer)
9420                     (apply #'call-process "equery" nil t nil
9421                            `("-C"
9422                              "h"
9423                              ,elm))))))))
9424
9425
9426
9427 (defun anything-c-gentoo-init-list ()
9428   "Initialize buffer with all packages in Portage."
9429   (let* ((portage-buf (get-buffer-create "*anything-gentoo*"))
9430          (buf (anything-candidate-buffer 'portage-buf)))
9431     (with-current-buffer buf
9432       (dolist (i anything-c-cache-gentoo)
9433         (insert (concat i "\n"))))))
9434
9435 (defun anything-c-gentoo-setup-cache ()
9436   "Set up `anything-c-cache-gentoo'"
9437   (setq anything-c-cache-gentoo
9438         (split-string (with-temp-buffer
9439                         (call-process "eix" nil t nil
9440                                       "--only-names")
9441                         (buffer-string)))))
9442
9443 (defun anything-c-gentoo-eshell-action (elm command)
9444   (when (get-buffer "*EShell Command Output*")
9445     (kill-buffer "*EShell Command Output*"))
9446   (message "Wait searching...")
9447   (let ((buf-fname (buffer-file-name anything-current-buffer)))
9448     (if (and buf-fname (string-match tramp-file-name-regexp buf-fname))
9449         (progn
9450           (save-window-excursion
9451             (pop-to-buffer "*scratch*")
9452             (eshell-command (format "%s %s" command elm)))
9453           (pop-to-buffer "*EShell Command Output*"))
9454         (eshell-command (format "%s %s" command elm)))))
9455
9456 (defun anything-c-gentoo-get-use ()
9457   "Initialize buffer with all use flags."
9458   (let* ((use-buf (get-buffer-create "*anything-gentoo-use*"))
9459          (buf (anything-candidate-buffer 'use-buf)))
9460     (with-current-buffer buf
9461       (dolist (i anything-c-gentoo-use-flags)
9462         (insert (concat i "\n"))))))
9463
9464
9465 (defun anything-c-gentoo-setup-use-flags-cache ()
9466   "Setup `anything-c-gentoo-use-flags'"
9467   (setq anything-c-gentoo-use-flags
9468         (split-string (with-temp-buffer
9469                         (call-process "eix" nil t nil
9470                                       "--print-all-useflags")
9471                         (buffer-string)))))
9472
9473 (defun anything-c-gentoo-get-url (elm)
9474   "Return a list of urls from eix output."
9475   (loop
9476         with url-list = (split-string
9477                          (with-temp-buffer
9478                            (call-process "eix" nil t nil
9479                                          elm "--format" "<homepage>\n")
9480                            (buffer-string)))
9481         with all
9482         for i in url-list
9483         when (and (string-match "^http://.*" i)
9484                   (not (member i all)))
9485         collect i into all
9486         finally return all))
9487
9488 (defun anything-c-gentoo-get-world ()
9489   "Return list of all installed package on your system."
9490   (split-string (with-temp-buffer
9491                   (call-process "qlist" nil t nil
9492                                 "-I")
9493                   (buffer-string))))
9494
9495 (defun anything-c-gentoo-get-local-use ()
9496   (split-string (with-temp-buffer
9497                   (call-process "portageq" nil t nil
9498                                 "envvar"
9499                                 "USE")
9500                   (buffer-string))))
9501
9502
9503 (defun anything-c-highlight-world (eix)
9504   "Highlight all installed package."
9505   (loop for i in eix
9506         if (member i anything-c-cache-world)
9507         collect (propertize i 'face 'anything-gentoo-match-face)
9508         else
9509         collect i))
9510
9511 (defun anything-c-highlight-local-use (use-flags)
9512   (let ((local-uses (anything-c-gentoo-get-local-use)))
9513     (loop for i in use-flags
9514           if (member i local-uses)
9515           collect (propertize i 'face 'anything-gentoo-match-face)
9516           else
9517           collect i)))
9518
9519
9520 \f
9521 ;;; Anything ratpoison UI
9522 ;;
9523 ;;
9524 (defvar anything-c-source-ratpoison-commands
9525   '((name . "Ratpoison Commands")
9526     (init . anything-c-ratpoison-commands-init)
9527     (candidates-in-buffer)
9528     (action ("Execute the command" . anything-c-ratpoison-commands-execute))
9529     (display-to-real . anything-c-ratpoison-commands-display-to-real)
9530     (candidate-number-limit)))
9531
9532 (defun anything-c-ratpoison-commands-init ()
9533   (unless (anything-candidate-buffer)
9534     (with-current-buffer (anything-candidate-buffer 'global)
9535       ;; with ratpoison prefix key
9536       (save-excursion
9537         (call-process "ratpoison" nil (current-buffer) nil "-c" "help"))
9538       (while (re-search-forward "^\\([^ ]+\\) \\(.+\\)$" nil t)
9539         (replace-match "<ratpoison> \\1: \\2"))
9540       (goto-char (point-max))
9541       ;; direct binding
9542       (save-excursion
9543         (call-process "ratpoison" nil (current-buffer) nil "-c" "help top"))
9544       (while (re-search-forward "^\\([^ ]+\\) \\(.+\\)$" nil t)
9545         (replace-match "\\1: \\2")))))
9546
9547 (defun anything-c-ratpoison-commands-display-to-real (display)
9548   (and (string-match ": " display)
9549        (substring display (match-end 0))))
9550
9551 (defun anything-c-ratpoison-commands-execute (candidate)
9552   (call-process "ratpoison" nil nil nil "-ic" candidate))
9553
9554
9555 \f
9556 ;;; Anything `completing-read' replacement
9557 ;;
9558 ;;
9559 (defun anything-comp-read-get-candidates (collection &optional test sort-fn alistp)
9560   "Convert COLLECTION to list removing elements that don't match TEST.
9561 See `anything-comp-read' about supported COLLECTION arguments.
9562
9563 SORT-FN is a predicate to sort COLLECTION.
9564
9565 ALISTP when non--nil will not use `all-completions' to collect
9566 candidates because it doesn't handle alists correctly for anything.
9567 i.e In `all-completions' the keys \(cars of elements\)
9568 are the possible completions. In anything we want to use the cdr instead
9569 like \(display . real\).
9570
9571 e.g
9572
9573 \(setq A '((a . 1) (b . 2) (c . 3)))
9574 ==>((a . 1) (b . 2) (c . 3))
9575 \(anything-comp-read \"test: \" A :alistp nil
9576                                   :exec-when-only-one t
9577                                   :initial-input \"a\")
9578 ==>\"a\"
9579 \(anything-comp-read \"test: \" A :alistp t
9580                                   :exec-when-only-one t
9581                                   :initial-input \"1\")
9582 ==>\"1\"
9583
9584 See docstring of `all-completions' for more info.
9585
9586 If COLLECTION is an `obarray', a TEST should be needed. See `obarray'."
9587   (let ((cands
9588          (cond ((and (eq collection obarray) test)
9589                 (all-completions "" collection test))
9590                ((and (vectorp collection) test)
9591                 (loop for i across collection when (funcall test i) collect i))
9592                ((vectorp collection)
9593                 (loop for i across collection collect i))
9594                ((and alistp test)
9595                 (loop for i in collection when (funcall test i) collect i))
9596                ((and (symbolp collection) (boundp collection))
9597                 (symbol-value collection))
9598                (alistp collection)
9599                ((and collection test)
9600                 (all-completions "" collection test))
9601                (t (all-completions "" collection)))))
9602     (if sort-fn (sort cands sort-fn) cands)))
9603
9604 (defun anything-cr-default-transformer (candidates source)
9605   "Default filter candidate function for `anything-comp-read'.
9606 Do nothing, just return candidate list unmodified."
9607   candidates)
9608
9609 (defun* anything-comp-read (prompt collection
9610                                    &key
9611                                    test
9612                                    initial-input
9613                                    default
9614                                    preselect
9615                                    (buffer "*Anything Completions*")
9616                                    must-match
9617                                    (requires-pattern 0)
9618                                    (history nil)
9619                                    input-history
9620                                    (persistent-action nil)
9621                                    (persistent-help "DoNothing")
9622                                    (mode-line anything-mode-line-string)
9623                                    (keymap anything-map)
9624                                    (name "Anything Completions")
9625                                    candidates-in-buffer
9626                                    exec-when-only-one
9627                                    (volatile t)
9628                                    sort
9629                                    (fc-transformer 'anything-cr-default-transformer)
9630                                    (marked-candidates nil)
9631                                    (alistp t))
9632   "Read a string in the minibuffer, with anything completion.
9633
9634 It is anything `completing-read' equivalent.
9635
9636 - PROMPT is the prompt name to use.
9637
9638 - COLLECTION can be a list, vector, obarray or hash-table.
9639   It can be also a function that receives three arguments:
9640   the values string, predicate and t. See `all-completions' for more details.
9641
9642 Keys description:
9643
9644 - TEST: A predicate called with one arg i.e candidate.
9645
9646 - INITIAL-INPUT: Same as input arg in `anything'.
9647
9648 - PRESELECT: See preselect arg of `anything'.
9649
9650 - DEFAULT: This option is used only for compatibility with regular
9651   Emacs `completing-read'.
9652
9653 - BUFFER: Name of anything-buffer.
9654
9655 - MUST-MATCH: Candidate selected must be one of COLLECTION.
9656
9657 - REQUIRES-PATTERN: Same as anything attribute, default is 0.
9658
9659 - HISTORY: A list containing specific history, default is nil.
9660   When it is non--nil, all elements of HISTORY are displayed in
9661   a special source before COLLECTION.
9662
9663 - INPUT-HISTORY: A symbol. the minibuffer input history will be
9664   stored there, if nil or not provided, `minibuffer-history'
9665   will be used instead.
9666
9667 - PERSISTENT-ACTION: A function called with one arg i.e candidate.
9668
9669 - PERSISTENT-HELP: A string to document PERSISTENT-ACTION.
9670
9671 - MODE-LINE: A string or list to display in mode line.
9672   (See `anything-mode-line-string')
9673
9674 - KEYMAP: A keymap to use in this `anything-comp-read'.
9675   (The keymap will be shared with history source)
9676
9677 - NAME: The name related to this local source.
9678
9679 - EXEC-WHEN-ONLY-ONE: Bound `anything-execute-action-at-once-if-one'
9680   to non--nil. (possibles values are t or nil).
9681
9682 - VOLATILE: Use volatile attribute \(enabled by default\).
9683
9684 - SORT: A predicate to give to `sort' e.g `string-lessp'.
9685
9686 - FC-TRANSFORMER: A `filtered-candidate-transformer' function.
9687
9688 - MARKED-CANDIDATES: If non--nil return candidate or marked candidates as a list.
9689
9690 - ALISTP: \(default is non--nil\) See `anything-comp-read-get-candidates'.
9691
9692 - CANDIDATES-IN-BUFFER: when non--nil use a source build with
9693   `anything-candidates-in-buffer' which is much faster.
9694   Argument VOLATILE have no effect when CANDIDATES-IN-BUFFER is non--nil.
9695
9696 Any prefix args passed during `anything-comp-read' invocation will be recorded
9697 in `anything-current-prefix-arg', otherwise if prefix args were given before
9698 `anything-comp-read' invocation, the value of `current-prefix-arg' will be used.
9699 That's mean you can pass prefix args before or after calling a command
9700 that use `anything-comp-read' See `anything-M-x' for example."
9701   (when (get-buffer anything-action-buffer)
9702     (kill-buffer anything-action-buffer))
9703   (flet ((action-fn (candidate)
9704            (if marked-candidates
9705                (anything-marked-candidates)
9706                (identity candidate))))
9707     ;; Assume completion have been already required,
9708     ;; so always use 'confirm.
9709     (when (eq must-match 'confirm-after-completion)
9710       (setq must-match 'confirm))
9711     (let* ((minibuffer-completion-confirm must-match)
9712            (must-match-map (when must-match
9713                              (let ((map (make-sparse-keymap)))
9714                                (define-key map (kbd "RET")
9715                                  'anything-confirm-and-exit-minibuffer)
9716                                map)))
9717            (anything-map (if must-match-map
9718                              (make-composed-keymap
9719                               must-match-map (or keymap anything-map))
9720                              (or keymap anything-map)))
9721            (src-hist `((name . ,(format "%s History" name))
9722                        (candidates
9723                         . (lambda ()
9724                             (let ((all (anything-comp-read-get-candidates
9725                                         history nil nil ,alistp)))
9726                               (delete
9727                                ""
9728                                (anything-fast-remove-dups
9729                                 (if (and default (not (string= default "")))
9730                                     (delq nil (cons default
9731                                                     (delete default all)))
9732                                     all)
9733                                 :test 'equal)))))
9734                        (filtered-candidate-transformer
9735                         . (lambda (candidates sources)
9736                             (loop for i in candidates
9737                                   do (set-text-properties 0 (length i) nil i)
9738                                   collect i)))
9739                        (persistent-action . ,persistent-action)
9740                        (persistent-help . ,persistent-help)
9741                        (mode-line . ,mode-line)
9742                        (action . ,'action-fn)))
9743            (src `((name . ,name)
9744                   (candidates
9745                    . (lambda ()
9746                        (let ((cands (anything-comp-read-get-candidates
9747                                      collection test sort alistp)))
9748                          (unless (or must-match (string= anything-pattern ""))
9749                            (setq cands (append (list anything-pattern) cands)))
9750                          (if (and default (not (string= default "")))
9751                              (delq nil (cons default (delete default cands)))
9752                              cands))))
9753                   (filtered-candidate-transformer ,fc-transformer)
9754                   (requires-pattern . ,requires-pattern)
9755                   (persistent-action . ,persistent-action)
9756                   (persistent-help . ,persistent-help)
9757                   (mode-line . ,mode-line)
9758                   (action . ,'action-fn)))
9759            (src-1 `((name . ,name)
9760                     (init
9761                      . (lambda ()
9762                          (let ((cands (anything-comp-read-get-candidates
9763                                        collection test sort alistp)))
9764                            (unless (or must-match (string= anything-pattern ""))
9765                              (setq cands (append (list anything-pattern) cands)))
9766                            (with-current-buffer (anything-candidate-buffer 'global)
9767                              (loop for i in
9768                                    (if (and default (not (string= default "")))
9769                                        (delq nil (cons default (delete default cands)))
9770                                        cands)
9771                                    do (insert (concat i "\n")))))))
9772                     (candidates-in-buffer)
9773                     (filtered-candidate-transformer ,fc-transformer)
9774                     (requires-pattern . ,requires-pattern)
9775                     (persistent-action . ,persistent-action)
9776                     (persistent-help . ,persistent-help)
9777                     (mode-line . ,mode-line)
9778                     (action . ,'action-fn)))
9779            (src-list (list src-hist
9780                            (if candidates-in-buffer
9781                                src-1
9782                                (if volatile
9783                                    (append src '((volatile)))
9784                                    src))))
9785            (anything-execute-action-at-once-if-one exec-when-only-one))
9786       (or
9787        (anything
9788         :sources src-list
9789         :input initial-input
9790         :default default
9791         :preselect preselect
9792         :prompt prompt
9793         :resume 'noresume
9794         :keymap anything-map
9795         :history (and (symbolp input-history) input-history)
9796         :buffer buffer)
9797        (when (and (eq anything-exit-status 0)
9798                   (eq must-match 'confirm))
9799          ;; Return empty string only if it is the DEFAULT
9800          ;; value and anything-pattern is empty.
9801          ;; otherwise return anything-pattern
9802          (if (and (string= anything-pattern "") default)
9803              default (identity anything-pattern)))
9804        (unless (or (eq anything-exit-status 1)
9805                    must-match) ; FIXME this should not be needed now.
9806          default)
9807        (keyboard-quit)))))
9808
9809 ;; Generic completing-read
9810 ;;
9811 ;; Support also function as collection.
9812 ;; e.g M-x man is supported.
9813 ;; Support hash-table and vectors as collection.
9814 ;; NOTE:
9815 ;; Some crap emacs functions may not be supported
9816 ;; like ffap-alternate-file (bad use of completing-read)
9817 ;; and maybe others.
9818 ;; Provide a mode `anything-completion-mode' which turn on
9819 ;; anything in all `completing-read' and `read-file-name' in Emacs.
9820 ;;
9821 (defvar anything-completion-mode-string " AC")
9822
9823 (defvar anything-completion-mode-quit-message
9824   "Anything completion disabled")
9825
9826 (defvar anything-completion-mode-start-message
9827   "Anything completion enabled")
9828
9829 ;;; Specialized handlers
9830 ;;
9831 ;;
9832 (defun anything-completing-read-symbols
9833     (prompt collection test require-match init
9834      hist default inherit-input-method name buffer)
9835   "Specialized function for fast symbols completion in `ac-mode'."
9836   (or
9837    (anything
9838     :sources `((name . ,name)
9839                (init . (lambda ()
9840                          (with-current-buffer (anything-candidate-buffer 'global)
9841                            (goto-char (point-min))
9842                            (when (and default (stringp default)
9843                                       ;; Some defaults args result as
9844                                       ;; (symbol-name nil) == "nil".
9845                                       ;; e.g debug-on-entry.
9846                                       (not (string= default "nil"))
9847                                       (not (string= default "")))
9848                              (insert (concat default "\n")))
9849                            (loop with all = (all-completions "" collection test)
9850                                  for sym in all
9851                                  unless (and default (eq sym default))
9852                                  do (insert (concat sym "\n"))))))
9853                (persistent-action . anything-lisp-completion-persistent-action)
9854                (persistent-help . "Show brief doc in mode-line")
9855                (candidates-in-buffer)
9856                (action . identity))
9857     :prompt prompt
9858     :buffer buffer
9859     :input init
9860     :history hist
9861     :resume 'noresume
9862     :default (or default ""))
9863    (keyboard-quit)))
9864
9865
9866 ;;; Generic completing read
9867 ;;
9868 ;;
9869 (defun anything-completing-read-default-1
9870     (prompt collection test require-match
9871      init hist default inherit-input-method
9872      name buffer &optional cands-in-buffer exec-when-only-one)
9873   "Call `anything-comp-read' with same args as `completing-read'.
9874 Extra optional arg CANDS-IN-BUFFER mean use `candidates-in-buffer'
9875 method which is faster.
9876 It should be used when candidate list don't need to rebuild dynamically."
9877   (let ((history (or (car-safe hist) hist)))
9878     (anything-comp-read
9879      prompt collection
9880      :test test
9881      :history history
9882      :input-history history
9883      :must-match require-match
9884      :alistp nil ; Be sure `all-completions' is used.
9885      :name name
9886      :requires-pattern (if (and (string= default "")
9887                                 (or (eq require-match 'confirm)
9888                                     (eq require-match
9889                                         'confirm-after-completion)))
9890                            1 0)
9891      :candidates-in-buffer cands-in-buffer
9892      :exec-when-only-one exec-when-only-one
9893      :buffer buffer
9894      ;; If DEF is not provided, fallback to empty string
9895      ;; to avoid `thing-at-point' to be appended on top of list
9896      :default (or default "")
9897      ;; Use `regexp-quote' to fix initial input
9898      ;; with special characters (e.g nnimap+gmail:)
9899      :initial-input (and (stringp init) (regexp-quote init)))))
9900
9901 (defun anything-completing-read-with-cands-in-buffer
9902     (prompt collection test require-match
9903      init hist default inherit-input-method
9904      name buffer)
9905   "Same as `anything-completing-read-default-1' but use candidates-in-buffer."
9906   ;; Some commands like find-tag may use `read-file-name' from inside
9907   ;; the calculation of collection. in this case it clash with
9908   ;; candidates-in-buffer that reuse precedent data (files) which is wrong.
9909   ;; So (re)calculate collection outside of main anything-session.
9910   (let ((cands (all-completions "" collection)))
9911     (anything-completing-read-default-1 prompt cands test require-match
9912                                         init hist default inherit-input-method
9913                                         name buffer t)))
9914
9915 (defun* anything-completing-read-default
9916     (prompt collection &optional
9917             predicate require-match
9918             initial-input hist def
9919             inherit-input-method)
9920   "An anything replacement of `completing-read'.
9921 This function should be used only as a `completing-read-function'.
9922
9923 Don't use it directly, use instead `anything-comp-read' in your programs.
9924
9925 See documentation of `completing-read' and `all-completions' for details."
9926   (declare (special anything-completion-mode))
9927   (let* ((current-command this-command)
9928          (str-command     (symbol-name current-command))
9929          (buf-name        (format "*ac-mode-%s*" str-command))
9930          (entry           (assq current-command
9931                                 anything-completing-read-handlers-alist))
9932          (def-com         (cdr-safe entry))
9933          (str-defcom      (and def-com (symbol-name def-com)))
9934          (def-args        (list prompt collection predicate require-match
9935                                 initial-input hist def inherit-input-method))
9936          ;; Append the two extra args needed to set the buffer and source name
9937          ;; in anything specialized functions.
9938          (any-args        (append def-args (list str-command buf-name)))
9939          anything-completion-mode-start-message ; Be quiet
9940          anything-completion-mode-quit-message
9941          (minibuffer-completion-table collection)
9942          (minibuffer-completion-predicate predicate)
9943          ;; Be sure this pesty *completion* buffer doesn't popup.
9944          (minibuffer-setup-hook (remove 'minibuffer-completion-help
9945                                         minibuffer-setup-hook)))
9946     (when (eq def-com 'ido) (setq def-com 'ido-completing-read))
9947     (unless (or (not entry) def-com)
9948       ;; An entry in *read-handlers-alist exists but have
9949       ;; a nil value, so we exit from here, disable `ac-mode'
9950       ;; and run the command again with it original behavior.
9951       ;; `ac-mode' will be restored on exit.
9952       (return-from anything-completing-read-default
9953         (unwind-protect
9954              (progn
9955                (ac-mode -1)
9956                (apply completing-read-function def-args))
9957           (ac-mode 1))))
9958     ;; If we use now `completing-read' we MUST turn off `ac-mode'
9959     ;; to avoid infinite recursion and CRASH. It will be reenabled on exit.
9960     (when (or (eq def-com 'completing-read)
9961               ;; All specialized functions are prefixed by "anything"
9962               (and (stringp str-defcom)
9963                    (not (string-match "^anything" str-defcom))))
9964       (ac-mode -1))
9965     (unwind-protect
9966          (cond (;; An anything specialized function exists, run it.
9967                 (and def-com anything-completion-mode)
9968                 (apply def-com any-args))
9969                (;; Try to handle `ido-completing-read' everywhere.
9970                 (and def-com (eq def-com 'ido-completing-read))
9971                 (setcar (memq collection def-args)
9972                         (all-completions "" collection predicate))
9973                 (apply def-com def-args))
9974                (;; User set explicitely `completing-read' or something similar
9975                 ;; in *read-handlers-alist, use this with exactly the same
9976                 ;; args as in `completing-read'.
9977                 ;; If we are here `anything-completion-mode' is now disabled.
9978                 def-com
9979                 (apply def-com def-args))
9980                (t ; Fall back to classic `anything-comp-read'.
9981                 (anything-completing-read-default-1
9982                  prompt collection predicate require-match
9983                  initial-input hist def inherit-input-method
9984                  str-command buf-name)))
9985       (ac-mode 1)
9986       ;; When exiting minibuffer, `this-command' is set to
9987       ;; `anything-exit-minibuffer', which is unwanted when starting
9988       ;; on another `completing-read', so restore `this-command' to
9989       ;; initial value when exiting.
9990       (setq this-command current-command))))
9991
9992 (defun* anything-generic-read-file-name
9993     (prompt &optional dir default-filename mustmatch initial predicate)
9994   "An anything replacement of `read-file-name'."
9995   (declare (special anything-completion-mode))
9996   (let* ((default (and default-filename
9997                        (if (listp default-filename)
9998                            (car default-filename)
9999                            default-filename)))
10000          (init (or default initial dir default-directory))
10001          (ini-input (and init (expand-file-name init)))
10002          (current-command this-command)
10003          (str-command (symbol-name current-command))
10004          (anything-file-completion-sources
10005           (cons str-command
10006                 (remove str-command anything-file-completion-sources)))
10007          (buf-name (format "*ac-mode-%s*" str-command))
10008          (entry (assq current-command
10009                       anything-completing-read-handlers-alist))
10010          (def-com  (cdr-safe entry))
10011          (str-defcom (symbol-name def-com))
10012          (def-args (list prompt dir default-filename mustmatch initial predicate))
10013          ;; Append the two extra args needed to set the buffer and source name
10014          ;; in anything specialized functions.
10015          (any-args (append def-args (list str-command buf-name)))
10016          (ido-state ido-mode)
10017          anything-completion-mode-start-message ; Be quiet
10018          anything-completion-mode-quit-message  ; Same here
10019          fname)
10020     ;; Some functions that normally call `completing-read' can switch
10021     ;; brutally to `read-file-name' (e.g find-tag), in this case
10022     ;; the anything specialized function will fail because it is build
10023     ;; for `completing-read', so set it to 'incompatible to be sure
10024     ;; we switch to `anything-c-read-file-name' and don't try to call it
10025     ;; with wrong number of args.
10026     (when (and def-com (> (length (help-function-arglist def-com)) 8))
10027       (setq def-com 'incompatible))
10028     (when (eq def-com 'ido) (setq def-com 'ido-read-file-name))
10029     (unless (or (not entry) def-com)
10030       (return-from anything-generic-read-file-name
10031         (unwind-protect
10032              (progn
10033                (ac-mode -1)
10034                (apply read-file-name-function def-args))
10035           (ac-mode 1))))
10036     ;; If we use now `read-file-name' we MUST turn off `ac-mode'
10037     ;; to avoid infinite recursion and CRASH. It will be reenabled on exit.
10038     (when (or (eq def-com 'read-file-name)
10039               (eq def-com 'ido-read-file-name)
10040               (and (stringp str-defcom)
10041                    (not (string-match "^anything" str-defcom))))
10042       (ac-mode -1))
10043     (unwind-protect
10044          (setq fname
10045                (cond (;; A specialized function exists, run it
10046                       ;; with the two extra args specific to anything..
10047                       (and def-com anything-completion-mode
10048                            (not (eq def-com 'ido-read-file-name))
10049                            (not (eq def-com 'incompatible)))
10050                       (apply def-com any-args))
10051                      (;; Def-com value is `ido-read-file-name'
10052                       ;; run it with default args.
10053                       (and def-com (eq def-com 'ido-read-file-name))
10054                       (ido-mode 1)
10055                       (apply def-com def-args))
10056                      (;; Def-com value is `read-file-name'
10057                       ;; run it with default args.
10058                       (eq def-com 'read-file-name)
10059                       (apply def-com def-args))
10060                      (t ; Fall back to classic `anything-c-read-file-name'.
10061                       (anything-c-read-file-name
10062                        prompt
10063                        :name str-command
10064                        :buffer buf-name
10065                        :initial-input (expand-file-name init dir)
10066                        :alistp nil
10067                        :must-match mustmatch
10068                        :test predicate))))
10069       (ac-mode 1)
10070       (ido-mode (if ido-state 1 -1))
10071       ;; Same comment as in `anything-completing-read-default'.
10072       (setq this-command current-command))
10073     fname))
10074
10075 ;;;###autoload
10076 (define-minor-mode anything-completion-mode
10077     "Toggle generic anything completion.
10078
10079 All functions in Emacs that use `completing-read'
10080 or `read-file-name' and friends will use anything interface
10081 when this mode is turned on.
10082 However you can modify this behavior for functions of your choice
10083 with `anything-completing-read-handlers-alist'.
10084
10085 Called with a positive arg, turn on unconditionally, with a
10086 negative arg turn off.
10087 You can turn it on with `ac-mode'.
10088
10089 Some crap emacs functions may not be supported,
10090 e.g `ffap-alternate-file' and maybe others
10091 You can add such functions to `anything-completing-read-handlers-alist'
10092 with a nil value.
10093
10094 Note: This mode will work only partially on Emacs23."
10095   :group 'anything
10096   :global t
10097   :lighter anything-completion-mode-string
10098   (declare (special completing-read-function))
10099   (if anything-completion-mode
10100       (progn
10101         (setq completing-read-function 'anything-completing-read-default
10102               read-file-name-function  'anything-generic-read-file-name)
10103         (message anything-completion-mode-start-message))
10104       (setq completing-read-function (and (fboundp 'completing-read-default)
10105                                           'completing-read-default)
10106             read-file-name-function  (and (fboundp 'read-file-name-default)
10107                                           'read-file-name-default))
10108       (message anything-completion-mode-quit-message)))
10109
10110 (defalias 'ac-mode 'anything-completion-mode)
10111
10112
10113 \f
10114 ;;; Eshell completion.
10115 ;;
10116 ;; Enable like this in .emacs:
10117 ;;
10118 ;; (add-hook 'eshell-mode-hook
10119 ;;           #'(lambda ()
10120 ;;               (define-key eshell-mode-map [remap pcomplete] 'anything-esh-pcomplete)))
10121 ;;
10122 (defvar anything-c-source-esh
10123   '((name . "Eshell completions")
10124     (init . (lambda ()
10125               (setq pcomplete-current-completions nil
10126                     pcomplete-last-completion-raw nil)
10127               ;; Eshell-command add this hook in all minibuffers
10128               ;; Remove it for the anything one. (Fixed in Emacs24)
10129               (remove-hook 'minibuffer-setup-hook 'eshell-mode)))
10130     (candidates . anything-esh-get-candidates)
10131     (action . anything-ec-insert))
10132   "Anything source for Eshell completion.")
10133
10134 ;; Internal.
10135 (defvar anything-ec-target "")
10136 (defun anything-ec-insert (candidate)
10137   "Replace text at point with CANDIDATE.
10138 The function that call this should set `anything-ec-target' to thing at point.
10139 This is the same as `ac-insert', just inlined here for compatibility."
10140   (let ((pt (point)))
10141     (when (and anything-ec-target
10142                (search-backward anything-ec-target nil t)
10143                (string= (buffer-substring (point) pt) anything-ec-target))
10144       (delete-region (point) pt)))
10145   (insert (anything-quote-whitespace candidate)))
10146
10147 (defun anything-esh-get-candidates ()
10148   "Get candidates for eshell completion using `pcomplete'."
10149   (catch 'pcompleted
10150     (let* ((pcomplete-stub)
10151            pcomplete-seen pcomplete-norm-func
10152            pcomplete-args pcomplete-last pcomplete-index
10153            (pcomplete-autolist pcomplete-autolist)
10154            (pcomplete-suffix-list pcomplete-suffix-list))
10155       (with-anything-current-buffer
10156         (loop with table  = (pcomplete-completions)
10157               with entry  = (condition-case nil
10158                                 ;; On Emacs24 `try-completion' return
10159                                 ;; pattern when more than one result.
10160                                 ;; Otherwise Emacs23 return nil, which
10161                                 ;; is wrong, in this case use pattern
10162                                 ;; to behave like Emacs24.
10163                                 (or (try-completion anything-pattern
10164                                                     (pcomplete-entries))
10165                                     anything-pattern)
10166                               ;; In Emacs23 `pcomplete-entries' may fail
10167                               ;; with error, so try this instead.
10168                               (error
10169                                nil
10170                                (let ((fc (car (last
10171                                                (pcomplete-parse-arguments)))))
10172                                  ;; Check if last arg require fname completion.
10173                                  (and (file-name-directory fc) fc))))
10174               for i in (all-completions pcomplete-stub table)
10175               for file-cand = (and entry
10176                                    (if (file-remote-p i) i
10177                                        (expand-file-name
10178                                         i (file-name-directory entry))))
10179               if (and file-cand (or (file-remote-p file-cand)
10180                                     (file-exists-p file-cand)))
10181               collect file-cand into ls
10182               else collect i into ls
10183               finally return
10184               (if (and entry (not (string= entry "")) (file-exists-p entry))
10185                   (append (list (expand-file-name entry default-directory)) ls)
10186                   ls))))))
10187
10188 ;;; Eshell history.
10189 ;;
10190 ;;
10191 (defvar anything-c-source-eshell-history
10192   `((name . "Eshell history")
10193     (init . (lambda ()
10194               (let (eshell-hist-ignoredups)
10195                 ;; Write the content's of ring to file.
10196                 (eshell-write-history eshell-history-file-name t)
10197                 (with-current-buffer (anything-candidate-buffer 'global)
10198                   (insert-file-contents eshell-history-file-name)))
10199               ;; Same comment as in `anything-c-source-esh'
10200               (remove-hook 'minibuffer-setup-hook 'eshell-mode)))
10201     (candidates-in-buffer)
10202     (keymap . ,anything-eshell-history-map)
10203     (filtered-candidate-transformer . (lambda (candidates sources)
10204                                         (reverse candidates)))
10205     (candidate-number-limit . 9999)
10206     (action . (lambda (candidate)
10207                 (eshell-kill-input)
10208                 (insert candidate))))
10209   "Anything source for Eshell history.")
10210
10211 \f
10212 ;;; Show completion - an alternative of anything-show-completion.el.
10213 ;;
10214 ;; Provide show completion with macro `with-anything-show-completion'.
10215
10216
10217 ;; Called each time cursor move in anything-buffer.
10218 (defun anything-c-show-completion ()
10219   (with-anything-current-buffer
10220     (overlay-put anything-c-show-completion-overlay
10221                  'display (anything-get-selection))))
10222
10223 (defun anything-c-show-completion-init-overlay (beg end)
10224   (and anything-c-turn-on-show-completion
10225        (setq anything-c-show-completion-overlay (make-overlay beg end))
10226        (overlay-put anything-c-show-completion-overlay
10227                     'face 'anything-lisp-show-completion)))
10228
10229 (defun anything-c-show-completion-display-function (buffer)
10230   "A special resized anything window is used depending on position in BUFFER."
10231   (with-selected-window (selected-window)
10232     (let* ((screen-size  (+ (count-screen-lines (window-start) (point) t)
10233                             1                             ; mode-line
10234                             (if header-line-format 1 0))) ; header-line
10235            (def-size     (- (window-height)
10236                             anything-c-show-completion-min-window-height))
10237            (upper-height (max window-min-height (min screen-size def-size)))
10238            split-window-keep-point)
10239       (recenter -1)
10240       (set-window-buffer (if (active-minibuffer-window)
10241                              (minibuffer-selected-window)
10242                              (split-window nil upper-height))
10243                          buffer))))
10244
10245 (defmacro with-anything-show-completion (beg end &rest body)
10246   "Show anything candidate in an overlay at point.
10247 BEG and END are the beginning and end position of the current completion
10248 in `anything-current-buffer'.
10249 BODY is an anything call where we want to enable show completion.
10250 If `anything-c-turn-on-show-completion' is nil just do nothing."
10251   (declare (indent 2) (debug t))
10252   `(let ((anything-move-selection-after-hook
10253           (and anything-c-turn-on-show-completion
10254                (append (list 'anything-c-show-completion)
10255                        anything-move-selection-after-hook))))
10256      (unwind-protect
10257           (progn
10258             (anything-c-show-completion-init-overlay ,beg ,end)
10259             (let ((anything-display-function
10260                    (if anything-c-show-completion-use-special-display
10261                        'anything-c-show-completion-display-function
10262                        'anything-default-display-buffer)))
10263               ,@body))
10264        (and anything-c-turn-on-show-completion
10265             (delete-overlay anything-c-show-completion-overlay)))))
10266
10267 \f
10268 ;;; Lisp symbol completion.
10269 ;;
10270 ;;
10271 ;;;###autoload
10272 (defun anything-lisp-completion-at-point ()
10273   "Anything lisp symbol completion at point."
10274   (interactive)
10275   (let* ((data       (lisp-completion-at-point))
10276          (beg        (car data))
10277          (end        (point)) ; 'cadr data' is wrong when no space after point.
10278          (plist      (nthcdr 3 data))
10279          (pred       (plist-get plist :predicate))
10280          (lgst-len   0)
10281          (target     (and beg end (buffer-substring-no-properties beg end)))
10282          (candidates (all-completions target (nth 2 data) pred))
10283          (anything-quit-if-no-candidate t)
10284
10285          (anything-execute-action-at-once-if-one t)
10286          (anything-match-plugin-enabled
10287           (member 'anything-compile-source--match-plugin
10288                   anything-compile-source-functions)))
10289     (if candidates
10290         (with-anything-show-completion beg end
10291           ;; Overlay is initialized now in anything-current-buffer.
10292           (anything
10293            :sources
10294            '((name . "Lisp completion")
10295              (init . (lambda ()
10296                        (with-current-buffer (anything-candidate-buffer 'global)
10297                          (loop for sym in candidates
10298                                for len = (length sym)
10299                                when (> len lgst-len) do (setq lgst-len len)
10300                                do (insert (concat sym "\n"))))))
10301              (candidates-in-buffer)
10302              (persistent-action . anything-lisp-completion-persistent-action)
10303              (persistent-help . "Show brief doc in mode-line")
10304              (filtered-candidate-transformer anything-lisp-completion-transformer)
10305              (action . (lambda (candidate)
10306                          (delete-region beg end)
10307                          (insert candidate))))
10308            :input (if anything-match-plugin-enabled (concat target " ") target)))
10309         (message "[No Match]"))))
10310
10311 (defun anything-lisp-completion-persistent-action (candidate)
10312   (let ((cursor-in-echo-area t)
10313         mode-line-in-non-selected-windows)
10314     (anything-c-show-info-in-mode-line
10315      (propertize
10316       (anything-c-get-first-line-documentation
10317        (intern candidate))
10318       'face 'anything-lisp-completion-info))))
10319
10320 (defun anything-lisp-completion-transformer (candidates source)
10321   "Anything candidates transformer for lisp completion."
10322   (declare (special lgst-len))
10323   (loop for c in candidates
10324         for sym = (intern c)
10325         for annot = (cond ((commandp sym) " (Com)")
10326                           ((fboundp sym)  " (Fun)")
10327                           ((boundp sym)   " (Var)")
10328                           ((facep sym)    " (Face)"))
10329         for spaces = (make-string (- lgst-len (length c)) ? )
10330         collect (cons (concat c spaces annot) c)))
10331
10332 (defun anything-c-get-first-line-documentation (sym)
10333   "Return first line documentation of symbol SYM.
10334 If SYM is not documented, return \"Not documented\"."
10335   (let ((doc (cond ((fboundp sym)
10336                     (documentation sym t))
10337                    ((boundp sym)
10338                     (documentation-property sym 'variable-documentation t))
10339                    ((facep sym)
10340                     (face-documentation sym))
10341                    (t nil))))
10342     (if (and doc (not (string= doc ""))
10343              ;; `documentation' return "\n\n(args...)"
10344              ;; for CL-style functions.
10345              (not (string-match-p "^\n\n" doc)))
10346         (car (split-string doc "\n"))
10347         "Not documented")))
10348
10349 ;;; File completion.
10350 ;;
10351 ;; Complete file name at point.
10352 (defun anything-c-thing-before-point ()
10353   "Get symbol name before point.
10354 Borrowed from anything-complete.el, inlined here for compatibility."
10355   (save-excursion
10356     (let ((beg (point)))
10357       ;; older regexp "\(\\|\\s-\\|^\\|\\_<\\|\r\\|'\\|#'"
10358       (when (re-search-backward
10359              "\\_<" (field-beginning nil nil (point-at-bol)) t)
10360         (buffer-substring-no-properties beg (match-end 0))))))
10361
10362 ;;;###autoload
10363 (defun anything-c-complete-file-name-at-point ()
10364   "Complete file name at point."
10365   (interactive)
10366   (let* ((init (substring-no-properties (thing-at-point 'filename)))
10367          (end  (point))
10368          (beg  (- (point) (length init)))
10369          (anything-quit-if-no-candidate t)
10370          (anything-execute-action-at-once-if-one t)
10371          completion)
10372     (with-anything-show-completion beg end
10373       (setq completion (anything-c-read-file-name "FileName: "
10374                                                   :initial-input init)))
10375     (anything-c-insert-file-name-completion-at-point completion)))
10376
10377 ;; Internal
10378 (defvar anything-lisp-completion-counter 0)
10379 ;;;###autoload
10380 (defun anything-lisp-completion-at-point-or-indent (arg)
10381   "First call indent and second call complete lisp symbol.
10382 The second call should happen before `anything-lisp-completion-or-indent-delay',
10383 after this delay, next call will indent again.
10384 After completion, next call is always indent.
10385 See that like click and double mouse click.
10386 One hit indent, two quick hits maybe indent and complete."
10387   (interactive "P")
10388   ;; Be sure `indent-for-tab-command' will not try
10389   ;; to use `completion-at-point'.
10390   (let ((tab-always-indent (if (eq tab-always-indent 'complete)
10391                                t tab-always-indent)))
10392     (incf anything-lisp-completion-counter)
10393     (unwind-protect
10394          (if (> anything-lisp-completion-counter 1)
10395              (anything-lisp-completion-or-file-name-at-point)
10396              (indent-for-tab-command arg))
10397       ;; After `anything-lisp-completion-or-indent-delay' seconds
10398       ;; reset to 0.
10399       (run-with-timer anything-lisp-completion-or-indent-delay nil
10400                       #'(lambda ()
10401                           (setq anything-lisp-completion-counter 0)))
10402       ;; Always reset to 0 at second hit.
10403       (when (eq anything-lisp-completion-counter 2)
10404         (setq anything-lisp-completion-counter 0)))))
10405
10406 ;;;###autoload
10407 (defun anything-lisp-completion-or-file-name-at-point ()
10408   "Complete lisp symbol or filename at point.
10409 Filename completion happen if filename is started in
10410 or between double quotes."
10411   (interactive)
10412   (let ((tap (substring-no-properties (thing-at-point 'filename))))
10413     (if (and tap (string-match "^\\(~/\\|/\\|[a-zA-Z]\:/\\).*" tap)
10414              (save-excursion (search-backward "\"" (point-at-bol) t)))
10415         (anything-c-complete-file-name-at-point)
10416         (anything-lisp-completion-at-point))))
10417
10418 (defun anything-c-apropos-init (test default)
10419   "Init candidates buffer for `anything-c-apropos' sources."
10420   (with-current-buffer (anything-candidate-buffer 'global)
10421     (goto-char (point-min))
10422     (when (and default (stringp default)
10423                ;; Some defaults args result as
10424                ;; (symbol-name nil) == "nil".
10425                ;; e.g debug-on-entry.
10426                (not (string= default "nil"))
10427                (funcall test (intern default)))
10428       (insert (concat default "\n")))
10429     (loop with all = (all-completions "" obarray test)
10430           for sym in all
10431           unless (and default (eq sym default))
10432           do (insert (concat sym "\n")))))
10433
10434 \f
10435 ;;; Run Externals commands within Emacs with anything completion
10436 ;;
10437 ;;
10438 (defvar anything-external-command-history nil)
10439
10440 (defun anything-c-external-commands-list-1 (&optional sort)
10441   "Returns a list of all external commands the user can execute.
10442 If `anything-c-external-commands-list' is non-nil it will
10443 return its contents.  Else it calculates all external commands
10444 and sets `anything-c-external-commands-list'."
10445   (if anything-c-external-commands-list
10446       anything-c-external-commands-list
10447       (setq anything-c-external-commands-list
10448             (loop
10449                   with paths = (split-string (getenv "PATH") path-separator)
10450                   with completions = ()
10451                   for dir in paths
10452                   when (and (file-exists-p dir) (file-accessible-directory-p dir))
10453                   for lsdir = (loop for i in (directory-files dir t)
10454                                     for bn = (file-name-nondirectory i)
10455                                     when (and (not (member bn completions))
10456                                               (not (file-directory-p i))
10457                                               (file-executable-p i))
10458                                     collect bn)
10459                   append lsdir into completions
10460                   finally return (if sort (sort completions 'string-lessp) completions)))))
10461
10462 (defun anything-run-or-raise (exe &optional file)
10463   "Generic command that run asynchronously EXE.
10464 If EXE is already running just jump to his window if `anything-raise-command'
10465 is non--nil.
10466 When FILE argument is provided run EXE with FILE.
10467 In this case EXE must be provided as \"EXE %s\"."
10468   (lexical-let* ((real-com (car (split-string (replace-regexp-in-string
10469                                                "%s" "" exe))))
10470                  (proc     (if file (concat real-com " " file) real-com)))
10471     (if (get-process proc)
10472         (if anything-raise-command
10473             (shell-command  (format anything-raise-command real-com))
10474             (error "Error: %s is already running" real-com))
10475         (when (loop for i in anything-c-external-commands-list thereis real-com)
10476           (message "Starting %s..." real-com)
10477           (if file
10478               (start-process-shell-command
10479                proc nil (format exe (shell-quote-argument
10480                                      (if (eq system-type 'windows-nt)
10481                                          (anything-w32-prepare-filename file)
10482                                          file))))
10483               (start-process-shell-command proc nil real-com))
10484           (set-process-sentinel
10485            (get-process proc)
10486            #'(lambda (process event)
10487                (when (and (string= event "finished\n")
10488                           anything-raise-command
10489                           (not (anything-c-get-pid-from-process-name real-com)))
10490                  (shell-command  (format anything-raise-command "emacs")))
10491                (message "%s process...Finished." process))))
10492         (setq anything-c-external-commands-list
10493               (cons real-com
10494                     (delete real-com anything-c-external-commands-list))))))
10495
10496
10497 \f
10498 ;;; Generic action functions
10499 ;;
10500 ;;
10501 (defun anything-c-file-buffers (filename)
10502   "Returns a list of buffer names corresponding to FILENAME."
10503   (let ((name     (expand-file-name filename))
10504         (buf-list ()))
10505     (dolist (buf (buffer-list) buf-list)
10506       (let ((bfn (buffer-file-name buf)))
10507         (when (and bfn (string= name bfn))
10508           (push (buffer-name buf) buf-list))))))
10509
10510 (defun anything-revert-buffer (candidate)
10511   (with-current-buffer candidate
10512     (when (or (buffer-modified-p)
10513               (not (verify-visited-file-modtime
10514                     (get-buffer candidate))))
10515       (revert-buffer t t))))
10516
10517 (defun anything-revert-marked-buffers (ignore)
10518   (mapc 'anything-revert-buffer (anything-marked-candidates)))
10519
10520 (defun anything-kill-marked-buffers (ignore)
10521   (mapc 'kill-buffer (anything-marked-candidates)))
10522
10523 (defun anything-c-delete-file (file &optional error-if-dot-file-p)
10524   "Delete the given file after querying the user.
10525 Ask to kill buffers associated with that file, too."
10526   (when (and error-if-dot-file-p
10527              (anything-ff-dot-file-p file))
10528     (error "Error: Cannot operate on `.' or `..'"))
10529   (let ((buffers (anything-c-file-buffers file)))
10530     (if (< emacs-major-version 24)
10531         ;; `dired-delete-file' in Emacs versions < 24
10532         ;; doesn't support delete-by-moving-to-trash
10533         ;; so use `delete-directory' and `delete-file'
10534         ;; that handle it.
10535         (cond ((and (not (file-symlink-p file))
10536                     (file-directory-p file)
10537                     (directory-files file t dired-re-no-dot))
10538                (when (y-or-n-p (format "Recursive delete of `%s'? " file))
10539                  (delete-directory file 'recursive)))
10540               ((and (not (file-symlink-p file))
10541                     (file-directory-p file))
10542                (delete-directory file))
10543               (t (delete-file file)))
10544         (dired-delete-file
10545          file 'dired-recursive-deletes delete-by-moving-to-trash))
10546     (when buffers
10547       (dolist (buf buffers)
10548         (when (y-or-n-p (format "Kill buffer %s, too? " buf))
10549           (kill-buffer buf))))))
10550
10551 (defun anything-get-mailcap-for-file (filename)
10552   "Get the command to use for FILENAME from mailcap files.
10553 The command is like <command %s> and is meant to use with `format'."
10554   (mailcap-parse-mailcaps)
10555   (let* ((ext  (file-name-extension filename))
10556          (mime (when ext (mailcap-extension-to-mime ext)))
10557          (result (when mime (mailcap-mime-info mime))))
10558     ;; If elisp file have no associations in .mailcap
10559     ;; `mailcap-maybe-eval' is returned, in this case just return nil.
10560     (when (stringp result) result)))
10561
10562 (defun anything-get-default-program-for-file (filename)
10563   "Try to find a default program to open FILENAME.
10564 Try first in `anything-c-external-programs-associations' and then in mailcap file
10565 if nothing found return nil."
10566   (let* ((ext      (file-name-extension filename))
10567          (def-prog (assoc-default ext anything-c-external-programs-associations)))
10568     (cond ((and def-prog (not (string= def-prog "")))
10569            (concat def-prog " %s"))
10570           ((and anything-c-default-external-file-browser
10571                 (file-directory-p filename))
10572            (concat anything-c-default-external-file-browser " %s"))
10573           (t (anything-get-mailcap-for-file filename)))))
10574
10575 (defun anything-c-open-file-externally (file)
10576   "Open FILE with an external program.
10577 Try to guess which program to use with `anything-get-default-program-for-file'.
10578 If not found or a prefix arg is given query the user which tool to use."
10579   (let* ((fname          (expand-file-name file))
10580          (collection     (anything-c-external-commands-list-1 'sort))
10581          (def-prog       (anything-get-default-program-for-file fname))
10582          (real-prog-name (if (or anything-current-prefix-arg (not def-prog))
10583                              ;; Prefix arg or no default program.
10584                              (prog1
10585                                  (anything-comp-read
10586                                   "Program: " collection
10587                                   :must-match t
10588                                   :name "Open file Externally"
10589                                   :history anything-external-command-history)
10590                                ;; Always prompt to set this program as default.
10591                                (setq def-prog nil))
10592                              ;; No prefix arg or default program exists.
10593                              (replace-regexp-in-string " %s\\| '%s'" "" def-prog)))
10594          (program        (concat real-prog-name " %s")))
10595     (unless (or def-prog ; Association exists, no need to record it.
10596                 ;; Don't try to record non--filenames associations (e.g urls).
10597                 (not (file-exists-p fname)))
10598       (when
10599           (y-or-n-p
10600            (format
10601             "Do you want to make `%s' the default program for this kind of files? "
10602             real-prog-name))
10603         (anything-aif (assoc (file-name-extension fname)
10604                              anything-c-external-programs-associations)
10605             (setq anything-c-external-programs-associations
10606                   (delete it anything-c-external-programs-associations)))
10607         (push (cons (file-name-extension fname)
10608                     (read-string
10609                      "Program (Add args maybe and confirm): " real-prog-name))
10610               anything-c-external-programs-associations)
10611         (customize-save-variable 'anything-c-external-programs-associations
10612                                  anything-c-external-programs-associations)))
10613     (anything-run-or-raise program file)
10614     (setq anything-external-command-history
10615           (cons real-prog-name
10616                 (delete real-prog-name
10617                         (loop for i in anything-external-command-history
10618                               when (executable-find i) collect i))))))
10619
10620 (defun anything-c-find-file-or-marked (candidate)
10621   "Open file CANDIDATE or open anything marked files in background."
10622   (let ((marked (anything-marked-candidates))
10623         (ffap-newfile-prompt anything-ff-newfile-prompt-p)
10624         (find-file-wildcards nil))
10625     (if (> (length marked) 1)
10626         ;; Open all marked files in background and display
10627         ;; the first one.
10628         (progn (mapc 'find-file-noselect (cdr marked))
10629                (find-file (car marked)))
10630         (if (and (not (file-exists-p candidate))
10631                  (and ffap-url-regexp
10632                       (not (string-match ffap-url-regexp candidate)))
10633                  (string-match "/$" candidate))
10634             ;; A a non--existing filename ending with /
10635             ;; Create a directory and jump to it.
10636             (when (y-or-n-p (format "Create directory `%s'? " candidate))
10637               (let ((dirfname (directory-file-name candidate)))
10638                 (if (file-exists-p dirfname)
10639                     (error "Mkdir: Unable to create directory `%s': file exists."
10640                            (anything-c-basename dirfname))
10641                     (make-directory candidate 'parent)))
10642               (anything-find-files-1 candidate))
10643             ;; A non--existing filename NOT ending with / or
10644             ;; an existing filename, create or jump to it.
10645             (find-file-at-point (car marked))))))
10646
10647 (defun anything-delete-marked-files (ignore)
10648   (let* ((files (anything-marked-candidates))
10649          (len (length files)))
10650     (if (not (y-or-n-p
10651               (format "Delete *%s File(s):\n%s"
10652                       len
10653                       (mapconcat (lambda (f) (format "- %s\n" f)) files ""))))
10654         (message "(No deletions performed)")
10655         (dolist (i files)
10656           (set-text-properties 0 (length i) nil i)
10657           (anything-c-delete-file i anything-ff-signal-error-on-dot-files))
10658         (message "%s File(s) deleted" len))))
10659
10660 (defun anything-ediff-marked-buffers (candidate &optional merge)
10661   "Ediff 2 marked buffers or CANDIDATE and `anything-current-buffer'.
10662 With optional arg MERGE call `ediff-merge-buffers'."
10663   (let ((lg-lst (length (anything-marked-candidates)))
10664         buf1 buf2)
10665     (case lg-lst
10666       (0
10667        (error "Error:You have to mark at least 1 buffer"))
10668       (1
10669        (setq buf1 anything-current-buffer
10670              buf2 (first (anything-marked-candidates))))
10671       (2
10672        (setq buf1 (first (anything-marked-candidates))
10673              buf2 (second (anything-marked-candidates))))
10674       (t
10675        (error "Error:To much buffers marked!")))
10676     (if merge
10677         (ediff-merge-buffers buf1 buf2)
10678         (ediff-buffers buf1 buf2))))
10679
10680 (defun anything-ediff-marked-buffers-merge (candidate)
10681   "Ediff merge `anything-current-buffer' with CANDIDATE.
10682 See `anything-ediff-marked-buffers'."
10683   (anything-ediff-marked-buffers candidate t))
10684
10685 (defun anything-bookmark-get-bookmark-from-name (bmk)
10686   "Return bookmark name even if it is a bookmark with annotation.
10687 e.g prepended with *.
10688 Return nil if bmk is not a valid bookmark."
10689   (let ((bookmark (replace-regexp-in-string "\*" "" bmk)))
10690     (if (assoc bookmark bookmark-alist)
10691         bookmark
10692         (when (assoc bmk bookmark-alist)
10693           bmk))))
10694
10695 (defun anything-delete-marked-bookmarks (ignore)
10696   "Delete this bookmark or all marked bookmarks."
10697   (dolist (i (anything-marked-candidates))
10698     (bookmark-delete (anything-bookmark-get-bookmark-from-name i)
10699                      'batch)))
10700
10701 (defun anything-require-or-error (feature function)
10702   (or (require feature nil t)
10703       (error "Need %s to use `%s'." feature function)))
10704
10705 (defun anything-find-buffer-on-elscreen (candidate)
10706   "Open buffer in new screen, if marked buffers open all in elscreens."
10707   (anything-require-or-error 'elscreen 'anything-find-buffer-on-elscreen)
10708   (anything-aif (anything-marked-candidates)
10709       (dolist (i it)
10710         (let ((target-screen (elscreen-find-screen-by-buffer
10711                               (get-buffer i) 'create)))
10712           (elscreen-goto target-screen)))
10713     (let ((target-screen (elscreen-find-screen-by-buffer
10714                           (get-buffer candidate) 'create)))
10715       (elscreen-goto target-screen))))
10716
10717 (defun anything-elscreen-find-file (file)
10718   (anything-require-or-error 'elscreen 'anything-elscreen-find-file)
10719   (elscreen-find-file file))
10720
10721 (defun anything-w32-prepare-filename (file)
10722   "Convert filename FILE to something usable by external w32 executables."
10723   (replace-regexp-in-string ; For UNC paths
10724    "/" "\\"
10725    (replace-regexp-in-string ; Strip cygdrive paths
10726     "/cygdrive/\\(.\\)" "\\1:"
10727     file nil nil) nil t))
10728
10729 ;;;###autoload
10730 (defun anything-w32-shell-execute-open-file (file)
10731   (interactive "fOpen file:")
10732   (with-no-warnings
10733     (w32-shell-execute "open" (anything-w32-prepare-filename file))))
10734
10735 (defun anything-c-open-file-with-default-tool (file)
10736   "Open FILE with the default tool on this platform."
10737   (if (eq system-type 'windows-nt)
10738       (anything-w32-shell-execute-open-file file)
10739       (start-process "anything-c-open-file-with-default-tool"
10740                      nil
10741                      (cond ((eq system-type 'gnu/linux)
10742                             "xdg-open")
10743                            ((or (eq system-type 'darwin) ;; Mac OS X
10744                                 (eq system-type 'macos)) ;; Mac OS 9
10745                             "open"))
10746                      file)))
10747
10748 (defun anything-c-open-dired (file)
10749   "Opens a dired buffer in FILE's directory.  If FILE is a
10750 directory, open this directory."
10751   (if (file-directory-p file)
10752       (dired file)
10753       (dired (file-name-directory file))
10754       (dired-goto-file file)))
10755
10756 (defun anything-c-display-to-real-line (candidate)
10757   (if (string-match "^ *\\([0-9]+\\):\\(.*\\)$" candidate)
10758       (list (string-to-number (match-string 1 candidate)) (match-string 2 candidate))
10759       (error "Line number not found")))
10760
10761 (defun anything-c-action-line-goto (lineno-and-content)
10762   (apply #'anything-goto-file-line (anything-interpret-value (anything-attr 'target-file))
10763          (append lineno-and-content
10764                  (list (if (and (anything-attr-defined 'target-file)
10765                                 (not anything-in-persistent-action))
10766                            'find-file-other-window
10767                            'find-file)))))
10768
10769 (defun* anything-c-action-file-line-goto (file-line-content &optional (find-file-function #'find-file))
10770   (apply #'anything-goto-file-line
10771          (if (stringp file-line-content)
10772              ;; Case: filtered-candidate-transformer is skipped
10773              (cdr (anything-c-filtered-candidate-transformer-file-line-1 file-line-content))
10774              file-line-content)))
10775
10776 (require 'compile)
10777 (defun anything-c-filtered-candidate-transformer-file-line (candidates source)
10778   (delq nil (mapcar 'anything-c-filtered-candidate-transformer-file-line-1 candidates)))
10779
10780 (defun anything-c-filtered-candidate-transformer-file-line-1 (candidate)
10781   (when (string-match "^\\(.+?\\):\\([0-9]+\\):\\(.*\\)$" candidate)
10782     (let ((filename (match-string 1 candidate))
10783           (lineno (match-string 2 candidate))
10784           (content (match-string 3 candidate)))
10785       (cons (format "%s:%s\n %s"
10786                     (propertize filename 'face compilation-info-face)
10787                     (propertize lineno 'face compilation-line-face)
10788                     content)
10789             (list (expand-file-name
10790                    filename
10791                    (or (anything-interpret-value (anything-attr 'default-directory))
10792                        (and (anything-candidate-buffer)
10793                             (buffer-local-value
10794                              'default-directory (anything-candidate-buffer)))))
10795                   (string-to-number lineno) content)))))
10796
10797 (defun* anything-goto-file-line (file lineno content &optional (find-file-function #'find-file))
10798   (anything-aif (anything-attr 'before-jump-hook)
10799       (funcall it))
10800   (when file (funcall find-file-function file))
10801   (if (anything-attr-defined 'adjust)
10802       (anything-c-goto-line-with-adjustment
10803        lineno content (not (anything-attr-defined 'recenter)))
10804     (anything-goto-line lineno nil (not (anything-attr-defined 'recenter))))
10805   (anything-aif (anything-attr 'after-jump-hook)
10806       (funcall it))
10807   (when anything-in-persistent-action
10808     (anything-match-line-color-current-line)))
10809
10810 (defun anything-find-file-as-root (candidate)
10811   (find-file (concat "/" anything-su-or-sudo "::" (expand-file-name candidate))))
10812
10813 (defun anything-find-many-files (ignore)
10814   (mapc 'find-file (anything-marked-candidates)))
10815
10816 ;; borrowed from etags.el
10817 ;; (anything-c-goto-line-with-adjustment (line-number-at-pos) ";; borrowed from etags.el")
10818 (defun anything-c-goto-line-with-adjustment (line line-content &optional show-top)
10819   (let ((startpos)
10820         offset found pat)
10821     ;; This constant is 1/2 the initial search window.
10822     ;; There is no sense in making it too small,
10823     ;; since just going around the loop once probably
10824     ;; costs about as much as searching 2000 chars.
10825     (setq offset 1000
10826           found nil
10827           pat (concat (if (eq selective-display t)
10828                           "\\(^\\|\^m\\) *" "^ *") ;allow indent
10829                       (regexp-quote line-content)))
10830     ;; If no char pos was given, try the given line number.
10831     (setq startpos (progn (anything-goto-line line nil show-top) (point)))
10832     (or startpos (setq startpos (point-min)))
10833     ;; First see if the tag is right at the specified location.
10834     (goto-char startpos)
10835     (setq found (looking-at pat))
10836     (while (and (not found)
10837                 (progn
10838                   (goto-char (- startpos offset))
10839                   (not (bobp))))
10840       (setq found
10841             (re-search-forward pat (+ startpos offset) t)
10842             offset (* 3 offset)))       ; expand search window
10843     (or found
10844         (re-search-forward pat nil t)
10845         (error "not found")))
10846   ;; Position point at the right place
10847   ;; if the search string matched an extra Ctrl-m at the beginning.
10848   (and (eq selective-display t)
10849        (looking-at "\^m")
10850        (forward-char 1))
10851   (beginning-of-line))
10852
10853 (anything-document-attribute 'default-directory "type . file-line"
10854                              "`default-directory' to interpret file.")
10855 (anything-document-attribute 'before-jump-hook "type . file-line / line"
10856                              "Function to call before jumping to the target location.")
10857 (anything-document-attribute 'after-jump-hook "type . file-line / line"
10858                              "Function to call after jumping to the target location.")
10859 (anything-document-attribute 'adjust "type . file-line"
10860                              "Search around line matching line contents.")
10861 (anything-document-attribute 'recenter "type . file-line / line"
10862                              "`recenter' after jumping.")
10863 (anything-document-attribute 'target-file "type . line"
10864                              "Goto line of target-file.")
10865
10866 ;;;###autoload
10867 (defun anything-c-call-interactively (cmd-or-name)
10868   "Execute CMD-OR-NAME as Emacs command.
10869 It is added to `extended-command-history'.
10870 `anything-current-prefix-arg' is used as the command's prefix argument."
10871   (setq extended-command-history
10872         (cons (anything-c-stringify cmd-or-name)
10873               (delete (anything-c-stringify cmd-or-name) extended-command-history)))
10874   (let ((current-prefix-arg anything-current-prefix-arg)
10875         (cmd (anything-c-symbolify cmd-or-name)))
10876     (if (stringp (symbol-function cmd))
10877         (execute-kbd-macro (symbol-function cmd))
10878         (setq this-command cmd)
10879         (call-interactively cmd))))
10880
10881 ;;;###autoload
10882 (defun anything-c-set-variable (var)
10883   "Set value to VAR interactively."
10884   (interactive)
10885   (let ((sym (anything-c-symbolify var)))
10886     (set sym (eval-minibuffer (format "Set %s: " var)
10887                               (prin1-to-string (symbol-value sym))))))
10888 ;; (setq hh 12)
10889 ;; (anything-c-set-variable 'hh)
10890
10891
10892 \f
10893 ;;; Persistent Action Helpers
10894 ;;
10895 ;;
10896 (defvar anything-match-line-overlay-face nil)
10897 (defvar anything-match-line-overlay nil)
10898
10899 (defun anything-match-line-color-current-line (&optional start end buf face rec)
10900   "Highlight and underline current position"
10901   (let ((args (list (or start (line-beginning-position))
10902                     (or end (1+ (line-end-position)))
10903                     buf)))
10904     (if (not anything-match-line-overlay)
10905         (setq anything-match-line-overlay (apply 'make-overlay args))
10906         (apply 'move-overlay anything-match-line-overlay args)))
10907   (overlay-put anything-match-line-overlay
10908                'face (or face anything-match-line-overlay-face))
10909   (when rec
10910     (goto-char start)
10911     (recenter)))
10912
10913 (defalias 'anything-persistent-highlight-point 'anything-match-line-color-current-line)
10914
10915
10916 (setq anything-match-line-overlay-face 'anything-overlay-line-face)
10917
10918 (defun anything-match-line-cleanup ()
10919   (when anything-match-line-overlay
10920     (delete-overlay anything-match-line-overlay)
10921     (setq anything-match-line-overlay nil)))
10922
10923 (defun anything-match-line-update ()
10924   (when anything-match-line-overlay
10925     (delete-overlay anything-match-line-overlay)
10926     (anything-match-line-color-current-line)))
10927
10928 (add-hook 'anything-cleanup-hook 'anything-match-line-cleanup)
10929 (add-hook 'anything-after-persistent-action-hook 'anything-match-line-update)
10930
10931 \f
10932 ;;; Actions Transformers
10933 ;;
10934 ;;
10935 ;;; Files
10936 (defun anything-c-transform-file-load-el (actions candidate)
10937   "Add action to load the file CANDIDATE if it is an emacs lisp
10938 file.  Else return ACTIONS unmodified."
10939   (if (member (file-name-extension candidate) '("el" "elc"))
10940       (append actions '(("Load Emacs Lisp File" . load-file)))
10941       actions))
10942
10943 (defun anything-c-transform-file-browse-url (actions candidate)
10944   "Add an action to browse the file CANDIDATE if it in a html
10945 file or URL.  Else return ACTIONS unmodified."
10946   (let ((browse-action '("Browse with Browser" . browse-url)))
10947     (cond ((string-match "^http\\|^ftp" candidate)
10948            (cons browse-action actions))
10949           ((string-match "\\.html?$" candidate)
10950            (append actions (list browse-action)))
10951           (t actions))))
10952
10953 ;;; Function
10954 (defun anything-c-transform-function-call-interactively (actions candidate)
10955   "Add an action to call the function CANDIDATE interactively if
10956 it is a command.  Else return ACTIONS unmodified."
10957   (if (commandp (intern-soft candidate))
10958       (append actions '(("Call Interactively"
10959                          .
10960                          anything-c-call-interactively)))
10961       actions))
10962
10963 ;;;; S-Expressions
10964 (defun anything-c-transform-sexp-eval-command-sexp (actions candidate)
10965   "If CANDIDATE's `car' is a command, then add an action to
10966 evaluate it and put it onto the `command-history'."
10967   (if (commandp (car (read candidate)))
10968       ;; Make it first entry
10969       (cons '("Eval and put onto command-history" .
10970               (lambda (sexp)
10971                 (let ((sym (read sexp)))
10972                   (eval sym)
10973                   (setq command-history
10974                         (cons sym command-history)))))
10975             actions)
10976       actions))
10977
10978 \f
10979 ;;; Candidate Transformers
10980 ;;
10981 ;;
10982 ;;; Buffers
10983 (defun anything-c-skip-boring-buffers (buffers)
10984   (anything-c-skip-entries buffers anything-c-boring-buffer-regexp))
10985
10986 (defun anything-c-skip-current-buffer (buffers)
10987   "[DEPRECATED] Skip current buffer in buffer lists.
10988 This transformer should not be used as this is now handled directly
10989 in `anything-c-buffer-list' and `anything-c-highlight-buffers'."
10990   (if anything-allow-skipping-current-buffer
10991       (remove (buffer-name anything-current-buffer) buffers)
10992       buffers))
10993
10994 (defun anything-c-shadow-boring-buffers (buffers)
10995   "Buffers matching `anything-c-boring-buffer-regexp' will be
10996 displayed with the `file-name-shadow' face if available."
10997   (anything-c-shadow-entries buffers anything-c-boring-buffer-regexp))
10998
10999 (defvar anything-c-buffer-display-string-functions
11000   '(anything-c-buffer-display-string--compilation
11001     anything-c-buffer-display-string--shell
11002     anything-c-buffer-display-string--eshell)
11003   "Functions to setup display string for buffer.
11004
11005 Function has one argument, buffer name.
11006 If it returns string, use it.
11007 If it returns nil, display buffer name.
11008 See `anything-c-buffer-display-string--compilation' for example.")
11009
11010 (defun anything-c-transform-buffer-display-string (buffers)
11011   "Setup display string for buffer candidates
11012 using `anything-c-buffer-display-string-functions'."
11013   (loop for buf in buffers
11014         if (consp buf)
11015         collect buf
11016         else
11017         for disp = (progn (set-buffer buf)
11018                           (run-hook-with-args-until-success
11019                            'anything-c-buffer-display-string-functions buf))
11020         collect (if disp (cons disp buf) buf)))
11021
11022 (defun anything-c-buffer-display-string--compilation (buf)
11023   (anything-aif (car compilation-arguments)
11024       (format "%s: %s [%s]" buf it default-directory)))
11025
11026 (defun anything-c-buffer-display-string--eshell (buf)
11027   (declare (special eshell-history-ring))
11028   (when (eq major-mode 'eshell-mode)
11029     (format "%s: %s [%s]" buf
11030             (ignore-errors (ring-ref eshell-history-ring 0))
11031             default-directory)))
11032
11033 (defun anything-c-buffer-display-string--shell (buf)
11034   (when (eq major-mode 'shell-mode)
11035     (format "%s: %s [%s]" buf
11036             (ignore-errors (ring-ref comint-input-ring 0))
11037             default-directory)))
11038
11039 ;;; Files
11040 (defun anything-c-shadow-boring-files (files)
11041   "Files matching `anything-c-boring-file-regexp' will be
11042 displayed with the `file-name-shadow' face if available."
11043   (anything-c-shadow-entries files anything-c-boring-file-regexp))
11044
11045 (defun anything-c-skip-boring-files (files)
11046   "Files matching `anything-c-boring-file-regexp' will be skipped."
11047   (anything-c-skip-entries files anything-c-boring-file-regexp))
11048 ;; (anything-c-skip-boring-files '("README" "/src/.svn/hoge"))
11049
11050 (defun anything-c-skip-current-file (files)
11051   "Current file will be skipped."
11052   (remove (buffer-file-name anything-current-buffer) files))
11053
11054 (defun anything-c-w32-pathname-transformer (args)
11055   "Change undesirable features of windows pathnames to ones more acceptable to
11056 other candidate transformers."
11057   (if (eq system-type 'windows-nt)
11058       (anything-transform-mapcar
11059        (lambda (x)
11060          (replace-regexp-in-string
11061           "/cygdrive/\\(.\\)" "\\1:"
11062           (replace-regexp-in-string "\\\\" "/" x)))
11063        args)
11064     args))
11065
11066 (defun anything-c-shorten-home-path (files)
11067   "Replaces /home/user with ~."
11068   (let ((home (replace-regexp-in-string "\\\\" "/" ; stupid Windows...
11069                                         (getenv "HOME"))))
11070     (anything-transform-mapcar
11071      (lambda (file)
11072        (if (and (stringp file) (string-match home file))
11073            (cons (replace-match "~" nil nil file) file)
11074          file))
11075      files)))
11076
11077 ;;; Functions
11078 (defun anything-c-mark-interactive-functions (functions)
11079   "Mark interactive functions (commands) with (i) after the function name."
11080   (let (list)
11081     (loop for function in functions
11082           do (push (cons (concat function
11083                                  (when (commandp (intern-soft function)) " (i)"))
11084                          function)
11085                    list)
11086           finally (return (nreverse list)))))
11087
11088 \f
11089 ;;; Adaptive Sorting of Candidates
11090 ;;
11091 ;;
11092 ;; Internal
11093 (defvar anything-c-adaptive-done nil
11094   "nil if history information is not yet stored for the current
11095 selection.")
11096
11097 (defvar anything-c-adaptive-history nil
11098   "Contains the stored history information.
11099 Format: ((SOURCE-NAME (SELECTED-CANDIDATE (PATTERN . NUMBER-OF-USE) ...) ...) ...)")
11100
11101 ;; Should run at beginning of `anything-initial-setup'.
11102 (add-hook 'anything-before-initialize-hook #'(lambda ()
11103                                                (when anything-c-use-adaptative-sorting
11104                                                  (setq anything-c-adaptive-done nil))))
11105
11106 ;; Should run at beginning of `anything-exit-minibuffer'.
11107 (add-hook 'anything-before-action-hook #'(lambda ()
11108                                           (when anything-c-use-adaptative-sorting
11109                                             (anything-c-adaptive-store-selection))))
11110
11111 ;; Should run at beginning of `anything-select-action'.
11112 (add-hook 'anything-select-action-hook #'(lambda ()
11113                                            (when anything-c-use-adaptative-sorting
11114                                              (anything-c-adaptive-store-selection))))
11115
11116 (defun anything-c-source-use-adaptative-p (&optional source-name)
11117   "Return current source only if it use adaptative history, nil otherwise."
11118   (when anything-c-use-adaptative-sorting
11119     (let* ((source (or source-name (anything-get-current-source)))
11120            (adapt-source (or (assoc-default 'filtered-candidate-transformer
11121                                             (assoc (assoc-default 'type source)
11122                                                    anything-type-attributes))
11123                              (assoc-default 'candidate-transformer
11124                                             (assoc (assoc-default 'type source)
11125                                                    anything-type-attributes))
11126                              (assoc-default 'filtered-candidate-transformer source)
11127                              (assoc-default 'candidate-transformer source))))
11128       (if (listp adapt-source)
11129           (when (member 'anything-c-adaptive-sort adapt-source) source)
11130           (when (eq adapt-source 'anything-c-adaptive-sort) source)))))
11131
11132 (defun anything-c-adaptive-store-selection ()
11133   "Store history information for the selected candidate."
11134   (unless anything-c-adaptive-done
11135     (setq anything-c-adaptive-done t)
11136     (let ((source (anything-c-source-use-adaptative-p)))
11137       (when source
11138         (let* ((source-name (or (assoc-default 'type source)
11139                                 (assoc-default 'name source)))
11140                (source-info (or (assoc source-name anything-c-adaptive-history)
11141                                 (progn
11142                                   (push (list source-name) anything-c-adaptive-history)
11143                                   (car anything-c-adaptive-history))))
11144                (selection (anything-get-selection))
11145                (selection-info (progn
11146                                  (setcdr source-info
11147                                          (cons
11148                                           (let ((found (assoc selection (cdr source-info))))
11149                                             (if (not found)
11150                                                 ;; new entry
11151                                                 (list selection)
11152
11153                                                 ;; move entry to the beginning of the
11154                                                 ;; list, so that it doesn't get
11155                                                 ;; trimmed when the history is
11156                                                 ;; truncated
11157                                                 (setcdr source-info
11158                                                         (delete found (cdr source-info)))
11159                                                 found))
11160                                           (cdr source-info)))
11161                                  (cadr source-info)))
11162                (pattern-info (progn
11163                                (setcdr selection-info
11164                                        (cons
11165                                         (let ((found (assoc anything-pattern (cdr selection-info))))
11166                                           (if (not found)
11167                                               ;; new entry
11168                                               (cons anything-pattern 0)
11169
11170                                               ;; move entry to the beginning of the
11171                                               ;; list, so if two patterns used the
11172                                               ;; same number of times then the one
11173                                               ;; used last appears first in the list
11174                                               (setcdr selection-info
11175                                                       (delete found (cdr selection-info)))
11176                                               found))
11177                                         (cdr selection-info)))
11178                                (cadr selection-info))))
11179
11180           ;; increase usage count
11181           (setcdr pattern-info (1+ (cdr pattern-info)))
11182
11183           ;; truncate history if needed
11184           (if (> (length (cdr selection-info)) anything-c-adaptive-history-length)
11185               (setcdr selection-info
11186                       (subseq (cdr selection-info) 0 anything-c-adaptive-history-length))))))))
11187
11188 (defun anything-c-adaptative-maybe-load-history ()
11189   (when (and anything-c-use-adaptative-sorting
11190              (file-readable-p anything-c-adaptive-history-file))
11191     (load-file anything-c-adaptive-history-file)))
11192
11193 (add-hook 'emacs-startup-hook 'anything-c-adaptative-maybe-load-history)
11194 (add-hook 'kill-emacs-hook 'anything-c-adaptive-save-history)
11195
11196 (defun anything-c-adaptive-save-history (&optional arg)
11197   "Save history information to file given by `anything-c-adaptive-history-file'."
11198   (interactive "p")
11199   (when anything-c-use-adaptative-sorting
11200     (with-temp-buffer
11201       (insert
11202        ";; -*- mode: emacs-lisp -*-\n"
11203        ";; History entries used for anything adaptive display.\n")
11204       (prin1 `(setq anything-c-adaptive-history ',anything-c-adaptive-history)
11205              (current-buffer))
11206       (insert ?\n)
11207       (write-region (point-min) (point-max) anything-c-adaptive-history-file nil
11208                     (unless arg 'quiet)))))
11209
11210 (defun anything-c-adaptive-sort (candidates source)
11211   "Sort the CANDIDATES for SOURCE by usage frequency.
11212 This is a filtered candidate transformer you can use for the
11213 attribute `filtered-candidate-transformer' of a source in
11214 `anything-sources' or a type in `anything-type-attributes'."
11215   (let* ((source-name (or (assoc-default 'type source)
11216                           (assoc-default 'name source)))
11217          (source-info (assoc source-name anything-c-adaptive-history)))
11218     (if source-info
11219         (let ((usage
11220                ;; ... assemble a list containing the (CANIDATE . USAGE-COUNT)
11221                ;; pairs
11222                (mapcar (lambda (candidate-info)
11223                          (let ((count 0))
11224                            (dolist (pattern-info (cdr candidate-info))
11225                              (if (not (equal (car pattern-info)
11226                                              anything-pattern))
11227                                  (incf count (cdr pattern-info))
11228
11229                                  ;; if current pattern is equal to the previously
11230                                  ;; used one then this candidate has priority
11231                                  ;; (that's why its count is boosted by 10000) and
11232                                  ;; it only has to compete with other candidates
11233                                  ;; which were also selected with the same pattern
11234                                  (setq count (+ 10000 (cdr pattern-info)))
11235                                  (return)))
11236                            (cons (car candidate-info) count)))
11237                        (cdr source-info)))
11238               sorted)
11239           (if (and usage (consp usage))
11240               ;; sort the list in descending order, so candidates with highest
11241               ;; priorty come first
11242               (progn
11243                 (setq usage (sort usage (lambda (first second)
11244                                           (> (cdr first) (cdr second)))))
11245
11246                 ;; put those candidates first which have the highest usage count
11247                 (dolist (info usage)
11248                   (when (member* (car info) candidates
11249                                  :test 'anything-c-adaptive-compare)
11250                     (push (car info) sorted)
11251                     (setq candidates (remove* (car info) candidates
11252                                               :test 'anything-c-adaptive-compare))))
11253
11254                 ;; and append the rest
11255                 (append (reverse sorted) candidates nil))
11256               (message "Your `%s' is maybe corrupted or too old, \
11257 you should reinitialize it with `anything-c-reset-adaptative-history'"
11258                        anything-c-adaptive-history-file)
11259               (sit-for 1)
11260               candidates))
11261         ;; if there is no information stored for this source then do nothing
11262         candidates)))
11263
11264 ;;;###autoload
11265 (defun anything-c-reset-adaptative-history ()
11266   "Delete all `anything-c-adaptive-history' and his file.
11267 Useful when you have a old or corrupted `anything-c-adaptive-history-file'."
11268   (interactive)
11269   (when (y-or-n-p "Really delete all your `anything-c-adaptive-history'? ")
11270     (setq anything-c-adaptive-history nil)
11271     (delete-file anything-c-adaptive-history-file)))
11272
11273 (defun anything-c-adaptive-compare (x y)
11274   "Compare candidates X and Y taking into account that the
11275 candidate can be in (DISPLAY . REAL) format."
11276   (equal (if (listp x)
11277              (cdr x)
11278              x)
11279          (if (listp y)
11280              (cdr y)
11281              y)))
11282
11283
11284 \f
11285 ;;; Outliner
11286 ;;
11287 ;;
11288 (defvar anything-outline-goto-near-line-flag t)
11289 (defvar anything-outline-using nil)
11290 (defun anything-after-update-hook--outline ()
11291   (if (and (eq anything-outline-using t)
11292            (eq anything-outline-goto-near-line-flag t))
11293       (anything-outline-goto-near-line)))
11294 (add-hook 'anything-after-update-hook 'anything-after-update-hook--outline)
11295
11296 (defun anything-outline-goto-near-line ()
11297   (with-anything-window
11298     ;; TODO need consideration whether to update position by every input.
11299     (when t ; (equal anything-pattern "")
11300       (anything-goto-line 2)
11301       (let ((lineno (with-anything-current-buffer
11302                       (line-number-at-pos (car anything-current-position)))))
11303         (block exit
11304           (while (<= (progn (skip-chars-forward " ")
11305                             (or (number-at-point) lineno))
11306                      lineno)
11307             (forward-line 1)
11308             (when (eobp)
11309               (forward-line -1)
11310               (return-from exit))))
11311         (forward-line -1)
11312         (and (bobp) (forward-line 1))
11313         (and (anything-pos-header-line-p) (forward-line -2))
11314         (anything-mark-current-line)))))
11315
11316
11317 \f
11318 ;;; Plug-in
11319 ;;
11320 ;;
11321 ;; Plug-in: info-index
11322 (defun* anything-c-info-init (&optional (file (anything-attr 'info-file)))
11323   (let (result)
11324     (unless (anything-candidate-buffer)
11325       (save-window-excursion
11326         (info file)
11327         (let (Info-history
11328               (tobuf (anything-candidate-buffer 'global))
11329               (infobuf (current-buffer))
11330               s e)
11331           (dolist (node (or (anything-attr 'index-nodes) (Info-index-nodes)))
11332             (Info-goto-node node)
11333             (goto-char (point-min))
11334             (while (search-forward "\n* " nil t)
11335               (unless (search-forward "Menu:\n" (1+ (point-at-eol)) t)
11336                 '(save-current-buffer (buffer-substring-no-properties (point-at-bol) (point-at-eol)) result)
11337                 (setq s (point-at-bol)
11338                       e (point-at-eol))
11339                 (with-current-buffer tobuf
11340                   (insert-buffer-substring infobuf s e)
11341                   (insert "\n"))))))))))
11342
11343 (defun anything-c-info-goto (node-line)
11344   (Info-goto-node (car node-line))
11345   (anything-goto-line (cdr node-line)))
11346
11347 (defun anything-c-info-display-to-real (line)
11348   (and (string-match
11349         ;; This regexp is stolen from Info-apropos-matches
11350         "\\* +\\([^\n]*.+[^\n]*\\):[ \t]+\\([^\n]*\\)\\.\\(?:[ \t\n]*(line +\\([0-9]+\\))\\)?" line)
11351        (cons (format "(%s)%s" (anything-attr 'info-file) (match-string 2 line))
11352              (string-to-number (or (match-string 3 line) "1")))))
11353
11354 (defun anything-c-make-info-source (source file)
11355   `(,@source
11356     (name . ,(concat "Info Index: " file))
11357     (info-file . ,file)
11358     (init . anything-c-info-init)
11359     (display-to-real . anything-c-info-display-to-real)
11360     (get-line . buffer-substring)
11361     (candidates-in-buffer)
11362     (action ("Goto node" . anything-c-info-goto))))
11363
11364 (defun anything-compile-source--info-index (source)
11365   (anything-aif (anything-interpret-value (assoc-default 'info-index source))
11366       (anything-c-make-info-source source it)
11367     source))
11368 (add-to-list 'anything-compile-source-functions 'anything-compile-source--info-index)
11369
11370 (anything-document-attribute 'info-index "info-index plugin"
11371                              "Create a source of info index very easily.
11372
11373 ex. (defvar anything-c-source-info-wget '((info-index . \"wget\"))")
11374
11375 (anything-document-attribute 'index-nodes "info-index plugin (optional)"
11376                              "Index nodes of info file.
11377
11378 If it is omitted, `Info-index-nodes' is used to collect index nodes.
11379 Some info files are missing index specification.
11380
11381 ex. See `anything-c-source-info-screen'.")
11382
11383 ;; Plug-in: candidates-file
11384 (defun anything-compile-source--candidates-file (source)
11385   (if (assoc-default 'candidates-file source)
11386       `((init anything-p-candidats-file-init
11387               ,@(let ((orig-init (assoc-default 'init source)))
11388                      (cond ((null orig-init) nil)
11389                            ((functionp orig-init) (list orig-init))
11390                            (t orig-init))))
11391         (candidates-in-buffer)
11392         ,@source)
11393       source))
11394 (add-to-list 'anything-compile-source-functions 'anything-compile-source--candidates-file)
11395
11396 (defun anything-p-candidats-file-init ()
11397   (destructuring-bind (file &optional updating)
11398       (anything-mklist (anything-attr 'candidates-file))
11399     (setq file (anything-interpret-value file))
11400     (with-current-buffer (anything-candidate-buffer (find-file-noselect file))
11401       (when updating
11402         (buffer-disable-undo)
11403         (font-lock-mode -1)
11404         (auto-revert-mode 1)))))
11405
11406 (anything-document-attribute 'candidates-file "candidates-file plugin"
11407                              "Use a file as the candidates buffer.
11408
11409 1st argument is a filename, string or function name or variable name.
11410 If optional 2nd argument is non-nil, the file opened with `auto-revert-mode'.")
11411
11412 ;; Plug-in: headline
11413 (defun anything-compile-source--anything-headline (source)
11414   (if (assoc-default 'headline source)
11415       (append '((init . anything-headline-init)
11416                 (get-line . buffer-substring)
11417                 (type . line))
11418               source
11419               '((candidates-in-buffer)
11420                 (persistent-help . "Show this line")))
11421       source))
11422 (add-to-list 'anything-compile-source-functions 'anything-compile-source--anything-headline)
11423
11424 (defun anything-headline-init ()
11425   (when (and (anything-current-buffer-is-modified)
11426              (with-anything-current-buffer
11427                (eval (or (anything-attr 'condition) t))))
11428     (anything-headline-make-candidate-buffer
11429      (anything-interpret-value (anything-attr 'headline))
11430      (anything-interpret-value (anything-attr 'subexp)))))
11431
11432 (anything-document-attribute 'headline "Headline plug-in"
11433                              "Regexp string for anything-headline to scan.")
11434 (anything-document-attribute 'condition "Headline plug-in"
11435                              "A sexp representing the condition to use anything-headline.")
11436 (anything-document-attribute 'subexp "Headline plug-in"
11437                              "Display (match-string-no-properties subexp).")
11438
11439 ;; Le Wang: Note on how `anything-head-line-get-candidates' works with a list
11440 ;; of regexps.
11441 ;;
11442 ;;   1. Create list of ((title . start-of-match) . hiearchy)
11443 ;;   2. Sort this list by start-of-match.
11444 ;;   3. Go through sorted list and return titles that reflect full hiearchy.
11445 ;;
11446 ;; It's quite brilliantly written.
11447 ;;
11448
11449
11450 (defun anything-headline-get-candidates (regexp subexp)
11451   (with-anything-current-buffer
11452     (save-excursion
11453       (goto-char (point-min))
11454       (if (functionp regexp) (setq regexp (funcall regexp)))
11455       (let (hierarchy curhead)
11456         (flet ((matched ()
11457                  (if (numberp subexp)
11458                      (cons (match-string-no-properties subexp) (match-beginning subexp))
11459                      (cons (buffer-substring (point-at-bol) (point-at-eol))
11460                            (point-at-bol))))
11461                (hierarchies (headlines)
11462                  (1+ (loop for (_ . hierarchy) in headlines
11463                            maximize hierarchy)))
11464                (vector-0-n (v n)
11465                  (loop for i from 0 to hierarchy
11466                        collecting (aref curhead i)))
11467                (arrange (headlines)
11468                  (unless (null headlines) ; FIX headlines empty bug!
11469                    (loop with curhead = (make-vector (hierarchies headlines) "")
11470                          for ((str . pt) . hierarchy) in headlines
11471                          do (aset curhead hierarchy str)
11472                          collecting
11473                          (cons
11474                           (format "H%d:%s" (1+ hierarchy)
11475                                   (mapconcat 'identity (vector-0-n curhead hierarchy) " / "))
11476                           pt)))))
11477           (if (listp regexp)
11478               (arrange
11479                (sort
11480                 (loop for re in regexp
11481                       for hierarchy from 0
11482                       do (goto-char (point-min))
11483                       appending
11484                       (loop
11485                             while (re-search-forward re nil t)
11486                             collect (cons (matched) hierarchy)))
11487                 (lambda (a b) (> (cdar b) (cdar a)))))
11488               (loop while (re-search-forward regexp nil t)
11489                     collect (matched))))))))
11490
11491
11492 (defun anything-headline-make-candidate-buffer (regexp subexp)
11493   (with-current-buffer (anything-candidate-buffer 'local)
11494     (loop for (content . pos) in (anything-headline-get-candidates regexp subexp)
11495           do (insert
11496               (format "%5d:%s\n"
11497                       (with-anything-current-buffer
11498                         (line-number-at-pos pos))
11499                       content)))))
11500
11501 (defun anything-headline-goto-position (pos recenter)
11502   (goto-char pos)
11503   (unless recenter
11504     (set-window-start (get-buffer-window anything-current-buffer) (point))))
11505
11506
11507 ;; Plug-in: persistent-help
11508 (defun anything-compile-source--persistent-help (source)
11509   (append source '((header-line . anything-persistent-help-string))))
11510 (add-to-list 'anything-compile-source-functions 'anything-compile-source--persistent-help)
11511
11512 (defun anything-persistent-help-string ()
11513   (substitute-command-keys
11514    (concat "\\<anything-map>\\[anything-execute-persistent-action]: "
11515            (or (anything-interpret-value (anything-attr 'persistent-help))
11516                (anything-aif (or (assoc-default 'persistent-action
11517                                                 (anything-get-current-source))
11518                                  (assoc-default 'action
11519                                                 (anything-get-current-source)))
11520                    (cond ((symbolp it) (symbol-name it))
11521                          ((listp it) (or (ignore-errors (caar it))  ""))))
11522                "")
11523            " (keeping session)")))
11524
11525 (anything-document-attribute 'persistent-help "persistent-help plug-in"
11526                              "A string to explain persistent-action of this source.
11527 It also accepts a function or a variable name.")
11528
11529 ;;; (anything '(((name . "persistent-help test")(candidates "a")(persistent-help . "TEST"))))
11530
11531 ;; Plug-in: Type customize
11532 (defun anything-c-uniq-list (lst)
11533   "Like `remove-duplicates' in CL.
11534 But cut deeper duplicates and test by `equal'. "
11535   (reverse (remove-duplicates (reverse lst) :test 'equal)))
11536 (defvar anything-additional-type-attributes nil)
11537 (defun anything-c-arrange-type-attribute (type spec)
11538   "Override type attributes by `define-anything-type-attribute'.
11539
11540 The SPEC is like source. The symbol `REST' is replaced
11541 with original attribute value.
11542
11543  Example: Set `play-sound-file' as default action
11544    (anything-c-arrange-type-attribute 'file
11545       '((action (\"Play sound\" . play-sound-file)
11546          REST ;; Rest of actions (find-file, find-file-other-window, etc...)."
11547   (add-to-list 'anything-additional-type-attributes
11548                (cons type
11549                      (loop with typeattr = (assoc-default
11550                                             type anything-type-attributes)
11551                            for (attr . value) in spec
11552                            if (listp value)
11553                            collect (cons attr
11554                                          (anything-c-uniq-list
11555                                           (loop for v in value
11556                                                 if (eq v 'REST)
11557                                                 append
11558                                                 (assoc-default attr typeattr)
11559                                                 else
11560                                                 collect v)))
11561                            else
11562                            collect (cons attr value)))))
11563 (put 'anything-c-arrange-type-attribute 'lisp-indent-function 1)
11564
11565 (defun anything-compile-source--type-customize (source)
11566   (anything-aif (assoc-default (assoc-default 'type source)
11567                                anything-additional-type-attributes)
11568       (append it source)
11569     source))
11570 (add-to-list 'anything-compile-source-functions
11571              'anything-compile-source--type-customize t)
11572
11573 ;; Plug-in: default-action
11574 (defun anything-compile-source--default-action (source)
11575   (anything-aif (assoc-default 'default-action source)
11576       (append `((action ,it ,@(remove it (assoc-default 'action source))))
11577               source)
11578     source))
11579 (add-to-list 'anything-compile-source-functions
11580              'anything-compile-source--default-action t)
11581 (anything-document-attribute 'default-action "default-action plug-in"
11582                              "Default action.")
11583
11584 \f
11585 ;;; Type Attributes
11586 ;;
11587 ;;
11588 (define-anything-type-attribute 'buffer
11589     `((action
11590        ("Switch to buffer" . anything-c-switch-to-buffer)
11591        ,(and (locate-library "popwin") '("Switch to buffer in popup window" . popwin:popup-buffer))
11592        ("Switch to buffer other window" . switch-to-buffer-other-window)
11593        ("Switch to buffer other frame" . switch-to-buffer-other-frame)
11594        ,(and (locate-library "elscreen") '("Display buffer in Elscreen" . anything-find-buffer-on-elscreen))
11595        ("Query replace regexp" . anything-c-buffer-query-replace-regexp)
11596        ("Query replace" . anything-c-buffer-query-replace)
11597        ("View buffer" . view-buffer)
11598        ("Display buffer"   . display-buffer)
11599        ("Grep buffers (C-u grep all buffers)" . anything-c-zgrep-buffers)
11600        ("Revert buffer(s)" . anything-revert-marked-buffers)
11601        ("Insert buffer" . insert-buffer)
11602        ("Kill buffer(s)" . anything-kill-marked-buffers)
11603        ("Diff with file" . diff-buffer-with-file)
11604        ("Ediff Marked buffers" . anything-ediff-marked-buffers)
11605        ("Ediff Merge marked buffers" . (lambda (candidate)
11606                                          (anything-ediff-marked-buffers candidate t))))
11607       (persistent-help . "Show this buffer")
11608       (candidate-transformer anything-c-skip-boring-buffers
11609                              anything-c-transform-buffer-display-string))
11610   "Buffer or buffer name.")
11611
11612 (define-anything-type-attribute 'file
11613     `((action
11614        ("Find file" . anything-find-many-files)
11615        ,(and (locate-library "popwin") '("Find file in popup window" . popwin:find-file))
11616        ("Find file as root" . anything-find-file-as-root)
11617        ("Find file other window" . find-file-other-window)
11618        ("Find file other frame" . find-file-other-frame)
11619        ("Open dired in file's directory" . anything-c-open-dired)
11620        ("Grep File(s) `C-u recurse'" . anything-find-files-grep)
11621        ("Zgrep File(s) `C-u Recurse'" . anything-ff-zgrep)
11622        ("Pdfgrep File(s)" . anything-ff-pdfgrep)
11623        ("Checksum File" . anything-ff-checksum)
11624        ("Ediff File" . anything-find-files-ediff-files)
11625        ("Ediff Merge File" . anything-find-files-ediff-merge-files)
11626        ("View file" . view-file)
11627        ("Insert file" . insert-file)
11628        ("Delete file(s)" . anything-delete-marked-files)
11629        ("Open file externally (C-u to choose)" . anything-c-open-file-externally)
11630        ("Open file with default tool" . anything-c-open-file-with-default-tool)
11631        ("Find file in hex dump" . hexl-find-file))
11632       (persistent-help . "Show this file")
11633       (action-transformer anything-c-transform-file-load-el
11634                           anything-c-transform-file-browse-url)
11635       (candidate-transformer anything-c-w32-pathname-transformer
11636                              anything-c-skip-current-file
11637                              anything-c-skip-boring-files
11638                              anything-c-shorten-home-path))
11639   "File name.")
11640
11641 (let ((actions '(("Describe command" . describe-function)
11642                  ("Add command to kill ring" . anything-c-kill-new)
11643                  ("Go to command's definition" . find-function)
11644                  ("Debug on entry" . debug-on-entry)
11645                  ("Cancel debug on entry" . cancel-debug-on-entry)
11646                  ("Trace function" . trace-function)
11647                  ("Trace function (background)" . trace-function-background)
11648                  ("Untrace function" . untrace-function))))
11649   (define-anything-type-attribute 'command
11650       `((action ("Call interactively" . anything-c-call-interactively)
11651                 ,@actions)
11652         (coerce . anything-c-symbolify)
11653         (persistent-action . describe-function))
11654     "Command. (string or symbol)")
11655
11656   (define-anything-type-attribute 'function
11657       `((action . ,actions)
11658         (action-transformer anything-c-transform-function-call-interactively)
11659         (candidate-transformer anything-c-mark-interactive-functions)
11660         (coerce . anything-c-symbolify))
11661     "Function. (string or symbol)"))
11662
11663 (define-anything-type-attribute 'variable
11664     '((action ("Describe variable" . describe-variable)
11665        ("Add variable to kill ring" . anything-c-kill-new)
11666        ("Go to variable's definition" . find-variable)
11667        ("Set variable" . anything-c-set-variable))
11668       (coerce . anything-c-symbolify))
11669   "Variable.")
11670
11671 (define-anything-type-attribute 'sexp
11672     '((action ("Eval s-expression" . (lambda (c) (eval (read c))))
11673        ("Add s-expression to kill ring" . kill-new))
11674       (action-transformer anything-c-transform-sexp-eval-command-sexp))
11675   "String representing S-Expressions.")
11676
11677 (define-anything-type-attribute 'bookmark
11678     `((coerce . anything-bookmark-get-bookmark-from-name)
11679       (action
11680        ("Jump to bookmark" . anything-c-bookmark-jump)
11681        ("Jump to BM other window" . bookmark-jump-other-window)
11682        ("Bookmark edit annotation" . bookmark-edit-annotation)
11683        ("Bookmark show annotation" . bookmark-show-annotation)
11684        ("Delete bookmark(s)" . anything-delete-marked-bookmarks)
11685        ,@(and (locate-library "bookmark-extensions")
11686               `(("Edit Bookmark" . bmkext-edit-bookmark)))
11687        ("Rename bookmark" . bookmark-rename)
11688        ("Relocate bookmark" . bookmark-relocate))
11689       (keymap . ,anything-c-bookmark-map)
11690       (mode-line . anything-bookmark-mode-line-string))
11691   "Bookmark name.")
11692
11693 (define-anything-type-attribute 'line
11694     '((display-to-real . anything-c-display-to-real-line)
11695       (action ("Go to Line" . anything-c-action-line-goto)))
11696   "LINENO:CONTENT string, eg. \"  16:foo\".
11697
11698 Optional `target-file' attribute is a name of target file.
11699
11700 Optional `before-jump-hook' attribute is a function with no
11701 arguments which is called before jumping to position.
11702
11703 Optional `after-jump-hook' attribute is a function with no
11704 arguments which is called after jumping to position.
11705
11706 If `adjust' attribute is specified, searches the line whose
11707 content is CONTENT near the LINENO.
11708
11709 If `recenter' attribute is specified, the line is displayed at
11710 the center of window, otherwise at the top of window.
11711 ")
11712
11713 (define-anything-type-attribute 'file-line
11714     `((filtered-candidate-transformer anything-c-filtered-candidate-transformer-file-line)
11715       (multiline)
11716       (action ("Go to" . anything-c-action-file-line-goto)))
11717   "FILENAME:LINENO:CONTENT string, eg. \"~/.emacs:16:;; comment\".
11718
11719 Optional `default-directory' attribute is a default-directory
11720 FILENAME is interpreted.
11721
11722 Optional `before-jump-hook' attribute is a function with no
11723 arguments which is called before jumping to position.
11724
11725 Optional `after-jump-hook' attribute is a function with no
11726 arguments which is called after jumping to position.
11727
11728 If `adjust' attribute is specified, searches the line whose
11729 content is CONTENT near the LINENO.
11730
11731 If `recenter' attribute is specified, the line is displayed at
11732 the center of window, otherwise at the top of window.
11733 ")
11734
11735 (define-anything-type-attribute 'timer
11736     '((real-to-display . anything-c-timer-real-to-display)
11737       (action ("Cancel Timer" . cancel-timer)
11738        ("Describe Function" . (lambda (tm) (describe-function (timer--function tm))))
11739        ("Find Function" . (lambda (tm) (find-function (timer--function tm)))))
11740       (persistent-action . (lambda (tm) (describe-function (timer--function tm))))
11741       (persistent-help . "Describe Function"))
11742   "Timer.")
11743
11744 \f
11745 ;;; Default `anything-sources'
11746 ;; Setting `anything-sources' is DEPRECATED, but it seems that newbies
11747 ;; tend to invoke M-x anything directly. So I offer default setting.
11748 (setq anything-sources
11749       '(anything-c-source-buffers-list
11750         anything-c-source-recentf
11751         anything-c-source-files-in-current-dir+))
11752
11753 \f
11754 ;;; Preconfigured Anything
11755 ;;
11756 ;;
11757 ;;;###autoload
11758 (defun anything-mini ()
11759   "Preconfigured `anything' lightweight version \(buffer -> recentf\)."
11760   (interactive)
11761   (anything-other-buffer '(anything-c-source-buffers-list
11762                            anything-c-source-recentf
11763                            anything-c-source-buffer-not-found)
11764                          "*anything mini*"))
11765 ;;;###autoload
11766 (defun anything-for-files ()
11767   "Preconfigured `anything' for opening files.
11768 ffap -> recentf -> buffer -> bookmark -> file-cache -> files-in-current-dir -> locate."
11769   (interactive)
11770   (anything-other-buffer anything-for-files-prefered-list "*anything for files*"))
11771
11772 ;;;###autoload
11773 (defun anything-recentf ()
11774   "Preconfigured `anything' for `recentf'."
11775   (interactive)
11776   (anything-other-buffer 'anything-c-source-recentf "*anything recentf*"))
11777
11778 ;;;###autoload
11779 (defun anything-info-at-point (arg)
11780   "Preconfigured `anything' for searching info at point.
11781 With a prefix-arg insert symbol at point."
11782   (interactive "P")
11783   (let ((anything-c-google-suggest-default-function
11784          'anything-c-google-suggest-emacs-lisp))
11785     (anything :sources '(anything-c-source-info-elisp
11786                          anything-c-source-info-cl
11787                          anything-c-source-info-pages
11788                          anything-c-source-google-suggest)
11789               :input (and arg (thing-at-point 'symbol))
11790               :buffer "*anything info*")))
11791
11792 ;;;###autoload
11793 (defun anything-show-kill-ring ()
11794   "Preconfigured `anything' for `kill-ring'.
11795 It is drop-in replacement of `yank-pop'.
11796 You may bind this command to M-y.
11797 First call open the kill-ring browser, next calls move to next line."
11798   (interactive)
11799   (anything :sources 'anything-c-source-kill-ring
11800             :buffer "*anything kill-ring*"))
11801
11802 ;;;###autoload
11803 (defun anything-minibuffer-history ()
11804   "Preconfigured `anything' for `minibuffer-history'."
11805   (interactive)
11806   (let ((enable-recursive-minibuffers t))
11807     (anything-other-buffer 'anything-c-source-minibuffer-history
11808                            "*anything minibuffer-history*")))
11809
11810 ;;;###autoload
11811 (defun anything-gentoo ()
11812   "Preconfigured `anything' for gentoo linux."
11813   (interactive)
11814   (anything-other-buffer '(anything-c-source-gentoo
11815                            anything-c-source-use-flags)
11816                          "*anything gentoo*"))
11817
11818 ;;;###autoload
11819 (defun anything-imenu ()
11820   "Preconfigured `anything' for `imenu'."
11821   (interactive)
11822   (anything :sources 'anything-c-source-imenu
11823             :buffer "*anything imenu*"))
11824
11825 ;;;###autoload
11826 (defun anything-google-suggest ()
11827   "Preconfigured `anything' for google search with google suggest."
11828   (interactive)
11829   (anything-other-buffer 'anything-c-source-google-suggest "*anything google*"))
11830
11831 ;;;###autoload
11832 (defun anything-yahoo-suggest ()
11833   "Preconfigured `anything' for Yahoo searching with Yahoo suggest."
11834   (interactive)
11835   (anything-other-buffer 'anything-c-source-yahoo-suggest "*anything yahoo*"))
11836
11837 ;;; Converted from anything-show-*-only
11838 ;;;###autoload
11839 (defun anything-for-buffers ()
11840   "Preconfigured `anything' for buffers."
11841   (interactive)
11842   (anything-other-buffer 'anything-c-source-buffers "*anything for buffers*"))
11843
11844 ;;;###autoload
11845 (defun anything-buffers-list ()
11846   "Preconfigured `anything' to list buffers.
11847 It is an enhanced version of `anything-for-buffers'."
11848   (interactive)
11849   (anything :sources '(anything-c-source-buffers-list
11850                        anything-c-source-buffer-not-found)
11851             :buffer "*anything buffers*" :keymap anything-c-buffer-map))
11852
11853 (defalias 'anything-buffers+ 'anything-buffers-list
11854   "Preconfigured `anything' to list buffers.
11855 It is an alias of `anything-buffers-list'.")
11856
11857 ;;;###autoload
11858 (defun anything-bbdb ()
11859   "Preconfigured `anything' for BBDB.
11860
11861 Needs BBDB.
11862
11863 http://bbdb.sourceforge.net/"
11864   (interactive)
11865   (anything-other-buffer 'anything-c-source-bbdb "*anything bbdb*"))
11866
11867 ;;;###autoload
11868 (defun anything-locate (arg)
11869   "Preconfigured `anything' for Locate.
11870 Note: you can add locate options after entering pattern.
11871 See 'man locate' for valid options.
11872
11873 You can specify a specific database with prefix argument ARG \(C-u\).
11874 Many databases can be used: navigate and mark them.
11875 See also `anything-locate-with-db'.
11876
11877 To create a user specific db, use
11878 \"updatedb -l 0 -o db_path -U directory\".
11879 Where db_path is a filename matched by
11880 `anything-locate-db-file-regexp'."
11881   (interactive "P")
11882   (setq anything-ff-default-directory default-directory)
11883   (anything-locate-1 arg))
11884
11885 ;;;###autoload
11886 (defun anything-w3m-bookmarks ()
11887   "Preconfigured `anything' for w3m bookmark.
11888
11889 Needs w3m and emacs-w3m.
11890
11891 http://w3m.sourceforge.net/
11892 http://emacs-w3m.namazu.org/"
11893   (interactive)
11894   (anything-other-buffer 'anything-c-source-w3m-bookmarks
11895                          "*anything w3m bookmarks*"))
11896
11897 ;;;###autoload
11898 (defun anything-firefox-bookmarks ()
11899   "Preconfigured `anything' for firefox bookmark.
11900 You will have to enable html bookmarks in firefox:
11901 open about:config in firefox and double click on this line to enable value \
11902 to true:
11903
11904 user_pref(\"browser.bookmarks.autoExportHTML\", false);
11905
11906 You should have now:
11907
11908 user_pref(\"browser.bookmarks.autoExportHTML\", true);
11909
11910 After closing firefox, you will be able to browse you bookmarks.
11911 "
11912   (interactive)
11913   (anything-other-buffer 'anything-c-source-firefox-bookmarks
11914                          "*Anything Firefox*"))
11915
11916 ;;;###autoload
11917 (defun anything-colors ()
11918   "Preconfigured `anything' for color."
11919   (interactive)
11920   (anything-other-buffer
11921    '(anything-c-source-colors anything-c-source-customize-face)
11922    "*anything colors*"))
11923
11924 ;;;###autoload
11925 (defun anything-bookmarks ()
11926   "Preconfigured `anything' for bookmarks."
11927   (interactive)
11928   (anything-other-buffer 'anything-c-source-bookmarks "*anything bookmarks*"))
11929
11930 ;;;###autoload
11931 (defun anything-c-pp-bookmarks ()
11932   "Preconfigured `anything' for bookmarks (pretty-printed)."
11933   (interactive)
11934   (anything-other-buffer '(anything-c-source-bookmarks-local
11935                            anything-c-source-bookmarks-su
11936                            anything-c-source-bookmarks-ssh)
11937                          "*anything pp bookmarks*"))
11938
11939 ;;;###autoload
11940 (defun anything-c-insert-latex-math ()
11941   "Preconfigured anything for latex math symbols completion."
11942   (interactive)
11943   (anything-other-buffer 'anything-c-source-latex-math "*anything latex*"))
11944
11945 ;;;###autoload
11946 (defun anything-register ()
11947   "Preconfigured `anything' for Emacs registers."
11948   (interactive)
11949   (anything-other-buffer 'anything-c-source-register "*anything register*"))
11950
11951 ;;;###autoload
11952 (defun anything-man-woman ()
11953   "Preconfigured `anything' for Man and Woman pages."
11954   (interactive)
11955   (anything-other-buffer 'anything-c-source-man-pages "*Anything man woman*"))
11956
11957 ;;;###autoload
11958 (defun anything-org-keywords ()
11959   "Preconfigured `anything' for org keywords."
11960   (interactive)
11961   (anything-other-buffer 'anything-c-source-org-keywords "*org keywords*"))
11962
11963 ;;;###autoload
11964 (defun anything-emms ()
11965   "Preconfigured `anything' for emms sources."
11966   (interactive)
11967   (anything :sources '(anything-c-source-emms-streams
11968                        anything-c-source-emms-files
11969                        anything-c-source-emms-dired)
11970             :buffer "*Anything Emms*"))
11971
11972 ;;;###autoload
11973 (defun anything-eev-anchors ()
11974   "Preconfigured `anything' for eev anchors."
11975   (interactive)
11976   (anything-other-buffer 'anything-c-source-eev-anchor "*Anything eev anchors*"))
11977
11978 ;;;###autoload
11979 (defun anything-bm-list ()
11980   "Preconfigured `anything' for visible bookmarks.
11981
11982 Needs bm.el
11983
11984 http://cvs.savannah.gnu.org/viewvc/*checkout*/bm/bm/bm.el"
11985   (interactive)
11986   (let ((anything-outline-using t))
11987     (anything-other-buffer 'anything-c-source-bm "*anything bm list*")))
11988
11989 ;;;###autoload
11990 (defun anything-timers ()
11991   "Preconfigured `anything' for timers."
11992   (interactive)
11993   (anything-other-buffer '(anything-c-source-absolute-time-timers
11994                            anything-c-source-idle-time-timers)
11995                          "*anything timers*"))
11996
11997 ;;;###autoload
11998 (defun anything-list-emacs-process ()
11999   "Preconfigured `anything' for emacs process."
12000   (interactive)
12001   (anything-other-buffer 'anything-c-source-emacs-process "*anything process*"))
12002
12003 ;;;###autoload
12004 (defun anything-occur ()
12005   "Preconfigured Anything for Occur source.
12006 If region is active, search only in region,
12007 otherwise search in whole buffer."
12008   (interactive)
12009   (let ((anything-compile-source-functions
12010          ;; rule out anything-match-plugin because the input is one regexp.
12011          (delq 'anything-compile-source--match-plugin
12012                (copy-sequence anything-compile-source-functions))))
12013     (anything :sources 'anything-c-source-occur
12014               :buffer "*Anything Occur*"
12015               :history 'anything-c-grep-history)))
12016
12017 ;;;###autoload
12018 (defun anything-browse-code ()
12019   "Preconfigured anything to browse code."
12020   (interactive)
12021   (anything :sources 'anything-c-source-browse-code
12022             :buffer "*anything browse code*"
12023             :default (thing-at-point 'symbol)))
12024
12025 ;;;###autoload
12026 (defun anything-org-headlines ()
12027   "Preconfigured anything to show org headlines."
12028   (interactive)
12029   (anything-other-buffer 'anything-c-source-org-headline "*org headlines*"))
12030
12031 ;;;###autoload
12032 (defun anything-regexp ()
12033   "Preconfigured anything to build regexps.
12034 `query-replace-regexp' can be run from there against found regexp."
12035   (interactive)
12036   (save-restriction
12037     (let ((anything-compile-source-functions
12038            ;; rule out anything-match-plugin because the input is one regexp.
12039            (delq 'anything-compile-source--match-plugin
12040                  (copy-sequence anything-compile-source-functions))))
12041       (when (and (anything-region-active-p)
12042                  ;; Don't narrow to region if buffer is already narrowed.
12043                  (not (anything-current-buffer-narrowed-p)))
12044         (narrow-to-region (region-beginning) (region-end)))
12045       (anything :sources anything-c-source-regexp
12046                 :buffer "*anything regexp*"
12047                 :prompt "Regexp: "
12048                 :history 'anything-build-regexp-history))))
12049
12050 ;;;###autoload
12051 (defun anything-c-copy-files-async ()
12052   "Preconfigured anything to copy file list FLIST to DEST asynchronously."
12053   (interactive)
12054   (let* ((flist (anything-c-read-file-name
12055                  "Copy File async: "
12056                  :marked-candidates t))
12057          (dest  (anything-c-read-file-name
12058                  "Copy File async To: "
12059                  :preselect (car flist)
12060                  :initial-input (car anything-ff-history)
12061                  :history (anything-find-files-history :comp-read nil))))
12062     (anything-c-copy-async-with-log flist dest)))
12063
12064 ;;;###autoload
12065 (defun anything-find-files (arg)
12066   "Preconfigured `anything' for anything implementation of `find-file'.
12067 Called with a prefix arg show history if some.
12068 Don't call it from programs, use `anything-find-files-1' instead.
12069 This is the starting point for nearly all actions you can do on files."
12070   (interactive "P")
12071   (let ((any-input (if (and arg anything-ff-history)
12072                        (anything-find-files-history)
12073                        (anything-find-files-initial-input)))
12074         (presel    (buffer-file-name (current-buffer))))
12075     (when (and (eq major-mode 'org-agenda-mode)
12076                org-directory
12077                (not any-input))
12078       (setq any-input (expand-file-name org-directory)))
12079     (set-text-properties 0 (length any-input) nil any-input)
12080     (if any-input
12081         (anything-find-files-1 any-input)
12082         (setq any-input (expand-file-name (anything-c-current-directory)))
12083         (anything-find-files-1
12084          any-input (if anything-ff-transformer-show-only-basename
12085                        (and presel (anything-c-basename presel))
12086                        presel)))))
12087
12088 ;;;###autoload
12089 (defun anything-write-file ()
12090   "Preconfigured `anything' providing completion for `write-file'."
12091   (interactive)
12092   (let ((anything-mp-highlight-delay nil))
12093     (anything :sources 'anything-c-source-write-file
12094               :input (expand-file-name default-directory)
12095               :prompt "Write buffer to file: "
12096               :buffer "*Anything write file*")))
12097
12098 ;;;###autoload
12099 (defun anything-insert-file ()
12100   "Preconfigured `anything' providing completion for `insert-file'."
12101   (interactive)
12102   (let ((anything-mp-highlight-delay nil))
12103     (anything :sources 'anything-c-source-insert-file
12104               :input (expand-file-name default-directory)
12105               :prompt "Insert file: "
12106               :buffer "*Anything insert file*")))
12107
12108 ;;;###autoload
12109 (defun anything-dired-rename-file ()
12110   "Preconfigured `anything' to rename files from dired."
12111   (interactive)
12112   (anything-dired-do-action-on-file :action 'rename))
12113
12114 ;;;###autoload
12115 (defun anything-dired-copy-file ()
12116   "Preconfigured `anything' to copy files from dired."
12117   (interactive)
12118   (anything-dired-do-action-on-file :action 'copy))
12119
12120 ;;;###autoload
12121 (defun anything-dired-symlink-file ()
12122   "Preconfigured `anything' to symlink files from dired."
12123   (interactive)
12124   (anything-dired-do-action-on-file :action 'symlink))
12125
12126 ;;;###autoload
12127 (defun anything-dired-hardlink-file ()
12128   "Preconfigured `anything' to hardlink files from dired."
12129   (interactive)
12130   (anything-dired-do-action-on-file :action 'hardlink))
12131
12132 ;;;###autoload
12133 (defun anything-do-grep ()
12134   "Preconfigured anything for grep.
12135 Contrarily to Emacs `grep' no default directory is given, but
12136 the full path of candidates in ONLY.
12137 That allow to grep different files not only in `default-directory' but anywhere
12138 by marking them (C-<SPACE>). If one or more directory is selected
12139 grep will search in all files of these directories.
12140 You can use also wildcard in the base name of candidate.
12141 If a prefix arg is given use the -r option of grep.
12142 The prefix arg can be passed before or after start.
12143 See also `anything-do-grep-1'."
12144   (interactive)
12145   (let ((only    (anything-c-read-file-name
12146                   "Search in file(s): "
12147                   :marked-candidates t
12148                   :preselect (or (dired-get-filename nil t)
12149                                  (buffer-file-name (current-buffer)))))
12150         (prefarg (or current-prefix-arg anything-current-prefix-arg)))
12151     (anything-do-grep-1 only prefarg)))
12152
12153 ;;;###autoload
12154 (defun anything-do-zgrep ()
12155   "Preconfigured anything for zgrep."
12156   (interactive)
12157   (let ((prefarg (or current-prefix-arg anything-current-prefix-arg))
12158         (ls (anything-c-read-file-name
12159              "Search in file(s): "
12160              :marked-candidates t
12161              :preselect (or (dired-get-filename nil t)
12162                             (buffer-file-name (current-buffer))))))
12163     (anything-ff-zgrep-1 ls prefarg)))
12164
12165 ;;;###autoload
12166 (defun anything-do-pdfgrep ()
12167   "Preconfigured anything for pdfgrep."
12168   (interactive)
12169   (let ((only (anything-c-read-file-name
12170                "Search in file(s): "
12171                :marked-candidates t
12172                :test #'(lambda (file)
12173                          (or (string= (file-name-extension file) "pdf")
12174                              (string= (file-name-extension file) "PDF")
12175                              (file-directory-p file)))
12176                :preselect (or (dired-get-filename nil t)
12177                               (buffer-file-name (current-buffer)))))
12178         (anything-c-grep-default-function 'anything-c-pdfgrep-init))
12179     (anything-do-pdfgrep-1 only)))
12180
12181 ;;;###autoload
12182 (defun anything-c-etags-select (arg)
12183   "Preconfigured anything for etags.
12184 Called with one prefix arg use symbol at point as initial input.
12185 Called with two prefix arg reinitialize cache.
12186 If tag file have been modified reinitialize cache."
12187   (interactive "P")
12188   (let ((tag  (anything-c-etags-get-tag-file))
12189         (init (and (equal arg '(4)) (thing-at-point 'symbol)))
12190         (anything-quit-if-no-candidate t)
12191         (anything-execute-action-at-once-if-one t)
12192         (anything-compile-source-functions
12193          (if anything-c-etags-use-regexp-search
12194              ;; rule out anything-match-plugin because the input is one regexp.
12195              (delq 'anything-compile-source--match-plugin
12196                    (copy-sequence anything-compile-source-functions))
12197              anything-compile-source-functions)))
12198     (when (or (equal arg '(16))
12199               (and anything-c-etags-mtime-alist
12200                    (anything-c-etags-file-modified-p tag)))
12201       (remhash tag anything-c-etags-cache))
12202     (if (and tag (file-exists-p tag))
12203         (anything :sources 'anything-c-source-etags-select
12204                   :keymap anything-c-etags-map
12205                   :input init
12206                   :buffer "*anything etags*")
12207         (message "Error: No tag file found, please create one with etags shell command."))))
12208
12209 ;;;###autoload
12210 (defun anything-filelist ()
12211   "Preconfigured `anything' to open files instantly.
12212
12213 See `anything-c-filelist-file-name' docstring for usage."
12214   (interactive)
12215   (anything-other-buffer 'anything-c-source-filelist "*anything file list*"))
12216
12217 ;;;###autoload
12218 (defun anything-filelist+ ()
12219   "Preconfigured `anything' to open files/buffers/bookmarks instantly.
12220
12221 This is a replacement for `anything-for-files'.
12222 See `anything-c-filelist-file-name' docstring for usage."
12223   (interactive)
12224   (anything-other-buffer
12225    '(anything-c-source-ffap-line
12226      anything-c-source-ffap-guesser
12227      anything-c-source-buffers-list
12228      anything-c-source-recentf
12229      anything-c-source-bookmarks
12230      anything-c-source-file-cache
12231      anything-c-source-filelist)
12232    "*anything file list*"))
12233
12234 ;;;###autoload
12235 (defun anything-M-x ()
12236   "Preconfigured `anything' for Emacs commands.
12237 It is `anything' replacement of regular `M-x' `execute-extended-command'."
12238   (interactive)
12239   (let* (in-help
12240          help-cand
12241          special-display-buffer-names
12242          special-display-regexps
12243          anything-persistent-action-use-special-display
12244          (history (loop with hist
12245                         for i in extended-command-history
12246                         for com = (intern i)
12247                         when (fboundp com)
12248                         collect i into hist finally return hist)))
12249     (flet ((pers-help (candidate)
12250              (let ((hbuf (get-buffer (help-buffer))))
12251                (if (and in-help (string= candidate help-cand))
12252                    (progn
12253                      ;; When M-x is started from a help buffer,
12254                      ;; Don't kill it as it is anything-current-buffer.
12255                      (unless (equal hbuf anything-current-buffer)
12256                        (kill-buffer hbuf))
12257                      (setq in-help nil))
12258                    ;; Be sure anything-current-buffer
12259                    ;; have not a dedicated window.
12260                    (set-window-dedicated-p
12261                     (get-buffer-window anything-current-buffer) nil)
12262                    (describe-function (intern candidate))
12263                    (message nil) ; Erase the new stupid message Type "q"[...]
12264                    (setq in-help t))
12265                (setq help-cand candidate))))
12266       (let* ((command (anything-comp-read
12267                        "M-x " obarray
12268                        :test 'commandp
12269                        :requires-pattern anything-M-x-requires-pattern
12270                        :name "Emacs Commands"
12271                        :buffer "*anything M-x*"
12272                        :persistent-action 'pers-help
12273                        :persistent-help "Describe this command"
12274                        :history history
12275                        :must-match t
12276                        :candidates-in-buffer t
12277                        :fc-transformer 'anything-M-x-transformer))
12278              (sym-com (intern command)))
12279         (unless current-prefix-arg
12280           (setq current-prefix-arg anything-current-prefix-arg))
12281         ;; Avoid having `this-command' set to *exit-minibuffer.
12282         (setq this-command sym-com)
12283         (call-interactively sym-com)
12284         (setq extended-command-history
12285               (cons command (delete command history)))))))
12286
12287 ;;;###autoload
12288 (defun anything-manage-advice ()
12289   "Preconfigured `anything' to disable/enable function advices."
12290   (interactive)
12291   (anything-other-buffer 'anything-c-source-advice "*anything advice*"))
12292
12293 ;;;###autoload
12294 (defun anything-bookmark-ext ()
12295   "Preconfigured `anything' for bookmark-extensions sources.
12296 Needs bookmark-ext.el:
12297 <http://mercurial.intuxication.org/hg/emacs-bookmark-extension>.
12298 Contain also `anything-c-source-google-suggest'."
12299   (interactive)
12300   (anything
12301    :sources
12302    '(anything-c-source-bookmark-files&dirs
12303      anything-c-source-bookmark-w3m
12304      anything-c-source-google-suggest
12305      anything-c-source-bmkext-addressbook
12306      anything-c-source-bookmark-gnus
12307      anything-c-source-bookmark-info
12308      anything-c-source-bookmark-man
12309      anything-c-source-bookmark-images
12310      anything-c-source-bookmark-su-files&dirs
12311      anything-c-source-bookmark-ssh-files&dirs)
12312    :prompt "SearchBookmark: "
12313    :buffer "*anything bmkext*"))
12314
12315 ;;;###autoload
12316 (defun anything-simple-call-tree ()
12317   "Preconfigured `anything' for simple-call-tree. List function relationships.
12318
12319 Needs simple-call-tree.el.
12320 http://www.emacswiki.org/cgi-bin/wiki/download/simple-call-tree.el"
12321   (interactive)
12322   (anything-other-buffer
12323    '(anything-c-source-simple-call-tree-functions-callers
12324      anything-c-source-simple-call-tree-callers-functions)
12325    "*anything simple-call-tree*"))
12326
12327 ;;;###autoload
12328 (defun anything-mark-ring ()
12329   "Preconfigured `anything' for `anything-c-source-mark-ring'."
12330   (interactive)
12331   (anything :sources 'anything-c-source-mark-ring))
12332
12333 ;;;###autoload
12334 (defun anything-global-mark-ring ()
12335   "Preconfigured `anything' for `anything-c-source-global-mark-ring'."
12336   (interactive)
12337   (anything :sources 'anything-c-source-global-mark-ring))
12338
12339 ;;;###autoload
12340 (defun anything-all-mark-rings ()
12341   "Preconfigured `anything' for `anything-c-source-global-mark-ring' and \
12342 `anything-c-source-mark-ring'."
12343   (interactive)
12344   (anything :sources '(anything-c-source-mark-ring
12345                        anything-c-source-global-mark-ring)))
12346
12347 ;;;###autoload
12348 (defun anything-yaoddmuse-emacswiki-edit-or-view ()
12349   "Preconfigured `anything' to edit or view EmacsWiki page.
12350
12351 Needs yaoddmuse.el.
12352
12353 http://www.emacswiki.org/emacs/download/yaoddmuse.el"
12354   (interactive)
12355   (anything :sources 'anything-c-source-yaoddmuse-emacswiki-edit-or-view))
12356
12357 ;;;###autoload
12358 (defun anything-yaoddmuse-emacswiki-post-library ()
12359   "Preconfigured `anything' to post library to EmacsWiki.
12360
12361 Needs yaoddmuse.el.
12362
12363 http://www.emacswiki.org/emacs/download/yaoddmuse.el"
12364   (interactive)
12365   (anything :sources 'anything-c-source-yaoddmuse-emacswiki-post-library))
12366
12367 ;;;###autoload
12368 (defun anything-eval-expression (arg)
12369   "Preconfigured anything for `anything-c-source-evaluation-result'."
12370   (interactive "P")
12371   (anything :sources 'anything-c-source-evaluation-result
12372             :input (when arg (thing-at-point 'sexp))
12373             :buffer "*anything eval*"
12374             :history 'anything-eval-expression-input-history
12375             :keymap anything-eval-expression-map))
12376
12377 ;;;###autoload
12378 (defun anything-eval-expression-with-eldoc ()
12379   "Preconfigured anything for `anything-c-source-evaluation-result' with `eldoc' support. "
12380   (interactive)
12381   (declare (special eldoc-idle-delay))
12382   (let ((timer (run-with-idle-timer eldoc-idle-delay
12383                                     'repeat 'anything-eldoc-show-in-eval))
12384         (minibuffer-completing-symbol t) ; Enable lisp completion.
12385         (completion-cycle-threshold t))  ; Always cycle, no pesty completion buffer (emacs24 only).
12386     (unwind-protect
12387          (minibuffer-with-setup-hook
12388              'anything-eldoc-store-minibuffer
12389            (call-interactively 'anything-eval-expression))
12390       (and timer (cancel-timer timer))
12391       (setq anything-eldoc-active-minibuffers-list
12392             (cdr anything-eldoc-active-minibuffers-list)))))
12393
12394 ;;;###autoload
12395 (defun anything-calcul-expression ()
12396   "Preconfigured anything for `anything-c-source-calculation-result'."
12397   (interactive)
12398   (anything-other-buffer 'anything-c-source-calculation-result "*anything calcul*"))
12399
12400 ;;;###autoload
12401 (defun anything-surfraw (pattern engine)
12402   "Preconfigured `anything' to search PATTERN with search ENGINE."
12403   (interactive (list (read-string "SearchFor: "
12404                                   nil 'anything-surfraw-input-history)
12405                      (anything-comp-read
12406                       "Engine: "
12407                       (anything-c-build-elvi-list)
12408                       :must-match t
12409                       :name "Surfraw Search Engines"
12410                       :history anything-surfraw-engines-history)))
12411   (let* ((engine-nodesc (car (split-string engine)))
12412          (url (with-temp-buffer
12413                 (apply 'call-process "surfraw" nil t nil
12414                        ;;JAVE
12415                        (append  (list engine-nodesc "-p") (split-string pattern)))
12416                 (replace-regexp-in-string
12417                  "\n" "" (buffer-string))))
12418          (browse-url-browser-function (or anything-surfraw-default-browser-function
12419                                           browse-url-browser-function)))
12420     (if (string= engine-nodesc "W")
12421         (anything-c-browse-url anything-c-home-url)
12422         (anything-c-browse-url url)
12423         (setq anything-surfraw-engines-history
12424               (cons engine (delete engine anything-surfraw-engines-history))))))
12425
12426 ;;;###autoload
12427 (defun anything-call-source ()
12428   "Preconfigured `anything' to call anything source."
12429   (interactive)
12430   (anything :sources 'anything-c-source-call-source
12431             :buffer anything-source-select-buffer))
12432
12433 ;;;###autoload
12434 (defun anything-execute-anything-command ()
12435   "Preconfigured `anything' to execute preconfigured `anything'."
12436   (interactive)
12437   (anything-other-buffer 'anything-c-source-anything-commands
12438                          "*anything commands*"))
12439
12440 ;;;###autoload
12441 (defun anything-create (&optional string initial-input)
12442   "Preconfigured `anything' to do many create actions from STRING.
12443 See also `anything-create--actions'."
12444   (interactive)
12445   (setq string (or string (read-string "Create Anything: " initial-input)))
12446   (anything :sources '(((name . "Anything Create")
12447                         (header-name . (lambda (_) (format "Action for \"%s\"" string)))
12448                         (candidates . anything-create--actions)
12449                         (candidate-number-limit)
12450                         (action . (lambda (func) (funcall func string)))))))
12451
12452 ;;;###autoload
12453 (defun anything-top ()
12454   "Preconfigured `anything' for top command."
12455   (interactive)
12456   (let ((anything-samewindow t)
12457         (anything-enable-shortcuts)
12458         (anything-display-function 'anything-default-display-buffer)
12459         (anything-candidate-number-limit 9999))
12460     (save-window-excursion
12461       (delete-other-windows)
12462       (anything-other-buffer 'anything-c-source-top "*anything top*"))))
12463
12464 ;;;###autoload
12465 (defun anything-select-xfont ()
12466   "Preconfigured `anything' to select Xfont."
12467   (interactive)
12468   (anything-other-buffer 'anything-c-source-xfonts "*anything select* xfont"))
12469
12470 ;;;###autoload
12471 (defun anything-world-time ()
12472   "Preconfigured `anything' to show world time."
12473   (interactive)
12474   (anything-other-buffer 'anything-c-source-time-world "*anything world time*"))
12475
12476 ;;;###autoload
12477 (defun anything-apt (arg)
12478   "Preconfigured `anything' : frontend of APT package manager.
12479 With a prefix arg reload cache."
12480   (interactive "P")
12481   (let ((query (read-string "Search Package: " nil 'anything-c-apt-input-history)))
12482     (when arg (anything-c-apt-refresh))
12483     (anything :sources 'anything-c-source-apt
12484               :prompt "Search Package: "
12485               :input query
12486               :history 'anything-c-apt-input-history)))
12487
12488 ;;;###autoload
12489 (defun anything-esh-pcomplete ()
12490   "Preconfigured anything to provide anything completion in eshell."
12491   (interactive)
12492   (let* ((anything-quit-if-no-candidate t)
12493          (anything-execute-action-at-once-if-one t)
12494          (target (thing-at-point 'symbol))
12495          (end (point))
12496          (beg (or (and target (- end (length target)))
12497                   ;; Nothing at point.
12498                   (progn (insert " ") (point)))))
12499     (setq anything-ec-target (or target " "))
12500     (with-anything-show-completion beg end
12501       (anything :sources 'anything-c-source-esh
12502                 :buffer "*anything pcomplete*"
12503                 :input (anything-ff-set-pattern ; Handle tramp filenames.
12504                         (car (last (ignore-errors ; Needed in lisp symbols completion.
12505                                      (pcomplete-parse-arguments)))))))))
12506
12507 ;;;###autoload
12508 (defun anything-eshell-history ()
12509   "Preconfigured anything for eshell history."
12510   (interactive)
12511   (let* ((end (point))
12512          (beg (save-excursion (eshell-bol) (point)))
12513          (input (buffer-substring beg end))
12514          flag-empty)
12515     (when (eq beg end)
12516       (insert " ")
12517       (setq flag-empty t)
12518       (setq end (point)))
12519     (unwind-protect
12520          (with-anything-show-completion beg end
12521            (anything :sources 'anything-c-source-eshell-history
12522                      :buffer "*Eshell history*"
12523                      :input input))
12524       (when (and flag-empty
12525                  (looking-back " "))
12526         (delete-char -1)))))
12527
12528 ;;;###autoload
12529 (defun anything-c-run-external-command (program)
12530   "Preconfigured `anything' to run External PROGRAM asyncronously from Emacs.
12531 If program is already running exit with error.
12532 You can set your own list of commands with
12533 `anything-c-external-commands-list'."
12534   (interactive (list
12535                 (anything-comp-read
12536                  "RunProgram: "
12537                  (anything-c-external-commands-list-1 'sort)
12538                  :must-match t
12539                  :name "External Commands"
12540                  :history anything-external-command-history)))
12541   (anything-run-or-raise program)
12542   (setq anything-external-command-history
12543         (cons program (delete program
12544                               (loop for i in anything-external-command-history
12545                                     when (executable-find i) collect i)))))
12546
12547 ;;;###autoload
12548 (defun anything-ratpoison-commands ()
12549   "Preconfigured `anything' to execute ratpoison commands."
12550   (interactive)
12551   (anything-other-buffer 'anything-c-source-ratpoison-commands
12552                          "*anything ratpoison commands*"))
12553
12554 ;;;###autoload
12555 (defun anything-ucs ()
12556   "Preconfigured anything for `ucs-names' math symbols."
12557   (interactive)
12558   (anything :sources 'anything-c-source-ucs
12559             :keymap  anything-c-ucs-map))
12560
12561 ;;;###autoload
12562 (defun anything-c-apropos ()
12563   "Preconfigured anything to describe commands, functions, variables and faces."
12564   (interactive)
12565   (let ((default (thing-at-point 'symbol)))
12566     (anything :sources
12567               `(((name . "Commands")
12568                  (init . (lambda ()
12569                            (anything-c-apropos-init 'commandp ,default)))
12570                  (persistent-action . anything-lisp-completion-persistent-action)
12571                  (persistent-help . "Show brief doc in mode-line")
12572                  (candidates-in-buffer)
12573                  (action . (lambda (candidate)
12574                              (describe-function (intern candidate)))))
12575                 ((name . "Functions")
12576                  (init . (lambda ()
12577                            (anything-c-apropos-init #'(lambda (x) (and (fboundp x)
12578                                                                        (not (commandp x))))
12579                                                     ,default)))
12580                  (persistent-action . anything-lisp-completion-persistent-action)
12581                  (persistent-help . "Show brief doc in mode-line")
12582                  (candidates-in-buffer)
12583                  (action . (lambda (candidate)
12584                              (describe-function (intern candidate)))))
12585                 ((name . "Variables")
12586                  (init . (lambda ()
12587                            (anything-c-apropos-init 'boundp ,default)))
12588                  (persistent-action . anything-lisp-completion-persistent-action)
12589                  (persistent-help . "Show brief doc in mode-line")
12590                  (candidates-in-buffer)
12591                  (action . (lambda (candidate)
12592                              (describe-variable (intern candidate)))))
12593                 ((name . "Faces")
12594                  (init . (lambda ()
12595                            (anything-c-apropos-init 'facep ,default)))
12596                  (persistent-action . anything-lisp-completion-persistent-action)
12597                  (persistent-help . "Show brief doc in mode-line")
12598                  (candidates-in-buffer)
12599                  (filtered-candidate-transformer . (lambda (candidates source)
12600                                                      (loop for c in candidates
12601                                                            collect (propertize c 'face (intern c)))))
12602                  (action . (lambda (candidate)
12603                              (describe-face (intern candidate)))))
12604                 ((name . "Anything attributes")
12605                  (candidates . (lambda ()
12606                                  (mapcar 'symbol-name anything-additional-attributes)))
12607                  (action . (lambda (candidate)
12608                              (with-output-to-temp-buffer "*Help*"
12609                                (princ (get (intern candidate) 'anything-attrdoc))))))))))
12610
12611 ;;;###autoload
12612 (defun anything-xrandr-set ()
12613   (interactive)
12614   (anything :sources 'anything-c-source-xrandr-change-resolution
12615             :buffer "*anything xrandr*"))
12616
12617 ;;;###autoload
12618 (defun anything-ctags-current-file ()
12619   "Preconfigured `anything' to list function/variable definitions.
12620
12621 Needs Exuberant Ctags.
12622
12623 http://ctags.sourceforge.net/"
12624   (interactive)
12625   (anything :sources 'anything-c-source-ctags
12626             :buffer "*anything ctags*"))
12627 \f
12628 ;;; Unit tests are now in ../developer-tools/unit-test-anything-config.el.
12629
12630 (provide 'anything-config)
12631
12632 ;; Local Variables:
12633 ;; coding: utf-8
12634 ;; End:
12635
12636 ;;; anything-config.el ends here