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 (defvar minibuffer-inactive-mode-map (make-sparse-keymap))
1546 (dolist (map (list minibuffer-local-filename-completion-map
1547                    minibuffer-local-completion-map
1548                    minibuffer-local-must-match-filename-map
1549                    minibuffer-local-filename-must-match-map
1550                    minibuffer-local-map
1551                    minibuffer-local-isearch-map
1552                    minibuffer-local-must-match-map
1553                    minibuffer-local-ns-map
1554                    minibuffer-inactive-mode-map
1555                    minibuffer-local-shell-command-map))
1556   (define-key map "\C-r" 'anything-minibuffer-history))
1557
1558
1559 \f
1560 ;;; Menu
1561 ;;
1562 ;;
1563 (easy-menu-define nil global-map
1564   "`anything' menu"
1565   '("Anything"
1566     ["All anything commands" anything-execute-anything-command t]
1567     ["Find any Files/Buffers" anything-for-files t]
1568     ["Anything Everywhere (Toggle)" ac-mode t]
1569     "----"
1570     ("Files:"
1571      ["Find files" anything-find-files t]
1572      ["Recent Files" anything-recentf t]
1573      ["Locate" anything-locate t]
1574      ["Bookmarks" anything-c-pp-bookmarks t])
1575     ("Buffers:"
1576      ["Find buffers" anything-buffers-list t])
1577     ("Commands:"
1578      ["Emacs Commands" anything-M-x t]
1579      ["Externals Commands" anything-c-run-external-command t])
1580     ("Help:"
1581      ["Anything Apropos" anything-c-apropos t])
1582     ("Info:"
1583      ["Info at point" anything-info-at-point t]
1584      ["Emacs Manual index" anything-info-emacs t]
1585      ["Gnus Manual index" anything-info-gnus t])
1586     ("Org:"
1587      ["Org keywords" anything-org-keywords t]
1588      ["Org headlines" anything-org-headlines t])
1589     ("Tools:"
1590      ["Occur" anything-occur t]
1591      ["Grep" anything-do-grep t]
1592      ["Etags" anything-c-etags-select t]
1593      ["Lisp complete at point" anything-lisp-completion-at-point t]
1594      ["Browse Kill ring" anything-show-kill-ring t]
1595      ["Browse register" anything-register t]
1596      ["Browse code" anything-browse-code t]
1597      ["Mark Ring" anything-all-mark-rings t]
1598      ["Regexp handler" anything-regexp t]
1599      ["Colors & Faces" anything-colors t]
1600      ["Show xfonts" anything-select-xfont t]
1601      ["Ucs Symbols" anything-ucs t]
1602      ["Imenu" anything-imenu t]
1603      ["Google Suggest" anything-google-suggest t]
1604      ["Eval expression" anything-eval-expression-with-eldoc t]
1605      ["Calcul expression" anything-calcul-expression t]
1606      ["Man pages" anything-man-woman t]
1607      ["Top externals process" anything-top t]
1608      ["Emacs internals process" anything-list-emacs-process t])
1609     "----"
1610     ["Prefered Options" anything-configuration t]))
1611
1612 ;;; Anything map add ons
1613 ;;
1614 ;;
1615 (define-key anything-map (kbd "C-x C-f") 'anything-quit-and-find-file)
1616 (define-key anything-map (kbd "M-m")     'anything-toggle-all-marks)
1617 (define-key anything-map (kbd "C-w")     'anything-yank-text-at-point)
1618
1619 \f
1620 ;;; Specialized keymaps
1621 ;;
1622 ;;
1623 (defun anything-c-make-child-map (parent)
1624   (let ((map (make-sparse-keymap)))
1625     (set-keymap-parent map parent)
1626     map))
1627
1628 (defvar anything-c-buffer-map
1629   (let ((map (anything-c-make-child-map anything-map)))
1630     (define-key map (kbd "C-c ?")     'anything-c-buffer-help)
1631     ;; No need to have separate command for grep and zgrep
1632     ;; as we don't use recursivity for buffers.
1633     ;; So use zgrep for both as it is capable to handle non--compressed files.
1634     (define-key map (kbd "M-g s")     'anything-buffer-run-zgrep)
1635     (define-key map (kbd "C-c o")     'anything-buffer-switch-other-window)
1636     (define-key map (kbd "C-c C-o")   'anything-buffer-switch-other-frame)
1637     (define-key map (kbd "C-c =")     'anything-buffer-run-ediff)
1638     (define-key map (kbd "M-=")       'anything-buffer-run-ediff-merge)
1639     (define-key map (kbd "C-=")       'anything-buffer-diff-persistent)
1640     (define-key map (kbd "M-U")       'anything-buffer-revert-persistent)
1641     (define-key map (kbd "M-D")       'anything-buffer-run-kill-buffers)
1642     (define-key map (kbd "C-x C-s")   'anything-buffer-save-persistent)
1643     (define-key map (kbd "C-M-%")     'anything-buffer-run-query-replace-regexp)
1644     (define-key map (kbd "M-%")       'anything-buffer-run-query-replace)
1645     (define-key map (kbd "M-m")       'anything-toggle-all-marks)
1646     (define-key map (kbd "M-a")       'anything-mark-all)
1647     (when (locate-library "elscreen")
1648       (define-key map (kbd "<C-tab>") 'anything-buffer-switch-to-elscreen))
1649     (delq nil map))
1650   "Keymap for buffer sources in anything.")
1651
1652 (defvar anything-find-files-map
1653   (let ((map (anything-c-make-child-map anything-map)))
1654     (define-key map (kbd "C-]")           'anything-ff-run-toggle-basename)
1655     (define-key map (kbd "C-x C-f")       'anything-ff-run-locate)
1656     (define-key map (kbd "M-g s")         'anything-ff-run-grep)
1657     (define-key map (kbd "M-g p")         'anything-ff-run-pdfgrep)
1658     (define-key map (kbd "M-g z")         'anything-ff-run-zgrep)
1659     (define-key map (kbd "M-.")           'anything-ff-run-etags)
1660     (define-key map (kbd "M-R")           'anything-ff-run-rename-file)
1661     (define-key map (kbd "M-C")           'anything-ff-run-copy-file)
1662     (define-key map (kbd "M-B")           'anything-ff-run-byte-compile-file)
1663     (define-key map (kbd "M-L")           'anything-ff-run-load-file)
1664     (define-key map (kbd "M-S")           'anything-ff-run-symlink-file)
1665     (define-key map (kbd "M-H")           'anything-ff-run-hardlink-file)
1666     (define-key map (kbd "M-D")           'anything-ff-run-delete-file)
1667     (define-key map (kbd "M-K")           'anything-ff-run-kill-buffer-persistent)
1668     (define-key map (kbd "C-d")           'anything-ff-persistent-delete)
1669     (define-key map (kbd "M-e")           'anything-ff-run-switch-to-eshell)
1670     (define-key map (kbd "<M-tab>")       'anything-ff-run-complete-fn-at-point)
1671     (define-key map (kbd "C-c o")         'anything-ff-run-switch-other-window)
1672     (define-key map (kbd "C-c C-o")       'anything-ff-run-switch-other-frame)
1673     (define-key map (kbd "C-c C-x")       'anything-ff-run-open-file-externally)
1674     (define-key map (kbd "M-!")           'anything-ff-run-eshell-command-on-file)
1675     (define-key map (kbd "C-=")           'anything-ff-run-ediff-file)
1676     (define-key map (kbd "C-c =")         'anything-ff-run-ediff-merge-file)
1677     (define-key map (kbd "M-p")           'anything-ff-run-switch-to-history)
1678     (define-key map (kbd "M-i")           'anything-ff-properties-persistent)
1679     (define-key map (kbd "C-c ?")         'anything-ff-help)
1680     (define-key map (kbd "C-}")           'anything-narrow-window)
1681     (define-key map (kbd "C-{")           'anything-enlarge-window)
1682     (define-key map (kbd "C-<backspace>") 'anything-ff-run-toggle-auto-update)
1683     (define-key map (kbd "M-a")           'anything-mark-all)
1684     (define-key map (kbd "M-m")           'anything-toggle-all-marks)
1685     (define-key map (kbd "M-u")           'anything-unmark-all)
1686     (define-key map (kbd "C-c C-a")       'anything-ff-run-gnus-attach-files)
1687     (define-key map (kbd "C-c p")         'anything-ff-run-print-file)
1688     ;; Next 2 have no effect if candidate is not an image file.
1689     (define-key map (kbd "M-l")           'anything-ff-rotate-left-persistent)
1690     (define-key map (kbd "M-r")           'anything-ff-rotate-right-persistent)
1691     (define-key map (kbd "C-.")           'anything-find-files-down-one-level)
1692     (define-key map (kbd "C-l")           'anything-find-files-down-one-level)
1693     (define-key map (kbd "C-h C-b")       'anything-send-bug-report-from-anything)
1694     (define-key map (kbd "C-h C-d")       'anything-debug-output)
1695     (when anything-ff-lynx-style-map
1696       (define-key map (kbd "<left>")      'anything-find-files-down-one-level)
1697       (define-key map (kbd "<right>")     'anything-execute-persistent-action))
1698     (delq nil map))
1699   "Keymap for `anything-find-files'.")
1700
1701 (defvar anything-c-read-file-map
1702   (let ((map (anything-c-make-child-map anything-map)))
1703     (define-key map (kbd "C-]")           'anything-ff-run-toggle-basename)
1704     (define-key map (kbd "C-.")           'anything-find-files-down-one-level)
1705     (define-key map (kbd "C-l")           'anything-find-files-down-one-level)
1706     (define-key map (kbd "C-<backspace>") 'anything-ff-run-toggle-auto-update)
1707     (define-key map (kbd "C-c ?")         'anything-read-file-name-help)
1708     (when anything-ff-lynx-style-map
1709       (define-key map (kbd "<left>")      'anything-find-files-down-one-level)
1710       (define-key map (kbd "<right>")     'anything-execute-persistent-action)
1711       (define-key map (kbd "C-o")         nil)
1712       (define-key map (kbd "<M-left>")    'anything-previous-source)
1713       (define-key map (kbd "<M-right>")   'anything-next-source))
1714     (delq nil map))
1715   "Keymap for `anything-c-read-file-name'.")
1716
1717 (defvar anything-generic-files-map
1718   (let ((map (anything-c-make-child-map anything-map)))
1719     (define-key map (kbd "M-g s")   'anything-ff-run-grep)
1720     (define-key map (kbd "M-g z")   'anything-ff-run-zgrep)
1721     (define-key map (kbd "M-g p")   'anything-ff-run-pdfgrep)
1722     (define-key map (kbd "M-D")     'anything-ff-run-delete-file)
1723     (define-key map (kbd "C-=")     'anything-ff-run-ediff-file)
1724     (define-key map (kbd "C-c =")   'anything-ff-run-ediff-merge-file)
1725     (define-key map (kbd "C-c o")   'anything-ff-run-switch-other-window)
1726     (define-key map (kbd "M-i")     'anything-ff-properties-persistent)
1727     (define-key map (kbd "C-c C-x") 'anything-ff-run-open-file-externally)
1728     (define-key map (kbd "C-w")     'anything-yank-text-at-point)
1729     (define-key map (kbd "C-c ?")   'anything-generic-file-help)
1730     map)
1731   "Generic Keymap for files.")
1732
1733 (defvar anything-c-grep-map
1734   (let ((map (anything-c-make-child-map anything-map)))
1735     (define-key map (kbd "M-<down>") 'anything-c-goto-next-file)
1736     (define-key map (kbd "M-<up>")   'anything-c-goto-precedent-file)
1737     (define-key map (kbd "C-c o")    'anything-c-grep-run-other-window-action)
1738     (define-key map (kbd "C-w")      'anything-yank-text-at-point)
1739     (define-key map (kbd "C-x C-s")  'anything-c-grep-run-save-buffer)
1740     (when anything-c-grep-use-ioccur-style-keys
1741       (define-key map (kbd "<right>")  'anything-c-grep-run-persistent-action)
1742       (define-key map (kbd "<left>")  'anything-c-grep-run-default-action))
1743     (define-key map (kbd "C-c ?")    'anything-grep-help)
1744     (delq nil map))
1745   "Keymap used in Grep sources.")
1746
1747 (defvar anything-c-pdfgrep-map
1748   (let ((map (anything-c-make-child-map anything-map)))
1749     (define-key map (kbd "M-<down>") 'anything-c-goto-next-file)
1750     (define-key map (kbd "M-<up>")   'anything-c-goto-precedent-file)
1751     (define-key map (kbd "C-w")      'anything-yank-text-at-point)
1752     (define-key map (kbd "C-c ?")    'anything-pdfgrep-help)
1753     map)
1754   "Keymap used in pdfgrep.")
1755
1756 (defvar anything-c-etags-map
1757   (let ((map (anything-c-make-child-map anything-map)))
1758     (define-key map (kbd "M-<down>") 'anything-c-goto-next-file)
1759     (define-key map (kbd "M-<up>")   'anything-c-goto-precedent-file)
1760     (define-key map (kbd "C-w")      'anything-yank-text-at-point)
1761     (define-key map (kbd "C-c ?")    'anything-etags-help)
1762     map)
1763   "Keymap used in Etags.")
1764
1765 (defvar anything-eval-expression-map
1766   (let ((map (anything-c-make-child-map anything-map)))
1767     (define-key map (kbd "<C-return>") 'anything-eval-new-line-and-indent)
1768     (define-key map (kbd "<tab>")      'lisp-indent-line)
1769     (define-key map (kbd "<C-tab>")    'lisp-complete-symbol)
1770     (define-key map (kbd "C-p")        'previous-line)
1771     (define-key map (kbd "C-n")        'next-line)
1772     (define-key map (kbd "<up>")       'previous-line)
1773     (define-key map (kbd "<down>")     'next-line)
1774     (define-key map (kbd "<right>")    'forward-char)
1775     (define-key map (kbd "<left>")     'backward-char)
1776     map))
1777
1778 (defvar anything-c-ucs-map
1779   (let ((map (anything-c-make-child-map anything-map)))
1780     (define-key map (kbd "<C-backspace>") 'anything-c-ucs-persistent-delete)
1781     (define-key map (kbd "<C-left>")      'anything-c-ucs-persistent-backward)
1782     (define-key map (kbd "<C-right>")     'anything-c-ucs-persistent-forward)
1783     (define-key map (kbd "<C-return>")    'anything-c-ucs-persistent-insert)
1784     (define-key map (kbd "C-c ?")         'anything-c-ucs-help)
1785     map)
1786   "Keymap for `anything-ucs'.")
1787
1788 (defvar anything-c-bookmark-map
1789   (let ((map (anything-c-make-child-map anything-map)))
1790     (define-key map (kbd "C-c o") 'anything-c-bookmark-run-jump-other-window)
1791     (define-key map (kbd "C-d")   'anything-c-bookmark-run-delete)
1792     (when (locate-library "bookmark-extensions")
1793       (define-key map (kbd "M-e") 'anything-c-bmkext-run-edit))
1794     (define-key map (kbd "C-c ?") 'anything-c-bookmark-help)
1795     (delq nil map))
1796   "Generic Keymap for emacs bookmark sources.")
1797
1798 (defvar anything-esh-on-file-map
1799   (let ((map (anything-c-make-child-map anything-map)))
1800     (define-key map (kbd "C-c ?")    'anything-esh-help)
1801     map)
1802   "Keymap for `anything-find-files-eshell-command-on-file'.")
1803
1804 (defvar anything-eshell-history-map
1805   (let ((map (anything-c-make-child-map anything-map)))
1806     (define-key map (kbd "M-p") 'anything-next-line)
1807     map)
1808   "Keymap for `anything-eshell-history'.")
1809
1810 (defvar anything-kill-ring-map
1811   (let ((map (anything-c-make-child-map anything-map)))
1812     (define-key map (kbd "M-y") 'anything-next-line)
1813     (define-key map (kbd "M-u") 'anything-previous-line)
1814     map)
1815   "Keymap for `anything-show-kill-ring'.")
1816
1817 (defvar anything-occur-map
1818   (let ((map (anything-c-make-child-map anything-map)))
1819     (define-key map (kbd "C-M-%") 'anything-occur-run-query-replace-regexp)
1820     map)
1821   "Keymap for `anything-occur'.")
1822
1823 \f
1824 ;;; Embeded documentation.
1825 ;;
1826 ;;
1827 (defun anything-c-list-preconfigured-anything ()
1828   "Collect preconfigured anything functions in this file."
1829   (loop with doc
1830         with sym
1831         for entry in (cdr (assoc
1832                            (file-truename (locate-library "anything-config"))
1833                            load-history))
1834         if (and (consp entry)
1835                 (eq (car entry) 'defun)
1836                 (string-match "^Preconfigured.+$"
1837                               (setq doc (or (documentation (setq sym (cdr entry)))
1838                                             ""))))
1839         collect (cons sym (match-string 0 doc))))
1840
1841 (defun anything-c-format-preconfigured-anything ()
1842   (mapcar (lambda (x) (format "\\[%s] : %s\n" (car x) (cdr x)))
1843           (anything-c-list-preconfigured-anything)))
1844
1845 ;;; Global help message - Used by `anything-help'
1846 ;;
1847 ;;
1848 (setq anything-help-message
1849       (lambda ()
1850         (concat
1851          "\\<anything-map>"
1852          "`anything' is QuickSilver-like candidate-selection framework.
1853
1854 Narrow the list by typing some pattern,
1855 Multiple patterns are allowed by splitting by space.
1856 Select with natural Emacs operations, choose with RET.
1857
1858 If you have any problems, press C-c C-x C-b!!
1859 Feel free to send bug reports. I'll fix them.
1860 The steps are described in the beginning of anything.el file.
1861
1862 == Basic Operations ==
1863 C-p, Up: Previous Line
1864 C-n, Down : Next Line
1865 M-v, PageUp : Previous Page
1866 C-v, PageDown : Next Page
1867 Enter : Execute first (default) action / Select
1868 M-< : First Line
1869 M-> : Last Line
1870 M-PageUp, C-M-S-v, C-M-y : Previous Page (other-window)
1871 M-PageDown, C-M-v : Next Page (other-window)
1872
1873 Tab, C-i : Show action list
1874 Left : Previous Source
1875 Right, C-o : Next Source
1876 C-k : Delete pattern
1877 C-z : Persistent Action (Execute action with anything session kept)
1878 C-c C-x C-b: Send a bug report
1879
1880 == Shortcuts For 2nd/3rd Action ==
1881 \\[anything-select-2nd-action-or-end-of-line] : Execute 2nd Action (if the minibuffer cursor is at end of line)
1882 \\[anything-select-3rd-action] : Execute 3rd Action
1883
1884 == Visible Marks ==
1885 Visible marks store candidate. Some actions uses marked candidates.
1886
1887 \\[anything-toggle-visible-mark] : Toggle Visible Mark
1888 \\[anything-prev-visible-mark] : Previous Mark
1889 \\[anything-next-visible-mark] : Next Mark
1890
1891 == Miscellaneous Commands ==
1892 \\[anything-toggle-resplit-window] : Toggle vertical/horizontal split anything window
1893 \\[anything-quit-and-find-file] : Drop into `find-file'
1894 \\[anything-delete-current-selection] : Delete Selected Item (visually)
1895 \\[anything-kill-selection-and-quit] : Set Item Into the kill-ring And Quit
1896 \\[anything-yank-selection] : Yank Selected Item Into Pattern
1897 \\[anything-follow-mode] : Toggle Automatical Execution Of Persistent Action
1898 \\[anything-force-update] : Recalculate And Redisplay Candidates
1899
1900 == Global Commands ==
1901 \\<global-map>\\[anything-resume] revives last `anything' session.
1902 It is very useful, so you should bind any key.
1903
1904 Single source is executed by \\[anything-call-source].
1905
1906 == Preconfigured `anything' ==
1907 Preconfigured `anything' is commands that uses `anything' interface.
1908 You can use them without configuration.
1909
1910 "
1911          (apply 'concat (anything-c-format-preconfigured-anything))
1912          "
1913 Enjoy!")))
1914
1915 ;;; `anything-buffer-list' help
1916 ;;
1917 ;;
1918 (defvar anything-c-buffer-help-message
1919   "== Anything Buffer ==
1920 \nTips:
1921 You can enter a partial name of major-mode (e.g lisp, sh) to narrow down buffers.
1922 Enter then a space and a pattern to narrow down to buffers matching this pattern.
1923 \nSpecific commands for `anything-buffers-list':
1924 \\<anything-c-buffer-map>
1925 \\[anything-buffer-run-zgrep]\t\t->Grep Buffer(s) works as zgrep too. (C-u grep all buffers but non--file buffers).
1926 \\[anything-buffer-switch-other-window]\t\t->Switch other window.
1927 \\[anything-buffer-switch-other-frame]\t\t->Switch other frame.
1928 \\[anything-buffer-run-query-replace-regexp]\t\t->Query replace regexp in marked buffers.
1929 \\[anything-buffer-run-query-replace]\t\t->Query replace in marked buffers.
1930 \\[anything-buffer-switch-to-elscreen]\t\t->Find buffer in Elscreen.
1931 \\[anything-buffer-run-ediff]\t\t->Ediff current buffer with candidate.  If two marked buffers ediff those buffers.
1932 \\[anything-buffer-run-ediff-merge]\t\t->Ediff merge current buffer with candidate.  If two marked buffers ediff merge those buffers.
1933 \\[anything-buffer-diff-persistent]\t\t->Toggle Diff buffer with saved file without quitting.
1934 \\[anything-buffer-revert-persistent]\t\t->Revert buffer without quitting.
1935 \\[anything-buffer-save-persistent]\t\t->Save buffer without quitting.
1936 \\[anything-buffer-run-kill-buffers]\t\t->Delete marked buffers and quit.
1937 \\[anything-toggle-all-marks]\t\t->Toggle all marks.
1938 \\[anything-mark-all]\t\t->Mark all.
1939 \\[anything-c-buffer-help]\t\t->Display this help.
1940 \n== Anything Map ==
1941 \\{anything-map}")
1942
1943 ;;;###autoload
1944 (defun anything-c-buffer-help ()
1945   "Help command for anything buffers."
1946   (interactive)
1947   (let ((anything-help-message anything-c-buffer-help-message))
1948     (anything-help)))
1949
1950 ;;; Find files help (`anything-find-files')
1951 ;;
1952 ;;
1953 (defvar anything-ff-help-message
1954   "== Anything Find Files ==
1955 \nTips:
1956 \n- Enter `~/' at end of pattern to quickly reach home directory.
1957 - Enter `/' at end of pattern to quickly reach root of your file system.
1958 - Enter `./' at end of pattern to quickly reach `default-directory' (initial start of session).
1959 - You can complete with partial basename \(e.g \"fb\" will complete \"foobar\"\).
1960 - Use `C-u C-z' to watch an image.
1961 - To browse images directories turn on `anything-follow-mode' and navigate with arrow keys.
1962 - When entered ediff, hitting `C-g' will ask you to use locate to find the file to ediff with.
1963
1964 \nSpecific commands for `anything-find-files':
1965 \\<anything-find-files-map>
1966 \\[anything-ff-run-locate]\t\t->Run Locate on basename of candidate (C-u to specify locate db).
1967 \\[anything-ff-run-grep]\t\t->Run Grep (C-u Recursive).
1968 \\[anything-ff-run-pdfgrep]\t\t->Run Pdfgrep on marked files.
1969 \\[anything-ff-run-zgrep]\t\t->Run zgrep (C-u Recursive).
1970 \\[anything-ff-run-etags]\t\t->Run Etags (C-u use thing-at-point `C-u C-u' reload cache)
1971 \\[anything-ff-run-rename-file]\t\t->Rename File (C-u Follow).
1972 \\[anything-ff-run-copy-file]\t\t->Copy File (C-u Follow).
1973 \\[anything-ff-run-byte-compile-file]\t\t->Byte Compile File (C-u Load).
1974 \\[anything-ff-run-load-file]\t\t->Load File.
1975 \\[anything-ff-run-symlink-file]\t\t->Symlink File.
1976 \\[anything-ff-run-hardlink-file]\t\t->Hardlink file.
1977 \\[anything-ff-run-delete-file]\t\t->Delete File.
1978 \\[anything-ff-run-kill-buffer-persistent]\t\t->Kill buffer candidate without quitting.
1979 \\[anything-ff-persistent-delete]\t\t->Delete file without quitting.
1980 \\[anything-ff-run-switch-to-eshell]\t\t->Switch to Eshell.
1981 \\[anything-ff-run-eshell-command-on-file]\t\t->Eshell command on file (C-u Run on all marked files at once).
1982 \\[anything-ff-run-ediff-file]\t\t->Ediff file.
1983 \\[anything-ff-run-ediff-merge-file]\t\t->Ediff merge file.
1984 \\[anything-ff-run-complete-fn-at-point]\t\t->Complete file name at point.
1985 \\[anything-ff-run-switch-other-window]\t\t->Switch other window.
1986 \\[anything-ff-run-switch-other-frame]\t\t->Switch other frame.
1987 \\[anything-ff-run-open-file-externally]\t\t->Open file with external program (C-u to choose).
1988 \\[anything-ff-rotate-left-persistent]\t\t->Rotate Image Left.
1989 \\[anything-ff-rotate-right-persistent]\t\t->Rotate Image Right.
1990 \\[anything-find-files-down-one-level]\t\t->Go down precedent directory.
1991 \\[anything-ff-run-switch-to-history]\t\t->Switch to anything find-files history.
1992 \\[anything-ff-properties-persistent]\t\t->Show file properties in a tooltip.
1993 \\[anything-mark-all]\t\t->Mark all visibles candidates.
1994 \\[anything-ff-run-toggle-auto-update]\t->Toggle auto expansion of directories.
1995 \\[anything-unmark-all]\t\t->Unmark all candidates, visibles and invisibles.
1996 \\[anything-ff-run-gnus-attach-files]\t\t->Gnus attach files to message buffer.
1997 \\[anything-ff-run-print-file]\t\t->Print file, (C-u to refresh printers list).
1998 \\[anything-enlarge-window]\t\t->Enlarge anything window.
1999 \\[anything-narrow-window]\t\t->Narrow anything window.
2000 \\[anything-ff-run-toggle-basename]\t\t->Toggle basename/fullpath.
2001 \\[anything-send-bug-report-from-anything]\t\t->Send Bug report.
2002 \\[anything-ff-help]\t\t->Display this help info.
2003 \n== Anything Map ==
2004 \\{anything-map}")
2005
2006 ;;;###autoload
2007 (defun anything-ff-help ()
2008   "Help command for `anything-find-files'."
2009   (interactive)
2010   (let ((anything-help-message anything-ff-help-message))
2011     (anything-help)))
2012
2013 ;;; Help for `anything-c-read-file-name'
2014 ;;
2015 ;;
2016 (defvar anything-read-file-name-help-message
2017   "== Anything read file name Map ==\
2018 \nSpecific commands for anything-c-read-file-name:
2019 \\<anything-c-read-file-map>
2020 \\[anything-find-files-down-one-level]\t\t->Go down precedent directory.
2021 \\[anything-ff-run-toggle-auto-update]\t->Toggle auto expansion of directories.
2022 \\[anything-next-source]\t->Goto next source.
2023 \\[anything-previous-source]\t->Goto previous source.
2024 \\[anything-read-file-name-help]\t\t->Display this help info.
2025 \n== Anything Map ==
2026 \\{anything-map}")
2027
2028 ;;;###autoload
2029 (defun anything-read-file-name-help ()
2030   (interactive)
2031   (let ((anything-help-message anything-read-file-name-help-message))
2032     (anything-help)))
2033
2034 ;;; Generic file help - Used by locate.
2035 ;;
2036 ;;
2037 (defvar anything-generic-file-help-message
2038   "== Anything Generic files Map ==\
2039 \nSpecific commands for anything locate and others files sources:
2040 \\<anything-generic-files-map>
2041 \\[anything-ff-run-grep]\t\t->Run grep (C-u recurse).
2042 \\[anything-ff-run-pdfgrep]\t\t->Run Pdfgrep on marked files.
2043 \\[anything-ff-run-delete-file]\t\t->Delete file.
2044 \\[anything-ff-run-ediff-file]\t\t->Ediff file.
2045 \\[anything-ff-run-ediff-merge-file]\t\t->Ediff merge file.
2046 \\[anything-ff-run-switch-other-window]\t\t->Switch other window.
2047 \\[anything-ff-properties-persistent]\t\t->Show file properties.
2048 \\[anything-yank-text-at-point]\t\t->Yank text at point.
2049 \\[anything-ff-run-open-file-externally]\t\t->Open file with external program (C-u to choose).
2050 \nLocate tips:
2051 You can add after writing search pattern any of the locate command line options.
2052 e.g -b, -e, -n <number>...etc.
2053 See Man locate for more infos.
2054 \n== Anything Map ==
2055 \\{anything-map}")
2056
2057 ;;;###autoload
2058 (defun anything-generic-file-help ()
2059   (interactive)
2060   (let ((anything-help-message anything-generic-file-help-message))
2061     (anything-help)))
2062
2063 ;;; Grep help
2064 ;;
2065 ;;
2066 (defvar anything-grep-help-message
2067   "== Anything Grep Map ==\
2068 \nAnything Grep tips:
2069 You can start grep with a prefix arg to recurse in subdirectories.
2070 You can use wild card when selecting files (e.g *.el)
2071 You can grep in many differents directories by marking files or wild cards.
2072 You can save your results in a grep-mode buffer, see below.
2073
2074 \nSpecific commands for Anything Grep:
2075 \\<anything-c-grep-map>
2076 \\[anything-c-goto-next-file]\t->Next File.
2077 \\[anything-c-goto-precedent-file]\t\t->Precedent File.
2078 \\[anything-yank-text-at-point]\t\t->Yank Text at point in minibuffer.
2079 \\[anything-c-grep-run-other-window-action]\t\t->Jump other window.
2080 \\[anything-c-grep-run-persistent-action]\t\t->Run persistent action (Same as `C-z').
2081 \\[anything-c-grep-run-default-action]\t\t->Run default action (Same as RET).
2082 \\[anything-c-grep-run-save-buffer]\t\t->Save to a `grep-mode' enabled buffer.
2083 \\[anything-grep-help]\t\t->Show this help.
2084 \n== Anything Map ==
2085 \\{anything-map}")
2086
2087 ;;;###autoload
2088 (defun anything-grep-help ()
2089   (interactive)
2090   (let ((anything-help-message anything-grep-help-message))
2091     (anything-help)))
2092
2093 ;;; Pdf grep help
2094 ;;
2095 ;;
2096 (defvar anything-pdfgrep-help-message
2097   "== Anything PdfGrep Map ==\
2098 \nSpecific commands for Pdf Grep:
2099 \\<anything-c-pdfgrep-map>
2100 \\[anything-c-goto-next-file]\t->Next File.
2101 \\[anything-c-goto-precedent-file]\t\t->Precedent File.
2102 \\[anything-yank-text-at-point]\t\t->Yank Text at point in minibuffer.
2103 \\[anything-pdfgrep-help]\t\t->Show this help.
2104 \n== Anything Map ==
2105 \\{anything-map}")
2106
2107 ;;;###autoload
2108 (defun anything-pdfgrep-help ()
2109   (interactive)
2110   (let ((anything-help-message anything-pdfgrep-help-message))
2111     (anything-help)))
2112
2113 ;;; Etags help
2114 ;;
2115 ;;
2116 (defvar anything-etags-help-message
2117   "== Anything Etags Map ==\
2118 \nSpecific commands for Etags:
2119 \\<anything-c-etags-map>
2120 \\[anything-c-goto-next-file]\t->Next File.
2121 \\[anything-c-goto-precedent-file]\t\t->Precedent File.
2122 \\[anything-yank-text-at-point]\t\t->Yank Text at point in minibuffer.
2123 \\[anything-etags-help]\t\t->Show this help.
2124 \n== Anything Map ==
2125 \\{anything-map}")
2126
2127 ;;;###autoload
2128 (defun anything-etags-help ()
2129   "The help function for etags."
2130   (interactive)
2131   (let ((anything-help-message anything-etags-help-message))
2132     (anything-help)))
2133
2134 ;;; Ucs help
2135 ;;
2136 ;;
2137 (defvar anything-c-ucs-help-message
2138   "== Anything Ucs ==
2139 \nSpecific commands for `anything-ucs':
2140 \\<anything-c-ucs-map>
2141 \\[anything-c-ucs-persistent-insert]\t->Insert char.
2142 \\[anything-c-ucs-persistent-forward]\t->Forward char.
2143 \\[anything-c-ucs-persistent-backward]\t->Backward char.
2144 \\[anything-c-ucs-persistent-delete]\t->Delete char backward.
2145 \\[anything-c-ucs-help]\t\t->Show this help.
2146
2147 \n== Anything Map ==
2148 \\{anything-map}")
2149
2150 (defun anything-c-ucs-help ()
2151   "Help command for `anything-ucs'."
2152   (interactive)
2153   (let ((anything-help-message anything-c-ucs-help-message))
2154     (anything-help)))
2155
2156 ;;; Bookmark help
2157 ;;
2158 ;;
2159 (defvar anything-bookmark-help-message
2160   "== Anything bookmark name Map ==\
2161 \nSpecific commands for bookmarks:
2162 \\<anything-c-bookmark-map>
2163 \\[anything-c-bookmark-run-jump-other-window]\t\t->Jump other window.
2164 \\[anything-c-bookmark-run-delete]\t\t->Delete bookmark.
2165 \\[anything-c-bmkext-run-edit]\t\t->Edit bookmark (only for bmkext).
2166 \\[anything-c-bookmark-help]\t\t->Run this help.
2167 \n== Anything Map ==
2168 \\{anything-map}")
2169
2170 (defun anything-c-bookmark-help ()
2171   "Help command for bookmarks."
2172   (interactive)
2173   (let ((anything-help-message anything-bookmark-help-message))
2174     (anything-help)))
2175
2176 ;;; Eshell command on file help
2177 ;;
2178 ;;
2179 (defvar anything-c-esh-help-message
2180   "== Anything eshell on file ==
2181 \nTips:
2182
2183 - Passing extra args after filename:
2184
2185 Normally your command or alias will be called with file as argument.
2186
2187 e.g <command> 'candidate_file'
2188
2189 But you can also pass an argument or more after 'candidate_file' like this:
2190
2191 <command> %s [extra_args]\n
2192
2193 'candidate_file' will be inserted at '%s' and your command will look at this:
2194
2195 <command> 'candidate_file' [args]
2196
2197 - Specify many files as args (marked files):
2198
2199 e.g <command> file1 file2 ...
2200
2201 Please restart and use a prefix arg to call `anything-find-files-eshell-command-on-file'.
2202 Otherwise your command will be called many times like this:
2203
2204 <command> file1 <command> file2 etc...
2205
2206 \nSpecific commands for `anything-find-files-eshell-command-on-file':
2207 \\<anything-esh-on-file-map>
2208 \\[anything-esh-help]\t\t->Display this help.
2209 \n== Anything Map ==
2210 \\{anything-map}")
2211
2212 (defun anything-esh-help ()
2213   "Help command for `anything-find-files-eshell-command-on-file'."
2214   (interactive)
2215   (let ((anything-help-message anything-c-esh-help-message))
2216     (anything-help)))
2217
2218 \f
2219 ;;; Mode line strings
2220 ;;
2221 ;;
2222 (defvar anything-buffer-mode-line-string
2223   '("Buffer(s)"
2224     "\\<anything-c-buffer-map>\
2225 \\[anything-c-buffer-help]:Help, \
2226 \\<anything-map>\
2227 \\[anything-select-action]:Acts,\
2228 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
2229 \\[anything-select-3rd-action]:NthAct,\
2230 \\[anything-send-bug-report-from-anything]:BugReport."
2231     "String displayed in mode-line in `anything-c-source-buffers-list'"))
2232
2233 (defvar anything-ff-mode-line-string
2234   "\\<anything-find-files-map>\
2235 \\[anything-ff-help]:Help, \
2236 \\[anything-send-bug-report-from-anything]:BugReport, \
2237 \\<anything-map>\
2238 \\[anything-select-action]:Acts, \
2239 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
2240 \\[anything-select-3rd-action]:NthAct"
2241   "String displayed in mode-line in `anything-c-source-find-files'")
2242
2243 (defvar anything-read-file-name-mode-line-string
2244   "\\<anything-c-read-file-map>\
2245 \\[anything-read-file-name-help]:Help, \
2246 \\<anything-map>\
2247 \\[anything-select-action]:Acts,\
2248 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
2249 \\[anything-select-3rd-action]:NthAct"
2250   "String displayed in mode-line in `anything-c-source-find-files'")
2251
2252 (defvar anything-generic-file-mode-line-string
2253   "\\<anything-generic-files-map>\
2254 \\[anything-generic-file-help]:Help, \
2255 \\<anything-map>\
2256 \\[anything-select-action]:Acts,\
2257 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
2258 \\[anything-select-3rd-action]:NthAct,\
2259 \\[anything-send-bug-report-from-anything]:BugReport."
2260   "String displayed in mode-line in Locate.")
2261
2262 (defvar anything-grep-mode-line-string
2263   "\\<anything-c-grep-map>\
2264 \\[anything-grep-help]:Help,\
2265 \\<anything-map>\
2266 \\[anything-select-action]:Acts,\
2267 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
2268 \\[anything-select-3rd-action]:NthAct,\
2269 \\[anything-send-bug-report-from-anything]:BugReport."
2270   "String displayed in mode-line in `anything-do-grep'.")
2271
2272 (defvar anything-pdfgrep-mode-line-string
2273   "\\<anything-c-pdfgrep-map>\
2274 \\[anything-pdfgrep-help]:Help,\
2275 \\<anything-map>\
2276 \\[anything-select-action]:Acts,\
2277 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
2278 \\[anything-select-3rd-action]:NthAct,\
2279 \\[anything-send-bug-report-from-anything]:BugReport."
2280   "String displayed in mode-line in `anything-do-pdfgrep'.")
2281
2282 (defvar anything-etags-mode-line-string
2283   "\\<anything-c-etags-map>\
2284 \\[anything-etags-help]:Help,\
2285 \\<anything-map>\
2286 \\[anything-select-action]:Acts,\
2287 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
2288 \\[anything-select-3rd-action]:NthAct,\
2289 \\[anything-send-bug-report-from-anything]:BugReport."
2290   "String displayed in mode-line in `anything-c-etags-select'.")
2291
2292
2293 (defvar anything-c-ucs-mode-line-string
2294   "\\<anything-c-ucs-map>\
2295 \\[anything-c-ucs-help]:Help, \
2296 \\<anything-map>\
2297 \\[anything-select-action]:Acts,\
2298 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
2299 \\[anything-select-3rd-action]:NthAct."
2300   "String displayed in mode-line in `anything-ucs'.")
2301
2302 (defvar anything-bookmark-mode-line-string
2303   '("Bookmark(s)"
2304     "\\<anything-c-bookmark-map>\
2305 \\[anything-c-bookmark-help]:Help, \
2306 \\<anything-map>\
2307 \\[anything-select-action]:Acts,\
2308 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
2309 \\[anything-select-3rd-action]:NthAct,\
2310 \\[anything-send-bug-report-from-anything]:BugReport."
2311     "String displayed in mode-line in `anything-c-source-buffers-list'"))
2312
2313 (defvar anything-occur-mode-line
2314   "\\<anything-map>\
2315 \\[anything-help]:Help,\
2316 \\<anything-occur-map>\
2317 \\[anything-occur-run-query-replace-regexp]:Query replace regexp,\
2318 \\<anything-map>\
2319 \\[anything-select-action]:Acts,\
2320 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
2321 \\[anything-select-3rd-action]:NthAct,\
2322 \\[anything-send-bug-report-from-anything]:BugReport.")
2323
2324 \f
2325 ;;; Utilities Functions
2326 ;;
2327 ;;
2328 (defun anything-ff-find-printers ()
2329   "Return a list of available printers on Unix systems."
2330   (when (executable-find "lpstat")
2331     (let ((printer-list (with-temp-buffer
2332                           (call-process "lpstat" nil t nil "-a")
2333                           (split-string (buffer-string) "\n"))))
2334       (loop for p in printer-list
2335             for printer = (car (split-string p))
2336             when printer
2337             collect printer))))
2338
2339 ;; Shut up byte compiler in emacs24*.
2340 (defun anything-c-switch-to-buffer (buffer-or-name)
2341   "Same as `switch-to-buffer' whithout warnings at compile time."
2342   (with-no-warnings
2343     (switch-to-buffer buffer-or-name)))
2344
2345 (defun* anything-c-position (item seq &key (test 'eq) all)
2346   "A simple and faster replacement of CL `position'.
2347 Return position of first occurence of ITEM found in SEQ.
2348 Argument SEQ can be a string, in this case ITEM have to be a char.
2349 Argument ALL, if non--nil specify to return a list of positions of
2350 all ITEM found in SEQ."
2351   (let ((key (if (stringp seq) 'across 'in)))
2352     (eval
2353      `(loop for c ,key seq
2354             for index from 0
2355             when (funcall test c item)
2356             if all collect index into ls
2357             else return index
2358             finally return ls))))
2359
2360 (defun anything-c-get-pid-from-process-name (process-name)
2361   "Get pid from running process PROCESS-NAME."
2362   (loop with process-list = (list-system-processes)
2363         for pid in process-list
2364         for process = (assoc-default 'comm (process-attributes pid))
2365         when (and process (string-match process-name process))
2366         return pid))
2367
2368 (defun* anything-current-buffer-narrowed-p (&optional
2369                                             (buffer anything-current-buffer))
2370   "Check if BUFFER is narrowed.
2371 Default is `anything-current-buffer'."
2372   (with-current-buffer buffer
2373     (let ((beg (point-min))
2374           (end (point-max))
2375           (total (buffer-size)))
2376       (or (/= beg 1) (/= end (1+ total))))))
2377
2378 (defun anything-region-active-p ()
2379   (and transient-mark-mode mark-active (/= (mark) (point))))
2380
2381 (defun anything-goto-char (loc)
2382   "Go to char, revealing if necessary."
2383   (goto-char loc)
2384   (when (or (eq major-mode 'org-mode)
2385             (and (boundp 'outline-minor-mode)
2386                  outline-minor-mode))
2387     (require 'org) ; On some old Emacs versions org may not be loaded.
2388     (org-reveal)))
2389
2390 (defun anything-goto-line (lineno &optional noanim show-top)
2391   "Goto LINENO opening only outline headline if needed.
2392 Animation is used unless NOANIM is non--nil."
2393   (goto-char (point-min))
2394   (anything-goto-char (point-at-bol lineno))
2395   (when show-top
2396     (set-window-start (get-buffer-window) (point)))
2397   (unless noanim
2398     (anything-match-line-color-current-line)
2399     (sit-for 0.3)
2400     (anything-match-line-cleanup)))
2401
2402 (defun anything-show-this-source-only ()
2403   "Show all candidates of this source."
2404   (interactive)
2405   (let (anything-candidate-number-limit)
2406     (anything-set-source-filter
2407      (list (assoc-default 'name (anything-get-current-source))))))
2408
2409 ;;;###autoload
2410 (defun anything-test-sources ()
2411   "List all anything sources for test.
2412 The output is sexps which are evaluated by \\[eval-last-sexp]."
2413   (interactive)
2414   (with-output-to-temp-buffer "*Anything Test Sources*"
2415     (mapc (lambda (s) (princ (format ";; (anything '%s)\n" s)))
2416           (apropos-internal "^anything-c-source" #'boundp))
2417     (pop-to-buffer standard-output)))
2418
2419 (defun anything-displaying-source-names ()
2420   "Display sources name."
2421   (with-current-buffer anything-buffer
2422     (goto-char (point-min))
2423     (loop with pos
2424           while (setq pos (next-single-property-change (point) 'anything-header))
2425           do (goto-char pos)
2426           collect (buffer-substring-no-properties (point-at-bol)(point-at-eol))
2427           do (forward-line 1))))
2428
2429 ;; [Obsolete]
2430 (defun anything-select-source ()
2431   "[OBSOLETE] Select source."
2432   (interactive)
2433   (let ((default (assoc-default 'name (anything-get-current-source)))
2434         (source-names (anything-displaying-source-names))
2435         (all-source-names (mapcar (lambda (s) (assoc-default 'name s))
2436                                   (anything-get-sources))))
2437     (setq anything-candidate-number-limit 9999)
2438     (anything-aif
2439         (let (anything-source-filter)
2440           (anything-nest '(((name . "Anything Source")
2441                             (candidates . source-names)
2442                             (action . identity))
2443                            ((name . "Anything Source (ALL)")
2444                             (candidates . all-source-names)
2445                             (action . identity)))
2446                          nil "Source: " nil
2447                          default "*anything select source*"))
2448         (anything-set-source-filter (list it))
2449       (anything-set-source-filter nil))))
2450
2451 (defun anything-insert-string (str)
2452   "Insert STR."
2453   (anything-set-pattern str 'noupdate))
2454
2455 ;;;###autoload
2456 (defun anything-insert-buffer-name ()
2457   "Insert buffer name."
2458   (interactive)
2459   (anything-set-pattern
2460    (with-anything-current-buffer
2461      (if buffer-file-name (file-name-nondirectory buffer-file-name)
2462        (buffer-name)))))
2463
2464 (defalias 'anything-insert-symbol 'next-history-element)
2465 (defalias 'anything-insert-selection 'anything-yank-selection)
2466
2467 (defun anything-c-match-on-file-name (candidate)
2468   "Return non-nil if `anything-pattern' match basename of filename CANDIDATE."
2469   (string-match anything-pattern (file-name-nondirectory candidate)))
2470
2471 (defun anything-c-match-on-directory-name (candidate)
2472   "Return non-nil if `anything-pattern' match directory part of CANDIDATE."
2473   (anything-aif (file-name-directory candidate)
2474       (string-match anything-pattern it)))
2475
2476 (defun anything-c-match-on-basename (candidate)
2477   "Return non-nil if `anything-pattern' match basename of filename CANDIDATE."
2478   (string-match anything-pattern (anything-c-basename candidate)))
2479
2480 (defun anything-c-string-match (candidate)
2481   "Return non-nil if `anything-pattern' match CANDIDATE.
2482 The match is done with `string-match'."
2483   (string-match anything-pattern candidate))
2484
2485 (defun anything-c-skip-entries (list regexp)
2486   "Remove entries which matches REGEXP from LIST."
2487   (remove-if (lambda (x) (and (stringp x) (string-match regexp x)))
2488              list))
2489
2490 (defun anything-c-shadow-entries (list regexp)
2491   "Display elements of LIST matching REGEXP with the `file-name-shadow' face."
2492   (mapcar (lambda (file)
2493             ;; Add shadow face property to boring files.
2494             (let ((face (if (facep 'file-name-shadow)
2495                             'file-name-shadow
2496                             ;; fall back to default on XEmacs
2497                             'default)))
2498               (if (string-match regexp file)
2499                   (setq file (propertize file 'face face))))
2500             file)
2501           list))
2502
2503 (defsubst anything-c-stringify (str-or-sym)
2504   "Get string of STR-OR-SYM."
2505   (if (stringp str-or-sym)
2506       str-or-sym
2507       (symbol-name str-or-sym)))
2508
2509 (defsubst anything-c-symbolify (str-or-sym)
2510   "Get symbol of STR-OR-SYM."
2511   (if (symbolp str-or-sym)
2512       str-or-sym
2513       (intern str-or-sym)))
2514
2515 (defun anything-c-describe-function (func)
2516   "FUNC is symbol or string."
2517   (describe-function (anything-c-symbolify func)))
2518
2519 (defun anything-c-describe-variable (var)
2520   "VAR is symbol or string."
2521   (describe-variable (anything-c-symbolify var)))
2522
2523 (defun anything-c-find-function (func)
2524   "FUNC is symbol or string."
2525   (find-function (anything-c-symbolify func)))
2526
2527 (defun anything-c-find-variable (var)
2528   "VAR is symbol or string."
2529   (find-variable (anything-c-symbolify var)))
2530
2531 (defun anything-c-kill-new (candidate &optional replace)
2532   "CANDIDATE is symbol or string.
2533 See `kill-new' for argument REPLACE."
2534   (kill-new (anything-c-stringify candidate) replace))
2535
2536 (defun* anything-fast-remove-dups (seq &key (test 'eq))
2537   "Remove duplicates elements in list SEQ.
2538 This is same as `remove-duplicates' but with memoisation.
2539 It is much faster, especially in large lists.
2540 A test function can be provided with TEST argument key.
2541 Default is `eq'."
2542   (loop with cont = (make-hash-table :test test)
2543         for elm in seq
2544         unless (gethash elm cont)
2545         do (puthash elm elm cont)
2546         finally return
2547         (loop for i being the hash-values in cont collect i)))
2548
2549 (defadvice eval-defun (after anything-source-hack activate)
2550   "Allow immediate execution of anything source when evaling it.
2551 See `anything-c-enable-eval-defun-hack'."
2552   (when anything-c-enable-eval-defun-hack
2553     (let ((varsym (save-excursion
2554                     (beginning-of-defun)
2555                     (forward-char 1)
2556                     (when (memq (read (current-buffer)) '(defvar setq))
2557                       (read (current-buffer))))))
2558       (when (string-match "^anything-c-source-" (symbol-name varsym))
2559         (anything varsym)))))
2560 ;; (progn (ad-disable-advice 'eval-defun 'after 'anything-source-hack) (ad-update 'eval-defun))
2561
2562
2563 ;; Move this function from anything.el and redefine here
2564 ;; to avoid an unneeded defadvice.
2565 (defun anything-quit-and-find-file ()
2566   "Drop into `anything-find-files' from `anything'.
2567 If current selection is a buffer or a file, `anything-find-files'
2568 from its directory."
2569   (interactive)
2570   (anything-run-after-quit
2571    (lambda (f)
2572      (if (file-exists-p f)
2573          (anything-find-files-1 (file-name-directory f)
2574                                 (if anything-ff-transformer-show-only-basename
2575                                     (anything-c-basename f) f))
2576          (anything-find-files-1 f)))
2577    (anything-aif (get-buffer (anything-get-selection))
2578        (or (buffer-file-name it)
2579            (car (rassoc it dired-buffers))
2580            (and (with-current-buffer it
2581                   (eq major-mode 'org-agenda-mode))
2582                 org-directory
2583                 (expand-file-name org-directory))
2584            default-directory)
2585      (let ((sel (anything-get-selection)))
2586        (cond ((or (file-remote-p sel)
2587                   (file-exists-p sel))
2588               (expand-file-name sel))
2589              ((string-match ffap-url-regexp sel)
2590               sel)
2591              (t default-directory))))))
2592
2593
2594 (defmacro* anything-c-walk-directory (directory &key path (directories t) match)
2595   "Walk through DIRECTORY tree.
2596 PATH can be one of basename, relative, or full.
2597 DIRECTORIES when non--nil (default) return also directories names, otherwise
2598 skip directories names.
2599 MATCH match only filenames matching regexp MATCH."
2600   `(let (result
2601          (fn (case ,path
2602                (basename 'file-name-nondirectory)
2603                (relative 'file-relative-name)
2604                (full     'identity)
2605                (t        'file-name-nondirectory))))
2606      (labels ((ls-R (dir)
2607                 (loop with ls = (directory-files dir t directory-files-no-dot-files-regexp)
2608                       for f in ls
2609                       if (file-directory-p f)
2610                       do (progn (when ,directories
2611                                   (push (funcall fn f) result))
2612                                 ;; Don't recurse in directory symlink.
2613                                 (unless (file-symlink-p f)
2614                                   (ls-R f)))
2615                       else do
2616                       (unless (and ,match (not (string-match ,match (file-name-nondirectory f))))
2617                         (push (funcall fn f) result)))))
2618        (ls-R ,directory)
2619        (nreverse result))))
2620
2621 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Anything Applications ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2622
2623 ;;; Anything regexp.
2624 ;;
2625 ;;
2626 (defvar anything-build-regexp-history nil)
2627 (defun anything-c-query-replace-regexp (candidate)
2628   "Query replace regexp from `anything-regexp'.
2629 With a prefix arg replace only matches surrounded by word boundaries,
2630 i.e Don't replace inside a word, regexp is surrounded with \\bregexp\\b."
2631   (let ((regexp (funcall (anything-attr 'regexp))))
2632     (apply 'query-replace-regexp
2633            (anything-c-query-replace-args regexp))))
2634
2635 (defun anything-c-kill-regexp-as-sexp (candidate)
2636   "Kill regexp in a format usable in lisp code."
2637   (anything-c-regexp-kill-new
2638    (prin1-to-string (funcall (anything-attr 'regexp)))))
2639
2640 (defun anything-c-kill-regexp (candidate)
2641   "Kill regexp as it is in `anything-pattern'."
2642   (anything-c-regexp-kill-new (funcall (anything-attr 'regexp))))
2643
2644 (defun anything-c-query-replace-args (regexp)
2645   "create arguments of `query-replace-regexp' action in `anything-regexp'."
2646   (let ((region-only (anything-region-active-p)))
2647     (list
2648      regexp
2649      (query-replace-read-to regexp
2650                             (format "Query replace %sregexp %s"
2651                                     (if anything-current-prefix-arg "word " "")
2652                                     (if region-only "in region " ""))
2653                             t)
2654      anything-current-prefix-arg
2655      (when region-only (region-beginning))
2656      (when region-only (region-end)))))
2657
2658 (defvar anything-c-source-regexp
2659   '((name . "Regexp Builder")
2660     (init . (lambda ()
2661               (anything-candidate-buffer anything-current-buffer)))
2662     (candidates-in-buffer)
2663     (get-line . anything-c-regexp-get-line)
2664     (persistent-action . anything-c-regexp-persistent-action)
2665     (persistent-help . "Show this line")
2666     (multiline)
2667     (delayed)
2668     (requires-pattern . 2)
2669     (mode-line . "Press TAB to select action.")
2670     (regexp . (lambda () anything-input))
2671     (action . (("Kill Regexp as sexp" . anything-c-kill-regexp-as-sexp)
2672                ("Query Replace Regexp (C-u Not inside word.)"
2673                 . anything-c-query-replace-regexp)
2674                ("Kill Regexp" . anything-c-kill-regexp)))))
2675
2676 (defun anything-c-regexp-get-line (s e)
2677   (propertize
2678    (apply 'concat
2679           ;; Line contents
2680           (format "%5d: %s" (line-number-at-pos (1- s)) (buffer-substring s e))
2681           ;; subexps
2682           (loop for i from 0 to (1- (/ (length (match-data)) 2))
2683                 collect (format "\n         %s'%s'"
2684                                 (if (zerop i) "Group 0: " (format "Group %d: " i))
2685                                 (match-string i))))
2686    ;; match beginning
2687    ;; KLUDGE: point of anything-candidate-buffer is +1 than that of anything-current-buffer.
2688    ;; It is implementation problem of candidates-in-buffer.
2689    'anything-realvalue
2690    (1- s)))
2691
2692 (defun anything-c-regexp-persistent-action (pt)
2693   (anything-goto-char pt)
2694   (anything-persistent-highlight-point))
2695
2696 (defun anything-c-regexp-kill-new (input)
2697   (kill-new input)
2698   (message "Killed: %s" input))
2699
2700 (defun anything-quote-whitespace (candidate)
2701   "Quote whitespace, if some, in string CANDIDATE."
2702   (replace-regexp-in-string " " "\\\\ " candidate))
2703
2704 \f
2705 ;;; Toggle all marks.
2706 ;;
2707 ;;
2708 ;;;###autoload
2709 (defun anything-mark-all ()
2710   "Mark all visible unmarked candidates in current source."
2711   (interactive)
2712   (with-anything-window
2713     (save-excursion
2714       (goto-char (anything-get-previous-header-pos))
2715       (anything-next-line)
2716       (let* ((next-head (anything-get-next-header-pos))
2717              (end       (and next-head
2718                              (save-excursion
2719                                (goto-char next-head)
2720                                (forward-line -1)
2721                                (point))))
2722              (maxpoint  (or end (point-max))))
2723         (while (< (point) maxpoint)
2724           (anything-mark-current-line)
2725           (let* ((prefix (get-text-property (point-at-bol) 'display))
2726                  (cand   (anything-get-selection))
2727                  (bn     (and (anything-file-completion-source-p)
2728                               (anything-c-basename cand)))
2729                  (src    (assoc-default 'name (anything-get-current-source))))
2730             (when (and (not (anything-this-visible-mark))
2731                        (not (or (string= prefix "[?]")
2732                                 (string= prefix "[@]"))))
2733               ;; Don't mark possibles directories ending with . or ..
2734               ;; autosave files/links and non--existent file.
2735               (unless
2736                   (and (or (anything-file-completion-source-p)
2737                            (equal src "Files from Current Directory"))
2738                        (or (string-match "^\\.#.*\\|^#.*#$\\|\\.$" bn)
2739                            ;; We need to test here when not using a transformer
2740                            ;; that tag prefix (i.e on tramp)
2741                            (not (file-exists-p cand))))
2742                 (anything-make-visible-mark))))
2743           (forward-line 1) (end-of-line))))
2744     (anything-mark-current-line)
2745     (message "%s candidates marked" (length anything-marked-candidates))))
2746
2747 ;;;###autoload
2748 (defun anything-unmark-all ()
2749   "Unmark all candidates in all sources of current anything session."
2750   (interactive)
2751   (with-anything-window
2752     (let ((len (length anything-marked-candidates)))
2753       (save-excursion
2754         (anything-clear-visible-mark))
2755       (setq anything-marked-candidates nil)
2756       (anything-mark-current-line)
2757       (message "%s candidates unmarked" len))))
2758
2759 ;;;###autoload
2760 (defun anything-toggle-all-marks ()
2761   "Toggle all marks.
2762 Mark all visible candidates of current source or unmark all candidates
2763 visible or invisible in all sources of current anything session"
2764   (interactive)
2765   (let ((marked (anything-marked-candidates)))
2766     (if (and (>= (length marked) 1)
2767              (with-anything-window anything-visible-mark-overlays))
2768         (anything-unmark-all)
2769         (anything-mark-all))))
2770
2771
2772 \f
2773 ;;; Buffers
2774 ;;
2775 ;;
2776 (defun anything-c-buffer-list ()
2777   "Return a list of buffer names.
2778 The first buffer in the list will be the last recently used
2779 buffer that is not the current buffer unless
2780 `anything-allow-skipping-current-buffer' is nil."
2781   (let ((buffers (mapcar 'buffer-name (buffer-list))))
2782     (if anything-allow-skipping-current-buffer
2783         (progn
2784           (setq buffers (remove (buffer-name anything-current-buffer) buffers))
2785           (append (cdr buffers) (list (car buffers))))
2786         buffers)))
2787
2788 (defvar anything-c-source-buffers
2789   '((name . "Buffers")
2790     (candidates . anything-c-buffer-list)
2791     (type . buffer)))
2792
2793 (defvar anything-c-source-buffer-not-found
2794   `((name . "Create buffer")
2795     (dummy)
2796     (filtered-candidate-transformer (lambda (cands source)
2797                                       (list anything-pattern)))
2798     (keymap . ,anything-map)
2799     (action . (lambda (candidate)
2800                 (anything-c-switch-to-buffer (get-buffer-create candidate))))))
2801
2802 ;;; Buffers-list (was buffers+)
2803 ;;
2804 ;;
2805 (defun anything-c-highlight-buffers (buffers)
2806   "Transformer function to highlight BUFFERS list.
2807 Should be called after others transformers i.e (boring buffers)."
2808   (loop with buflist = (if anything-allow-skipping-current-buffer
2809                            buffers
2810                            (cons (pop (cdr buffers)) buffers))
2811         for i in buflist
2812         for buf = (get-buffer i)
2813         for bfname = (buffer-file-name buf)
2814         collect
2815         (cond (;; A dired buffer.
2816                (rassoc buf dired-buffers)
2817                (propertize i 'face 'anything-ff-directory
2818                            'help-echo (car (rassoc buf dired-buffers))))
2819               ;; A buffer file modified somewhere outside of emacs.
2820               ((and bfname (not (file-remote-p bfname))
2821                     (file-exists-p bfname)
2822                     (not (verify-visited-file-modtime buf)))
2823                (propertize i 'face 'anything-buffer-saved-out
2824                            'help-echo bfname))
2825               ;; A new buffer file not already saved on disk.
2826               ((and bfname (not (file-remote-p bfname))
2827                     (not (verify-visited-file-modtime buf)))
2828                (propertize i 'face 'anything-buffer-not-saved
2829                            'help-echo bfname))
2830               ;; A Remote buffer file modified and not saved on disk.
2831               ((and bfname (file-remote-p bfname) (buffer-modified-p buf))
2832                (let ((prefix (propertize
2833                               " " 'display
2834                               (propertize "@ " 'face 'anything-ff-prefix))))
2835                  (cons (concat prefix (propertize i 'face 'anything-ff-symlink
2836                                                   'help-echo bfname)) i)))
2837               ;; A buffer file modified and not saved on disk.
2838               ((and bfname (buffer-modified-p buf))
2839                (propertize i 'face 'anything-ff-symlink
2840                            'help-echo bfname))
2841               ;; A remote buffer file not modified and saved on disk.
2842               ((and bfname (file-remote-p bfname))
2843                (let ((prefix (propertize
2844                               " " 'display
2845                               (propertize "@ " 'face 'anything-ff-prefix))))
2846                  (cons (concat prefix (propertize i 'face 'font-lock-type-face
2847                                                   'help-echo bfname)) i)))
2848               ;; A buffer file not modified and saved on disk.
2849               (bfname
2850                (propertize i 'face 'font-lock-type-face
2851                            'help-echo bfname))
2852               ;; Any non--file buffer.
2853               (t (propertize i 'face 'italic)))))
2854
2855
2856 (defvar anything-c-source-buffers-list
2857   `((name . "Buffers")
2858     (candidates . anything-c-buffer-list)
2859     (type . buffer)
2860     (match anything-c-buffer-match-major-mode)
2861     (candidate-transformer anything-c-skip-boring-buffers
2862                            anything-c-highlight-buffers)
2863     (persistent-action . anything-c-buffers-list-persistent-action)
2864     (keymap . ,anything-c-buffer-map)
2865     (volatile)
2866     (mode-line . anything-buffer-mode-line-string)
2867     (persistent-help . "Show this buffer / C-u \\[anything-execute-persistent-action]: Kill this buffer")))
2868
2869 (defvaralias 'anything-c-source-buffers+ 'anything-c-source-buffers-list)
2870
2871 (defun anything-c-buffer-match-major-mode (candidate)
2872   "Match maybe buffer by major-mode.
2873 If you give a major-mode or partial major-mode,
2874 it will list all buffers of this major-mode and/or buffers with name
2875 matching this major-mode.
2876 If you add a space after major-mode and then a space,
2877 it will match all buffers of the major-mode
2878 before space matching pattern after space.
2879 If you give a pattern which doesn't match a major-mode, it will search buffer
2880 with name matching pattern."
2881   (let* ((cand (replace-regexp-in-string "^\\s-\\{1\\}" "" candidate))
2882          (buf  (get-buffer cand)))
2883     (when buf
2884       (with-current-buffer buf
2885         (let ((mjm   (symbol-name major-mode))
2886               (split (split-string anything-pattern)))
2887           (cond ((string-match "\\s-$" anything-pattern)
2888                  (string-match (car split) mjm))
2889                 ((string-match "\\s-" anything-pattern)
2890                  (and (string-match (car split) mjm)
2891                       (string-match (cadr split) cand)))
2892                 (t (or (string-match anything-pattern mjm)
2893                        (string-match anything-pattern cand)))))))))
2894
2895 (defun anything-c-buffer-query-replace-1 (&optional regexp-flag)
2896   "Query replace in marked buffers.
2897 If REGEXP-FLAG is given use `query-replace-regexp'."
2898   (let ((fn     (if regexp-flag 'query-replace-regexp 'query-replace))
2899         (prompt (if regexp-flag "Query replace regexp" "Query replace"))
2900         (bufs   (anything-marked-candidates)))
2901     (loop
2902           with replace = (query-replace-read-from prompt regexp-flag)
2903           with tostring = (unless (consp replace)
2904                             (query-replace-read-to
2905                              replace prompt regexp-flag))
2906           for buf in bufs
2907           do
2908           (save-window-excursion
2909             (anything-c-switch-to-buffer buf)
2910             (save-excursion
2911               (let ((case-fold-search t))
2912                 (goto-char (point-min))
2913                 (if (consp replace)
2914                     (apply fn (list (car replace) (cdr replace)))
2915                     (apply fn (list replace tostring)))))))))
2916
2917 (defun anything-c-buffer-query-replace-regexp (candidate)
2918   (anything-c-buffer-query-replace-1 'regexp))
2919
2920 (defun anything-c-buffer-query-replace (candidate)
2921   (anything-c-buffer-query-replace-1))
2922
2923 (defun anything-buffer-toggle-diff (candidate)
2924   "Toggle diff buffer CANDIDATE with it's file."
2925   (if (get-buffer-window "*Diff*")
2926       (kill-buffer "*Diff*")
2927       (diff-buffer-with-file (get-buffer candidate))))
2928
2929 ;;;###autoload
2930 (defun anything-buffer-diff-persistent ()
2931   "Toggle diff buffer without quitting anything."
2932   (interactive)
2933   (anything-attrset 'diff-action 'anything-buffer-toggle-diff)
2934   (anything-execute-persistent-action 'diff-action))
2935
2936 (defun anything-buffer-revert-and-update (candidate)
2937   (let ((marked (anything-marked-candidates)))
2938     (loop for buf in marked do (anything-revert-buffer buf))
2939     (anything-force-update candidate)))
2940
2941 ;;;###autoload
2942 (defun anything-buffer-revert-persistent ()
2943   "Revert buffer without quitting anything."
2944   (interactive)
2945   (anything-attrset 'revert-action 'anything-buffer-revert-and-update)
2946   (anything-execute-persistent-action 'revert-action 'onewindow))
2947
2948 (defun anything-buffer-save-and-update (candidate)
2949   (let ((marked (anything-marked-candidates))
2950         (enable-recursive-minibuffers t))
2951     (loop for buf in marked do
2952           (with-current-buffer (get-buffer buf)
2953             (save-buffer)))
2954     (anything-force-update candidate)))
2955
2956 ;;;###autoload
2957 (defun anything-buffer-save-persistent ()
2958   "Save buffer without quitting anything."
2959   (interactive)
2960   (anything-attrset 'save-action 'anything-buffer-save-and-update)
2961   (anything-execute-persistent-action 'save-action 'onewindow))
2962
2963 ;;;###autoload
2964 (defun anything-buffer-run-kill-buffers ()
2965   "Run kill buffer action from `anything-c-source-buffers-list'."
2966   (interactive)
2967   (anything-c-quit-and-execute-action 'anything-kill-marked-buffers))
2968
2969 ;;;###autoload
2970 (defun anything-buffer-run-grep ()
2971   "Run Grep action from `anything-c-source-buffers-list'."
2972   (interactive)
2973   (anything-c-quit-and-execute-action 'anything-c-grep-buffers))
2974
2975 ;;;###autoload
2976 (defun anything-buffer-run-zgrep ()
2977   "Run Grep action from `anything-c-source-buffers-list'."
2978   (interactive)
2979   (anything-c-quit-and-execute-action 'anything-c-zgrep-buffers))
2980
2981 ;;;###autoload
2982 (defun anything-buffer-run-query-replace-regexp ()
2983   "Run Query replace regexp action from `anything-c-source-buffers-list'."
2984   (interactive)
2985   (anything-c-quit-and-execute-action 'anything-c-buffer-query-replace-regexp))
2986
2987 ;;;###autoload
2988 (defun anything-buffer-run-query-replace ()
2989   "Run Query replace action from `anything-c-source-buffers-list'."
2990   (interactive)
2991   (anything-c-quit-and-execute-action 'anything-c-buffer-query-replace))
2992
2993 ;;;###autoload
2994 (defun anything-buffer-switch-other-window ()
2995   "Run switch to other window action from `anything-c-source-buffers-list'."
2996   (interactive)
2997   (anything-c-quit-and-execute-action 'switch-to-buffer-other-window))
2998
2999 ;;;###autoload
3000 (defun anything-buffer-switch-other-frame ()
3001   "Run switch to other frame action from `anything-c-source-buffers-list'."
3002   (interactive)
3003   (anything-c-quit-and-execute-action 'switch-to-buffer-other-frame))
3004
3005 ;;;###autoload
3006 (defun anything-buffer-switch-to-elscreen ()
3007   "Run switch to elscreen  action from `anything-c-source-buffers-list'."
3008   (interactive)
3009   (anything-c-quit-and-execute-action 'anything-find-buffer-on-elscreen))
3010
3011 ;;;###autoload
3012 (defun anything-buffer-run-ediff ()
3013   "Run ediff action from `anything-c-source-buffers-list'."
3014   (interactive)
3015   (anything-c-quit-and-execute-action 'anything-ediff-marked-buffers))
3016
3017 (defun anything-buffer-run-ediff-merge ()
3018   "Run ediff action from `anything-c-source-buffers-list'."
3019   (interactive)
3020   (anything-c-quit-and-execute-action 'anything-ediff-marked-buffers-merge))
3021
3022 (defun anything-c-buffers-persistent-kill (buffer)
3023   "Persistent action to kill buffer."
3024   (with-current-buffer (get-buffer buffer)
3025     (if (and (buffer-modified-p)
3026              (buffer-file-name (current-buffer)))
3027         (progn
3028           (save-buffer)
3029           (kill-buffer buffer))
3030         (kill-buffer buffer)))
3031   (anything-delete-current-selection))
3032
3033 (defun anything-c-buffers-list-persistent-action (candidate)
3034   (if current-prefix-arg
3035       (anything-c-buffers-persistent-kill candidate)
3036       (anything-c-switch-to-buffer candidate)))
3037
3038 \f
3039 ;;;; <File>
3040 ;;
3041 ;;
3042 ;;; File name history
3043 (defvar anything-c-source-file-name-history
3044   '((name . "File Name History")
3045     (candidates . file-name-history)
3046     (match anything-c-match-on-basename)
3047     (type . file)))
3048
3049 ;;; Files in current dir
3050 ;;
3051 ;;
3052 (defvar anything-c-source-files-in-current-dir
3053   '((name . "Files from Current Directory")
3054     (candidates . (lambda ()
3055                     (with-anything-current-buffer
3056                       (directory-files (anything-c-current-directory)))))
3057     ;; volatile is not needed, I think.
3058     (type . file)))
3059
3060 (defun anything-c-highlight-files (files)
3061   (loop for i in files
3062         if (file-directory-p i)
3063         collect (propertize (file-name-nondirectory i)
3064                             'face 'anything-ff-directory
3065                             'help-echo (expand-file-name i))
3066         else
3067         collect (propertize (file-name-nondirectory i)
3068                             'face 'anything-ff-file
3069                             'help-echo (expand-file-name i))))
3070
3071 (defvar anything-c-source-files-in-current-dir+
3072   `((name . "Files from Current Directory")
3073     (candidates . (lambda ()
3074                     (with-anything-current-buffer
3075                       (directory-files (anything-c-current-directory) t))))
3076     (keymap . ,anything-generic-files-map)
3077     (help-message . anything-generic-file-help-message)
3078     (mode-line . anything-generic-file-mode-line-string)
3079     (candidate-transformer anything-c-highlight-files)
3080     ;; volatile is not needed, I think.
3081     (type . file)))
3082
3083
3084 \f
3085 ;;; Anything-find-files - The anything files browser.
3086 ;;
3087 ;;
3088 ;; Internal.
3089 (defvar anything-c-find-files-doc-header " (`C-l': Go to precedent level)"
3090   "*The doc that is inserted in the Name header of a find-files or dired source.")
3091 (defvar anything-ff-auto-update-flag nil
3092   "Internal, flag to turn on/off auto-update in `anything-find-files'.
3093 Don't set it directly, use instead `anything-ff-auto-update-initial-value'.")
3094 (defvar anything-ff-last-expanded nil
3095   "Store last expanded directory or file.")
3096 (defvar anything-ff-default-directory nil)
3097 (defvar anything-ff-history nil)
3098 (defvar anything-ff-cand-to-mark nil)
3099 (defvar anything-ff-url-regexp
3100   "\\`\\(news\\(post\\)?:\\|nntp:\\|mailto:\\|file:\\|\\(ftp\\|https?\\|telnet\\|gopher\\|www\\|wais\\):/?/?\\).*"
3101   "Same as `ffap-url-regexp' but match earlier possible url.")
3102
3103 (defvar anything-c-source-find-files
3104   `((name . "Find Files")
3105     (header-name . (lambda (name)
3106                      (concat name anything-c-find-files-doc-header)))
3107     ;; It is needed for filenames with capital letters
3108     (disable-shortcuts)
3109     (init . (lambda ()
3110               (setq anything-ff-auto-update-flag
3111                     anything-ff-auto-update-initial-value)))
3112     (candidates . anything-find-files-get-candidates)
3113     (filtered-candidate-transformer anything-c-find-files-transformer)
3114     (persistent-action . anything-find-files-persistent-action)
3115     (persistent-help . "Hit1 Expand Candidate, Hit2 or (C-u) Find file")
3116     (mode-line . anything-ff-mode-line-string)
3117     (volatile)
3118     (candidate-number-limit . 9999)
3119     (action-transformer . anything-find-files-action-transformer)
3120     (action
3121      . ,(delq
3122          nil
3123          `(("Find File" . anything-c-find-file-or-marked)
3124            ("Find file in Dired" . anything-c-point-file-in-dired)
3125            ,(and (locate-library "elscreen")
3126                  '("Find file in Elscreen"  . anything-elscreen-find-file))
3127            ,(and (locate-library "popwin")
3128                  '("Find file in popup window" . popwin:find-file))
3129            ("Checksum File" . anything-ff-checksum)
3130            ("Complete at point `M-tab'"
3131             . anything-c-insert-file-name-completion-at-point)
3132            ("Open file externally `C-c C-x, C-u to choose'"
3133             . anything-c-open-file-externally)
3134            ("Grep File(s) `M-g s, C-u Recurse'" . anything-find-files-grep)
3135            ("Zgrep File(s) `M-g z, C-u Recurse'" . anything-ff-zgrep)
3136            ("Switch to Eshell `M-e'" . anything-ff-switch-to-eshell)
3137            ("Etags `M-., C-u tap, C-u C-u reload tag file'" . anything-ff-etags-select)
3138            ("Eshell command on file(s) `M-!, C-u run on all marked at once.'"
3139             . anything-find-files-eshell-command-on-file)
3140            ("Find file as root" . anything-find-file-as-root)
3141            ("Find file in hex dump" . hexl-find-file)
3142            ("Ediff File `C-='" . anything-find-files-ediff-files)
3143            ("Ediff Merge File `C-c ='" . anything-find-files-ediff-merge-files)
3144            ("Delete File(s) `M-D'" . anything-delete-marked-files)
3145            ("Copy file(s) `M-C, C-u to follow'" . anything-find-files-copy)
3146            ("Copy file(s) Async" . anything-ff-copy-async)
3147            ("Rename file(s) `M-R, C-u to follow'" . anything-find-files-rename)
3148            ("Serial rename files" . anything-ff-serial-rename)
3149            ("Serial rename by symlinking files" . anything-ff-serial-rename-by-symlink)
3150            ("Serial rename by copying files" . anything-ff-serial-rename-by-copying)
3151            ("Symlink files(s) `M-S, C-u to follow'" . anything-find-files-symlink)
3152            ("Relsymlink file(s) `C-u to follow'" . anything-find-files-relsymlink)
3153            ("Hardlink file(s) `M-H, C-u to follow'" . anything-find-files-hardlink)
3154            ("Find file other window `C-o'" . find-file-other-window)
3155            ("Switch to history `M-p'" . anything-find-files-switch-to-hist)
3156            ("Find file other frame `C-c C-o'" . find-file-other-frame)
3157            ("Print File `C-c p, C-u to refresh'" . anything-ff-print)
3158            ("Locate `C-x C-f, C-u to specify locate db'" . anything-ff-locate))))))
3159
3160 (defun anything-find-files-set-prompt-for-action (action files)
3161   "Set prompt for action ACTION for FILES."
3162   (let ((len (length files)))
3163     (format "%s *%s File(s)\n%s to: "
3164             action len
3165             (mapconcat (lambda (f)
3166                          (format "- %s\n" f)) files ""))))
3167
3168 (defun anything-dwim-target-directory ()
3169   "Return value of `default-directory' of buffer in other window.
3170 If there is only one window return the value ot `default-directory'
3171 for current buffer."
3172   (with-anything-current-buffer
3173     (let ((num-windows (length (window-list))))
3174       (if (> num-windows 1)
3175           (save-selected-window
3176             (other-window 1)
3177             default-directory)
3178           (car anything-ff-history)))))
3179
3180 (defun anything-find-files-do-action (action)
3181   "Generic function for creating action from `anything-c-source-find-files'.
3182 ACTION must be an action supported by `anything-dired-action'."
3183   (let* ((ifiles (mapcar 'expand-file-name ; Allow modify '/foo/.' -> '/foo'
3184                          (anything-marked-candidates)))
3185          (cand   (anything-get-selection)) ; Target
3186          (prompt (anything-find-files-set-prompt-for-action
3187                   (capitalize (symbol-name action)) ifiles))
3188          (parg   anything-current-prefix-arg)
3189          (dest   (anything-c-read-file-name
3190                   prompt
3191                   :preselect (if anything-ff-transformer-show-only-basename
3192                                  (anything-c-basename cand) cand)
3193                   :initial-input (anything-dwim-target-directory)
3194                   :history (anything-find-files-history :comp-read nil))))
3195     (anything-dired-action
3196      dest :files ifiles :action action :follow parg)))
3197
3198 (defun anything-find-files-copy (candidate)
3199   "Copy files from `anything-find-files'."
3200   (anything-find-files-do-action 'copy))
3201
3202 (defun anything-find-files-rename (candidate)
3203   "Rename files from `anything-find-files'."
3204   (anything-find-files-do-action 'rename))
3205
3206 (defun anything-find-files-symlink (candidate)
3207   "Symlink files from `anything-find-files'."
3208   (anything-find-files-do-action 'symlink))
3209
3210 (defun anything-find-files-relsymlink (candidate)
3211   "Relsymlink files from `anything-find-files'."
3212   (anything-find-files-do-action 'relsymlink))
3213
3214 (defun anything-find-files-hardlink (candidate)
3215   "Hardlink files from `anything-find-files'."
3216   (anything-find-files-do-action 'hardlink))
3217
3218 (defun anything-find-files-byte-compile (candidate)
3219   "Byte compile elisp files from `anything-find-files'."
3220   (let ((files    (anything-marked-candidates))
3221         (parg     anything-current-prefix-arg))
3222     (loop for fname in files
3223           do (byte-compile-file fname parg))))
3224
3225 (defun anything-find-files-load-files (candidate)
3226   "Load elisp files from `anything-find-files'."
3227   (let ((files    (anything-marked-candidates)))
3228     (loop for fname in files
3229           do (load fname))))
3230
3231 (defun anything-find-files-ediff-files-1 (candidate &optional merge)
3232   "Generic function to ediff/merge files in `anything-find-files'."
3233   (let ((bname  (anything-c-basename candidate))
3234         (prompt (if merge "Ediff Merge `%s' With File: "
3235                     "Ediff `%s' With File: "))
3236         (fun    (if merge 'ediff-merge-files 'ediff-files)))
3237     (funcall fun
3238              candidate
3239              (condition-case quit
3240                  (anything-c-read-file-name
3241                   (format prompt bname))
3242                (quit ;; Hit C-g ask user to fallback to locate.
3243                 (if (y-or-n-p "Search file for ediff with locate? ")
3244                     (anything-c-locate-read-file-name
3245                      (format prompt bname)
3246                      ;; Check if -b option is available.
3247                      (if (and (eq system-type 'windows-nt)
3248                               (string-match "^es" anything-c-locate-command))
3249                          bname
3250                          (concat bname " -b")))
3251                     (error "Error: Ediff Operation aborted")))))))
3252
3253 (defun anything-find-files-ediff-files (candidate)
3254   (anything-find-files-ediff-files-1 candidate))
3255
3256 (defun anything-find-files-ediff-merge-files (candidate)
3257   (anything-find-files-ediff-files-1 candidate 'merge))
3258
3259 (defun anything-find-files-grep (candidate)
3260   "Default action to grep files from `anything-find-files'."
3261   (anything-do-grep-1 (anything-marked-candidates)
3262                       anything-current-prefix-arg))
3263
3264 (defun anything-ff-zgrep (candidate)
3265   "Default action to zgrep files from `anything-find-files'."
3266   (let ((prefarg anything-current-prefix-arg)
3267         (ls      (anything-marked-candidates)))
3268     (anything-ff-zgrep-1 ls prefarg)))
3269
3270 (defun anything-ff-pdfgrep (candidate)
3271   "Default action to pdfgrep files from `anything-find-files'."
3272   (let ((cands (loop for file in (anything-marked-candidates)
3273                      if (or (string= (file-name-extension file) "pdf")
3274                             (string= (file-name-extension file) "PDF"))
3275                      collect file))
3276         (anything-c-pdfgrep-default-function 'anything-c-pdfgrep-init))
3277     (when cands
3278       (anything-do-pdfgrep-1 cands))))
3279
3280 (defun anything-ff-etags-select (candidate)
3281   "Default action to jump to etags from `anything-find-files'."
3282   (when (get-buffer anything-action-buffer)
3283     (kill-buffer anything-action-buffer))
3284   (let ((default-directory anything-ff-default-directory))
3285     (anything-c-etags-select anything-current-prefix-arg)))
3286
3287 (defun anything-find-files-switch-to-hist (candidate)
3288   "Switch to anything-find-files history."
3289   (anything-find-files t))
3290
3291 ;;; Asynchronous copy of files.
3292 ;;
3293 ;;
3294 (defun anything-c-copy-files-async-1 (flist dest)
3295   "Copy a list of Files FLIST to DEST asynchronously.
3296 It use another emacs process to do the job.
3297 Communication with background emacs is done with temp file
3298 `anything-c-copy-files-async-log-file'."
3299   (start-file-process "emacs-batch" nil anything-c-copy-async-prefered-emacs
3300                       "-Q" "--batch" "--eval"
3301                       (format "(progn
3302   (require 'dired) (require 'cl)
3303   (let ((dired-recursive-copies 'always)
3304         failures success
3305         (ovw-count 0)
3306         (cpf-count 0))
3307     (dolist (f '%S)
3308        (condition-case err
3309              (let ((file-exists (file-exists-p
3310                                  (expand-file-name
3311                                   (file-name-nondirectory (directory-file-name f))
3312                                    (file-name-directory
3313                                      (file-name-as-directory \"%s\"))))))
3314                 (dired-copy-file f \"%s\" t)
3315                 (if file-exists
3316                     (progn (push (cons \"Overwriting\" f) success)
3317                            (incf ovw-count))
3318                     (push (cons \"Copying\" f) success)
3319                     (incf cpf-count)))
3320           (file-error
3321            (push (dired-make-relative
3322                    (expand-file-name
3323                      (file-name-nondirectory (directory-file-name f))
3324                      (file-name-directory \"%s\")))
3325                  failures))))
3326     (with-current-buffer (find-file-noselect \"%s\")
3327        (erase-buffer)
3328        (when failures
3329          (dolist (fail (reverse failures))
3330            (insert (concat \"Failed to copy \" fail \"\n\"))))
3331        (when success
3332          (loop for (a . s) in (reverse success) do
3333            (insert (concat a \" \" s  \" to %s done\n\"))))
3334        (and (/= cpf-count 0) (insert (concat (int-to-string cpf-count) \" File(s) Copied\n\")))
3335        (and (/= ovw-count 0) (insert (concat (int-to-string ovw-count) \" File(s) Overwrited\n\")))
3336        (and failures (insert (concat (int-to-string (length failures)) \" File(s) Failed to copy\n\")))
3337        (save-buffer))))"
3338                               flist dest dest dest anything-c-copy-files-async-log-file dest)))
3339
3340 (defun anything-c-copy-async-with-log (flist dest)
3341   "Copy file list FLIST to DEST showing log.
3342 Log is send to `anything-c-copy-files-async-log-file'.
3343 Copying is done asynchronously with `anything-c-copy-files-async-1'."
3344   (declare (special auto-revert-interval))
3345   (pop-to-buffer (find-file-noselect anything-c-copy-files-async-log-file))
3346   (set (make-local-variable 'auto-revert-interval) 1)
3347   (erase-buffer)
3348   (insert "Wait copying files...\n")
3349   (sit-for 0.5) (save-buffer)
3350   (goto-char (point-max))
3351   (auto-revert-mode 1)
3352   (anything-c-copy-files-async-1 flist dest))
3353
3354 (defun anything-ff-copy-async (candidate)
3355   "Anything find files action to copy files async.
3356 Copying is done asynchronously with `anything-c-copy-files-async-1'."
3357   (let* ((flist (anything-marked-candidates))
3358          (dest  (anything-c-read-file-name
3359                  (anything-find-files-set-prompt-for-action
3360                   "Copy Async" flist)
3361                  :preselect candidate
3362                  :initial-input (car anything-ff-history)
3363                  :history (anything-find-files-history :comp-read nil))))
3364     (anything-c-copy-async-with-log flist dest)))
3365
3366 (defvar eshell-command-aliases-list nil)
3367 (defvar anything-eshell-command-on-file-input-history nil)
3368 (defun anything-find-files-eshell-command-on-file-1 (candidate &optional map)
3369   "Run `eshell-command' on CANDIDATE or marked candidates.
3370 This is done possibly with an eshell alias, if no alias found, you can type in
3371 an eshell command.
3372
3373 Basename of CANDIDATE can be a wild-card.
3374 e.g you can do \"eshell-command command *.el\"
3375 Where \"*.el\" is the CANDIDATE.
3376
3377 It is possible to do eshell-command command <CANDIDATE> <some more args>
3378 like this: \"command %s some more args\".
3379
3380 If MAP is given run `eshell-command' on all marked files at once,
3381 Otherwise, run `eshell-command' on each marked files.
3382 In other terms, with a prefix arg do on the three marked files
3383 \"foo\" \"bar\" \"baz\":
3384
3385 \"eshell-command command foo bar baz\"
3386
3387 otherwise do
3388
3389 \"eshell-command command foo\"
3390 \"eshell-command command bar\"
3391 \"eshell-command command baz\"
3392
3393 Note:
3394 If `eshell' or `eshell-command' have not been run once,
3395 or if you have no eshell aliases `eshell-command-aliases-list'
3396 will not be loaded first time you use this."
3397   (when (or eshell-command-aliases-list
3398             (y-or-n-p "Eshell is not loaded, run eshell-command without alias anyway? "))
3399     (and eshell-command-aliases-list (eshell-read-aliases-list))
3400     (let* ((cand-list (anything-marked-candidates))
3401            (default-directory (or anything-ff-default-directory
3402                                   ;; If candidate is an url *-ff-default-directory is nil
3403                                   ;; so keep value of default-directory.
3404                                   default-directory))
3405            (command (anything-comp-read
3406                      "Command: "
3407                      (loop for (a . c) in eshell-command-aliases-list
3408                            when (string-match "\\(\\$1\\|\\$\\*\\)$" (car c))
3409                            collect (propertize a 'help-echo (car c)) into ls
3410                            finally return (sort ls 'string<))
3411                      :buffer "*esh command on file*"
3412                      :name "Eshell command"
3413                      :keymap anything-esh-on-file-map
3414                      :mode-line
3415                      '("Eshell alias"
3416                        "C-c ?: Help, \\[universal-argument]: Insert output at point")
3417                      :input-history
3418                      'anything-eshell-command-on-file-input-history))
3419            (alias-value (car (assoc-default command eshell-command-aliases-list))))
3420       (when (and (= (length cand-list) 1)
3421                  (string-match "[*]" (anything-c-basename (car cand-list))))
3422         (setq cand-list (file-expand-wildcards (car cand-list) t)))
3423       ;; Be sure output don't go in current buffer
3424       ;; but allow sending output to current buffer
3425       ;; if a prefix arg have been passed during the
3426       ;; `anything-comp-read' call.
3427       (setq current-prefix-arg anything-current-prefix-arg)
3428       ;; MAP have been set before calling `anything-comp-read'
3429       ;; by `anything-current-prefix-arg'.
3430       (if (and (or map ; prefix-arg
3431                    (and alias-value
3432                         ;; If command is an alias be sure it accept
3433                         ;; more than one arg i.e $*.
3434                         (string-match "\\$\\*$" alias-value)))
3435                (> (length cand-list) 1))
3436
3437           ;; Run eshell-command with ALL marked files as arguments.
3438           (let ((mapfiles (mapconcat 'shell-quote-argument cand-list " ")))
3439             (if (string-match "'%s'\\|\"%s\"\\|%s" command)
3440                 (eshell-command (format command mapfiles)) ; See [1]
3441                 (eshell-command (format "%s %s" command mapfiles))))
3442
3443           ;; Run eshell-command on EACH marked files.
3444           (loop for i in cand-list
3445                 for bn = (anything-c-basename i)
3446                 for files = (format "'%s'" i)
3447                 for com = (if (string-match "'%s'\\|\"%s\"\\|%s" command)
3448                               ;; [1] This allow to enter other args AFTER filename
3449                               ;; i.e <command %s some_more_args>
3450                               (format command files)
3451                               (format "%s %s" command files))
3452                 do (eshell-command com))))))
3453
3454 (defun anything-find-files-eshell-command-on-file (candidate)
3455   "Run `eshell-command' on CANDIDATE or marked candidates.
3456 See `anything-find-files-eshell-command-on-file-1' for more info."
3457   (anything-find-files-eshell-command-on-file-1
3458    candidate anything-current-prefix-arg))
3459
3460 (defun anything-ff-switch-to-eshell (candidate)
3461   "Switch to eshell and cd to `anything-ff-default-directory'."
3462   (flet ((cd-eshell ()
3463            (goto-char (point-max))
3464            (insert
3465             (format "cd '%s'" anything-ff-default-directory))
3466            (eshell-send-input)))
3467     (if (get-buffer "*eshell*")
3468         (progn
3469           (anything-c-switch-to-buffer "*eshell*")
3470           (cd-eshell))
3471         (call-interactively 'eshell)
3472         (cd-eshell))))
3473
3474 (defun anything-ff-serial-rename-action (method)
3475   "Rename all marked files to `anything-ff-default-directory' with METHOD.
3476 See `anything-ff-serial-rename-1'."
3477   (let* ((cands     (anything-marked-candidates))
3478          (def-name  (car cands))
3479          (name      (read-string "NewName: "
3480                                  (replace-regexp-in-string
3481                                   "[0-9]+$" ""
3482                                   (anything-c-basename
3483                                    def-name
3484                                    (file-name-extension def-name)))))
3485          (start     (read-number "StartAtNumber: "))
3486          (extension (read-string "Extension: "
3487                                  (file-name-extension (car cands))))
3488          (dir       (expand-file-name
3489                      (anything-c-read-file-name
3490                       "Serial Rename to directory: "
3491                       :initial-input
3492                       (expand-file-name anything-ff-default-directory)
3493                       :test 'file-directory-p
3494                       :must-match t)))
3495          (res       (loop for f in cands
3496                           for bn = (anything-c-basename f)
3497                           for count from start
3498                           concat (format "%s <-> %s%s.%s\n"
3499                                          bn name count extension))))
3500     (if (y-or-n-p
3501          (format "Result:\n %sRename like this to <%s> ? " res dir))
3502         (progn
3503           (anything-ff-serial-rename-1
3504            dir cands name start extension :method method)
3505           (message nil)
3506           (anything-find-files-1 dir))
3507         (message "Operation aborted"))))
3508
3509 (defun anything-ff-member-directory-p (file directory)
3510   (let ((dir-file (expand-file-name
3511                    (file-name-as-directory (file-name-directory file))))
3512         (cur-dir  (expand-file-name (file-name-as-directory directory))))
3513     (string= dir-file cur-dir)))
3514
3515 (defun* anything-ff-serial-rename-1
3516     (directory collection new-name start-at-num extension &key (method 'rename))
3517   "rename files in COLLECTION to DIRECTORY with the prefix name NEW-NAME.
3518 Rename start at number START-AT-NUM - ex: prefixname-01.jpg.
3519 EXTENSION is the file extension to use, in empty prompt,
3520 reuse the original extension of file.
3521 METHOD can be one of rename, copy or symlink.
3522 Files will be renamed if they are files of current directory, otherwise they
3523 will be treated with METHOD.
3524 Default METHOD is rename."
3525   ;; Maybe remove directories selected by error in collection.
3526   (setq collection (remove-if 'file-directory-p collection))
3527   (flet ((symlink-file (file dest)
3528            (let ((flist (list file)))
3529              (anything-dired-action
3530               dest :action 'symlink :files flist))))
3531
3532     (let* ((tmp-dir  (file-name-as-directory
3533                       (concat (file-name-as-directory directory)
3534                               (symbol-name (gensym "tmp")))))
3535            (fn       (case method
3536                        (copy    'copy-file)
3537                        (symlink 'symlink-file)
3538                        (rename  'rename-file)
3539                        (t (error "Error: Unknow method %s" method)))))
3540       (make-directory tmp-dir)
3541       (unwind-protect
3542            (progn
3543              ;; Rename all files to tmp-dir with new-name.
3544              ;; If files are not from start directory, use method
3545              ;; to move files to tmp-dir.
3546              (loop for i in collection
3547                    for count from start-at-num
3548                    for fnum = (if (< count 10) "0%s" "%s")
3549                    for nname = (concat tmp-dir new-name (format fnum count)
3550                                        (if (not (string= extension ""))
3551                                            (format ".%s" (replace-regexp-in-string
3552                                                           "[.]" "" extension))
3553                                            (file-name-extension i 'dot)))
3554                    do (if (anything-ff-member-directory-p i directory)
3555                           (rename-file i nname)
3556                           (funcall fn i nname)))
3557              ;; Now move all from tmp-dir to destination.
3558              (loop with dirlist = (directory-files
3559                                    tmp-dir t directory-files-no-dot-files-regexp)
3560                    for f in dirlist do
3561                    (if (file-symlink-p f)
3562                        (symlink-file (file-truename f)
3563                                      (concat (file-name-as-directory directory)
3564                                              (anything-c-basename f)))
3565                        (rename-file f directory))))
3566         (delete-directory tmp-dir t)))))
3567
3568 (defun anything-ff-serial-rename (candidate)
3569   "Serial rename all marked files to `anything-ff-default-directory'.
3570 Rename only file of current directory, and symlink files coming from
3571 other directories.
3572 See `anything-ff-serial-rename-1'."
3573   (anything-ff-serial-rename-action 'rename))
3574
3575 (defun anything-ff-serial-rename-by-symlink (candidate)
3576   "Serial rename all marked files to `anything-ff-default-directory'.
3577 Rename only file of current directory, and symlink files coming from
3578 other directories.
3579 See `anything-ff-serial-rename-1'."
3580   (anything-ff-serial-rename-action 'symlink))
3581
3582 (defun anything-ff-serial-rename-by-copying (candidate)
3583   "Serial rename all marked files to `anything-ff-default-directory'.
3584 Rename only file of current directory, and copy files coming from
3585 other directories.
3586 See `anything-ff-serial-rename-1'."
3587   (anything-ff-serial-rename-action 'copy))
3588
3589 (defun anything-c-quit-and-execute-action (action)
3590   "Quit current anything session and execute ACTION."
3591   (setq anything-saved-action action)
3592   (anything-exit-minibuffer))
3593
3594 (defun anything-ff-toggle-auto-update (candidate)
3595   (setq anything-ff-auto-update-flag (not anything-ff-auto-update-flag))
3596   (message "[Auto expansion %s]"
3597            (if anything-ff-auto-update-flag "enabled" "disabled")))
3598
3599 ;;;###autoload
3600 (defun anything-ff-run-toggle-auto-update ()
3601   (interactive)
3602   (when (anything-file-completion-source-p)
3603     (anything-attrset 'toggle-auto-update 'anything-ff-toggle-auto-update)
3604     (anything-execute-persistent-action 'toggle-auto-update)))
3605
3606 ;;;###autoload
3607 (defun anything-ff-run-switch-to-history ()
3608   "Run Switch to history action from `anything-c-source-find-files'."
3609   (interactive)
3610   (when (anything-file-completion-source-p)
3611     (anything-c-quit-and-execute-action 'anything-find-files-switch-to-hist)))
3612
3613 ;;;###autoload
3614 (defun anything-ff-run-grep ()
3615   "Run Grep action from `anything-c-source-find-files'."
3616   (interactive)
3617   (when (anything-file-completion-source-p)
3618     (anything-c-quit-and-execute-action 'anything-find-files-grep)))
3619
3620 ;;;###autoload
3621 (defun anything-ff-run-pdfgrep ()
3622   "Run Pdfgrep action from `anything-c-source-find-files'."
3623   (interactive)
3624   (when (anything-file-completion-source-p)
3625     (anything-c-quit-and-execute-action 'anything-ff-pdfgrep)))
3626
3627 ;;;###autoload
3628 (defun anything-ff-run-zgrep ()
3629   "Run Grep action from `anything-c-source-find-files'."
3630   (interactive)
3631   (when (anything-file-completion-source-p)
3632     (anything-c-quit-and-execute-action 'anything-ff-zgrep)))
3633
3634 ;;;###autoload
3635 (defun anything-ff-run-copy-file ()
3636   "Run Copy file action from `anything-c-source-find-files'."
3637   (interactive)
3638   (when (anything-file-completion-source-p)
3639     (anything-c-quit-and-execute-action 'anything-find-files-copy)))
3640
3641 ;;;###autoload
3642 (defun anything-ff-run-rename-file ()
3643   "Run Rename file action from `anything-c-source-find-files'."
3644   (interactive)
3645   (when (anything-file-completion-source-p)
3646     (anything-c-quit-and-execute-action 'anything-find-files-rename)))
3647
3648 ;;;###autoload
3649 (defun anything-ff-run-byte-compile-file ()
3650   "Run Byte compile file action from `anything-c-source-find-files'."
3651   (interactive)
3652   (when (anything-file-completion-source-p)
3653     (anything-c-quit-and-execute-action 'anything-find-files-byte-compile)))
3654
3655 ;;;###autoload
3656 (defun anything-ff-run-load-file ()
3657   "Run Load file action from `anything-c-source-find-files'."
3658   (interactive)
3659   (when (anything-file-completion-source-p)
3660     (anything-c-quit-and-execute-action 'anything-find-files-load-files)))
3661
3662 ;;;###autoload
3663 (defun anything-ff-run-eshell-command-on-file ()
3664   "Run eshell command on file action from `anything-c-source-find-files'."
3665   (interactive)
3666   (when (anything-file-completion-source-p)
3667     (anything-c-quit-and-execute-action
3668      'anything-find-files-eshell-command-on-file)))
3669
3670 ;;;###autoload
3671 (defun anything-ff-run-ediff-file ()
3672   "Run Ediff file action from `anything-c-source-find-files'."
3673   (interactive)
3674   (when (anything-file-completion-source-p)
3675     (anything-c-quit-and-execute-action 'anything-find-files-ediff-files)))
3676
3677 ;;;###autoload
3678 (defun anything-ff-run-ediff-merge-file ()
3679   "Run Ediff merge file action from `anything-c-source-find-files'."
3680   (interactive)
3681   (when (anything-file-completion-source-p)
3682     (anything-c-quit-and-execute-action
3683      'anything-find-files-ediff-merge-files)))
3684
3685 ;;;###autoload
3686 (defun anything-ff-run-symlink-file ()
3687   "Run Symlink file action from `anything-c-source-find-files'."
3688   (interactive)
3689   (when (anything-file-completion-source-p)
3690     (anything-c-quit-and-execute-action 'anything-find-files-symlink)))
3691
3692 ;;;###autoload
3693 (defun anything-ff-run-hardlink-file ()
3694   "Run Hardlink file action from `anything-c-source-find-files'."
3695   (interactive)
3696   (when (anything-file-completion-source-p)
3697     (anything-c-quit-and-execute-action 'anything-find-files-hardlink)))
3698
3699 ;;;###autoload
3700 (defun anything-ff-run-delete-file ()
3701   "Run Delete file action from `anything-c-source-find-files'."
3702   (interactive)
3703   (when (anything-file-completion-source-p)
3704     (anything-c-quit-and-execute-action 'anything-delete-marked-files)))
3705
3706 ;;;###autoload
3707 (defun anything-ff-run-complete-fn-at-point ()
3708   "Run complete file name action from `anything-c-source-find-files'."
3709   (interactive)
3710   (when (anything-file-completion-source-p)
3711     (anything-c-quit-and-execute-action
3712      'anything-c-insert-file-name-completion-at-point)))
3713
3714 ;;;###autoload
3715 (defun anything-ff-run-switch-to-eshell ()
3716   "Run switch to eshell action from `anything-c-source-find-files'."
3717   (interactive)
3718   (when (anything-file-completion-source-p)
3719     (anything-c-quit-and-execute-action 'anything-ff-switch-to-eshell)))
3720
3721 ;;;###autoload
3722 (defun anything-ff-run-switch-other-window ()
3723   "Run switch to other window action from `anything-c-source-find-files'."
3724   (interactive)
3725   (when (anything-file-completion-source-p)
3726     (anything-c-quit-and-execute-action 'find-file-other-window)))
3727
3728 ;;;###autoload
3729 (defun anything-ff-run-switch-other-frame ()
3730   "Run switch to other frame action from `anything-c-source-find-files'."
3731   (interactive)
3732   (when (anything-file-completion-source-p)
3733     (anything-c-quit-and-execute-action 'find-file-other-frame)))
3734
3735 ;;;###autoload
3736 (defun anything-ff-run-open-file-externally ()
3737   "Run open file externally command action from `anything-c-source-find-files'."
3738   (interactive)
3739   (when (anything-file-completion-source-p)
3740     (anything-c-quit-and-execute-action 'anything-c-open-file-externally)))
3741
3742 (defun anything-ff-locate (candidate)
3743   "Locate action function for `anything-find-files'."
3744   (let ((input (concat (anything-c-basename
3745                         (expand-file-name
3746                          candidate
3747                          anything-ff-default-directory))
3748                        ;; The locate '-b' option doesn't exists
3749                        ;; in everything.
3750                        (unless (and (eq system-type 'windows-nt)
3751                                     (string-match "^es" anything-c-locate-command))
3752                          " -b")))
3753         (anything-mp-highlight-delay 0.7))
3754     (anything-locate-1 anything-current-prefix-arg input 'from-ff)))
3755
3756 ;;;###autoload
3757 (defun anything-ff-run-locate ()
3758   "Run locate action from `anything-c-source-find-files'."
3759   (interactive)
3760   (when (anything-file-completion-source-p)
3761     (anything-c-quit-and-execute-action 'anything-ff-locate)))
3762
3763 ;;;###autoload
3764 (defun anything-ff-run-gnus-attach-files ()
3765   "Run gnus attach files command action from `anything-c-source-find-files'."
3766   (interactive)
3767   (when (anything-file-completion-source-p)
3768     (anything-c-quit-and-execute-action 'anything-ff-gnus-attach-files)))
3769
3770 ;;;###autoload
3771 (defun anything-ff-run-etags ()
3772   "Run Etags command action from `anything-c-source-find-files'."
3773   (interactive)
3774   (when (anything-file-completion-source-p)
3775     (anything-c-quit-and-execute-action 'anything-ff-etags-select)))
3776
3777 (defun anything-ff-print (candidate)
3778   "Print marked files.
3779 You have to set in order
3780 variables `lpr-command',`lpr-switches' and/or `printer-name'.
3781
3782 e.g:
3783 \(setq lpr-command \"gtklp\"\)
3784 \(setq lpr-switches '(\"-P\")\)
3785 \(setq printer-name \"Epson-Stylus-Photo-R265\"\)
3786
3787 Same as `dired-do-print' but for anything."
3788   (when (or anything-current-prefix-arg
3789             (not anything-ff-printer-list))
3790     (setq anything-ff-printer-list
3791           (anything-ff-find-printers)))
3792   (let* ((file-list (anything-marked-candidates))
3793          (len (length file-list))
3794          (printer-name (if anything-ff-printer-list
3795                            (anything-comp-read
3796                             "Printer: " anything-ff-printer-list)
3797                            printer-name))
3798          (command (read-string
3799                    (format "Print *%s File(s):\n%s with: "
3800                            len
3801                            (mapconcat
3802                             (lambda (f) (format "- %s\n" f))
3803                             file-list ""))
3804                    (when (and lpr-command
3805                               (or lpr-switches
3806                                   printer-name))
3807                      (mapconcat 'identity
3808                                 (cons lpr-command
3809                                       (append (if (stringp lpr-switches)
3810                                                   (list lpr-switches)
3811                                                   lpr-switches)
3812                                               (list printer-name)))
3813                                 " "))))
3814          (file-args (mapconcat #'(lambda (x)
3815                                    (format "'%s'" x))
3816                                file-list " "))
3817          (cmd-line (concat command " " file-args)))
3818     (if command
3819         (start-process-shell-command "anything-print" nil cmd-line)
3820         (error "Error: Please verify your printer settings in Emacs."))))
3821
3822 ;;;###autoload
3823 (defun anything-ff-run-print-file ()
3824   "Run Print file action from `anything-c-source-find-files'."
3825   (interactive)
3826   (when (anything-file-completion-source-p)
3827     (anything-c-quit-and-execute-action 'anything-ff-print)))
3828
3829 (defun anything-ff-checksum (file)
3830   "Calculate the checksum of FILE.
3831 Provide completion on different algorithms to use on Emacs24.
3832 On Emacs23 only 'sha1' is available.
3833 The checksum is copied to kill-ring."
3834   (let ((algo-list (and (fboundp 'secure-hash)
3835                         '(md5 sha1 sha224 sha256 sha384 sha512))))
3836     (kill-new
3837      (if algo-list
3838          (secure-hash (intern
3839                        (anything-comp-read
3840                         "Algorithm: " algo-list))
3841                       file)
3842          (sha1 (with-temp-buffer
3843                  (insert-file-contents file)
3844                  (buffer-string)))))
3845     (message "Checksum copied to kill-ring.")))
3846
3847 (defun anything-ff-toggle-basename (candidate)
3848   (setq anything-ff-transformer-show-only-basename
3849         (not anything-ff-transformer-show-only-basename))
3850   (let ((target (if anything-ff-transformer-show-only-basename
3851                     (anything-c-basename candidate) candidate)))
3852     (anything-force-update target)))
3853
3854 (defun anything-ff-run-toggle-basename ()
3855   (interactive)
3856   (when (anything-file-completion-source-p)
3857     (anything-attrset 'toggle-basename 'anything-ff-toggle-basename)
3858     (anything-execute-persistent-action 'toggle-basename)))
3859
3860 (defun* anything-reduce-file-name (fname level &key unix-close expand)
3861   "Reduce FNAME by LEVEL from end or beginning depending LEVEL value.
3862 If LEVEL is positive reduce from end else from beginning.
3863 If UNIX-CLOSE is non--nil close filename with /.
3864 If EXPAND is non--nil expand-file-name."
3865   (let* ((exp-fname  (expand-file-name fname))
3866          (fname-list (split-string (if (or (string= fname "~/") expand)
3867                                        exp-fname fname) "/" t))
3868          (len        (length fname-list))
3869          (pop-list   (if (< level 0)
3870                          (subseq fname-list (* level -1))
3871                          (subseq fname-list 0 (- len level))))
3872          (result     (mapconcat 'identity pop-list "/"))
3873          (empty      (string= result "")))
3874     (when unix-close (setq result (concat result "/")))
3875     (if (string-match "^~" result)
3876         (if (string= result "~/") "~/" result)
3877         (if (< level 0)
3878             (if empty "../" (concat "../" result))
3879             (cond ((eq system-type 'windows-nt)
3880                    (if empty (expand-file-name "/") ; Expand to "/" or "c:/".
3881                        result))
3882                   (empty "/")
3883                   (t
3884                    (concat "/" result)))))))
3885
3886 ;; Internal
3887 (defvar anything-file-completion-sources
3888   '("Find Files" "Read File Name"
3889     "Read File Name History" "Copy Files"
3890     "Rename Files" "Symlink Files"
3891     "Hardlink Files" "Write File" "Insert File")
3892   "Sources that use the *find-files mechanism can be added here.
3893 Sources generated by `ac-mode' don't need to be added here, it will
3894 be done automatically.
3895 You should not modify this yourself unless you know what you do.")
3896
3897 (defun anything-file-completion-source-p ()
3898   "Return non--nil if current source is a file completion source.
3899 A source is a file completion source if it is
3900 one of `anything-file-completion-sources'.
3901 Return nil if anything is not running."
3902   (let ((cur-source (cdr (assoc 'name (anything-get-current-source)))))
3903     (loop for i in anything-file-completion-sources
3904           thereis (string= cur-source i))))
3905
3906 (defun anything-find-files-down-one-level (arg)
3907   "Go down one level like unix command `cd ..'.
3908 If prefix numeric arg is given go ARG level down."
3909   (interactive "p")
3910   (when (and (anything-file-completion-source-p)
3911              (not (anything-ff-invalid-tramp-name-p)))
3912     (with-anything-window
3913       (setq anything-follow-mode nil))
3914     ;; When going to precedent level we want to be at the line
3915     ;; corresponding to actual directory, so store this info
3916     ;; in `anything-ff-last-expanded'.
3917     (if (and (not (file-directory-p anything-pattern))
3918              (file-exists-p anything-pattern))
3919         (setq anything-ff-last-expanded anything-pattern)
3920         (setq anything-ff-last-expanded anything-ff-default-directory))
3921     (let ((new-pattern (anything-reduce-file-name anything-pattern arg
3922                                                   :unix-close t :expand t)))
3923       (anything-set-pattern new-pattern))))
3924
3925 (defun anything-ff-retrieve-last-expanded ()
3926   "Move overlay to last visited directory `anything-ff-last-expanded'.
3927 This happen after using `anything-find-files-down-one-level',
3928 or hitting C-z on \"..\"."
3929   (when (and anything-ff-last-expanded
3930              (anything-file-completion-source-p))
3931     (let ((presel (if anything-ff-transformer-show-only-basename
3932                        (anything-c-basename
3933                         (directory-file-name anything-ff-last-expanded))
3934                        (directory-file-name anything-ff-last-expanded))))
3935       (with-anything-window
3936         (when (re-search-forward
3937                (concat "^" (regexp-quote presel) "$") nil t)
3938           (forward-line 0)
3939           (anything-mark-current-line)))
3940       (setq anything-ff-last-expanded nil))))
3941 (add-hook 'anything-after-update-hook 'anything-ff-retrieve-last-expanded)
3942
3943 ;; Auto-update - anything-find-files auto expansion of directories.
3944 ;;
3945 (defun anything-ff-update-when-only-one-matched ()
3946   "Expand to directory when sole completion.
3947 When only one candidate is remaining and it is a directory,
3948 expand to this directory."
3949   (when (and anything-ff-auto-update-flag
3950              (anything-file-completion-source-p)
3951              (not (anything-ff-invalid-tramp-name-p)))
3952     (let* ((history-p   (string= (assoc-default
3953                                   'name (anything-get-current-source))
3954                                  "Read File Name History"))
3955            (pat         (if (string-match tramp-file-name-regexp
3956                                           anything-pattern)
3957                             (anything-create-tramp-name anything-pattern)
3958                             anything-pattern))
3959            (completed-p (string= (file-name-as-directory pat)
3960                                  anything-ff-default-directory)))
3961       (when (and (or
3962                   ;; Only one candidate remaining
3963                   ;; and at least 2 char in basename.
3964                   (and (<= (anything-approximate-candidate-number) 2)
3965                        (>= (length (anything-c-basename anything-pattern)) 2))
3966                   ;; Already completed.
3967                   completed-p)
3968                  (not history-p)) ; Don't try to auto complete in history.
3969         (with-anything-window
3970           (let ((cur-cand (prog2
3971                               (unless completed-p
3972                                 ;; Only one non--existing candidate
3973                                 ;; and one directory candidate, move to it.
3974                                 (anything-next-line))
3975                               (anything-get-selection))))
3976             (when (and (stringp cur-cand) (file-directory-p cur-cand))
3977               (if (and (not (string-match "^.*[.]\\{1,2\\}$" cur-cand)) ; [1]
3978                        ;; Maybe we are here because completed-p is true
3979                        ;; but check this again to be sure. (Windows fix)
3980                        (<= (anything-approximate-candidate-number) 2)) ; [2]
3981                   ;; If after going to next line the candidate
3982                   ;; is not one of "." or ".." [1]
3983                   ;; and only one candidate is remaining [2],
3984                   ;; assume candidate is a new directory to expand, and do it.
3985                   (anything-set-pattern (file-name-as-directory cur-cand))
3986                   ;; The candidate is one of "." or ".."
3987                   ;; that mean we have entered the last letter of the directory name
3988                   ;; in prompt, so expansion is already done, just add the "/" at end
3989                   ;; of name unless anything-pattern ends with "."
3990                   ;; (i.e we are writing something starting with ".")
3991                   (unless (string-match "^.*[.]\\{1\\}$" anything-pattern)
3992                     (anything-set-pattern
3993                      ;; Need to expand-file-name to avoid e.g /ssh:host:./ in prompt.
3994                      (expand-file-name (file-name-as-directory anything-pattern)))))
3995               (anything-check-minibuffer-input-1))))))))
3996 (add-hook 'anything-after-update-hook 'anything-ff-update-when-only-one-matched)
3997
3998 ;; Allow expanding to home directory or root
3999 ;; when entering respectively "~/" or "//" at end of pattern.
4000 ;; e.g /home/thierry/labo/anything-config-qp/~/
4001 ;; will expand to "~/"
4002 ;; and /home/thierry/labo/anything-config-qp//
4003 ;; will expand to "/"
4004 (defun anything-ff-auto-expand-to-home-or-root ()
4005   "Goto home, root or default directory when pattern ends with ~/, /, or ./.
4006 This happen only in function using sources that are
4007 `anything-file-completion-source-p' compliant."
4008   (when (and (anything-file-completion-source-p)
4009              (string-match ".*\\(/~/\\|/\\{2\\}\\|/[.]\\{1\\}/\\)$"
4010                            anything-pattern)
4011              (not (string-match anything-ff-url-regexp anything-pattern)))
4012     (let ((match (match-string 1 anything-pattern)))
4013       (cond ((string= match "//")
4014              ;; Expand to "/" or "c:/"
4015              (setq anything-pattern (expand-file-name "/")))
4016             ((string= match "/~/")
4017              (if (eq system-type 'windows-nt)
4018                  (setq anything-pattern (file-name-as-directory (getenv "HOME")))
4019                  (setq anything-pattern "~/")))
4020             ((string= match "/./")
4021              (setq anything-pattern
4022                    (with-anything-current-buffer
4023                      (expand-file-name default-directory))))))
4024     (setq anything-ff-default-directory anything-pattern)
4025     ;; For some reasons, i must use here with-current-buffer => mini buffer
4026     ;; and not `anything-set-pattern' that use with-selected-window => mini win.
4027     (with-current-buffer (window-buffer (minibuffer-window))
4028       (delete-minibuffer-contents)
4029       (insert anything-pattern))))
4030
4031 (add-hook 'anything-after-update-hook 'anything-ff-auto-expand-to-home-or-root)
4032
4033 (defun anything-c-point-file-in-dired (file)
4034   "Put point on filename FILE in dired buffer."
4035   (dired (file-name-directory file))
4036   (dired-goto-file file))
4037
4038 (defun anything-create-tramp-name (fname)
4039   "Build filename for `anything-pattern' like /su:: or /sudo::."
4040   (apply #'tramp-make-tramp-file-name
4041          (loop with v = (tramp-dissect-file-name fname)
4042                for i across v collect i)))
4043
4044 (defun* anything-ff-tramp-hostnames (&optional (pattern anything-pattern))
4045   "Get a list of hosts for tramp method found in `anything-pattern'.
4046 Argument PATTERN default to `anything-pattern', it is here only for debugging
4047 purpose."
4048   (when (string-match tramp-file-name-regexp pattern)
4049     (let ((method      (match-string 1 pattern))
4050           (tn          (match-string 0 pattern))
4051           (all-methods (mapcar 'car tramp-methods)))
4052       (anything-fast-remove-dups
4053        (loop for (f . h) in (tramp-get-completion-function method)
4054              append (loop for e in (funcall f (car h))
4055                           for host = (and (consp e) (cadr e))
4056                           when (and host (not (member host all-methods)))
4057                           collect (concat tn host)))
4058        :test 'equal))))
4059
4060 (defun anything-ff-before-action-hook-fn ()
4061   "Exit anything when user try to execute action on an invalid tramp fname."
4062   (let ((cand (anything-get-selection)))
4063     (when (and (anything-file-completion-source-p)
4064                (anything-ff-invalid-tramp-name-p cand) ; Check candidate.
4065                (anything-ff-invalid-tramp-name-p)) ; check anything-pattern.
4066       (error "Error: Unknow file or directory `%s'" cand))))
4067 (add-hook 'anything-before-action-hook 'anything-ff-before-action-hook-fn)
4068
4069 (defun* anything-ff-invalid-tramp-name-p (&optional (pattern anything-pattern))
4070   "Return non--nil when PATTERN is an invalid tramp filename."
4071   (string= (anything-ff-set-pattern pattern)
4072            "Invalid tramp file name"))
4073
4074 (defun anything-ff-set-pattern (pattern)
4075   "Handle tramp filenames in `anything-pattern'."
4076   (let ((methods (mapcar 'car tramp-methods))
4077         (reg "\\`/\\([^[/:]+\\|[^/]+]\\):.*:")
4078         cur-method tramp-name)
4079     (cond ((string= pattern "") "")
4080           ((string-match ".*\\(~?/?[.]\\{1\\}/\\)$" pattern)
4081            (with-anything-current-buffer
4082              (expand-file-name default-directory)))
4083           ((and (string-match ".*\\(~//\\|//\\)$" pattern)
4084                 (not (string-match anything-ff-url-regexp anything-pattern)))
4085            (expand-file-name "/") ; Expand to "/" or "c:/"
4086            )
4087           ((string-match "^~\\|.*/~/$" pattern)
4088            (let* ((home (expand-file-name (getenv "HOME"))))
4089              (replace-match home nil t pattern)))
4090           ;; Match "/method:maybe_hostname:"
4091           ((and (string-match reg pattern)
4092                 (setq cur-method (match-string 1 pattern))
4093                 (member cur-method methods))
4094            (setq tramp-name (anything-create-tramp-name
4095                              (match-string 0 pattern)))
4096            (replace-match tramp-name nil t pattern))
4097           ;; Match "/hostname:"
4098           ((and (string-match  tramp-file-name-regexp pattern)
4099                 (setq cur-method (match-string 1 pattern))
4100                 (and cur-method (not (member cur-method methods))))
4101            (setq tramp-name (anything-create-tramp-name
4102                              (match-string 0 pattern)))
4103            (replace-match tramp-name nil t pattern))
4104           ;; Match "/method:" in this case don't try to connect.
4105           ((and (not (string-match reg pattern))
4106                 (string-match tramp-file-name-regexp pattern)
4107                 (member (match-string 1 pattern) methods))
4108            "Invalid tramp file name")   ; Write in anything-buffer.
4109           ;; PATTERN is a directory, end it with "/".
4110           ;; This will make PATTERN not ending yet with "/"
4111           ;; candidate for `anything-ff-default-directory',
4112           ;; allowing `anything-ff-retrieve-last-expanded' to retrieve it
4113           ;; when descending level.
4114           ((file-directory-p pattern)
4115            (file-name-as-directory pattern))
4116           ;; Return PATTERN unchanged.
4117           (t pattern))))
4118
4119 (defun anything-find-files-get-candidates (&optional require-match)
4120   "Create candidate list for `anything-c-source-find-files'."
4121   (let* ((path          (anything-ff-set-pattern anything-pattern))
4122          (path-name-dir (if (file-directory-p path)
4123                             (file-name-as-directory path)
4124                             (file-name-directory path)))
4125          (tramp-verbose anything-tramp-verbose)) ; No tramp message when 0.
4126     (set-text-properties 0 (length path) nil path)
4127     ;; Don't set now `anything-pattern' if `path' == "Invalid tramp file name"
4128     ;; like that the actual value (e.g /ssh:) is passed to
4129     ;; `anything-ff-tramp-hostnames'.
4130     (unless (string= path "Invalid tramp file name")
4131       (setq anything-pattern (anything-ff-transform-fname-for-completion path)))
4132     (setq anything-ff-default-directory
4133           (if (string= anything-pattern "")
4134               (expand-file-name "/") ; Expand to "/" or "c:/"
4135               ;; If path is an url *default-directory have to be nil.
4136               (unless (or (string-match anything-ff-url-regexp path)
4137                           (string-match ffap-url-regexp path))
4138                 path-name-dir)))
4139     (cond ((string= path "Invalid tramp file name")
4140            (or (anything-ff-tramp-hostnames) ; Hostnames completion.
4141                (prog2
4142                    ;; `anything-pattern' have not been modified yet.
4143                    ;; Set it here to the value of `path' that should be now
4144                    ;; "Invalid tramp file name" and set the candidates list
4145                    ;; to ("Invalid tramp file name") to make `anything-pattern'
4146                    ;; match single candidate "Invalid tramp file name".
4147                    (setq anything-pattern path)
4148                    ;; "Invalid tramp file name" is now printed
4149                    ;; in `anything-buffer'.
4150                    (list path))))
4151           ((or (file-regular-p path)
4152                ;; `ffap-url-regexp' don't match until url is complete.
4153                (string-match anything-ff-url-regexp path)
4154                (and (not (file-exists-p path)) (string-match "/$" path))
4155                (and ffap-url-regexp (string-match ffap-url-regexp path)))
4156            (list path))
4157           ((string= path "") (anything-ff-directory-files "/" t))
4158           ((and (file-directory-p path) (not (file-readable-p path)))
4159            (list (format "Opening directory: access denied, `%s'" path)))
4160           ((file-directory-p path) (anything-ff-directory-files path t))
4161           (t
4162            (append (list path) ; No need to check for must-match.
4163                    (anything-ff-directory-files path-name-dir t))))))
4164
4165 (defun anything-ff-directory-files (directory &optional full)
4166   "List contents of DIRECTORY.
4167 Argument FULL mean absolute path.
4168 It is same as `directory-files' but always returns the
4169 dotted filename '.' and '..' on root directories on Windows
4170 systems."
4171   (setq directory (expand-file-name directory))
4172   (let ((ls (directory-files directory full))
4173         dot dot2 lsdir)
4174     (if (or
4175          ;; A windows volume.
4176          (string-match "^[a-zA-Z]\\{1\\}:/$" directory)
4177          ;; Empty directories on ftp hosts may have no dot dirs.
4178          (and (file-remote-p directory)
4179               (string-match "^/ftp:" directory)))
4180         (progn (setq dot (concat directory "."))
4181                (setq dot2 (concat directory ".."))
4182                (setq lsdir (remove dot2 (remove dot ls)))
4183                (append (list dot dot2) lsdir))
4184         ls)))
4185
4186 (defun anything-ff-transform-fname-for-completion (fname)
4187   "Return FNAME with it's basename modified as a regexp.
4188 e.g foo => f.*o.*o .
4189 If basename contain one or more space or FNAME is a valid directory name
4190 return FNAME unchanged."
4191   (let ((bn (anything-c-basename fname)))
4192     (if (or (not anything-ff-smart-completion)
4193             (string-match "\\s-" bn)
4194             (string-match "/$" fname) ; Allow mkdir.
4195             (file-directory-p fname)
4196             (string-match anything-ff-url-regexp fname))
4197         fname ; Fall back to match-plugin.
4198         (setq bn (if (> (length bn) 2) ; Normal completion on first 2 char.
4199                      (mapconcat 'identity (split-string bn "" t) ".*") bn))
4200         (concat (file-name-directory fname) bn))))
4201
4202 (defun anything-ff-save-history ()
4203   "Store the last value of `anything-ff-default-directory' \
4204 in `anything-ff-history'."
4205   (when (and anything-ff-default-directory
4206              (anything-file-completion-source-p))
4207     (push anything-ff-default-directory anything-ff-history)))
4208 (add-hook 'anything-cleanup-hook 'anything-ff-save-history)
4209
4210 (defun anything-ff-valid-symlink-p (file)
4211   (file-exists-p (file-truename file)))
4212
4213 (defun anything-ff-properties (candidate)
4214   "Show file properties of CANDIDATE in a tooltip or message."
4215   (let ((type       (anything-ff-attributes candidate :type t))
4216         (dired-line (anything-ff-attributes candidate :dired t :human-size t)))
4217     (if (window-system)
4218         (tooltip-show
4219          (concat
4220           (anything-c-basename candidate) "\n"
4221           "Type: " type "\n"
4222           (when (string= type "symlink")
4223             (format "True name: '%s'\n"
4224                     (cond ((string-match "^\.#" (anything-c-basename candidate))
4225                            "Autosave symlink")
4226                           ((anything-ff-valid-symlink-p candidate)
4227                            (file-truename candidate))
4228                           (t "Invalid Symlink"))))
4229           dired-line))
4230         (message dired-line) (sit-for 5))))
4231
4232 ;;;###autoload
4233 (defun anything-ff-properties-persistent ()
4234   "Show properties without quitting anything."
4235   (interactive)
4236   (anything-attrset 'properties-action 'anything-ff-properties)
4237   (anything-execute-persistent-action 'properties-action))
4238
4239 ;;;###autoload
4240 (defun anything-ff-persistent-delete ()
4241   "Delete current candidate without quitting."
4242   (interactive)
4243   (anything-attrset 'quick-delete 'anything-ff-quick-delete)
4244   (anything-execute-persistent-action 'quick-delete))
4245
4246 (defun anything-ff-dot-file-p (file)
4247   "Check if FILE is `.' or `..'."
4248   (member (anything-c-basename file) '("." "..")))
4249
4250 (defun anything-ff-quick-delete (candidate)
4251   "Delete file CANDIDATE without quitting."
4252   (let ((presel (prog1 (save-excursion
4253                          (let (sel)
4254                            (anything-next-line)
4255                            (setq sel (anything-get-selection))
4256                            (if (string= sel candidate)
4257                                (progn (anything-previous-line)
4258                                       (anything-get-selection))
4259                                sel)))
4260                   (anything-mark-current-line))))
4261     (setq presel (if (and anything-ff-transformer-show-only-basename
4262                           (not (anything-ff-dot-file-p presel)))
4263                      (anything-c-basename presel) presel))
4264     (if anything-ff-quick-delete-dont-prompt-for-deletion
4265         (anything-c-delete-file candidate
4266                                 anything-ff-signal-error-on-dot-files)
4267         (save-selected-window
4268           (when (y-or-n-p (format "Really Delete file `%s'? " candidate))
4269             (anything-c-delete-file candidate
4270                                     anything-ff-signal-error-on-dot-files)
4271             (message nil))))
4272     (anything-force-update presel)))
4273
4274 (defun anything-ff-kill-buffer-fname (candidate)
4275   (let* ((buf (get-file-buffer candidate))
4276          (buf-name (buffer-name buf)))
4277     (if buf
4278         (progn
4279           (kill-buffer buf) (message "Buffer `%s' killed" buf))
4280         (message "No buffer to kill"))))
4281
4282 (defun anything-ff-kill-or-find-buffer-fname (candidate)
4283   "Find file CANDIDATE or kill it's buffer if it is visible.
4284 Never kill `anything-current-buffer'.
4285 Never kill buffer modified.
4286 This is called normally on third hit of \
4287 \\<anything-map>\\[anything-execute-persistent-action]
4288 in `anything-find-files-persistent-action'."
4289   (let* ((buf      (get-file-buffer candidate))
4290          (buf-name (buffer-name buf)))
4291     (if (and buf (get-buffer-window buf)
4292              (not (eq buf (get-buffer anything-current-buffer)))
4293              (not (buffer-modified-p buf)))
4294         (progn
4295           (kill-buffer buf) (message "Buffer `%s' killed" buf-name))
4296         (find-file candidate))))
4297
4298 ;;;###autoload
4299 (defun anything-ff-run-kill-buffer-persistent ()
4300   "Execute `anything-ff-kill-buffer-fname' whitout quitting."
4301   (interactive)
4302   (when (anything-file-completion-source-p)
4303     (anything-attrset 'kill-buffer-fname 'anything-ff-kill-buffer-fname)
4304     (anything-execute-persistent-action 'kill-buffer-fname)))
4305
4306 (defun anything-ff-human-size (size)
4307   "Return a string showing SIZE of a file in human readable form.
4308 SIZE can be an integer or a float depending it's value.
4309 `file-attributes' will take care of that to avoid overflow error.
4310 KBSIZE if a floating point number, default value is 1024.0."
4311   (let ((M (cons "M" (/ size (expt anything-ff-default-kbsize 2))))
4312         (G (cons "G" (/ size (expt anything-ff-default-kbsize 3))))
4313         (K (cons "K" (/ size anything-ff-default-kbsize)))
4314         (B (cons "B" size)))
4315     (loop with result = B
4316           for (a . b) in
4317           (loop for (x . y) in (list M G K B)
4318                 unless (< y 1) collect (cons x y))
4319           when (< b (cdr result)) do (setq result (cons a b))
4320           finally return (if (string= (car result) "B")
4321                              (format "%s" size)
4322                              (format "%.1f%s" (cdr result) (car result))))))
4323
4324 (defun* anything-ff-attributes
4325     (file &key type links uid gid access-time modif-time
4326           status size mode gid-change inode device-num dired human-size)
4327   "Easy interface for `file-attributes'."
4328   (let ((all (destructuring-bind
4329                    (type links uid gid access-time modif-time
4330                          status size mode gid-change inode device-num)
4331                  (file-attributes file 'string)
4332                (list :type        type
4333                      :links       links
4334                      :uid         uid
4335                      :gid         gid
4336                      :access-time access-time
4337                      :modif-time  modif-time
4338                      :status      status
4339                      :size        size
4340                      :mode        mode
4341                      :gid-change  gid-change
4342                      :inode       inode
4343                      :device-num  device-num))))
4344     (cond (type
4345            (let ((result (getf all :type)))
4346              (cond ((stringp result)
4347                     "symlink")
4348                    (result "directory")
4349                    (t "file"))))
4350           (links (getf all :links))
4351           (uid   (getf all :uid))
4352           (gid   (getf all :gid))
4353           (access-time
4354            (format-time-string "%Y-%m-%d %R" (getf all :access-time)))
4355           (modif-time
4356            (format-time-string "%Y-%m-%d %R" (getf all :modif-time)))
4357           (status
4358            (format-time-string "%Y-%m-%d %R" (getf all :status)))
4359           (size (if human-size (anything-ff-human-size (getf all :size))
4360                     (getf all :size)))
4361           (mode (getf all :mode))
4362           (gid-change (getf all :gid-change))
4363           (inode (getf all :inode))
4364           (device-num (getf all :device-num))
4365           (dired
4366            (concat
4367             (getf all :mode) " "
4368             (number-to-string (getf all :links)) " "
4369             (getf all :uid) ":"
4370             (getf all :gid) " "
4371             (if human-size (anything-ff-human-size (getf all :size))
4372                 (int-to-string (getf all :size))) " "
4373                 (format-time-string "%Y-%m-%d %R" (getf all :modif-time))))
4374           (t all))))
4375
4376 (defun anything-ff-prefix-filename (fname &optional file-or-symlinkp new-file)
4377   "Return filename FNAME maybe prefixed with [?] or [@].
4378 If FILE-OR-SYMLINKP is non--nil this mean we assume FNAME is an
4379 existing filename or valid symlink and there is no need to test it.
4380 NEW-FILE when non--nil mean FNAME is a non existing file and
4381 return FNAME prefixed with [?]."
4382   (let* ((prefix-new (propertize
4383                       " " 'display
4384                       (propertize "[?]" 'face 'anything-ff-prefix)))
4385          (prefix-url (propertize
4386                       " " 'display
4387                       (propertize "[@]" 'face 'anything-ff-prefix))))
4388     (cond ((or file-or-symlinkp (file-exists-p fname)) fname)
4389           ((or (string-match anything-ff-url-regexp fname)
4390                (string-match ffap-url-regexp fname))
4391            (concat prefix-url " " fname))
4392           ((or new-file (not (file-exists-p fname)))
4393            (concat prefix-new " " fname)))))
4394
4395 (defun anything-c-find-files-transformer (files sources)
4396   "Transformer for `anything-c-source-find-files'.
4397 Tramp files are not highlighted unless `anything-ff-tramp-not-fancy'
4398 is non--nil."
4399   (if (and (string-match tramp-file-name-regexp anything-pattern)
4400            anything-ff-tramp-not-fancy)
4401       (if anything-ff-transformer-show-only-basename
4402           (loop for i in files collect
4403                 (if (string-match "[.]\\{1,2\\}$" i)
4404                     i (cons (anything-c-basename i) i)))
4405           files)
4406       (anything-ff-highlight-files files sources)))
4407
4408 (defun anything-ff-highlight-files (files sources)
4409   "Candidate transformer for `anything-c-source-find-files' without icons."
4410   (loop for i in files
4411         for disp = (if (and anything-ff-transformer-show-only-basename
4412                             (not (string-match "[.]\\{1,2\\}$" i))
4413                             (not (string-match ffap-url-regexp i))
4414                             (not (string-match anything-ff-url-regexp i)))
4415                        (anything-c-basename i) i)
4416         collect
4417         (cond ((and (stringp (car (file-attributes i)))
4418                     (not (anything-ff-valid-symlink-p i))
4419                     (not (string-match "^\.#" (anything-c-basename i))))
4420                (cons (anything-ff-prefix-filename
4421                       (propertize disp 'face 'anything-ff-invalid-symlink) t)
4422                      i))
4423               ((stringp (car (file-attributes i)))
4424                (cons (anything-ff-prefix-filename
4425                       (propertize disp 'face 'anything-ff-symlink) t)
4426                      i))
4427               ((eq t (car (file-attributes i)))
4428                (cons (anything-ff-prefix-filename
4429                       (propertize disp 'face 'anything-ff-directory) t)
4430                      i))
4431               ((file-executable-p i)
4432                (cons (anything-ff-prefix-filename
4433                       (propertize disp 'face 'anything-ff-executable) t)
4434                      i))
4435               ((file-exists-p i)
4436                (cons (anything-ff-prefix-filename
4437                       (propertize disp 'face 'anything-ff-file) t)
4438                      i))
4439               (t
4440                (cons (anything-ff-prefix-filename
4441                       (propertize disp 'face 'anything-ff-file) nil 'new-file)
4442                      i)))))
4443
4444 (defun anything-find-files-action-transformer (actions candidate)
4445   "Action transformer for `anything-c-source-find-files'."
4446   (cond ((with-anything-current-buffer
4447            (eq major-mode 'message-mode))
4448          (append (subseq actions 0 4)
4449                  '(("Gnus attach file(s)" . anything-ff-gnus-attach-files))
4450                  (subseq actions 4)))
4451         ((string-match (image-file-name-regexp) candidate)
4452          (append (subseq actions 0 4)
4453                  '(("Rotate image right `M-r'" . anything-ff-rotate-image-right)
4454                    ("Rotate image left `M-l'" . anything-ff-rotate-image-left))
4455                  (subseq actions 4)))
4456         ((string-match "\.el$" (anything-aif (anything-marked-candidates)
4457                                    (car it) candidate))
4458          (append (subseq actions 0 4)
4459                  '(("Byte compile lisp file(s) `M-B, C-u to load'"
4460                     . anything-find-files-byte-compile)
4461                    ("Load File(s) `M-L'" . anything-find-files-load-files))
4462                  (subseq actions 4)))
4463         ((and (string-match "\.html?$" candidate)
4464               (file-exists-p candidate))
4465          (append (subseq actions 0 4)
4466                  '(("Browse url file" . browse-url-of-file))
4467                  (subseq actions 5)))
4468         ((or (string= (file-name-extension candidate) "pdf")
4469              (string= (file-name-extension candidate) "PDF"))
4470          (append (subseq actions 0 4)
4471                  '(("Pdfgrep File(s)" . anything-ff-pdfgrep))
4472                  (subseq actions 5)))
4473         (t actions)))
4474
4475 (defun anything-ff-gnus-attach-files (candidate)
4476   "Run `gnus-dired-attach' on `anything-marked-candidates' or CANDIDATE."
4477   (let ((flist (anything-marked-candidates)))
4478     (gnus-dired-attach flist)))
4479
4480 (defun anything-ff-rotate-current-image-1 (file &optional num-arg)
4481   "Rotate current image at NUM-ARG degrees.
4482 This is a destructive operation on FILE made by external tool mogrify."
4483   (declare (special image-dired-display-image-buffer))
4484   (setq file (file-truename file)) ; For symlinked images.
4485   ;; When FILE is not an image-file, do nothing.
4486   (when (string-match (image-file-name-regexp) file)
4487     (if (executable-find "mogrify")
4488         (progn
4489           (shell-command (format "mogrify -rotate %s %s"
4490                                  (or num-arg 90)
4491                                  (shell-quote-argument file)))
4492           (when (buffer-live-p image-dired-display-image-buffer)
4493             (kill-buffer image-dired-display-image-buffer))
4494           (image-dired-display-image file)
4495           (message nil)
4496           (display-buffer (get-buffer image-dired-display-image-buffer)))
4497         (error "mogrify not found"))))
4498
4499 (defun anything-ff-rotate-image-left (candidate)
4500   "Rotate image file CANDIDATE left.
4501 This affect directly file CANDIDATE."
4502   (anything-ff-rotate-current-image-1 candidate -90))
4503
4504 (defun anything-ff-rotate-image-right (candidate)
4505   "Rotate image file CANDIDATE right.
4506 This affect directly file CANDIDATE."
4507   (anything-ff-rotate-current-image-1 candidate))
4508
4509 (defun anything-ff-rotate-left-persistent ()
4510   "Rotate image left without quitting anything."
4511   (interactive)
4512   (anything-attrset 'image-action1 'anything-ff-rotate-image-left)
4513   (anything-execute-persistent-action 'image-action1))
4514
4515 (defun anything-ff-rotate-right-persistent ()
4516   "Rotate image right without quitting anything."
4517   (interactive)
4518   (anything-attrset 'image-action2 'anything-ff-rotate-image-right)
4519   (anything-execute-persistent-action 'image-action2))
4520
4521 (defun anything-ff-exif-data (candidate)
4522   "Extract exif data from file CANDIDATE using `anything-ff-exif-data-program'."
4523   (if (and anything-ff-exif-data-program
4524            (executable-find anything-ff-exif-data-program))
4525       (shell-command-to-string (format "%s %s %s"
4526                                        anything-ff-exif-data-program
4527                                        anything-ff-exif-data-program-args
4528                                        candidate))
4529       (format "No program %s found to extract exif"
4530               anything-ff-exif-data-program)))
4531
4532 (defun anything-find-files-persistent-action (candidate)
4533   "Open subtree CANDIDATE without quitting anything.
4534 If CANDIDATE is not a directory expand CANDIDATE filename.
4535 If CANDIDATE is alone, open file CANDIDATE filename.
4536 That's mean:
4537 First hit on C-z expand CANDIDATE second hit open file.
4538 If a prefix arg is given or `anything-follow-mode' is on open file."
4539   (let ((follow        (buffer-local-value
4540                         'anything-follow-mode
4541                         (get-buffer-create anything-buffer)))
4542         (new-pattern   (anything-get-selection))
4543         (num-lines-buf (with-current-buffer anything-buffer
4544                          (count-lines (point-min) (point-max)))))
4545     (flet ((insert-in-minibuffer (fname)
4546              (with-selected-window (minibuffer-window)
4547                (unless follow
4548                  (delete-minibuffer-contents)
4549                  (set-text-properties 0 (length fname) nil fname)
4550                  (insert fname)))))
4551       (cond ((and (string= (anything-ff-set-pattern anything-pattern)
4552                            "Invalid tramp file name")
4553                   (string-match tramp-file-name-regexp candidate))
4554              ;; First hit insert hostname and
4555              ;; second hit insert ":" and expand.
4556              (if (string= candidate anything-pattern)
4557                  (insert-in-minibuffer (concat candidate ":"))
4558                  (insert-in-minibuffer candidate)))
4559             (;; A symlink directory, expand it's truename.
4560              (and (file-directory-p candidate) (file-symlink-p candidate))
4561              (insert-in-minibuffer (file-name-as-directory
4562                                     (file-truename
4563                                      (expand-file-name candidate)))))
4564             ;; A directory, open it.
4565             ((file-directory-p candidate)
4566              (when (string= (anything-c-basename candidate) "..")
4567                (setq anything-ff-last-expanded anything-ff-default-directory))
4568              (insert-in-minibuffer (file-name-as-directory
4569                                     (expand-file-name candidate))))
4570             ;; A symlink file, expand to it's true name. (first hit)
4571             ((and (file-symlink-p candidate) (not current-prefix-arg) (not follow))
4572              (insert-in-minibuffer (file-truename candidate)))
4573             ;; A regular file, expand it, (first hit)
4574             ((and (>= num-lines-buf 3) (not current-prefix-arg) (not follow))
4575              (insert-in-minibuffer new-pattern))
4576             ;; An image file and it is the second hit on C-z,
4577             ;; show the file in `image-dired'.
4578             ((string-match (image-file-name-regexp) candidate)
4579              (when (buffer-live-p image-dired-display-image-buffer)
4580                (kill-buffer image-dired-display-image-buffer))
4581              (image-dired-display-image candidate)
4582              (message nil)
4583              (anything-c-switch-to-buffer image-dired-display-image-buffer)
4584              (with-current-buffer image-dired-display-image-buffer
4585                (let ((exif-data (anything-ff-exif-data candidate)))
4586                  (image-dired-update-property 'help-echo exif-data))))
4587             ;; Allow browsing archive on avfs fs.
4588             ;; Assume volume is already mounted with mountavfs.
4589             ((and anything-ff-avfs-directory
4590                   (string-match
4591                    (regexp-quote (expand-file-name anything-ff-avfs-directory))
4592                    (file-name-directory candidate))
4593                   (anything-ff-file-compressed-p candidate))
4594              (insert-in-minibuffer (concat candidate "#")))
4595             ;; On second hit we open file.
4596             ;; On Third hit we kill it's buffer maybe.
4597             (t
4598              (anything-ff-kill-or-find-buffer-fname candidate))))))
4599
4600 (defun anything-ff-file-compressed-p (candidate)
4601   "Whether CANDIDATE is a compressed file or not."
4602   (member (file-name-extension candidate)
4603           anything-ff-file-compressed-list))
4604
4605 (defun anything-c-insert-file-name-completion-at-point (candidate)
4606   "Insert file name completion at point."
4607   (with-anything-current-buffer
4608     (if buffer-read-only
4609         (error "Error: Buffer `%s' is read-only" (buffer-name))
4610         (let* ((end         (point))
4611                (guess       (substring-no-properties (thing-at-point 'filename)))
4612                (beg         (- (point) (length guess)))
4613                (full-path-p (or (string-match-p (concat "^" (getenv "HOME")) guess)
4614                                 (string-match-p "^[^\~]" guess))))
4615           (set-text-properties 0 (length candidate) nil candidate)
4616           (if (and guess (not (string= guess ""))
4617                    (string-match-p "^~\\|/.*" guess))
4618               (progn
4619                 (delete-region beg end)
4620                 (insert (if full-path-p
4621                             (expand-file-name candidate)
4622                             (abbreviate-file-name candidate))))
4623               (error "Aborting completion: No valid file name at point"))))))
4624
4625 (defun* anything-find-files-history (&key (comp-read t))
4626   "The `anything-find-files' history.
4627 Show the first `anything-ff-history-max-length' elements of
4628 `anything-ff-history' in an `anything-comp-read'."
4629   (let ((history (when anything-ff-history
4630                    (anything-fast-remove-dups anything-ff-history
4631                                               :test 'equal))))
4632     (when history
4633       (setq anything-ff-history
4634             (if (>= (length history) anything-ff-history-max-length)
4635                 (subseq history 0 anything-ff-history-max-length)
4636                 history))
4637       (if comp-read
4638           (anything-comp-read
4639            "Switch to Directory: "
4640            anything-ff-history
4641            :name "Anything Find Files History"
4642            :must-match t)
4643           anything-ff-history))))
4644
4645 (defun anything-find-files-1 (fname &optional preselect)
4646   "Find FNAME with `anything' completion.
4647 Like `find-file' but with `anything' support.
4648 Use it for non--interactive calls of `anything-find-files'."
4649   (when (get-buffer anything-action-buffer)
4650     (kill-buffer anything-action-buffer))
4651   (let ((anything-mp-highlight-delay nil)
4652         ;; Be sure we don't erase the precedent minibuffer if some.
4653         (anything-ff-auto-update-initial-value
4654          (and anything-ff-auto-update-initial-value
4655               (not (minibuffer-window-active-p (minibuffer-window)))))
4656         anything-samewindow)
4657     (anything :sources 'anything-c-source-find-files
4658               :input fname
4659               :preselect preselect
4660               :keymap anything-find-files-map
4661               :prompt "Find Files or Url: "
4662               :buffer "*Anything Find Files*")))
4663
4664
4665 (defun anything-find-files-initial-input (&optional input)
4666   "Return INPUT if present, otherwise try to guess it."
4667   (or (and input (or (and (file-remote-p input) input)
4668                      (expand-file-name input)))
4669       (anything-find-files-input
4670        (ffap-guesser)
4671        (thing-at-point 'filename))))
4672
4673 (defun anything-find-files-input (fap tap)
4674   "Default input of `anything-find-files'."
4675   (let* ((def-dir (anything-c-current-directory))
4676          (lib     (anything-find-library-at-point))
4677          (url     (anything-ff-find-url-at-point))
4678          (remp    (and fap (file-remote-p fap)))
4679          (file-p  (and (not remp)
4680                        fap
4681                        (not (string= fap ""))
4682                        (file-exists-p fap)
4683                        tap (not (string= tap ""))
4684                        (file-exists-p
4685                         (file-name-directory (expand-file-name tap def-dir))))))
4686     (cond (lib) ; e.g we are inside a require sexp.
4687           (url) ; String at point is an hyperlink.
4688           (remp fap)
4689           (file-p (expand-file-name tap def-dir))
4690           (t (and (not (string= fap "")) fap)))))
4691
4692 (defun anything-c-current-directory ()
4693   "Return current-directory name at point.
4694 Useful in dired buffers when there is inserted subdirs."
4695   (if (eq major-mode 'dired-mode)
4696       (dired-current-directory)
4697       default-directory))
4698
4699 (defun anything-ff-find-url-at-point ()
4700   "Try to find link to an url in text-property at point."
4701   (let* ((he      (get-text-property (point) 'help-echo))
4702          (ov      (overlays-at (point)))
4703          (ov-he   (and ov (overlay-get
4704                            (car (overlays-at (point))) 'help-echo)))
4705          (w3m-l   (get-text-property (point) 'w3m-href-anchor))
4706          (nt-prop (get-text-property (point) 'nt-link)))
4707     ;; Org link.
4708     (when (and (stringp he) (string-match "^LINK: " he))
4709       (setq he (replace-match "" t t he)))
4710     (loop for i in (list he ov-he w3m-l nt-prop)
4711           thereis (and (stringp i) (string-match ffap-url-regexp i) i))))
4712
4713 (defun anything-find-library-at-point ()
4714   "Try to find library path at point.
4715 Find inside `require' and `declare-function' sexp."
4716   (require 'find-func)
4717   (let* ((beg-sexp (save-excursion (search-backward "(" (point-at-bol) t)))
4718          (end-sexp (save-excursion (search-forward ")" (point-at-eol) t)))
4719          (sexp     (and beg-sexp end-sexp
4720                         (buffer-substring-no-properties
4721                          (1+ beg-sexp) (1- end-sexp)))))
4722     (ignore-errors
4723       (cond ((and sexp (string-match "require \'.+[^)]" sexp))
4724              (find-library-name
4725               (replace-regexp-in-string
4726                "'\\|\)\\|\(" ""
4727                ;; If require use third arg, ignore it,
4728                ;; always use library path found in `load-path'.
4729                (second (split-string (match-string 0 sexp))))))
4730             ((and sexp (string-match-p "^declare-function" sexp))
4731              (find-library-name
4732               (replace-regexp-in-string
4733                "\"\\|ext:" ""
4734                (third (split-string sexp)))))
4735             (t nil)))))
4736
4737 ;;; Anything completion for `write-file'.==> C-x C-w
4738 (defvar anything-c-source-write-file
4739   `((name . "Write File")
4740     (header-name . (lambda (name)
4741                      (concat name anything-c-find-files-doc-header)))
4742     ;; It is needed for filenames with capital letters
4743     (disable-shortcuts)
4744     (candidates . anything-find-files-get-candidates)
4745     (filtered-candidate-transformer anything-c-find-files-transformer)
4746     (persistent-action . anything-find-files-persistent-action)
4747     (persistent-help . "Expand Candidate")
4748     (volatile)
4749     (action .
4750             (("Write File" . (lambda (candidate)
4751                                (write-file candidate 'confirm)))))))
4752
4753 ;;; Anything completion for `insert-file'.==> C-x i
4754 (defvar anything-c-source-insert-file
4755   `((name . "Insert File")
4756     (header-name . (lambda (name)
4757                      (concat name anything-c-find-files-doc-header)))
4758     ;; It is needed for filenames with capital letters
4759     (disable-shortcuts)
4760     (candidates . anything-find-files-get-candidates)
4761     (filtered-candidate-transformer anything-c-find-files-transformer)
4762     (persistent-action . anything-find-files-persistent-action)
4763     (persistent-help . "Expand Candidate")
4764     (volatile)
4765     (action .
4766             (("Insert File" . (lambda (candidate)
4767                                 (when (y-or-n-p (format "Really insert %s in %s "
4768                                                         candidate anything-current-buffer))
4769                                   (insert-file-contents candidate))))))))
4770
4771 ;;; Anything completion for copy, rename and (rel)sym/hard/link files from dired.
4772 (defvar anything-c-source-copy-files
4773   `((name . "Copy Files")
4774     (header-name . (lambda (name)
4775                      (concat name anything-c-find-files-doc-header)))
4776     ;; It is needed for filenames with capital letters
4777     (disable-shortcuts)
4778     (candidates . anything-find-files-get-candidates)
4779     (filtered-candidate-transformer anything-c-find-files-transformer)
4780     (persistent-action . anything-find-files-persistent-action)
4781     (persistent-help . "Expand Candidate")
4782     (volatile)
4783     (action .
4784             (("Copy File"
4785               . (lambda (candidate)
4786                   (anything-dired-action candidate :action 'copy)))
4787              ("Copy and Follow"
4788               . (lambda (candidate)
4789                   (anything-dired-action candidate :action 'copy :follow t)))))))
4790
4791
4792 (defvar  anything-c-source-rename-files
4793   `((name . "Rename Files")
4794     (header-name . (lambda (name)
4795                      (concat name anything-c-find-files-doc-header)))
4796     ;; It is needed for filenames with capital letters
4797     (disable-shortcuts)
4798     (candidates . anything-find-files-get-candidates)
4799     (filtered-candidate-transformer anything-c-find-files-transformer)
4800     (persistent-action . anything-find-files-persistent-action)
4801     (persistent-help . "Expand Candidate")
4802     (volatile)
4803     (action .
4804             (("Rename File"
4805               . (lambda (candidate)
4806                   (anything-dired-action candidate :action 'rename)))
4807              ("Rename and Follow"
4808               . (lambda (candidate)
4809                   (anything-dired-action candidate :action 'rename :follow t)))))))
4810
4811 (defvar anything-c-source-symlink-files
4812   `((name . "Symlink Files")
4813     (header-name . (lambda (name)
4814                      (concat name anything-c-find-files-doc-header)))
4815     ;; It is needed for filenames with capital letters
4816     (disable-shortcuts)
4817     (candidates . anything-find-files-get-candidates)
4818     (filtered-candidate-transformer anything-c-find-files-transformer)
4819     (persistent-action . anything-find-files-persistent-action)
4820     (persistent-help . "Expand Candidate")
4821     (volatile)
4822     (action
4823      . (("Symlink File"
4824          . (lambda (candidate)
4825              (anything-dired-action candidate :action 'symlink)))
4826         ("RelSymlink File"
4827          . (lambda (candidate)
4828              (anything-dired-action candidate :action 'relsymlink)))))))
4829
4830
4831 (defvar anything-c-source-hardlink-files
4832   `((name . "Hardlink Files")
4833     (header-name . (lambda (name)
4834                      (concat name anything-c-find-files-doc-header)))
4835     ;; It is needed for filenames with capital letters
4836     (disable-shortcuts)
4837     (candidates . anything-find-files-get-candidates)
4838     (filtered-candidate-transformer anything-c-find-files-transformer)
4839     (persistent-action . anything-find-files-persistent-action)
4840     (persistent-help . "Expand Candidate")
4841     (volatile)
4842     (action
4843      . (("Hardlink File"
4844          . (lambda (candidate)
4845              (anything-dired-action candidate :action 'hardlink)))))))
4846
4847 (defun* anything-dired-action (candidate &key action follow (files (dired-get-marked-files)))
4848   "Copy, rename or symlink file at point or marked files in dired to CANDIDATE.
4849 ACTION is a key that can be one of 'copy, 'rename, 'symlink, 'relsymlink."
4850   (when (get-buffer dired-log-buffer) (kill-buffer dired-log-buffer))
4851   (let ((fn     (case action
4852                   ('copy       'dired-copy-file)
4853                   ('rename     'dired-rename-file)
4854                   ('symlink    'make-symbolic-link)
4855                   ('relsymlink 'dired-make-relative-symlink)
4856                   ('hardlink   'dired-hardlink)))
4857         (marker (case action
4858                   ((copy rename)   dired-keep-marker-copy)
4859                   ('symlink        dired-keep-marker-symlink)
4860                   ('relsymlink     dired-keep-marker-relsymlink)
4861                   ('hardlink       dired-keep-marker-hardlink)))
4862         (dirflag (and (= (length files) 1)
4863                       (file-directory-p (car files))
4864                       (not (file-directory-p candidate)))))
4865     (dired-create-files
4866      fn (symbol-name action) files
4867      ;; CANDIDATE is the destination.
4868      (if (file-directory-p candidate)
4869          ;; When CANDIDATE is a directory, build file-name in this directory.
4870          ;; Else we use CANDIDATE.
4871          #'(lambda (from)
4872              (expand-file-name (file-name-nondirectory from) candidate))
4873          #'(lambda (from) candidate))
4874      marker)
4875     (push (file-name-as-directory
4876            (if (file-directory-p candidate)
4877                (expand-file-name candidate)
4878                (file-name-directory candidate)))
4879            anything-ff-history)
4880     (when (and follow (not (get-buffer dired-log-buffer)))
4881       (let ((target (directory-file-name candidate)))
4882         (unwind-protect
4883              (progn
4884                (setq anything-ff-cand-to-mark
4885                      (anything-get-dest-fnames-from-list files candidate dirflag))
4886                (if (and dirflag (eq action 'rename))
4887                    (anything-find-files-1 (file-name-directory target)
4888                                           (if anything-ff-transformer-show-only-basename
4889                                               (anything-c-basename target) target))
4890                    (anything-find-files-1 (expand-file-name candidate))))
4891           (setq anything-ff-cand-to-mark nil))))))
4892
4893 (defun anything-c-basename (fname &optional ext)
4894   "Print FNAME  with any  leading directory  components removed.
4895 If specified, also remove filename extension EXT."
4896   (if (and ext (or (string= (file-name-extension fname) ext)
4897                    (string= (file-name-extension fname t) ext))
4898            (not (file-directory-p fname)))
4899       (file-name-sans-extension (file-name-nondirectory fname))
4900       (file-name-nondirectory (directory-file-name fname))))
4901
4902 (defun anything-get-dest-fnames-from-list (flist dest-cand rename-dir-flag)
4903   "Transform filenames of FLIST to abs of DEST-CAND.
4904 If RENAME-DIR-FLAG is non--nil collect the `directory-file-name' of transformed
4905 members of FLIST."
4906   ;; At this point files have been renamed/copied at destination.
4907   ;; That's mean DEST-CAND exists.
4908   (loop
4909         with dest = (expand-file-name dest-cand)
4910         for src in flist
4911         for basename-src = (anything-c-basename src)
4912         for fname = (cond (rename-dir-flag (directory-file-name dest))
4913                           ((file-directory-p dest)
4914                            (concat (file-name-as-directory dest) basename-src))
4915                           (t dest))
4916         when (file-exists-p fname)
4917         collect fname into tmp-list
4918         finally return (sort tmp-list 'string<)))
4919
4920 (defun anything-ff-maybe-mark-candidates ()
4921   "Mark all candidates of list `anything-ff-cand-to-mark'."
4922   (when (and (string= (assoc-default 'name (anything-get-current-source))
4923                       (assoc-default 'name anything-c-source-find-files))
4924              anything-ff-cand-to-mark)
4925     (with-anything-window
4926       (while anything-ff-cand-to-mark
4927         (if (string= (car anything-ff-cand-to-mark) (anything-get-selection))
4928             (progn
4929               (anything-make-visible-mark)
4930               (anything-next-line)
4931               (setq anything-ff-cand-to-mark (cdr anything-ff-cand-to-mark)))
4932             (anything-next-line)))
4933       (unless (anything-this-visible-mark)
4934         (anything-prev-visible-mark)))))
4935
4936 (add-hook 'anything-after-update-hook #'anything-ff-maybe-mark-candidates)
4937
4938 (defun* anything-dired-do-action-on-file (&key action)
4939   (let* ((files     (dired-get-marked-files))
4940          (len       (length files))
4941          (fname     (if (> len 1)
4942                         (format "* %d Files" len)
4943                         (car files)))
4944          (source    (case action
4945                       ('copy     'anything-c-source-copy-files)
4946                       ('rename   'anything-c-source-rename-files)
4947                       ('symlink  'anything-c-source-symlink-files)
4948                       ('hardlink 'anything-c-source-hardlink-files)))
4949          (prompt-fm (case action
4950                       ('copy     "Copy %s to: ")
4951                       ('rename   "Rename %s to: ")
4952                       ('symlink  "Symlink %s to: ")
4953                       ('hardlink "Hardlink %s to: ")))
4954          (buffer    (case action
4955                       ('copy     "*Anything Copy Files*")
4956                       ('rename   "*Anything Rename Files*")
4957                       ('symlink  "*Anything Symlink Files*")
4958                       ('hardlink "*Anything Hardlink Files*")))
4959          (anything-mp-highlight-delay     nil))
4960     (anything :sources source
4961               :input (or (dired-dwim-target-directory)
4962                          (expand-file-name (anything-c-current-directory)))
4963               :preselect (dired-get-filename)
4964               :prompt (format prompt-fm fname)
4965               :keymap anything-c-read-file-map
4966               :buffer buffer)))
4967
4968 ;;;###autoload
4969 (define-minor-mode anything-dired-mode ()
4970   "Enable anything completion in Dired functions.
4971 Bindings affected are C, R, S, H.
4972 This is deprecated for Emacs24+ users, use `ac-mode' instead."
4973   :group 'anything-config
4974   :global t
4975   (if anything-dired-mode
4976       (progn
4977         (substitute-key-definition
4978          'dired-do-copy 'anything-dired-copy-file dired-mode-map)
4979         (substitute-key-definition
4980          'dired-do-rename 'anything-dired-rename-file dired-mode-map)
4981         (substitute-key-definition
4982          'dired-do-symlink 'anything-dired-symlink-file dired-mode-map)
4983         (substitute-key-definition
4984          'dired-do-hardlink 'anything-dired-hardlink-file dired-mode-map))
4985       (substitute-key-definition
4986        'anything-dired-copy-file 'dired-do-copy dired-mode-map)
4987       (substitute-key-definition
4988        'anything-dired-rename-file 'dired-do-rename dired-mode-map)
4989       (substitute-key-definition
4990        'anything-dired-symlink-file 'dired-do-symlink dired-mode-map)
4991       (substitute-key-definition
4992        'anything-dired-hardlink-file 'dired-do-hardlink dired-mode-map)))
4993
4994 (defalias 'anything-dired-bindings 'anything-dired-mode)
4995
4996 (defun* anything-c-read-file-name
4997     (prompt
4998      &key
4999      (name "Read File Name")
5000      (initial-input (expand-file-name default-directory))
5001      (buffer "*Anything Completions*")
5002      test
5003      (preselect nil)
5004      (history nil)
5005      must-match
5006      (marked-candidates nil)
5007      (alistp t)
5008      (persistent-action 'anything-find-files-persistent-action)
5009      (persistent-help "Hit1 Expand Candidate, Hit2 or (C-u) Find file"))
5010   "Read a file name with anything completion.
5011 It is anything `read-file-name' emulation.
5012
5013 Argument PROMPT is the default prompt to use.
5014
5015 Keys description:
5016
5017 - NAME: Source name, default to \"Read File Name\".
5018
5019 - INITIAL-INPUT: Where to start read file name, default to `default-directory'.
5020
5021 - BUFFER: `anything-buffer' name default to \"*Anything Completions*\".
5022
5023 - TEST: A predicate called with one arg 'candidate'.
5024
5025 - PRESELECT: anything preselection.
5026
5027 - HISTORY: Display HISTORY in a special source.
5028
5029 - MUST-MATCH: Can be 'confirm, nil, or t.
5030
5031 - MARKED-CANDIDATES: When non--nil return a list of marked candidates.
5032
5033 - ALISTP: Don't use `all-completions' in history (take effect only on history).
5034
5035 - PERSISTENT-ACTION: a persistent action function.
5036
5037 - PERSISTENT-HELP: persistent help message."
5038   (when (get-buffer anything-action-buffer)
5039     (kill-buffer anything-action-buffer))
5040
5041   ;; Assume completion have been already required,
5042   ;; so always use 'confirm.
5043   (when (eq must-match 'confirm-after-completion)
5044     (setq must-match 'confirm))
5045
5046   (flet ((action-fn (candidate)
5047            (if marked-candidates
5048                (anything-marked-candidates)
5049                (identity candidate))))
5050
5051     (let* ((anything-mp-highlight-delay nil)
5052            ;; Be sure we don't erase the underlying minibuffer if some.
5053            (anything-ff-auto-update-initial-value
5054             (and anything-ff-auto-update-initial-value
5055                  (not (minibuffer-window-active-p (minibuffer-window)))))
5056            anything-same-window
5057            (hist (and history (anything-comp-read-get-candidates
5058                                history nil nil alistp)))
5059            (minibuffer-completion-confirm must-match)
5060            (must-match-map (when must-match
5061                              (let ((map (make-sparse-keymap)))
5062                                (define-key map (kbd "RET")
5063                                  'anything-confirm-and-exit-minibuffer)
5064                                map)))
5065            (anything-map (if must-match-map
5066                              (make-composed-keymap
5067                               must-match-map anything-c-read-file-map)
5068                              anything-c-read-file-map)))
5069
5070       (or (anything
5071            :sources
5072            `(((name . ,(format "%s History" name))
5073               (header-name . (lambda (name)
5074                                (concat name anything-c-find-files-doc-header)))
5075               (disable-shortcuts)
5076               (mode-line . anything-read-file-name-mode-line-string)
5077               (candidates . hist)
5078               (persistent-action . ,persistent-action)
5079               (persistent-help . ,persistent-help)
5080               (action . ,'action-fn))
5081              ((name . ,name)
5082               (header-name . (lambda (name)
5083                                (concat name anything-c-find-files-doc-header)))
5084               (init . (lambda ()
5085                         (setq anything-ff-auto-update-flag
5086                               anything-ff-auto-update-initial-value)))
5087               ;; It is needed for filenames with capital letters
5088               (disable-shortcuts)
5089               (mode-line . anything-read-file-name-mode-line-string)
5090               (candidates
5091                . (lambda ()
5092                    (if test
5093                        (loop with hn = (anything-ff-tramp-hostnames)
5094                              for i in (anything-find-files-get-candidates
5095                                        must-match)
5096                              when (or (member i hn)            ; A tramp host
5097                                       (funcall test i)         ; Test ok
5098                                       (not (file-exists-p i))) ; A new file.
5099                              collect i)
5100                        (anything-find-files-get-candidates must-match))))
5101               (filtered-candidate-transformer anything-c-find-files-transformer)
5102               (persistent-action . ,persistent-action)
5103               (candidate-number-limit . 9999)
5104               (toggle-auto-update . anything-ff-toggle-auto-update)
5105               (persistent-help . ,persistent-help)
5106               (volatile)
5107               (action . ,'action-fn)))
5108            :input initial-input
5109            :prompt prompt
5110            :resume 'noresume
5111            :buffer buffer
5112            :preselect preselect)
5113           (when (and (not (string= anything-pattern ""))
5114                      (eq anything-exit-status 0)
5115                      (eq must-match 'confirm))
5116             (identity anything-pattern))
5117           (keyboard-quit)))))
5118
5119 \f
5120 ;;; File Cache
5121 (defvar anything-c-file-cache-initialized-p nil)
5122
5123 (defvar anything-c-file-cache-files nil)
5124
5125 (defvar anything-c-source-file-cache
5126   `((name . "File Cache")
5127     (init
5128      . (lambda ()
5129          (require 'filecache nil t)
5130          (unless anything-c-file-cache-initialized-p
5131            (setq anything-c-file-cache-files
5132                  (loop for item in file-cache-alist append
5133                        (destructuring-bind (base &rest dirs) item
5134                          (loop for dir in dirs collect
5135                                (concat dir base)))))
5136            (defadvice file-cache-add-file (after file-cache-list activate)
5137              (add-to-list 'anything-c-file-cache-files (expand-file-name file)))
5138            (setq anything-c-file-cache-initialized-p t))))
5139     (keymap . ,anything-generic-files-map)
5140     (help-message . anything-generic-file-help-message)
5141     (mode-line . anything-generic-file-mode-line-string)
5142     (candidates . anything-c-file-cache-files)
5143     (match anything-c-match-on-basename)
5144     (type . file)))
5145
5146 \f
5147 ;;; Locate
5148 ;;
5149 ;;
5150 ;; NOTE for WINDOZE users:
5151 ;; You have to install Everything with his command line interface here:
5152 ;; http://www.voidtools.com/download.php
5153
5154 (defun anything-ff-find-locatedb (&optional from-ff)
5155   "Try to find if a local locatedb file is available.
5156 The search is done in `anything-ff-default-directory' or
5157 fall back to `default-directory' if FROM-FF is nil."
5158   (when anything-ff-locate-db-filename
5159     (cond ((and anything-ff-default-directory
5160                 from-ff
5161                 (file-exists-p (expand-file-name
5162                                 anything-ff-locate-db-filename
5163                                 anything-ff-default-directory))
5164                 (expand-file-name
5165                  anything-ff-locate-db-filename
5166                  anything-ff-default-directory)))
5167           ((and (not from-ff)
5168                 (file-exists-p (expand-file-name
5169                                 anything-ff-locate-db-filename
5170                                 default-directory))
5171                 (expand-file-name
5172                  anything-ff-locate-db-filename
5173                  default-directory))))))
5174
5175 (defun anything-locate-1 (&optional localdb init from-ff)
5176   "Generic function to run Locate.
5177 if LOCALDB is non--nil search and use a local locate db file.
5178 INIT is a string to use as initial input in prompt.
5179 See `anything-locate-with-db' and `anything-locate'."
5180   (anything-locate-with-db
5181    (and localdb
5182         (or (anything-ff-find-locatedb from-ff)
5183             (anything-c-read-file-name
5184              "LocateDBFiles: "
5185              :initial-input (or anything-ff-default-directory
5186                                 default-directory)
5187              :marked-candidates t
5188              :preselect anything-locate-db-file-regexp
5189              :test #'(lambda (x)
5190                        (if anything-locate-db-file-regexp
5191                            ;; Select only locate db files and directories
5192                            ;; to allow navigation.
5193                            (or (string-match
5194                                 anything-locate-db-file-regexp x)
5195                                (file-directory-p x))
5196                            x)))))
5197    init))
5198 ;; (anything-locate-1 t)
5199
5200 (defun anything-locate-with-db (&optional db initial-input)
5201   "Run locate -d DB.
5202 If DB is not given or nil use locate without -d option.
5203 Argument DB can be given as a string or list of db files.
5204 Argument INITIAL-INPUT is a string to use as initial-input.
5205 See also `anything-locate'."
5206   (when (and db (stringp db)) (setq db (list db)))
5207   (unless anything-c-locate-command
5208     (setq anything-c-locate-command
5209           (case system-type
5210             ('gnu/linux "locate -i -r %s")
5211             ('berkeley-unix "locate -i %s")
5212             ('windows-nt "es -i -r %s")
5213             (t "locate %s"))))
5214   (let ((anything-c-locate-command
5215          (if db
5216              (replace-regexp-in-string
5217               "locate"
5218               (format "locate -d %s"
5219                       (mapconcat 'identity
5220                                  ;; Remove eventually
5221                                  ;; marked directories by error.
5222                                  (loop for i in db
5223                                        unless (file-directory-p i)
5224                                        collect i) ":"))
5225               anything-c-locate-command)
5226              anything-c-locate-command)))
5227     (anything :sources 'anything-c-source-locate
5228               :buffer "*anything locate*"
5229               :input initial-input
5230               :keymap anything-generic-files-map)))
5231 ;; (anything-locate-with-db "~/locate.db")
5232
5233 (defun anything-c-locate-init ()
5234   "Initialize async locate process for `anything-c-source-locate'."
5235   (setq mode-line-format
5236         '(" " mode-line-buffer-identification " "
5237           (line-number-mode "%l") " "
5238           (:eval (propertize "(Locate Process Running) "
5239                   'face '((:foreground "red"))))))
5240   (prog1
5241       (start-process-shell-command "locate-process" nil
5242                                    (format anything-c-locate-command
5243                                            anything-pattern))
5244     (set-process-sentinel (get-process "locate-process")
5245                           #'(lambda (process event)
5246                               (when (string= event "finished\n")
5247                                 (with-anything-window
5248                                   (force-mode-line-update nil)
5249                                   (anything-update-move-first-line)))))))
5250
5251 (defvar anything-c-source-locate
5252   `((name . "Locate")
5253     (candidates . anything-c-locate-init)
5254     (type . file)
5255     (requires-pattern . 3)
5256     (keymap . ,anything-generic-files-map)
5257     (help-message . anything-generic-file-help-message)
5258     (candidate-number-limit . 9999)
5259     (mode-line . anything-generic-file-mode-line-string)
5260     (delayed))
5261   "Find files matching the current input pattern with locate.")
5262
5263 (defun anything-c-locate-read-file-name (prompt &optional init)
5264   "Search a file with locate and return it's filename.
5265 Use argument PROMPT and INIT for `anything' arguments
5266 prompt and input."
5267   (anything :sources
5268             '((name . "Locate")
5269               (candidates . anything-c-locate-init)
5270               (action . identity)
5271               (requires-pattern . 3)
5272               (candidate-number-limit . 9999)
5273               (mode-line . anything-generic-file-mode-line-string)
5274               (delayed))
5275             :prompt prompt
5276             :input init
5277             :buffer "*anything locate rfn*"))
5278
5279
5280 \f
5281 ;;; Anything Incremental Grep.
5282 ;;
5283 ;;
5284 ;; Allow to grep incrementally with anything interface.
5285 ;; It allow also to Grep files recursively without using 'find' shell command.
5286 ;; On Windows you will need at least Grep version 2.5.4 of Gnuwin32.
5287 (defvar anything-c-grep-default-command
5288   "grep -d skip %e -niH -e %p %f"
5289   "Default grep format command for `anything-do-grep-1'.
5290 Where:
5291 '%e' format spec is for --exclude or --include grep options.
5292 '%p' format spec is for pattern.
5293 '%f' format spec is for filenames.")
5294
5295 (defvar anything-c-grep-default-recurse-command
5296   "grep -d recurse %e -niH -e %p %f"
5297   "Default recursive grep format command for `anything-do-grep-1'.
5298 See `anything-c-grep-default-command' for format specs.")
5299
5300 (defvar anything-c-default-zgrep-command "zgrep -niH -e %p %f")
5301
5302 (defvar anything-c-rzgrep-cache (make-hash-table :test 'equal))
5303
5304 (defvar anything-c-grep-default-function 'anything-c-grep-init)
5305
5306 (defvar anything-c-grep-debug-command-line nil
5307   "Turn on anything grep command-line debugging when non--nil.")
5308
5309 (defvar anything-c-zgrep-recurse-flag nil)
5310
5311 (defvar anything-c-grep-history nil)
5312
5313 (defvar anything-c-grep-max-length-history 100
5314   "*Max number of elements to save in `anything-c-grep-history'.")
5315
5316 (defun anything-c-grep-prepare-candidates (candidates)
5317   "Prepare filenames and directories CANDIDATES for grep command line."
5318   ;; If one or more candidate is a directory, search in all files
5319   ;; of this candidate (e.g /home/user/directory/*).
5320   ;; If r option is enabled search also in subdidrectories.
5321   ;; We need here to expand wildcards to support crap windows filenames
5322   ;; as grep doesn't accept quoted wildcards (e.g "dir/*.el").
5323   (if anything-c-zgrep-recurse-flag
5324       (mapconcat 'shell-quote-argument candidates " ")
5325       (loop for i in candidates append
5326             (cond ( ;; Candidate is a directory and we use recursion.
5327                    (and (file-directory-p i)
5328                         (anything-c-grep-recurse-p))
5329                    (list (expand-file-name i)))
5330                   ;; Candidate is a directory, search in all files.
5331                   ((file-directory-p i)
5332                    (file-expand-wildcards
5333                     (concat (file-name-as-directory (expand-file-name i)) "*") t))
5334                   ;; Candidate is a file or wildcard and we use recursion, use the
5335                   ;; current directory instead of candidate.
5336                   ((and (or (file-exists-p i) (string-match "\*" i))
5337                         (anything-c-grep-recurse-p))
5338                    (list (expand-file-name
5339                           (directory-file-name ; Needed for windoze.
5340                            (file-name-directory (directory-file-name i))))))
5341                   ;; Candidate use wildcard.
5342                   ((string-match "^\*" (anything-c-basename i))
5343                    (file-expand-wildcards i t))
5344                   ;; Else should be one or more file.
5345                   (t (list i))) into all-files
5346             finally return
5347             (mapconcat 'shell-quote-argument all-files " "))))
5348
5349 (defun anything-c-grep-recurse-p ()
5350   "Check if `anything-do-grep-1' have switched to recursive."
5351   (let ((args (replace-regexp-in-string
5352                "grep" "" anything-c-grep-default-command)))
5353     (string-match-p "r\\|recurse" args)))
5354
5355 (defun anything-c-grep-init (only-files &optional include zgrep)
5356   "Start an asynchronous grep process in ONLY-FILES list."
5357   (let* ((fnargs        (anything-c-grep-prepare-candidates
5358                          (if (file-remote-p anything-ff-default-directory)
5359                              (mapcar #'(lambda (x)
5360                                          (file-remote-p x 'localname))
5361                                      only-files)
5362                              only-files)))
5363          (ignored-files (mapconcat
5364                          #'(lambda (x)
5365                              (concat "--exclude=" (shell-quote-argument x)))
5366                          grep-find-ignored-files " "))
5367          (ignored-dirs  (mapconcat
5368                          ;; Need grep version >=2.5.4 of Gnuwin32 on windoze.
5369                          #'(lambda (x)
5370                              (concat "--exclude-dir=" (shell-quote-argument x)))
5371                          grep-find-ignored-directories " "))
5372          (exclude       (if (anything-c-grep-recurse-p)
5373                             (concat (or include ignored-files) " " ignored-dirs)
5374                             ignored-files))
5375          (cmd-line      (format-spec
5376                          anything-c-grep-default-command
5377                          (delq nil
5378                                (list (unless zgrep (cons ?e exclude))
5379                                      (cons ?p (shell-quote-argument anything-pattern))
5380                                      (cons ?f fnargs))))))
5381     (when anything-c-grep-debug-command-line
5382       (with-current-buffer (get-buffer-create "*any grep debug*")
5383         (goto-char (point-max))
5384         (insert (concat ">>> " cmd-line "\n\n"))))
5385     (setq mode-line-format
5386           '(" " mode-line-buffer-identification " "
5387             (line-number-mode "%l") " "
5388             (:eval (when (get-process "grep-process")
5389                      (propertize "[Grep Process Running] "
5390                                  'face 'anything-grep-running)))))
5391     (force-mode-line-update nil)
5392     (prog1
5393         (let ((default-directory anything-ff-default-directory))
5394           (start-file-process-shell-command "grep-process" nil cmd-line))
5395       (message nil)
5396       (set-process-sentinel
5397        (get-process "grep-process")
5398        #'(lambda (process event)
5399            (when (string= event "finished\n")
5400              (with-anything-window
5401                (anything-update-move-first-line)
5402                (setq mode-line-format
5403                      '(" " mode-line-buffer-identification " "
5404                        (line-number-mode "%l") " "
5405                        (:eval (propertize
5406                                (format "[Grep Process Finished - (%s results)] "
5407                                        (let ((nlines (1- (count-lines
5408                                                           (point-min)
5409                                                           (point-max)))))
5410                                          (if (> nlines 0) nlines 0)))
5411                                'face 'anything-grep-finish))))
5412                (force-mode-line-update nil))))))))
5413
5414 (defun anything-c-grep-action (candidate &optional where mark)
5415   "Define a default action for `anything-do-grep' on CANDIDATE.
5416 WHERE can be one of other-window, elscreen, other-frame."
5417   (let* ((split        (anything-c-grep-split-line candidate))
5418          (lineno       (string-to-number (nth 1 split)))
5419          (loc-fname    (car split))
5420          (tramp-method (file-remote-p anything-ff-default-directory 'method))
5421          (tramp-host   (file-remote-p anything-ff-default-directory 'host))
5422          (tramp-prefix (concat "/" tramp-method ":" tramp-host ":"))
5423          (fname        (if tramp-host
5424                            (concat tramp-prefix loc-fname) loc-fname)))
5425     (case where
5426       (other-window (find-file-other-window fname))
5427       (elscreen     (anything-elscreen-find-file fname))
5428       (other-frame  (find-file-other-frame fname))
5429       (grep         (anything-c-grep-save-results-1))
5430       (t (find-file fname)))
5431     (unless (eq where 'grep)
5432       (anything-goto-line lineno))
5433     (when mark
5434       (set-marker (mark-marker) (point))
5435       (push-mark (point) 'nomsg))
5436     ;; Save history
5437     (unless (or anything-in-persistent-action
5438                 (string= anything-pattern ""))
5439       (setq anything-c-grep-history
5440             (cons anything-pattern
5441                   (delete anything-pattern anything-c-grep-history)))
5442       (when (> (length anything-c-grep-history)
5443                anything-c-grep-max-length-history)
5444         (setq anything-c-grep-history
5445               (delete (car (last anything-c-grep-history))
5446                       anything-c-grep-history))))))
5447
5448 (defun anything-c-grep-other-window (candidate)
5449   "Jump to result in other window from anything grep."
5450   (anything-c-grep-action candidate 'other-window))
5451
5452 (defun anything-c-grep-other-frame (candidate)
5453   "Jump to result in other frame from anything grep."
5454   (anything-c-grep-action candidate 'other-frame))
5455
5456 (defun anything-c-grep-jump-elscreen (candidate)
5457   "Jump to result in elscreen from anything grep."
5458   (anything-c-grep-action candidate 'elscreen))
5459
5460 (defun anything-c-grep-save-results (_candidate)
5461   (anything-c-grep-action _candidate 'grep))
5462
5463 (defun anything-c-grep-save-results-1 ()
5464   "Save anything grep result in a `grep-mode' buffer."
5465   (let ((buf "*grep*")
5466         new-buf)
5467     (when (get-buffer buf)
5468       (setq new-buf (read-string "GrepBufferName: " buf))
5469       (loop for b in (anything-c-buffer-list)
5470             when (and (string= new-buf b)
5471                       (not (y-or-n-p
5472                             (format "Buffer `%s' already exists overwrite? "
5473                                     new-buf))))
5474             do (setq new-buf (read-string "GrepBufferName: " "*grep ")))
5475       (setq buf new-buf))
5476     (with-current-buffer (get-buffer-create buf)
5477       (let ((inhibit-read-only t))
5478         (erase-buffer)
5479         (insert "-*- mode: grep -*-\n\n"
5480                 (format "Grep Results for `%s':\n\n" anything-pattern))
5481         (save-excursion
5482           (insert (with-current-buffer anything-buffer
5483                     (goto-char (point-min)) (forward-line 1)
5484                     (buffer-substring (point) (point-max))))
5485           (grep-mode))))
5486     (message "Anything Grep Results saved in `%s' buffer" buf)))
5487
5488 (defun anything-c-grep-persistent-action (candidate)
5489   "Persistent action for `anything-do-grep'.
5490 With a prefix arg record CANDIDATE in `mark-ring'."
5491   (if current-prefix-arg
5492       (anything-c-grep-action candidate nil 'mark)
5493       (anything-c-grep-action candidate))
5494   (anything-match-line-color-current-line))
5495
5496 (defun anything-c-grep-guess-extensions (files)
5497   "Try to guess file extensions in FILES list when using grep recurse.
5498 These extensions will be added to command line with --include arg of grep."
5499   (loop
5500         with glob-list = nil
5501         with lst = (if (file-directory-p (car files))
5502                        (directory-files
5503                         (car files) nil
5504                         directory-files-no-dot-files-regexp)
5505                        files)
5506         for i in lst
5507         for ext = (file-name-extension i t)
5508         for glob = (and ext (not (string= ext ""))
5509                         (concat "*" ext))
5510         unless (or (not glob)
5511                    (member glob glob-list)
5512                    (member glob grep-find-ignored-files))
5513         collect glob into glob-list
5514         finally return glob-list))
5515
5516 (defun anything-do-grep-1 (only &optional recurse zgrep)
5517   "Launch grep with a list of ONLY files.
5518 When RECURSE is given use -r option of grep and prompt user
5519 to set the --include args of grep.
5520 You can give more than one arg separated by space.
5521 e.g *.el *.py *.tex.
5522 If it's empty --exclude `grep-find-ignored-files' is used instead."
5523   (let* ((anything-compile-source-functions
5524           ;; rule out anything-match-plugin because the input is one regexp.
5525           (delq 'anything-compile-source--match-plugin
5526                 (copy-sequence anything-compile-source-functions)))
5527          (exts (anything-c-grep-guess-extensions only))
5528          (globs (and (not zgrep) (mapconcat 'identity exts " ")))
5529          (include-files (and recurse (not zgrep)
5530                              (read-string "OnlyExt(*.[ext]): "
5531                                           globs)))
5532          ;; Set `minibuffer-history' AFTER includes-files
5533          ;; to avoid storing wild-cards here.
5534          (minibuffer-history anything-c-grep-history)
5535          (anything-c-grep-default-command (cond ((and recurse zgrep) anything-c-default-zgrep-command)
5536                                                 (recurse anything-c-grep-default-recurse-command)
5537                                                 (zgrep anything-c-default-zgrep-command)
5538                                                 (t anything-c-grep-default-command)))
5539          ;; Disable match-plugin and use here own highlighting.
5540          (anything-mp-highlight-delay     nil))
5541     (when include-files
5542       (setq include-files
5543             (and (not (string= include-files ""))
5544                  (mapconcat #'(lambda (x)
5545                                 (concat "--include=" (shell-quote-argument x)))
5546                             (split-string include-files) " "))))
5547     ;; When called as action from an other source e.g *-find-files
5548     ;; we have to kill action buffer.
5549     (when (get-buffer anything-action-buffer)
5550       (kill-buffer anything-action-buffer))
5551     ;; `anything-find-files' haven't already started,
5552     ;; give a default value to `anything-ff-default-directory'.
5553     (setq anything-ff-default-directory (or anything-ff-default-directory
5554                                             default-directory))
5555     (anything
5556      :sources
5557      `(((name . "Grep")
5558         (header-name . (lambda (name)
5559                          (concat name "(C-c ? Help)")))
5560         (candidates
5561          . (lambda ()
5562              (funcall anything-c-grep-default-function only include-files zgrep)))
5563         (filtered-candidate-transformer anything-c-grep-cand-transformer)
5564         (candidate-number-limit . 9999)
5565         (mode-line . anything-grep-mode-line-string)
5566         (keymap . ,anything-c-grep-map)
5567         (action . ,(delq
5568                     nil
5569                     `(("Find File" . anything-c-grep-action)
5570                       ("Find file other frame" . anything-c-grep-other-frame)
5571                       ,(and (locate-library "elscreen")
5572                             '("Find file in Elscreen"
5573                               . anything-c-grep-jump-elscreen))
5574                       ("Save results in grep buffer" . anything-c-grep-save-results)
5575                       ("Find file other window" . anything-c-grep-other-window))))
5576         (persistent-action . anything-c-grep-persistent-action)
5577         (persistent-help . "Jump to line (`C-u' Record in mark ring)")
5578         (requires-pattern . 3)
5579         (delayed)))
5580      :buffer "*anything grep*")))
5581
5582 (defun anything-ff-zgrep-1 (flist recursive)
5583   (unwind-protect
5584        (let* ((def-dir (or anything-ff-default-directory
5585                            default-directory))
5586               (only    (if recursive
5587                            (or (gethash def-dir anything-c-rzgrep-cache)
5588                                (puthash
5589                                 def-dir
5590                                 (anything-c-walk-directory
5591                                  def-dir
5592                                  :directories nil
5593                                  :path 'full
5594                                  :match ".*\\(\.gz\\|\.bz\\|\.xz\\|\.lzma\\)$")
5595                                 anything-c-rzgrep-cache))
5596                            flist)))
5597          (when recursive (setq anything-c-zgrep-recurse-flag t))
5598          (anything-do-grep-1 only recursive 'zgrep))
5599     (setq anything-c-zgrep-recurse-flag nil)))
5600
5601 (defun anything-c-grep-split-line (line)
5602   "Split a grep output line."
5603   (let (beg fname lineno str)
5604     ;; Don't print until grep line is valid.
5605     (when (string-match "\\(.*\\)\\(:[0-9]+:\\)\\(.*\\)" line)
5606       (with-temp-buffer
5607         (insert line)
5608         (goto-char (point-min))
5609         (setq beg (point))
5610         (forward-char 2)
5611         (re-search-forward ":" nil t)
5612         (setq fname (buffer-substring-no-properties beg (1- (point))))
5613         (setq beg (point))
5614         (re-search-forward ":" nil t)
5615         (setq lineno (buffer-substring-no-properties beg (1- (point))))
5616         (setq str (buffer-substring-no-properties (point) (point-at-eol))))
5617       (list fname lineno str))))
5618
5619 (defun anything-c-grep-cand-transformer (candidates sources)
5620   "Filtered candidate transformer function for `anything-do-grep'."
5621   (loop for i in candidates
5622         for split  = (and i (anything-c-grep-split-line i))
5623         for fname  = (car split)
5624         for lineno = (nth 1 split)
5625         for str    = (nth 2 split)
5626         when (and fname lineno str)
5627         collect
5628         (cons (concat (propertize (file-name-nondirectory fname)
5629                                   'face 'anything-grep-file
5630                                   'help-echo fname) ":"
5631                                   (propertize lineno 'face 'anything-grep-lineno) ":"
5632                                   (anything-c-grep-highlight-match str))
5633               i)))
5634
5635 (defun anything-c-grep-highlight-match (str)
5636   "Highlight in string STR all occurences matching `anything-pattern'."
5637   (condition-case nil
5638       (with-temp-buffer
5639         (insert str)
5640         (goto-char (point-min))
5641         (while (and (re-search-forward anything-pattern nil t)
5642                     (> (- (match-end 0) (match-beginning 0)) 0))
5643           (add-text-properties
5644            (match-beginning 0) (match-end 0)
5645            '(face anything-grep-match)))
5646         (buffer-string))
5647     (error nil)))
5648
5649 ;; Go to next or precedent file (common to etags and grep).
5650 (defun anything-c-goto-next-or-prec-file (n)
5651   "Go to next or precedent candidate file in anything grep/etags buffers.
5652 If N is positive go forward otherwise go backward."
5653   (with-anything-window
5654     (let* ((current-line-list  (split-string
5655                                 (buffer-substring
5656                                  (point-at-bol)
5657                                  (point-at-eol)) ":"))
5658            (current-fname      (nth 0 current-line-list))
5659            (fn-b-o-f           (if (eq n 1) 'eobp 'bobp)))
5660       (catch 'break
5661         (while (not (funcall fn-b-o-f))
5662           (forward-line n) ; Go forward or backward depending of n value.
5663           (unless (search-forward current-fname (point-at-eol) t)
5664             (anything-mark-current-line)
5665             (throw 'break nil))))
5666       (cond ((and (eq n 1) (eobp))
5667              (re-search-backward ".")
5668              (forward-line 0)
5669              (anything-mark-current-line))
5670             ((and (< n 1) (bobp))
5671              (forward-line 1)
5672              (anything-mark-current-line))))))
5673
5674 ;;;###autoload
5675 (defun anything-c-goto-precedent-file ()
5676   "Go to precedent file in anything grep/etags buffers."
5677   (interactive)
5678   (anything-c-goto-next-or-prec-file -1))
5679
5680 ;;;###autoload
5681 (defun anything-c-goto-next-file ()
5682   "Go to precedent file in anything grep/etags buffers."
5683   (interactive)
5684   (anything-c-goto-next-or-prec-file 1))
5685
5686 ;;;###autoload
5687 (defun anything-c-grep-run-persistent-action ()
5688   "Run grep persistent action from `anything-do-grep-1'."
5689   (interactive)
5690   (anything-attrset 'jump-persistent 'anything-c-grep-persistent-action)
5691   (anything-execute-persistent-action 'jump-persistent))
5692
5693 ;;;###autoload
5694 (defun anything-c-grep-run-default-action ()
5695   "Run grep default action from `anything-do-grep-1'."
5696   (interactive)
5697   (anything-c-quit-and-execute-action 'anything-c-grep-action))
5698
5699 ;;;###autoload
5700 (defun anything-c-grep-run-other-window-action ()
5701   "Run grep goto other window action from `anything-do-grep-1'."
5702   (interactive)
5703   (anything-c-quit-and-execute-action 'anything-c-grep-other-window))
5704
5705 ;;;###autoload
5706 (defun anything-c-grep-run-save-buffer ()
5707   "Run grep save results action from `anything-do-grep-1'."
5708   (interactive)
5709   (anything-c-quit-and-execute-action 'anything-c-grep-save-results))
5710
5711 ;; Grep buffers
5712 (defun anything-c-grep-buffers-1 (candidate &optional zgrep)
5713   "Run grep on all file--buffers or CANDIDATE if it is a file--buffer.
5714 If one of selected buffers is not a file--buffer,
5715 it is ignored and grep will run on all others file--buffers.
5716 If only one candidate is selected and it is not a file--buffer,
5717 switch to this buffer and run `anything-occur'.
5718 If a prefix arg is given run grep on all buffers ignoring non--file-buffers."
5719   (let* ((prefarg (or current-prefix-arg anything-current-prefix-arg))
5720          (cands (if prefarg
5721                     (buffer-list)
5722                     (anything-marked-candidates)))
5723          (win-conf (current-window-configuration))
5724          ;; Non--fname buffers are ignored.
5725          (bufs (loop for buf in cands
5726                      for fname = (buffer-file-name (get-buffer buf))
5727                      when fname
5728                      collect (expand-file-name fname))))
5729     (if bufs
5730         (if zgrep
5731             (anything-do-grep-1 bufs nil 'zgrep)
5732             (anything-do-grep-1 bufs))
5733         ;; bufs is empty, thats mean we have only CANDIDATE
5734         ;; and it is not a buffer-filename, fallback to occur.
5735         (anything-c-switch-to-buffer candidate)
5736         (when (get-buffer anything-action-buffer)
5737           (kill-buffer anything-action-buffer))
5738         (anything-occur)
5739         (when (eq anything-exit-status 1)
5740           (set-window-configuration win-conf)))))
5741
5742 (defun anything-c-grep-buffers (candidate)
5743   "Action to grep buffers."
5744   (anything-c-grep-buffers-1 candidate))
5745
5746 (defun anything-c-zgrep-buffers (candidate)
5747   "Action to zgrep buffers."
5748   (anything-c-grep-buffers-1 candidate 'zgrep))
5749
5750 \f
5751 ;;; Anything interface for pdfgrep
5752 ;;  pdfgrep program <http://pdfgrep.sourceforge.net/>
5753 ;;  and a pdf-reader (e.g xpdf) are needed.
5754 ;;
5755 (defvar anything-c-pdfgrep-default-command "pdfgrep --color never -niH %s %s")
5756 (defvar anything-c-pdfgrep-default-function 'anything-c-pdfgrep-init)
5757 (defvar anything-c-pdfgrep-debug-command-line nil)
5758
5759 (defun anything-c-pdfgrep-init (only-files)
5760   "Start an asynchronous pdfgrep process in ONLY-FILES list."
5761   (let* ((fnargs   (anything-c-grep-prepare-candidates
5762                     (if (file-remote-p anything-ff-default-directory)
5763                         (mapcar #'(lambda (x)
5764                                     (file-remote-p x 'localname))
5765                                 only-files)
5766                         only-files)))
5767          (cmd-line (format anything-c-pdfgrep-default-command
5768                            anything-pattern
5769                            fnargs)))
5770     (when anything-c-pdfgrep-debug-command-line
5771       (with-current-buffer (get-buffer-create "*any pdfgrep debug*")
5772         (goto-char (point-max))
5773         (insert (concat ">>> " cmd-line "\n\n"))))
5774     (setq mode-line-format
5775           '(" " mode-line-buffer-identification " "
5776             (line-number-mode "%l") " "
5777             (:eval (propertize "(Pdfgrep Process Running) "
5778                     'face '((:foreground "red"))))))
5779     (prog1
5780         (let ((default-directory anything-ff-default-directory))
5781           (start-file-process-shell-command "pdfgrep-process" nil cmd-line))
5782       (message nil)
5783       (set-process-sentinel
5784        (get-process "pdfgrep-process")
5785        #'(lambda (process event)
5786            (when (string= event "finished\n")
5787              (with-anything-window
5788                (anything-update-move-first-line))
5789              (force-mode-line-update nil)))))))
5790
5791
5792 (defun anything-do-pdfgrep-1 (only)
5793   "Launch pdfgrep with a list of ONLY files."
5794   (unless (executable-find "pdfgrep")
5795     (error "Error: No such program `pdfgrep'."))
5796   (let* ((anything-compile-source-functions
5797           ;; rule out anything-match-plugin because the input is one regexp.
5798           (delq 'anything-compile-source--match-plugin
5799                 (copy-sequence anything-compile-source-functions)))
5800          ;; Disable match-plugin and use here own highlighting.
5801          (anything-mp-highlight-delay nil))
5802     ;; When called as action from an other source e.g *-find-files
5803     ;; we have to kill action buffer.
5804     (when (get-buffer anything-action-buffer)
5805       (kill-buffer anything-action-buffer))
5806     ;; If `anything-find-files' haven't already started,
5807     ;; give a default value to `anything-ff-default-directory'.
5808     (setq anything-ff-default-directory (or anything-ff-default-directory
5809                                             default-directory))
5810     (anything
5811      :sources
5812      `(((name . "PdfGrep")
5813         (candidates
5814          . (lambda ()
5815              (funcall anything-c-pdfgrep-default-function only)))
5816         (filtered-candidate-transformer anything-c-grep-cand-transformer)
5817         (candidate-number-limit . 9999)
5818         (mode-line . anything-pdfgrep-mode-line-string)
5819         (action . anything-c-pdfgrep-action)
5820         (persistent-help . "Jump to PDF Page")
5821         (requires-pattern . 3)
5822         (delayed)))
5823      :keymap anything-c-pdfgrep-map
5824      :buffer "*anything grep*")))
5825
5826
5827 (defun anything-c-pdfgrep-action (candidate)
5828   (let* ((split  (anything-c-grep-split-line candidate))
5829          (pageno (nth 1 split))
5830          (fname  (car split)))
5831     (start-file-process-shell-command
5832      "pdf-reader" nil
5833      (format-spec anything-c-pdfgrep-default-read-command
5834                   (list (cons ?f fname) (cons ?p pageno))))))
5835
5836 \f
5837 ;; Yank text at point.
5838 ;;
5839 ;;
5840 ;; Internal
5841 (defvar anything-yank-point nil)
5842
5843 ;;;###autoload
5844 (defun anything-yank-text-at-point ()
5845   "Yank text at point in minibuffer."
5846   (interactive)
5847   (let (input)
5848     (flet ((insert-in-minibuffer (word)
5849              (with-selected-window (minibuffer-window)
5850                (let ((str anything-pattern))
5851                  (delete-minibuffer-contents)
5852                  (set-text-properties 0 (length word) nil word)
5853                  (insert (concat str word))))))
5854       (with-anything-current-buffer
5855         ;; Start to initial point if C-w have never been hit.
5856         (unless anything-yank-point (setq anything-yank-point (point)))
5857         (and anything-yank-point (goto-char anything-yank-point))
5858         (forward-word 1)
5859         (setq input (buffer-substring-no-properties anything-yank-point (point)))
5860         (setq anything-yank-point (point))) ; End of last forward-word
5861       (insert-in-minibuffer input))))
5862
5863 (defun anything-reset-yank-point ()
5864   (setq anything-yank-point nil))
5865
5866 (add-hook 'anything-after-persistent-action-hook 'anything-reset-yank-point)
5867 (add-hook 'anything-cleanup-hook 'anything-reset-yank-point)
5868
5869 \f
5870 ;;; Recentf files
5871 ;;
5872 ;;
5873 (defvar anything-c-source-recentf
5874   `((name . "Recentf")
5875     (init . (lambda ()
5876               (require 'recentf)
5877               (or recentf-mode (recentf-mode 1))))
5878     ;; Needed for filenames with capitals letters.
5879     (disable-shortcuts)
5880     (candidates . recentf-list)
5881     (keymap . ,anything-generic-files-map)
5882     (help-message . anything-generic-file-help-message)
5883     (mode-line . anything-generic-file-mode-line-string)
5884     (match anything-c-match-on-basename)
5885     (type . file))
5886   "See (info \"(emacs)File Conveniences\").
5887 Set `recentf-max-saved-items' to a bigger value if default is too small.")
5888
5889 ;;; ffap
5890 (eval-when-compile (require 'ffap))
5891 (defvar anything-c-source-ffap-guesser
5892   `((name . "File at point")
5893     (init . (lambda () (require 'ffap)))
5894     (candidates . (lambda ()
5895                     (anything-aif
5896                         (with-anything-current-buffer
5897                           (ffap-guesser))
5898                         (list it))))
5899     (keymap . ,anything-generic-files-map)
5900     (help-message . anything-generic-file-help-message)
5901     (mode-line . anything-generic-file-mode-line-string)
5902     (type . file)))
5903
5904 ;;; ffap with line number
5905 (defun anything-c-ffap-file-line-at-point ()
5906   "Get (FILENAME . LINENO) at point."
5907   (anything-aif (let (ffap-alist) (ffap-file-at-point))
5908       (save-excursion
5909         (beginning-of-line)
5910         (when (and (search-forward it nil t)
5911                    (looking-at ":\\([0-9]+\\)"))
5912           (cons it (string-to-number (match-string 1)))))))
5913
5914 (defun anything-c-ffap-line-candidates ()
5915   (with-anything-current-buffer
5916     (anything-attrset 'ffap-line-location (anything-c-ffap-file-line-at-point)))
5917   (anything-aif (anything-attr 'ffap-line-location)
5918     (destructuring-bind (file . line) it
5919       (list (cons (format "%s (line %d)" file line) file)))))
5920
5921 ;;; Goto line after opening file by `anything-c-source-ffap-line'.
5922 (defun anything-c-ffap-line-goto-line ()
5923   (when (car (anything-attr 'ffap-line-location))
5924     (unwind-protect
5925         (ignore-errors
5926           (with-selected-window
5927               (get-buffer-window
5928                (get-file-buffer (car (anything-attr 'ffap-line-location))))
5929             (anything-goto-line (cdr (anything-attr 'ffap-line-location)))))
5930       (anything-attrset 'ffap-line-location nil))))
5931 (add-hook 'anything-after-action-hook 'anything-c-ffap-line-goto-line)
5932 (add-hook 'anything-after-persistent-action-hook 'anything-c-ffap-line-goto-line)
5933
5934 (defvar anything-c-source-ffap-line
5935   `((name . "File/Lineno at point")
5936     (init . (lambda () (require 'ffap)))
5937     (candidates . anything-c-ffap-line-candidates)
5938     (keymap . ,anything-map)
5939     (type . file)))
5940
5941 ;;; list of files gleaned from every dired buffer
5942 (defun anything-c-files-in-all-dired-candidates ()
5943   (save-excursion
5944     (mapcan
5945      (lambda (dir)
5946        (cond ((listp dir)               ;filelist
5947               dir)
5948              ((equal "" (file-name-nondirectory dir)) ;dir
5949               (directory-files dir t))
5950              (t                         ;wildcard
5951               (file-expand-wildcards dir t))))
5952      (delq nil
5953            (mapcar (lambda (buf)
5954                      (set-buffer buf)
5955                      (when (eq major-mode 'dired-mode)
5956                        (if (consp dired-directory)
5957                            (cdr dired-directory) ;filelist
5958                            dired-directory))) ;dir or wildcard
5959                    (buffer-list))))))
5960 ;; (dired '("~/" "~/.emacs-custom.el" "~/.emacs.bmk"))
5961
5962 (defvar anything-c-source-files-in-all-dired
5963   '((name . "Files in all dired buffer.")
5964     (candidates . anything-c-files-in-all-dired-candidates)
5965     (type . file)))
5966
5967 (defvar anything-c-source-filelist
5968   '((name . "FileList")
5969     (grep-candidates . anything-c-filelist-file-name)
5970     (candidate-number-limit . 200)
5971     (requires-pattern . 4)
5972     (type . file))
5973   "Source to find files instantly.
5974 See `anything-c-filelist-file-name' docstring for usage.")
5975
5976 \f
5977 ;;;; <info>
5978 ;;; Info pages
5979 (defvar anything-c-info-pages nil
5980   "All info pages on system.
5981 Will be calculated the first time you invoke anything with this
5982 source.")
5983
5984 (defun anything-c-info-pages-init ()
5985   "Collect candidates for initial Info node Top."
5986   (if anything-c-info-pages
5987       anything-c-info-pages
5988       (let ((info-topic-regexp "\\* +\\([^:]+: ([^)]+)[^.]*\\)\\.")
5989             topics)
5990         (require 'info)
5991         (with-temp-buffer
5992           (Info-find-node "dir" "top")
5993           (goto-char (point-min))
5994           (while (re-search-forward info-topic-regexp nil t)
5995             (push (match-string-no-properties 1) topics))
5996           (kill-buffer))
5997         (setq anything-c-info-pages topics))))
5998
5999 (defvar anything-c-source-info-pages
6000   `((name . "Info Pages")
6001     (init . anything-c-info-pages-init)
6002     (candidates . anything-c-info-pages)
6003     (action . (("Show with Info" .(lambda (node-str)
6004                                     (info (replace-regexp-in-string
6005                                            "^[^:]+: " "" node-str))))))
6006     (requires-pattern . 2)))
6007
6008 \f
6009 ;;; Man and woman UI
6010 ;;
6011 ;;
6012 (defvar anything-c-man-pages nil
6013   "All man pages on system.
6014 Will be calculated the first time you invoke anything with this
6015 source.")
6016
6017 (defun anything-c-man-default-action (candidate)
6018   "Default action for jumping to a woman or man page from anything."
6019   (let ((wfiles (woman-file-name-all-completions candidate)))
6020     (condition-case err
6021         (if (> (length wfiles) 1)
6022             (woman-find-file
6023              (anything-comp-read
6024               "ManFile: " wfiles :must-match t))
6025             (woman candidate))
6026       ;; If woman is unable to format correctly
6027       ;; use man instead.
6028       (error (kill-buffer) ; Kill woman buffer.
6029              (let ((Man-notify-method 'meek))
6030                (Man-getpage-in-background candidate))))))
6031
6032 (defvar anything-c-source-man-pages
6033   `((name . "Manual Pages")
6034     (candidates . (lambda ()
6035                     (if anything-c-man-pages
6036                         anything-c-man-pages
6037                         ;; XEmacs doesn't have a woman :)
6038                         (setq anything-c-man-pages
6039                               (ignore-errors
6040                                 (require 'woman)
6041                                 (woman-file-name "")
6042                                 (sort (mapcar 'car woman-topic-all-completions)
6043                                       'string-lessp))))))
6044     (action  ("Show with Woman" . anything-c-man-default-action))
6045     ;; Woman does not work OS X
6046     ;; http://xahlee.org/emacs/modernization_man_page.html
6047     (action-transformer . (lambda (actions candidate)
6048                             (if (eq system-type 'darwin)
6049                                 '(("Show with Man" . man))
6050                                 actions)))
6051     (requires-pattern . 2)))
6052
6053 \f
6054 ;;;; <Command>
6055 ;;; Anything M-x - Enhanced M-x UI
6056 ;;
6057 ;;
6058 ;; Another replacement of `M-x' that act exactly like the
6059 ;; vanilla Emacs one, no problem of windows configuration, prefix args
6060 ;; can be passed before calling `M-x' (e.g C-u M-x..) but also during
6061 ;; anything invocation.
6062 ;; Documentation of commands available without quitting,
6063 ;; Show keybindings of commands.
6064 ;; Show history.
6065 (defvar anything-M-x-input-history nil)
6066
6067 (defun* anything-M-x-get-major-mode-command-alist (mode-map)
6068   "Return alist of MODE-MAP."
6069   (loop for key being the key-seqs of mode-map using (key-bindings com)
6070         for str-key  = (key-description key)
6071         for ismenu   = (string-match "<menu-bar>" str-key)
6072         unless ismenu collect (cons str-key com)))
6073
6074 (defun anything-get-mode-map-from-mode (mode)
6075   "Guess the mode-map name according to MODE.
6076 Some modes don't use conventional mode-map name
6077 so we need to guess mode-map name. e.g python-mode ==> py-mode-map.
6078 Return nil if no mode-map found."
6079   (loop
6080         ;; Start with a conventional mode-map name.
6081         with mode-map    = (intern-soft (format "%s-map" mode))
6082         with mode-string = (symbol-name mode)
6083         with mode-name   = (replace-regexp-in-string "-mode" "" mode-string)
6084         while (not mode-map)
6085         for count downfrom (length mode-name)
6086         ;; Return when no result after parsing entire string.
6087         when (eq count 0) return nil
6088         for sub-name = (substring mode-name 0 count)
6089         do (setq mode-map (intern-soft (format "%s-map" (concat sub-name "-mode"))))
6090         finally return mode-map))
6091
6092 (defun anything-M-x-current-mode-map-alist ()
6093   "Return mode-map alist of current `major-mode'."
6094   (let ((map (anything-get-mode-map-from-mode major-mode)))
6095     (when (and map (boundp map))
6096       (anything-M-x-get-major-mode-command-alist (symbol-value map)))))
6097
6098
6099 (defun anything-M-x-transformer (candidates sources)
6100   "filtered-candidate-transformer to show bindings in emacs commands.
6101 Show global bindings and local bindings according to current `major-mode'."
6102   (with-anything-current-buffer
6103     (loop with local-map = (anything-M-x-current-mode-map-alist)
6104           for cand in candidates
6105           for local-key  = (car (rassq cand local-map))
6106           for key        = (substitute-command-keys (format "\\[%s]" cand))
6107           collect
6108           (cons (cond ((and (string-match "^M-x" key) local-key)
6109                        (format "%s (%s)"
6110                                cand (propertize
6111                                      local-key
6112                                      'face 'anything-M-x-key-face)))
6113                       ((string-match "^M-x" key) cand)
6114                       (t (format "%s (%s)"
6115                                  cand (propertize
6116                                        key
6117                                        'face 'anything-M-x-key-face))))
6118                 cand) into ls
6119           finally return
6120           (sort ls #'(lambda (x y) (string-lessp (car x) (car y)))))))
6121
6122 \f
6123 ;;; Complex command history
6124 ;;
6125 ;;
6126 (defvar anything-c-source-complex-command-history
6127   '((name . "Complex Command History")
6128     (candidates . (lambda () (mapcar 'prin1-to-string command-history)))
6129     (type . sexp)))
6130
6131 ;;; M-x history (not related to `anything-M-x')
6132 ;;
6133 ;;
6134 (defvar anything-c-source-extended-command-history
6135   '((name . "Emacs Commands History")
6136     (candidates
6137      . (lambda ()
6138          (anything-fast-remove-dups extended-command-history :test 'equal)))
6139     (type . command)))
6140
6141 ;;; Emacs commands (Basic source for emacs commands)
6142 ;;
6143 ;;
6144 (defvar anything-c-source-emacs-commands
6145   '((name . "Emacs Commands")
6146     (candidates . (lambda ()
6147                     (let (commands)
6148                       (mapatoms (lambda (a)
6149                                   (if (commandp a)
6150                                       (push (symbol-name a)
6151                                             commands))))
6152                       (sort commands 'string-lessp))))
6153     (type . command)
6154     (requires-pattern . 2))
6155   "Source for completing and invoking Emacs commands.
6156 A command is a function with interactive spec that can
6157 be invoked with `M-x'.
6158
6159 To get non-interactive functions listed, use
6160 `anything-c-source-emacs-functions'.")
6161
6162 \f
6163 ;;;; <Function>
6164 ;;; Emacs functions
6165 ;;
6166 ;;
6167 (defvar anything-c-source-emacs-functions
6168   '((name . "Emacs Functions")
6169     (candidates . (lambda ()
6170                     (let (commands)
6171                       (mapatoms (lambda (a)
6172                                   (if (functionp a)
6173                                       (push (symbol-name a) commands))))
6174                       (sort commands 'string-lessp))))
6175     (type . function)
6176     (requires-pattern . 2))
6177   "Source for completing Emacs functions.")
6178
6179 ;;; With abbrev expansion
6180 ;;; Similar to my exec-abbrev-cmd.el
6181 ;;; See http://www.tsdh.de/cgi-bin/wiki.pl/exec-abbrev-cmd.el
6182 (defvar anything-c-function-abbrev-regexp nil
6183   "The regexp for `anything-c-source-emacs-functions-with-abbrevs'.
6184 Regexp built from the current `anything-pattern' interpreting it
6185 as abbreviation.
6186 Only for internal use.")
6187
6188 (defun anything-c-match-function-by-abbrev (candidate)
6189   "Return non-nil if `anything-pattern' is an abbreviation of the function CANDIDATE.
6190
6191 Abbreviations are made by taking the first character from each
6192 word in the function's name, e.g. \"bb\" is an abbrev for
6193 `bury-buffer', \"stb\" is an abbrev for `anything-c-switch-to-buffer'."
6194   (string-match anything-c-function-abbrev-regexp candidate))
6195
6196 (defvar anything-c-source-emacs-functions-with-abbrevs
6197   (append anything-c-source-emacs-functions
6198           '((match anything-c-match-function-by-abbrev
6199              anything-c-string-match))
6200           '((init
6201              . (lambda ()
6202                  (defadvice anything-update
6203                      (before anything-c-update-function-abbrev-regexp activate)
6204                    (let ((char-list (append anything-pattern nil))
6205                          (str "^"))
6206                      (dolist (c char-list)
6207                        (setq str (concat str (list c) "[^-]*-")))
6208                      (setq str (concat (substring str 0 (1- (length str))) "$"))
6209                      (setq anything-c-function-abbrev-regexp str))))))))
6210
6211 (defvar anything-c-source-advice
6212   '((name . "Function Advice")
6213     (candidates . anything-c-advice-candidates)
6214     (action ("Toggle Enable/Disable" . anything-c-advice-toggle))
6215     (persistent-action . anything-c-advice-persistent-action)
6216     (multiline)
6217     (persistent-help . "Describe function / C-u C-z: Toggle advice")))
6218 ;; (let ((debug-on-signal t))(anything 'anything-c-source-advice))
6219 ;; (testadvice)
6220
6221 (defun anything-c-advice-candidates ()
6222   (require 'advice)
6223   (loop for (fname) in ad-advised-functions
6224         for function = (intern fname)
6225         append
6226         (loop for class in ad-advice-classes append
6227               (loop for advice in (ad-get-advice-info-field function class)
6228                     for enabled = (ad-advice-enabled advice)
6229                     collect
6230                     (cons (format
6231                            "%s %s %s"
6232                            (if enabled "Enabled " "Disabled")
6233                            (propertize fname 'face 'font-lock-function-name-face)
6234                            (ad-make-single-advice-docstring advice class nil))
6235                           (list function class advice))))))
6236
6237 (defun anything-c-advice-persistent-action (func-class-advice)
6238   (if current-prefix-arg
6239       (anything-c-advice-toggle func-class-advice)
6240       (describe-function (car func-class-advice))))
6241
6242 (defun anything-c-advice-toggle (func-class-advice)
6243   (destructuring-bind (function class advice) func-class-advice
6244     (cond ((ad-advice-enabled advice)
6245            (ad-advice-set-enabled advice nil)
6246            (message "Disabled"))
6247           (t                            ;disabled
6248            (ad-advice-set-enabled advice t)
6249            (message "Enabled")))
6250     (ad-activate function)
6251     (and anything-in-persistent-action
6252          (anything-c-advice-update-current-display-string))))
6253
6254 (defun anything-c-advice-update-current-display-string ()
6255   (anything-edit-current-selection
6256     (let ((newword (cond ((looking-at "Disabled") "Enabled")
6257                          ((looking-at "Enabled")  "Disabled")))
6258           realvalue)
6259       (when newword
6260         (delete-region (point) (progn (forward-word 1) (point)))
6261         (insert newword)))))
6262
6263 \f
6264 ;;;; <Variable>
6265 ;;; Emacs variables
6266 ;;
6267 ;;
6268 (defvar anything-c-source-emacs-variables
6269   '((name . "Emacs Variables")
6270     (candidates . (lambda ()
6271                     (sort (all-completions "" obarray 'boundp) 'string-lessp)))
6272     (type . variable)
6273     (requires-pattern . 2))
6274   "Source for completing Emacs variables.")
6275
6276 \f
6277 ;;; LaCarte
6278 (defvar anything-c-source-lacarte
6279   '((name . "Lacarte")
6280     (init . (lambda () (require 'lacarte )))
6281     (candidates . (lambda () (delete '(nil) (lacarte-get-overall-menu-item-alist))))
6282     (candidate-number-limit . 9999)
6283     (action . anything-c-call-interactively))
6284   "Needs lacarte.el.
6285
6286 http://www.emacswiki.org/cgi-bin/wiki/download/lacarte.el")
6287
6288 \f
6289 ;;; Bookmarks
6290 ;;
6291 ;;
6292 ;; Bind some faces for bookmarks.
6293 (defvar anything-c-bookmarks-face1 'anything-ff-directory)
6294 (defvar anything-c-bookmarks-face2 'anything-ff-file)
6295 (defvar anything-c-bookmarks-face3 'anything-bookmarks-su-face)
6296
6297 (eval-when-compile (require 'bookmark))
6298 (defvar anything-c-source-bookmarks
6299   `((name . "Bookmarks")
6300     (init . (lambda ()
6301               (require 'bookmark)))
6302     (candidates . bookmark-all-names)
6303     (type . bookmark))
6304   "See (info \"(emacs)Bookmarks\").")
6305
6306 ;;; bookmark-set
6307 (defvar anything-c-source-bookmark-set
6308   '((name . "Set Bookmark")
6309     (dummy)
6310     (action . bookmark-set))
6311   "See (info \"(emacs)Bookmarks\").")
6312
6313 ;;; Visible Bookmarks
6314 ;; (install-elisp "http://cvs.savannah.gnu.org/viewvc/*checkout*/bm/bm/bm.el")
6315
6316
6317 ;; http://d.hatena.ne.jp/grandVin/20080911/1221114327
6318 (defvar anything-c-source-bm
6319   '((name . "Visible Bookmarks")
6320     (init . anything-c-bm-init)
6321     (candidates-in-buffer)
6322     (type . line))
6323   "Needs bm.el.
6324
6325 http://www.nongnu.org/bm/")
6326
6327 (defun anything-c-bm-init ()
6328   "Init function for `anything-c-source-bm'."
6329   (when (require 'bm nil t)
6330     (with-no-warnings
6331       (let ((bookmarks (bm-lists))
6332             (buf (anything-candidate-buffer 'global)))
6333         (dolist (bm (sort* (append (car bookmarks) (cdr bookmarks))
6334                            '< :key 'overlay-start))
6335           (let ((start (overlay-start bm))
6336                 (end (overlay-end bm))
6337                 (annotation (or (overlay-get bm 'annotation) "")))
6338             (unless (< (- end start) 1) ; org => (if (< (- end start) 2)
6339               (let ((str (format "%5d: [%s]: %s\n"
6340                                  (line-number-at-pos start)
6341                                  annotation
6342                                  (buffer-substring start (1- end)))))
6343                 (with-current-buffer buf (insert str))))))))))
6344
6345 ;;; Special bookmarks
6346 (defvar anything-c-source-bookmarks-ssh
6347   '((name . "Bookmarks-ssh")
6348     (init . (lambda ()
6349               (require 'bookmark)))
6350     (candidates . (lambda () (anything-c-collect-bookmarks :ssh t)))
6351     (type . bookmark))
6352   "See (info \"(emacs)Bookmarks\").")
6353
6354 (defvar anything-c-source-bookmarks-su
6355   '((name . "Bookmarks-root")
6356     (init . (lambda ()
6357               (require 'bookmark)))
6358     (candidates . (lambda () (anything-c-collect-bookmarks :su t)))
6359     (filtered-candidate-transformer anything-c-highlight-bookmark-su)
6360
6361     (type . bookmark))
6362   "See (info \"(emacs)Bookmarks\").")
6363
6364 (defvar anything-c-source-bookmarks-local
6365   '((name . "Bookmarks-Local")
6366     (init . (lambda ()
6367               (require 'bookmark)))
6368     (candidates . (lambda () (anything-c-collect-bookmarks :local t)))
6369     (filtered-candidate-transformer
6370      anything-c-adaptive-sort
6371      anything-c-highlight-bookmark)
6372     (type . bookmark))
6373   "See (info \"(emacs)Bookmarks\").")
6374
6375 (defun* anything-c-collect-bookmarks (&key local su sudo ssh)
6376   (let* ((lis-all (bookmark-all-names))
6377          (lis-loc (cond (local (loop for i in lis-all
6378                                      unless (string-match "^(ssh)\\|^(su)" i)
6379                                      collect i))
6380                         (su (loop for i in lis-all
6381                                   when (string-match "^(su)" i)
6382                                   collect i))
6383                         (sudo (loop for i in lis-all
6384                                     when (string-match "^(sudo)" i)
6385                                     collect i))
6386                         (ssh (loop for i in lis-all
6387                                    when (string-match "^(ssh)" i)
6388                                    collect i)))))
6389     (sort lis-loc 'string-lessp)))
6390
6391 (defun anything-c-bookmark-root-logged-p ()
6392   (catch 'break
6393     (dolist (i (mapcar #'buffer-name (buffer-list)))
6394       (when (string-match (format "*tramp/%s ." anything-su-or-sudo) i)
6395         (throw 'break t)))))
6396
6397 (defun anything-c-highlight-bookmark-su (files source)
6398   (if (anything-c-bookmark-root-logged-p)
6399       (anything-c-highlight-bookmark files source)
6400       (anything-c-highlight-not-logged files source)))
6401
6402 (defun anything-c-highlight-not-logged (files source)
6403   (loop for i in files
6404         collect (propertize i 'face anything-c-bookmarks-face3)))
6405
6406 (defun anything-c-highlight-bookmark (bookmarks source)
6407   "Used as `candidate-transformer' to colorize bookmarks.
6408 Work both with standard Emacs bookmarks and bookmark-extensions.el."
6409   (loop for i in bookmarks
6410         for isfile        = (bookmark-get-filename i)
6411         for bufp          = (and (fboundp 'bmkext-get-buffer-name)
6412                                  (bmkext-get-buffer-name i))
6413         for handlerp      = (and (fboundp 'bookmark-get-handler)
6414                                  (bookmark-get-handler i))
6415         for isw3m         = (and (fboundp 'bmkext-w3m-bookmark-p)
6416                                  (bmkext-w3m-bookmark-p i))
6417         for isgnus        = (and (fboundp 'bmkext-gnus-bookmark-p)
6418                                  (bmkext-gnus-bookmark-p i))
6419         for isman         = (and (fboundp 'bmkext-man-bookmark-p) ; Man
6420                                  (bmkext-man-bookmark-p i))
6421         for iswoman       = (and (fboundp 'bmkext-woman-bookmark-p) ; Woman
6422                                  (bmkext-woman-bookmark-p i))
6423         for handlerp      = (bookmark-get-handler i)
6424         for isannotation  = (bookmark-get-annotation i)
6425         for isabook       = (string= (bookmark-prop-get i 'type) "addressbook")
6426         for isinfo        = (eq handlerp 'Info-bookmark-jump)
6427         ;; Add a * if bookmark have annotation
6428         if (and isannotation (not (string-equal isannotation "")))
6429         do (setq i (concat "*" i))
6430         collect (cond (;; info buffers
6431                        isinfo
6432                        (propertize i 'face 'anything-bmkext-info 'help-echo isfile))
6433                       (;; w3m buffers
6434                        isw3m
6435                        (propertize i 'face 'anything-bmkext-w3m 'help-echo isfile))
6436                       (;; gnus buffers
6437                        isgnus
6438                        (propertize i 'face 'anything-bmkext-gnus 'help-echo isfile))
6439                       (;; Man Woman
6440                        (or iswoman isman)
6441                        (propertize i 'face 'anything-bmkext-man 'help-echo isfile))
6442                       (;; Addressbook
6443                        isabook
6444                        (propertize i 'face '((:foreground "Tomato"))))
6445                       (;; directories
6446                        (and isfile (file-directory-p isfile))
6447                        (propertize i 'face anything-c-bookmarks-face1 'help-echo isfile))
6448                       (;; regular files
6449                        t
6450                        (propertize i 'face 'anything-bmkext-file 'help-echo isfile)))))
6451
6452 (defun anything-c-bookmark-jump (candidate)
6453   "Jump to bookmark from keyboard."
6454   (let ((current-prefix-arg anything-current-prefix-arg))
6455     (bookmark-jump candidate)))
6456
6457 ;;;###autoload
6458 (defun anything-c-bookmark-run-jump-other-window ()
6459   "Jump to bookmark from keyboard."
6460   (interactive)
6461   (anything-c-quit-and-execute-action 'bookmark-jump-other-window))
6462
6463 ;;;###autoload
6464 (defun anything-c-bookmark-run-delete ()
6465   "Delete bookmark from keyboard."
6466   (interactive)
6467   (when (y-or-n-p "Delete bookmark?")
6468     (anything-c-quit-and-execute-action 'anything-delete-marked-bookmarks)))
6469
6470 \f
6471 ;;; Sources to filter bookmark-extensions bookmarks.
6472 ;;
6473 ;;
6474 ;; Dependency: http://mercurial.intuxication.org/hg/emacs-bookmark-extension
6475 ;; If you want to enable google-maps in addressbook you will need
6476 ;; Julien Danjou google-maps-el package available here:
6477 ;; http://julien.danjou.info/google-maps-el.html
6478
6479 (defun anything-c-bmkext-filter-setup-alist (fn &rest args)
6480   "Return a filtered `bookmark-alist' sorted alphabetically."
6481   (loop
6482         with alist = (if args
6483                          (apply #'(lambda (x) (funcall fn x)) args)
6484                          (funcall fn))
6485         for i in alist
6486         for b = (car i)
6487         collect b into sa
6488         finally return (sort sa 'string-lessp)))
6489
6490 ;;;###autoload
6491 (defun anything-c-bmkext-run-edit ()
6492   "Run `bmkext-edit-bookmark' from keyboard."
6493   (interactive)
6494   (anything-c-quit-and-execute-action 'bmkext-edit-bookmark))
6495
6496 ;;; Addressbook.
6497 ;;
6498 ;;
6499 (defvar anything-c-source-bmkext-addressbook
6500   '((name . "Bookmark Addressbook")
6501     (init . (lambda ()
6502               (require 'bookmark-extensions)
6503               (bookmark-maybe-load-default-file)))
6504     (candidates . anything-c-bmkext-addressbook-setup-alist)
6505     (persistent-action
6506      . (lambda (candidate)
6507          (let ((bmk (anything-bookmark-get-bookmark-from-name
6508                      candidate)))
6509            (bookmark--jump-via bmk 'pop-to-buffer))))
6510     (persistent-help . "Show contact - Prefix with C-u to append")
6511     (filtered-candidate-transformer
6512      anything-c-adaptive-sort
6513      anything-c-highlight-bookmark)
6514     (action . (("Show Contact(s)"
6515                 . (lambda (candidate)
6516                     (let* ((contacts (anything-marked-candidates))
6517                            (current-prefix-arg (or anything-current-prefix-arg
6518                                                    (> (length contacts) 1))))
6519                       (bookmark-jump
6520                        (anything-bookmark-get-bookmark-from-name (car contacts)))
6521                       (anything-aif (cdr contacts)
6522                           (loop for bmk in it do
6523                                 (bookmark-jump
6524                                  (anything-bookmark-get-bookmark-from-name bmk)))))))
6525                ("Send Mail"
6526                 . (lambda (candidate)
6527                     (let* ((contacts (anything-marked-candidates))
6528                            (bmk      (anything-bookmark-get-bookmark-from-name
6529                                       (car contacts)))
6530                            (append   (message-buffers)))
6531                       (if append
6532                           (addressbook-set-mail-buffer1 bmk 'append)
6533                           (addressbook-set-mail-buffer1 bmk))
6534                       (setq contacts (cdr contacts))
6535                       (when contacts
6536                         (loop for bmk in contacts do
6537                               (addressbook-set-mail-buffer1 bmk 'append))))))
6538                ("Edit Bookmark"
6539                 . (lambda (candidate)
6540                     (let ((bmk (anything-bookmark-get-bookmark-from-name
6541                                 candidate)))
6542                       (addressbook-bookmark-edit
6543                        (assoc bmk bookmark-alist)))))
6544                ("Insert Email at point"
6545                 . (lambda (candidate)
6546                     (let* ((bmk   (anything-bookmark-get-bookmark-from-name
6547                                    candidate))
6548                            (mlist (split-string
6549                                    (assoc-default
6550                                     'email (assoc bmk bookmark-alist))
6551                                    ", ")))
6552                       (insert
6553                        (if (> (length mlist) 1)
6554                            (anything-comp-read
6555                             "Insert Mail Address: " mlist :must-match t)
6556                            (car mlist))))))
6557                ("Show annotation"
6558                 . (lambda (candidate)
6559                     (let ((bmk (anything-bookmark-get-bookmark-from-name
6560                                 candidate)))
6561                       (bookmark-show-annotation bmk))))
6562                ("Edit annotation"
6563                 . (lambda (candidate)
6564                     (let ((bmk (anything-bookmark-get-bookmark-from-name
6565                                 candidate)))
6566                       (bookmark-edit-annotation bmk))))
6567                ("Show Google map"
6568                 . (lambda (candidate)
6569                     (let* ((bmk (anything-bookmark-get-bookmark-from-name
6570                                  candidate))
6571                            (full-bmk (assoc bmk bookmark-alist)))
6572                       (addressbook-google-map full-bmk))))))))
6573
6574
6575 (defun anything-c-bmkext-addressbook-setup-alist ()
6576   "Specialized filter function for bookmarks w3m."
6577   (anything-c-bmkext-filter-setup-alist 'bmkext-addressbook-alist-only))
6578
6579 ;; W3m bookmarks from bookmark-extensions.
6580 (defvar anything-c-source-bookmark-w3m
6581   '((name . "Bookmark W3m")
6582     (init . (lambda ()
6583               (require 'bookmark-extensions)
6584               (bookmark-maybe-load-default-file)))
6585     (candidates . anything-c-bookmark-w3m-setup-alist)
6586     (filtered-candidate-transformer
6587      anything-c-adaptive-sort
6588      anything-c-highlight-bookmark)
6589     (type . bookmark)))
6590
6591 (defun anything-c-bookmark-w3m-setup-alist ()
6592   "Specialized filter function for bookmarks w3m."
6593   (anything-c-bmkext-filter-setup-alist 'bmkext-w3m-alist-only))
6594
6595 ;; Images
6596 (defvar anything-c-source-bookmark-images
6597   '((name . "Bookmark Images")
6598     (init . (lambda ()
6599               (require 'bookmark-extensions)
6600               (bookmark-maybe-load-default-file)))
6601     (candidates . anything-c-bookmark-images-setup-alist)
6602     (filtered-candidate-transformer
6603      anything-c-adaptive-sort
6604      anything-c-highlight-bookmark)
6605     (type . bookmark)))
6606
6607 (defun anything-c-bookmark-images-setup-alist ()
6608   "Specialized filter function for images bookmarks."
6609   (anything-c-bmkext-filter-setup-alist 'bmkext-image-file-alist-only))
6610
6611 ;; Woman Man
6612 (defvar anything-c-source-bookmark-man
6613   '((name . "Bookmark Woman&Man")
6614     (init . (lambda ()
6615               (require 'bookmark-extensions)
6616               (bookmark-maybe-load-default-file)))
6617     (candidates . anything-c-bookmark-man-setup-alist)
6618     (filtered-candidate-transformer
6619      anything-c-adaptive-sort
6620      anything-c-highlight-bookmark)
6621     (type . bookmark)))
6622
6623 (defun anything-c-bookmark-man-setup-alist ()
6624   "Specialized filter function for bookmarks w3m."
6625   (append (anything-c-bmkext-filter-setup-alist 'bmkext-man-alist-only)
6626           (anything-c-bmkext-filter-setup-alist 'bmkext-woman-alist-only)))
6627
6628 ;; Gnus
6629 (defvar anything-c-source-bookmark-gnus
6630   '((name . "Bookmark Gnus")
6631     (init . (lambda ()
6632               (require 'bookmark-extensions)
6633               (bookmark-maybe-load-default-file)))
6634     (candidates . anything-c-bookmark-gnus-setup-alist)
6635     (filtered-candidate-transformer
6636      anything-c-adaptive-sort
6637      anything-c-highlight-bookmark)
6638     (type . bookmark)))
6639
6640 (defun anything-c-bookmark-gnus-setup-alist ()
6641   "Specialized filter function for bookmarks gnus."
6642   (anything-c-bmkext-filter-setup-alist 'bmkext-gnus-alist-only))
6643
6644 ;; Info
6645 (defvar anything-c-source-bookmark-info
6646   '((name . "Bookmark Info")
6647     (init . (lambda ()
6648               (require 'bookmark-extensions)
6649               (bookmark-maybe-load-default-file)))
6650     (candidates . anything-c-bookmark-info-setup-alist)
6651     (filtered-candidate-transformer
6652      anything-c-adaptive-sort
6653      anything-c-highlight-bookmark)
6654     (type . bookmark)))
6655
6656 (defun anything-c-bookmark-info-setup-alist ()
6657   "Specialized filter function for bookmarks info."
6658   (anything-c-bmkext-filter-setup-alist 'bmkext-info-alist-only))
6659
6660 ;; Local Files&directories
6661 (defvar anything-c-source-bookmark-files&dirs
6662   '((name . "Bookmark Files&Directories")
6663     (init . (lambda ()
6664               (require 'bookmark-extensions)
6665               (bookmark-maybe-load-default-file)))
6666     (candidates . anything-c-bookmark-local-files-setup-alist)
6667     (filtered-candidate-transformer
6668      anything-c-adaptive-sort
6669      anything-c-highlight-bookmark)
6670     (type . bookmark)))
6671
6672 (defun anything-c-bookmark-local-files-setup-alist ()
6673   "Specialized filter function for bookmarks locals files."
6674   (anything-c-bmkext-filter-setup-alist 'bmkext-local-file-alist-only))
6675
6676 ;; Su Files&directories
6677 (defvar anything-c-source-bookmark-su-files&dirs
6678   '((name . "Bookmark Root-Files&Directories")
6679     (init . (lambda ()
6680               (require 'bookmark-extensions)
6681               (bookmark-maybe-load-default-file)))
6682     (candidates . anything-c-bookmark-su-files-setup-alist)
6683     (filtered-candidate-transformer
6684      anything-c-adaptive-sort
6685      anything-c-highlight-bookmark-su)
6686     (type . bookmark)))
6687
6688 (defun anything-c-bookmark-su-files-setup-alist ()
6689   "Specialized filter function for bookmarks su/sudo files."
6690   (declare (special bmkext-su-or-sudo-regexp))
6691   (loop
6692         with l = (anything-c-bmkext-filter-setup-alist 'bmkext-remote-file-alist-only)
6693         for i in l
6694         for isfile = (bookmark-get-filename i)
6695         for istramp = (and isfile (boundp 'tramp-file-name-regexp)
6696                            (save-match-data
6697                              (string-match tramp-file-name-regexp isfile)))
6698         for issu = (and istramp
6699                         (string-match bmkext-su-or-sudo-regexp isfile))
6700         if issu
6701         collect i))
6702
6703 ;; Ssh Files&directories
6704 (defvar anything-c-source-bookmark-ssh-files&dirs
6705   '((name . "Bookmark Ssh-Files&Directories")
6706     (init . (lambda ()
6707               (require 'bookmark-extensions)
6708               (bookmark-maybe-load-default-file)))
6709     (candidates . anything-c-bookmark-ssh-files-setup-alist)
6710     (filtered-candidate-transformer . anything-c-adaptive-sort)
6711     (type . bookmark)))
6712
6713 (defun anything-c-bookmark-ssh-files-setup-alist ()
6714   "Specialized filter function for bookmarks ssh files."
6715   (loop
6716         with l = (anything-c-bmkext-filter-setup-alist 'bmkext-remote-file-alist-only)
6717         for i in l
6718         for isfile = (bookmark-get-filename i)
6719         for istramp = (and isfile (boundp 'tramp-file-name-regexp)
6720                            (save-match-data
6721                              (string-match tramp-file-name-regexp isfile)))
6722         for isssh = (and istramp
6723                          (string-match "/ssh:" isfile))
6724         if isssh
6725         collect i))
6726
6727
6728 \f
6729 ;;; Firefox bookmarks
6730 ;;
6731 ;;
6732 ;; You will have to set firefox to import bookmarks in his html file bookmarks.html.
6733 ;; (only for firefox versions >=3)
6734 ;; To achieve that, open about:config in firefox and double click on this line to enable value
6735 ;; to true:
6736 ;; user_pref("browser.bookmarks.autoExportHTML", false);
6737 ;; You should have now:
6738 ;; user_pref("browser.bookmarks.autoExportHTML", true);
6739 ;; NOTE: This is also working in the same way for mozilla aka seamonkey.
6740
6741 (defvar anything-firefox-bookmark-url-regexp "\\(https\\|http\\|ftp\\|about\\|file\\)://[^ \"]*")
6742 (defvar anything-firefox-bookmarks-regexp ">\\([^><]+.[^</a>]\\)")
6743
6744 (defun anything-get-firefox-user-init-dir ()
6745   "Guess the default Firefox user directory name."
6746   (let* ((moz-dir (concat (getenv "HOME") "/.mozilla/firefox/"))
6747          (moz-user-dir
6748           (with-current-buffer (find-file-noselect (concat moz-dir "profiles.ini"))
6749             (goto-char (point-min))
6750             (prog1
6751                 (when (search-forward "Path=" nil t)
6752                   (buffer-substring-no-properties (point) (point-at-eol)))
6753               (kill-buffer)))))
6754     (file-name-as-directory (concat moz-dir moz-user-dir))))
6755
6756 (defun anything-guess-firefox-bookmark-file ()
6757   "Return the path of the Firefox bookmarks file."
6758   (concat (anything-get-firefox-user-init-dir) "bookmarks.html"))
6759
6760 (defun anything-html-bookmarks-to-alist (file url-regexp bmk-regexp)
6761   "Parse html bookmark FILE and return an alist with (title . url) as elements."
6762   (let (bookmarks-alist url title)
6763     (with-temp-buffer
6764       (insert-file-contents file)
6765       (goto-char (point-min))
6766       (while (re-search-forward "href=\\|^ *<DT><A HREF=" nil t)
6767         (forward-line 0)
6768         (when (re-search-forward url-regexp nil t)
6769           (setq url (match-string 0)))
6770         (when (re-search-forward bmk-regexp nil t)
6771           (setq title (match-string 1)))
6772         (push (cons title url) bookmarks-alist)
6773         (forward-line)))
6774     (nreverse bookmarks-alist)))
6775
6776 (defvar anything-c-firefox-bookmarks-alist nil)
6777 (defvar anything-c-source-firefox-bookmarks
6778   '((name . "Firefox Bookmarks")
6779     (init . (lambda ()
6780               (setq anything-c-firefox-bookmarks-alist
6781                     (anything-html-bookmarks-to-alist
6782                      (anything-guess-firefox-bookmark-file)
6783                      anything-firefox-bookmark-url-regexp
6784                      anything-firefox-bookmarks-regexp))))
6785     (candidates . (lambda ()
6786                     (mapcar #'car anything-c-firefox-bookmarks-alist)))
6787     (filtered-candidate-transformer
6788      anything-c-adaptive-sort
6789      anything-c-highlight-firefox-bookmarks)
6790     (action . (("Browse Url"
6791                 . (lambda (candidate)
6792                     (anything-c-browse-url
6793                      (anything-c-firefox-bookmarks-get-value candidate))))
6794                ("Copy Url"
6795                 . (lambda (elm)
6796                     (kill-new (anything-c-w3m-bookmarks-get-value elm))))))))
6797
6798
6799 (defun anything-c-firefox-bookmarks-get-value (elm)
6800   (assoc-default elm anything-c-firefox-bookmarks-alist))
6801
6802 (defun anything-c-highlight-firefox-bookmarks (bookmarks source)
6803   (loop for i in bookmarks
6804         collect (propertize
6805                  i 'face '((:foreground "YellowGreen"))
6806                  'help-echo (anything-c-firefox-bookmarks-get-value i))))
6807
6808
6809 \f
6810 ;;; W3m bookmark - anything interface.
6811 ;;
6812 ;;
6813 ;; Some users have the emacs-w3m library in load-path
6814 ;; without having the w3m executable :-;
6815 ;; So check if w3m program is present before trying to load
6816 ;; emacs-w3m.
6817 (eval-when-compile
6818   (when (executable-find "w3m")
6819     (require 'w3m-bookmark nil t)))
6820
6821 (defvar w3m-bookmark-file "~/.w3m/bookmark.html")
6822 (defvar anything-w3m-bookmarks-regexp ">\\([^><]+.[^</a>]\\)")
6823 (defvar anything-w3m-bookmark-url-regexp "\\(https\\|http\\|ftp\\|file\\)://[^>]*")
6824 (defvar anything-c-w3m-bookmarks-alist nil)
6825 (defvar anything-c-source-w3m-bookmarks
6826   '((name . "W3m Bookmarks")
6827     (init . (lambda ()
6828               (setq anything-c-w3m-bookmarks-alist
6829                     (anything-html-bookmarks-to-alist
6830                      w3m-bookmark-file
6831                      anything-w3m-bookmark-url-regexp
6832                      anything-w3m-bookmarks-regexp))))
6833     (candidates . (lambda ()
6834                     (mapcar #'car anything-c-w3m-bookmarks-alist)))
6835     (filtered-candidate-transformer
6836      anything-c-adaptive-sort
6837      anything-c-highlight-w3m-bookmarks)
6838     (action . (("Browse Url"
6839                 . (lambda (candidate)
6840                     (anything-c-w3m-browse-bookmark candidate)))
6841                ("Copy Url"
6842                 . (lambda (elm)
6843                     (kill-new (anything-c-w3m-bookmarks-get-value elm))))
6844                ("Browse Url Externally"
6845                 . (lambda (candidate)
6846                     (anything-c-w3m-browse-bookmark candidate t)))
6847                ("Delete Bookmark"
6848                 . (lambda (candidate)
6849                     (anything-c-w3m-delete-bookmark candidate)))
6850                ("Rename Bookmark"
6851                 . (lambda (candidate)
6852                     (anything-c-w3m-rename-bookmark candidate)))))
6853     (persistent-action . (lambda (candidate)
6854                            (if current-prefix-arg
6855                                (anything-c-w3m-browse-bookmark candidate t)
6856                                (anything-c-w3m-browse-bookmark candidate nil t))))
6857     (persistent-help . "Open URL with emacs-w3m in new tab / \
6858 C-u \\[anything-execute-persistent-action]: Open URL with Firefox"))
6859   "Needs w3m and emacs-w3m.
6860
6861 http://w3m.sourceforge.net/
6862 http://emacs-w3m.namazu.org/")
6863
6864
6865 (defun anything-c-w3m-bookmarks-get-value (elm)
6866   (replace-regexp-in-string
6867    "\"" "" (cdr (assoc elm anything-c-w3m-bookmarks-alist))))
6868
6869 (defun anything-c-w3m-browse-bookmark (elm &optional use-external new-tab)
6870   (let* ((fn  (if use-external 'anything-c-browse-url 'w3m-browse-url))
6871          (arg (and (eq fn 'w3m-browse-url) new-tab)))
6872     (funcall fn (anything-c-w3m-bookmarks-get-value elm) arg)))
6873
6874 (defun anything-c-highlight-w3m-bookmarks (bookmarks source)
6875   (loop for i in bookmarks
6876         collect (propertize
6877                  i 'face 'anything-w3m-bookmarks-face
6878                  'help-echo (anything-c-w3m-bookmarks-get-value i))))
6879
6880
6881 (defun anything-c-w3m-delete-bookmark (elm)
6882   "Delete w3m bookmark from `w3m-bookmark-file'."
6883   (with-current-buffer
6884       (find-file-literally w3m-bookmark-file)
6885     (goto-char (point-min))
6886     (when (re-search-forward elm nil t)
6887       (beginning-of-line)
6888       (delete-region (point)
6889                      (line-end-position))
6890       (delete-blank-lines))
6891     (save-buffer)
6892     (kill-buffer)))
6893
6894 (defun anything-c-w3m-rename-bookmark (elm)
6895   "Rename w3m bookmark in `w3m-bookmark-file'."
6896   (let* ((old-title (replace-regexp-in-string ">" "" elm))
6897          (new-title (read-string "NewTitle: " old-title)))
6898     (with-current-buffer
6899         (find-file-literally w3m-bookmark-file)
6900       (goto-char (point-min))
6901       (when (re-search-forward (concat elm "<") nil t)
6902         (goto-char (1- (point)))
6903         (delete-char (- (length old-title)))
6904         (insert new-title))
6905       (save-buffer)
6906       (kill-buffer))))
6907
6908 \f
6909 ;;;; <Library>
6910 ;;; Elisp library scan
6911 ;;
6912 ;;
6913 (defvar anything-c-source-elisp-library-scan
6914   '((name . "Elisp libraries (Scan)")
6915     (init . (anything-c-elisp-library-scan-init))
6916     (candidates-in-buffer)
6917     (action ("Find library"
6918              . (lambda (candidate) (find-file (find-library-name candidate))))
6919      ("Find library other window"
6920       . (lambda (candidate)
6921           (find-file-other-window (find-library-name candidate))))
6922      ("Load library"
6923       . (lambda (candidate) (load-library candidate))))))
6924
6925 (defun anything-c-elisp-library-scan-init ()
6926   "Init anything buffer status."
6927   (let ((anything-buffer (anything-candidate-buffer 'global))
6928         (library-list (anything-c-elisp-library-scan-list)))
6929     (with-current-buffer anything-buffer
6930       (dolist (library library-list)
6931         (insert (format "%s\n" library))))))
6932
6933 (defun anything-c-elisp-library-scan-list (&optional dirs string)
6934   "Do completion for file names passed to `locate-file'.
6935 DIRS is directory to search path.
6936 STRING is string to match."
6937   ;; Use `load-path' as path when ignore `dirs'.
6938   (or dirs (setq dirs load-path))
6939   ;; Init with blank when ignore `string'.
6940   (or string (setq string ""))
6941   ;; Get library list.
6942   (let ((string-dir (file-name-directory string))
6943         ;; File regexp that suffix match `load-file-rep-suffixes'.
6944         (match-regexp (format "^.*\\.el%s$" (regexp-opt load-file-rep-suffixes)))
6945         name
6946         names)
6947     (dolist (dir dirs)
6948       (unless dir
6949         (setq dir default-directory))
6950       (if string-dir
6951           (setq dir (expand-file-name string-dir dir)))
6952       (when (file-directory-p dir)
6953         (dolist (file (file-name-all-completions
6954                        (file-name-nondirectory string) dir))
6955           ;; Suffixes match `load-file-rep-suffixes'.
6956           (setq name (if string-dir (concat string-dir file) file))
6957           (if (string-match match-regexp name)
6958               (add-to-list 'names name)))))
6959     names))
6960
6961 \f
6962 ;;;; <Programming>
6963 ;;
6964 ;;
6965
6966 ;;; Imenu
6967 ;;
6968 ;;
6969 (defvar anything-c-imenu-delimiter " / ")
6970
6971 (defvar anything-c-imenu-index-filter nil)
6972 (make-variable-buffer-local 'anything-c-imenu-index-filter)
6973
6974 (defvar anything-c-cached-imenu-alist nil)
6975 (make-variable-buffer-local 'anything-c-cached-imenu-alist)
6976
6977 (defvar anything-c-cached-imenu-candidates nil)
6978 (make-variable-buffer-local 'anything-c-cached-imenu-candidates)
6979
6980 (defvar anything-c-cached-imenu-tick nil)
6981 (make-variable-buffer-local 'anything-c-cached-imenu-tick)
6982
6983 (eval-when-compile (require 'imenu))
6984 (setq imenu-auto-rescan t)
6985
6986 (defun anything-imenu-create-candidates (entry)
6987   "Create candidates with ENTRY."
6988   (if (listp (cdr entry))
6989       (mapcan
6990        (lambda (sub)
6991          (if (consp (cdr sub))
6992              (mapcar
6993               (lambda (subentry)
6994                 (concat (car entry) anything-c-imenu-delimiter subentry))
6995               (anything-imenu-create-candidates sub))
6996              (list (concat (car entry) anything-c-imenu-delimiter (car sub)))))
6997        (cdr entry))
6998       (list entry)))
6999
7000 (defvar anything-c-source-imenu
7001   '((name . "Imenu")
7002     (init . (lambda () (require 'imenu)))
7003     (candidates . anything-c-imenu-candidates)
7004     (persistent-action . (lambda (elm)
7005                            (anything-c-imenu-default-action elm)
7006                            (unless (fboundp 'semantic-imenu-tag-overlay)
7007                              (anything-match-line-color-current-line))))
7008     (persistent-help . "Show this entry")
7009     (action . anything-c-imenu-default-action))
7010   "See (info \"(emacs)Imenu\")")
7011
7012
7013 (defun anything-c-imenu-candidates ()
7014   (with-anything-current-buffer
7015     (let ((tick (buffer-modified-tick)))
7016       (if (eq anything-c-cached-imenu-tick tick)
7017           anything-c-cached-imenu-candidates
7018           (setq imenu--index-alist nil)
7019           (setq anything-c-cached-imenu-tick tick
7020                 anything-c-cached-imenu-candidates
7021                 (ignore-errors
7022                   (mapcan
7023                    'anything-imenu-create-candidates
7024                    (setq anything-c-cached-imenu-alist
7025                          (let ((index (imenu--make-index-alist)))
7026                            (if anything-c-imenu-index-filter
7027                                (funcall anything-c-imenu-index-filter index)
7028                                index))))))
7029           (setq anything-c-cached-imenu-candidates
7030                 (mapcar #'(lambda (x)
7031                             (if (stringp x)
7032                                 x
7033                                 (car x)))
7034                         anything-c-cached-imenu-candidates))))))
7035
7036 (setq imenu-default-goto-function 'imenu-default-goto-function)
7037 (defun anything-c-imenu-default-action (elm)
7038   "The default action for `anything-c-source-imenu'."
7039   (let ((path (split-string elm anything-c-imenu-delimiter))
7040         (alist anything-c-cached-imenu-alist))
7041     (dolist (elm path)
7042       (setq alist (assoc elm alist)))
7043     (imenu alist)))
7044
7045
7046 \f
7047 ;;; Ctags
7048 ;;
7049 ;;
7050 (defvar anything-c-ctags-modes
7051   '( c-mode c++-mode awk-mode csharp-mode java-mode javascript-mode lua-mode
7052     makefile-mode pascal-mode perl-mode cperl-mode php-mode python-mode
7053     scheme-mode sh-mode slang-mode sql-mode tcl-mode ))
7054
7055 (defun anything-c-source-ctags-init ()
7056   (when (and buffer-file-name
7057              (memq major-mode anything-c-ctags-modes)
7058              (anything-current-buffer-is-modified))
7059     (with-current-buffer (anything-candidate-buffer 'local)
7060       (call-process-shell-command
7061        (if (string-match "\\.el\\.gz$" anything-buffer-file-name)
7062            (format "ctags -e -u -f- --language-force=lisp --fields=n =(zcat %s) "
7063                    anything-buffer-file-name)
7064            (format "ctags -e -u -f- --fields=n %s " anything-buffer-file-name))
7065        nil (current-buffer))
7066       (goto-char (point-min))
7067       (forward-line 2)
7068       (delete-region (point-min) (point))
7069       (loop while (and (not (eobp)) (search-forward "\001" (point-at-eol) t))
7070             for lineno-start = (point)
7071             for lineno = (buffer-substring
7072                           lineno-start
7073                           (1- (search-forward "," (point-at-eol) t)))
7074             do
7075             (beginning-of-line)
7076             (insert (format "%5s:" lineno))
7077             (search-forward "\177" (point-at-eol) t)
7078             (delete-region (1- (point)) (point-at-eol))
7079             (forward-line 1)))))
7080
7081 (defvar anything-c-source-ctags
7082   '((name . "Exuberant ctags")
7083     (init . anything-c-source-ctags-init)
7084     (candidates-in-buffer)
7085     (adjust)
7086     (type . line))
7087   "Needs Exuberant Ctags.
7088
7089 http://ctags.sourceforge.net/")
7090
7091 \f
7092 ;;; Etags
7093 ;;
7094 ;;
7095 ;; anything-etags.el is deprecated, if this file is found,
7096 ;; warn user at compile time.
7097 (eval-when-compile
7098   (when (locate-library "anything-etags.el")
7099     (display-warning
7100      '(anything-config)
7101      "You are using obsolete library `anything-etags.el' and should remove it."
7102      :warning)))
7103
7104 (defvar anything-c-etags-tag-file-dir nil
7105   "Etags file directory.")
7106 (defvar anything-c-etags-mtime-alist nil
7107   "Store the last modification time of etags files here.")
7108 (defvar anything-c-etags-cache (make-hash-table :test 'equal)
7109   "Cache content of etags files used here for faster access.")
7110
7111 (defun anything-c-etags-get-tag-file (&optional directory)
7112   "Return the path of etags file if found."
7113   ;; Get tag file from `default-directory' or upper directory.
7114   (let ((current-dir (anything-c-etags-find-tag-file-directory
7115                       (or directory default-directory))))
7116     ;; Return nil if not find tag file.
7117     (when current-dir
7118       ;; Set tag file directory.
7119       (setq anything-c-etags-tag-file-dir current-dir)
7120       (expand-file-name anything-c-etags-tag-file-name current-dir))))
7121
7122 (defun anything-c-etags-find-tag-file-directory (current-dir)
7123   "Try to find the directory containing tag file.
7124 If not found in CURRENT-DIR search in upper directory."
7125   (flet ((file-exists? (dir)
7126            (let ((tag-path (expand-file-name
7127                             anything-c-etags-tag-file-name dir)))
7128              (and (stringp tag-path)
7129                   (file-regular-p tag-path)
7130                   (file-readable-p tag-path)))))
7131     (loop with count = 0
7132           until (file-exists? current-dir)
7133           ;; Return nil if outside the value of
7134           ;; `anything-c-etags-tag-file-search-limit'.
7135           if (= count anything-c-etags-tag-file-search-limit)
7136           do (return nil)
7137           ;; Or search upper directories.
7138           else
7139           do (incf count)
7140           (setq current-dir (expand-file-name (concat current-dir "../")))
7141           finally return current-dir)))
7142
7143 (defun anything-c-source-etags-header-name (x)
7144   "Create header name for this anything etags session."
7145   (concat "Etags in "
7146           (with-anything-current-buffer
7147             (anything-c-etags-get-tag-file))))
7148
7149 (defmacro anything-c-etags-create-buffer (file)
7150   "Create the `anything-buffer' based on contents of etags tag FILE."
7151   `(let* ((tag-fname ,file)
7152           max
7153           (split (with-current-buffer (find-file-noselect tag-fname)
7154                    (prog1
7155                        (split-string (buffer-string) "\n" 'omit-nulls)
7156                      (setq max (line-number-at-pos (point-max)))
7157                      (kill-buffer))))
7158           (progress-reporter (make-progress-reporter "Loading tag file..." 0 max)))
7159      (loop
7160            with fname
7161            with cand
7162            for i in split for count from 0
7163            for elm = (unless (string-match "^\x0c" i)
7164                        (anything-aif (string-match "\177" i)
7165                            (substring i 0 it)
7166                          i))
7167            do (cond ((and elm (string-match "^\\(.+\\),[0-9]+" elm))
7168                      (setq fname (match-string 1 elm)))
7169                     (elm (setq cand (concat fname ": " elm)))
7170                     (t (setq cand nil)))
7171            when cand do (progn
7172                           (insert (concat cand "\n"))
7173                           (progress-reporter-update progress-reporter count)))))
7174
7175 (defun anything-c-etags-init ()
7176   "Feed `anything-buffer' using `anything-c-etags-cache' or tag file.
7177 If no entry in cache, create one."
7178   (let ((tagfile (anything-c-etags-get-tag-file)))
7179     (when tagfile
7180       (with-current-buffer (anything-candidate-buffer 'global)
7181         (anything-aif (gethash tagfile anything-c-etags-cache)
7182             ;; An entry is present in cache, insert it.
7183             (insert it)
7184           ;; No entry, create a new buffer using content of tag file (slower).
7185           (anything-c-etags-create-buffer tagfile)
7186           ;; Store content of buffer in cache.
7187           (puthash tagfile (buffer-string) anything-c-etags-cache)
7188           ;; Store or set the last modification of tag file.
7189           (anything-aif (assoc tagfile anything-c-etags-mtime-alist)
7190               ;; If an entry exists modify it.
7191               (setcdr it (anything-c-etags-mtime tagfile))
7192             ;; No entry create a new one.
7193             (add-to-list 'anything-c-etags-mtime-alist
7194                          (cons tagfile (anything-c-etags-mtime tagfile)))))))))
7195
7196 (defvar anything-c-source-etags-select
7197   '((name . "Etags")
7198     (header-name . anything-c-source-etags-header-name)
7199     (init . anything-c-etags-init)
7200     (candidates-in-buffer)
7201     (search . (anything-c-etags-search-fn))
7202     (mode-line . anything-etags-mode-line-string)
7203     (action . anything-c-etags-default-action)
7204     (persistent-action . (lambda (candidate)
7205                            (anything-c-etags-default-action candidate)
7206                            (anything-match-line-color-current-line))))
7207   "Anything source for Etags.")
7208
7209 (defun anything-c-etags-search-fn (pattern)
7210   "Search function for `anything-c-source-etags-select'."
7211   (re-search-forward
7212    (if anything-c-etags-use-regexp-search
7213        (format anything-c-etags-search-regexp pattern)
7214        pattern)
7215    nil t))
7216
7217 (defun anything-c-etags-default-action (candidate)
7218   "Anything default action to jump to an etags entry."
7219   (let* ((split (split-string candidate ": "))
7220          (fname (expand-file-name
7221                  (car split) anything-c-etags-tag-file-dir))
7222          (elm   (cadr split)))
7223     (find-file fname)
7224     (goto-char (point-min))
7225     (search-forward elm nil t)
7226     (goto-char (match-beginning 0))))
7227
7228 (defun anything-c-etags-mtime (file)
7229   "Last modification time of etags tag FILE."
7230   (cadr (nth 5 (file-attributes file))))
7231
7232 (defun anything-c-etags-file-modified-p (file)
7233   "Check if tag FILE have been modified in this session.
7234 If FILE is nil return nil."
7235   (let ((last-modif (and file
7236                          (assoc-default file anything-c-etags-mtime-alist))))
7237     (and last-modif
7238          (/= last-modif (anything-c-etags-mtime file)))))
7239
7240
7241 \f
7242 ;;; Semantic
7243 ;;
7244 ;;
7245 (defvar anything-semantic-candidates nil)
7246
7247 (defun anything-semantic-construct-candidates (tags depth)
7248   (when (require 'semantic nil t)
7249     (apply
7250      'append
7251      (mapcar
7252       (lambda (tag)
7253         (if (listp tag)
7254             (let ((type (semantic-tag-type tag))
7255                   (class (semantic-tag-class tag)))
7256               (if (or (and (stringp type)
7257                            (or (string= type "class")
7258                                (string= type "namespace")))
7259                       (eq class 'function)
7260                       (eq class 'variable))
7261                   (cons (cons (concat (make-string (* depth 2) ?\s)
7262                                       (semantic-format-tag-summarize tag nil t))
7263                               tag)
7264                         (anything-semantic-construct-candidates
7265                          (semantic-tag-components tag) (1+ depth)))))))
7266       tags))))
7267
7268 (defun anything-semantic-default-action (candidate)
7269   (let ((tag (cdr (assoc candidate anything-semantic-candidates))))
7270     (semantic-go-to-tag tag)))
7271
7272 (defvar anything-c-source-semantic
7273   '((name . "Semantic Tags")
7274     (init . (lambda ()
7275               (setq anything-semantic-candidates
7276                     (ignore-errors (anything-semantic-construct-candidates
7277                                     (semantic-fetch-tags) 0)))))
7278     (candidates . (lambda ()
7279                     (if anything-semantic-candidates
7280                         (mapcar 'car anything-semantic-candidates))))
7281     (persistent-action . (lambda (elm)
7282                            (anything-semantic-default-action elm)
7283                            (anything-match-line-color-current-line)))
7284     (persistent-help . "Show this entry")
7285     (action . anything-semantic-default-action)
7286     "Needs semantic in CEDET.
7287
7288 http://cedet.sourceforge.net/semantic.shtml
7289 http://cedet.sourceforge.net/"))
7290
7291
7292 \f
7293 ;;; Anything interface of `simple-call-tree.el'.
7294 ;;
7295 ;; <http://www.emacswiki.org/cgi-bin/wiki/download/simple-call-tree.el>
7296 ;;
7297 ;; Function is called by
7298 (defvar anything-c-source-simple-call-tree-functions-callers
7299   '((name . "Function is called by")
7300     (init . anything-c-simple-call-tree-functions-callers-init)
7301     (multiline)
7302     (candidates . anything-c-simple-call-tree-candidates)
7303     (persistent-action . anything-c-simple-call-tree-persistent-action)
7304     (persistent-help . "Show function definitions by rotation")
7305     (action ("Find definition selected by persistent-action" .
7306              anything-c-simple-call-tree-find-definition)))
7307   "Needs simple-call-tree.el.
7308 http://www.emacswiki.org/cgi-bin/wiki/download/simple-call-tree.el")
7309
7310 (defvar anything-c-simple-call-tree-tick nil)
7311 (make-variable-buffer-local 'anything-c-simple-call-tree-tick)
7312 (defun anything-c-simple-call-tree-analyze-maybe ()
7313   (unless (eq (buffer-chars-modified-tick) anything-c-simple-call-tree-tick)
7314     (simple-call-tree-analyze)
7315     (setq anything-c-simple-call-tree-tick (buffer-chars-modified-tick))))
7316
7317 (defun anything-c-simple-call-tree-init-base (function message)
7318   (require 'simple-call-tree)
7319   (with-no-warnings
7320     (when (anything-current-buffer-is-modified)
7321       (anything-c-simple-call-tree-analyze-maybe)
7322       (let ((list (funcall function simple-call-tree-alist)))
7323         (with-current-buffer (anything-candidate-buffer 'local)
7324           (dolist (entry list)
7325             (let ((funcs (concat "  " (mapconcat #'identity (cdr entry) "\n  "))))
7326               (insert (car entry) message
7327                       (if (string= funcs "  ")
7328                           "  no functions."
7329                           funcs)
7330                       "\n\n"))))))))
7331
7332 (defun anything-c-simple-call-tree-functions-callers-init ()
7333   (anything-c-simple-call-tree-init-base 'simple-call-tree-invert
7334                                          " is called by\n"))
7335
7336 (defun anything-c-simple-call-tree-candidates ()
7337   (with-current-buffer (anything-candidate-buffer)
7338     (split-string (buffer-string) "\n\n")))
7339
7340 (defvar anything-c-simple-call-tree-related-functions nil)
7341 (defvar anything-c-simple-call-tree-function-index 0)
7342 (defun anything-c-simple-call-tree-persistent-action (candidate)
7343   (unless (eq last-command 'anything-execute-persistent-action)
7344     (setq anything-c-simple-call-tree-related-functions
7345           (delete "no functions."
7346                   (split-string
7347                    (replace-regexp-in-string "  \\| is called by\\| calls "
7348                                              "" candidate)
7349                    "\n")))
7350     (setq anything-c-simple-call-tree-function-index -1))
7351   (incf anything-c-simple-call-tree-function-index)
7352   (anything-c-simple-call-tree-find-definition candidate))
7353
7354 (defun anything-c-simple-call-tree-find-definition (candidate)
7355   (find-function
7356    (intern
7357     (nth (mod anything-c-simple-call-tree-function-index
7358               (length anything-c-simple-call-tree-related-functions))
7359          anything-c-simple-call-tree-related-functions))))
7360
7361
7362 ;;; Function calls
7363 (defvar anything-c-source-simple-call-tree-callers-functions
7364   '((name . "Function calls")
7365     (init . anything-c-simple-call-tree-callers-functions-init)
7366     (multiline)
7367     (candidates . anything-c-simple-call-tree-candidates)
7368     (persistent-action . anything-c-simple-call-tree-persistent-action)
7369     (persistent-help . "Show function definitions by rotation")
7370     (action ("Find definition selected by persistent-action" .
7371              anything-c-simple-call-tree-find-definition)))
7372   "Needs simple-call-tree.el.
7373 http://www.emacswiki.org/cgi-bin/wiki/download/simple-call-tree.el")
7374
7375 (defun anything-c-simple-call-tree-callers-functions-init ()
7376   (anything-c-simple-call-tree-init-base 'identity " calls \n"))
7377
7378
7379
7380 \f
7381 ;;; Anything UI of auto-document.el
7382 ;;
7383 ;; <http://www.emacswiki.org/cgi-bin/wiki/download/auto-document.el>
7384 ;;
7385 ;; Commands/Options with doc
7386 (defvar anything-c-auto-document-data nil)
7387 (make-variable-buffer-local 'anything-c-auto-document-data)
7388 (defvar anything-c-source-commands-and-options-in-file
7389   '((name . "Commands/Options in file")
7390     (header-name
7391      . (lambda (x) (format "Commands/Options in %s"
7392                            (buffer-local-value 'buffer-file-name
7393                                                anything-current-buffer))))
7394     (candidates . anything-command-and-options-candidates)
7395     (multiline)
7396     (action . imenu))
7397   "List Commands and Options with doc. It needs auto-document.el .
7398
7399 http://www.emacswiki.org/cgi-bin/wiki/download/auto-document.el")
7400
7401 (eval-when-compile (require 'auto-document nil t))
7402 (defun anything-command-and-options-candidates ()
7403   (with-anything-current-buffer
7404     (when (and (require 'auto-document nil t)
7405                (eq major-mode 'emacs-lisp-mode)
7406                (or (anything-current-buffer-is-modified)
7407                    (not anything-c-auto-document-data)))
7408       (or imenu--index-alist (imenu--make-index-alist t))
7409       (setq anything-c-auto-document-data
7410             (destructuring-bind (commands options)
7411                 (adoc-construct anything-current-buffer)
7412               (append
7413                (loop for (command . doc) in commands
7414                      for cmdname = (symbol-name command)
7415                      collect
7416                      (cons
7417                       (format "Command: %s\n %s"
7418                               (propertize cmdname 'face font-lock-function-name-face)
7419                               (adoc-first-line doc))
7420                       (assoc cmdname imenu--index-alist)))
7421                (loop with var-alist = (cdr (assoc "Variables" imenu--index-alist))
7422                      for (option doc default) in options
7423                      for optname = (symbol-name option)
7424                      collect
7425                      (cons
7426                       (format "Option: %s\n %s\n default = %s"
7427                               (propertize optname 'face font-lock-variable-name-face)
7428                               (adoc-first-line doc)
7429                               (adoc-prin1-to-string default))
7430                       (assoc optname
7431                              var-alist)))))))
7432     anything-c-auto-document-data))
7433
7434
7435 \f
7436 ;;;; <Color and Face>
7437 ;;
7438
7439 ;;; Customize Face
7440 ;;
7441 ;;
7442 (defvar anything-c-source-customize-face
7443   '((name . "Customize Face")
7444     (init . (lambda ()
7445               (unless (anything-candidate-buffer)
7446                 (save-selected-window
7447                   (list-faces-display))
7448                 (anything-candidate-buffer (get-buffer "*Faces*")))))
7449     (candidates-in-buffer)
7450     (get-line . buffer-substring)
7451     (action . (lambda (line)
7452                 (customize-face (intern (car (split-string line))))))
7453     (requires-pattern . 3))
7454   "See (info \"(emacs)Faces\")")
7455
7456 ;;; Colors browser
7457 ;;
7458 ;;
7459 (defvar anything-c-source-colors
7460   '((name . "Colors")
7461     (init . (lambda () (unless (anything-candidate-buffer)
7462                          (save-selected-window
7463                            (list-colors-display))
7464                          (anything-candidate-buffer (get-buffer "*Colors*")))))
7465     (candidates-in-buffer)
7466     (get-line . buffer-substring)
7467     (action
7468      ("Copy Name" . (lambda (candidate)
7469                       (kill-new (anything-c-colors-get-name candidate))))
7470      ("Copy RGB" . (lambda (candidate)
7471                      (kill-new (anything-c-colors-get-rgb candidate))))
7472      ("Insert Name" . (lambda (candidate)
7473                         (with-anything-current-buffer
7474                           (insert (anything-c-colors-get-name candidate)))))
7475      ("Insert RGB" . (lambda (candidate)
7476                        (with-anything-current-buffer
7477                          (insert (anything-c-colors-get-rgb candidate))))))))
7478
7479 (defun anything-c-colors-get-name (candidate)
7480   "Get color name."
7481   (replace-regexp-in-string
7482    " " ""
7483    (with-temp-buffer
7484      (insert (capitalize candidate))
7485      (goto-char (point-min))
7486      (search-forward-regexp "\\s-\\{2,\\}")
7487      (delete-region (point) (point-max))
7488      (buffer-string))))
7489
7490 (defun anything-c-colors-get-rgb (candidate)
7491   "Get color RGB."
7492   (replace-regexp-in-string
7493    " " ""
7494    (with-temp-buffer
7495      (insert (capitalize candidate))
7496      (goto-char (point-max))
7497      (search-backward-regexp "\\s-\\{2,\\}")
7498      (delete-region (point) (point-min))
7499      (buffer-string))))
7500
7501 \f
7502 ;;;; <Search Engine>
7503 ;;; Tracker desktop search
7504 (defvar anything-c-source-tracker-search
7505   '((name . "Tracker Search")
7506     (candidates . (lambda ()
7507                     (start-process "tracker-search-process" nil
7508                                    "tracker-search"
7509                                    anything-pattern)))
7510     (type . file)
7511     (requires-pattern . 3)
7512     (delayed))
7513   "Source for retrieving files matching the current input pattern
7514 with the tracker desktop search.")
7515
7516 ;;; Spotlight (MacOS X desktop search)
7517 (defvar anything-c-source-mac-spotlight
7518   '((name . "mdfind")
7519     (candidates
7520      . (lambda () (start-process "mdfind-process" nil "mdfind" anything-pattern)))
7521     (type . file)
7522     (requires-pattern . 3)
7523     (delayed))
7524   "Source for retrieving files via Spotlight's command line
7525 utility mdfind.")
7526
7527 ;;; Picklist
7528 (defvar anything-c-source-picklist
7529   '((name . "Picklist")
7530     (candidates . (lambda () (mapcar 'car picklist-list)))
7531     (type . file)))
7532
7533
7534 \f
7535 ;;; Kill ring
7536 ;;
7537 ;;
7538 (defvar anything-c-source-kill-ring
7539   `((name . "Kill Ring")
7540     (init . (lambda () (anything-attrset 'last-command last-command)))
7541     (candidates . anything-c-kill-ring-candidates)
7542     (filtered-candidate-transformer anything-c-kill-ring-transformer)
7543     (action . anything-c-kill-ring-action)
7544     (keymap . ,anything-kill-ring-map)
7545     (last-command)
7546     (migemo)
7547     (multiline))
7548   "Source for browse and insert contents of kill-ring.")
7549
7550 (defun anything-c-kill-ring-candidates ()
7551   (loop for kill in (anything-fast-remove-dups kill-ring :test 'equal)
7552         unless (or (< (length kill) anything-kill-ring-threshold)
7553                    (string-match "^[\\s\\t]+$" kill))
7554         collect kill))
7555
7556 (defun anything-c-kill-ring-transformer (candidates source)
7557   "Display only the `anything-c-kill-ring-max-lines-number' lines of candidate."
7558   (loop for i in candidates
7559         for nlines = (with-temp-buffer (insert i) (count-lines (point-min) (point-max)))
7560         if (and anything-c-kill-ring-max-lines-number
7561                 (> nlines anything-c-kill-ring-max-lines-number))
7562         collect (cons
7563                  (with-temp-buffer
7564                    (insert i)
7565                    (goto-char (point-min))
7566                    (concat
7567                     (buffer-substring
7568                      (point-min)
7569                      (save-excursion
7570                        (forward-line anything-c-kill-ring-max-lines-number)
7571                        (point)))
7572                     "[...]")) i)
7573         else collect i))
7574
7575 (defun anything-c-kill-ring-action (str)
7576   "Insert STR in `kill-ring' and set STR to the head.
7577 If this action is executed just after `yank',
7578 replace with STR as yanked string."
7579   (setq kill-ring (delete str kill-ring))
7580   (if (not (eq (anything-attr 'last-command) 'yank))
7581       (insert-for-yank str)
7582       ;; from `yank-pop'
7583       (let ((inhibit-read-only t)
7584             (before (< (point) (mark t))))
7585         (if before
7586             (funcall (or yank-undo-function 'delete-region) (point) (mark t))
7587             (funcall (or yank-undo-function 'delete-region) (mark t) (point)))
7588         (setq yank-undo-function nil)
7589         (set-marker (mark-marker) (point) (current-buffer))
7590         (insert-for-yank str)
7591         ;; Set the window start back where it was in the yank command,
7592         ;; if possible.
7593         (set-window-start (selected-window) yank-window-start t)
7594         (if before
7595             ;; This is like exchange-point-and-mark, but doesn't activate the mark.
7596             ;; It is cleaner to avoid activation, even though the command
7597             ;; loop would deactivate the mark because we inserted text.
7598             (goto-char (prog1 (mark t)
7599                          (set-marker (mark-marker) (point) (current-buffer)))))))
7600   (kill-new str))
7601
7602
7603 \f
7604 ;;;; <Mark ring>
7605 ;; DO NOT include these sources in `anything-sources' use
7606 ;; the commands `anything-mark-ring', `anything-global-mark-ring' or
7607 ;; `anything-all-mark-rings' instead.
7608
7609 (defun anything-c-source-mark-ring-candidates ()
7610   (flet ((get-marks (pos)
7611            (save-excursion
7612              (goto-char pos)
7613              (beginning-of-line)
7614              (let ((line  (car (split-string (thing-at-point 'line) "[\n\r]"))))
7615                (when (string= "" line)
7616                  (setq line  "<EMPTY LINE>"))
7617                (format "%7d: %s" (line-number-at-pos) line)))))
7618     (with-anything-current-buffer
7619       (loop
7620             with marks = (if (mark) (cons (mark-marker) mark-ring) mark-ring)
7621             with recip = nil
7622             for i in marks
7623             for m = (get-marks i)
7624             unless (member m recip)
7625             collect m into recip
7626             finally return recip))))
7627
7628 (defvar anything-mark-ring-cache nil)
7629 (defvar anything-c-source-mark-ring
7630   '((name . "mark-ring")
7631     (init . (lambda ()
7632               (setq anything-mark-ring-cache
7633                     (ignore-errors (anything-c-source-mark-ring-candidates)))))
7634     (candidates . (lambda ()
7635                     (anything-aif anything-mark-ring-cache
7636                         it)))
7637     (action . (("Goto line"
7638                 . (lambda (candidate)
7639                     (anything-goto-line (string-to-number candidate))))))
7640     (persistent-action . (lambda (candidate)
7641                            (anything-goto-line (string-to-number candidate))
7642                            (anything-match-line-color-current-line)))
7643     (persistent-help . "Show this line")))
7644
7645
7646 ;;; Global-mark-ring
7647 (defvar anything-c-source-global-mark-ring
7648   '((name . "global-mark-ring")
7649     (candidates . anything-c-source-global-mark-ring-candidates)
7650     (action . (("Goto line"
7651                 . (lambda (candidate)
7652                     (let ((items (split-string candidate ":")))
7653                       (anything-c-switch-to-buffer (second items))
7654                       (anything-goto-line (string-to-number (car items))))))))
7655     (persistent-action . (lambda (candidate)
7656                            (let ((items (split-string candidate ":")))
7657                              (anything-c-switch-to-buffer (second items))
7658                              (anything-goto-line (string-to-number (car items)))
7659                              (anything-match-line-color-current-line))))
7660     (persistent-help . "Show this line")))
7661
7662 (defun anything-c-source-global-mark-ring-candidates ()
7663   (flet ((buf-fn (m)
7664            (with-current-buffer (marker-buffer m)
7665              (goto-char m)
7666              (beginning-of-line)
7667              (let (line)
7668                (if (string= "" line)
7669                    (setq line  "<EMPTY LINE>")
7670                    (setq line (car (split-string (thing-at-point 'line)
7671                                                  "[\n\r]"))))
7672                (format "%7d:%s:    %s"
7673                        (line-number-at-pos) (marker-buffer m) line)))))
7674     (loop
7675           with marks = global-mark-ring
7676           with recip = nil
7677           for i in marks
7678           for gm = (unless (or (string-match
7679                                 "^ " (format "%s" (marker-buffer i)))
7680                                (null (marker-buffer i)))
7681                      (buf-fn i))
7682           when (and gm (not (member gm recip)))
7683           collect gm into recip
7684           finally return recip)))
7685
7686
7687 \f
7688 ;;;; <Register>
7689 ;;; Insert from register
7690 (defvar anything-c-source-register
7691   '((name . "Registers")
7692     (candidates . anything-c-register-candidates)
7693     (action-transformer . anything-c-register-action-transformer)
7694     (multiline)
7695     (action))
7696   "See (info \"(emacs)Registers\")")
7697
7698 (defun anything-c-register-candidates ()
7699   "Collecting register contents and appropriate commands."
7700   (loop for (char . val) in register-alist
7701         for key    = (single-key-description char)
7702         for string-actions =
7703         (cond
7704           ((numberp val)
7705            (list (int-to-string val)
7706                  'insert-register
7707                  'increment-register))
7708           ((markerp val)
7709            (let ((buf (marker-buffer val)))
7710              (if (null buf)
7711                  (list "a marker in no buffer")
7712                  (list (concat
7713                         "a buffer position:"
7714                         (buffer-name buf)
7715                         ", position "
7716                         (int-to-string (marker-position val)))
7717                        'jump-to-register
7718                        'insert-register))))
7719           ((and (consp val) (window-configuration-p (car val)))
7720            (list "window configuration."
7721                  'jump-to-register))
7722           ((and (consp val) (frame-configuration-p (car val)))
7723            (list "frame configuration."
7724                  'jump-to-register))
7725           ((and (consp val) (eq (car val) 'file))
7726            (list (concat "file:"
7727                          (prin1-to-string (cdr val))
7728                          ".")
7729                  'jump-to-register))
7730           ((and (consp val) (eq (car val) 'file-query))
7731            (list (concat "file:a file-query reference: file "
7732                          (car (cdr val))
7733                          ", position "
7734                          (int-to-string (car (cdr (cdr val))))
7735                          ".")
7736                  'jump-to-register))
7737           ((consp val)
7738            (let ((lines (format "%4d" (length val))))
7739              (list (format "%s: %s\n" lines
7740                            (truncate-string-to-width
7741                             (mapconcat 'identity (list (car val))
7742                                        "^J") (- (window-width) 15)))
7743                    'insert-register)))
7744           ((stringp val)
7745            (list
7746             ;; without properties
7747             (concat (substring-no-properties
7748                      val 0 (min (length val) anything-c-register-max-offset))
7749                     (if (> (length val) anything-c-register-max-offset)
7750                         "[...]" ""))
7751             'insert-register
7752             'append-to-register
7753             'prepend-to-register))
7754           ((vectorp val)
7755            (list
7756             "Undo-tree entry."
7757             'undo-tree-restore-state-from-register))
7758           (t
7759            "GARBAGE!"))
7760         collect (cons (format "register %3s: %s" key (car string-actions))
7761                       (cons char (cdr string-actions)))))
7762
7763 (defun anything-c-register-action-transformer (actions register-and-functions)
7764   "Decide actions by the contents of register."
7765   (loop with func-actions =
7766         '((insert-register
7767            "Insert Register" .
7768            (lambda (c) (insert-register (car c))))
7769           (jump-to-register
7770            "Jump to Register" .
7771            (lambda (c) (jump-to-register (car c))))
7772           (append-to-register
7773            "Append Region to Register" .
7774            (lambda (c) (append-to-register
7775                         (car c) (region-beginning) (region-end))))
7776           (prepend-to-register
7777            "Prepend Region to Register" .
7778            (lambda (c) (prepend-to-register
7779                         (car c) (region-beginning) (region-end))))
7780           (increment-register
7781            "Increment Prefix Arg to Register" .
7782            (lambda (c) (increment-register
7783                         anything-current-prefix-arg (car c))))
7784           (undo-tree-restore-state-from-register
7785            "Restore Undo-tree register"
7786            (lambda (c) (and (fboundp 'undo-tree-restore-state-from-register)
7787                             (undo-tree-restore-state-from-register (car c))))))
7788         for func in (cdr register-and-functions)
7789         for cell = (assq func func-actions)
7790         when cell
7791         collect (cdr cell)))
7792
7793
7794 \f
7795 ;;; Latex completion
7796 (defun anything-c-latex-math-candidates ()
7797   "Collect candidates for latex math completion."
7798   (declare (special LaTeX-math-menu))
7799   (loop for i in (cddr LaTeX-math-menu)
7800         for elm = (loop for s in i when (vectorp s)
7801                         collect (cons (aref s 0) (aref s 1)))
7802         append elm))
7803
7804 (defvar anything-c-source-latex-math
7805   '((name . "Latex Math Menu")
7806     (init . (lambda ()
7807               (with-anything-current-buffer
7808                 (LaTeX-math-mode 1))))
7809     (candidate-number-limit . 9999)
7810     (candidates . anything-c-latex-math-candidates)
7811     (action . (lambda (candidate)
7812                 (call-interactively candidate)))))
7813
7814 \f
7815 ;;;; <Headline Extraction>
7816 (defvar anything-c-source-fixme
7817   '((name . "TODO/FIXME/DRY comments")
7818     (headline . "^.*\\<\\(TODO\\|FIXME\\|DRY\\)\\>.*$")
7819     (adjust)
7820     (recenter))
7821   "Show TODO/FIXME/DRY comments in current file.")
7822
7823 (defvar anything-c-source-rd-headline
7824   '((name . "RD HeadLine")
7825     (headline  "^= \\(.+\\)$" "^== \\(.+\\)$" "^=== \\(.+\\)$" "^==== \\(.+\\)$")
7826     (condition . (memq major-mode '(rdgrep-mode rd-mode)))
7827     (migemo)
7828     (subexp . 1))
7829   "Show RD headlines.
7830
7831 RD is Ruby's POD.
7832 http://en.wikipedia.org/wiki/Ruby_Document_format")
7833
7834 (defvar anything-c-source-oddmuse-headline
7835   '((name . "Oddmuse HeadLine")
7836     (headline  "^= \\(.+\\) =$" "^== \\(.+\\) ==$"
7837      "^=== \\(.+\\) ===$" "^==== \\(.+\\) ====$")
7838     (condition . (memq major-mode '(oddmuse-mode yaoddmuse-mode)))
7839     (migemo)
7840     (subexp . 1))
7841   "Show Oddmuse headlines, such as EmacsWiki.")
7842
7843 (defvar anything-c-source-emacs-source-defun
7844   '((name . "Emacs Source DEFUN")
7845     (headline . "DEFUN\\|DEFVAR")
7846     (condition . (string-match "/emacs2[0-9].+/src/.+c$"
7847                   (or buffer-file-name ""))))
7848   "Show DEFUN/DEFVAR in Emacs C source file.")
7849
7850 (defvar anything-c-source-emacs-lisp-expectations
7851   '((name . "Emacs Lisp Expectations")
7852     (headline . "(desc[ ]\\|(expectations")
7853     (condition . (eq major-mode 'emacs-lisp-mode)))
7854   "Show descriptions (desc) in Emacs Lisp Expectations.
7855
7856 http://www.emacswiki.org/cgi-bin/wiki/download/el-expectations.el")
7857
7858 (defvar anything-c-source-emacs-lisp-toplevels
7859   '((name . "Emacs Lisp Toplevel / Level 3 Comment / Linkd Star / interactive")
7860     (headline . "^(\\|(@\\*\\|^;;;\\|(interactive\\b")
7861     (get-line . buffer-substring)
7862     (condition . (eq major-mode 'emacs-lisp-mode))
7863     (adjust))
7864   "Show top-level forms, level 4 comments and linkd stars (optional) in Emacs Lisp.
7865 linkd.el is optional because linkd stars are extracted by regexp.
7866 http://www.emacswiki.org/cgi-bin/wiki/download/linkd.el")
7867
7868 \f
7869 ;;; Anything yaoddmuse
7870 ;;
7871 ;; Be sure to have yaoddmuse.el installed
7872 ;; install-elisp may be required if you want to install elisp file from here.
7873 (defvar anything-yaoddmuse-use-cache-file nil)
7874 (defvar anything-c-yaoddmuse-cache-file "~/.emacs.d/yaoddmuse-cache.el")
7875 (defvar anything-c-yaoddmuse-ew-cache nil)
7876
7877 (defun anything-yaoddmuse-get-candidates ()
7878   (declare (special yaoddmuse-pages-hash))
7879   (if anything-yaoddmuse-use-cache-file
7880       (ignore-errors
7881         (unless anything-c-yaoddmuse-ew-cache
7882           (load anything-c-yaoddmuse-cache-file)
7883           (setq anything-c-yaoddmuse-ew-cache
7884                 (gethash "EmacsWiki" yaoddmuse-pages-hash)))
7885         anything-c-yaoddmuse-ew-cache)
7886       (yaoddmuse-update-pagename t)
7887       (gethash "EmacsWiki" yaoddmuse-pages-hash)))
7888
7889 (defvar anything-c-source-yaoddmuse-emacswiki-edit-or-view
7890   '((name . "Yaoddmuse Edit or View (EmacsWiki)")
7891     (candidates . anything-yaoddmuse-get-candidates)
7892     (action . (("Edit page" . (lambda (candidate)
7893                                 (yaoddmuse-edit "EmacsWiki" candidate)))
7894                ("Browse page"
7895                 . (lambda (candidate)
7896                     (yaoddmuse-browse-page "EmacsWiki" candidate)))
7897                ("Browse page other window"
7898                 . (lambda (candidate)
7899                     (if (one-window-p)
7900                         (split-window-vertically))
7901                     (yaoddmuse-browse-page "EmacsWiki" candidate)))
7902                ("Browse diff"
7903                 . (lambda (candidate)
7904                     (yaoddmuse-browse-page-diff "EmacsWiki" candidate)))
7905                ("Copy URL"
7906                 . (lambda (candidate)
7907                     (kill-new (yaoddmuse-url "EmacsWiki" candidate))
7908                     (message "Have copy page %s's URL to yank." candidate)))
7909                ("Create page"
7910                 . (lambda (candidate)
7911                     (yaoddmuse-edit "EmacsWiki" anything-input)))
7912                ("Update cache"
7913                 . (lambda (candidate)
7914                     (if anything-yaoddmuse-use-cache-file
7915                         (progn
7916                           (anything-yaoddmuse-cache-pages t)
7917                           (setq anything-c-yaoddmuse-ew-cache
7918                                 (gethash "EmacsWiki" yaoddmuse-pages-hash)))
7919                         (yaoddmuse-update-pagename))))))
7920     (action-transformer anything-c-yaoddmuse-action-transformer))
7921   "Needs yaoddmuse.el.
7922
7923 http://www.emacswiki.org/emacs/download/yaoddmuse.el")
7924
7925
7926 (defvar anything-c-source-yaoddmuse-emacswiki-post-library
7927   '((name . "Yaoddmuse Post library (EmacsWiki)")
7928     (init . (anything-yaoddmuse-init))
7929     (candidates-in-buffer)
7930     (action . (("Post library and Browse"
7931                 . (lambda (candidate)
7932                     (yaoddmuse-post-file
7933                      (find-library-name candidate)
7934                      "EmacsWiki"
7935                      (file-name-nondirectory (find-library-name candidate))
7936                      nil t)))
7937                ("Post library"
7938                 . (lambda (candidate)
7939                     (yaoddmuse-post-file
7940                      (find-library-name candidate)
7941                      "EmacsWiki"
7942                      (file-name-nondirectory
7943                       (find-library-name candidate))))))))
7944   "Needs yaoddmuse.el.
7945
7946 http://www.emacswiki.org/emacs/download/yaoddmuse.el")
7947
7948
7949 (defun anything-c-yaoddmuse-action-transformer (actions candidate)
7950   "Allow the use of `install-elisp' only on elisp files."
7951   (if (string-match "\.el$" candidate)
7952       (append actions '(("Install Elisp"
7953                          . (lambda (elm)
7954                              (install-elisp-from-emacswiki elm)))))
7955       actions))
7956
7957 ;;;###autoload
7958 (defun anything-yaoddmuse-cache-pages (&optional load)
7959   "Fetch the list of files on emacswiki and create cache file.
7960 If load is non--nil load the file and feed `yaoddmuse-pages-hash'."
7961   (interactive)
7962   (declare (special yaoddmuse-pages-hash))
7963   (yaoddmuse-update-pagename)
7964   (save-excursion
7965     (find-file anything-c-yaoddmuse-cache-file)
7966     (erase-buffer)
7967     (insert "(puthash \"EmacsWiki\" '(")
7968     (loop for i in (gethash "EmacsWiki" yaoddmuse-pages-hash)
7969           do
7970           (insert (concat "(\"" (car i) "\") ")))
7971     (insert ") yaoddmuse-pages-hash)\n")
7972     (save-buffer)
7973     (kill-buffer (current-buffer))
7974     (when (or current-prefix-arg
7975               load)
7976       (load anything-c-yaoddmuse-cache-file))))
7977
7978 (defun anything-yaoddmuse-init ()
7979   "Init anything buffer status."
7980   (let ((anything-buffer (anything-candidate-buffer 'global))
7981         (library-list (yaoddmuse-get-library-list)))
7982     (with-current-buffer anything-buffer
7983       ;; Insert library name.
7984       (dolist (library library-list)
7985         (insert (format "%s\n" library)))
7986       ;; Sort lines.
7987       (sort-lines nil (point-min) (point-max)))))
7988
7989 \f
7990 ;;; Eev anchors
7991 (defvar anything-c-source-eev-anchor
7992   '((name . "Anchors")
7993     (candidates
7994      . (lambda ()
7995          (ignore-errors
7996            (with-anything-current-buffer
7997              (loop initially (goto-char (point-min))
7998                    while (re-search-forward
7999                           (format ee-anchor-format "\\([^\.].+\\)") nil t)
8000                    for anchor = (match-string-no-properties 1)
8001                    collect (cons (format "%5d:%s"
8002                                          (line-number-at-pos (match-beginning 0))
8003                                          (format ee-anchor-format anchor))
8004                                  anchor))))))
8005     (persistent-action . (lambda (item)
8006                            (ee-to item)
8007                            (anything-match-line-color-current-line)))
8008     (migemo)
8009     (persistent-help . "Show this entry")
8010     (action . (("Goto link" . ee-to)))))
8011
8012 \f
8013 ;;; Org headlines
8014 ;;
8015 ;;
8016 (defvar anything-c-source-org-headline
8017   `((name . "Org HeadLine")
8018     (headline
8019      ,@(mapcar
8020         (lambda (num)
8021           (format "^\\*\\{%d\\} \\(.+?\\)\\([ \t]*:[a-zA-Z0-9_@:]+:\\)?[ \t]*$"
8022                   num))
8023         (number-sequence 1 8)))
8024     (condition . (eq major-mode 'org-mode))
8025     (migemo)
8026     (subexp . 1)
8027     (persistent-action . (lambda (elm)
8028                            (anything-c-action-line-goto elm)
8029                            (org-cycle)))
8030     (action-transformer
8031      . (lambda (actions candidate)
8032          '(("Go to Line" . anything-c-action-line-goto)
8033            ("Refile to this Headline" . anything-c-org-headline-refile)
8034            ("Insert Link to This Headline"
8035             . anything-c-org-headline-insert-link-to-headline)))))
8036   "Show Org headlines.
8037 org-mode is very very much extended text-mode/outline-mode.
8038
8039 See (find-library \"org.el\")
8040 See http://orgmode.org for the latest version.")
8041
8042 (defun anything-c-org-headline-insert-link-to-headline (lineno-and-content)
8043   (insert
8044    (save-excursion
8045      (anything-goto-line (car lineno-and-content))
8046      (and (looking-at org-complex-heading-regexp)
8047           (org-make-link-string (concat "*" (match-string 4)))))))
8048
8049 (defun anything-c-org-headline-refile (lineno-and-content)
8050   "Refile current org entry to LINENO-AND-CONTENT."
8051   (with-anything-current-buffer
8052     (org-cut-subtree)
8053     (anything-goto-line (car lineno-and-content))
8054     (org-end-of-subtree t t)
8055     (let ((org-yank-adjusted-subtrees t))
8056       (org-yank))))
8057
8058
8059 ;;; Org keywords
8060 ;;
8061 ;;
8062 (defvar anything-c-source-org-keywords
8063   '((name . "Org Keywords")
8064     (init . anything-c-org-keywords-init)
8065     (candidates . anything-c-org-keywords-candidates)
8066     (action . anything-c-org-keywords-insert)
8067     (persistent-action . anything-c-org-keywords-show-help)
8068     (persistent-help . "Show an example and info page to describe this keyword.")
8069     (keywords-examples)
8070     (keywords)))
8071
8072 (defvar anything-c-org-keywords-info-location
8073   '(("#+TITLE:" . "(org)Export options")
8074     ("#+AUTHOR:" . "(org)Export options")
8075     ("#+DATE:" . "(org)Export options")
8076     ("#+EMAIL:" . "(org)Export options")
8077     ("#+DESCRIPTION:" . "(org)Export options")
8078     ("#+KEYWORDS:" . "(org)Export options")
8079     ("#+LANGUAGE:" . "(org)Export options")
8080     ("#+TEXT:" . "(org)Export options")
8081     ("#+TEXT:" . "(org)Export options")
8082     ("#+OPTIONS:" . "(org)Export options")
8083     ("#+BIND:" . "(org)Export options")
8084     ("#+LINK_UP:" . "(org)Export options")
8085     ("#+LINK_HOME:" . "(org)Export options")
8086     ("#+LATEX_HEADER:" . "(org)Export options")
8087     ("#+EXPORT_SELECT_TAGS:" . "(org)Export options")
8088     ("#+EXPORT_EXCLUDE_TAGS:" . "(org)Export options")
8089     ("#+INFOJS_OPT" . "(org)Javascript support")
8090     ("#+BEGIN_HTML" . "(org)Quoting HTML tags")
8091     ("#+BEGIN_LaTeX" . "(org)Quoting LaTeX code")
8092     ("#+ORGTBL" . "(org)Radio tables")
8093     ("#+HTML:" . "(org)Quoting HTML tags")
8094     ("#+LaTeX:" . "(org)Quoting LaTeX code")
8095     ("#+BEGIN:" . "(org)Dynamic blocks") ;clocktable columnview
8096     ("#+BEGIN_EXAMPLE" . "(org)Literal examples")
8097     ("#+BEGIN_QUOTE" . "(org)Paragraphs")
8098     ("#+BEGIN_VERSE" . "(org)Paragraphs")
8099     ("#+BEGIN_SRC" . "(org)Literal examples")
8100     ("#+CAPTION" . "(org)Tables in HTML export")
8101     ("#+LABEL" . "(org)Tables in LaTeX export")
8102     ("#+ATTR_HTML" . "(org)Links")
8103     ("#+ATTR_LaTeX" . "(org)Images in LaTeX export")))
8104
8105 (defun anything-c-org-keywords-init ()
8106   (unless (anything-attr 'keywords-examples)
8107     (require 'org)
8108     (anything-attrset 'keywords-examples
8109                       (append
8110                        (mapcar
8111                         (lambda (x)
8112                           (string-match "^#\\+\\(\\([A-Z_]+:?\\).*\\)" x)
8113                           (cons (match-string 2 x) (match-string 1 x)))
8114                         (org-split-string (org-get-current-options) "\n"))
8115                        (mapcar 'list org-additional-option-like-keywords)))
8116     (anything-attrset 'keywords (mapcar 'car (anything-attr 'keywords-examples)))))
8117
8118 (defun anything-c-org-keywords-candidates ()
8119   (and (or (eq (buffer-local-value 'major-mode anything-current-buffer) 'org-mode)
8120            (eq (buffer-local-value 'major-mode anything-current-buffer) 'message-mode))
8121        (anything-attr 'keywords)))
8122
8123 (defun anything-c-org-keywords-insert (keyword)
8124   (cond ((and (string-match "BEGIN" keyword)
8125               (anything-region-active-p))
8126          (let ((beg (region-beginning))
8127                (end (region-end)))
8128            (goto-char end)
8129            (insert "\n#+" (replace-regexp-in-string
8130                            "BEGIN" "END" keyword) "\n")
8131            (goto-char beg)
8132            (insert "#+" keyword " ")
8133            (save-excursion (insert "\n"))))
8134         ((string-match "BEGIN" keyword)
8135          (insert "#+" keyword " ")
8136          (save-excursion
8137            (insert "\n#+" (replace-regexp-in-string
8138                            "BEGIN" "END" keyword) "\n")))
8139         (t (insert "#+" keyword " "))))
8140
8141 (defun anything-c-org-keywords-show-help (keyword)
8142   (info (or (assoc-default (concat "#+" keyword) anything-c-org-keywords-info-location)
8143             "(org)In-buffer settings"))
8144   (search-forward (concat "#+" keyword) nil t)
8145   (anything-persistent-highlight-point)
8146   (message "%s" (or (cdr (assoc keyword (anything-attr 'keywords-examples))) "")))
8147
8148
8149 \f
8150 ;;; bbdb
8151 ;;
8152 ;;
8153 (defvar bbdb-records)
8154 (defvar bbdb-buffer-name)
8155
8156 (defun anything-c-bbdb-candidates ()
8157   "Return a list of all names in the bbdb database.  The format
8158 is \"Firstname Lastname\"."
8159   (mapcar (lambda (bbdb-record)
8160             (replace-regexp-in-string
8161              "\\s-+$" ""
8162              (concat (aref bbdb-record 0) " " (aref bbdb-record 1))))
8163           (bbdb-records)))
8164
8165 (defun anything-c-bbdb-create-contact (actions candidate)
8166   "Action transformer that returns only an entry to add the
8167 current `anything-pattern' as new contact.  All other actions are
8168 removed."
8169   (if (string= candidate "*Add to contacts*")
8170       '(("Add to contacts" . (lambda (actions)
8171                                (bbdb-create-internal
8172                                 (read-from-minibuffer "Name: " anything-c-bbdb-name)
8173                                 (read-from-minibuffer "Company: ")
8174                                 (read-from-minibuffer "Email: ")
8175                                 nil
8176                                 nil
8177                                 (read-from-minibuffer "Note: ")))))
8178       actions))
8179
8180 (defun anything-c-bbdb-get-record (candidate)
8181   "Return record that match CANDIDATE."
8182   (bbdb candidate nil)
8183   (set-buffer "*BBDB*")
8184   (bbdb-current-record))
8185
8186 (defvar anything-c-bbdb-name nil
8187   "Only for internal use.")
8188
8189 (defvar anything-c-source-bbdb
8190   '((name . "BBDB")
8191     (candidates . anything-c-bbdb-candidates)
8192     (action ("Send a mail" . anything-c-bbdb-compose-mail)
8193      ("View person's data" . anything-c-bbdb-view-person-action))
8194     (filtered-candidate-transformer . (lambda (candidates source)
8195                                         (setq anything-c-bbdb-name anything-pattern)
8196                                         (if (not candidates)
8197                                             (list "*Add to contacts*")
8198                                             candidates)))
8199     (action-transformer . (lambda (actions candidate)
8200                             (anything-c-bbdb-create-contact actions candidate))))
8201   "Needs BBDB.
8202
8203 http://bbdb.sourceforge.net/")
8204
8205 (defun anything-c-bbdb-view-person-action (candidate)
8206   "View BBDB data of single CANDIDATE or marked candidates."
8207   (anything-aif (anything-marked-candidates)
8208       (let ((bbdb-append-records (length it)))
8209         (dolist (i it)
8210           (bbdb-redisplay-one-record (anything-c-bbdb-get-record i))))
8211     (bbdb-redisplay-one-record (anything-c-bbdb-get-record candidate))))
8212
8213 (defun anything-c-bbdb-collect-mail-addresses ()
8214   "Return a list of all mail addresses of records in bbdb buffer."
8215   (with-current-buffer bbdb-buffer-name
8216     (loop for i in bbdb-records
8217           if (bbdb-record-net (car i))
8218           collect (bbdb-dwim-net-address (car i)))))
8219
8220 (defun anything-c-bbdb-compose-mail (candidate)
8221   "Compose a mail with all records of bbdb buffer."
8222   (anything-c-bbdb-view-person-action candidate)
8223   (let* ((address-list (anything-c-bbdb-collect-mail-addresses))
8224          (address-str  (mapconcat 'identity address-list ",\n    ")))
8225     (compose-mail address-str)))
8226
8227 \f
8228 ;;; Evaluation Result
8229 ;;
8230 ;;
8231 ;; Internal
8232 (defvar anything-eldoc-active-minibuffers-list nil)
8233 (defvar anything-eval-expression-input-history nil)
8234
8235 (defvar anything-c-source-evaluation-result
8236   '((name . "Evaluation Result")
8237     (disable-shortcuts)
8238     (dummy)
8239     (multiline)
8240     (mode-line . "C-RET: nl-and-indent, tab: reindent, C-tab:complete, C-p/n: next/prec-line.")
8241     (filtered-candidate-transformer . (lambda (candidates source)
8242                                         (list
8243                                          (condition-case nil
8244                                              (with-anything-current-buffer
8245                                                (pp-to-string
8246                                                 (eval (read anything-pattern))))
8247                                            (error "Error")))))
8248     (action . (("Copy result to kill-ring" . (lambda (candidate)
8249                                                (with-current-buffer anything-buffer
8250                                                  (let ((end (save-excursion
8251                                                               (goto-char (point-max))
8252                                                               (search-backward "\n")
8253                                                               (point))))
8254                                                    (kill-region (point) end)))))
8255                ("copy sexp to kill-ring" . (lambda (candidate)
8256                                              (kill-new anything-input)))))))
8257
8258 (defun anything-eval-new-line-and-indent ()
8259   (interactive)
8260   (newline) (lisp-indent-line))
8261
8262 (defun anything-eldoc-store-minibuffer ()
8263   "Store minibuffer buffer name in `anything-eldoc-active-minibuffers-list'."
8264   (with-selected-window (minibuffer-window)
8265     (push (buffer-name) anything-eldoc-active-minibuffers-list)))
8266
8267 (defun anything-eldoc-show-in-eval ()
8268   "Return eldoc in mode-line for current minibuffer input."
8269   (let ((buf (with-selected-window (minibuffer-window)
8270                (buffer-name))))
8271     (when (member buf anything-eldoc-active-minibuffers-list)
8272       (let* ((str-all (with-current-buffer buf
8273                         (minibuffer-completion-contents)))
8274              (sym     (when str-all
8275                         (with-temp-buffer
8276                           (insert str-all)
8277                           (goto-char (point-max))
8278                           (unless (looking-back ")\\|\"") (forward-char -1))
8279                           (eldoc-current-symbol))))
8280              (info-fn (eldoc-fnsym-in-current-sexp))
8281              (doc     (or (eldoc-get-var-docstring sym)
8282                           (eldoc-get-fnsym-args-string
8283                            (car info-fn) (cadr info-fn)))))
8284         (when doc (funcall anything-c-eldoc-in-minibuffer-show-fn doc))))))
8285
8286 (defun anything-c-show-info-in-mode-line (str)
8287   "Display string STR in mode-line."
8288   (save-selected-window
8289     (with-current-buffer anything-buffer
8290       (let ((mode-line-format (concat " " str)))
8291         (force-mode-line-update)
8292         (sit-for anything-c-show-info-in-mode-line-delay))
8293       (force-mode-line-update))))
8294
8295 ;;; Calculation Result
8296 ;;
8297 ;;
8298 (defvar anything-c-source-calculation-result
8299   '((name . "Calculation Result")
8300     (dummy)
8301     (filtered-candidate-transformer . (lambda (candidates source)
8302                                         (list
8303                                          (condition-case nil
8304                                              (calc-eval anything-pattern)
8305                                            (error "error")))))
8306     (action ("Copy result to kill-ring" . kill-new))))
8307
8308 \f
8309 ;;; Google Suggestions
8310 ;;
8311 ;;
8312 ;; Internal
8313 (defvar anything-ggs-max-length-real-flag 0)
8314 (defvar anything-ggs-max-length-num-flag 0)
8315
8316 (defun anything-c-google-suggest-fetch (input)
8317   "Fetch suggestions for INPUT from XML buffer.
8318 Return an alist with elements like (data . number_results)."
8319   (setq anything-ggs-max-length-real-flag 0
8320         anything-ggs-max-length-num-flag 0)
8321   (let ((request (concat anything-c-google-suggest-url
8322                          (url-hexify-string input))))
8323     (flet ((fetch ()
8324              (loop
8325                    with result-alist = (xml-get-children
8326                                         (car (xml-parse-region
8327                                               (point-min) (point-max)))
8328                                         'CompleteSuggestion)
8329                    for i in result-alist
8330                    for data = (cdr (caadr (assoc 'suggestion i)))
8331                    for nqueries = (cdr (caadr (assoc 'num_queries i)))
8332                    for lqueries = (length (anything-c-ggs-set-number-result
8333                                            nqueries))
8334                    for ldata = (length data)
8335                    do
8336                    (progn
8337                      (when (> ldata anything-ggs-max-length-real-flag)
8338                        (setq anything-ggs-max-length-real-flag ldata))
8339                      (when (> lqueries anything-ggs-max-length-num-flag)
8340                        (setq anything-ggs-max-length-num-flag lqueries)))
8341                    collect (cons data nqueries) into cont
8342                    finally return cont)))
8343       (if anything-google-suggest-use-curl-p
8344           (with-temp-buffer
8345             (call-process "curl" nil t nil request)
8346             (fetch))
8347           (with-current-buffer
8348               (url-retrieve-synchronously request)
8349             (fetch))))))
8350
8351 (defun anything-c-google-suggest-set-candidates (&optional request-prefix)
8352   "Set candidates with result and number of google results found."
8353   (let ((suggestions
8354          (loop with suggested-results = (anything-c-google-suggest-fetch
8355                                          (or (and request-prefix
8356                                                   (concat request-prefix
8357                                                           " " anything-pattern))
8358                                              anything-pattern))
8359                for (real . numresult) in suggested-results
8360                ;; Prepare number of results with ","
8361                for fnumresult = (anything-c-ggs-set-number-result numresult)
8362                ;; Calculate number of spaces to add before fnumresult
8363                ;; if it is smaller than longest result
8364                ;; `anything-ggs-max-length-num-flag'.
8365                ;; e.g 1,234,567
8366                ;;       345,678
8367                ;; To be sure it is aligned properly.
8368                for nspaces = (if (< (length fnumresult)
8369                                     anything-ggs-max-length-num-flag)
8370                                  (- anything-ggs-max-length-num-flag
8371                                     (length fnumresult))
8372                                  0)
8373                ;; Add now the spaces before fnumresult.
8374                for align-fnumresult = (concat (make-string nspaces ? )
8375                                               fnumresult)
8376                for interval = (- anything-ggs-max-length-real-flag
8377                                  (length real))
8378                for spaces   = (make-string (+ 2 interval) ? )
8379                for display = (format "%s%s(%s results)"
8380                                      real spaces align-fnumresult)
8381                collect (cons display real))))
8382     (if (loop for (disp . dat) in suggestions
8383               thereis (equal dat anything-pattern))
8384         suggestions
8385         ;; if there is no suggestion exactly matching the input then
8386         ;; prepend a Search on Google item to the list
8387         (append
8388          suggestions
8389          (list (cons (concat "Search for " "'" anything-input "'" " on Google")
8390                      anything-input))))))
8391
8392 (defun anything-c-ggs-set-number-result (num)
8393   (if num
8394       (progn
8395         (and (numberp num) (setq num (number-to-string num)))
8396         (loop for i in (reverse (split-string num "" t))
8397               for count from 1
8398               append (list i) into C
8399               when (= count 3)
8400               append (list ",") into C
8401               and do (setq count 0)
8402               finally return
8403               (replace-regexp-in-string
8404                "^," "" (mapconcat 'identity (reverse C) ""))))
8405       "?"))
8406
8407 (defvar anything-c-google-suggest-default-browser-function nil
8408   "*The browse url function you prefer to use with google suggest.
8409 When nil, use the first browser function available
8410 See `anything-browse-url-default-browser-alist'.")
8411
8412 (defun anything-c-google-suggest-action (candidate)
8413   "Default action to jump to a google suggested candidate."
8414   (let ((arg (concat anything-c-google-suggest-search-url
8415                      (url-hexify-string candidate))))
8416     (anything-aif anything-c-google-suggest-default-browser-function
8417         (funcall it arg)
8418       (anything-c-browse-url arg))))
8419
8420 (defvar anything-c-google-suggest-default-function
8421   'anything-c-google-suggest-set-candidates
8422   "Default function to use in anything google suggest.")
8423
8424 (defvar anything-c-source-google-suggest
8425   '((name . "Google Suggest")
8426     (candidates . (lambda ()
8427                     (funcall anything-c-google-suggest-default-function)))
8428     (action . (("Google Search" . anything-c-google-suggest-action)))
8429     (volatile)
8430     (requires-pattern . 3)
8431     (delayed)))
8432
8433 (defun anything-c-google-suggest-emacs-lisp ()
8434   "Try to emacs lisp complete with google suggestions."
8435   (anything-c-google-suggest-set-candidates "emacs lisp"))
8436
8437
8438 ;;; Yahoo suggestions
8439 ;;
8440 ;;
8441 (defun anything-c-yahoo-suggest-fetch (input)
8442   "Fetch Yahoo suggestions for INPUT from XML buffer.
8443 Return an alist with elements like (data . number_results)."
8444   (let ((request (concat anything-c-yahoo-suggest-url
8445                          (url-hexify-string input))))
8446     (flet ((fetch ()
8447              (loop
8448                    with result-alist = (xml-get-children
8449                                         (car (xml-parse-region
8450                                               (point-min) (point-max)))
8451                                         'Result)
8452                    for i in result-alist
8453                    collect (caddr i))))
8454       (with-current-buffer
8455           (url-retrieve-synchronously request)
8456         (fetch)))))
8457
8458 (defun anything-c-yahoo-suggest-set-candidates ()
8459   "Set candidates with Yahoo results found."
8460   (let ((suggestions (anything-c-yahoo-suggest-fetch anything-input)))
8461     (or suggestions
8462         (append
8463          suggestions
8464          (list (cons (concat "Search for " "'" anything-input "'" " on Yahoo")
8465                      anything-input))))))
8466
8467 (defun anything-c-yahoo-suggest-action (candidate)
8468   "Default action to jump to a Yahoo suggested candidate."
8469   (anything-c-browse-url (concat anything-c-yahoo-suggest-search-url
8470                                  (url-hexify-string candidate))))
8471
8472 (defvar anything-c-source-yahoo-suggest
8473   '((name . "Yahoo Suggest")
8474     (candidates . anything-c-yahoo-suggest-set-candidates)
8475     (action . (("Yahoo Search" . anything-c-yahoo-suggest-action)))
8476     (volatile)
8477     (requires-pattern . 3)
8478     (delayed)))
8479
8480
8481 \f
8482 ;;; Web browser functions.
8483 ;;
8484 ;;
8485 (require 'browse-url)
8486 ;; If default setting of `w3m-command' is not
8487 ;; what you want you and you modify it, you will have to reeval
8488 ;; also `anything-browse-url-default-browser-alist'.
8489 (defvar w3m-command "/usr/bin/w3m")
8490 (defvar anything-c-home-url "http://www.google.fr"
8491   "*Default url to use as home url.")
8492
8493 (defvar ac-browse-url-chromium-program "chromium-browser")
8494 (defvar ac-browse-url-uzbl-program "uzbl-browser")
8495 (defvar anything-browse-url-default-browser-alist
8496   `((,w3m-command . w3m-browse-url)
8497     (,browse-url-firefox-program . browse-url-firefox)
8498     (,ac-browse-url-chromium-program . ac-browse-url-chromium)
8499     (,ac-browse-url-uzbl-program . ac-browse-url-uzbl)
8500     (,browse-url-kde-program . browse-url-kde)
8501     (,browse-url-gnome-moz-program . browse-url-gnome-moz)
8502     (,browse-url-mozilla-program . browse-url-mozilla)
8503     (,browse-url-galeon-program . browse-url-galeon)
8504     (,browse-url-netscape-program . browse-url-netscape)
8505     (,browse-url-mosaic-program . browse-url-mosaic)
8506     (,browse-url-xterm-program . browse-url-text-xterm))
8507   "*Alist of \(executable . function\) to try to find a suitable url browser.")
8508
8509 (defun* anything-c-generic-browser (url name &rest args)
8510   "Browse URL with NAME browser."
8511   (let ((proc (concat name " " url)))
8512     (message "Starting %s..." name)
8513     (apply 'start-process proc nil name
8514            (append args (list url)))
8515     (set-process-sentinel
8516      (get-process proc)
8517      #'(lambda (process event)
8518          (when (string= event "finished\n")
8519            (message "%s process %s" process event))))))
8520
8521 (defun ac-browse-url-chromium (url)
8522   "Browse URL with google chrome browser."
8523   (interactive "sURL: ")
8524   (anything-c-generic-browser
8525    url ac-browse-url-chromium-program))
8526
8527 (defun ac-browse-url-uzbl (url &optional ignore)
8528   "Browse URL with uzbl browser."
8529   (interactive "sURL: ")
8530   (anything-c-generic-browser url ac-browse-url-uzbl-program "-u"))
8531
8532 (defun anything-browse-url-default-browser (url &rest args)
8533   "Find the first available browser and ask it to load URL."
8534   (let ((default-browser-fn
8535          (loop for (exe . fn) in anything-browse-url-default-browser-alist
8536                thereis (and exe (executable-find exe) fn))))
8537     (if default-browser-fn
8538         (apply default-browser-fn url args)
8539         (error "No usable browser found"))))
8540
8541 (defun anything-c-browse-url (url &rest args)
8542   "Default command to browse URL."
8543   (if browse-url-browser-function
8544       (browse-url url args)
8545       (anything-browse-url-default-browser url args)))
8546
8547 \f
8548 ;;; Surfraw
8549 ;;
8550 ;; Need external program surfraw.
8551 ;; <http://surfraw.alioth.debian.org/>
8552
8553 (defvar anything-surfraw-default-browser-function nil
8554   "*The browse url function you prefer to use with surfraw.
8555 When nil, fallback to `browse-url-browser-function'.")
8556
8557 ;; Internal
8558 (defvar anything-surfraw-engines-history nil)
8559 (defvar anything-surfraw-input-history nil)
8560
8561 (defun anything-c-build-elvi-list ()
8562   "Return list of all engines and descriptions handled by surfraw."
8563   (cdr
8564    (with-temp-buffer
8565      (call-process "surfraw" nil t nil
8566                    "-elvi")
8567      (split-string (buffer-string) "\n"))))
8568
8569 \f
8570 ;;; Emms
8571 ;;
8572 ;;
8573 (defun anything-emms-stream-edit-bookmark (elm)
8574   "Change the information of current emms-stream bookmark from anything."
8575   (declare (special emms-stream-list))
8576   (let* ((cur-buf anything-current-buffer)
8577          (bookmark (assoc elm emms-stream-list))
8578          (name     (read-from-minibuffer "Description: "
8579                                          (nth 0 bookmark)))
8580          (url      (read-from-minibuffer "URL: "
8581                                          (nth 1 bookmark)))
8582          (fd       (read-from-minibuffer "Feed Descriptor: "
8583                                          (int-to-string (nth 2 bookmark))))
8584          (type     (read-from-minibuffer "Type (url, streamlist, or lastfm): "
8585                                          (format "%s" (car (last bookmark))))))
8586     (save-window-excursion
8587       (emms-streams)
8588       (when (re-search-forward (concat "^" name) nil t)
8589         (beginning-of-line)
8590         (emms-stream-delete-bookmark)
8591         (emms-stream-add-bookmark name url (string-to-number fd) type)
8592         (emms-stream-save-bookmarks-file)
8593         (emms-stream-quit)
8594         (anything-c-switch-to-buffer cur-buf)))))
8595
8596 (defun anything-emms-stream-delete-bookmark (candidate)
8597   "Delete emms-streams bookmarks from anything."
8598   (let* ((cands   (anything-marked-candidates))
8599          (bmks    (loop for bm in cands collect
8600                         (car (assoc bm emms-stream-list))))
8601          (bmk-reg (mapconcat 'regexp-quote bmks "\\|^")))
8602     (when (y-or-n-p (format "Really delete radios\n -%s: ? "
8603                             (mapconcat 'identity bmks "\n -")))
8604       (save-window-excursion
8605         (emms-streams)
8606         (goto-char (point-min))
8607         (loop while (re-search-forward bmk-reg nil t)
8608               do (progn (beginning-of-line)
8609                         (emms-stream-delete-bookmark))
8610               finally do (progn
8611                            (emms-stream-save-bookmarks-file)
8612                            (emms-stream-quit)))))))
8613
8614 (defvar anything-c-source-emms-streams
8615   '((name . "Emms Streams")
8616     (init . (lambda ()
8617               (emms-stream-init)))
8618     (candidates . (lambda ()
8619                     (declare (special emms-stream-list))
8620                     (mapcar 'car emms-stream-list)))
8621     (action . (("Play" . (lambda (elm)
8622                            (declare (special emms-stream-list))
8623                            (let* ((stream (assoc elm emms-stream-list))
8624                                   (fn (intern (concat "emms-play-" (symbol-name (car (last stream))))))
8625                                   (url (second stream)))
8626                              (funcall fn url))))
8627                ("Delete" . anything-emms-stream-delete-bookmark)
8628                ("Edit" . anything-emms-stream-edit-bookmark)))
8629     (filtered-candidate-transformer . anything-c-adaptive-sort)))
8630
8631 ;; Don't forget to set `emms-source-file-default-directory'
8632 (defvar anything-c-source-emms-dired
8633   '((name . "Music Directory")
8634     (candidates . (lambda ()
8635                     (cddr (directory-files emms-source-file-default-directory))))
8636     (action .
8637      (("Play Directory" . (lambda (item)
8638                             (emms-play-directory
8639                              (expand-file-name
8640                               item
8641                               emms-source-file-default-directory))))
8642       ("Open dired in file's directory" . (lambda (item)
8643                                             (anything-c-open-dired
8644                                              (expand-file-name
8645                                               item
8646                                               emms-source-file-default-directory))))))
8647     (filtered-candidate-transformer . anything-c-adaptive-sort)))
8648
8649
8650 (defun anything-c-emms-files-modifier (candidates source)
8651   (let ((current-playlist (with-current-emms-playlist
8652                               (loop with cur-list = (emms-playlist-tracks-in-region
8653                                                      (point-min) (point-max))
8654                                     for i in cur-list
8655                                     for name = (assoc-default 'name i)
8656                                     when name
8657                                     collect name))))
8658     (loop for i in candidates
8659           if (member (cdr i) current-playlist)
8660           collect (cons (propertize (car i)
8661                                     'face 'anything-emms-playlist)
8662                         (cdr i)) into lis
8663           else collect i into lis
8664           finally return (reverse lis))))
8665
8666 (defun anything-c-emms-play-current-playlist ()
8667   "Play current playlist."
8668   (with-current-emms-playlist
8669       (emms-playlist-first)
8670     (emms-playlist-mode-play-smart)))
8671
8672 (defvar anything-c-source-emms-files
8673   '((name . "Emms files")
8674     (candidates . (lambda ()
8675                     (loop for v being the hash-values in emms-cache-db
8676                           for name      = (assoc-default 'name v)
8677                           for artist    = (or (assoc-default 'info-artist v) "unknown")
8678                           for genre     = (or (assoc-default 'info-genre v) "unknown")
8679                           for tracknum  = (or (assoc-default 'info-tracknumber v) "unknown")
8680                           for song      = (or (assoc-default 'info-title v) "unknown")
8681                           for info      = (concat artist " - " genre " - " tracknum ": " song)
8682                           unless (string-match "^\\(http\\|mms\\):" name)
8683                           collect (cons info name))))
8684     (filtered-candidate-transformer . anything-c-emms-files-modifier)
8685     (candidate-number-limit . 9999)
8686     (action . (("Play file" . emms-play-file)
8687                ("Add to Playlist and play (C-u clear current)"
8688                 . (lambda (candidate)
8689                     (when anything-current-prefix-arg
8690                       (emms-playlist-current-clear))
8691                     (emms-playlist-new)
8692                     (mapc 'emms-add-playlist-file (anything-marked-candidates))
8693                     (unless emms-player-playing-p
8694                       (anything-c-emms-play-current-playlist))))))))
8695
8696
8697 \f
8698 ;;; Jabber Contacts (jabber.el)
8699 (defun anything-c-jabber-online-contacts ()
8700   "List online Jabber contacts."
8701   (with-no-warnings
8702     (let (jids)
8703       (dolist (item (jabber-concat-rosters) jids)
8704         (when (get item 'connected)
8705           (push (if (get item 'name)
8706                     (cons (get item 'name) item)
8707                     (cons (symbol-name item) item)) jids))))))
8708
8709 (defvar anything-c-source-jabber-contacts
8710   '((name . "Jabber Contacts")
8711     (init . (lambda () (require 'jabber)))
8712     (candidates . (lambda () (mapcar 'car (anything-c-jabber-online-contacts))))
8713     (action . (lambda (x)
8714                 (jabber-chat-with
8715                  (jabber-read-account)
8716                  (symbol-name
8717                   (cdr (assoc x (anything-c-jabber-online-contacts)))))))))
8718
8719
8720 \f
8721 ;;; Call source.
8722 (defvar anything-source-select-buffer "*anything source select*")
8723 (defvar anything-c-source-call-source
8724   `((name . "Call anything source")
8725     (candidate-number-limit)
8726     (candidates
8727      . (lambda ()
8728          (loop for vname in (all-completions "anything-c-source-" obarray)
8729                for var = (intern vname)
8730                for name = (ignore-errors (assoc-default 'name (symbol-value var)))
8731                if name collect
8732                (cons (format "%s `%s'"
8733                              name (propertize vname 'face 'font-lock-variable-name-face))
8734                      var))))
8735     (action
8736      . (("Invoke anything with selected source"
8737          .
8738          (lambda (candidate)
8739            (setq anything-candidate-number-limit 9999)
8740            (anything candidate nil nil nil nil
8741                      anything-source-select-buffer)))
8742         ("Describe variable" . describe-variable)
8743         ("Find variable" . find-variable)))
8744     (persistent-action . describe-variable)
8745     (persistent-help . "Show description of this source")))
8746
8747 (defun anything-call-source-from-anything ()
8748   "Call anything source within `anything' session."
8749   (interactive)
8750   (setq anything-input-idle-delay 0)
8751   (anything-set-sources '(anything-c-source-call-source)))
8752
8753 ;;; Execute Preconfigured anything.
8754 (defvar anything-c-source-anything-commands
8755   '((name . "Preconfigured Anything")
8756     (candidates . anything-c-anything-commands-candidates)
8757     (type . command)
8758     (candidate-number-limit)))
8759
8760 (defun anything-c-anything-commands-candidates ()
8761   (loop for (cmd . desc) in (anything-c-list-preconfigured-anything)
8762         collect (cons (if (where-is-internal cmd nil t)
8763                           (substitute-command-keys (format "M-x %s (\\[%s]) : %s" cmd cmd desc))
8764                           (substitute-command-keys (format "\\[%s] : %s" cmd desc)))
8765                       cmd)))
8766
8767 \f
8768 ;;; Occur
8769 ;;
8770 ;;
8771 (defun anything-c-occur-init ()
8772   "Create the initial anything occur buffer.
8773 If region is active use region as buffer contents
8774 instead of whole buffer."
8775   (with-current-buffer (anything-candidate-buffer 'global)
8776     (erase-buffer)
8777     (let ((buf-contents
8778            (with-anything-current-buffer
8779              (if (anything-region-active-p)
8780                  (buffer-substring (region-beginning) (region-end))
8781                  (buffer-substring (point-min) (point-max))))))
8782       (insert buf-contents))))
8783
8784 (defun anything-c-occur-get-line (s e)
8785   (format "%7d:%s" (line-number-at-pos (1- s)) (buffer-substring s e)))
8786
8787 (defun anything-c-occur-query-replace-regexp (candidate)
8788   "Query replace regexp starting from CANDIDATE.
8789 If region is active ignore CANDIDATE and replace only in region.
8790 With a prefix arg replace only matches surrounded by word boundaries,
8791 i.e Don't replace inside a word, regexp is surrounded with \\bregexp\\b."
8792   (let ((regexp anything-input))
8793     (unless (anything-region-active-p)
8794       (anything-c-action-line-goto candidate))
8795     (apply 'query-replace-regexp
8796            (anything-c-query-replace-args regexp))))
8797
8798 (defun anything-occur-run-query-replace-regexp ()
8799   "Run `query-replace-regexp' in anything occur from keymap."
8800   (interactive)
8801   (anything-c-quit-and-execute-action
8802    'anything-c-occur-query-replace-regexp))
8803
8804 (defvar anything-c-source-occur
8805   `((name . "Occur")
8806     (init . anything-c-occur-init)
8807     (candidates-in-buffer)
8808     (migemo)
8809     (get-line . anything-c-occur-get-line)
8810     (display-to-real . anything-c-display-to-real-line)
8811     (action . (("Go to Line" . anything-c-action-line-goto)
8812                ("Query replace regexp (C-u Not inside word.)"
8813                 . anything-c-occur-query-replace-regexp)))
8814     (recenter)
8815     (mode-line . anything-occur-mode-line)
8816     (keymap . ,anything-occur-map)
8817     (requires-pattern . 1)
8818     (delayed)))
8819
8820 \f
8821 ;;; Anything browse code.
8822 (defun anything-c-browse-code-get-line (beg end)
8823   "Select line if it match the regexp corresponding to current `major-mode'.
8824 Line is parsed for BEG position to END position."
8825   (let ((str-line (buffer-substring beg end))
8826         (regexp   (assoc-default major-mode
8827                                  anything-c-browse-code-regexp-alist))
8828         (num-line (if (string= anything-pattern "") beg (1- beg))))
8829     (when (and regexp (string-match regexp str-line))
8830       (format "%4d:%s" (line-number-at-pos num-line) str-line))))
8831
8832
8833 (defvar anything-c-source-browse-code
8834   '((name . "Browse code")
8835     (init . (lambda ()
8836               (anything-candidate-buffer anything-current-buffer)
8837               (with-anything-current-buffer
8838                 (jit-lock-fontify-now))))
8839     (candidate-number-limit . 9999)
8840     (candidates-in-buffer)
8841     (get-line . anything-c-browse-code-get-line)
8842     (type . line)
8843     (recenter)))
8844
8845 \f
8846 ;; Do many actions for input
8847 (defvar anything-c-source-create
8848   '((name . "Create")
8849     (dummy)
8850     (action)
8851     (action-transformer . anything-create--actions))
8852   "Do many create actions from `anything-pattern'.
8853 See also `anything-create--actions'.")
8854
8855 (defun anything-create-from-anything ()
8856   "Run `anything-create' from `anything' as a fallback."
8857   (interactive)
8858   (anything-run-after-quit 'anything-create nil anything-pattern))
8859
8860 (defun anything-create--actions (&rest ignored)
8861   "Default actions for `anything-create' / `anything-c-source-create'."
8862   (remove-if-not
8863    (lambda (pair) (and (consp pair) (functionp (cdr pair))))
8864    (append anything-create--actions-private
8865            '(("find-file" . find-file)
8866              ("find-file other window" . find-file-other-window)
8867              ("New buffer" . anything-c-switch-to-buffer)
8868              ("New buffer other window" . switch-to-buffer-other-window)
8869              ("Bookmark Set" . bookmark-set)
8870              ("Set Register" .
8871               (lambda (x) (set-register (read-char "Register: ") x)))
8872              ("Insert Linkd star" . linkd-insert-star)
8873              ("Insert Linkd Tag" . linkd-insert-tag)
8874              ("Insert Linkd Link" . linkd-insert-link)
8875              ("Insert Linkd Lisp" . linkd-insert-lisp)
8876              ("Insert Linkd Wiki" . linkd-insert-wiki)
8877              ("Google Search" . google)))))
8878
8879 \f
8880 ;; Minibuffer History
8881 ;;
8882 ;;
8883 (defvar anything-c-source-minibuffer-history
8884   '((name . "Minibuffer History")
8885     (header-name . (lambda (name)
8886                      (format "%s (%s)" name minibuffer-history-variable)))
8887     (candidates
8888      . (lambda ()
8889          (let ((history (loop for i in
8890                               (symbol-value minibuffer-history-variable)
8891                               unless (string= "" i) collect i)))
8892            (if (consp (car history))
8893                (mapcar 'prin1-to-string history)
8894                history))))
8895     (migemo)
8896     (action . (lambda (candidate)
8897                 (delete-minibuffer-contents)
8898                 (insert candidate)))))
8899
8900 \f
8901 ;;; Elscreen
8902 ;;
8903 ;;
8904 (defvar anything-c-source-elscreen
8905   '((name . "Elscreen")
8906     (candidates
8907      . (lambda ()
8908          (if (cdr (elscreen-get-screen-to-name-alist))
8909              (sort
8910               (loop for sname in (elscreen-get-screen-to-name-alist)
8911                     append (list (format "[%d] %s" (car sname) (cdr sname))))
8912               #'(lambda (a b) (compare-strings a nil nil b nil nil))))))
8913     (action
8914      . (("Change Screen" .
8915                          (lambda (candidate)
8916                            (elscreen-goto (- (aref candidate 1) (aref "0" 0)))))
8917         ("Kill Screen(s)" .
8918                           (lambda (candidate)
8919                             (dolist (i (anything-marked-candidates))
8920                               (elscreen-goto (- (aref i 1) (aref "0" 0)))
8921                               (elscreen-kill))))
8922         ("Only Screen" .
8923                        (lambda (candidate)
8924                          (elscreen-goto (- (aref candidate 1) (aref "0" 0)))
8925                          (elscreen-kill-others)))))))
8926
8927 \f
8928 ;;;; <System>
8929
8930 ;;; Top (process)
8931 (defvar anything-c-top-command "COLUMNS=%s top -b -n 1"
8932   "Top command (batch mode). %s is replaced with `frame-width'.")
8933 (defvar anything-c-source-top
8934   '((name . "Top (Press C-c C-u to refresh)")
8935     (init . anything-c-top-init)
8936     (candidates-in-buffer)
8937     (display-to-real . anything-c-top-display-to-real)
8938     (persistent-action . anything-c-top-sh-persistent-action)
8939     (persistent-help . "SIGTERM")
8940     (action
8941      ("kill (TERM)" . (lambda (pid)
8942                         (anything-c-top-sh (format "kill -TERM %s" pid))))
8943      ("kill (KILL)" . (lambda (pid)
8944                         (anything-c-top-sh (format "kill -KILL %s" pid))))
8945      ("Copy PID" . (lambda (pid) (kill-new pid))))))
8946
8947 (defun anything-c-top-sh (cmd)
8948   (message "Executed %s\n%s" cmd (shell-command-to-string cmd)))
8949
8950 (defun anything-c-top-sh-persistent-action (pid)
8951   (delete-other-windows)
8952   (anything-c-top-sh (format "kill -TERM %s" pid))
8953   (anything-force-update))
8954
8955 (defun anything-c-top-init ()
8956   (with-current-buffer (anything-candidate-buffer 'global)
8957     (call-process-shell-command
8958      (format anything-c-top-command
8959              (- (frame-width) (if anything-enable-digit-shortcuts 4 0)))
8960      nil (current-buffer))))
8961
8962 (defun anything-c-top-display-to-real (line)
8963   (car (split-string line)))
8964
8965 ;;; Timers
8966 (defvar anything-c-source-absolute-time-timers
8967   '((name . "Absolute Time Timers")
8968     (candidates . timer-list)
8969     (type . timer)))
8970
8971 (defvar anything-c-source-idle-time-timers
8972   '((name . "Idle Time Timers")
8973     (candidates . timer-idle-list)
8974     (type . timer)))
8975
8976 (defun anything-c-timer-real-to-display (timer)
8977   (destructuring-bind (triggered t1 t2 t3 repeat-delay func args idle-delay)
8978       (append timer nil)                ;use `append' to convert vector->list
8979     (format "%s repeat=%5S %s(%s)"
8980             (let ((time (list t1 t2 t3)))
8981               (if idle-delay
8982                   (format-time-string "idle-for=%5s" time)
8983                   (format-time-string "%m/%d %T" time)))
8984             repeat-delay
8985             func
8986             (mapconcat 'prin1-to-string args " "))))
8987
8988 ;;; X RandR resolution change
8989 ;;
8990 ;;
8991 ;;; FIXME I do not care multi-display.
8992
8993 (defun anything-c-xrandr-info ()
8994   "Return a pair with current X screen number and current X display name."
8995   (with-temp-buffer
8996     (call-process "xrandr" nil (current-buffer) nil
8997                   "--current")
8998     (let (screen output)
8999       (goto-char (point-min))
9000       (save-excursion
9001         (when (re-search-forward "\\(^Screen \\)\\([0-9]\\):" nil t)
9002           (setq screen (match-string 2))))
9003       (when (re-search-forward "^\\(.*\\) connected" nil t)
9004         (setq output (match-string 1)))
9005       (list screen output))))
9006
9007 (defun anything-c-xrandr-screen ()
9008   "Return current X screen number."
9009   (car (anything-c-xrandr-info)))
9010
9011 (defun anything-c-xrandr-output ()
9012   "Return current X display name."
9013   (cadr (anything-c-xrandr-info)))
9014
9015 (defvar anything-c-source-xrandr-change-resolution
9016   '((name . "Change Resolution")
9017     (candidates
9018      . (lambda ()
9019          (with-temp-buffer
9020            (call-process "xrandr" nil (current-buffer) nil
9021                          "--screen" (anything-c-xrandr-screen) "-q")
9022            (goto-char 1)
9023            (loop with modes = nil
9024                  while (re-search-forward "   \\([0-9]+x[0-9]+\\)" nil t)
9025                  for mode = (match-string 1)
9026                  unless (member mode modes)
9027                  collect mode into modes
9028                  finally return modes))))
9029     (action
9030      ("Change Resolution"
9031       . (lambda (mode)
9032           (call-process "xrandr" nil nil nil
9033                         "--screen" (anything-c-xrandr-screen)
9034                         "--output" (anything-c-xrandr-output)
9035                         "--mode" mode))))))
9036
9037 ;;; Xfont selection
9038 ;;
9039 ;;
9040 (defun anything-c-persistent-xfont-action (elm)
9041   "Show current font temporarily"
9042   (let ((current-font (cdr (assoc 'font (frame-parameters))))
9043         (default-font elm))
9044     (unwind-protect
9045          (progn (set-frame-font default-font 'keep-size) (sit-for 2))
9046       (set-frame-font current-font))))
9047
9048 (defvar anything-c-xfonts-cache nil)
9049 (defvar anything-c-source-xfonts
9050   '((name . "X Fonts")
9051     (init . (lambda ()
9052               (unless anything-c-xfonts-cache
9053                 (setq anything-c-xfonts-cache
9054                       (x-list-fonts "*")))))
9055     (candidates . anything-c-xfonts-cache)
9056     (action . (("Copy to kill ring" . (lambda (elm)
9057                                         (kill-new elm)))
9058                ("Set Font" . (lambda (elm)
9059                                (kill-new elm)
9060                                (set-frame-font elm 'keep-size)
9061                                (message "New font have been copied to kill ring")))))
9062     (persistent-action . anything-c-persistent-xfont-action)
9063     (persistent-help . "Switch to this font temporarily")))
9064
9065 ;;; 𝕌𝕔𝕤 𝕊𝕪𝕞𝕓𝕠𝕝 𝕔𝕠𝕞𝕡𝕝𝕖𝕥𝕚𝕠𝕟
9066 ;;
9067 ;;
9068 (defvar anything-c-ucs-max-len 0)
9069 (defun anything-c-calculate-ucs-max-len ()
9070   "Calculate the length of longest `ucs-names' candidate."
9071   (loop with count = 0
9072         for (n . v) in (ucs-names)
9073         for len = (length n)
9074         if (> len count)
9075         do (setq count len)
9076         finally return count))
9077
9078 (defun anything-c-ucs-init ()
9079   "Initialize an anything buffer with ucs symbols.
9080 Only math* symbols are collected."
9081   (unless (> anything-c-ucs-max-len 0)
9082     (setq anything-c-ucs-max-len
9083           (anything-c-calculate-ucs-max-len)))
9084   (with-current-buffer (anything-candidate-buffer
9085                         (get-buffer-create "*anything ucs*"))
9086     ;; `ucs-names' fn will not run again, data is cached in
9087     ;; var `ucs-names'.
9088     (loop for (n . v) in (ucs-names)
9089           for len = (length n)
9090           for diff = (+ (- anything-c-ucs-max-len len) 2)
9091           unless (string= "" n)
9092           do (progn (insert (concat
9093                              n ":"
9094                              (make-string
9095                               diff ? )))
9096                     (ucs-insert v)
9097                     (insert "\n")))))
9098
9099 (defun anything-c-ucs-forward-char (candidate)
9100   (with-anything-current-buffer
9101     (forward-char 1)))
9102
9103 (defun anything-c-ucs-backward-char (candidate)
9104   (with-anything-current-buffer
9105     (forward-char -1)))
9106
9107 (defun anything-c-ucs-delete-backward (candidate)
9108   (with-anything-current-buffer
9109     (delete-char -1)))
9110
9111 (defun anything-c-ucs-insert-char (candidate)
9112   (with-anything-current-buffer
9113     (insert
9114      (replace-regexp-in-string
9115       " " ""
9116       (cadr (split-string candidate ":"))))))
9117
9118 (defun anything-c-ucs-persistent-insert ()
9119   (interactive)
9120   (anything-attrset 'action-insert 'anything-c-ucs-insert-char)
9121   (anything-execute-persistent-action 'action-insert))
9122
9123 (defun anything-c-ucs-persistent-forward ()
9124   (interactive)
9125   (anything-attrset 'action-forward 'anything-c-ucs-forward-char)
9126   (anything-execute-persistent-action 'action-forward))
9127
9128 (defun anything-c-ucs-persistent-backward ()
9129   (interactive)
9130   (anything-attrset 'action-back 'anything-c-ucs-backward-char)
9131   (anything-execute-persistent-action 'action-back))
9132
9133 (defun anything-c-ucs-persistent-delete ()
9134   (interactive)
9135   (anything-attrset 'action-delete 'anything-c-ucs-delete-backward)
9136   (anything-execute-persistent-action 'action-delete))
9137
9138 (defvar anything-c-source-ucs
9139   '((name . "Ucs names")
9140     (init . anything-c-ucs-init)
9141     (candidate-number-limit . 9999)
9142     (candidates-in-buffer)
9143     (mode-line . anything-c-ucs-mode-line-string)
9144     (action . (("Insert" . anything-c-ucs-insert-char)
9145                ("Forward char" . anything-c-ucs-forward-char)
9146                ("Backward char" . anything-c-ucs-backward-char)
9147                ("Delete char backward" . anything-c-ucs-delete-backward))))
9148   "Source for collecting `ucs-names' math symbols.")
9149
9150
9151 ;;; Emacs process
9152 ;;
9153 ;;
9154 (defvar anything-c-source-emacs-process
9155   '((name . "Emacs Process")
9156     (candidates . (lambda () (mapcar #'process-name (process-list))))
9157     (persistent-action . (lambda (elm)
9158                            (delete-process (get-process elm))
9159                            (anything-delete-current-selection)))
9160     (persistent-help . "Kill Process")
9161     (action ("Kill Process" . (lambda (elm)
9162                                 (delete-process (get-process elm)))))))
9163
9164 ;;; World time
9165 ;;
9166 ;;
9167 (defvar anything-c-source-time-world
9168   '((name . "Time World List")
9169     (init . (lambda ()
9170               (let ((anything-buffer (anything-candidate-buffer 'global)))
9171                 (with-current-buffer anything-buffer
9172                   (display-time-world-display display-time-world-list)))))
9173     (candidates-in-buffer)))
9174
9175
9176 \f
9177 ;;; Anything interface for Debian/Ubuntu packages (apt-*)
9178 ;;
9179 ;;
9180 (defvar anything-c-source-apt
9181   '((name . "APT")
9182     (init . anything-c-apt-init)
9183     (candidates-in-buffer)
9184     (candidate-transformer anything-c-apt-candidate-transformer)
9185     (display-to-real . anything-c-apt-display-to-real)
9186     (requires-pattern . 2)
9187     (update . anything-c-apt-refresh)
9188     (action
9189      ("Show package description" . anything-c-apt-cache-show)
9190      ("Install package" . anything-c-apt-install)
9191      ("Reinstall package" . anything-c-apt-reinstall)
9192      ("Remove package" . anything-c-apt-uninstall)
9193      ("Purge package" . anything-c-apt-purge))
9194     (persistent-action . anything-c-apt-persistent-action)
9195     (persistent-help . "Show package description")))
9196
9197 (defvar anything-c-apt-query "emacs")
9198 (defvar anything-c-apt-search-command "apt-cache search '%s'")
9199 (defvar anything-c-apt-show-command "apt-cache show '%s'")
9200 (defvar anything-c-apt-installed-packages nil)
9201 (defvar anything-c-apt-all-packages nil)
9202 (defvar anything-c-apt-input-history nil)
9203
9204 (defun anything-c-apt-refresh ()
9205   "Refresh installed candidates list."
9206   (setq anything-c-apt-installed-packages nil)
9207   (setq anything-c-apt-all-packages nil))
9208
9209 (defun anything-c-apt-persistent-action (candidate)
9210   "Persistent action for APT source."
9211   (anything-c-apt-cache-show candidate))
9212
9213 (defun anything-c-apt-candidate-transformer (candidates)
9214   "Show installed CANDIDATES and the ones to deinstall in a different color."
9215   (loop for cand in candidates
9216         for name = (anything-c-apt-display-to-real cand)
9217         collect (cond ((string= (assoc-default
9218                                  name anything-c-apt-installed-packages)
9219                                 "deinstall")
9220                        (propertize cand 'face 'anything-apt-deinstalled))
9221                       ((string= (assoc-default
9222                                  name anything-c-apt-installed-packages)
9223                                 "install")
9224                        (propertize cand 'face 'anything-apt-installed))
9225                       (t cand))))
9226
9227 (defun anything-c-apt-init ()
9228   "Initialize list of debian packages."
9229   (let ((query ""))
9230     (unless (and anything-c-apt-installed-packages
9231                  anything-c-apt-all-packages)
9232       (message "Loading package list...")
9233       (setq anything-c-apt-installed-packages
9234             (with-temp-buffer
9235               (call-process-shell-command "dpkg --get-selections"
9236                                           nil (current-buffer))
9237               (loop for i in (split-string (buffer-string) "\n" t)
9238                     for p = (split-string i)
9239                     collect (cons (car p) (cadr p)))))
9240       (setq anything-c-apt-all-packages
9241             (with-current-buffer
9242                 (anything-candidate-buffer
9243                  (get-buffer-create (format "*anything-apt*")))
9244               (erase-buffer)
9245               (call-process-shell-command
9246                (format anything-c-apt-search-command query)
9247                nil (current-buffer))))
9248       (message "Loading package list done")
9249       (sit-for 0.5))))
9250
9251 (defun anything-c-apt-display-to-real (line)
9252   "Return only name of a debian package.
9253 LINE is displayed like:
9254 package name - description."
9255   (car (split-string line " - ")))
9256
9257 (defun anything-c-shell-command-if-needed (command)
9258   "Run shell command COMMAND to describe package.
9259 If a buffer named COMMAND already exists, just switch to it."
9260   (let ((buf (get-buffer command)))
9261     (anything-c-switch-to-buffer (get-buffer-create command))
9262     (unless buf (insert (shell-command-to-string command)))))
9263
9264 (defun anything-c-apt-cache-show (package)
9265   "Show information on apt package PACKAGE."
9266   (anything-c-shell-command-if-needed
9267    (format anything-c-apt-show-command package)))
9268
9269 (defun anything-c-apt-install (package)
9270   "Run 'apt-get install' shell command on PACKAGE."
9271   (anything-c-apt-generic-action :action 'install))
9272
9273 (defun anything-c-apt-reinstall (package)
9274   "Run 'apt-get install --reinstall' shell command on PACKAGE."
9275   (anything-c-apt-generic-action :action 'reinstall))
9276
9277 (defun anything-c-apt-uninstall (package)
9278   "Run 'apt-get remove' shell command on PACKAGE."
9279   (anything-c-apt-generic-action :action 'uninstall))
9280
9281 (defun anything-c-apt-purge (package)
9282   "Run 'apt-get purge' shell command on PACKAGE."
9283   (anything-c-apt-generic-action :action 'purge))
9284
9285 (defun* anything-c-apt-generic-action (&key action)
9286   "Run 'apt-get ACTION'.
9287 Support install, remove and purge actions."
9288   (ansi-term (getenv "SHELL") "anything apt")
9289   (term-line-mode)
9290   (let ((command   (case action
9291                      ('install   "sudo apt-get install ")
9292                      ('reinstall "sudo apt-get install --reinstall ")
9293                      ('uninstall "sudo apt-get remove ")
9294                      ('purge     "sudo apt-get purge ")
9295                      (t          (error "Unknow action"))))
9296         (beg       (point))
9297         end
9298         (cand-list (mapconcat #'(lambda (x) (format "'%s'" x))
9299                               (anything-marked-candidates) " ")))
9300     (goto-char (point-max))
9301     (insert (concat command cand-list))
9302     (setq end (point))
9303     (if (y-or-n-p (format "%s package" (symbol-name action)))
9304         (progn
9305           (setq anything-c-external-commands-list nil)
9306           (setq anything-c-apt-installed-packages nil)
9307           (term-char-mode) (term-send-input))
9308         (delete-region beg end) (term-send-eof) (kill-buffer))))
9309
9310 ;; (anything-c-apt-install "jed")
9311
9312 \f
9313 ;;; Anything UI for gentoo portage.
9314 ;;
9315 ;;
9316 (defvar anything-c-gentoo-use-flags nil)
9317 (defvar anything-c-gentoo-buffer "*anything-gentoo-output*")
9318 (defvar anything-c-cache-gentoo nil)
9319 (defvar anything-c-cache-world nil)
9320 (defvar anything-c-source-gentoo
9321   '((name . "Portage sources")
9322     (init . (lambda ()
9323               (get-buffer-create anything-c-gentoo-buffer)
9324               (unless anything-c-cache-gentoo
9325                 (anything-c-gentoo-setup-cache))
9326               (unless anything-c-cache-world
9327                 (setq anything-c-cache-world (anything-c-gentoo-get-world)))
9328               (anything-c-gentoo-init-list)))
9329     (candidates-in-buffer)
9330     (match . identity)
9331     (candidate-transformer anything-c-highlight-world)
9332     (action . (("Show package" . (lambda (elm)
9333                                    (anything-c-gentoo-eshell-action elm "eix")))
9334                ("Show history" . (lambda (elm)
9335                                    (if (member elm anything-c-cache-world)
9336                                        (anything-c-gentoo-eshell-action elm "genlop -qe")
9337                                        (message "No infos on packages not yet installed"))))
9338                ("Copy in kill-ring" . kill-new)
9339                ("insert at point" . insert)
9340                ("Browse HomePage" . (lambda (elm)
9341                                       (let ((urls (anything-c-gentoo-get-url elm)))
9342                                         (browse-url (anything-comp-read "Url: " urls :must-match t)))))
9343                ("Show extra infos" . (lambda (elm)
9344                                        (if (member elm anything-c-cache-world)
9345                                            (anything-c-gentoo-eshell-action elm "genlop -qi")
9346                                            (message "No infos on packages not yet installed"))))
9347                ("Show use flags" . (lambda (elm)
9348                                      (anything-c-gentoo-default-action elm "equery" "-C" "u")
9349                                      (font-lock-add-keywords nil '(("^\+.*" . font-lock-variable-name-face)))
9350                                      (font-lock-mode 1)))
9351                ("Run emerge pretend" . (lambda (elm)
9352                                          (anything-c-gentoo-eshell-action elm "emerge -p")))
9353                ("Emerge" . (lambda (elm)
9354                              (anything-gentoo-install elm :action 'install)))
9355                ("Unmerge" . (lambda (elm)
9356                               (anything-gentoo-install elm :action 'uninstall)))
9357                ("Show dependencies" . (lambda (elm)
9358                                         (anything-c-gentoo-default-action elm "equery" "-C" "d")))
9359                ("Show related files" . (lambda (elm)
9360                                          (anything-c-gentoo-default-action elm "equery" "files")))
9361                ("Refresh" . (lambda (elm)
9362                               (anything-c-gentoo-setup-cache)
9363                               (setq anything-c-cache-world (anything-c-gentoo-get-world))))))))
9364
9365
9366 (defun* anything-gentoo-install (candidate &key action)
9367   (setq anything-c-external-commands-list nil)
9368   (ansi-term (getenv "SHELL") "Gentoo emerge")
9369   (term-line-mode)
9370   (let ((command (case action
9371                    ('install "sudo emerge -av ")
9372                    ('uninstall "sudo emerge -avC ")
9373                    (t (error "Unknow action"))))
9374         (elms (mapconcat 'identity (anything-marked-candidates) " "))
9375         (beg (point)) end)
9376     (goto-char (point-max))
9377     (insert (concat command elms))
9378     (setq end (point))
9379     (term-char-mode) (term-send-input)))
9380
9381 (defun anything-c-gentoo-default-action (elm command &rest args)
9382   "Gentoo default action that use `anything-c-gentoo-buffer'."
9383   (if (member elm anything-c-cache-world)
9384       (progn
9385         (anything-c-switch-to-buffer anything-c-gentoo-buffer)
9386         (erase-buffer)
9387         (let ((com-list (append args (list elm))))
9388           (apply #'call-process command nil t nil
9389                  com-list)))
9390       (message "No infos on packages not yet installed")))
9391
9392 (defvar anything-c-source-use-flags
9393   '((name . "Use Flags")
9394     (init . (lambda ()
9395               (unless anything-c-gentoo-use-flags
9396                 (anything-c-gentoo-setup-use-flags-cache))
9397               (anything-c-gentoo-get-use)))
9398     (candidates-in-buffer)
9399     (match . identity)
9400     (candidate-transformer anything-c-highlight-local-use)
9401     (action . (("Description"
9402                 . (lambda (elm)
9403                     (anything-c-switch-to-buffer anything-c-gentoo-buffer)
9404                     (erase-buffer)
9405                     (apply #'call-process "euse" nil t nil
9406                            `("-i"
9407                              ,elm))
9408                     (font-lock-add-keywords nil `((,elm . font-lock-variable-name-face)))
9409                     (font-lock-mode 1)))
9410                ("Enable"
9411                 . (lambda (elm)
9412                     (anything-c-gentoo-eshell-action elm "*sudo -p Password: euse -E")))
9413                ("Disable"
9414                 . (lambda (elm)
9415                     (anything-c-gentoo-eshell-action elm "*sudo -p Password: euse -D")))
9416                ("Remove"
9417                 . (lambda (elm)
9418                     (anything-c-gentoo-eshell-action elm "*sudo -p Password: euse -P")))
9419                ("Show which dep use this flag"
9420                 . (lambda (elm)
9421                     (anything-c-switch-to-buffer anything-c-gentoo-buffer)
9422                     (erase-buffer)
9423                     (apply #'call-process "equery" nil t nil
9424                            `("-C"
9425                              "h"
9426                              ,elm))))))))
9427
9428
9429
9430 (defun anything-c-gentoo-init-list ()
9431   "Initialize buffer with all packages in Portage."
9432   (let* ((portage-buf (get-buffer-create "*anything-gentoo*"))
9433          (buf (anything-candidate-buffer 'portage-buf)))
9434     (with-current-buffer buf
9435       (dolist (i anything-c-cache-gentoo)
9436         (insert (concat i "\n"))))))
9437
9438 (defun anything-c-gentoo-setup-cache ()
9439   "Set up `anything-c-cache-gentoo'"
9440   (setq anything-c-cache-gentoo
9441         (split-string (with-temp-buffer
9442                         (call-process "eix" nil t nil
9443                                       "--only-names")
9444                         (buffer-string)))))
9445
9446 (defun anything-c-gentoo-eshell-action (elm command)
9447   (when (get-buffer "*EShell Command Output*")
9448     (kill-buffer "*EShell Command Output*"))
9449   (message "Wait searching...")
9450   (let ((buf-fname (buffer-file-name anything-current-buffer)))
9451     (if (and buf-fname (string-match tramp-file-name-regexp buf-fname))
9452         (progn
9453           (save-window-excursion
9454             (pop-to-buffer "*scratch*")
9455             (eshell-command (format "%s %s" command elm)))
9456           (pop-to-buffer "*EShell Command Output*"))
9457         (eshell-command (format "%s %s" command elm)))))
9458
9459 (defun anything-c-gentoo-get-use ()
9460   "Initialize buffer with all use flags."
9461   (let* ((use-buf (get-buffer-create "*anything-gentoo-use*"))
9462          (buf (anything-candidate-buffer 'use-buf)))
9463     (with-current-buffer buf
9464       (dolist (i anything-c-gentoo-use-flags)
9465         (insert (concat i "\n"))))))
9466
9467
9468 (defun anything-c-gentoo-setup-use-flags-cache ()
9469   "Setup `anything-c-gentoo-use-flags'"
9470   (setq anything-c-gentoo-use-flags
9471         (split-string (with-temp-buffer
9472                         (call-process "eix" nil t nil
9473                                       "--print-all-useflags")
9474                         (buffer-string)))))
9475
9476 (defun anything-c-gentoo-get-url (elm)
9477   "Return a list of urls from eix output."
9478   (loop
9479         with url-list = (split-string
9480                          (with-temp-buffer
9481                            (call-process "eix" nil t nil
9482                                          elm "--format" "<homepage>\n")
9483                            (buffer-string)))
9484         with all
9485         for i in url-list
9486         when (and (string-match "^http://.*" i)
9487                   (not (member i all)))
9488         collect i into all
9489         finally return all))
9490
9491 (defun anything-c-gentoo-get-world ()
9492   "Return list of all installed package on your system."
9493   (split-string (with-temp-buffer
9494                   (call-process "qlist" nil t nil
9495                                 "-I")
9496                   (buffer-string))))
9497
9498 (defun anything-c-gentoo-get-local-use ()
9499   (split-string (with-temp-buffer
9500                   (call-process "portageq" nil t nil
9501                                 "envvar"
9502                                 "USE")
9503                   (buffer-string))))
9504
9505
9506 (defun anything-c-highlight-world (eix)
9507   "Highlight all installed package."
9508   (loop for i in eix
9509         if (member i anything-c-cache-world)
9510         collect (propertize i 'face 'anything-gentoo-match-face)
9511         else
9512         collect i))
9513
9514 (defun anything-c-highlight-local-use (use-flags)
9515   (let ((local-uses (anything-c-gentoo-get-local-use)))
9516     (loop for i in use-flags
9517           if (member i local-uses)
9518           collect (propertize i 'face 'anything-gentoo-match-face)
9519           else
9520           collect i)))
9521
9522
9523 \f
9524 ;;; Anything ratpoison UI
9525 ;;
9526 ;;
9527 (defvar anything-c-source-ratpoison-commands
9528   '((name . "Ratpoison Commands")
9529     (init . anything-c-ratpoison-commands-init)
9530     (candidates-in-buffer)
9531     (action ("Execute the command" . anything-c-ratpoison-commands-execute))
9532     (display-to-real . anything-c-ratpoison-commands-display-to-real)
9533     (candidate-number-limit)))
9534
9535 (defun anything-c-ratpoison-commands-init ()
9536   (unless (anything-candidate-buffer)
9537     (with-current-buffer (anything-candidate-buffer 'global)
9538       ;; with ratpoison prefix key
9539       (save-excursion
9540         (call-process "ratpoison" nil (current-buffer) nil "-c" "help"))
9541       (while (re-search-forward "^\\([^ ]+\\) \\(.+\\)$" nil t)
9542         (replace-match "<ratpoison> \\1: \\2"))
9543       (goto-char (point-max))
9544       ;; direct binding
9545       (save-excursion
9546         (call-process "ratpoison" nil (current-buffer) nil "-c" "help top"))
9547       (while (re-search-forward "^\\([^ ]+\\) \\(.+\\)$" nil t)
9548         (replace-match "\\1: \\2")))))
9549
9550 (defun anything-c-ratpoison-commands-display-to-real (display)
9551   (and (string-match ": " display)
9552        (substring display (match-end 0))))
9553
9554 (defun anything-c-ratpoison-commands-execute (candidate)
9555   (call-process "ratpoison" nil nil nil "-ic" candidate))
9556
9557
9558 \f
9559 ;;; Anything `completing-read' replacement
9560 ;;
9561 ;;
9562 (defun anything-comp-read-get-candidates (collection &optional test sort-fn alistp)
9563   "Convert COLLECTION to list removing elements that don't match TEST.
9564 See `anything-comp-read' about supported COLLECTION arguments.
9565
9566 SORT-FN is a predicate to sort COLLECTION.
9567
9568 ALISTP when non--nil will not use `all-completions' to collect
9569 candidates because it doesn't handle alists correctly for anything.
9570 i.e In `all-completions' the keys \(cars of elements\)
9571 are the possible completions. In anything we want to use the cdr instead
9572 like \(display . real\).
9573
9574 e.g
9575
9576 \(setq A '((a . 1) (b . 2) (c . 3)))
9577 ==>((a . 1) (b . 2) (c . 3))
9578 \(anything-comp-read \"test: \" A :alistp nil
9579                                   :exec-when-only-one t
9580                                   :initial-input \"a\")
9581 ==>\"a\"
9582 \(anything-comp-read \"test: \" A :alistp t
9583                                   :exec-when-only-one t
9584                                   :initial-input \"1\")
9585 ==>\"1\"
9586
9587 See docstring of `all-completions' for more info.
9588
9589 If COLLECTION is an `obarray', a TEST should be needed. See `obarray'."
9590   (let ((cands
9591          (cond ((and (eq collection obarray) test)
9592                 (all-completions "" collection test))
9593                ((and (vectorp collection) test)
9594                 (loop for i across collection when (funcall test i) collect i))
9595                ((vectorp collection)
9596                 (loop for i across collection collect i))
9597                ((and alistp test)
9598                 (loop for i in collection when (funcall test i) collect i))
9599                ((and (symbolp collection) (boundp collection))
9600                 (symbol-value collection))
9601                (alistp collection)
9602                ((and collection test)
9603                 (all-completions "" collection test))
9604                (t (all-completions "" collection)))))
9605     (if sort-fn (sort cands sort-fn) cands)))
9606
9607 (defun anything-cr-default-transformer (candidates source)
9608   "Default filter candidate function for `anything-comp-read'.
9609 Do nothing, just return candidate list unmodified."
9610   candidates)
9611
9612 (defun* anything-comp-read (prompt collection
9613                                    &key
9614                                    test
9615                                    initial-input
9616                                    default
9617                                    preselect
9618                                    (buffer "*Anything Completions*")
9619                                    must-match
9620                                    (requires-pattern 0)
9621                                    (history nil)
9622                                    input-history
9623                                    (persistent-action nil)
9624                                    (persistent-help "DoNothing")
9625                                    (mode-line anything-mode-line-string)
9626                                    (keymap anything-map)
9627                                    (name "Anything Completions")
9628                                    candidates-in-buffer
9629                                    exec-when-only-one
9630                                    (volatile t)
9631                                    sort
9632                                    (fc-transformer 'anything-cr-default-transformer)
9633                                    (marked-candidates nil)
9634                                    (alistp t))
9635   "Read a string in the minibuffer, with anything completion.
9636
9637 It is anything `completing-read' equivalent.
9638
9639 - PROMPT is the prompt name to use.
9640
9641 - COLLECTION can be a list, vector, obarray or hash-table.
9642   It can be also a function that receives three arguments:
9643   the values string, predicate and t. See `all-completions' for more details.
9644
9645 Keys description:
9646
9647 - TEST: A predicate called with one arg i.e candidate.
9648
9649 - INITIAL-INPUT: Same as input arg in `anything'.
9650
9651 - PRESELECT: See preselect arg of `anything'.
9652
9653 - DEFAULT: This option is used only for compatibility with regular
9654   Emacs `completing-read'.
9655
9656 - BUFFER: Name of anything-buffer.
9657
9658 - MUST-MATCH: Candidate selected must be one of COLLECTION.
9659
9660 - REQUIRES-PATTERN: Same as anything attribute, default is 0.
9661
9662 - HISTORY: A list containing specific history, default is nil.
9663   When it is non--nil, all elements of HISTORY are displayed in
9664   a special source before COLLECTION.
9665
9666 - INPUT-HISTORY: A symbol. the minibuffer input history will be
9667   stored there, if nil or not provided, `minibuffer-history'
9668   will be used instead.
9669
9670 - PERSISTENT-ACTION: A function called with one arg i.e candidate.
9671
9672 - PERSISTENT-HELP: A string to document PERSISTENT-ACTION.
9673
9674 - MODE-LINE: A string or list to display in mode line.
9675   (See `anything-mode-line-string')
9676
9677 - KEYMAP: A keymap to use in this `anything-comp-read'.
9678   (The keymap will be shared with history source)
9679
9680 - NAME: The name related to this local source.
9681
9682 - EXEC-WHEN-ONLY-ONE: Bound `anything-execute-action-at-once-if-one'
9683   to non--nil. (possibles values are t or nil).
9684
9685 - VOLATILE: Use volatile attribute \(enabled by default\).
9686
9687 - SORT: A predicate to give to `sort' e.g `string-lessp'.
9688
9689 - FC-TRANSFORMER: A `filtered-candidate-transformer' function.
9690
9691 - MARKED-CANDIDATES: If non--nil return candidate or marked candidates as a list.
9692
9693 - ALISTP: \(default is non--nil\) See `anything-comp-read-get-candidates'.
9694
9695 - CANDIDATES-IN-BUFFER: when non--nil use a source build with
9696   `anything-candidates-in-buffer' which is much faster.
9697   Argument VOLATILE have no effect when CANDIDATES-IN-BUFFER is non--nil.
9698
9699 Any prefix args passed during `anything-comp-read' invocation will be recorded
9700 in `anything-current-prefix-arg', otherwise if prefix args were given before
9701 `anything-comp-read' invocation, the value of `current-prefix-arg' will be used.
9702 That's mean you can pass prefix args before or after calling a command
9703 that use `anything-comp-read' See `anything-M-x' for example."
9704   (when (get-buffer anything-action-buffer)
9705     (kill-buffer anything-action-buffer))
9706   (flet ((action-fn (candidate)
9707            (if marked-candidates
9708                (anything-marked-candidates)
9709                (identity candidate))))
9710     ;; Assume completion have been already required,
9711     ;; so always use 'confirm.
9712     (when (eq must-match 'confirm-after-completion)
9713       (setq must-match 'confirm))
9714     (let* ((minibuffer-completion-confirm must-match)
9715            (must-match-map (when must-match
9716                              (let ((map (make-sparse-keymap)))
9717                                (define-key map (kbd "RET")
9718                                  'anything-confirm-and-exit-minibuffer)
9719                                map)))
9720            (anything-map (if must-match-map
9721                              (make-composed-keymap
9722                               must-match-map (or keymap anything-map))
9723                              (or keymap anything-map)))
9724            (src-hist `((name . ,(format "%s History" name))
9725                        (candidates
9726                         . (lambda ()
9727                             (let ((all (anything-comp-read-get-candidates
9728                                         history nil nil ,alistp)))
9729                               (delete
9730                                ""
9731                                (anything-fast-remove-dups
9732                                 (if (and default (not (string= default "")))
9733                                     (delq nil (cons default
9734                                                     (delete default all)))
9735                                     all)
9736                                 :test 'equal)))))
9737                        (filtered-candidate-transformer
9738                         . (lambda (candidates sources)
9739                             (loop for i in candidates
9740                                   do (set-text-properties 0 (length i) nil i)
9741                                   collect i)))
9742                        (persistent-action . ,persistent-action)
9743                        (persistent-help . ,persistent-help)
9744                        (mode-line . ,mode-line)
9745                        (action . ,'action-fn)))
9746            (src `((name . ,name)
9747                   (candidates
9748                    . (lambda ()
9749                        (let ((cands (anything-comp-read-get-candidates
9750                                      collection test sort alistp)))
9751                          (unless (or must-match (string= anything-pattern ""))
9752                            (setq cands (append (list anything-pattern) cands)))
9753                          (if (and default (not (string= default "")))
9754                              (delq nil (cons default (delete default cands)))
9755                              cands))))
9756                   (filtered-candidate-transformer ,fc-transformer)
9757                   (requires-pattern . ,requires-pattern)
9758                   (persistent-action . ,persistent-action)
9759                   (persistent-help . ,persistent-help)
9760                   (mode-line . ,mode-line)
9761                   (action . ,'action-fn)))
9762            (src-1 `((name . ,name)
9763                     (init
9764                      . (lambda ()
9765                          (let ((cands (anything-comp-read-get-candidates
9766                                        collection test sort alistp)))
9767                            (unless (or must-match (string= anything-pattern ""))
9768                              (setq cands (append (list anything-pattern) cands)))
9769                            (with-current-buffer (anything-candidate-buffer 'global)
9770                              (loop for i in
9771                                    (if (and default (not (string= default "")))
9772                                        (delq nil (cons default (delete default cands)))
9773                                        cands)
9774                                    do (insert (concat i "\n")))))))
9775                     (candidates-in-buffer)
9776                     (filtered-candidate-transformer ,fc-transformer)
9777                     (requires-pattern . ,requires-pattern)
9778                     (persistent-action . ,persistent-action)
9779                     (persistent-help . ,persistent-help)
9780                     (mode-line . ,mode-line)
9781                     (action . ,'action-fn)))
9782            (src-list (list src-hist
9783                            (if candidates-in-buffer
9784                                src-1
9785                                (if volatile
9786                                    (append src '((volatile)))
9787                                    src))))
9788            (anything-execute-action-at-once-if-one exec-when-only-one))
9789       (or
9790        (anything
9791         :sources src-list
9792         :input initial-input
9793         :default default
9794         :preselect preselect
9795         :prompt prompt
9796         :resume 'noresume
9797         :keymap anything-map
9798         :history (and (symbolp input-history) input-history)
9799         :buffer buffer)
9800        (when (and (eq anything-exit-status 0)
9801                   (eq must-match 'confirm))
9802          ;; Return empty string only if it is the DEFAULT
9803          ;; value and anything-pattern is empty.
9804          ;; otherwise return anything-pattern
9805          (if (and (string= anything-pattern "") default)
9806              default (identity anything-pattern)))
9807        (unless (or (eq anything-exit-status 1)
9808                    must-match) ; FIXME this should not be needed now.
9809          default)
9810        (keyboard-quit)))))
9811
9812 ;; Generic completing-read
9813 ;;
9814 ;; Support also function as collection.
9815 ;; e.g M-x man is supported.
9816 ;; Support hash-table and vectors as collection.
9817 ;; NOTE:
9818 ;; Some crap emacs functions may not be supported
9819 ;; like ffap-alternate-file (bad use of completing-read)
9820 ;; and maybe others.
9821 ;; Provide a mode `anything-completion-mode' which turn on
9822 ;; anything in all `completing-read' and `read-file-name' in Emacs.
9823 ;;
9824 (defvar anything-completion-mode-string " AC")
9825
9826 (defvar anything-completion-mode-quit-message
9827   "Anything completion disabled")
9828
9829 (defvar anything-completion-mode-start-message
9830   "Anything completion enabled")
9831
9832 ;;; Specialized handlers
9833 ;;
9834 ;;
9835 (defun anything-completing-read-symbols
9836     (prompt collection test require-match init
9837      hist default inherit-input-method name buffer)
9838   "Specialized function for fast symbols completion in `ac-mode'."
9839   (or
9840    (anything
9841     :sources `((name . ,name)
9842                (init . (lambda ()
9843                          (with-current-buffer (anything-candidate-buffer 'global)
9844                            (goto-char (point-min))
9845                            (when (and default (stringp default)
9846                                       ;; Some defaults args result as
9847                                       ;; (symbol-name nil) == "nil".
9848                                       ;; e.g debug-on-entry.
9849                                       (not (string= default "nil"))
9850                                       (not (string= default "")))
9851                              (insert (concat default "\n")))
9852                            (loop with all = (all-completions "" collection test)
9853                                  for sym in all
9854                                  unless (and default (eq sym default))
9855                                  do (insert (concat sym "\n"))))))
9856                (persistent-action . anything-lisp-completion-persistent-action)
9857                (persistent-help . "Show brief doc in mode-line")
9858                (candidates-in-buffer)
9859                (action . identity))
9860     :prompt prompt
9861     :buffer buffer
9862     :input init
9863     :history hist
9864     :resume 'noresume
9865     :default (or default ""))
9866    (keyboard-quit)))
9867
9868
9869 ;;; Generic completing read
9870 ;;
9871 ;;
9872 (defun anything-completing-read-default-1
9873     (prompt collection test require-match
9874      init hist default inherit-input-method
9875      name buffer &optional cands-in-buffer exec-when-only-one)
9876   "Call `anything-comp-read' with same args as `completing-read'.
9877 Extra optional arg CANDS-IN-BUFFER mean use `candidates-in-buffer'
9878 method which is faster.
9879 It should be used when candidate list don't need to rebuild dynamically."
9880   (let ((history (or (car-safe hist) hist)))
9881     (anything-comp-read
9882      prompt collection
9883      :test test
9884      :history history
9885      :input-history history
9886      :must-match require-match
9887      :alistp nil ; Be sure `all-completions' is used.
9888      :name name
9889      :requires-pattern (if (and (string= default "")
9890                                 (or (eq require-match 'confirm)
9891                                     (eq require-match
9892                                         'confirm-after-completion)))
9893                            1 0)
9894      :candidates-in-buffer cands-in-buffer
9895      :exec-when-only-one exec-when-only-one
9896      :buffer buffer
9897      ;; If DEF is not provided, fallback to empty string
9898      ;; to avoid `thing-at-point' to be appended on top of list
9899      :default (or default "")
9900      ;; Use `regexp-quote' to fix initial input
9901      ;; with special characters (e.g nnimap+gmail:)
9902      :initial-input (and (stringp init) (regexp-quote init)))))
9903
9904 (defun anything-completing-read-with-cands-in-buffer
9905     (prompt collection test require-match
9906      init hist default inherit-input-method
9907      name buffer)
9908   "Same as `anything-completing-read-default-1' but use candidates-in-buffer."
9909   ;; Some commands like find-tag may use `read-file-name' from inside
9910   ;; the calculation of collection. in this case it clash with
9911   ;; candidates-in-buffer that reuse precedent data (files) which is wrong.
9912   ;; So (re)calculate collection outside of main anything-session.
9913   (let ((cands (all-completions "" collection)))
9914     (anything-completing-read-default-1 prompt cands test require-match
9915                                         init hist default inherit-input-method
9916                                         name buffer t)))
9917
9918 (defun* anything-completing-read-default
9919     (prompt collection &optional
9920             predicate require-match
9921             initial-input hist def
9922             inherit-input-method)
9923   "An anything replacement of `completing-read'.
9924 This function should be used only as a `completing-read-function'.
9925
9926 Don't use it directly, use instead `anything-comp-read' in your programs.
9927
9928 See documentation of `completing-read' and `all-completions' for details."
9929   (declare (special anything-completion-mode))
9930   (let* ((current-command this-command)
9931          (str-command     (symbol-name current-command))
9932          (buf-name        (format "*ac-mode-%s*" str-command))
9933          (entry           (assq current-command
9934                                 anything-completing-read-handlers-alist))
9935          (def-com         (cdr-safe entry))
9936          (str-defcom      (and def-com (symbol-name def-com)))
9937          (def-args        (list prompt collection predicate require-match
9938                                 initial-input hist def inherit-input-method))
9939          ;; Append the two extra args needed to set the buffer and source name
9940          ;; in anything specialized functions.
9941          (any-args        (append def-args (list str-command buf-name)))
9942          anything-completion-mode-start-message ; Be quiet
9943          anything-completion-mode-quit-message
9944          (minibuffer-completion-table collection)
9945          (minibuffer-completion-predicate predicate)
9946          ;; Be sure this pesty *completion* buffer doesn't popup.
9947          (minibuffer-setup-hook (remove 'minibuffer-completion-help
9948                                         minibuffer-setup-hook)))
9949     (when (eq def-com 'ido) (setq def-com 'ido-completing-read))
9950     (unless (or (not entry) def-com)
9951       ;; An entry in *read-handlers-alist exists but have
9952       ;; a nil value, so we exit from here, disable `ac-mode'
9953       ;; and run the command again with it original behavior.
9954       ;; `ac-mode' will be restored on exit.
9955       (return-from anything-completing-read-default
9956         (unwind-protect
9957              (progn
9958                (ac-mode -1)
9959                (apply completing-read-function def-args))
9960           (ac-mode 1))))
9961     ;; If we use now `completing-read' we MUST turn off `ac-mode'
9962     ;; to avoid infinite recursion and CRASH. It will be reenabled on exit.
9963     (when (or (eq def-com 'completing-read)
9964               ;; All specialized functions are prefixed by "anything"
9965               (and (stringp str-defcom)
9966                    (not (string-match "^anything" str-defcom))))
9967       (ac-mode -1))
9968     (unwind-protect
9969          (cond (;; An anything specialized function exists, run it.
9970                 (and def-com anything-completion-mode)
9971                 (apply def-com any-args))
9972                (;; Try to handle `ido-completing-read' everywhere.
9973                 (and def-com (eq def-com 'ido-completing-read))
9974                 (setcar (memq collection def-args)
9975                         (all-completions "" collection predicate))
9976                 (apply def-com def-args))
9977                (;; User set explicitely `completing-read' or something similar
9978                 ;; in *read-handlers-alist, use this with exactly the same
9979                 ;; args as in `completing-read'.
9980                 ;; If we are here `anything-completion-mode' is now disabled.
9981                 def-com
9982                 (apply def-com def-args))
9983                (t ; Fall back to classic `anything-comp-read'.
9984                 (anything-completing-read-default-1
9985                  prompt collection predicate require-match
9986                  initial-input hist def inherit-input-method
9987                  str-command buf-name)))
9988       (ac-mode 1)
9989       ;; When exiting minibuffer, `this-command' is set to
9990       ;; `anything-exit-minibuffer', which is unwanted when starting
9991       ;; on another `completing-read', so restore `this-command' to
9992       ;; initial value when exiting.
9993       (setq this-command current-command))))
9994
9995 (defun* anything-generic-read-file-name
9996     (prompt &optional dir default-filename mustmatch initial predicate)
9997   "An anything replacement of `read-file-name'."
9998   (declare (special anything-completion-mode))
9999   (let* ((default (and default-filename
10000                        (if (listp default-filename)
10001                            (car default-filename)
10002                            default-filename)))
10003          (init (or default initial dir default-directory))
10004          (ini-input (and init (expand-file-name init)))
10005          (current-command this-command)
10006          (str-command (symbol-name current-command))
10007          (anything-file-completion-sources
10008           (cons str-command
10009                 (remove str-command anything-file-completion-sources)))
10010          (buf-name (format "*ac-mode-%s*" str-command))
10011          (entry (assq current-command
10012                       anything-completing-read-handlers-alist))
10013          (def-com  (cdr-safe entry))
10014          (str-defcom (symbol-name def-com))
10015          (def-args (list prompt dir default-filename mustmatch initial predicate))
10016          ;; Append the two extra args needed to set the buffer and source name
10017          ;; in anything specialized functions.
10018          (any-args (append def-args (list str-command buf-name)))
10019          (ido-state ido-mode)
10020          anything-completion-mode-start-message ; Be quiet
10021          anything-completion-mode-quit-message  ; Same here
10022          fname)
10023     ;; Some functions that normally call `completing-read' can switch
10024     ;; brutally to `read-file-name' (e.g find-tag), in this case
10025     ;; the anything specialized function will fail because it is build
10026     ;; for `completing-read', so set it to 'incompatible to be sure
10027     ;; we switch to `anything-c-read-file-name' and don't try to call it
10028     ;; with wrong number of args.
10029     (when (and def-com (> (length (help-function-arglist def-com)) 8))
10030       (setq def-com 'incompatible))
10031     (when (eq def-com 'ido) (setq def-com 'ido-read-file-name))
10032     (unless (or (not entry) def-com)
10033       (return-from anything-generic-read-file-name
10034         (unwind-protect
10035              (progn
10036                (ac-mode -1)
10037                (apply read-file-name-function def-args))
10038           (ac-mode 1))))
10039     ;; If we use now `read-file-name' we MUST turn off `ac-mode'
10040     ;; to avoid infinite recursion and CRASH. It will be reenabled on exit.
10041     (when (or (eq def-com 'read-file-name)
10042               (eq def-com 'ido-read-file-name)
10043               (and (stringp str-defcom)
10044                    (not (string-match "^anything" str-defcom))))
10045       (ac-mode -1))
10046     (unwind-protect
10047          (setq fname
10048                (cond (;; A specialized function exists, run it
10049                       ;; with the two extra args specific to anything..
10050                       (and def-com anything-completion-mode
10051                            (not (eq def-com 'ido-read-file-name))
10052                            (not (eq def-com 'incompatible)))
10053                       (apply def-com any-args))
10054                      (;; Def-com value is `ido-read-file-name'
10055                       ;; run it with default args.
10056                       (and def-com (eq def-com 'ido-read-file-name))
10057                       (ido-mode 1)
10058                       (apply def-com def-args))
10059                      (;; Def-com value is `read-file-name'
10060                       ;; run it with default args.
10061                       (eq def-com 'read-file-name)
10062                       (apply def-com def-args))
10063                      (t ; Fall back to classic `anything-c-read-file-name'.
10064                       (anything-c-read-file-name
10065                        prompt
10066                        :name str-command
10067                        :buffer buf-name
10068                        :initial-input (expand-file-name init dir)
10069                        :alistp nil
10070                        :must-match mustmatch
10071                        :test predicate))))
10072       (ac-mode 1)
10073       (ido-mode (if ido-state 1 -1))
10074       ;; Same comment as in `anything-completing-read-default'.
10075       (setq this-command current-command))
10076     fname))
10077
10078 ;;;###autoload
10079 (define-minor-mode anything-completion-mode
10080     "Toggle generic anything completion.
10081
10082 All functions in Emacs that use `completing-read'
10083 or `read-file-name' and friends will use anything interface
10084 when this mode is turned on.
10085 However you can modify this behavior for functions of your choice
10086 with `anything-completing-read-handlers-alist'.
10087
10088 Called with a positive arg, turn on unconditionally, with a
10089 negative arg turn off.
10090 You can turn it on with `ac-mode'.
10091
10092 Some crap emacs functions may not be supported,
10093 e.g `ffap-alternate-file' and maybe others
10094 You can add such functions to `anything-completing-read-handlers-alist'
10095 with a nil value.
10096
10097 Note: This mode will work only partially on Emacs23."
10098   :group 'anything
10099   :global t
10100   :lighter anything-completion-mode-string
10101   (declare (special completing-read-function))
10102   (if anything-completion-mode
10103       (progn
10104         (setq completing-read-function 'anything-completing-read-default
10105               read-file-name-function  'anything-generic-read-file-name)
10106         (message anything-completion-mode-start-message))
10107       (setq completing-read-function (and (fboundp 'completing-read-default)
10108                                           'completing-read-default)
10109             read-file-name-function  (and (fboundp 'read-file-name-default)
10110                                           'read-file-name-default))
10111       (message anything-completion-mode-quit-message)))
10112
10113 (defalias 'ac-mode 'anything-completion-mode)
10114
10115
10116 \f
10117 ;;; Eshell completion.
10118 ;;
10119 ;; Enable like this in .emacs:
10120 ;;
10121 ;; (add-hook 'eshell-mode-hook
10122 ;;           #'(lambda ()
10123 ;;               (define-key eshell-mode-map [remap pcomplete] 'anything-esh-pcomplete)))
10124 ;;
10125 (defvar anything-c-source-esh
10126   '((name . "Eshell completions")
10127     (init . (lambda ()
10128               (setq pcomplete-current-completions nil
10129                     pcomplete-last-completion-raw nil)
10130               ;; Eshell-command add this hook in all minibuffers
10131               ;; Remove it for the anything one. (Fixed in Emacs24)
10132               (remove-hook 'minibuffer-setup-hook 'eshell-mode)))
10133     (candidates . anything-esh-get-candidates)
10134     (action . anything-ec-insert))
10135   "Anything source for Eshell completion.")
10136
10137 ;; Internal.
10138 (defvar anything-ec-target "")
10139 (defun anything-ec-insert (candidate)
10140   "Replace text at point with CANDIDATE.
10141 The function that call this should set `anything-ec-target' to thing at point.
10142 This is the same as `ac-insert', just inlined here for compatibility."
10143   (let ((pt (point)))
10144     (when (and anything-ec-target
10145                (search-backward anything-ec-target nil t)
10146                (string= (buffer-substring (point) pt) anything-ec-target))
10147       (delete-region (point) pt)))
10148   (insert (anything-quote-whitespace candidate)))
10149
10150 (defun anything-esh-get-candidates ()
10151   "Get candidates for eshell completion using `pcomplete'."
10152   (catch 'pcompleted
10153     (let* ((pcomplete-stub)
10154            pcomplete-seen pcomplete-norm-func
10155            pcomplete-args pcomplete-last pcomplete-index
10156            (pcomplete-autolist pcomplete-autolist)
10157            (pcomplete-suffix-list pcomplete-suffix-list))
10158       (with-anything-current-buffer
10159         (loop with table  = (pcomplete-completions)
10160               with entry  = (condition-case nil
10161                                 ;; On Emacs24 `try-completion' return
10162                                 ;; pattern when more than one result.
10163                                 ;; Otherwise Emacs23 return nil, which
10164                                 ;; is wrong, in this case use pattern
10165                                 ;; to behave like Emacs24.
10166                                 (or (try-completion anything-pattern
10167                                                     (pcomplete-entries))
10168                                     anything-pattern)
10169                               ;; In Emacs23 `pcomplete-entries' may fail
10170                               ;; with error, so try this instead.
10171                               (error
10172                                nil
10173                                (let ((fc (car (last
10174                                                (pcomplete-parse-arguments)))))
10175                                  ;; Check if last arg require fname completion.
10176                                  (and (file-name-directory fc) fc))))
10177               for i in (all-completions pcomplete-stub table)
10178               for file-cand = (and entry
10179                                    (if (file-remote-p i) i
10180                                        (expand-file-name
10181                                         i (file-name-directory entry))))
10182               if (and file-cand (or (file-remote-p file-cand)
10183                                     (file-exists-p file-cand)))
10184               collect file-cand into ls
10185               else collect i into ls
10186               finally return
10187               (if (and entry (not (string= entry "")) (file-exists-p entry))
10188                   (append (list (expand-file-name entry default-directory)) ls)
10189                   ls))))))
10190
10191 ;;; Eshell history.
10192 ;;
10193 ;;
10194 (defvar anything-c-source-eshell-history
10195   `((name . "Eshell history")
10196     (init . (lambda ()
10197               (let (eshell-hist-ignoredups)
10198                 ;; Write the content's of ring to file.
10199                 (eshell-write-history eshell-history-file-name t)
10200                 (with-current-buffer (anything-candidate-buffer 'global)
10201                   (insert-file-contents eshell-history-file-name)))
10202               ;; Same comment as in `anything-c-source-esh'
10203               (remove-hook 'minibuffer-setup-hook 'eshell-mode)))
10204     (candidates-in-buffer)
10205     (keymap . ,anything-eshell-history-map)
10206     (filtered-candidate-transformer . (lambda (candidates sources)
10207                                         (reverse candidates)))
10208     (candidate-number-limit . 9999)
10209     (action . (lambda (candidate)
10210                 (eshell-kill-input)
10211                 (insert candidate))))
10212   "Anything source for Eshell history.")
10213
10214 \f
10215 ;;; Show completion - an alternative of anything-show-completion.el.
10216 ;;
10217 ;; Provide show completion with macro `with-anything-show-completion'.
10218
10219
10220 ;; Called each time cursor move in anything-buffer.
10221 (defun anything-c-show-completion ()
10222   (with-anything-current-buffer
10223     (overlay-put anything-c-show-completion-overlay
10224                  'display (anything-get-selection))))
10225
10226 (defun anything-c-show-completion-init-overlay (beg end)
10227   (and anything-c-turn-on-show-completion
10228        (setq anything-c-show-completion-overlay (make-overlay beg end))
10229        (overlay-put anything-c-show-completion-overlay
10230                     'face 'anything-lisp-show-completion)))
10231
10232 (defun anything-c-show-completion-display-function (buffer)
10233   "A special resized anything window is used depending on position in BUFFER."
10234   (with-selected-window (selected-window)
10235     (let* ((screen-size  (+ (count-screen-lines (window-start) (point) t)
10236                             1                             ; mode-line
10237                             (if header-line-format 1 0))) ; header-line
10238            (def-size     (- (window-height)
10239                             anything-c-show-completion-min-window-height))
10240            (upper-height (max window-min-height (min screen-size def-size)))
10241            split-window-keep-point)
10242       (recenter -1)
10243       (set-window-buffer (if (active-minibuffer-window)
10244                              (minibuffer-selected-window)
10245                              (split-window nil upper-height))
10246                          buffer))))
10247
10248 (defmacro with-anything-show-completion (beg end &rest body)
10249   "Show anything candidate in an overlay at point.
10250 BEG and END are the beginning and end position of the current completion
10251 in `anything-current-buffer'.
10252 BODY is an anything call where we want to enable show completion.
10253 If `anything-c-turn-on-show-completion' is nil just do nothing."
10254   (declare (indent 2) (debug t))
10255   `(let ((anything-move-selection-after-hook
10256           (and anything-c-turn-on-show-completion
10257                (append (list 'anything-c-show-completion)
10258                        anything-move-selection-after-hook))))
10259      (unwind-protect
10260           (progn
10261             (anything-c-show-completion-init-overlay ,beg ,end)
10262             (let ((anything-display-function
10263                    (if anything-c-show-completion-use-special-display
10264                        'anything-c-show-completion-display-function
10265                        'anything-default-display-buffer)))
10266               ,@body))
10267        (and anything-c-turn-on-show-completion
10268             (delete-overlay anything-c-show-completion-overlay)))))
10269
10270 \f
10271 ;;; Lisp symbol completion.
10272 ;;
10273 ;;
10274 ;;;###autoload
10275 (defun anything-lisp-completion-at-point ()
10276   "Anything lisp symbol completion at point."
10277   (interactive)
10278   (let* ((data       (lisp-completion-at-point))
10279          (beg        (car data))
10280          (end        (point)) ; 'cadr data' is wrong when no space after point.
10281          (plist      (nthcdr 3 data))
10282          (pred       (plist-get plist :predicate))
10283          (lgst-len   0)
10284          (target     (and beg end (buffer-substring-no-properties beg end)))
10285          (candidates (all-completions target (nth 2 data) pred))
10286          (anything-quit-if-no-candidate t)
10287
10288          (anything-execute-action-at-once-if-one t)
10289          (anything-match-plugin-enabled
10290           (member 'anything-compile-source--match-plugin
10291                   anything-compile-source-functions)))
10292     (if candidates
10293         (with-anything-show-completion beg end
10294           ;; Overlay is initialized now in anything-current-buffer.
10295           (anything
10296            :sources
10297            '((name . "Lisp completion")
10298              (init . (lambda ()
10299                        (with-current-buffer (anything-candidate-buffer 'global)
10300                          (loop for sym in candidates
10301                                for len = (length sym)
10302                                when (> len lgst-len) do (setq lgst-len len)
10303                                do (insert (concat sym "\n"))))))
10304              (candidates-in-buffer)
10305              (persistent-action . anything-lisp-completion-persistent-action)
10306              (persistent-help . "Show brief doc in mode-line")
10307              (filtered-candidate-transformer anything-lisp-completion-transformer)
10308              (action . (lambda (candidate)
10309                          (delete-region beg end)
10310                          (insert candidate))))
10311            :input (if anything-match-plugin-enabled (concat target " ") target)))
10312         (message "[No Match]"))))
10313
10314 (defun anything-lisp-completion-persistent-action (candidate)
10315   (let ((cursor-in-echo-area t)
10316         mode-line-in-non-selected-windows)
10317     (anything-c-show-info-in-mode-line
10318      (propertize
10319       (anything-c-get-first-line-documentation
10320        (intern candidate))
10321       'face 'anything-lisp-completion-info))))
10322
10323 (defun anything-lisp-completion-transformer (candidates source)
10324   "Anything candidates transformer for lisp completion."
10325   (declare (special lgst-len))
10326   (loop for c in candidates
10327         for sym = (intern c)
10328         for annot = (cond ((commandp sym) " (Com)")
10329                           ((fboundp sym)  " (Fun)")
10330                           ((boundp sym)   " (Var)")
10331                           ((facep sym)    " (Face)"))
10332         for spaces = (make-string (- lgst-len (length c)) ? )
10333         collect (cons (concat c spaces annot) c)))
10334
10335 (defun anything-c-get-first-line-documentation (sym)
10336   "Return first line documentation of symbol SYM.
10337 If SYM is not documented, return \"Not documented\"."
10338   (let ((doc (cond ((fboundp sym)
10339                     (documentation sym t))
10340                    ((boundp sym)
10341                     (documentation-property sym 'variable-documentation t))
10342                    ((facep sym)
10343                     (face-documentation sym))
10344                    (t nil))))
10345     (if (and doc (not (string= doc ""))
10346              ;; `documentation' return "\n\n(args...)"
10347              ;; for CL-style functions.
10348              (not (string-match-p "^\n\n" doc)))
10349         (car (split-string doc "\n"))
10350         "Not documented")))
10351
10352 ;;; File completion.
10353 ;;
10354 ;; Complete file name at point.
10355 (defun anything-c-thing-before-point ()
10356   "Get symbol name before point.
10357 Borrowed from anything-complete.el, inlined here for compatibility."
10358   (save-excursion
10359     (let ((beg (point)))
10360       ;; older regexp "\(\\|\\s-\\|^\\|\\_<\\|\r\\|'\\|#'"
10361       (when (re-search-backward
10362              "\\_<" (field-beginning nil nil (point-at-bol)) t)
10363         (buffer-substring-no-properties beg (match-end 0))))))
10364
10365 ;;;###autoload
10366 (defun anything-c-complete-file-name-at-point ()
10367   "Complete file name at point."
10368   (interactive)
10369   (let* ((init (substring-no-properties (thing-at-point 'filename)))
10370          (end  (point))
10371          (beg  (- (point) (length init)))
10372          (anything-quit-if-no-candidate t)
10373          (anything-execute-action-at-once-if-one t)
10374          completion)
10375     (with-anything-show-completion beg end
10376       (setq completion (anything-c-read-file-name "FileName: "
10377                                                   :initial-input init)))
10378     (anything-c-insert-file-name-completion-at-point completion)))
10379
10380 ;; Internal
10381 (defvar anything-lisp-completion-counter 0)
10382 ;;;###autoload
10383 (defun anything-lisp-completion-at-point-or-indent (arg)
10384   "First call indent and second call complete lisp symbol.
10385 The second call should happen before `anything-lisp-completion-or-indent-delay',
10386 after this delay, next call will indent again.
10387 After completion, next call is always indent.
10388 See that like click and double mouse click.
10389 One hit indent, two quick hits maybe indent and complete."
10390   (interactive "P")
10391   ;; Be sure `indent-for-tab-command' will not try
10392   ;; to use `completion-at-point'.
10393   (let ((tab-always-indent (if (eq tab-always-indent 'complete)
10394                                t tab-always-indent)))
10395     (incf anything-lisp-completion-counter)
10396     (unwind-protect
10397          (if (> anything-lisp-completion-counter 1)
10398              (anything-lisp-completion-or-file-name-at-point)
10399              (indent-for-tab-command arg))
10400       ;; After `anything-lisp-completion-or-indent-delay' seconds
10401       ;; reset to 0.
10402       (run-with-timer anything-lisp-completion-or-indent-delay nil
10403                       #'(lambda ()
10404                           (setq anything-lisp-completion-counter 0)))
10405       ;; Always reset to 0 at second hit.
10406       (when (eq anything-lisp-completion-counter 2)
10407         (setq anything-lisp-completion-counter 0)))))
10408
10409 ;;;###autoload
10410 (defun anything-lisp-completion-or-file-name-at-point ()
10411   "Complete lisp symbol or filename at point.
10412 Filename completion happen if filename is started in
10413 or between double quotes."
10414   (interactive)
10415   (let ((tap (substring-no-properties (thing-at-point 'filename))))
10416     (if (and tap (string-match "^\\(~/\\|/\\|[a-zA-Z]\:/\\).*" tap)
10417              (save-excursion (search-backward "\"" (point-at-bol) t)))
10418         (anything-c-complete-file-name-at-point)
10419         (anything-lisp-completion-at-point))))
10420
10421 (defun anything-c-apropos-init (test default)
10422   "Init candidates buffer for `anything-c-apropos' sources."
10423   (with-current-buffer (anything-candidate-buffer 'global)
10424     (goto-char (point-min))
10425     (when (and default (stringp default)
10426                ;; Some defaults args result as
10427                ;; (symbol-name nil) == "nil".
10428                ;; e.g debug-on-entry.
10429                (not (string= default "nil"))
10430                (funcall test (intern default)))
10431       (insert (concat default "\n")))
10432     (loop with all = (all-completions "" obarray test)
10433           for sym in all
10434           unless (and default (eq sym default))
10435           do (insert (concat sym "\n")))))
10436
10437 \f
10438 ;;; Run Externals commands within Emacs with anything completion
10439 ;;
10440 ;;
10441 (defvar anything-external-command-history nil)
10442
10443 (defun anything-c-external-commands-list-1 (&optional sort)
10444   "Returns a list of all external commands the user can execute.
10445 If `anything-c-external-commands-list' is non-nil it will
10446 return its contents.  Else it calculates all external commands
10447 and sets `anything-c-external-commands-list'."
10448   (if anything-c-external-commands-list
10449       anything-c-external-commands-list
10450       (setq anything-c-external-commands-list
10451             (loop
10452                   with paths = (split-string (getenv "PATH") path-separator)
10453                   with completions = ()
10454                   for dir in paths
10455                   when (and (file-exists-p dir) (file-accessible-directory-p dir))
10456                   for lsdir = (loop for i in (directory-files dir t)
10457                                     for bn = (file-name-nondirectory i)
10458                                     when (and (not (member bn completions))
10459                                               (not (file-directory-p i))
10460                                               (file-executable-p i))
10461                                     collect bn)
10462                   append lsdir into completions
10463                   finally return (if sort (sort completions 'string-lessp) completions)))))
10464
10465 (defun anything-run-or-raise (exe &optional file)
10466   "Generic command that run asynchronously EXE.
10467 If EXE is already running just jump to his window if `anything-raise-command'
10468 is non--nil.
10469 When FILE argument is provided run EXE with FILE.
10470 In this case EXE must be provided as \"EXE %s\"."
10471   (lexical-let* ((real-com (car (split-string (replace-regexp-in-string
10472                                                "%s" "" exe))))
10473                  (proc     (if file (concat real-com " " file) real-com)))
10474     (if (get-process proc)
10475         (if anything-raise-command
10476             (shell-command  (format anything-raise-command real-com))
10477             (error "Error: %s is already running" real-com))
10478         (when (loop for i in anything-c-external-commands-list thereis real-com)
10479           (message "Starting %s..." real-com)
10480           (if file
10481               (start-process-shell-command
10482                proc nil (format exe (shell-quote-argument
10483                                      (if (eq system-type 'windows-nt)
10484                                          (anything-w32-prepare-filename file)
10485                                          file))))
10486               (start-process-shell-command proc nil real-com))
10487           (set-process-sentinel
10488            (get-process proc)
10489            #'(lambda (process event)
10490                (when (and (string= event "finished\n")
10491                           anything-raise-command
10492                           (not (anything-c-get-pid-from-process-name real-com)))
10493                  (shell-command  (format anything-raise-command "emacs")))
10494                (message "%s process...Finished." process))))
10495         (setq anything-c-external-commands-list
10496               (cons real-com
10497                     (delete real-com anything-c-external-commands-list))))))
10498
10499
10500 \f
10501 ;;; Generic action functions
10502 ;;
10503 ;;
10504 (defun anything-c-file-buffers (filename)
10505   "Returns a list of buffer names corresponding to FILENAME."
10506   (let ((name     (expand-file-name filename))
10507         (buf-list ()))
10508     (dolist (buf (buffer-list) buf-list)
10509       (let ((bfn (buffer-file-name buf)))
10510         (when (and bfn (string= name bfn))
10511           (push (buffer-name buf) buf-list))))))
10512
10513 (defun anything-revert-buffer (candidate)
10514   (with-current-buffer candidate
10515     (when (or (buffer-modified-p)
10516               (not (verify-visited-file-modtime
10517                     (get-buffer candidate))))
10518       (revert-buffer t t))))
10519
10520 (defun anything-revert-marked-buffers (ignore)
10521   (mapc 'anything-revert-buffer (anything-marked-candidates)))
10522
10523 (defun anything-kill-marked-buffers (ignore)
10524   (mapc 'kill-buffer (anything-marked-candidates)))
10525
10526 (defun anything-c-delete-file (file &optional error-if-dot-file-p)
10527   "Delete the given file after querying the user.
10528 Ask to kill buffers associated with that file, too."
10529   (when (and error-if-dot-file-p
10530              (anything-ff-dot-file-p file))
10531     (error "Error: Cannot operate on `.' or `..'"))
10532   (let ((buffers (anything-c-file-buffers file)))
10533     (if (< emacs-major-version 24)
10534         ;; `dired-delete-file' in Emacs versions < 24
10535         ;; doesn't support delete-by-moving-to-trash
10536         ;; so use `delete-directory' and `delete-file'
10537         ;; that handle it.
10538         (cond ((and (not (file-symlink-p file))
10539                     (file-directory-p file)
10540                     (directory-files file t dired-re-no-dot))
10541                (when (y-or-n-p (format "Recursive delete of `%s'? " file))
10542                  (delete-directory file 'recursive)))
10543               ((and (not (file-symlink-p file))
10544                     (file-directory-p file))
10545                (delete-directory file))
10546               (t (delete-file file)))
10547         (dired-delete-file
10548          file 'dired-recursive-deletes delete-by-moving-to-trash))
10549     (when buffers
10550       (dolist (buf buffers)
10551         (when (y-or-n-p (format "Kill buffer %s, too? " buf))
10552           (kill-buffer buf))))))
10553
10554 (defun anything-get-mailcap-for-file (filename)
10555   "Get the command to use for FILENAME from mailcap files.
10556 The command is like <command %s> and is meant to use with `format'."
10557   (mailcap-parse-mailcaps)
10558   (let* ((ext  (file-name-extension filename))
10559          (mime (when ext (mailcap-extension-to-mime ext)))
10560          (result (when mime (mailcap-mime-info mime))))
10561     ;; If elisp file have no associations in .mailcap
10562     ;; `mailcap-maybe-eval' is returned, in this case just return nil.
10563     (when (stringp result) result)))
10564
10565 (defun anything-get-default-program-for-file (filename)
10566   "Try to find a default program to open FILENAME.
10567 Try first in `anything-c-external-programs-associations' and then in mailcap file
10568 if nothing found return nil."
10569   (let* ((ext      (file-name-extension filename))
10570          (def-prog (assoc-default ext anything-c-external-programs-associations)))
10571     (cond ((and def-prog (not (string= def-prog "")))
10572            (concat def-prog " %s"))
10573           ((and anything-c-default-external-file-browser
10574                 (file-directory-p filename))
10575            (concat anything-c-default-external-file-browser " %s"))
10576           (t (anything-get-mailcap-for-file filename)))))
10577
10578 (defun anything-c-open-file-externally (file)
10579   "Open FILE with an external program.
10580 Try to guess which program to use with `anything-get-default-program-for-file'.
10581 If not found or a prefix arg is given query the user which tool to use."
10582   (let* ((fname          (expand-file-name file))
10583          (collection     (anything-c-external-commands-list-1 'sort))
10584          (def-prog       (anything-get-default-program-for-file fname))
10585          (real-prog-name (if (or anything-current-prefix-arg (not def-prog))
10586                              ;; Prefix arg or no default program.
10587                              (prog1
10588                                  (anything-comp-read
10589                                   "Program: " collection
10590                                   :must-match t
10591                                   :name "Open file Externally"
10592                                   :history anything-external-command-history)
10593                                ;; Always prompt to set this program as default.
10594                                (setq def-prog nil))
10595                              ;; No prefix arg or default program exists.
10596                              (replace-regexp-in-string " %s\\| '%s'" "" def-prog)))
10597          (program        (concat real-prog-name " %s")))
10598     (unless (or def-prog ; Association exists, no need to record it.
10599                 ;; Don't try to record non--filenames associations (e.g urls).
10600                 (not (file-exists-p fname)))
10601       (when
10602           (y-or-n-p
10603            (format
10604             "Do you want to make `%s' the default program for this kind of files? "
10605             real-prog-name))
10606         (anything-aif (assoc (file-name-extension fname)
10607                              anything-c-external-programs-associations)
10608             (setq anything-c-external-programs-associations
10609                   (delete it anything-c-external-programs-associations)))
10610         (push (cons (file-name-extension fname)
10611                     (read-string
10612                      "Program (Add args maybe and confirm): " real-prog-name))
10613               anything-c-external-programs-associations)
10614         (customize-save-variable 'anything-c-external-programs-associations
10615                                  anything-c-external-programs-associations)))
10616     (anything-run-or-raise program file)
10617     (setq anything-external-command-history
10618           (cons real-prog-name
10619                 (delete real-prog-name
10620                         (loop for i in anything-external-command-history
10621                               when (executable-find i) collect i))))))
10622
10623 (defun anything-c-find-file-or-marked (candidate)
10624   "Open file CANDIDATE or open anything marked files in background."
10625   (let ((marked (anything-marked-candidates))
10626         (ffap-newfile-prompt anything-ff-newfile-prompt-p)
10627         (find-file-wildcards nil))
10628     (if (> (length marked) 1)
10629         ;; Open all marked files in background and display
10630         ;; the first one.
10631         (progn (mapc 'find-file-noselect (cdr marked))
10632                (find-file (car marked)))
10633         (if (and (not (file-exists-p candidate))
10634                  (and ffap-url-regexp
10635                       (not (string-match ffap-url-regexp candidate)))
10636                  (string-match "/$" candidate))
10637             ;; A a non--existing filename ending with /
10638             ;; Create a directory and jump to it.
10639             (when (y-or-n-p (format "Create directory `%s'? " candidate))
10640               (let ((dirfname (directory-file-name candidate)))
10641                 (if (file-exists-p dirfname)
10642                     (error "Mkdir: Unable to create directory `%s': file exists."
10643                            (anything-c-basename dirfname))
10644                     (make-directory candidate 'parent)))
10645               (anything-find-files-1 candidate))
10646             ;; A non--existing filename NOT ending with / or
10647             ;; an existing filename, create or jump to it.
10648             (find-file-at-point (car marked))))))
10649
10650 (defun anything-delete-marked-files (ignore)
10651   (let* ((files (anything-marked-candidates))
10652          (len (length files)))
10653     (if (not (y-or-n-p
10654               (format "Delete *%s File(s):\n%s"
10655                       len
10656                       (mapconcat (lambda (f) (format "- %s\n" f)) files ""))))
10657         (message "(No deletions performed)")
10658         (dolist (i files)
10659           (set-text-properties 0 (length i) nil i)
10660           (anything-c-delete-file i anything-ff-signal-error-on-dot-files))
10661         (message "%s File(s) deleted" len))))
10662
10663 (defun anything-ediff-marked-buffers (candidate &optional merge)
10664   "Ediff 2 marked buffers or CANDIDATE and `anything-current-buffer'.
10665 With optional arg MERGE call `ediff-merge-buffers'."
10666   (let ((lg-lst (length (anything-marked-candidates)))
10667         buf1 buf2)
10668     (case lg-lst
10669       (0
10670        (error "Error:You have to mark at least 1 buffer"))
10671       (1
10672        (setq buf1 anything-current-buffer
10673              buf2 (first (anything-marked-candidates))))
10674       (2
10675        (setq buf1 (first (anything-marked-candidates))
10676              buf2 (second (anything-marked-candidates))))
10677       (t
10678        (error "Error:To much buffers marked!")))
10679     (if merge
10680         (ediff-merge-buffers buf1 buf2)
10681         (ediff-buffers buf1 buf2))))
10682
10683 (defun anything-ediff-marked-buffers-merge (candidate)
10684   "Ediff merge `anything-current-buffer' with CANDIDATE.
10685 See `anything-ediff-marked-buffers'."
10686   (anything-ediff-marked-buffers candidate t))
10687
10688 (defun anything-bookmark-get-bookmark-from-name (bmk)
10689   "Return bookmark name even if it is a bookmark with annotation.
10690 e.g prepended with *.
10691 Return nil if bmk is not a valid bookmark."
10692   (let ((bookmark (replace-regexp-in-string "\*" "" bmk)))
10693     (if (assoc bookmark bookmark-alist)
10694         bookmark
10695         (when (assoc bmk bookmark-alist)
10696           bmk))))
10697
10698 (defun anything-delete-marked-bookmarks (ignore)
10699   "Delete this bookmark or all marked bookmarks."
10700   (dolist (i (anything-marked-candidates))
10701     (bookmark-delete (anything-bookmark-get-bookmark-from-name i)
10702                      'batch)))
10703
10704 (defun anything-require-or-error (feature function)
10705   (or (require feature nil t)
10706       (error "Need %s to use `%s'." feature function)))
10707
10708 (defun anything-find-buffer-on-elscreen (candidate)
10709   "Open buffer in new screen, if marked buffers open all in elscreens."
10710   (anything-require-or-error 'elscreen 'anything-find-buffer-on-elscreen)
10711   (anything-aif (anything-marked-candidates)
10712       (dolist (i it)
10713         (let ((target-screen (elscreen-find-screen-by-buffer
10714                               (get-buffer i) 'create)))
10715           (elscreen-goto target-screen)))
10716     (let ((target-screen (elscreen-find-screen-by-buffer
10717                           (get-buffer candidate) 'create)))
10718       (elscreen-goto target-screen))))
10719
10720 (defun anything-elscreen-find-file (file)
10721   (anything-require-or-error 'elscreen 'anything-elscreen-find-file)
10722   (elscreen-find-file file))
10723
10724 (defun anything-w32-prepare-filename (file)
10725   "Convert filename FILE to something usable by external w32 executables."
10726   (replace-regexp-in-string ; For UNC paths
10727    "/" "\\"
10728    (replace-regexp-in-string ; Strip cygdrive paths
10729     "/cygdrive/\\(.\\)" "\\1:"
10730     file nil nil) nil t))
10731
10732 ;;;###autoload
10733 (defun anything-w32-shell-execute-open-file (file)
10734   (interactive "fOpen file:")
10735   (with-no-warnings
10736     (w32-shell-execute "open" (anything-w32-prepare-filename file))))
10737
10738 (defun anything-c-open-file-with-default-tool (file)
10739   "Open FILE with the default tool on this platform."
10740   (if (eq system-type 'windows-nt)
10741       (anything-w32-shell-execute-open-file file)
10742       (start-process "anything-c-open-file-with-default-tool"
10743                      nil
10744                      (cond ((eq system-type 'gnu/linux)
10745                             "xdg-open")
10746                            ((or (eq system-type 'darwin) ;; Mac OS X
10747                                 (eq system-type 'macos)) ;; Mac OS 9
10748                             "open"))
10749                      file)))
10750
10751 (defun anything-c-open-dired (file)
10752   "Opens a dired buffer in FILE's directory.  If FILE is a
10753 directory, open this directory."
10754   (if (file-directory-p file)
10755       (dired file)
10756       (dired (file-name-directory file))
10757       (dired-goto-file file)))
10758
10759 (defun anything-c-display-to-real-line (candidate)
10760   (if (string-match "^ *\\([0-9]+\\):\\(.*\\)$" candidate)
10761       (list (string-to-number (match-string 1 candidate)) (match-string 2 candidate))
10762       (error "Line number not found")))
10763
10764 (defun anything-c-action-line-goto (lineno-and-content)
10765   (apply #'anything-goto-file-line (anything-interpret-value (anything-attr 'target-file))
10766          (append lineno-and-content
10767                  (list (if (and (anything-attr-defined 'target-file)
10768                                 (not anything-in-persistent-action))
10769                            'find-file-other-window
10770                            'find-file)))))
10771
10772 (defun* anything-c-action-file-line-goto (file-line-content &optional (find-file-function #'find-file))
10773   (apply #'anything-goto-file-line
10774          (if (stringp file-line-content)
10775              ;; Case: filtered-candidate-transformer is skipped
10776              (cdr (anything-c-filtered-candidate-transformer-file-line-1 file-line-content))
10777              file-line-content)))
10778
10779 (require 'compile)
10780 (defun anything-c-filtered-candidate-transformer-file-line (candidates source)
10781   (delq nil (mapcar 'anything-c-filtered-candidate-transformer-file-line-1 candidates)))
10782
10783 (defun anything-c-filtered-candidate-transformer-file-line-1 (candidate)
10784   (when (string-match "^\\(.+?\\):\\([0-9]+\\):\\(.*\\)$" candidate)
10785     (let ((filename (match-string 1 candidate))
10786           (lineno (match-string 2 candidate))
10787           (content (match-string 3 candidate)))
10788       (cons (format "%s:%s\n %s"
10789                     (propertize filename 'face compilation-info-face)
10790                     (propertize lineno 'face compilation-line-face)
10791                     content)
10792             (list (expand-file-name
10793                    filename
10794                    (or (anything-interpret-value (anything-attr 'default-directory))
10795                        (and (anything-candidate-buffer)
10796                             (buffer-local-value
10797                              'default-directory (anything-candidate-buffer)))))
10798                   (string-to-number lineno) content)))))
10799
10800 (defun* anything-goto-file-line (file lineno content &optional (find-file-function #'find-file))
10801   (anything-aif (anything-attr 'before-jump-hook)
10802       (funcall it))
10803   (when file (funcall find-file-function file))
10804   (if (anything-attr-defined 'adjust)
10805       (anything-c-goto-line-with-adjustment
10806        lineno content (not (anything-attr-defined 'recenter)))
10807     (anything-goto-line lineno nil (not (anything-attr-defined 'recenter))))
10808   (anything-aif (anything-attr 'after-jump-hook)
10809       (funcall it))
10810   (when anything-in-persistent-action
10811     (anything-match-line-color-current-line)))
10812
10813 (defun anything-find-file-as-root (candidate)
10814   (find-file (concat "/" anything-su-or-sudo "::" (expand-file-name candidate))))
10815
10816 (defun anything-find-many-files (ignore)
10817   (mapc 'find-file (anything-marked-candidates)))
10818
10819 ;; borrowed from etags.el
10820 ;; (anything-c-goto-line-with-adjustment (line-number-at-pos) ";; borrowed from etags.el")
10821 (defun anything-c-goto-line-with-adjustment (line line-content &optional show-top)
10822   (let ((startpos)
10823         offset found pat)
10824     ;; This constant is 1/2 the initial search window.
10825     ;; There is no sense in making it too small,
10826     ;; since just going around the loop once probably
10827     ;; costs about as much as searching 2000 chars.
10828     (setq offset 1000
10829           found nil
10830           pat (concat (if (eq selective-display t)
10831                           "\\(^\\|\^m\\) *" "^ *") ;allow indent
10832                       (regexp-quote line-content)))
10833     ;; If no char pos was given, try the given line number.
10834     (setq startpos (progn (anything-goto-line line nil show-top) (point)))
10835     (or startpos (setq startpos (point-min)))
10836     ;; First see if the tag is right at the specified location.
10837     (goto-char startpos)
10838     (setq found (looking-at pat))
10839     (while (and (not found)
10840                 (progn
10841                   (goto-char (- startpos offset))
10842                   (not (bobp))))
10843       (setq found
10844             (re-search-forward pat (+ startpos offset) t)
10845             offset (* 3 offset)))       ; expand search window
10846     (or found
10847         (re-search-forward pat nil t)
10848         (error "not found")))
10849   ;; Position point at the right place
10850   ;; if the search string matched an extra Ctrl-m at the beginning.
10851   (and (eq selective-display t)
10852        (looking-at "\^m")
10853        (forward-char 1))
10854   (beginning-of-line))
10855
10856 (anything-document-attribute 'default-directory "type . file-line"
10857                              "`default-directory' to interpret file.")
10858 (anything-document-attribute 'before-jump-hook "type . file-line / line"
10859                              "Function to call before jumping to the target location.")
10860 (anything-document-attribute 'after-jump-hook "type . file-line / line"
10861                              "Function to call after jumping to the target location.")
10862 (anything-document-attribute 'adjust "type . file-line"
10863                              "Search around line matching line contents.")
10864 (anything-document-attribute 'recenter "type . file-line / line"
10865                              "`recenter' after jumping.")
10866 (anything-document-attribute 'target-file "type . line"
10867                              "Goto line of target-file.")
10868
10869 ;;;###autoload
10870 (defun anything-c-call-interactively (cmd-or-name)
10871   "Execute CMD-OR-NAME as Emacs command.
10872 It is added to `extended-command-history'.
10873 `anything-current-prefix-arg' is used as the command's prefix argument."
10874   (setq extended-command-history
10875         (cons (anything-c-stringify cmd-or-name)
10876               (delete (anything-c-stringify cmd-or-name) extended-command-history)))
10877   (let ((current-prefix-arg anything-current-prefix-arg)
10878         (cmd (anything-c-symbolify cmd-or-name)))
10879     (if (stringp (symbol-function cmd))
10880         (execute-kbd-macro (symbol-function cmd))
10881         (setq this-command cmd)
10882         (call-interactively cmd))))
10883
10884 ;;;###autoload
10885 (defun anything-c-set-variable (var)
10886   "Set value to VAR interactively."
10887   (interactive)
10888   (let ((sym (anything-c-symbolify var)))
10889     (set sym (eval-minibuffer (format "Set %s: " var)
10890                               (prin1-to-string (symbol-value sym))))))
10891 ;; (setq hh 12)
10892 ;; (anything-c-set-variable 'hh)
10893
10894
10895 \f
10896 ;;; Persistent Action Helpers
10897 ;;
10898 ;;
10899 (defvar anything-match-line-overlay-face nil)
10900 (defvar anything-match-line-overlay nil)
10901
10902 (defun anything-match-line-color-current-line (&optional start end buf face rec)
10903   "Highlight and underline current position"
10904   (let ((args (list (or start (line-beginning-position))
10905                     (or end (1+ (line-end-position)))
10906                     buf)))
10907     (if (not anything-match-line-overlay)
10908         (setq anything-match-line-overlay (apply 'make-overlay args))
10909         (apply 'move-overlay anything-match-line-overlay args)))
10910   (overlay-put anything-match-line-overlay
10911                'face (or face anything-match-line-overlay-face))
10912   (when rec
10913     (goto-char start)
10914     (recenter)))
10915
10916 (defalias 'anything-persistent-highlight-point 'anything-match-line-color-current-line)
10917
10918
10919 (setq anything-match-line-overlay-face 'anything-overlay-line-face)
10920
10921 (defun anything-match-line-cleanup ()
10922   (when anything-match-line-overlay
10923     (delete-overlay anything-match-line-overlay)
10924     (setq anything-match-line-overlay nil)))
10925
10926 (defun anything-match-line-update ()
10927   (when anything-match-line-overlay
10928     (delete-overlay anything-match-line-overlay)
10929     (anything-match-line-color-current-line)))
10930
10931 (add-hook 'anything-cleanup-hook 'anything-match-line-cleanup)
10932 (add-hook 'anything-after-persistent-action-hook 'anything-match-line-update)
10933
10934 \f
10935 ;;; Actions Transformers
10936 ;;
10937 ;;
10938 ;;; Files
10939 (defun anything-c-transform-file-load-el (actions candidate)
10940   "Add action to load the file CANDIDATE if it is an emacs lisp
10941 file.  Else return ACTIONS unmodified."
10942   (if (member (file-name-extension candidate) '("el" "elc"))
10943       (append actions '(("Load Emacs Lisp File" . load-file)))
10944       actions))
10945
10946 (defun anything-c-transform-file-browse-url (actions candidate)
10947   "Add an action to browse the file CANDIDATE if it in a html
10948 file or URL.  Else return ACTIONS unmodified."
10949   (let ((browse-action '("Browse with Browser" . browse-url)))
10950     (cond ((string-match "^http\\|^ftp" candidate)
10951            (cons browse-action actions))
10952           ((string-match "\\.html?$" candidate)
10953            (append actions (list browse-action)))
10954           (t actions))))
10955
10956 ;;; Function
10957 (defun anything-c-transform-function-call-interactively (actions candidate)
10958   "Add an action to call the function CANDIDATE interactively if
10959 it is a command.  Else return ACTIONS unmodified."
10960   (if (commandp (intern-soft candidate))
10961       (append actions '(("Call Interactively"
10962                          .
10963                          anything-c-call-interactively)))
10964       actions))
10965
10966 ;;;; S-Expressions
10967 (defun anything-c-transform-sexp-eval-command-sexp (actions candidate)
10968   "If CANDIDATE's `car' is a command, then add an action to
10969 evaluate it and put it onto the `command-history'."
10970   (if (commandp (car (read candidate)))
10971       ;; Make it first entry
10972       (cons '("Eval and put onto command-history" .
10973               (lambda (sexp)
10974                 (let ((sym (read sexp)))
10975                   (eval sym)
10976                   (setq command-history
10977                         (cons sym command-history)))))
10978             actions)
10979       actions))
10980
10981 \f
10982 ;;; Candidate Transformers
10983 ;;
10984 ;;
10985 ;;; Buffers
10986 (defun anything-c-skip-boring-buffers (buffers)
10987   (anything-c-skip-entries buffers anything-c-boring-buffer-regexp))
10988
10989 (defun anything-c-skip-current-buffer (buffers)
10990   "[DEPRECATED] Skip current buffer in buffer lists.
10991 This transformer should not be used as this is now handled directly
10992 in `anything-c-buffer-list' and `anything-c-highlight-buffers'."
10993   (if anything-allow-skipping-current-buffer
10994       (remove (buffer-name anything-current-buffer) buffers)
10995       buffers))
10996
10997 (defun anything-c-shadow-boring-buffers (buffers)
10998   "Buffers matching `anything-c-boring-buffer-regexp' will be
10999 displayed with the `file-name-shadow' face if available."
11000   (anything-c-shadow-entries buffers anything-c-boring-buffer-regexp))
11001
11002 (defvar anything-c-buffer-display-string-functions
11003   '(anything-c-buffer-display-string--compilation
11004     anything-c-buffer-display-string--shell
11005     anything-c-buffer-display-string--eshell)
11006   "Functions to setup display string for buffer.
11007
11008 Function has one argument, buffer name.
11009 If it returns string, use it.
11010 If it returns nil, display buffer name.
11011 See `anything-c-buffer-display-string--compilation' for example.")
11012
11013 (defun anything-c-transform-buffer-display-string (buffers)
11014   "Setup display string for buffer candidates
11015 using `anything-c-buffer-display-string-functions'."
11016   (loop for buf in buffers
11017         if (consp buf)
11018         collect buf
11019         else
11020         for disp = (progn (set-buffer buf)
11021                           (run-hook-with-args-until-success
11022                            'anything-c-buffer-display-string-functions buf))
11023         collect (if disp (cons disp buf) buf)))
11024
11025 (defun anything-c-buffer-display-string--compilation (buf)
11026   (anything-aif (car compilation-arguments)
11027       (format "%s: %s [%s]" buf it default-directory)))
11028
11029 (defun anything-c-buffer-display-string--eshell (buf)
11030   (declare (special eshell-history-ring))
11031   (when (eq major-mode 'eshell-mode)
11032     (format "%s: %s [%s]" buf
11033             (ignore-errors (ring-ref eshell-history-ring 0))
11034             default-directory)))
11035
11036 (defun anything-c-buffer-display-string--shell (buf)
11037   (when (eq major-mode 'shell-mode)
11038     (format "%s: %s [%s]" buf
11039             (ignore-errors (ring-ref comint-input-ring 0))
11040             default-directory)))
11041
11042 ;;; Files
11043 (defun anything-c-shadow-boring-files (files)
11044   "Files matching `anything-c-boring-file-regexp' will be
11045 displayed with the `file-name-shadow' face if available."
11046   (anything-c-shadow-entries files anything-c-boring-file-regexp))
11047
11048 (defun anything-c-skip-boring-files (files)
11049   "Files matching `anything-c-boring-file-regexp' will be skipped."
11050   (anything-c-skip-entries files anything-c-boring-file-regexp))
11051 ;; (anything-c-skip-boring-files '("README" "/src/.svn/hoge"))
11052
11053 (defun anything-c-skip-current-file (files)
11054   "Current file will be skipped."
11055   (remove (buffer-file-name anything-current-buffer) files))
11056
11057 (defun anything-c-w32-pathname-transformer (args)
11058   "Change undesirable features of windows pathnames to ones more acceptable to
11059 other candidate transformers."
11060   (if (eq system-type 'windows-nt)
11061       (anything-transform-mapcar
11062        (lambda (x)
11063          (replace-regexp-in-string
11064           "/cygdrive/\\(.\\)" "\\1:"
11065           (replace-regexp-in-string "\\\\" "/" x)))
11066        args)
11067     args))
11068
11069 (defun anything-c-shorten-home-path (files)
11070   "Replaces /home/user with ~."
11071   (let ((home (replace-regexp-in-string "\\\\" "/" ; stupid Windows...
11072                                         (getenv "HOME"))))
11073     (anything-transform-mapcar
11074      (lambda (file)
11075        (if (and (stringp file) (string-match home file))
11076            (replace-match "~" nil nil file)
11077          file))
11078      files)))
11079
11080 ;;; Functions
11081 (defun anything-c-mark-interactive-functions (functions)
11082   "Mark interactive functions (commands) with (i) after the function name."
11083   (let (list)
11084     (loop for function in functions
11085           do (push (cons (concat function
11086                                  (when (commandp (intern-soft function)) " (i)"))
11087                          function)
11088                    list)
11089           finally (return (nreverse list)))))
11090
11091 \f
11092 ;;; Adaptive Sorting of Candidates
11093 ;;
11094 ;;
11095 ;; Internal
11096 (defvar anything-c-adaptive-done nil
11097   "nil if history information is not yet stored for the current
11098 selection.")
11099
11100 (defvar anything-c-adaptive-history nil
11101   "Contains the stored history information.
11102 Format: ((SOURCE-NAME (SELECTED-CANDIDATE (PATTERN . NUMBER-OF-USE) ...) ...) ...)")
11103
11104 ;; Should run at beginning of `anything-initial-setup'.
11105 (add-hook 'anything-before-initialize-hook #'(lambda ()
11106                                                (when anything-c-use-adaptative-sorting
11107                                                  (setq anything-c-adaptive-done nil))))
11108
11109 ;; Should run at beginning of `anything-exit-minibuffer'.
11110 (add-hook 'anything-before-action-hook #'(lambda ()
11111                                           (when anything-c-use-adaptative-sorting
11112                                             (anything-c-adaptive-store-selection))))
11113
11114 ;; Should run at beginning of `anything-select-action'.
11115 (add-hook 'anything-select-action-hook #'(lambda ()
11116                                            (when anything-c-use-adaptative-sorting
11117                                              (anything-c-adaptive-store-selection))))
11118
11119 (defun anything-c-source-use-adaptative-p (&optional source-name)
11120   "Return current source only if it use adaptative history, nil otherwise."
11121   (when anything-c-use-adaptative-sorting
11122     (let* ((source (or source-name (anything-get-current-source)))
11123            (adapt-source (or (assoc-default 'filtered-candidate-transformer
11124                                             (assoc (assoc-default 'type source)
11125                                                    anything-type-attributes))
11126                              (assoc-default 'candidate-transformer
11127                                             (assoc (assoc-default 'type source)
11128                                                    anything-type-attributes))
11129                              (assoc-default 'filtered-candidate-transformer source)
11130                              (assoc-default 'candidate-transformer source))))
11131       (if (listp adapt-source)
11132           (when (member 'anything-c-adaptive-sort adapt-source) source)
11133           (when (eq adapt-source 'anything-c-adaptive-sort) source)))))
11134
11135 (defun anything-c-adaptive-store-selection ()
11136   "Store history information for the selected candidate."
11137   (unless anything-c-adaptive-done
11138     (setq anything-c-adaptive-done t)
11139     (let ((source (anything-c-source-use-adaptative-p)))
11140       (when source
11141         (let* ((source-name (or (assoc-default 'type source)
11142                                 (assoc-default 'name source)))
11143                (source-info (or (assoc source-name anything-c-adaptive-history)
11144                                 (progn
11145                                   (push (list source-name) anything-c-adaptive-history)
11146                                   (car anything-c-adaptive-history))))
11147                (selection (anything-get-selection))
11148                (selection-info (progn
11149                                  (setcdr source-info
11150                                          (cons
11151                                           (let ((found (assoc selection (cdr source-info))))
11152                                             (if (not found)
11153                                                 ;; new entry
11154                                                 (list selection)
11155
11156                                                 ;; move entry to the beginning of the
11157                                                 ;; list, so that it doesn't get
11158                                                 ;; trimmed when the history is
11159                                                 ;; truncated
11160                                                 (setcdr source-info
11161                                                         (delete found (cdr source-info)))
11162                                                 found))
11163                                           (cdr source-info)))
11164                                  (cadr source-info)))
11165                (pattern-info (progn
11166                                (setcdr selection-info
11167                                        (cons
11168                                         (let ((found (assoc anything-pattern (cdr selection-info))))
11169                                           (if (not found)
11170                                               ;; new entry
11171                                               (cons anything-pattern 0)
11172
11173                                               ;; move entry to the beginning of the
11174                                               ;; list, so if two patterns used the
11175                                               ;; same number of times then the one
11176                                               ;; used last appears first in the list
11177                                               (setcdr selection-info
11178                                                       (delete found (cdr selection-info)))
11179                                               found))
11180                                         (cdr selection-info)))
11181                                (cadr selection-info))))
11182
11183           ;; increase usage count
11184           (setcdr pattern-info (1+ (cdr pattern-info)))
11185
11186           ;; truncate history if needed
11187           (if (> (length (cdr selection-info)) anything-c-adaptive-history-length)
11188               (setcdr selection-info
11189                       (subseq (cdr selection-info) 0 anything-c-adaptive-history-length))))))))
11190
11191 (defun anything-c-adaptative-maybe-load-history ()
11192   (when (and anything-c-use-adaptative-sorting
11193              (file-readable-p anything-c-adaptive-history-file))
11194     (load-file anything-c-adaptive-history-file)))
11195
11196 (add-hook 'emacs-startup-hook 'anything-c-adaptative-maybe-load-history)
11197 (add-hook 'kill-emacs-hook 'anything-c-adaptive-save-history)
11198
11199 (defun anything-c-adaptive-save-history (&optional arg)
11200   "Save history information to file given by `anything-c-adaptive-history-file'."
11201   (interactive "p")
11202   (when anything-c-use-adaptative-sorting
11203     (with-temp-buffer
11204       (insert
11205        ";; -*- mode: emacs-lisp -*-\n"
11206        ";; History entries used for anything adaptive display.\n")
11207       (prin1 `(setq anything-c-adaptive-history ',anything-c-adaptive-history)
11208              (current-buffer))
11209       (insert ?\n)
11210       (write-region (point-min) (point-max) anything-c-adaptive-history-file nil
11211                     (unless arg 'quiet)))))
11212
11213 (defun anything-c-adaptive-sort (candidates source)
11214   "Sort the CANDIDATES for SOURCE by usage frequency.
11215 This is a filtered candidate transformer you can use for the
11216 attribute `filtered-candidate-transformer' of a source in
11217 `anything-sources' or a type in `anything-type-attributes'."
11218   (let* ((source-name (or (assoc-default 'type source)
11219                           (assoc-default 'name source)))
11220          (source-info (assoc source-name anything-c-adaptive-history)))
11221     (if source-info
11222         (let ((usage
11223                ;; ... assemble a list containing the (CANIDATE . USAGE-COUNT)
11224                ;; pairs
11225                (mapcar (lambda (candidate-info)
11226                          (let ((count 0))
11227                            (dolist (pattern-info (cdr candidate-info))
11228                              (if (not (equal (car pattern-info)
11229                                              anything-pattern))
11230                                  (incf count (cdr pattern-info))
11231
11232                                  ;; if current pattern is equal to the previously
11233                                  ;; used one then this candidate has priority
11234                                  ;; (that's why its count is boosted by 10000) and
11235                                  ;; it only has to compete with other candidates
11236                                  ;; which were also selected with the same pattern
11237                                  (setq count (+ 10000 (cdr pattern-info)))
11238                                  (return)))
11239                            (cons (car candidate-info) count)))
11240                        (cdr source-info)))
11241               sorted)
11242           (if (and usage (consp usage))
11243               ;; sort the list in descending order, so candidates with highest
11244               ;; priorty come first
11245               (progn
11246                 (setq usage (sort usage (lambda (first second)
11247                                           (> (cdr first) (cdr second)))))
11248
11249                 ;; put those candidates first which have the highest usage count
11250                 (dolist (info usage)
11251                   (when (member* (car info) candidates
11252                                  :test 'anything-c-adaptive-compare)
11253                     (push (car info) sorted)
11254                     (setq candidates (remove* (car info) candidates
11255                                               :test 'anything-c-adaptive-compare))))
11256
11257                 ;; and append the rest
11258                 (append (reverse sorted) candidates nil))
11259               (message "Your `%s' is maybe corrupted or too old, \
11260 you should reinitialize it with `anything-c-reset-adaptative-history'"
11261                        anything-c-adaptive-history-file)
11262               (sit-for 1)
11263               candidates))
11264         ;; if there is no information stored for this source then do nothing
11265         candidates)))
11266
11267 ;;;###autoload
11268 (defun anything-c-reset-adaptative-history ()
11269   "Delete all `anything-c-adaptive-history' and his file.
11270 Useful when you have a old or corrupted `anything-c-adaptive-history-file'."
11271   (interactive)
11272   (when (y-or-n-p "Really delete all your `anything-c-adaptive-history'? ")
11273     (setq anything-c-adaptive-history nil)
11274     (delete-file anything-c-adaptive-history-file)))
11275
11276 (defun anything-c-adaptive-compare (x y)
11277   "Compare candidates X and Y taking into account that the
11278 candidate can be in (DISPLAY . REAL) format."
11279   (equal (if (listp x)
11280              (cdr x)
11281              x)
11282          (if (listp y)
11283              (cdr y)
11284              y)))
11285
11286
11287 \f
11288 ;;; Outliner
11289 ;;
11290 ;;
11291 (defvar anything-outline-goto-near-line-flag t)
11292 (defvar anything-outline-using nil)
11293 (defun anything-after-update-hook--outline ()
11294   (if (and (eq anything-outline-using t)
11295            (eq anything-outline-goto-near-line-flag t))
11296       (anything-outline-goto-near-line)))
11297 (add-hook 'anything-after-update-hook 'anything-after-update-hook--outline)
11298
11299 (defun anything-outline-goto-near-line ()
11300   (with-anything-window
11301     ;; TODO need consideration whether to update position by every input.
11302     (when t ; (equal anything-pattern "")
11303       (anything-goto-line 2)
11304       (let ((lineno (with-anything-current-buffer
11305                       (line-number-at-pos (car anything-current-position)))))
11306         (block exit
11307           (while (<= (progn (skip-chars-forward " ")
11308                             (or (number-at-point) lineno))
11309                      lineno)
11310             (forward-line 1)
11311             (when (eobp)
11312               (forward-line -1)
11313               (return-from exit))))
11314         (forward-line -1)
11315         (and (bobp) (forward-line 1))
11316         (and (anything-pos-header-line-p) (forward-line -2))
11317         (anything-mark-current-line)))))
11318
11319
11320 \f
11321 ;;; Plug-in
11322 ;;
11323 ;;
11324 ;; Plug-in: info-index
11325 (defun* anything-c-info-init (&optional (file (anything-attr 'info-file)))
11326   (let (result)
11327     (unless (anything-candidate-buffer)
11328       (save-window-excursion
11329         (info file)
11330         (let (Info-history
11331               (tobuf (anything-candidate-buffer 'global))
11332               (infobuf (current-buffer))
11333               s e)
11334           (dolist (node (or (anything-attr 'index-nodes) (Info-index-nodes)))
11335             (Info-goto-node node)
11336             (goto-char (point-min))
11337             (while (search-forward "\n* " nil t)
11338               (unless (search-forward "Menu:\n" (1+ (point-at-eol)) t)
11339                 '(save-current-buffer (buffer-substring-no-properties (point-at-bol) (point-at-eol)) result)
11340                 (setq s (point-at-bol)
11341                       e (point-at-eol))
11342                 (with-current-buffer tobuf
11343                   (insert-buffer-substring infobuf s e)
11344                   (insert "\n"))))))))))
11345
11346 (defun anything-c-info-goto (node-line)
11347   (Info-goto-node (car node-line))
11348   (anything-goto-line (cdr node-line)))
11349
11350 (defun anything-c-info-display-to-real (line)
11351   (and (string-match
11352         ;; This regexp is stolen from Info-apropos-matches
11353         "\\* +\\([^\n]*.+[^\n]*\\):[ \t]+\\([^\n]*\\)\\.\\(?:[ \t\n]*(line +\\([0-9]+\\))\\)?" line)
11354        (cons (format "(%s)%s" (anything-attr 'info-file) (match-string 2 line))
11355              (string-to-number (or (match-string 3 line) "1")))))
11356
11357 (defun anything-c-make-info-source (source file)
11358   `(,@source
11359     (name . ,(concat "Info Index: " file))
11360     (info-file . ,file)
11361     (init . anything-c-info-init)
11362     (display-to-real . anything-c-info-display-to-real)
11363     (get-line . buffer-substring)
11364     (candidates-in-buffer)
11365     (action ("Goto node" . anything-c-info-goto))))
11366
11367 (defun anything-compile-source--info-index (source)
11368   (anything-aif (anything-interpret-value (assoc-default 'info-index source))
11369       (anything-c-make-info-source source it)
11370     source))
11371 (add-to-list 'anything-compile-source-functions 'anything-compile-source--info-index)
11372
11373 (anything-document-attribute 'info-index "info-index plugin"
11374                              "Create a source of info index very easily.
11375
11376 ex. (defvar anything-c-source-info-wget '((info-index . \"wget\"))")
11377
11378 (anything-document-attribute 'index-nodes "info-index plugin (optional)"
11379                              "Index nodes of info file.
11380
11381 If it is omitted, `Info-index-nodes' is used to collect index nodes.
11382 Some info files are missing index specification.
11383
11384 ex. See `anything-c-source-info-screen'.")
11385
11386 ;; Plug-in: candidates-file
11387 (defun anything-compile-source--candidates-file (source)
11388   (if (assoc-default 'candidates-file source)
11389       `((init anything-p-candidats-file-init
11390               ,@(let ((orig-init (assoc-default 'init source)))
11391                      (cond ((null orig-init) nil)
11392                            ((functionp orig-init) (list orig-init))
11393                            (t orig-init))))
11394         (candidates-in-buffer)
11395         ,@source)
11396       source))
11397 (add-to-list 'anything-compile-source-functions 'anything-compile-source--candidates-file)
11398
11399 (defun anything-p-candidats-file-init ()
11400   (destructuring-bind (file &optional updating)
11401       (anything-mklist (anything-attr 'candidates-file))
11402     (setq file (anything-interpret-value file))
11403     (with-current-buffer (anything-candidate-buffer (find-file-noselect file))
11404       (when updating
11405         (buffer-disable-undo)
11406         (font-lock-mode -1)
11407         (auto-revert-mode 1)))))
11408
11409 (anything-document-attribute 'candidates-file "candidates-file plugin"
11410                              "Use a file as the candidates buffer.
11411
11412 1st argument is a filename, string or function name or variable name.
11413 If optional 2nd argument is non-nil, the file opened with `auto-revert-mode'.")
11414
11415 ;; Plug-in: headline
11416 (defun anything-compile-source--anything-headline (source)
11417   (if (assoc-default 'headline source)
11418       (append '((init . anything-headline-init)
11419                 (get-line . buffer-substring)
11420                 (type . line))
11421               source
11422               '((candidates-in-buffer)
11423                 (persistent-help . "Show this line")))
11424       source))
11425 (add-to-list 'anything-compile-source-functions 'anything-compile-source--anything-headline)
11426
11427 (defun anything-headline-init ()
11428   (when (and (anything-current-buffer-is-modified)
11429              (with-anything-current-buffer
11430                (eval (or (anything-attr 'condition) t))))
11431     (anything-headline-make-candidate-buffer
11432      (anything-interpret-value (anything-attr 'headline))
11433      (anything-interpret-value (anything-attr 'subexp)))))
11434
11435 (anything-document-attribute 'headline "Headline plug-in"
11436                              "Regexp string for anything-headline to scan.")
11437 (anything-document-attribute 'condition "Headline plug-in"
11438                              "A sexp representing the condition to use anything-headline.")
11439 (anything-document-attribute 'subexp "Headline plug-in"
11440                              "Display (match-string-no-properties subexp).")
11441
11442 ;; Le Wang: Note on how `anything-head-line-get-candidates' works with a list
11443 ;; of regexps.
11444 ;;
11445 ;;   1. Create list of ((title . start-of-match) . hiearchy)
11446 ;;   2. Sort this list by start-of-match.
11447 ;;   3. Go through sorted list and return titles that reflect full hiearchy.
11448 ;;
11449 ;; It's quite brilliantly written.
11450 ;;
11451
11452
11453 (defun anything-headline-get-candidates (regexp subexp)
11454   (with-anything-current-buffer
11455     (save-excursion
11456       (goto-char (point-min))
11457       (if (functionp regexp) (setq regexp (funcall regexp)))
11458       (let (hierarchy curhead)
11459         (flet ((matched ()
11460                  (if (numberp subexp)
11461                      (cons (match-string-no-properties subexp) (match-beginning subexp))
11462                      (cons (buffer-substring (point-at-bol) (point-at-eol))
11463                            (point-at-bol))))
11464                (hierarchies (headlines)
11465                  (1+ (loop for (_ . hierarchy) in headlines
11466                            maximize hierarchy)))
11467                (vector-0-n (v n)
11468                  (loop for i from 0 to hierarchy
11469                        collecting (aref curhead i)))
11470                (arrange (headlines)
11471                  (unless (null headlines) ; FIX headlines empty bug!
11472                    (loop with curhead = (make-vector (hierarchies headlines) "")
11473                          for ((str . pt) . hierarchy) in headlines
11474                          do (aset curhead hierarchy str)
11475                          collecting
11476                          (cons
11477                           (format "H%d:%s" (1+ hierarchy)
11478                                   (mapconcat 'identity (vector-0-n curhead hierarchy) " / "))
11479                           pt)))))
11480           (if (listp regexp)
11481               (arrange
11482                (sort
11483                 (loop for re in regexp
11484                       for hierarchy from 0
11485                       do (goto-char (point-min))
11486                       appending
11487                       (loop
11488                             while (re-search-forward re nil t)
11489                             collect (cons (matched) hierarchy)))
11490                 (lambda (a b) (> (cdar b) (cdar a)))))
11491               (loop while (re-search-forward regexp nil t)
11492                     collect (matched))))))))
11493
11494
11495 (defun anything-headline-make-candidate-buffer (regexp subexp)
11496   (with-current-buffer (anything-candidate-buffer 'local)
11497     (loop for (content . pos) in (anything-headline-get-candidates regexp subexp)
11498           do (insert
11499               (format "%5d:%s\n"
11500                       (with-anything-current-buffer
11501                         (line-number-at-pos pos))
11502                       content)))))
11503
11504 (defun anything-headline-goto-position (pos recenter)
11505   (goto-char pos)
11506   (unless recenter
11507     (set-window-start (get-buffer-window anything-current-buffer) (point))))
11508
11509
11510 ;; Plug-in: persistent-help
11511 (defun anything-compile-source--persistent-help (source)
11512   (append source '((header-line . anything-persistent-help-string))))
11513 (add-to-list 'anything-compile-source-functions 'anything-compile-source--persistent-help)
11514
11515 (defun anything-persistent-help-string ()
11516   (substitute-command-keys
11517    (concat "\\<anything-map>\\[anything-execute-persistent-action]: "
11518            (or (anything-interpret-value (anything-attr 'persistent-help))
11519                (anything-aif (or (assoc-default 'persistent-action
11520                                                 (anything-get-current-source))
11521                                  (assoc-default 'action
11522                                                 (anything-get-current-source)))
11523                    (cond ((symbolp it) (symbol-name it))
11524                          ((listp it) (or (ignore-errors (caar it))  ""))))
11525                "")
11526            " (keeping session)")))
11527
11528 (anything-document-attribute 'persistent-help "persistent-help plug-in"
11529                              "A string to explain persistent-action of this source.
11530 It also accepts a function or a variable name.")
11531
11532 ;;; (anything '(((name . "persistent-help test")(candidates "a")(persistent-help . "TEST"))))
11533
11534 ;; Plug-in: Type customize
11535 (defun anything-c-uniq-list (lst)
11536   "Like `remove-duplicates' in CL.
11537 But cut deeper duplicates and test by `equal'. "
11538   (reverse (remove-duplicates (reverse lst) :test 'equal)))
11539 (defvar anything-additional-type-attributes nil)
11540 (defun anything-c-arrange-type-attribute (type spec)
11541   "Override type attributes by `define-anything-type-attribute'.
11542
11543 The SPEC is like source. The symbol `REST' is replaced
11544 with original attribute value.
11545
11546  Example: Set `play-sound-file' as default action
11547    (anything-c-arrange-type-attribute 'file
11548       '((action (\"Play sound\" . play-sound-file)
11549          REST ;; Rest of actions (find-file, find-file-other-window, etc...)."
11550   (setq anything-additional-type-attributes
11551         (delete (assq type anything-additional-type-attributes)
11552                 anything-additional-type-attributes))
11553   (add-to-list 'anything-additional-type-attributes
11554                (cons type
11555                      (loop with typeattr = (assoc-default
11556                                             type anything-type-attributes)
11557                            for (attr . value) in spec
11558                            if (listp value)
11559                            collect (cons attr
11560                                          (anything-c-uniq-list
11561                                           (loop for v in value
11562                                                 if (eq v 'REST)
11563                                                 append
11564                                                 (assoc-default attr typeattr)
11565                                                 else
11566                                                 collect v)))
11567                            else
11568                            collect (cons attr value)))))
11569 (put 'anything-c-arrange-type-attribute 'lisp-indent-function 1)
11570
11571 (defun anything-compile-source--type-customize (source)
11572   (anything-aif (assoc-default (assoc-default 'type source)
11573                                anything-additional-type-attributes)
11574       (append source it)
11575     source))
11576 (setq anything-compile-source-functions
11577       (delete 'anything-compile-source--type anything-compile-source-functions))
11578 (add-to-list 'anything-compile-source-functions
11579              'anything-compile-source--type-customize t)
11580
11581 ;; Plug-in: default-action
11582 (defun anything-compile-source--default-action (source)
11583   (anything-aif (assoc-default 'default-action source)
11584       (append `((action ,it ,@(remove it (assoc-default 'action source))))
11585               source)
11586     source))
11587 (add-to-list 'anything-compile-source-functions
11588              'anything-compile-source--default-action t)
11589 (anything-document-attribute 'default-action "default-action plug-in"
11590                              "Default action.")
11591
11592 \f
11593 ;;; Type Attributes
11594 ;;
11595 ;;
11596 (define-anything-type-attribute 'buffer
11597     `((action
11598        ("Switch to buffer" . anything-c-switch-to-buffer)
11599        ,(and (locate-library "popwin") '("Switch to buffer in popup window" . popwin:popup-buffer))
11600        ("Switch to buffer other window" . switch-to-buffer-other-window)
11601        ("Switch to buffer other frame" . switch-to-buffer-other-frame)
11602        ,(and (locate-library "elscreen") '("Display buffer in Elscreen" . anything-find-buffer-on-elscreen))
11603        ("Query replace regexp" . anything-c-buffer-query-replace-regexp)
11604        ("Query replace" . anything-c-buffer-query-replace)
11605        ("View buffer" . view-buffer)
11606        ("Display buffer"   . display-buffer)
11607        ("Grep buffers (C-u grep all buffers)" . anything-c-zgrep-buffers)
11608        ("Revert buffer(s)" . anything-revert-marked-buffers)
11609        ("Insert buffer" . insert-buffer)
11610        ("Kill buffer(s)" . anything-kill-marked-buffers)
11611        ("Diff with file" . diff-buffer-with-file)
11612        ("Ediff Marked buffers" . anything-ediff-marked-buffers)
11613        ("Ediff Merge marked buffers" . (lambda (candidate)
11614                                          (anything-ediff-marked-buffers candidate t))))
11615       (persistent-help . "Show this buffer")
11616       (candidate-transformer anything-c-skip-boring-buffers
11617                              anything-c-transform-buffer-display-string))
11618   "Buffer or buffer name.")
11619
11620 (define-anything-type-attribute 'file
11621     `((action
11622        ("Find file" . anything-find-many-files)
11623        ,(and (locate-library "popwin") '("Find file in popup window" . popwin:find-file))
11624        ("Find file as root" . anything-find-file-as-root)
11625        ("Find file other window" . find-file-other-window)
11626        ("Find file other frame" . find-file-other-frame)
11627        ("Open dired in file's directory" . anything-c-open-dired)
11628        ("Grep File(s) `C-u recurse'" . anything-find-files-grep)
11629        ("Zgrep File(s) `C-u Recurse'" . anything-ff-zgrep)
11630        ("Pdfgrep File(s)" . anything-ff-pdfgrep)
11631        ("Checksum File" . anything-ff-checksum)
11632        ("Ediff File" . anything-find-files-ediff-files)
11633        ("Ediff Merge File" . anything-find-files-ediff-merge-files)
11634        ("View file" . view-file)
11635        ("Insert file" . insert-file)
11636        ("Delete file(s)" . anything-delete-marked-files)
11637        ("Open file externally (C-u to choose)" . anything-c-open-file-externally)
11638        ("Open file with default tool" . anything-c-open-file-with-default-tool)
11639        ("Find file in hex dump" . hexl-find-file))
11640       (persistent-help . "Show this file")
11641       (action-transformer anything-c-transform-file-load-el
11642                           anything-c-transform-file-browse-url)
11643       (candidate-transformer anything-c-w32-pathname-transformer
11644                              anything-c-skip-current-file
11645                              anything-c-skip-boring-files
11646                              anything-c-shorten-home-path))
11647   "File name.")
11648
11649 (let ((actions '(("Describe command" . describe-function)
11650                  ("Add command to kill ring" . anything-c-kill-new)
11651                  ("Go to command's definition" . find-function)
11652                  ("Debug on entry" . debug-on-entry)
11653                  ("Cancel debug on entry" . cancel-debug-on-entry)
11654                  ("Trace function" . trace-function)
11655                  ("Trace function (background)" . trace-function-background)
11656                  ("Untrace function" . untrace-function))))
11657   (define-anything-type-attribute 'command
11658       `((action ("Call interactively" . anything-c-call-interactively)
11659                 ,@actions)
11660         (coerce . anything-c-symbolify)
11661         (persistent-action . describe-function))
11662     "Command. (string or symbol)")
11663
11664   (define-anything-type-attribute 'function
11665       `((action . ,actions)
11666         (action-transformer anything-c-transform-function-call-interactively)
11667         (candidate-transformer anything-c-mark-interactive-functions)
11668         (coerce . anything-c-symbolify))
11669     "Function. (string or symbol)"))
11670
11671 (define-anything-type-attribute 'variable
11672     '((action ("Describe variable" . describe-variable)
11673        ("Add variable to kill ring" . anything-c-kill-new)
11674        ("Go to variable's definition" . find-variable)
11675        ("Set variable" . anything-c-set-variable))
11676       (coerce . anything-c-symbolify))
11677   "Variable.")
11678
11679 (define-anything-type-attribute 'sexp
11680     '((action ("Eval s-expression" . (lambda (c) (eval (read c))))
11681        ("Add s-expression to kill ring" . kill-new))
11682       (action-transformer anything-c-transform-sexp-eval-command-sexp))
11683   "String representing S-Expressions.")
11684
11685 (define-anything-type-attribute 'bookmark
11686     `((coerce . anything-bookmark-get-bookmark-from-name)
11687       (action
11688        ("Jump to bookmark" . anything-c-bookmark-jump)
11689        ("Jump to BM other window" . bookmark-jump-other-window)
11690        ("Bookmark edit annotation" . bookmark-edit-annotation)
11691        ("Bookmark show annotation" . bookmark-show-annotation)
11692        ("Delete bookmark(s)" . anything-delete-marked-bookmarks)
11693        ,@(and (locate-library "bookmark-extensions")
11694               `(("Edit Bookmark" . bmkext-edit-bookmark)))
11695        ("Rename bookmark" . bookmark-rename)
11696        ("Relocate bookmark" . bookmark-relocate))
11697       (keymap . ,anything-c-bookmark-map)
11698       (mode-line . anything-bookmark-mode-line-string))
11699   "Bookmark name.")
11700
11701 (define-anything-type-attribute 'line
11702     '((display-to-real . anything-c-display-to-real-line)
11703       (action ("Go to Line" . anything-c-action-line-goto)))
11704   "LINENO:CONTENT string, eg. \"  16:foo\".
11705
11706 Optional `target-file' attribute is a name of target file.
11707
11708 Optional `before-jump-hook' attribute is a function with no
11709 arguments which is called before jumping to position.
11710
11711 Optional `after-jump-hook' attribute is a function with no
11712 arguments which is called after jumping to position.
11713
11714 If `adjust' attribute is specified, searches the line whose
11715 content is CONTENT near the LINENO.
11716
11717 If `recenter' attribute is specified, the line is displayed at
11718 the center of window, otherwise at the top of window.
11719 ")
11720
11721 (define-anything-type-attribute 'file-line
11722     `((filtered-candidate-transformer anything-c-filtered-candidate-transformer-file-line)
11723       (multiline)
11724       (action ("Go to" . anything-c-action-file-line-goto)))
11725   "FILENAME:LINENO:CONTENT string, eg. \"~/.emacs:16:;; comment\".
11726
11727 Optional `default-directory' attribute is a default-directory
11728 FILENAME is interpreted.
11729
11730 Optional `before-jump-hook' attribute is a function with no
11731 arguments which is called before jumping to position.
11732
11733 Optional `after-jump-hook' attribute is a function with no
11734 arguments which is called after jumping to position.
11735
11736 If `adjust' attribute is specified, searches the line whose
11737 content is CONTENT near the LINENO.
11738
11739 If `recenter' attribute is specified, the line is displayed at
11740 the center of window, otherwise at the top of window.
11741 ")
11742
11743 (define-anything-type-attribute 'timer
11744     '((real-to-display . anything-c-timer-real-to-display)
11745       (action ("Cancel Timer" . cancel-timer)
11746        ("Describe Function" . (lambda (tm) (describe-function (timer--function tm))))
11747        ("Find Function" . (lambda (tm) (find-function (timer--function tm)))))
11748       (persistent-action . (lambda (tm) (describe-function (timer--function tm))))
11749       (persistent-help . "Describe Function"))
11750   "Timer.")
11751
11752 \f
11753 ;;; Default `anything-sources'
11754 ;; Setting `anything-sources' is DEPRECATED, but it seems that newbies
11755 ;; tend to invoke M-x anything directly. So I offer default setting.
11756 (setq anything-sources
11757       '(anything-c-source-buffers-list
11758         anything-c-source-recentf
11759         anything-c-source-files-in-current-dir+))
11760
11761 \f
11762 ;;; Preconfigured Anything
11763 ;;
11764 ;;
11765 ;;;###autoload
11766 (defun anything-mini ()
11767   "Preconfigured `anything' lightweight version \(buffer -> recentf\)."
11768   (interactive)
11769   (anything-other-buffer '(anything-c-source-buffers-list
11770                            anything-c-source-recentf
11771                            anything-c-source-buffer-not-found)
11772                          "*anything mini*"))
11773 ;;;###autoload
11774 (defun anything-for-files ()
11775   "Preconfigured `anything' for opening files.
11776 ffap -> recentf -> buffer -> bookmark -> file-cache -> files-in-current-dir -> locate."
11777   (interactive)
11778   (anything-other-buffer anything-for-files-prefered-list "*anything for files*"))
11779
11780 ;;;###autoload
11781 (defun anything-recentf ()
11782   "Preconfigured `anything' for `recentf'."
11783   (interactive)
11784   (anything-other-buffer 'anything-c-source-recentf "*anything recentf*"))
11785
11786 ;;;###autoload
11787 (defun anything-info-at-point (arg)
11788   "Preconfigured `anything' for searching info at point.
11789 With a prefix-arg insert symbol at point."
11790   (interactive "P")
11791   (let ((anything-c-google-suggest-default-function
11792          'anything-c-google-suggest-emacs-lisp))
11793     (anything :sources '(anything-c-source-info-elisp
11794                          anything-c-source-info-cl
11795                          anything-c-source-info-pages
11796                          anything-c-source-google-suggest)
11797               :input (and arg (thing-at-point 'symbol))
11798               :buffer "*anything info*")))
11799
11800 ;;;###autoload
11801 (defun anything-show-kill-ring ()
11802   "Preconfigured `anything' for `kill-ring'.
11803 It is drop-in replacement of `yank-pop'.
11804 You may bind this command to M-y.
11805 First call open the kill-ring browser, next calls move to next line."
11806   (interactive)
11807   (let ((enable-recursive-minibuffers t))
11808     (anything :sources 'anything-c-source-kill-ring
11809               :buffer "*anything kill-ring*")))
11810
11811 ;;;###autoload
11812 (defun anything-minibuffer-history ()
11813   "Preconfigured `anything' for `minibuffer-history'."
11814   (interactive)
11815   (let ((enable-recursive-minibuffers t))
11816     (anything-other-buffer 'anything-c-source-minibuffer-history
11817                            "*anything minibuffer-history*")))
11818
11819 ;;;###autoload
11820 (defun anything-gentoo ()
11821   "Preconfigured `anything' for gentoo linux."
11822   (interactive)
11823   (anything-other-buffer '(anything-c-source-gentoo
11824                            anything-c-source-use-flags)
11825                          "*anything gentoo*"))
11826
11827 ;;;###autoload
11828 (defun anything-imenu ()
11829   "Preconfigured `anything' for `imenu'."
11830   (interactive)
11831   (anything :sources 'anything-c-source-imenu
11832             :buffer "*anything imenu*"))
11833
11834 ;;;###autoload
11835 (defun anything-google-suggest ()
11836   "Preconfigured `anything' for google search with google suggest."
11837   (interactive)
11838   (anything-other-buffer 'anything-c-source-google-suggest "*anything google*"))
11839
11840 ;;;###autoload
11841 (defun anything-yahoo-suggest ()
11842   "Preconfigured `anything' for Yahoo searching with Yahoo suggest."
11843   (interactive)
11844   (anything-other-buffer 'anything-c-source-yahoo-suggest "*anything yahoo*"))
11845
11846 ;;; Converted from anything-show-*-only
11847 ;;;###autoload
11848 (defun anything-for-buffers ()
11849   "Preconfigured `anything' for buffers."
11850   (interactive)
11851   (anything-other-buffer 'anything-c-source-buffers "*anything for buffers*"))
11852
11853 ;;;###autoload
11854 (defun anything-buffers-list ()
11855   "Preconfigured `anything' to list buffers.
11856 It is an enhanced version of `anything-for-buffers'."
11857   (interactive)
11858   (anything :sources '(anything-c-source-buffers-list
11859                        anything-c-source-buffer-not-found)
11860             :buffer "*anything buffers*" :keymap anything-c-buffer-map))
11861
11862 (defalias 'anything-buffers+ 'anything-buffers-list
11863   "Preconfigured `anything' to list buffers.
11864 It is an alias of `anything-buffers-list'.")
11865
11866 ;;;###autoload
11867 (defun anything-bbdb ()
11868   "Preconfigured `anything' for BBDB.
11869
11870 Needs BBDB.
11871
11872 http://bbdb.sourceforge.net/"
11873   (interactive)
11874   (anything-other-buffer 'anything-c-source-bbdb "*anything bbdb*"))
11875
11876 ;;;###autoload
11877 (defun anything-locate (arg)
11878   "Preconfigured `anything' for Locate.
11879 Note: you can add locate options after entering pattern.
11880 See 'man locate' for valid options.
11881
11882 You can specify a specific database with prefix argument ARG \(C-u\).
11883 Many databases can be used: navigate and mark them.
11884 See also `anything-locate-with-db'.
11885
11886 To create a user specific db, use
11887 \"updatedb -l 0 -o db_path -U directory\".
11888 Where db_path is a filename matched by
11889 `anything-locate-db-file-regexp'."
11890   (interactive "P")
11891   (setq anything-ff-default-directory default-directory)
11892   (anything-locate-1 arg))
11893
11894 ;;;###autoload
11895 (defun anything-w3m-bookmarks ()
11896   "Preconfigured `anything' for w3m bookmark.
11897
11898 Needs w3m and emacs-w3m.
11899
11900 http://w3m.sourceforge.net/
11901 http://emacs-w3m.namazu.org/"
11902   (interactive)
11903   (anything-other-buffer 'anything-c-source-w3m-bookmarks
11904                          "*anything w3m bookmarks*"))
11905
11906 ;;;###autoload
11907 (defun anything-firefox-bookmarks ()
11908   "Preconfigured `anything' for firefox bookmark.
11909 You will have to enable html bookmarks in firefox:
11910 open about:config in firefox and double click on this line to enable value \
11911 to true:
11912
11913 user_pref(\"browser.bookmarks.autoExportHTML\", false);
11914
11915 You should have now:
11916
11917 user_pref(\"browser.bookmarks.autoExportHTML\", true);
11918
11919 After closing firefox, you will be able to browse you bookmarks.
11920 "
11921   (interactive)
11922   (anything-other-buffer 'anything-c-source-firefox-bookmarks
11923                          "*Anything Firefox*"))
11924
11925 ;;;###autoload
11926 (defun anything-colors ()
11927   "Preconfigured `anything' for color."
11928   (interactive)
11929   (anything-other-buffer
11930    '(anything-c-source-colors anything-c-source-customize-face)
11931    "*anything colors*"))
11932
11933 ;;;###autoload
11934 (defun anything-bookmarks ()
11935   "Preconfigured `anything' for bookmarks."
11936   (interactive)
11937   (anything-other-buffer 'anything-c-source-bookmarks "*anything bookmarks*"))
11938
11939 ;;;###autoload
11940 (defun anything-c-pp-bookmarks ()
11941   "Preconfigured `anything' for bookmarks (pretty-printed)."
11942   (interactive)
11943   (anything-other-buffer '(anything-c-source-bookmarks-local
11944                            anything-c-source-bookmarks-su
11945                            anything-c-source-bookmarks-ssh)
11946                          "*anything pp bookmarks*"))
11947
11948 ;;;###autoload
11949 (defun anything-c-insert-latex-math ()
11950   "Preconfigured anything for latex math symbols completion."
11951   (interactive)
11952   (anything-other-buffer 'anything-c-source-latex-math "*anything latex*"))
11953
11954 ;;;###autoload
11955 (defun anything-register ()
11956   "Preconfigured `anything' for Emacs registers."
11957   (interactive)
11958   (anything-other-buffer 'anything-c-source-register "*anything register*"))
11959
11960 ;;;###autoload
11961 (defun anything-man-woman ()
11962   "Preconfigured `anything' for Man and Woman pages."
11963   (interactive)
11964   (anything-other-buffer 'anything-c-source-man-pages "*Anything man woman*"))
11965
11966 ;;;###autoload
11967 (defun anything-org-keywords ()
11968   "Preconfigured `anything' for org keywords."
11969   (interactive)
11970   (anything-other-buffer 'anything-c-source-org-keywords "*org keywords*"))
11971
11972 ;;;###autoload
11973 (defun anything-emms ()
11974   "Preconfigured `anything' for emms sources."
11975   (interactive)
11976   (anything :sources '(anything-c-source-emms-streams
11977                        anything-c-source-emms-files
11978                        anything-c-source-emms-dired)
11979             :buffer "*Anything Emms*"))
11980
11981 ;;;###autoload
11982 (defun anything-eev-anchors ()
11983   "Preconfigured `anything' for eev anchors."
11984   (interactive)
11985   (anything-other-buffer 'anything-c-source-eev-anchor "*Anything eev anchors*"))
11986
11987 ;;;###autoload
11988 (defun anything-bm-list ()
11989   "Preconfigured `anything' for visible bookmarks.
11990
11991 Needs bm.el
11992
11993 http://cvs.savannah.gnu.org/viewvc/*checkout*/bm/bm/bm.el"
11994   (interactive)
11995   (let ((anything-outline-using t))
11996     (anything-other-buffer 'anything-c-source-bm "*anything bm list*")))
11997
11998 ;;;###autoload
11999 (defun anything-timers ()
12000   "Preconfigured `anything' for timers."
12001   (interactive)
12002   (anything-other-buffer '(anything-c-source-absolute-time-timers
12003                            anything-c-source-idle-time-timers)
12004                          "*anything timers*"))
12005
12006 ;;;###autoload
12007 (defun anything-list-emacs-process ()
12008   "Preconfigured `anything' for emacs process."
12009   (interactive)
12010   (anything-other-buffer 'anything-c-source-emacs-process "*anything process*"))
12011
12012 ;;;###autoload
12013 (defun anything-occur ()
12014   "Preconfigured Anything for Occur source.
12015 If region is active, search only in region,
12016 otherwise search in whole buffer."
12017   (interactive)
12018   (let ((anything-compile-source-functions
12019          ;; rule out anything-match-plugin because the input is one regexp.
12020          (delq 'anything-compile-source--match-plugin
12021                (copy-sequence anything-compile-source-functions))))
12022     (anything :sources 'anything-c-source-occur
12023               :buffer "*Anything Occur*"
12024               :history 'anything-c-grep-history)))
12025
12026 ;;;###autoload
12027 (defun anything-browse-code ()
12028   "Preconfigured anything to browse code."
12029   (interactive)
12030   (anything :sources 'anything-c-source-browse-code
12031             :buffer "*anything browse code*"
12032             :default (thing-at-point 'symbol)))
12033
12034 ;;;###autoload
12035 (defun anything-org-headlines ()
12036   "Preconfigured anything to show org headlines."
12037   (interactive)
12038   (anything-other-buffer 'anything-c-source-org-headline "*org headlines*"))
12039
12040 ;;;###autoload
12041 (defun anything-regexp ()
12042   "Preconfigured anything to build regexps.
12043 `query-replace-regexp' can be run from there against found regexp."
12044   (interactive)
12045   (save-restriction
12046     (let ((anything-compile-source-functions
12047            ;; rule out anything-match-plugin because the input is one regexp.
12048            (delq 'anything-compile-source--match-plugin
12049                  (copy-sequence anything-compile-source-functions))))
12050       (when (and (anything-region-active-p)
12051                  ;; Don't narrow to region if buffer is already narrowed.
12052                  (not (anything-current-buffer-narrowed-p)))
12053         (narrow-to-region (region-beginning) (region-end)))
12054       (anything :sources anything-c-source-regexp
12055                 :buffer "*anything regexp*"
12056                 :prompt "Regexp: "
12057                 :history 'anything-build-regexp-history))))
12058
12059 ;;;###autoload
12060 (defun anything-c-copy-files-async ()
12061   "Preconfigured anything to copy file list FLIST to DEST asynchronously."
12062   (interactive)
12063   (let* ((flist (anything-c-read-file-name
12064                  "Copy File async: "
12065                  :marked-candidates t))
12066          (dest  (anything-c-read-file-name
12067                  "Copy File async To: "
12068                  :preselect (car flist)
12069                  :initial-input (car anything-ff-history)
12070                  :history (anything-find-files-history :comp-read nil))))
12071     (anything-c-copy-async-with-log flist dest)))
12072
12073 ;;;###autoload
12074 (defun anything-find-files (arg)
12075   "Preconfigured `anything' for anything implementation of `find-file'.
12076 Called with a prefix arg show history if some.
12077 Don't call it from programs, use `anything-find-files-1' instead.
12078 This is the starting point for nearly all actions you can do on files."
12079   (interactive "P")
12080   (let ((any-input (if (and arg anything-ff-history)
12081                        (anything-find-files-history)
12082                        (anything-find-files-initial-input)))
12083         (presel    (buffer-file-name (current-buffer))))
12084     (when (and (eq major-mode 'org-agenda-mode)
12085                org-directory
12086                (not any-input))
12087       (setq any-input (expand-file-name org-directory)))
12088     (set-text-properties 0 (length any-input) nil any-input)
12089     (if any-input
12090         (anything-find-files-1 any-input)
12091         (setq any-input (expand-file-name (anything-c-current-directory)))
12092         (anything-find-files-1
12093          any-input (if anything-ff-transformer-show-only-basename
12094                        (and presel (anything-c-basename presel))
12095                        presel)))))
12096
12097 ;;;###autoload
12098 (defun anything-write-file ()
12099   "Preconfigured `anything' providing completion for `write-file'."
12100   (interactive)
12101   (let ((anything-mp-highlight-delay nil))
12102     (anything :sources 'anything-c-source-write-file
12103               :input (expand-file-name default-directory)
12104               :prompt "Write buffer to file: "
12105               :buffer "*Anything write file*")))
12106
12107 ;;;###autoload
12108 (defun anything-insert-file ()
12109   "Preconfigured `anything' providing completion for `insert-file'."
12110   (interactive)
12111   (let ((anything-mp-highlight-delay nil))
12112     (anything :sources 'anything-c-source-insert-file
12113               :input (expand-file-name default-directory)
12114               :prompt "Insert file: "
12115               :buffer "*Anything insert file*")))
12116
12117 ;;;###autoload
12118 (defun anything-dired-rename-file ()
12119   "Preconfigured `anything' to rename files from dired."
12120   (interactive)
12121   (anything-dired-do-action-on-file :action 'rename))
12122
12123 ;;;###autoload
12124 (defun anything-dired-copy-file ()
12125   "Preconfigured `anything' to copy files from dired."
12126   (interactive)
12127   (anything-dired-do-action-on-file :action 'copy))
12128
12129 ;;;###autoload
12130 (defun anything-dired-symlink-file ()
12131   "Preconfigured `anything' to symlink files from dired."
12132   (interactive)
12133   (anything-dired-do-action-on-file :action 'symlink))
12134
12135 ;;;###autoload
12136 (defun anything-dired-hardlink-file ()
12137   "Preconfigured `anything' to hardlink files from dired."
12138   (interactive)
12139   (anything-dired-do-action-on-file :action 'hardlink))
12140
12141 ;;;###autoload
12142 (defun anything-do-grep ()
12143   "Preconfigured anything for grep.
12144 Contrarily to Emacs `grep' no default directory is given, but
12145 the full path of candidates in ONLY.
12146 That allow to grep different files not only in `default-directory' but anywhere
12147 by marking them (C-<SPACE>). If one or more directory is selected
12148 grep will search in all files of these directories.
12149 You can use also wildcard in the base name of candidate.
12150 If a prefix arg is given use the -r option of grep.
12151 The prefix arg can be passed before or after start.
12152 See also `anything-do-grep-1'."
12153   (interactive)
12154   (let ((only    (anything-c-read-file-name
12155                   "Search in file(s): "
12156                   :marked-candidates t
12157                   :preselect (or (dired-get-filename nil t)
12158                                  (buffer-file-name (current-buffer)))))
12159         (prefarg (or current-prefix-arg anything-current-prefix-arg)))
12160     (anything-do-grep-1 only prefarg)))
12161
12162 ;;;###autoload
12163 (defun anything-do-zgrep ()
12164   "Preconfigured anything for zgrep."
12165   (interactive)
12166   (let ((prefarg (or current-prefix-arg anything-current-prefix-arg))
12167         (ls (anything-c-read-file-name
12168              "Search in file(s): "
12169              :marked-candidates t
12170              :preselect (or (dired-get-filename nil t)
12171                             (buffer-file-name (current-buffer))))))
12172     (anything-ff-zgrep-1 ls prefarg)))
12173
12174 ;;;###autoload
12175 (defun anything-do-pdfgrep ()
12176   "Preconfigured anything for pdfgrep."
12177   (interactive)
12178   (let ((only (anything-c-read-file-name
12179                "Search in file(s): "
12180                :marked-candidates t
12181                :test #'(lambda (file)
12182                          (or (string= (file-name-extension file) "pdf")
12183                              (string= (file-name-extension file) "PDF")
12184                              (file-directory-p file)))
12185                :preselect (or (dired-get-filename nil t)
12186                               (buffer-file-name (current-buffer)))))
12187         (anything-c-grep-default-function 'anything-c-pdfgrep-init))
12188     (anything-do-pdfgrep-1 only)))
12189
12190 ;;;###autoload
12191 (defun anything-c-etags-select (arg)
12192   "Preconfigured anything for etags.
12193 Called with one prefix arg use symbol at point as initial input.
12194 Called with two prefix arg reinitialize cache.
12195 If tag file have been modified reinitialize cache."
12196   (interactive "P")
12197   (let ((tag  (anything-c-etags-get-tag-file))
12198         (init (and (equal arg '(4)) (thing-at-point 'symbol)))
12199         (anything-quit-if-no-candidate t)
12200         (anything-execute-action-at-once-if-one t)
12201         (anything-compile-source-functions
12202          (if anything-c-etags-use-regexp-search
12203              ;; rule out anything-match-plugin because the input is one regexp.
12204              (delq 'anything-compile-source--match-plugin
12205                    (copy-sequence anything-compile-source-functions))
12206              anything-compile-source-functions)))
12207     (when (or (equal arg '(16))
12208               (and anything-c-etags-mtime-alist
12209                    (anything-c-etags-file-modified-p tag)))
12210       (remhash tag anything-c-etags-cache))
12211     (if (and tag (file-exists-p tag))
12212         (anything :sources 'anything-c-source-etags-select
12213                   :keymap anything-c-etags-map
12214                   :input init
12215                   :buffer "*anything etags*")
12216         (message "Error: No tag file found, please create one with etags shell command."))))
12217
12218 ;;;###autoload
12219 (defun anything-filelist ()
12220   "Preconfigured `anything' to open files instantly.
12221
12222 See `anything-c-filelist-file-name' docstring for usage."
12223   (interactive)
12224   (anything-other-buffer 'anything-c-source-filelist "*anything file list*"))
12225
12226 ;;;###autoload
12227 (defun anything-filelist+ ()
12228   "Preconfigured `anything' to open files/buffers/bookmarks instantly.
12229
12230 This is a replacement for `anything-for-files'.
12231 See `anything-c-filelist-file-name' docstring for usage."
12232   (interactive)
12233   (anything-other-buffer
12234    '(anything-c-source-ffap-line
12235      anything-c-source-ffap-guesser
12236      anything-c-source-buffers-list
12237      anything-c-source-recentf
12238      anything-c-source-bookmarks
12239      anything-c-source-file-cache
12240      anything-c-source-filelist)
12241    "*anything file list*"))
12242
12243 ;;;###autoload
12244 (defun anything-M-x ()
12245   "Preconfigured `anything' for Emacs commands.
12246 It is `anything' replacement of regular `M-x' `execute-extended-command'."
12247   (interactive)
12248   (let* (in-help
12249          help-cand
12250          special-display-buffer-names
12251          special-display-regexps
12252          anything-persistent-action-use-special-display
12253          (history (loop with hist
12254                         for i in extended-command-history
12255                         for com = (intern i)
12256                         when (fboundp com)
12257                         collect i into hist finally return hist)))
12258     (flet ((pers-help (candidate)
12259              (let ((hbuf (get-buffer (help-buffer))))
12260                (if (and in-help (string= candidate help-cand))
12261                    (progn
12262                      ;; When M-x is started from a help buffer,
12263                      ;; Don't kill it as it is anything-current-buffer.
12264                      (unless (equal hbuf anything-current-buffer)
12265                        (kill-buffer hbuf))
12266                      (setq in-help nil))
12267                    ;; Be sure anything-current-buffer
12268                    ;; have not a dedicated window.
12269                    (set-window-dedicated-p
12270                     (get-buffer-window anything-current-buffer) nil)
12271                    (describe-function (intern candidate))
12272                    (message nil) ; Erase the new stupid message Type "q"[...]
12273                    (setq in-help t))
12274                (setq help-cand candidate))))
12275       (let* ((command (anything-comp-read
12276                        "M-x " obarray
12277                        :test 'commandp
12278                        :requires-pattern anything-M-x-requires-pattern
12279                        :name "Emacs Commands"
12280                        :buffer "*anything M-x*"
12281                        :persistent-action 'pers-help
12282                        :persistent-help "Describe this command"
12283                        :history history
12284                        :must-match t
12285                        :candidates-in-buffer t
12286                        :fc-transformer 'anything-M-x-transformer))
12287              (sym-com (intern command)))
12288         (unless current-prefix-arg
12289           (setq current-prefix-arg anything-current-prefix-arg))
12290         ;; Avoid having `this-command' set to *exit-minibuffer.
12291         (setq this-command sym-com)
12292         (call-interactively sym-com)
12293         (setq extended-command-history
12294               (cons command (delete command history)))))))
12295
12296 ;;;###autoload
12297 (defun anything-manage-advice ()
12298   "Preconfigured `anything' to disable/enable function advices."
12299   (interactive)
12300   (anything-other-buffer 'anything-c-source-advice "*anything advice*"))
12301
12302 ;;;###autoload
12303 (defun anything-bookmark-ext ()
12304   "Preconfigured `anything' for bookmark-extensions sources.
12305 Needs bookmark-ext.el:
12306 <http://mercurial.intuxication.org/hg/emacs-bookmark-extension>.
12307 Contain also `anything-c-source-google-suggest'."
12308   (interactive)
12309   (anything
12310    :sources
12311    '(anything-c-source-bookmark-files&dirs
12312      anything-c-source-bookmark-w3m
12313      anything-c-source-google-suggest
12314      anything-c-source-bmkext-addressbook
12315      anything-c-source-bookmark-gnus
12316      anything-c-source-bookmark-info
12317      anything-c-source-bookmark-man
12318      anything-c-source-bookmark-images
12319      anything-c-source-bookmark-su-files&dirs
12320      anything-c-source-bookmark-ssh-files&dirs)
12321    :prompt "SearchBookmark: "
12322    :buffer "*anything bmkext*"))
12323
12324 ;;;###autoload
12325 (defun anything-simple-call-tree ()
12326   "Preconfigured `anything' for simple-call-tree. List function relationships.
12327
12328 Needs simple-call-tree.el.
12329 http://www.emacswiki.org/cgi-bin/wiki/download/simple-call-tree.el"
12330   (interactive)
12331   (anything-other-buffer
12332    '(anything-c-source-simple-call-tree-functions-callers
12333      anything-c-source-simple-call-tree-callers-functions)
12334    "*anything simple-call-tree*"))
12335
12336 ;;;###autoload
12337 (defun anything-mark-ring ()
12338   "Preconfigured `anything' for `anything-c-source-mark-ring'."
12339   (interactive)
12340   (anything :sources 'anything-c-source-mark-ring))
12341
12342 ;;;###autoload
12343 (defun anything-global-mark-ring ()
12344   "Preconfigured `anything' for `anything-c-source-global-mark-ring'."
12345   (interactive)
12346   (anything :sources 'anything-c-source-global-mark-ring))
12347
12348 ;;;###autoload
12349 (defun anything-all-mark-rings ()
12350   "Preconfigured `anything' for `anything-c-source-global-mark-ring' and \
12351 `anything-c-source-mark-ring'."
12352   (interactive)
12353   (anything :sources '(anything-c-source-mark-ring
12354                        anything-c-source-global-mark-ring)))
12355
12356 ;;;###autoload
12357 (defun anything-yaoddmuse-emacswiki-edit-or-view ()
12358   "Preconfigured `anything' to edit or view EmacsWiki page.
12359
12360 Needs yaoddmuse.el.
12361
12362 http://www.emacswiki.org/emacs/download/yaoddmuse.el"
12363   (interactive)
12364   (anything :sources 'anything-c-source-yaoddmuse-emacswiki-edit-or-view))
12365
12366 ;;;###autoload
12367 (defun anything-yaoddmuse-emacswiki-post-library ()
12368   "Preconfigured `anything' to post library to EmacsWiki.
12369
12370 Needs yaoddmuse.el.
12371
12372 http://www.emacswiki.org/emacs/download/yaoddmuse.el"
12373   (interactive)
12374   (anything :sources 'anything-c-source-yaoddmuse-emacswiki-post-library))
12375
12376 ;;;###autoload
12377 (defun anything-eval-expression (arg)
12378   "Preconfigured anything for `anything-c-source-evaluation-result'."
12379   (interactive "P")
12380   (anything :sources 'anything-c-source-evaluation-result
12381             :input (when arg (thing-at-point 'sexp))
12382             :buffer "*anything eval*"
12383             :history 'anything-eval-expression-input-history
12384             :keymap anything-eval-expression-map))
12385
12386 ;;;###autoload
12387 (defun anything-eval-expression-with-eldoc ()
12388   "Preconfigured anything for `anything-c-source-evaluation-result' with `eldoc' support. "
12389   (interactive)
12390   (declare (special eldoc-idle-delay))
12391   (let ((timer (run-with-idle-timer eldoc-idle-delay
12392                                     'repeat 'anything-eldoc-show-in-eval))
12393         (minibuffer-completing-symbol t) ; Enable lisp completion.
12394         (completion-cycle-threshold t))  ; Always cycle, no pesty completion buffer (emacs24 only).
12395     (unwind-protect
12396          (minibuffer-with-setup-hook
12397              'anything-eldoc-store-minibuffer
12398            (call-interactively 'anything-eval-expression))
12399       (and timer (cancel-timer timer))
12400       (setq anything-eldoc-active-minibuffers-list
12401             (cdr anything-eldoc-active-minibuffers-list)))))
12402
12403 ;;;###autoload
12404 (defun anything-calcul-expression ()
12405   "Preconfigured anything for `anything-c-source-calculation-result'."
12406   (interactive)
12407   (anything-other-buffer 'anything-c-source-calculation-result "*anything calcul*"))
12408
12409 ;;;###autoload
12410 (defun anything-surfraw (pattern engine)
12411   "Preconfigured `anything' to search PATTERN with search ENGINE."
12412   (interactive (list (read-string "SearchFor: "
12413                                   nil 'anything-surfraw-input-history)
12414                      (anything-comp-read
12415                       "Engine: "
12416                       (anything-c-build-elvi-list)
12417                       :must-match t
12418                       :name "Surfraw Search Engines"
12419                       :history anything-surfraw-engines-history)))
12420   (let* ((engine-nodesc (car (split-string engine)))
12421          (url (with-temp-buffer
12422                 (apply 'call-process "surfraw" nil t nil
12423                        ;;JAVE
12424                        (append  (list engine-nodesc "-p") (split-string pattern)))
12425                 (replace-regexp-in-string
12426                  "\n" "" (buffer-string))))
12427          (browse-url-browser-function (or anything-surfraw-default-browser-function
12428                                           browse-url-browser-function)))
12429     (if (string= engine-nodesc "W")
12430         (anything-c-browse-url anything-c-home-url)
12431         (anything-c-browse-url url)
12432         (setq anything-surfraw-engines-history
12433               (cons engine (delete engine anything-surfraw-engines-history))))))
12434
12435 ;;;###autoload
12436 (defun anything-call-source ()
12437   "Preconfigured `anything' to call anything source."
12438   (interactive)
12439   (anything :sources 'anything-c-source-call-source
12440             :buffer anything-source-select-buffer))
12441
12442 ;;;###autoload
12443 (defun anything-execute-anything-command ()
12444   "Preconfigured `anything' to execute preconfigured `anything'."
12445   (interactive)
12446   (anything-other-buffer 'anything-c-source-anything-commands
12447                          "*anything commands*"))
12448
12449 ;;;###autoload
12450 (defun anything-create (&optional string initial-input)
12451   "Preconfigured `anything' to do many create actions from STRING.
12452 See also `anything-create--actions'."
12453   (interactive)
12454   (setq string (or string (read-string "Create Anything: " initial-input)))
12455   (anything :sources '(((name . "Anything Create")
12456                         (header-name . (lambda (_) (format "Action for \"%s\"" string)))
12457                         (candidates . anything-create--actions)
12458                         (candidate-number-limit)
12459                         (action . (lambda (func) (funcall func string)))))))
12460
12461 ;;;###autoload
12462 (defun anything-top ()
12463   "Preconfigured `anything' for top command."
12464   (interactive)
12465   (let ((anything-samewindow t)
12466         (anything-enable-shortcuts)
12467         (anything-display-function 'anything-default-display-buffer)
12468         (anything-candidate-number-limit 9999))
12469     (save-window-excursion
12470       (delete-other-windows)
12471       (anything-other-buffer 'anything-c-source-top "*anything top*"))))
12472
12473 ;;;###autoload
12474 (defun anything-select-xfont ()
12475   "Preconfigured `anything' to select Xfont."
12476   (interactive)
12477   (anything-other-buffer 'anything-c-source-xfonts "*anything select* xfont"))
12478
12479 ;;;###autoload
12480 (defun anything-world-time ()
12481   "Preconfigured `anything' to show world time."
12482   (interactive)
12483   (anything-other-buffer 'anything-c-source-time-world "*anything world time*"))
12484
12485 ;;;###autoload
12486 (defun anything-apt (arg)
12487   "Preconfigured `anything' : frontend of APT package manager.
12488 With a prefix arg reload cache."
12489   (interactive "P")
12490   (let ((query (read-string "Search Package: " nil 'anything-c-apt-input-history)))
12491     (when arg (anything-c-apt-refresh))
12492     (anything :sources 'anything-c-source-apt
12493               :prompt "Search Package: "
12494               :input query
12495               :history 'anything-c-apt-input-history)))
12496
12497 ;;;###autoload
12498 (defun anything-esh-pcomplete ()
12499   "Preconfigured anything to provide anything completion in eshell."
12500   (interactive)
12501   (let* ((anything-quit-if-no-candidate t)
12502          (anything-execute-action-at-once-if-one t)
12503          (target (thing-at-point 'symbol))
12504          (end (point))
12505          (beg (or (and target (- end (length target)))
12506                   ;; Nothing at point.
12507                   (progn (insert " ") (point)))))
12508     (setq anything-ec-target (or target " "))
12509     (with-anything-show-completion beg end
12510       (anything :sources 'anything-c-source-esh
12511                 :buffer "*anything pcomplete*"
12512                 :input (anything-ff-set-pattern ; Handle tramp filenames.
12513                         (car (last (ignore-errors ; Needed in lisp symbols completion.
12514                                      (pcomplete-parse-arguments)))))))))
12515
12516 ;;;###autoload
12517 (defun anything-eshell-history ()
12518   "Preconfigured anything for eshell history."
12519   (interactive)
12520   (let* ((end (point))
12521          (beg (save-excursion (eshell-bol) (point)))
12522          (input (buffer-substring beg end))
12523          flag-empty)
12524     (when (eq beg end)
12525       (insert " ")
12526       (setq flag-empty t)
12527       (setq end (point)))
12528     (unwind-protect
12529          (with-anything-show-completion beg end
12530            (anything :sources 'anything-c-source-eshell-history
12531                      :buffer "*Eshell history*"
12532                      :input input))
12533       (when (and flag-empty
12534                  (looking-back " "))
12535         (delete-char -1)))))
12536
12537 ;;;###autoload
12538 (defun anything-c-run-external-command (program)
12539   "Preconfigured `anything' to run External PROGRAM asyncronously from Emacs.
12540 If program is already running exit with error.
12541 You can set your own list of commands with
12542 `anything-c-external-commands-list'."
12543   (interactive (list
12544                 (anything-comp-read
12545                  "RunProgram: "
12546                  (anything-c-external-commands-list-1 'sort)
12547                  :must-match t
12548                  :name "External Commands"
12549                  :history anything-external-command-history)))
12550   (anything-run-or-raise program)
12551   (setq anything-external-command-history
12552         (cons program (delete program
12553                               (loop for i in anything-external-command-history
12554                                     when (executable-find i) collect i)))))
12555
12556 ;;;###autoload
12557 (defun anything-ratpoison-commands ()
12558   "Preconfigured `anything' to execute ratpoison commands."
12559   (interactive)
12560   (anything-other-buffer 'anything-c-source-ratpoison-commands
12561                          "*anything ratpoison commands*"))
12562
12563 ;;;###autoload
12564 (defun anything-ucs ()
12565   "Preconfigured anything for `ucs-names' math symbols."
12566   (interactive)
12567   (anything :sources 'anything-c-source-ucs
12568             :keymap  anything-c-ucs-map))
12569
12570 ;;;###autoload
12571 (defun anything-c-apropos ()
12572   "Preconfigured anything to describe commands, functions, variables and faces."
12573   (interactive)
12574   (let ((default (thing-at-point 'symbol)))
12575     (anything :sources
12576               `(((name . "Commands")
12577                  (init . (lambda ()
12578                            (anything-c-apropos-init 'commandp ,default)))
12579                  (persistent-action . anything-lisp-completion-persistent-action)
12580                  (persistent-help . "Show brief doc in mode-line")
12581                  (candidates-in-buffer)
12582                  (action . (lambda (candidate)
12583                              (describe-function (intern candidate)))))
12584                 ((name . "Functions")
12585                  (init . (lambda ()
12586                            (anything-c-apropos-init #'(lambda (x) (and (fboundp x)
12587                                                                        (not (commandp x))))
12588                                                     ,default)))
12589                  (persistent-action . anything-lisp-completion-persistent-action)
12590                  (persistent-help . "Show brief doc in mode-line")
12591                  (candidates-in-buffer)
12592                  (action . (lambda (candidate)
12593                              (describe-function (intern candidate)))))
12594                 ((name . "Variables")
12595                  (init . (lambda ()
12596                            (anything-c-apropos-init 'boundp ,default)))
12597                  (persistent-action . anything-lisp-completion-persistent-action)
12598                  (persistent-help . "Show brief doc in mode-line")
12599                  (candidates-in-buffer)
12600                  (action . (lambda (candidate)
12601                              (describe-variable (intern candidate)))))
12602                 ((name . "Faces")
12603                  (init . (lambda ()
12604                            (anything-c-apropos-init 'facep ,default)))
12605                  (persistent-action . anything-lisp-completion-persistent-action)
12606                  (persistent-help . "Show brief doc in mode-line")
12607                  (candidates-in-buffer)
12608                  (filtered-candidate-transformer . (lambda (candidates source)
12609                                                      (loop for c in candidates
12610                                                            collect (propertize c 'face (intern c)))))
12611                  (action . (lambda (candidate)
12612                              (describe-face (intern candidate)))))
12613                 ((name . "Anything attributes")
12614                  (candidates . (lambda ()
12615                                  (mapcar 'symbol-name anything-additional-attributes)))
12616                  (action . (lambda (candidate)
12617                              (with-output-to-temp-buffer "*Help*"
12618                                (princ (get (intern candidate) 'anything-attrdoc))))))))))
12619
12620 ;;;###autoload
12621 (defun anything-xrandr-set ()
12622   (interactive)
12623   (anything :sources 'anything-c-source-xrandr-change-resolution
12624             :buffer "*anything xrandr*"))
12625
12626 ;;;###autoload
12627 (defun anything-ctags-current-file ()
12628   "Preconfigured `anything' to list function/variable definitions.
12629
12630 Needs Exuberant Ctags.
12631
12632 http://ctags.sourceforge.net/"
12633   (interactive)
12634   (anything :sources 'anything-c-source-ctags
12635             :buffer "*anything ctags*"))
12636 \f
12637 ;;; Unit tests are now in ../developer-tools/unit-test-anything-config.el.
12638
12639 (provide 'anything-config)
12640
12641 ;; Local Variables:
12642 ;; coding: utf-8
12643 ;; End:
12644
12645 ;;; anything-config.el ends here