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                            anything-c-transform-buffer-display-string)
2864     (persistent-action . anything-c-buffers-list-persistent-action)
2865     (keymap . ,anything-c-buffer-map)
2866     (volatile)
2867     (mode-line . anything-buffer-mode-line-string)
2868     (persistent-help . "Show this buffer / C-u \\[anything-execute-persistent-action]: Kill this buffer")))
2869
2870 (defvaralias 'anything-c-source-buffers+ 'anything-c-source-buffers-list)
2871
2872 (defun anything-c-buffer-match-major-mode (candidate)
2873   "Match maybe buffer by major-mode.
2874 If you give a major-mode or partial major-mode,
2875 it will list all buffers of this major-mode and/or buffers with name
2876 matching this major-mode.
2877 If you add a space after major-mode and then a space,
2878 it will match all buffers of the major-mode
2879 before space matching pattern after space.
2880 If you give a pattern which doesn't match a major-mode, it will search buffer
2881 with name matching pattern."
2882   (let* ((cand (replace-regexp-in-string "^\\s-\\{1\\}" "" candidate))
2883          (buf  (get-buffer cand)))
2884     (when buf
2885       (with-current-buffer buf
2886         (let ((mjm   (symbol-name major-mode))
2887               (split (split-string anything-pattern)))
2888           (cond ((string-match "\\s-$" anything-pattern)
2889                  (string-match (car split) mjm))
2890                 ((string-match "\\s-" anything-pattern)
2891                  (and (string-match (car split) mjm)
2892                       (string-match (cadr split) cand)))
2893                 (t (or (string-match anything-pattern mjm)
2894                        (string-match anything-pattern cand)))))))))
2895
2896 (defun anything-c-buffer-query-replace-1 (&optional regexp-flag)
2897   "Query replace in marked buffers.
2898 If REGEXP-FLAG is given use `query-replace-regexp'."
2899   (let ((fn     (if regexp-flag 'query-replace-regexp 'query-replace))
2900         (prompt (if regexp-flag "Query replace regexp" "Query replace"))
2901         (bufs   (anything-marked-candidates)))
2902     (loop
2903           with replace = (query-replace-read-from prompt regexp-flag)
2904           with tostring = (unless (consp replace)
2905                             (query-replace-read-to
2906                              replace prompt regexp-flag))
2907           for buf in bufs
2908           do
2909           (save-window-excursion
2910             (anything-c-switch-to-buffer buf)
2911             (save-excursion
2912               (let ((case-fold-search t))
2913                 (goto-char (point-min))
2914                 (if (consp replace)
2915                     (apply fn (list (car replace) (cdr replace)))
2916                     (apply fn (list replace tostring)))))))))
2917
2918 (defun anything-c-buffer-query-replace-regexp (candidate)
2919   (anything-c-buffer-query-replace-1 'regexp))
2920
2921 (defun anything-c-buffer-query-replace (candidate)
2922   (anything-c-buffer-query-replace-1))
2923
2924 (defun anything-buffer-toggle-diff (candidate)
2925   "Toggle diff buffer CANDIDATE with it's file."
2926   (if (get-buffer-window "*Diff*")
2927       (kill-buffer "*Diff*")
2928       (diff-buffer-with-file (get-buffer candidate))))
2929
2930 ;;;###autoload
2931 (defun anything-buffer-diff-persistent ()
2932   "Toggle diff buffer without quitting anything."
2933   (interactive)
2934   (anything-attrset 'diff-action 'anything-buffer-toggle-diff)
2935   (anything-execute-persistent-action 'diff-action))
2936
2937 (defun anything-buffer-revert-and-update (candidate)
2938   (let ((marked (anything-marked-candidates)))
2939     (loop for buf in marked do (anything-revert-buffer buf))
2940     (anything-force-update candidate)))
2941
2942 ;;;###autoload
2943 (defun anything-buffer-revert-persistent ()
2944   "Revert buffer without quitting anything."
2945   (interactive)
2946   (anything-attrset 'revert-action 'anything-buffer-revert-and-update)
2947   (anything-execute-persistent-action 'revert-action 'onewindow))
2948
2949 (defun anything-buffer-save-and-update (candidate)
2950   (let ((marked (anything-marked-candidates))
2951         (enable-recursive-minibuffers t))
2952     (loop for buf in marked do
2953           (with-current-buffer (get-buffer buf)
2954             (save-buffer)))
2955     (anything-force-update candidate)))
2956
2957 ;;;###autoload
2958 (defun anything-buffer-save-persistent ()
2959   "Save buffer without quitting anything."
2960   (interactive)
2961   (anything-attrset 'save-action 'anything-buffer-save-and-update)
2962   (anything-execute-persistent-action 'save-action 'onewindow))
2963
2964 ;;;###autoload
2965 (defun anything-buffer-run-kill-buffers ()
2966   "Run kill buffer action from `anything-c-source-buffers-list'."
2967   (interactive)
2968   (anything-c-quit-and-execute-action 'anything-kill-marked-buffers))
2969
2970 ;;;###autoload
2971 (defun anything-buffer-run-grep ()
2972   "Run Grep action from `anything-c-source-buffers-list'."
2973   (interactive)
2974   (anything-c-quit-and-execute-action 'anything-c-grep-buffers))
2975
2976 ;;;###autoload
2977 (defun anything-buffer-run-zgrep ()
2978   "Run Grep action from `anything-c-source-buffers-list'."
2979   (interactive)
2980   (anything-c-quit-and-execute-action 'anything-c-zgrep-buffers))
2981
2982 ;;;###autoload
2983 (defun anything-buffer-run-query-replace-regexp ()
2984   "Run Query replace regexp action from `anything-c-source-buffers-list'."
2985   (interactive)
2986   (anything-c-quit-and-execute-action 'anything-c-buffer-query-replace-regexp))
2987
2988 ;;;###autoload
2989 (defun anything-buffer-run-query-replace ()
2990   "Run Query replace action from `anything-c-source-buffers-list'."
2991   (interactive)
2992   (anything-c-quit-and-execute-action 'anything-c-buffer-query-replace))
2993
2994 ;;;###autoload
2995 (defun anything-buffer-switch-other-window ()
2996   "Run switch to other window action from `anything-c-source-buffers-list'."
2997   (interactive)
2998   (anything-c-quit-and-execute-action 'switch-to-buffer-other-window))
2999
3000 ;;;###autoload
3001 (defun anything-buffer-switch-other-frame ()
3002   "Run switch to other frame action from `anything-c-source-buffers-list'."
3003   (interactive)
3004   (anything-c-quit-and-execute-action 'switch-to-buffer-other-frame))
3005
3006 ;;;###autoload
3007 (defun anything-buffer-switch-to-elscreen ()
3008   "Run switch to elscreen  action from `anything-c-source-buffers-list'."
3009   (interactive)
3010   (anything-c-quit-and-execute-action 'anything-find-buffer-on-elscreen))
3011
3012 ;;;###autoload
3013 (defun anything-buffer-run-ediff ()
3014   "Run ediff action from `anything-c-source-buffers-list'."
3015   (interactive)
3016   (anything-c-quit-and-execute-action 'anything-ediff-marked-buffers))
3017
3018 (defun anything-buffer-run-ediff-merge ()
3019   "Run ediff action from `anything-c-source-buffers-list'."
3020   (interactive)
3021   (anything-c-quit-and-execute-action 'anything-ediff-marked-buffers-merge))
3022
3023 (defun anything-c-buffers-persistent-kill (buffer)
3024   "Persistent action to kill buffer."
3025   (with-current-buffer (get-buffer buffer)
3026     (if (and (buffer-modified-p)
3027              (buffer-file-name (current-buffer)))
3028         (progn
3029           (save-buffer)
3030           (kill-buffer buffer))
3031         (kill-buffer buffer)))
3032   (anything-delete-current-selection))
3033
3034 (defun anything-c-buffers-list-persistent-action (candidate)
3035   (if current-prefix-arg
3036       (anything-c-buffers-persistent-kill candidate)
3037       (anything-c-switch-to-buffer candidate)))
3038
3039 \f
3040 ;;;; <File>
3041 ;;
3042 ;;
3043 ;;; File name history
3044 (defvar anything-c-source-file-name-history
3045   '((name . "File Name History")
3046     (candidates . file-name-history)
3047     (match anything-c-match-on-basename)
3048     (type . file)))
3049
3050 ;;; Files in current dir
3051 ;;
3052 ;;
3053 (defvar anything-c-source-files-in-current-dir
3054   '((name . "Files from Current Directory")
3055     (candidates . (lambda ()
3056                     (with-anything-current-buffer
3057                       (directory-files (anything-c-current-directory)))))
3058     ;; volatile is not needed, I think.
3059     (type . file)))
3060
3061 (defun anything-c-highlight-files (files)
3062   (loop for i in files
3063         if (file-directory-p i)
3064         collect (propertize (file-name-nondirectory i)
3065                             'face 'anything-ff-directory
3066                             'help-echo (expand-file-name i))
3067         else
3068         collect (propertize (file-name-nondirectory i)
3069                             'face 'anything-ff-file
3070                             'help-echo (expand-file-name i))))
3071
3072 (defvar anything-c-source-files-in-current-dir+
3073   `((name . "Files from Current Directory")
3074     (candidates . (lambda ()
3075                     (with-anything-current-buffer
3076                       (directory-files (anything-c-current-directory) t))))
3077     (keymap . ,anything-generic-files-map)
3078     (help-message . anything-generic-file-help-message)
3079     (mode-line . anything-generic-file-mode-line-string)
3080     (candidate-transformer anything-c-highlight-files)
3081     ;; volatile is not needed, I think.
3082     (type . file)))
3083
3084
3085 \f
3086 ;;; Anything-find-files - The anything files browser.
3087 ;;
3088 ;;
3089 ;; Internal.
3090 (defvar anything-c-find-files-doc-header " (`C-l': Go to precedent level)"
3091   "*The doc that is inserted in the Name header of a find-files or dired source.")
3092 (defvar anything-ff-auto-update-flag nil
3093   "Internal, flag to turn on/off auto-update in `anything-find-files'.
3094 Don't set it directly, use instead `anything-ff-auto-update-initial-value'.")
3095 (defvar anything-ff-last-expanded nil
3096   "Store last expanded directory or file.")
3097 (defvar anything-ff-default-directory nil)
3098 (defvar anything-ff-history nil)
3099 (defvar anything-ff-cand-to-mark nil)
3100 (defvar anything-ff-url-regexp
3101   "\\`\\(news\\(post\\)?:\\|nntp:\\|mailto:\\|file:\\|\\(ftp\\|https?\\|telnet\\|gopher\\|www\\|wais\\):/?/?\\).*"
3102   "Same as `ffap-url-regexp' but match earlier possible url.")
3103
3104 (defvar anything-c-source-find-files
3105   `((name . "Find Files")
3106     (header-name . (lambda (name)
3107                      (concat name anything-c-find-files-doc-header)))
3108     ;; It is needed for filenames with capital letters
3109     ;;(disable-shortcuts)
3110     (init . (lambda ()
3111               (setq anything-ff-auto-update-flag
3112                     anything-ff-auto-update-initial-value)))
3113     (candidates . anything-find-files-get-candidates)
3114     (filtered-candidate-transformer anything-c-find-files-transformer)
3115     (persistent-action . anything-find-files-persistent-action)
3116     (persistent-help . "Hit1 Expand Candidate, Hit2 or (C-u) Find file")
3117     (mode-line . anything-ff-mode-line-string)
3118     (volatile)
3119     (candidate-number-limit . 9999)
3120     (action-transformer . anything-find-files-action-transformer)
3121     (action
3122      . ,(delq
3123          nil
3124          `(("Find File" . anything-c-find-file-or-marked)
3125            ("Find file in Dired" . anything-c-point-file-in-dired)
3126            ,(and (locate-library "elscreen")
3127                  '("Find file in Elscreen"  . anything-elscreen-find-file))
3128            ,(and (locate-library "popwin")
3129                  '("Find file in popup window" . popwin:find-file))
3130            ("Checksum File" . anything-ff-checksum)
3131            ("Complete at point `M-tab'"
3132             . anything-c-insert-file-name-completion-at-point)
3133            ("Open file externally `C-c C-x, C-u to choose'"
3134             . anything-c-open-file-externally)
3135            ("Grep File(s) `M-g s, C-u Recurse'" . anything-find-files-grep)
3136            ("Zgrep File(s) `M-g z, C-u Recurse'" . anything-ff-zgrep)
3137            ("Switch to Eshell `M-e'" . anything-ff-switch-to-eshell)
3138            ("Etags `M-., C-u tap, C-u C-u reload tag file'" . anything-ff-etags-select)
3139            ("Eshell command on file(s) `M-!, C-u run on all marked at once.'"
3140             . anything-find-files-eshell-command-on-file)
3141            ("Find file as root" . anything-find-file-as-root)
3142            ("Find file in hex dump" . hexl-find-file)
3143            ("Ediff File `C-='" . anything-find-files-ediff-files)
3144            ("Ediff Merge File `C-c ='" . anything-find-files-ediff-merge-files)
3145            ("Delete File(s) `M-D'" . anything-delete-marked-files)
3146            ("Copy file(s) `M-C, C-u to follow'" . anything-find-files-copy)
3147            ("Copy file(s) Async" . anything-ff-copy-async)
3148            ("Rename file(s) `M-R, C-u to follow'" . anything-find-files-rename)
3149            ("Serial rename files" . anything-ff-serial-rename)
3150            ("Serial rename by symlinking files" . anything-ff-serial-rename-by-symlink)
3151            ("Serial rename by copying files" . anything-ff-serial-rename-by-copying)
3152            ("Symlink files(s) `M-S, C-u to follow'" . anything-find-files-symlink)
3153            ("Relsymlink file(s) `C-u to follow'" . anything-find-files-relsymlink)
3154            ("Hardlink file(s) `M-H, C-u to follow'" . anything-find-files-hardlink)
3155            ("Find file other window `C-o'" . find-file-other-window)
3156            ("Switch to history `M-p'" . anything-find-files-switch-to-hist)
3157            ("Find file other frame `C-c C-o'" . find-file-other-frame)
3158            ("Print File `C-c p, C-u to refresh'" . anything-ff-print)
3159            ("Locate `C-x C-f, C-u to specify locate db'" . anything-ff-locate))))))
3160
3161 (defun anything-find-files-set-prompt-for-action (action files)
3162   "Set prompt for action ACTION for FILES."
3163   (let ((len (length files)))
3164     (format "%s *%s File(s)\n%s to: "
3165             action len
3166             (mapconcat (lambda (f)
3167                          (format "- %s\n" f)) files ""))))
3168
3169 (defun anything-dwim-target-directory ()
3170   "Return value of `default-directory' of buffer in other window.
3171 If there is only one window return the value ot `default-directory'
3172 for current buffer."
3173   (with-anything-current-buffer
3174     (let ((num-windows (length (window-list))))
3175       (if (> num-windows 1)
3176           (save-selected-window
3177             (other-window 1)
3178             default-directory)
3179           (car anything-ff-history)))))
3180
3181 (defun anything-find-files-do-action (action)
3182   "Generic function for creating action from `anything-c-source-find-files'.
3183 ACTION must be an action supported by `anything-dired-action'."
3184   (let* ((ifiles (mapcar 'expand-file-name ; Allow modify '/foo/.' -> '/foo'
3185                          (anything-marked-candidates)))
3186          (cand   (anything-get-selection)) ; Target
3187          (prompt (anything-find-files-set-prompt-for-action
3188                   (capitalize (symbol-name action)) ifiles))
3189          (parg   anything-current-prefix-arg)
3190          (dest   (anything-c-read-file-name
3191                   prompt
3192                   :preselect (if anything-ff-transformer-show-only-basename
3193                                  (anything-c-basename cand) cand)
3194                   :initial-input (anything-dwim-target-directory)
3195                   :history (anything-find-files-history :comp-read nil))))
3196     (anything-dired-action
3197      dest :files ifiles :action action :follow parg)))
3198
3199 (defun anything-find-files-copy (candidate)
3200   "Copy files from `anything-find-files'."
3201   (anything-find-files-do-action 'copy))
3202
3203 (defun anything-find-files-rename (candidate)
3204   "Rename files from `anything-find-files'."
3205   (anything-find-files-do-action 'rename))
3206
3207 (defun anything-find-files-symlink (candidate)
3208   "Symlink files from `anything-find-files'."
3209   (anything-find-files-do-action 'symlink))
3210
3211 (defun anything-find-files-relsymlink (candidate)
3212   "Relsymlink files from `anything-find-files'."
3213   (anything-find-files-do-action 'relsymlink))
3214
3215 (defun anything-find-files-hardlink (candidate)
3216   "Hardlink files from `anything-find-files'."
3217   (anything-find-files-do-action 'hardlink))
3218
3219 (defun anything-find-files-byte-compile (candidate)
3220   "Byte compile elisp files from `anything-find-files'."
3221   (let ((files    (anything-marked-candidates))
3222         (parg     anything-current-prefix-arg))
3223     (loop for fname in files
3224           do (byte-compile-file fname parg))))
3225
3226 (defun anything-find-files-load-files (candidate)
3227   "Load elisp files from `anything-find-files'."
3228   (let ((files    (anything-marked-candidates)))
3229     (loop for fname in files
3230           do (load fname))))
3231
3232 (defun anything-find-files-ediff-files-1 (candidate &optional merge)
3233   "Generic function to ediff/merge files in `anything-find-files'."
3234   (let ((bname  (anything-c-basename candidate))
3235         (prompt (if merge "Ediff Merge `%s' With File: "
3236                     "Ediff `%s' With File: "))
3237         (fun    (if merge 'ediff-merge-files 'ediff-files)))
3238     (funcall fun
3239              candidate
3240              (condition-case quit
3241                  (anything-c-read-file-name
3242                   (format prompt bname))
3243                (quit ;; Hit C-g ask user to fallback to locate.
3244                 (if (y-or-n-p "Search file for ediff with locate? ")
3245                     (anything-c-locate-read-file-name
3246                      (format prompt bname)
3247                      ;; Check if -b option is available.
3248                      (if (and (eq system-type 'windows-nt)
3249                               (string-match "^es" anything-c-locate-command))
3250                          bname
3251                          (concat bname " -b")))
3252                     (error "Error: Ediff Operation aborted")))))))
3253
3254 (defun anything-find-files-ediff-files (candidate)
3255   (anything-find-files-ediff-files-1 candidate))
3256
3257 (defun anything-find-files-ediff-merge-files (candidate)
3258   (anything-find-files-ediff-files-1 candidate 'merge))
3259
3260 (defun anything-find-files-grep (candidate)
3261   "Default action to grep files from `anything-find-files'."
3262   (anything-do-grep-1 (anything-marked-candidates)
3263                       anything-current-prefix-arg))
3264
3265 (defun anything-ff-zgrep (candidate)
3266   "Default action to zgrep files from `anything-find-files'."
3267   (let ((prefarg anything-current-prefix-arg)
3268         (ls      (anything-marked-candidates)))
3269     (anything-ff-zgrep-1 ls prefarg)))
3270
3271 (defun anything-ff-pdfgrep (candidate)
3272   "Default action to pdfgrep files from `anything-find-files'."
3273   (let ((cands (loop for file in (anything-marked-candidates)
3274                      if (or (string= (file-name-extension file) "pdf")
3275                             (string= (file-name-extension file) "PDF"))
3276                      collect file))
3277         (anything-c-pdfgrep-default-function 'anything-c-pdfgrep-init))
3278     (when cands
3279       (anything-do-pdfgrep-1 cands))))
3280
3281 (defun anything-ff-etags-select (candidate)
3282   "Default action to jump to etags from `anything-find-files'."
3283   (when (get-buffer anything-action-buffer)
3284     (kill-buffer anything-action-buffer))
3285   (let ((default-directory anything-ff-default-directory))
3286     (anything-c-etags-select anything-current-prefix-arg)))
3287
3288 (defun anything-find-files-switch-to-hist (candidate)
3289   "Switch to anything-find-files history."
3290   (anything-find-files t))
3291
3292 ;;; Asynchronous copy of files.
3293 ;;
3294 ;;
3295 (defun anything-c-copy-files-async-1 (flist dest)
3296   "Copy a list of Files FLIST to DEST asynchronously.
3297 It use another emacs process to do the job.
3298 Communication with background emacs is done with temp file
3299 `anything-c-copy-files-async-log-file'."
3300   (start-file-process "emacs-batch" nil anything-c-copy-async-prefered-emacs
3301                       "-Q" "--batch" "--eval"
3302                       (format "(progn
3303   (require 'dired) (require 'cl)
3304   (let ((dired-recursive-copies 'always)
3305         failures success
3306         (ovw-count 0)
3307         (cpf-count 0))
3308     (dolist (f '%S)
3309        (condition-case err
3310              (let ((file-exists (file-exists-p
3311                                  (expand-file-name
3312                                   (file-name-nondirectory (directory-file-name f))
3313                                    (file-name-directory
3314                                      (file-name-as-directory \"%s\"))))))
3315                 (dired-copy-file f \"%s\" t)
3316                 (if file-exists
3317                     (progn (push (cons \"Overwriting\" f) success)
3318                            (incf ovw-count))
3319                     (push (cons \"Copying\" f) success)
3320                     (incf cpf-count)))
3321           (file-error
3322            (push (dired-make-relative
3323                    (expand-file-name
3324                      (file-name-nondirectory (directory-file-name f))
3325                      (file-name-directory \"%s\")))
3326                  failures))))
3327     (with-current-buffer (find-file-noselect \"%s\")
3328        (erase-buffer)
3329        (when failures
3330          (dolist (fail (reverse failures))
3331            (insert (concat \"Failed to copy \" fail \"\n\"))))
3332        (when success
3333          (loop for (a . s) in (reverse success) do
3334            (insert (concat a \" \" s  \" to %s done\n\"))))
3335        (and (/= cpf-count 0) (insert (concat (int-to-string cpf-count) \" File(s) Copied\n\")))
3336        (and (/= ovw-count 0) (insert (concat (int-to-string ovw-count) \" File(s) Overwrited\n\")))
3337        (and failures (insert (concat (int-to-string (length failures)) \" File(s) Failed to copy\n\")))
3338        (save-buffer))))"
3339                               flist dest dest dest anything-c-copy-files-async-log-file dest)))
3340
3341 (defun anything-c-copy-async-with-log (flist dest)
3342   "Copy file list FLIST to DEST showing log.
3343 Log is send to `anything-c-copy-files-async-log-file'.
3344 Copying is done asynchronously with `anything-c-copy-files-async-1'."
3345   (declare (special auto-revert-interval))
3346   (pop-to-buffer (find-file-noselect anything-c-copy-files-async-log-file))
3347   (set (make-local-variable 'auto-revert-interval) 1)
3348   (erase-buffer)
3349   (insert "Wait copying files...\n")
3350   (sit-for 0.5) (save-buffer)
3351   (goto-char (point-max))
3352   (auto-revert-mode 1)
3353   (anything-c-copy-files-async-1 flist dest))
3354
3355 (defun anything-ff-copy-async (candidate)
3356   "Anything find files action to copy files async.
3357 Copying is done asynchronously with `anything-c-copy-files-async-1'."
3358   (let* ((flist (anything-marked-candidates))
3359          (dest  (anything-c-read-file-name
3360                  (anything-find-files-set-prompt-for-action
3361                   "Copy Async" flist)
3362                  :preselect candidate
3363                  :initial-input (car anything-ff-history)
3364                  :history (anything-find-files-history :comp-read nil))))
3365     (anything-c-copy-async-with-log flist dest)))
3366
3367 (defvar eshell-command-aliases-list nil)
3368 (defvar anything-eshell-command-on-file-input-history nil)
3369 (defun anything-find-files-eshell-command-on-file-1 (candidate &optional map)
3370   "Run `eshell-command' on CANDIDATE or marked candidates.
3371 This is done possibly with an eshell alias, if no alias found, you can type in
3372 an eshell command.
3373
3374 Basename of CANDIDATE can be a wild-card.
3375 e.g you can do \"eshell-command command *.el\"
3376 Where \"*.el\" is the CANDIDATE.
3377
3378 It is possible to do eshell-command command <CANDIDATE> <some more args>
3379 like this: \"command %s some more args\".
3380
3381 If MAP is given run `eshell-command' on all marked files at once,
3382 Otherwise, run `eshell-command' on each marked files.
3383 In other terms, with a prefix arg do on the three marked files
3384 \"foo\" \"bar\" \"baz\":
3385
3386 \"eshell-command command foo bar baz\"
3387
3388 otherwise do
3389
3390 \"eshell-command command foo\"
3391 \"eshell-command command bar\"
3392 \"eshell-command command baz\"
3393
3394 Note:
3395 If `eshell' or `eshell-command' have not been run once,
3396 or if you have no eshell aliases `eshell-command-aliases-list'
3397 will not be loaded first time you use this."
3398   (when (or eshell-command-aliases-list
3399             (y-or-n-p "Eshell is not loaded, run eshell-command without alias anyway? "))
3400     (and eshell-command-aliases-list (eshell-read-aliases-list))
3401     (let* ((cand-list (anything-marked-candidates))
3402            (default-directory (or anything-ff-default-directory
3403                                   ;; If candidate is an url *-ff-default-directory is nil
3404                                   ;; so keep value of default-directory.
3405                                   default-directory))
3406            (command (anything-comp-read
3407                      "Command: "
3408                      (loop for (a . c) in eshell-command-aliases-list
3409                            when (string-match "\\(\\$1\\|\\$\\*\\)$" (car c))
3410                            collect (propertize a 'help-echo (car c)) into ls
3411                            finally return (sort ls 'string<))
3412                      :buffer "*esh command on file*"
3413                      :name "Eshell command"
3414                      :keymap anything-esh-on-file-map
3415                      :mode-line
3416                      '("Eshell alias"
3417                        "C-c ?: Help, \\[universal-argument]: Insert output at point")
3418                      :input-history
3419                      'anything-eshell-command-on-file-input-history))
3420            (alias-value (car (assoc-default command eshell-command-aliases-list))))
3421       (when (and (= (length cand-list) 1)
3422                  (string-match "[*]" (anything-c-basename (car cand-list))))
3423         (setq cand-list (file-expand-wildcards (car cand-list) t)))
3424       ;; Be sure output don't go in current buffer
3425       ;; but allow sending output to current buffer
3426       ;; if a prefix arg have been passed during the
3427       ;; `anything-comp-read' call.
3428       (setq current-prefix-arg anything-current-prefix-arg)
3429       ;; MAP have been set before calling `anything-comp-read'
3430       ;; by `anything-current-prefix-arg'.
3431       (if (and (or map ; prefix-arg
3432                    (and alias-value
3433                         ;; If command is an alias be sure it accept
3434                         ;; more than one arg i.e $*.
3435                         (string-match "\\$\\*$" alias-value)))
3436                (> (length cand-list) 1))
3437
3438           ;; Run eshell-command with ALL marked files as arguments.
3439           (let ((mapfiles (mapconcat 'shell-quote-argument cand-list " ")))
3440             (if (string-match "'%s'\\|\"%s\"\\|%s" command)
3441                 (eshell-command (format command mapfiles)) ; See [1]
3442                 (eshell-command (format "%s %s" command mapfiles))))
3443
3444           ;; Run eshell-command on EACH marked files.
3445           (loop for i in cand-list
3446                 for bn = (anything-c-basename i)
3447                 for files = (format "'%s'" i)
3448                 for com = (if (string-match "'%s'\\|\"%s\"\\|%s" command)
3449                               ;; [1] This allow to enter other args AFTER filename
3450                               ;; i.e <command %s some_more_args>
3451                               (format command files)
3452                               (format "%s %s" command files))
3453                 do (eshell-command com))))))
3454
3455 (defun anything-find-files-eshell-command-on-file (candidate)
3456   "Run `eshell-command' on CANDIDATE or marked candidates.
3457 See `anything-find-files-eshell-command-on-file-1' for more info."
3458   (anything-find-files-eshell-command-on-file-1
3459    candidate anything-current-prefix-arg))
3460
3461 (defun anything-ff-switch-to-eshell (candidate)
3462   "Switch to eshell and cd to `anything-ff-default-directory'."
3463   (flet ((cd-eshell ()
3464            (goto-char (point-max))
3465            (insert
3466             (format "cd '%s'" anything-ff-default-directory))
3467            (eshell-send-input)))
3468     (if (get-buffer "*eshell*")
3469         (progn
3470           (anything-c-switch-to-buffer "*eshell*")
3471           (cd-eshell))
3472         (call-interactively 'eshell)
3473         (cd-eshell))))
3474
3475 (defun anything-ff-serial-rename-action (method)
3476   "Rename all marked files to `anything-ff-default-directory' with METHOD.
3477 See `anything-ff-serial-rename-1'."
3478   (let* ((cands     (anything-marked-candidates))
3479          (def-name  (car cands))
3480          (name      (read-string "NewName: "
3481                                  (replace-regexp-in-string
3482                                   "[0-9]+$" ""
3483                                   (anything-c-basename
3484                                    def-name
3485                                    (file-name-extension def-name)))))
3486          (start     (read-number "StartAtNumber: "))
3487          (extension (read-string "Extension: "
3488                                  (file-name-extension (car cands))))
3489          (dir       (expand-file-name
3490                      (anything-c-read-file-name
3491                       "Serial Rename to directory: "
3492                       :initial-input
3493                       (expand-file-name anything-ff-default-directory)
3494                       :test 'file-directory-p
3495                       :must-match t)))
3496          (res       (loop for f in cands
3497                           for bn = (anything-c-basename f)
3498                           for count from start
3499                           concat (format "%s <-> %s%s.%s\n"
3500                                          bn name count extension))))
3501     (if (y-or-n-p
3502          (format "Result:\n %sRename like this to <%s> ? " res dir))
3503         (progn
3504           (anything-ff-serial-rename-1
3505            dir cands name start extension :method method)
3506           (message nil)
3507           (anything-find-files-1 dir))
3508         (message "Operation aborted"))))
3509
3510 (defun anything-ff-member-directory-p (file directory)
3511   (let ((dir-file (expand-file-name
3512                    (file-name-as-directory (file-name-directory file))))
3513         (cur-dir  (expand-file-name (file-name-as-directory directory))))
3514     (string= dir-file cur-dir)))
3515
3516 (defun* anything-ff-serial-rename-1
3517     (directory collection new-name start-at-num extension &key (method 'rename))
3518   "rename files in COLLECTION to DIRECTORY with the prefix name NEW-NAME.
3519 Rename start at number START-AT-NUM - ex: prefixname-01.jpg.
3520 EXTENSION is the file extension to use, in empty prompt,
3521 reuse the original extension of file.
3522 METHOD can be one of rename, copy or symlink.
3523 Files will be renamed if they are files of current directory, otherwise they
3524 will be treated with METHOD.
3525 Default METHOD is rename."
3526   ;; Maybe remove directories selected by error in collection.
3527   (setq collection (remove-if 'file-directory-p collection))
3528   (flet ((symlink-file (file dest)
3529            (let ((flist (list file)))
3530              (anything-dired-action
3531               dest :action 'symlink :files flist))))
3532
3533     (let* ((tmp-dir  (file-name-as-directory
3534                       (concat (file-name-as-directory directory)
3535                               (symbol-name (gensym "tmp")))))
3536            (fn       (case method
3537                        (copy    'copy-file)
3538                        (symlink 'symlink-file)
3539                        (rename  'rename-file)
3540                        (t (error "Error: Unknow method %s" method)))))
3541       (make-directory tmp-dir)
3542       (unwind-protect
3543            (progn
3544              ;; Rename all files to tmp-dir with new-name.
3545              ;; If files are not from start directory, use method
3546              ;; to move files to tmp-dir.
3547              (loop for i in collection
3548                    for count from start-at-num
3549                    for fnum = (if (< count 10) "0%s" "%s")
3550                    for nname = (concat tmp-dir new-name (format fnum count)
3551                                        (if (not (string= extension ""))
3552                                            (format ".%s" (replace-regexp-in-string
3553                                                           "[.]" "" extension))
3554                                            (file-name-extension i 'dot)))
3555                    do (if (anything-ff-member-directory-p i directory)
3556                           (rename-file i nname)
3557                           (funcall fn i nname)))
3558              ;; Now move all from tmp-dir to destination.
3559              (loop with dirlist = (directory-files
3560                                    tmp-dir t directory-files-no-dot-files-regexp)
3561                    for f in dirlist do
3562                    (if (file-symlink-p f)
3563                        (symlink-file (file-truename f)
3564                                      (concat (file-name-as-directory directory)
3565                                              (anything-c-basename f)))
3566                        (rename-file f directory))))
3567         (delete-directory tmp-dir t)))))
3568
3569 (defun anything-ff-serial-rename (candidate)
3570   "Serial rename all marked files to `anything-ff-default-directory'.
3571 Rename only file of current directory, and symlink files coming from
3572 other directories.
3573 See `anything-ff-serial-rename-1'."
3574   (anything-ff-serial-rename-action 'rename))
3575
3576 (defun anything-ff-serial-rename-by-symlink (candidate)
3577   "Serial rename all marked files to `anything-ff-default-directory'.
3578 Rename only file of current directory, and symlink files coming from
3579 other directories.
3580 See `anything-ff-serial-rename-1'."
3581   (anything-ff-serial-rename-action 'symlink))
3582
3583 (defun anything-ff-serial-rename-by-copying (candidate)
3584   "Serial rename all marked files to `anything-ff-default-directory'.
3585 Rename only file of current directory, and copy files coming from
3586 other directories.
3587 See `anything-ff-serial-rename-1'."
3588   (anything-ff-serial-rename-action 'copy))
3589
3590 (defun anything-c-quit-and-execute-action (action)
3591   "Quit current anything session and execute ACTION."
3592   (setq anything-saved-action action)
3593   (anything-exit-minibuffer))
3594
3595 (defun anything-ff-toggle-auto-update (candidate)
3596   (setq anything-ff-auto-update-flag (not anything-ff-auto-update-flag))
3597   (message "[Auto expansion %s]"
3598            (if anything-ff-auto-update-flag "enabled" "disabled")))
3599
3600 ;;;###autoload
3601 (defun anything-ff-run-toggle-auto-update ()
3602   (interactive)
3603   (when (anything-file-completion-source-p)
3604     (anything-attrset 'toggle-auto-update 'anything-ff-toggle-auto-update)
3605     (anything-execute-persistent-action 'toggle-auto-update)))
3606
3607 ;;;###autoload
3608 (defun anything-ff-run-switch-to-history ()
3609   "Run Switch to history action from `anything-c-source-find-files'."
3610   (interactive)
3611   (when (anything-file-completion-source-p)
3612     (anything-c-quit-and-execute-action 'anything-find-files-switch-to-hist)))
3613
3614 ;;;###autoload
3615 (defun anything-ff-run-grep ()
3616   "Run Grep action from `anything-c-source-find-files'."
3617   (interactive)
3618   (when (anything-file-completion-source-p)
3619     (anything-c-quit-and-execute-action 'anything-find-files-grep)))
3620
3621 ;;;###autoload
3622 (defun anything-ff-run-pdfgrep ()
3623   "Run Pdfgrep action from `anything-c-source-find-files'."
3624   (interactive)
3625   (when (anything-file-completion-source-p)
3626     (anything-c-quit-and-execute-action 'anything-ff-pdfgrep)))
3627
3628 ;;;###autoload
3629 (defun anything-ff-run-zgrep ()
3630   "Run Grep action from `anything-c-source-find-files'."
3631   (interactive)
3632   (when (anything-file-completion-source-p)
3633     (anything-c-quit-and-execute-action 'anything-ff-zgrep)))
3634
3635 ;;;###autoload
3636 (defun anything-ff-run-copy-file ()
3637   "Run Copy file action from `anything-c-source-find-files'."
3638   (interactive)
3639   (when (anything-file-completion-source-p)
3640     (anything-c-quit-and-execute-action 'anything-find-files-copy)))
3641
3642 ;;;###autoload
3643 (defun anything-ff-run-rename-file ()
3644   "Run Rename file action from `anything-c-source-find-files'."
3645   (interactive)
3646   (when (anything-file-completion-source-p)
3647     (anything-c-quit-and-execute-action 'anything-find-files-rename)))
3648
3649 ;;;###autoload
3650 (defun anything-ff-run-byte-compile-file ()
3651   "Run Byte compile file action from `anything-c-source-find-files'."
3652   (interactive)
3653   (when (anything-file-completion-source-p)
3654     (anything-c-quit-and-execute-action 'anything-find-files-byte-compile)))
3655
3656 ;;;###autoload
3657 (defun anything-ff-run-load-file ()
3658   "Run Load file action from `anything-c-source-find-files'."
3659   (interactive)
3660   (when (anything-file-completion-source-p)
3661     (anything-c-quit-and-execute-action 'anything-find-files-load-files)))
3662
3663 ;;;###autoload
3664 (defun anything-ff-run-eshell-command-on-file ()
3665   "Run eshell command on file action from `anything-c-source-find-files'."
3666   (interactive)
3667   (when (anything-file-completion-source-p)
3668     (anything-c-quit-and-execute-action
3669      'anything-find-files-eshell-command-on-file)))
3670
3671 ;;;###autoload
3672 (defun anything-ff-run-ediff-file ()
3673   "Run Ediff file action from `anything-c-source-find-files'."
3674   (interactive)
3675   (when (anything-file-completion-source-p)
3676     (anything-c-quit-and-execute-action 'anything-find-files-ediff-files)))
3677
3678 ;;;###autoload
3679 (defun anything-ff-run-ediff-merge-file ()
3680   "Run Ediff merge file action from `anything-c-source-find-files'."
3681   (interactive)
3682   (when (anything-file-completion-source-p)
3683     (anything-c-quit-and-execute-action
3684      'anything-find-files-ediff-merge-files)))
3685
3686 ;;;###autoload
3687 (defun anything-ff-run-symlink-file ()
3688   "Run Symlink file action from `anything-c-source-find-files'."
3689   (interactive)
3690   (when (anything-file-completion-source-p)
3691     (anything-c-quit-and-execute-action 'anything-find-files-symlink)))
3692
3693 ;;;###autoload
3694 (defun anything-ff-run-hardlink-file ()
3695   "Run Hardlink file action from `anything-c-source-find-files'."
3696   (interactive)
3697   (when (anything-file-completion-source-p)
3698     (anything-c-quit-and-execute-action 'anything-find-files-hardlink)))
3699
3700 ;;;###autoload
3701 (defun anything-ff-run-delete-file ()
3702   "Run Delete file action from `anything-c-source-find-files'."
3703   (interactive)
3704   (when (anything-file-completion-source-p)
3705     (anything-c-quit-and-execute-action 'anything-delete-marked-files)))
3706
3707 ;;;###autoload
3708 (defun anything-ff-run-complete-fn-at-point ()
3709   "Run complete file name action from `anything-c-source-find-files'."
3710   (interactive)
3711   (when (anything-file-completion-source-p)
3712     (anything-c-quit-and-execute-action
3713      'anything-c-insert-file-name-completion-at-point)))
3714
3715 ;;;###autoload
3716 (defun anything-ff-run-switch-to-eshell ()
3717   "Run switch to eshell action from `anything-c-source-find-files'."
3718   (interactive)
3719   (when (anything-file-completion-source-p)
3720     (anything-c-quit-and-execute-action 'anything-ff-switch-to-eshell)))
3721
3722 ;;;###autoload
3723 (defun anything-ff-run-switch-other-window ()
3724   "Run switch to other window action from `anything-c-source-find-files'."
3725   (interactive)
3726   (when (anything-file-completion-source-p)
3727     (anything-c-quit-and-execute-action 'find-file-other-window)))
3728
3729 ;;;###autoload
3730 (defun anything-ff-run-switch-other-frame ()
3731   "Run switch to other frame action from `anything-c-source-find-files'."
3732   (interactive)
3733   (when (anything-file-completion-source-p)
3734     (anything-c-quit-and-execute-action 'find-file-other-frame)))
3735
3736 ;;;###autoload
3737 (defun anything-ff-run-open-file-externally ()
3738   "Run open file externally command action from `anything-c-source-find-files'."
3739   (interactive)
3740   (when (anything-file-completion-source-p)
3741     (anything-c-quit-and-execute-action 'anything-c-open-file-externally)))
3742
3743 (defun anything-ff-locate (candidate)
3744   "Locate action function for `anything-find-files'."
3745   (let ((input (concat (anything-c-basename
3746                         (expand-file-name
3747                          candidate
3748                          anything-ff-default-directory))
3749                        ;; The locate '-b' option doesn't exists
3750                        ;; in everything.
3751                        (unless (and (eq system-type 'windows-nt)
3752                                     (string-match "^es" anything-c-locate-command))
3753                          " -b")))
3754         (anything-mp-highlight-delay 0.7))
3755     (anything-locate-1 anything-current-prefix-arg input 'from-ff)))
3756
3757 ;;;###autoload
3758 (defun anything-ff-run-locate ()
3759   "Run locate action from `anything-c-source-find-files'."
3760   (interactive)
3761   (when (anything-file-completion-source-p)
3762     (anything-c-quit-and-execute-action 'anything-ff-locate)))
3763
3764 ;;;###autoload
3765 (defun anything-ff-run-gnus-attach-files ()
3766   "Run gnus attach files command action from `anything-c-source-find-files'."
3767   (interactive)
3768   (when (anything-file-completion-source-p)
3769     (anything-c-quit-and-execute-action 'anything-ff-gnus-attach-files)))
3770
3771 ;;;###autoload
3772 (defun anything-ff-run-etags ()
3773   "Run Etags command action from `anything-c-source-find-files'."
3774   (interactive)
3775   (when (anything-file-completion-source-p)
3776     (anything-c-quit-and-execute-action 'anything-ff-etags-select)))
3777
3778 (defun anything-ff-print (candidate)
3779   "Print marked files.
3780 You have to set in order
3781 variables `lpr-command',`lpr-switches' and/or `printer-name'.
3782
3783 e.g:
3784 \(setq lpr-command \"gtklp\"\)
3785 \(setq lpr-switches '(\"-P\")\)
3786 \(setq printer-name \"Epson-Stylus-Photo-R265\"\)
3787
3788 Same as `dired-do-print' but for anything."
3789   (when (or anything-current-prefix-arg
3790             (not anything-ff-printer-list))
3791     (setq anything-ff-printer-list
3792           (anything-ff-find-printers)))
3793   (let* ((file-list (anything-marked-candidates))
3794          (len (length file-list))
3795          (printer-name (if anything-ff-printer-list
3796                            (anything-comp-read
3797                             "Printer: " anything-ff-printer-list)
3798                            printer-name))
3799          (command (read-string
3800                    (format "Print *%s File(s):\n%s with: "
3801                            len
3802                            (mapconcat
3803                             (lambda (f) (format "- %s\n" f))
3804                             file-list ""))
3805                    (when (and lpr-command
3806                               (or lpr-switches
3807                                   printer-name))
3808                      (mapconcat 'identity
3809                                 (cons lpr-command
3810                                       (append (if (stringp lpr-switches)
3811                                                   (list lpr-switches)
3812                                                   lpr-switches)
3813                                               (list printer-name)))
3814                                 " "))))
3815          (file-args (mapconcat #'(lambda (x)
3816                                    (format "'%s'" x))
3817                                file-list " "))
3818          (cmd-line (concat command " " file-args)))
3819     (if command
3820         (start-process-shell-command "anything-print" nil cmd-line)
3821         (error "Error: Please verify your printer settings in Emacs."))))
3822
3823 ;;;###autoload
3824 (defun anything-ff-run-print-file ()
3825   "Run Print file action from `anything-c-source-find-files'."
3826   (interactive)
3827   (when (anything-file-completion-source-p)
3828     (anything-c-quit-and-execute-action 'anything-ff-print)))
3829
3830 (defun anything-ff-checksum (file)
3831   "Calculate the checksum of FILE.
3832 Provide completion on different algorithms to use on Emacs24.
3833 On Emacs23 only 'sha1' is available.
3834 The checksum is copied to kill-ring."
3835   (let ((algo-list (and (fboundp 'secure-hash)
3836                         '(md5 sha1 sha224 sha256 sha384 sha512))))
3837     (kill-new
3838      (if algo-list
3839          (secure-hash (intern
3840                        (anything-comp-read
3841                         "Algorithm: " algo-list))
3842                       file)
3843          (sha1 (with-temp-buffer
3844                  (insert-file-contents file)
3845                  (buffer-string)))))
3846     (message "Checksum copied to kill-ring.")))
3847
3848 (defun anything-ff-toggle-basename (candidate)
3849   (setq anything-ff-transformer-show-only-basename
3850         (not anything-ff-transformer-show-only-basename))
3851   (let ((target (if anything-ff-transformer-show-only-basename
3852                     (anything-c-basename candidate) candidate)))
3853     (anything-force-update target)))
3854
3855 (defun anything-ff-run-toggle-basename ()
3856   (interactive)
3857   (when (anything-file-completion-source-p)
3858     (anything-attrset 'toggle-basename 'anything-ff-toggle-basename)
3859     (anything-execute-persistent-action 'toggle-basename)))
3860
3861 (defun* anything-reduce-file-name (fname level &key unix-close expand)
3862   "Reduce FNAME by LEVEL from end or beginning depending LEVEL value.
3863 If LEVEL is positive reduce from end else from beginning.
3864 If UNIX-CLOSE is non--nil close filename with /.
3865 If EXPAND is non--nil expand-file-name."
3866   (let* ((exp-fname  (expand-file-name fname))
3867          (fname-list (split-string (if (or (string= fname "~/") expand)
3868                                        exp-fname fname) "/" t))
3869          (len        (length fname-list))
3870          (pop-list   (if (< level 0)
3871                          (subseq fname-list (* level -1))
3872                          (subseq fname-list 0 (- len level))))
3873          (result     (mapconcat 'identity pop-list "/"))
3874          (empty      (string= result "")))
3875     (when unix-close (setq result (concat result "/")))
3876     (if (string-match "^~" result)
3877         (if (string= result "~/") "~/" result)
3878         (if (< level 0)
3879             (if empty "../" (concat "../" result))
3880             (cond ((eq system-type 'windows-nt)
3881                    (if empty (expand-file-name "/") ; Expand to "/" or "c:/".
3882                        result))
3883                   (empty "/")
3884                   (t
3885                    (concat "/" result)))))))
3886
3887 ;; Internal
3888 (defvar anything-file-completion-sources
3889   '("Find Files" "Read File Name"
3890     "Read File Name History" "Copy Files"
3891     "Rename Files" "Symlink Files"
3892     "Hardlink Files" "Write File" "Insert File")
3893   "Sources that use the *find-files mechanism can be added here.
3894 Sources generated by `ac-mode' don't need to be added here, it will
3895 be done automatically.
3896 You should not modify this yourself unless you know what you do.")
3897
3898 (defun anything-file-completion-source-p ()
3899   "Return non--nil if current source is a file completion source.
3900 A source is a file completion source if it is
3901 one of `anything-file-completion-sources'.
3902 Return nil if anything is not running."
3903   (let ((cur-source (cdr (assoc 'name (anything-get-current-source)))))
3904     (loop for i in anything-file-completion-sources
3905           thereis (string= cur-source i))))
3906
3907 (defun anything-find-files-down-one-level (arg)
3908   "Go down one level like unix command `cd ..'.
3909 If prefix numeric arg is given go ARG level down."
3910   (interactive "p")
3911   (when (and (anything-file-completion-source-p)
3912              (not (anything-ff-invalid-tramp-name-p)))
3913     (with-anything-window
3914       (setq anything-follow-mode nil))
3915     ;; When going to precedent level we want to be at the line
3916     ;; corresponding to actual directory, so store this info
3917     ;; in `anything-ff-last-expanded'.
3918     (if (and (not (file-directory-p anything-pattern))
3919              (file-exists-p anything-pattern))
3920         (setq anything-ff-last-expanded anything-pattern)
3921         (setq anything-ff-last-expanded anything-ff-default-directory))
3922     (let ((new-pattern (anything-reduce-file-name anything-pattern arg
3923                                                   :unix-close t :expand t)))
3924       (anything-set-pattern new-pattern))))
3925
3926 (defun anything-ff-retrieve-last-expanded ()
3927   "Move overlay to last visited directory `anything-ff-last-expanded'.
3928 This happen after using `anything-find-files-down-one-level',
3929 or hitting C-z on \"..\"."
3930   (when (and anything-ff-last-expanded
3931              (anything-file-completion-source-p))
3932     (let ((presel (if anything-ff-transformer-show-only-basename
3933                        (anything-c-basename
3934                         (directory-file-name anything-ff-last-expanded))
3935                        (directory-file-name anything-ff-last-expanded))))
3936       (with-anything-window
3937         (when (re-search-forward
3938                (concat "^" (regexp-quote presel) "$") nil t)
3939           (forward-line 0)
3940           (anything-mark-current-line)))
3941       (setq anything-ff-last-expanded nil))))
3942 (add-hook 'anything-after-update-hook 'anything-ff-retrieve-last-expanded)
3943
3944 ;; Auto-update - anything-find-files auto expansion of directories.
3945 ;;
3946 (defun anything-ff-update-when-only-one-matched ()
3947   "Expand to directory when sole completion.
3948 When only one candidate is remaining and it is a directory,
3949 expand to this directory."
3950   (when (and anything-ff-auto-update-flag
3951              (anything-file-completion-source-p)
3952              (not (anything-ff-invalid-tramp-name-p)))
3953     (let* ((history-p   (string= (assoc-default
3954                                   'name (anything-get-current-source))
3955                                  "Read File Name History"))
3956            (pat         (if (string-match tramp-file-name-regexp
3957                                           anything-pattern)
3958                             (anything-create-tramp-name anything-pattern)
3959                             anything-pattern))
3960            (completed-p (string= (file-name-as-directory pat)
3961                                  anything-ff-default-directory)))
3962       (when (and (or
3963                   ;; Only one candidate remaining
3964                   ;; and at least 2 char in basename.
3965                   (and (<= (anything-approximate-candidate-number) 2)
3966                        (>= (length (anything-c-basename anything-pattern)) 2))
3967                   ;; Already completed.
3968                   completed-p)
3969                  (not history-p)) ; Don't try to auto complete in history.
3970         (with-anything-window
3971           (let ((cur-cand (prog2
3972                               (unless completed-p
3973                                 ;; Only one non--existing candidate
3974                                 ;; and one directory candidate, move to it.
3975                                 (anything-next-line))
3976                               (anything-get-selection))))
3977             (when (and (stringp cur-cand) (file-directory-p cur-cand))
3978               (if (and (not (string-match "^.*[.]\\{1,2\\}$" cur-cand)) ; [1]
3979                        ;; Maybe we are here because completed-p is true
3980                        ;; but check this again to be sure. (Windows fix)
3981                        (<= (anything-approximate-candidate-number) 2)) ; [2]
3982                   ;; If after going to next line the candidate
3983                   ;; is not one of "." or ".." [1]
3984                   ;; and only one candidate is remaining [2],
3985                   ;; assume candidate is a new directory to expand, and do it.
3986                   (anything-set-pattern (file-name-as-directory cur-cand))
3987                   ;; The candidate is one of "." or ".."
3988                   ;; that mean we have entered the last letter of the directory name
3989                   ;; in prompt, so expansion is already done, just add the "/" at end
3990                   ;; of name unless anything-pattern ends with "."
3991                   ;; (i.e we are writing something starting with ".")
3992                   (unless (string-match "^.*[.]\\{1\\}$" anything-pattern)
3993                     (anything-set-pattern
3994                      ;; Need to expand-file-name to avoid e.g /ssh:host:./ in prompt.
3995                      (expand-file-name (file-name-as-directory anything-pattern)))))
3996               (anything-check-minibuffer-input-1))))))))
3997 (add-hook 'anything-after-update-hook 'anything-ff-update-when-only-one-matched)
3998
3999 ;; Allow expanding to home directory or root
4000 ;; when entering respectively "~/" or "//" at end of pattern.
4001 ;; e.g /home/thierry/labo/anything-config-qp/~/
4002 ;; will expand to "~/"
4003 ;; and /home/thierry/labo/anything-config-qp//
4004 ;; will expand to "/"
4005 (defun anything-ff-auto-expand-to-home-or-root ()
4006   "Goto home, root or default directory when pattern ends with ~/, /, or ./.
4007 This happen only in function using sources that are
4008 `anything-file-completion-source-p' compliant."
4009   (when (and (anything-file-completion-source-p)
4010              (string-match ".*\\(/~/\\|/\\{2\\}\\|/[.]\\{1\\}/\\)$"
4011                            anything-pattern)
4012              (not (string-match anything-ff-url-regexp anything-pattern)))
4013     (let ((match (match-string 1 anything-pattern)))
4014       (cond ((string= match "//")
4015              ;; Expand to "/" or "c:/"
4016              (setq anything-pattern (expand-file-name "/")))
4017             ((string= match "/~/")
4018              (if (eq system-type 'windows-nt)
4019                  (setq anything-pattern (file-name-as-directory (getenv "HOME")))
4020                  (setq anything-pattern "~/")))
4021             ((string= match "/./")
4022              (setq anything-pattern
4023                    (with-anything-current-buffer
4024                      (expand-file-name default-directory))))))
4025     (setq anything-ff-default-directory anything-pattern)
4026     ;; For some reasons, i must use here with-current-buffer => mini buffer
4027     ;; and not `anything-set-pattern' that use with-selected-window => mini win.
4028     (with-current-buffer (window-buffer (minibuffer-window))
4029       (delete-minibuffer-contents)
4030       (insert anything-pattern))))
4031
4032 (add-hook 'anything-after-update-hook 'anything-ff-auto-expand-to-home-or-root)
4033
4034 (defun anything-c-point-file-in-dired (file)
4035   "Put point on filename FILE in dired buffer."
4036   (dired (file-name-directory file))
4037   (dired-goto-file file))
4038
4039 (defun anything-create-tramp-name (fname)
4040   "Build filename for `anything-pattern' like /su:: or /sudo::."
4041   (apply #'tramp-make-tramp-file-name
4042          (loop with v = (tramp-dissect-file-name fname)
4043                for i across v collect i)))
4044
4045 (defun* anything-ff-tramp-hostnames (&optional (pattern anything-pattern))
4046   "Get a list of hosts for tramp method found in `anything-pattern'.
4047 Argument PATTERN default to `anything-pattern', it is here only for debugging
4048 purpose."
4049   (when (string-match tramp-file-name-regexp pattern)
4050     (let ((method      (match-string 1 pattern))
4051           (tn          (match-string 0 pattern))
4052           (all-methods (mapcar 'car tramp-methods)))
4053       (anything-fast-remove-dups
4054        (loop for (f . h) in (tramp-get-completion-function method)
4055              append (loop for e in (funcall f (car h))
4056                           for host = (and (consp e) (cadr e))
4057                           when (and host (not (member host all-methods)))
4058                           collect (concat tn host)))
4059        :test 'equal))))
4060
4061 (defun anything-ff-before-action-hook-fn ()
4062   "Exit anything when user try to execute action on an invalid tramp fname."
4063   (let ((cand (anything-get-selection)))
4064     (when (and (anything-file-completion-source-p)
4065                (anything-ff-invalid-tramp-name-p cand) ; Check candidate.
4066                (anything-ff-invalid-tramp-name-p)) ; check anything-pattern.
4067       (error "Error: Unknow file or directory `%s'" cand))))
4068 (add-hook 'anything-before-action-hook 'anything-ff-before-action-hook-fn)
4069
4070 (defun* anything-ff-invalid-tramp-name-p (&optional (pattern anything-pattern))
4071   "Return non--nil when PATTERN is an invalid tramp filename."
4072   (string= (anything-ff-set-pattern pattern)
4073            "Invalid tramp file name"))
4074
4075 (defun anything-ff-set-pattern (pattern)
4076   "Handle tramp filenames in `anything-pattern'."
4077   (let ((methods (mapcar 'car tramp-methods))
4078         (reg "\\`/\\([^[/:]+\\|[^/]+]\\):.*:")
4079         cur-method tramp-name)
4080     (cond ((string= pattern "") "")
4081           ((string-match ".*\\(~?/?[.]\\{1\\}/\\)$" pattern)
4082            (with-anything-current-buffer
4083              (expand-file-name default-directory)))
4084           ((and (string-match ".*\\(~//\\|//\\)$" pattern)
4085                 (not (string-match anything-ff-url-regexp anything-pattern)))
4086            (expand-file-name "/") ; Expand to "/" or "c:/"
4087            )
4088           ((string-match "^~\\|.*/~/$" pattern)
4089            (let* ((home (expand-file-name (getenv "HOME"))))
4090              (replace-match home nil t pattern)))
4091           ;; Match "/method:maybe_hostname:"
4092           ((and (string-match reg pattern)
4093                 (setq cur-method (match-string 1 pattern))
4094                 (member cur-method methods))
4095            (setq tramp-name (anything-create-tramp-name
4096                              (match-string 0 pattern)))
4097            (replace-match tramp-name nil t pattern))
4098           ;; Match "/hostname:"
4099           ((and (string-match  tramp-file-name-regexp pattern)
4100                 (setq cur-method (match-string 1 pattern))
4101                 (and cur-method (not (member cur-method methods))))
4102            (setq tramp-name (anything-create-tramp-name
4103                              (match-string 0 pattern)))
4104            (replace-match tramp-name nil t pattern))
4105           ;; Match "/method:" in this case don't try to connect.
4106           ((and (not (string-match reg pattern))
4107                 (string-match tramp-file-name-regexp pattern)
4108                 (member (match-string 1 pattern) methods))
4109            "Invalid tramp file name")   ; Write in anything-buffer.
4110           ;; PATTERN is a directory, end it with "/".
4111           ;; This will make PATTERN not ending yet with "/"
4112           ;; candidate for `anything-ff-default-directory',
4113           ;; allowing `anything-ff-retrieve-last-expanded' to retrieve it
4114           ;; when descending level.
4115           ((file-directory-p pattern)
4116            (file-name-as-directory pattern))
4117           ;; Return PATTERN unchanged.
4118           (t pattern))))
4119
4120 (defun anything-find-files-get-candidates (&optional require-match)
4121   "Create candidate list for `anything-c-source-find-files'."
4122   (let* ((path          (anything-ff-set-pattern anything-pattern))
4123          (path-name-dir (if (file-directory-p path)
4124                             (file-name-as-directory path)
4125                             (file-name-directory path)))
4126          (tramp-verbose anything-tramp-verbose)) ; No tramp message when 0.
4127     (set-text-properties 0 (length path) nil path)
4128     ;; Don't set now `anything-pattern' if `path' == "Invalid tramp file name"
4129     ;; like that the actual value (e.g /ssh:) is passed to
4130     ;; `anything-ff-tramp-hostnames'.
4131     (unless (string= path "Invalid tramp file name")
4132       (setq anything-pattern (anything-ff-transform-fname-for-completion path)))
4133     (setq anything-ff-default-directory
4134           (if (string= anything-pattern "")
4135               (expand-file-name "/") ; Expand to "/" or "c:/"
4136               ;; If path is an url *default-directory have to be nil.
4137               (unless (or (string-match anything-ff-url-regexp path)
4138                           (string-match ffap-url-regexp path))
4139                 path-name-dir)))
4140     (cond ((string= path "Invalid tramp file name")
4141            (or (anything-ff-tramp-hostnames) ; Hostnames completion.
4142                (prog2
4143                    ;; `anything-pattern' have not been modified yet.
4144                    ;; Set it here to the value of `path' that should be now
4145                    ;; "Invalid tramp file name" and set the candidates list
4146                    ;; to ("Invalid tramp file name") to make `anything-pattern'
4147                    ;; match single candidate "Invalid tramp file name".
4148                    (setq anything-pattern path)
4149                    ;; "Invalid tramp file name" is now printed
4150                    ;; in `anything-buffer'.
4151                    (list path))))
4152           ((or (file-regular-p path)
4153                ;; `ffap-url-regexp' don't match until url is complete.
4154                (string-match anything-ff-url-regexp path)
4155                (and (not (file-exists-p path)) (string-match "/$" path))
4156                (and ffap-url-regexp (string-match ffap-url-regexp path)))
4157            (list path))
4158           ((string= path "") (anything-ff-directory-files "/" t))
4159           ((and (file-directory-p path) (not (file-readable-p path)))
4160            (list (format "Opening directory: access denied, `%s'" path)))
4161           ((file-directory-p path) (anything-ff-directory-files path t))
4162           (t
4163            (append (list path) ; No need to check for must-match.
4164                    (anything-ff-directory-files path-name-dir t))))))
4165
4166 (defun anything-ff-directory-files (directory &optional full)
4167   "List contents of DIRECTORY.
4168 Argument FULL mean absolute path.
4169 It is same as `directory-files' but always returns the
4170 dotted filename '.' and '..' on root directories on Windows
4171 systems."
4172   (setq directory (expand-file-name directory))
4173   (let ((ls (directory-files directory full))
4174         dot dot2 lsdir)
4175     (if (or
4176          ;; A windows volume.
4177          (string-match "^[a-zA-Z]\\{1\\}:/$" directory)
4178          ;; Empty directories on ftp hosts may have no dot dirs.
4179          (and (file-remote-p directory)
4180               (string-match "^/ftp:" directory)))
4181         (progn (setq dot (concat directory "."))
4182                (setq dot2 (concat directory ".."))
4183                (setq lsdir (remove dot2 (remove dot ls)))
4184                (append (list dot dot2) lsdir))
4185         ls)))
4186
4187 (defun anything-ff-transform-fname-for-completion (fname)
4188   "Return FNAME with it's basename modified as a regexp.
4189 e.g foo => f.*o.*o .
4190 If basename contain one or more space or FNAME is a valid directory name
4191 return FNAME unchanged."
4192   (let ((bn (anything-c-basename fname)))
4193     (if (or (not anything-ff-smart-completion)
4194             (string-match "\\s-" bn)
4195             (string-match "/$" fname) ; Allow mkdir.
4196             (file-directory-p fname)
4197             (string-match anything-ff-url-regexp fname))
4198         fname ; Fall back to match-plugin.
4199         (setq bn (if (> (length bn) 2) ; Normal completion on first 2 char.
4200                      (mapconcat 'identity (split-string bn "" t) ".*") bn))
4201         (concat (file-name-directory fname) bn))))
4202
4203 (defun anything-ff-save-history ()
4204   "Store the last value of `anything-ff-default-directory' \
4205 in `anything-ff-history'."
4206   (when (and anything-ff-default-directory
4207              (anything-file-completion-source-p))
4208     (push anything-ff-default-directory anything-ff-history)))
4209 (add-hook 'anything-cleanup-hook 'anything-ff-save-history)
4210
4211 (defun anything-ff-valid-symlink-p (file)
4212   (file-exists-p (file-truename file)))
4213
4214 (defun anything-ff-properties (candidate)
4215   "Show file properties of CANDIDATE in a tooltip or message."
4216   (let ((type       (anything-ff-attributes candidate :type t))
4217         (dired-line (anything-ff-attributes candidate :dired t :human-size t)))
4218     (if (window-system)
4219         (tooltip-show
4220          (concat
4221           (anything-c-basename candidate) "\n"
4222           "Type: " type "\n"
4223           (when (string= type "symlink")
4224             (format "True name: '%s'\n"
4225                     (cond ((string-match "^\.#" (anything-c-basename candidate))
4226                            "Autosave symlink")
4227                           ((anything-ff-valid-symlink-p candidate)
4228                            (file-truename candidate))
4229                           (t "Invalid Symlink"))))
4230           dired-line))
4231         (message dired-line) (sit-for 5))))
4232
4233 ;;;###autoload
4234 (defun anything-ff-properties-persistent ()
4235   "Show properties without quitting anything."
4236   (interactive)
4237   (anything-attrset 'properties-action 'anything-ff-properties)
4238   (anything-execute-persistent-action 'properties-action))
4239
4240 ;;;###autoload
4241 (defun anything-ff-persistent-delete ()
4242   "Delete current candidate without quitting."
4243   (interactive)
4244   (anything-attrset 'quick-delete 'anything-ff-quick-delete)
4245   (anything-execute-persistent-action 'quick-delete))
4246
4247 (defun anything-ff-dot-file-p (file)
4248   "Check if FILE is `.' or `..'."
4249   (member (anything-c-basename file) '("." "..")))
4250
4251 (defun anything-ff-quick-delete (candidate)
4252   "Delete file CANDIDATE without quitting."
4253   (let ((presel (prog1 (save-excursion
4254                          (let (sel)
4255                            (anything-next-line)
4256                            (setq sel (anything-get-selection))
4257                            (if (string= sel candidate)
4258                                (progn (anything-previous-line)
4259                                       (anything-get-selection))
4260                                sel)))
4261                   (anything-mark-current-line))))
4262     (setq presel (if (and anything-ff-transformer-show-only-basename
4263                           (not (anything-ff-dot-file-p presel)))
4264                      (anything-c-basename presel) presel))
4265     (if anything-ff-quick-delete-dont-prompt-for-deletion
4266         (anything-c-delete-file candidate
4267                                 anything-ff-signal-error-on-dot-files)
4268         (save-selected-window
4269           (when (y-or-n-p (format "Really Delete file `%s'? " candidate))
4270             (anything-c-delete-file candidate
4271                                     anything-ff-signal-error-on-dot-files)
4272             (message nil))))
4273     (anything-force-update presel)))
4274
4275 (defun anything-ff-kill-buffer-fname (candidate)
4276   (let* ((buf (get-file-buffer candidate))
4277          (buf-name (buffer-name buf)))
4278     (if buf
4279         (progn
4280           (kill-buffer buf) (message "Buffer `%s' killed" buf))
4281         (message "No buffer to kill"))))
4282
4283 (defun anything-ff-kill-or-find-buffer-fname (candidate)
4284   "Find file CANDIDATE or kill it's buffer if it is visible.
4285 Never kill `anything-current-buffer'.
4286 Never kill buffer modified.
4287 This is called normally on third hit of \
4288 \\<anything-map>\\[anything-execute-persistent-action]
4289 in `anything-find-files-persistent-action'."
4290   (let* ((buf      (get-file-buffer candidate))
4291          (buf-name (buffer-name buf)))
4292     (if (and buf (get-buffer-window buf)
4293              (not (eq buf (get-buffer anything-current-buffer)))
4294              (not (buffer-modified-p buf)))
4295         (progn
4296           (kill-buffer buf) (message "Buffer `%s' killed" buf-name))
4297         (find-file candidate))))
4298
4299 ;;;###autoload
4300 (defun anything-ff-run-kill-buffer-persistent ()
4301   "Execute `anything-ff-kill-buffer-fname' whitout quitting."
4302   (interactive)
4303   (when (anything-file-completion-source-p)
4304     (anything-attrset 'kill-buffer-fname 'anything-ff-kill-buffer-fname)
4305     (anything-execute-persistent-action 'kill-buffer-fname)))
4306
4307 (defun anything-ff-human-size (size)
4308   "Return a string showing SIZE of a file in human readable form.
4309 SIZE can be an integer or a float depending it's value.
4310 `file-attributes' will take care of that to avoid overflow error.
4311 KBSIZE if a floating point number, default value is 1024.0."
4312   (let ((M (cons "M" (/ size (expt anything-ff-default-kbsize 2))))
4313         (G (cons "G" (/ size (expt anything-ff-default-kbsize 3))))
4314         (K (cons "K" (/ size anything-ff-default-kbsize)))
4315         (B (cons "B" size)))
4316     (loop with result = B
4317           for (a . b) in
4318           (loop for (x . y) in (list M G K B)
4319                 unless (< y 1) collect (cons x y))
4320           when (< b (cdr result)) do (setq result (cons a b))
4321           finally return (if (string= (car result) "B")
4322                              (format "%s" size)
4323                              (format "%.1f%s" (cdr result) (car result))))))
4324
4325 (defun* anything-ff-attributes
4326     (file &key type links uid gid access-time modif-time
4327           status size mode gid-change inode device-num dired human-size)
4328   "Easy interface for `file-attributes'."
4329   (let ((all (destructuring-bind
4330                    (type links uid gid access-time modif-time
4331                          status size mode gid-change inode device-num)
4332                  (file-attributes file 'string)
4333                (list :type        type
4334                      :links       links
4335                      :uid         uid
4336                      :gid         gid
4337                      :access-time access-time
4338                      :modif-time  modif-time
4339                      :status      status
4340                      :size        size
4341                      :mode        mode
4342                      :gid-change  gid-change
4343                      :inode       inode
4344                      :device-num  device-num))))
4345     (cond (type
4346            (let ((result (getf all :type)))
4347              (cond ((stringp result)
4348                     "symlink")
4349                    (result "directory")
4350                    (t "file"))))
4351           (links (getf all :links))
4352           (uid   (getf all :uid))
4353           (gid   (getf all :gid))
4354           (access-time
4355            (format-time-string "%Y-%m-%d %R" (getf all :access-time)))
4356           (modif-time
4357            (format-time-string "%Y-%m-%d %R" (getf all :modif-time)))
4358           (status
4359            (format-time-string "%Y-%m-%d %R" (getf all :status)))
4360           (size (if human-size (anything-ff-human-size (getf all :size))
4361                     (getf all :size)))
4362           (mode (getf all :mode))
4363           (gid-change (getf all :gid-change))
4364           (inode (getf all :inode))
4365           (device-num (getf all :device-num))
4366           (dired
4367            (concat
4368             (getf all :mode) " "
4369             (number-to-string (getf all :links)) " "
4370             (getf all :uid) ":"
4371             (getf all :gid) " "
4372             (if human-size (anything-ff-human-size (getf all :size))
4373                 (int-to-string (getf all :size))) " "
4374                 (format-time-string "%Y-%m-%d %R" (getf all :modif-time))))
4375           (t all))))
4376
4377 (defun anything-ff-prefix-filename (fname &optional file-or-symlinkp new-file)
4378   "Return filename FNAME maybe prefixed with [?] or [@].
4379 If FILE-OR-SYMLINKP is non--nil this mean we assume FNAME is an
4380 existing filename or valid symlink and there is no need to test it.
4381 NEW-FILE when non--nil mean FNAME is a non existing file and
4382 return FNAME prefixed with [?]."
4383   (let* ((prefix-new (propertize
4384                       " " 'display
4385                       (propertize "[?]" 'face 'anything-ff-prefix)))
4386          (prefix-url (propertize
4387                       " " 'display
4388                       (propertize "[@]" 'face 'anything-ff-prefix))))
4389     (cond ((or file-or-symlinkp (file-exists-p fname)) fname)
4390           ((or (string-match anything-ff-url-regexp fname)
4391                (string-match ffap-url-regexp fname))
4392            (concat prefix-url " " fname))
4393           ((or new-file (not (file-exists-p fname)))
4394            (concat prefix-new " " fname)))))
4395
4396 (defun anything-c-find-files-transformer (files sources)
4397   "Transformer for `anything-c-source-find-files'.
4398 Tramp files are not highlighted unless `anything-ff-tramp-not-fancy'
4399 is non--nil."
4400   (if (and (string-match tramp-file-name-regexp anything-pattern)
4401            anything-ff-tramp-not-fancy)
4402       (if anything-ff-transformer-show-only-basename
4403           (loop for i in files collect
4404                 (if (string-match "[.]\\{1,2\\}$" i)
4405                     i (cons (anything-c-basename i) i)))
4406           files)
4407       (anything-ff-highlight-files files sources)))
4408
4409 (defun anything-ff-highlight-files (files sources)
4410   "Candidate transformer for `anything-c-source-find-files' without icons."
4411   (loop for i in files
4412         for disp = (if (and anything-ff-transformer-show-only-basename
4413                             (not (string-match "[.]\\{1,2\\}$" i))
4414                             (not (string-match ffap-url-regexp i))
4415                             (not (string-match anything-ff-url-regexp i)))
4416                        (anything-c-basename i) i)
4417         collect
4418         (cond ((and (stringp (car (file-attributes i)))
4419                     (not (anything-ff-valid-symlink-p i))
4420                     (not (string-match "^\.#" (anything-c-basename i))))
4421                (cons (anything-ff-prefix-filename
4422                       (propertize disp 'face 'anything-ff-invalid-symlink) t)
4423                      i))
4424               ((stringp (car (file-attributes i)))
4425                (cons (anything-ff-prefix-filename
4426                       (propertize disp 'face 'anything-ff-symlink) t)
4427                      i))
4428               ((eq t (car (file-attributes i)))
4429                (cons (anything-ff-prefix-filename
4430                       (propertize disp 'face 'anything-ff-directory) t)
4431                      i))
4432               ((file-executable-p i)
4433                (cons (anything-ff-prefix-filename
4434                       (propertize disp 'face 'anything-ff-executable) t)
4435                      i))
4436               ((file-exists-p i)
4437                (cons (anything-ff-prefix-filename
4438                       (propertize disp 'face 'anything-ff-file) t)
4439                      i))
4440               (t
4441                (cons (anything-ff-prefix-filename
4442                       (propertize disp 'face 'anything-ff-file) nil 'new-file)
4443                      i)))))
4444
4445 (defun anything-find-files-action-transformer (actions candidate)
4446   "Action transformer for `anything-c-source-find-files'."
4447   (cond ((with-anything-current-buffer
4448            (eq major-mode 'message-mode))
4449          (append (subseq actions 0 4)
4450                  '(("Gnus attach file(s)" . anything-ff-gnus-attach-files))
4451                  (subseq actions 4)))
4452         ((string-match (image-file-name-regexp) candidate)
4453          (append (subseq actions 0 4)
4454                  '(("Rotate image right `M-r'" . anything-ff-rotate-image-right)
4455                    ("Rotate image left `M-l'" . anything-ff-rotate-image-left))
4456                  (subseq actions 4)))
4457         ((string-match "\.el$" (anything-aif (anything-marked-candidates)
4458                                    (car it) candidate))
4459          (append (subseq actions 0 4)
4460                  '(("Byte compile lisp file(s) `M-B, C-u to load'"
4461                     . anything-find-files-byte-compile)
4462                    ("Load File(s) `M-L'" . anything-find-files-load-files))
4463                  (subseq actions 4)))
4464         ((and (string-match "\.html?$" candidate)
4465               (file-exists-p candidate))
4466          (append (subseq actions 0 4)
4467                  '(("Browse url file" . browse-url-of-file))
4468                  (subseq actions 5)))
4469         ((or (string= (file-name-extension candidate) "pdf")
4470              (string= (file-name-extension candidate) "PDF"))
4471          (append (subseq actions 0 4)
4472                  '(("Pdfgrep File(s)" . anything-ff-pdfgrep))
4473                  (subseq actions 5)))
4474         (t actions)))
4475
4476 (defun anything-ff-gnus-attach-files (candidate)
4477   "Run `gnus-dired-attach' on `anything-marked-candidates' or CANDIDATE."
4478   (let ((flist (anything-marked-candidates)))
4479     (gnus-dired-attach flist)))
4480
4481 (defun anything-ff-rotate-current-image-1 (file &optional num-arg)
4482   "Rotate current image at NUM-ARG degrees.
4483 This is a destructive operation on FILE made by external tool mogrify."
4484   (declare (special image-dired-display-image-buffer))
4485   (setq file (file-truename file)) ; For symlinked images.
4486   ;; When FILE is not an image-file, do nothing.
4487   (when (string-match (image-file-name-regexp) file)
4488     (if (executable-find "mogrify")
4489         (progn
4490           (shell-command (format "mogrify -rotate %s %s"
4491                                  (or num-arg 90)
4492                                  (shell-quote-argument file)))
4493           (when (buffer-live-p image-dired-display-image-buffer)
4494             (kill-buffer image-dired-display-image-buffer))
4495           (image-dired-display-image file)
4496           (message nil)
4497           (display-buffer (get-buffer image-dired-display-image-buffer)))
4498         (error "mogrify not found"))))
4499
4500 (defun anything-ff-rotate-image-left (candidate)
4501   "Rotate image file CANDIDATE left.
4502 This affect directly file CANDIDATE."
4503   (anything-ff-rotate-current-image-1 candidate -90))
4504
4505 (defun anything-ff-rotate-image-right (candidate)
4506   "Rotate image file CANDIDATE right.
4507 This affect directly file CANDIDATE."
4508   (anything-ff-rotate-current-image-1 candidate))
4509
4510 (defun anything-ff-rotate-left-persistent ()
4511   "Rotate image left without quitting anything."
4512   (interactive)
4513   (anything-attrset 'image-action1 'anything-ff-rotate-image-left)
4514   (anything-execute-persistent-action 'image-action1))
4515
4516 (defun anything-ff-rotate-right-persistent ()
4517   "Rotate image right without quitting anything."
4518   (interactive)
4519   (anything-attrset 'image-action2 'anything-ff-rotate-image-right)
4520   (anything-execute-persistent-action 'image-action2))
4521
4522 (defun anything-ff-exif-data (candidate)
4523   "Extract exif data from file CANDIDATE using `anything-ff-exif-data-program'."
4524   (if (and anything-ff-exif-data-program
4525            (executable-find anything-ff-exif-data-program))
4526       (shell-command-to-string (format "%s %s %s"
4527                                        anything-ff-exif-data-program
4528                                        anything-ff-exif-data-program-args
4529                                        candidate))
4530       (format "No program %s found to extract exif"
4531               anything-ff-exif-data-program)))
4532
4533 (defun anything-find-files-persistent-action (candidate)
4534   "Open subtree CANDIDATE without quitting anything.
4535 If CANDIDATE is not a directory expand CANDIDATE filename.
4536 If CANDIDATE is alone, open file CANDIDATE filename.
4537 That's mean:
4538 First hit on C-z expand CANDIDATE second hit open file.
4539 If a prefix arg is given or `anything-follow-mode' is on open file."
4540   (let ((follow        (buffer-local-value
4541                         'anything-follow-mode
4542                         (get-buffer-create anything-buffer)))
4543         (new-pattern   (anything-get-selection))
4544         (num-lines-buf (with-current-buffer anything-buffer
4545                          (count-lines (point-min) (point-max)))))
4546     (flet ((insert-in-minibuffer (fname)
4547              (with-selected-window (minibuffer-window)
4548                (unless follow
4549                  (delete-minibuffer-contents)
4550                  (set-text-properties 0 (length fname) nil fname)
4551                  (insert fname)))))
4552       (cond ((and (string= (anything-ff-set-pattern anything-pattern)
4553                            "Invalid tramp file name")
4554                   (string-match tramp-file-name-regexp candidate))
4555              ;; First hit insert hostname and
4556              ;; second hit insert ":" and expand.
4557              (if (string= candidate anything-pattern)
4558                  (insert-in-minibuffer (concat candidate ":"))
4559                  (insert-in-minibuffer candidate)))
4560             (;; A symlink directory, expand it's truename.
4561              (and (file-directory-p candidate) (file-symlink-p candidate))
4562              (insert-in-minibuffer (file-name-as-directory
4563                                     (file-truename
4564                                      (expand-file-name candidate)))))
4565             ;; A directory, open it.
4566             ((file-directory-p candidate)
4567              (when (string= (anything-c-basename candidate) "..")
4568                (setq anything-ff-last-expanded anything-ff-default-directory))
4569              (insert-in-minibuffer (file-name-as-directory
4570                                     (expand-file-name candidate))))
4571             ;; A symlink file, expand to it's true name. (first hit)
4572             ((and (file-symlink-p candidate) (not current-prefix-arg) (not follow))
4573              (insert-in-minibuffer (file-truename candidate)))
4574             ;; A regular file, expand it, (first hit)
4575             ((and (>= num-lines-buf 3) (not current-prefix-arg) (not follow))
4576              (insert-in-minibuffer new-pattern))
4577             ;; An image file and it is the second hit on C-z,
4578             ;; show the file in `image-dired'.
4579             ((string-match (image-file-name-regexp) candidate)
4580              (when (buffer-live-p image-dired-display-image-buffer)
4581                (kill-buffer image-dired-display-image-buffer))
4582              (image-dired-display-image candidate)
4583              (message nil)
4584              (anything-c-switch-to-buffer image-dired-display-image-buffer)
4585              (with-current-buffer image-dired-display-image-buffer
4586                (let ((exif-data (anything-ff-exif-data candidate)))
4587                  (image-dired-update-property 'help-echo exif-data))))
4588             ;; Allow browsing archive on avfs fs.
4589             ;; Assume volume is already mounted with mountavfs.
4590             ((and anything-ff-avfs-directory
4591                   (string-match
4592                    (regexp-quote (expand-file-name anything-ff-avfs-directory))
4593                    (file-name-directory candidate))
4594                   (anything-ff-file-compressed-p candidate))
4595              (insert-in-minibuffer (concat candidate "#")))
4596             ;; On second hit we open file.
4597             ;; On Third hit we kill it's buffer maybe.
4598             (t
4599              (anything-ff-kill-or-find-buffer-fname candidate))))))
4600
4601 (defun anything-ff-file-compressed-p (candidate)
4602   "Whether CANDIDATE is a compressed file or not."
4603   (member (file-name-extension candidate)
4604           anything-ff-file-compressed-list))
4605
4606 (defun anything-c-insert-file-name-completion-at-point (candidate)
4607   "Insert file name completion at point."
4608   (with-anything-current-buffer
4609     (if buffer-read-only
4610         (error "Error: Buffer `%s' is read-only" (buffer-name))
4611         (let* ((end         (point))
4612                (guess       (substring-no-properties (thing-at-point 'filename)))
4613                (beg         (- (point) (length guess)))
4614                (full-path-p (or (string-match-p (concat "^" (getenv "HOME")) guess)
4615                                 (string-match-p "^[^\~]" guess))))
4616           (set-text-properties 0 (length candidate) nil candidate)
4617           (if (and guess (not (string= guess ""))
4618                    (string-match-p "^~\\|/.*" guess))
4619               (progn
4620                 (delete-region beg end)
4621                 (insert (if full-path-p
4622                             (expand-file-name candidate)
4623                             (abbreviate-file-name candidate))))
4624               (error "Aborting completion: No valid file name at point"))))))
4625
4626 (defun* anything-find-files-history (&key (comp-read t))
4627   "The `anything-find-files' history.
4628 Show the first `anything-ff-history-max-length' elements of
4629 `anything-ff-history' in an `anything-comp-read'."
4630   (let ((history (when anything-ff-history
4631                    (anything-fast-remove-dups anything-ff-history
4632                                               :test 'equal))))
4633     (when history
4634       (setq anything-ff-history
4635             (if (>= (length history) anything-ff-history-max-length)
4636                 (subseq history 0 anything-ff-history-max-length)
4637                 history))
4638       (if comp-read
4639           (anything-comp-read
4640            "Switch to Directory: "
4641            anything-ff-history
4642            :name "Anything Find Files History"
4643            :must-match t)
4644           anything-ff-history))))
4645
4646 (defun anything-find-files-1 (fname &optional preselect)
4647   "Find FNAME with `anything' completion.
4648 Like `find-file' but with `anything' support.
4649 Use it for non--interactive calls of `anything-find-files'."
4650   (when (get-buffer anything-action-buffer)
4651     (kill-buffer anything-action-buffer))
4652   (let ((anything-mp-highlight-delay nil)
4653         ;; Be sure we don't erase the precedent minibuffer if some.
4654         (anything-ff-auto-update-initial-value
4655          (and anything-ff-auto-update-initial-value
4656               (not (minibuffer-window-active-p (minibuffer-window)))))
4657         anything-samewindow)
4658     (anything :sources 'anything-c-source-find-files
4659               :input fname
4660               :preselect preselect
4661               :keymap anything-find-files-map
4662               :prompt "Find Files or Url: "
4663               :buffer "*Anything Find Files*")))
4664
4665
4666 (defun anything-find-files-initial-input (&optional input)
4667   "Return INPUT if present, otherwise try to guess it."
4668   (or (and input (or (and (file-remote-p input) input)
4669                      (expand-file-name input)))
4670       (anything-find-files-input
4671        (ffap-guesser)
4672        (thing-at-point 'filename))))
4673
4674 (defun anything-find-files-input (fap tap)
4675   "Default input of `anything-find-files'."
4676   (let* ((def-dir (anything-c-current-directory))
4677          (lib     (anything-find-library-at-point))
4678          (url     (anything-ff-find-url-at-point))
4679          (remp    (and fap (file-remote-p fap)))
4680          (file-p  (and (not remp)
4681                        fap
4682                        (not (string= fap ""))
4683                        (file-exists-p fap)
4684                        tap (not (string= tap ""))
4685                        (file-exists-p
4686                         (file-name-directory (expand-file-name tap def-dir))))))
4687     (cond (lib) ; e.g we are inside a require sexp.
4688           (url) ; String at point is an hyperlink.
4689           (remp fap)
4690           (file-p (expand-file-name tap def-dir))
4691           (t (and (not (string= fap "")) fap)))))
4692
4693 (defun anything-c-current-directory ()
4694   "Return current-directory name at point.
4695 Useful in dired buffers when there is inserted subdirs."
4696   (if (eq major-mode 'dired-mode)
4697       (dired-current-directory)
4698       default-directory))
4699
4700 (defun anything-ff-find-url-at-point ()
4701   "Try to find link to an url in text-property at point."
4702   (let* ((he      (get-text-property (point) 'help-echo))
4703          (ov      (overlays-at (point)))
4704          (ov-he   (and ov (overlay-get
4705                            (car (overlays-at (point))) 'help-echo)))
4706          (w3m-l   (get-text-property (point) 'w3m-href-anchor))
4707          (nt-prop (get-text-property (point) 'nt-link)))
4708     ;; Org link.
4709     (when (and (stringp he) (string-match "^LINK: " he))
4710       (setq he (replace-match "" t t he)))
4711     (loop for i in (list he ov-he w3m-l nt-prop)
4712           thereis (and (stringp i) (string-match ffap-url-regexp i) i))))
4713
4714 (defun anything-find-library-at-point ()
4715   "Try to find library path at point.
4716 Find inside `require' and `declare-function' sexp."
4717   (require 'find-func)
4718   (let* ((beg-sexp (save-excursion (search-backward "(" (point-at-bol) t)))
4719          (end-sexp (save-excursion (search-forward ")" (point-at-eol) t)))
4720          (sexp     (and beg-sexp end-sexp
4721                         (buffer-substring-no-properties
4722                          (1+ beg-sexp) (1- end-sexp)))))
4723     (ignore-errors
4724       (cond ((and sexp (string-match "require \'.+[^)]" sexp))
4725              (find-library-name
4726               (replace-regexp-in-string
4727                "'\\|\)\\|\(" ""
4728                ;; If require use third arg, ignore it,
4729                ;; always use library path found in `load-path'.
4730                (second (split-string (match-string 0 sexp))))))
4731             ((and sexp (string-match-p "^declare-function" sexp))
4732              (find-library-name
4733               (replace-regexp-in-string
4734                "\"\\|ext:" ""
4735                (third (split-string sexp)))))
4736             (t nil)))))
4737
4738 ;;; Anything completion for `write-file'.==> C-x C-w
4739 (defvar anything-c-source-write-file
4740   `((name . "Write File")
4741     (header-name . (lambda (name)
4742                      (concat name anything-c-find-files-doc-header)))
4743     ;; It is needed for filenames with capital letters
4744     ;;(disable-shortcuts)
4745     (candidates . anything-find-files-get-candidates)
4746     (filtered-candidate-transformer anything-c-find-files-transformer)
4747     (persistent-action . anything-find-files-persistent-action)
4748     (persistent-help . "Expand Candidate")
4749     (volatile)
4750     (action .
4751             (("Write File" . (lambda (candidate)
4752                                (write-file candidate 'confirm)))))))
4753
4754 ;;; Anything completion for `insert-file'.==> C-x i
4755 (defvar anything-c-source-insert-file
4756   `((name . "Insert File")
4757     (header-name . (lambda (name)
4758                      (concat name anything-c-find-files-doc-header)))
4759     ;; It is needed for filenames with capital letters
4760     ;;(disable-shortcuts)
4761     (candidates . anything-find-files-get-candidates)
4762     (filtered-candidate-transformer anything-c-find-files-transformer)
4763     (persistent-action . anything-find-files-persistent-action)
4764     (persistent-help . "Expand Candidate")
4765     (volatile)
4766     (action .
4767             (("Insert File" . (lambda (candidate)
4768                                 (when (y-or-n-p (format "Really insert %s in %s "
4769                                                         candidate anything-current-buffer))
4770                                   (insert-file-contents candidate))))))))
4771
4772 ;;; Anything completion for copy, rename and (rel)sym/hard/link files from dired.
4773 (defvar anything-c-source-copy-files
4774   `((name . "Copy Files")
4775     (header-name . (lambda (name)
4776                      (concat name anything-c-find-files-doc-header)))
4777     ;; It is needed for filenames with capital letters
4778     ;;(disable-shortcuts)
4779     (candidates . anything-find-files-get-candidates)
4780     (filtered-candidate-transformer anything-c-find-files-transformer)
4781     (persistent-action . anything-find-files-persistent-action)
4782     (persistent-help . "Expand Candidate")
4783     (volatile)
4784     (action .
4785             (("Copy File"
4786               . (lambda (candidate)
4787                   (anything-dired-action candidate :action 'copy)))
4788              ("Copy and Follow"
4789               . (lambda (candidate)
4790                   (anything-dired-action candidate :action 'copy :follow t)))))))
4791
4792
4793 (defvar  anything-c-source-rename-files
4794   `((name . "Rename Files")
4795     (header-name . (lambda (name)
4796                      (concat name anything-c-find-files-doc-header)))
4797     ;; It is needed for filenames with capital letters
4798     ;;(disable-shortcuts)
4799     (candidates . anything-find-files-get-candidates)
4800     (filtered-candidate-transformer anything-c-find-files-transformer)
4801     (persistent-action . anything-find-files-persistent-action)
4802     (persistent-help . "Expand Candidate")
4803     (volatile)
4804     (action .
4805             (("Rename File"
4806               . (lambda (candidate)
4807                   (anything-dired-action candidate :action 'rename)))
4808              ("Rename and Follow"
4809               . (lambda (candidate)
4810                   (anything-dired-action candidate :action 'rename :follow t)))))))
4811
4812 (defvar anything-c-source-symlink-files
4813   `((name . "Symlink Files")
4814     (header-name . (lambda (name)
4815                      (concat name anything-c-find-files-doc-header)))
4816     ;; It is needed for filenames with capital letters
4817     ;;(disable-shortcuts)
4818     (candidates . anything-find-files-get-candidates)
4819     (filtered-candidate-transformer anything-c-find-files-transformer)
4820     (persistent-action . anything-find-files-persistent-action)
4821     (persistent-help . "Expand Candidate")
4822     (volatile)
4823     (action
4824      . (("Symlink File"
4825          . (lambda (candidate)
4826              (anything-dired-action candidate :action 'symlink)))
4827         ("RelSymlink File"
4828          . (lambda (candidate)
4829              (anything-dired-action candidate :action 'relsymlink)))))))
4830
4831
4832 (defvar anything-c-source-hardlink-files
4833   `((name . "Hardlink Files")
4834     (header-name . (lambda (name)
4835                      (concat name anything-c-find-files-doc-header)))
4836     ;; It is needed for filenames with capital letters
4837     ;;(disable-shortcuts)
4838     (candidates . anything-find-files-get-candidates)
4839     (filtered-candidate-transformer anything-c-find-files-transformer)
4840     (persistent-action . anything-find-files-persistent-action)
4841     (persistent-help . "Expand Candidate")
4842     (volatile)
4843     (action
4844      . (("Hardlink File"
4845          . (lambda (candidate)
4846              (anything-dired-action candidate :action 'hardlink)))))))
4847
4848 (defun* anything-dired-action (candidate &key action follow (files (dired-get-marked-files)))
4849   "Copy, rename or symlink file at point or marked files in dired to CANDIDATE.
4850 ACTION is a key that can be one of 'copy, 'rename, 'symlink, 'relsymlink."
4851   (when (get-buffer dired-log-buffer) (kill-buffer dired-log-buffer))
4852   (let ((fn     (case action
4853                   ('copy       'dired-copy-file)
4854                   ('rename     'dired-rename-file)
4855                   ('symlink    'make-symbolic-link)
4856                   ('relsymlink 'dired-make-relative-symlink)
4857                   ('hardlink   'dired-hardlink)))
4858         (marker (case action
4859                   ((copy rename)   dired-keep-marker-copy)
4860                   ('symlink        dired-keep-marker-symlink)
4861                   ('relsymlink     dired-keep-marker-relsymlink)
4862                   ('hardlink       dired-keep-marker-hardlink)))
4863         (dirflag (and (= (length files) 1)
4864                       (file-directory-p (car files))
4865                       (not (file-directory-p candidate)))))
4866     (dired-create-files
4867      fn (symbol-name action) files
4868      ;; CANDIDATE is the destination.
4869      (if (file-directory-p candidate)
4870          ;; When CANDIDATE is a directory, build file-name in this directory.
4871          ;; Else we use CANDIDATE.
4872          #'(lambda (from)
4873              (expand-file-name (file-name-nondirectory from) candidate))
4874          #'(lambda (from) candidate))
4875      marker)
4876     (push (file-name-as-directory
4877            (if (file-directory-p candidate)
4878                (expand-file-name candidate)
4879                (file-name-directory candidate)))
4880            anything-ff-history)
4881     (when (and follow (not (get-buffer dired-log-buffer)))
4882       (let ((target (directory-file-name candidate)))
4883         (unwind-protect
4884              (progn
4885                (setq anything-ff-cand-to-mark
4886                      (anything-get-dest-fnames-from-list files candidate dirflag))
4887                (if (and dirflag (eq action 'rename))
4888                    (anything-find-files-1 (file-name-directory target)
4889                                           (if anything-ff-transformer-show-only-basename
4890                                               (anything-c-basename target) target))
4891                    (anything-find-files-1 (expand-file-name candidate))))
4892           (setq anything-ff-cand-to-mark nil))))))
4893
4894 (defun anything-c-basename (fname &optional ext)
4895   "Print FNAME  with any  leading directory  components removed.
4896 If specified, also remove filename extension EXT."
4897   (if (and ext (or (string= (file-name-extension fname) ext)
4898                    (string= (file-name-extension fname t) ext))
4899            (not (file-directory-p fname)))
4900       (file-name-sans-extension (file-name-nondirectory fname))
4901       (file-name-nondirectory (directory-file-name fname))))
4902
4903 (defun anything-get-dest-fnames-from-list (flist dest-cand rename-dir-flag)
4904   "Transform filenames of FLIST to abs of DEST-CAND.
4905 If RENAME-DIR-FLAG is non--nil collect the `directory-file-name' of transformed
4906 members of FLIST."
4907   ;; At this point files have been renamed/copied at destination.
4908   ;; That's mean DEST-CAND exists.
4909   (loop
4910         with dest = (expand-file-name dest-cand)
4911         for src in flist
4912         for basename-src = (anything-c-basename src)
4913         for fname = (cond (rename-dir-flag (directory-file-name dest))
4914                           ((file-directory-p dest)
4915                            (concat (file-name-as-directory dest) basename-src))
4916                           (t dest))
4917         when (file-exists-p fname)
4918         collect fname into tmp-list
4919         finally return (sort tmp-list 'string<)))
4920
4921 (defun anything-ff-maybe-mark-candidates ()
4922   "Mark all candidates of list `anything-ff-cand-to-mark'."
4923   (when (and (string= (assoc-default 'name (anything-get-current-source))
4924                       (assoc-default 'name anything-c-source-find-files))
4925              anything-ff-cand-to-mark)
4926     (with-anything-window
4927       (while anything-ff-cand-to-mark
4928         (if (string= (car anything-ff-cand-to-mark) (anything-get-selection))
4929             (progn
4930               (anything-make-visible-mark)
4931               (anything-next-line)
4932               (setq anything-ff-cand-to-mark (cdr anything-ff-cand-to-mark)))
4933             (anything-next-line)))
4934       (unless (anything-this-visible-mark)
4935         (anything-prev-visible-mark)))))
4936
4937 (add-hook 'anything-after-update-hook #'anything-ff-maybe-mark-candidates)
4938
4939 (defun* anything-dired-do-action-on-file (&key action)
4940   (let* ((files     (dired-get-marked-files))
4941          (len       (length files))
4942          (fname     (if (> len 1)
4943                         (format "* %d Files" len)
4944                         (car files)))
4945          (source    (case action
4946                       ('copy     'anything-c-source-copy-files)
4947                       ('rename   'anything-c-source-rename-files)
4948                       ('symlink  'anything-c-source-symlink-files)
4949                       ('hardlink 'anything-c-source-hardlink-files)))
4950          (prompt-fm (case action
4951                       ('copy     "Copy %s to: ")
4952                       ('rename   "Rename %s to: ")
4953                       ('symlink  "Symlink %s to: ")
4954                       ('hardlink "Hardlink %s to: ")))
4955          (buffer    (case action
4956                       ('copy     "*Anything Copy Files*")
4957                       ('rename   "*Anything Rename Files*")
4958                       ('symlink  "*Anything Symlink Files*")
4959                       ('hardlink "*Anything Hardlink Files*")))
4960          (anything-mp-highlight-delay     nil))
4961     (anything :sources source
4962               :input (or (dired-dwim-target-directory)
4963                          (expand-file-name (anything-c-current-directory)))
4964               :preselect (dired-get-filename)
4965               :prompt (format prompt-fm fname)
4966               :keymap anything-c-read-file-map
4967               :buffer buffer)))
4968
4969 ;;;###autoload
4970 (define-minor-mode anything-dired-mode ()
4971   "Enable anything completion in Dired functions.
4972 Bindings affected are C, R, S, H.
4973 This is deprecated for Emacs24+ users, use `ac-mode' instead."
4974   :group 'anything-config
4975   :global t
4976   (if anything-dired-mode
4977       (progn
4978         (substitute-key-definition
4979          'dired-do-copy 'anything-dired-copy-file dired-mode-map)
4980         (substitute-key-definition
4981          'dired-do-rename 'anything-dired-rename-file dired-mode-map)
4982         (substitute-key-definition
4983          'dired-do-symlink 'anything-dired-symlink-file dired-mode-map)
4984         (substitute-key-definition
4985          'dired-do-hardlink 'anything-dired-hardlink-file dired-mode-map))
4986       (substitute-key-definition
4987        'anything-dired-copy-file 'dired-do-copy dired-mode-map)
4988       (substitute-key-definition
4989        'anything-dired-rename-file 'dired-do-rename dired-mode-map)
4990       (substitute-key-definition
4991        'anything-dired-symlink-file 'dired-do-symlink dired-mode-map)
4992       (substitute-key-definition
4993        'anything-dired-hardlink-file 'dired-do-hardlink dired-mode-map)))
4994
4995 (defalias 'anything-dired-bindings 'anything-dired-mode)
4996
4997 (defun* anything-c-read-file-name
4998     (prompt
4999      &key
5000      (name "Read File Name")
5001      (initial-input (expand-file-name default-directory))
5002      (buffer "*Anything Completions*")
5003      test
5004      (preselect nil)
5005      (history nil)
5006      must-match
5007      (marked-candidates nil)
5008      (alistp t)
5009      (persistent-action 'anything-find-files-persistent-action)
5010      (persistent-help "Hit1 Expand Candidate, Hit2 or (C-u) Find file"))
5011   "Read a file name with anything completion.
5012 It is anything `read-file-name' emulation.
5013
5014 Argument PROMPT is the default prompt to use.
5015
5016 Keys description:
5017
5018 - NAME: Source name, default to \"Read File Name\".
5019
5020 - INITIAL-INPUT: Where to start read file name, default to `default-directory'.
5021
5022 - BUFFER: `anything-buffer' name default to \"*Anything Completions*\".
5023
5024 - TEST: A predicate called with one arg 'candidate'.
5025
5026 - PRESELECT: anything preselection.
5027
5028 - HISTORY: Display HISTORY in a special source.
5029
5030 - MUST-MATCH: Can be 'confirm, nil, or t.
5031
5032 - MARKED-CANDIDATES: When non--nil return a list of marked candidates.
5033
5034 - ALISTP: Don't use `all-completions' in history (take effect only on history).
5035
5036 - PERSISTENT-ACTION: a persistent action function.
5037
5038 - PERSISTENT-HELP: persistent help message."
5039   (when (get-buffer anything-action-buffer)
5040     (kill-buffer anything-action-buffer))
5041
5042   ;; Assume completion have been already required,
5043   ;; so always use 'confirm.
5044   (when (eq must-match 'confirm-after-completion)
5045     (setq must-match 'confirm))
5046
5047   (flet ((action-fn (candidate)
5048            (if marked-candidates
5049                (anything-marked-candidates)
5050                (identity candidate))))
5051
5052     (let* ((anything-mp-highlight-delay nil)
5053            ;; Be sure we don't erase the underlying minibuffer if some.
5054            (anything-ff-auto-update-initial-value
5055             (and anything-ff-auto-update-initial-value
5056                  (not (minibuffer-window-active-p (minibuffer-window)))))
5057            anything-same-window
5058            (hist (and history (anything-comp-read-get-candidates
5059                                history nil nil alistp)))
5060            (minibuffer-completion-confirm must-match)
5061            (must-match-map (when must-match
5062                              (let ((map (make-sparse-keymap)))
5063                                (define-key map (kbd "RET")
5064                                  'anything-confirm-and-exit-minibuffer)
5065                                map)))
5066            (anything-map (if must-match-map
5067                              (make-composed-keymap
5068                               must-match-map anything-c-read-file-map)
5069                              anything-c-read-file-map)))
5070
5071       (or (anything
5072            :sources
5073            `(((name . ,(format "%s History" name))
5074               (header-name . (lambda (name)
5075                                (concat name anything-c-find-files-doc-header)))
5076               ;;(disable-shortcuts)
5077               (mode-line . anything-read-file-name-mode-line-string)
5078               (candidates . hist)
5079               (persistent-action . ,persistent-action)
5080               (persistent-help . ,persistent-help)
5081               (action . ,'action-fn))
5082              ((name . ,name)
5083               (header-name . (lambda (name)
5084                                (concat name anything-c-find-files-doc-header)))
5085               (init . (lambda ()
5086                         (setq anything-ff-auto-update-flag
5087                               anything-ff-auto-update-initial-value)))
5088               ;; It is needed for filenames with capital letters
5089               ;;(disable-shortcuts)
5090               (mode-line . anything-read-file-name-mode-line-string)
5091               (candidates
5092                . (lambda ()
5093                    (if test
5094                        (loop with hn = (anything-ff-tramp-hostnames)
5095                              for i in (anything-find-files-get-candidates
5096                                        must-match)
5097                              when (or (member i hn)            ; A tramp host
5098                                       (funcall test i)         ; Test ok
5099                                       (not (file-exists-p i))) ; A new file.
5100                              collect i)
5101                        (anything-find-files-get-candidates must-match))))
5102               (filtered-candidate-transformer anything-c-find-files-transformer)
5103               (persistent-action . ,persistent-action)
5104               (candidate-number-limit . 9999)
5105               (toggle-auto-update . anything-ff-toggle-auto-update)
5106               (persistent-help . ,persistent-help)
5107               (volatile)
5108               (action . ,'action-fn)))
5109            :input initial-input
5110            :prompt prompt
5111            :resume 'noresume
5112            :buffer buffer
5113            :preselect preselect)
5114           (when (and (not (string= anything-pattern ""))
5115                      (eq anything-exit-status 0)
5116                      (eq must-match 'confirm))
5117             (identity anything-pattern))
5118           (keyboard-quit)))))
5119
5120 \f
5121 ;;; File Cache
5122 (defvar anything-c-file-cache-initialized-p nil)
5123
5124 (defvar anything-c-file-cache-files nil)
5125
5126 (defvar anything-c-source-file-cache
5127   `((name . "File Cache")
5128     (init
5129      . (lambda ()
5130          (require 'filecache nil t)
5131          (unless anything-c-file-cache-initialized-p
5132            (setq anything-c-file-cache-files
5133                  (loop for item in file-cache-alist append
5134                        (destructuring-bind (base &rest dirs) item
5135                          (loop for dir in dirs collect
5136                                (concat dir base)))))
5137            (defadvice file-cache-add-file (after file-cache-list activate)
5138              (add-to-list 'anything-c-file-cache-files (expand-file-name file)))
5139            (setq anything-c-file-cache-initialized-p t))))
5140     (keymap . ,anything-generic-files-map)
5141     (help-message . anything-generic-file-help-message)
5142     (mode-line . anything-generic-file-mode-line-string)
5143     (candidates . anything-c-file-cache-files)
5144     (match anything-c-match-on-basename)
5145     (type . file)))
5146
5147 \f
5148 ;;; Locate
5149 ;;
5150 ;;
5151 ;; NOTE for WINDOZE users:
5152 ;; You have to install Everything with his command line interface here:
5153 ;; http://www.voidtools.com/download.php
5154
5155 (defun anything-ff-find-locatedb (&optional from-ff)
5156   "Try to find if a local locatedb file is available.
5157 The search is done in `anything-ff-default-directory' or
5158 fall back to `default-directory' if FROM-FF is nil."
5159   (when anything-ff-locate-db-filename
5160     (cond ((and anything-ff-default-directory
5161                 from-ff
5162                 (file-exists-p (expand-file-name
5163                                 anything-ff-locate-db-filename
5164                                 anything-ff-default-directory))
5165                 (expand-file-name
5166                  anything-ff-locate-db-filename
5167                  anything-ff-default-directory)))
5168           ((and (not from-ff)
5169                 (file-exists-p (expand-file-name
5170                                 anything-ff-locate-db-filename
5171                                 default-directory))
5172                 (expand-file-name
5173                  anything-ff-locate-db-filename
5174                  default-directory))))))
5175
5176 (defun anything-locate-1 (&optional localdb init from-ff)
5177   "Generic function to run Locate.
5178 if LOCALDB is non--nil search and use a local locate db file.
5179 INIT is a string to use as initial input in prompt.
5180 See `anything-locate-with-db' and `anything-locate'."
5181   (anything-locate-with-db
5182    (and localdb
5183         (or (anything-ff-find-locatedb from-ff)
5184             (anything-c-read-file-name
5185              "LocateDBFiles: "
5186              :initial-input (or anything-ff-default-directory
5187                                 default-directory)
5188              :marked-candidates t
5189              :preselect anything-locate-db-file-regexp
5190              :test #'(lambda (x)
5191                        (if anything-locate-db-file-regexp
5192                            ;; Select only locate db files and directories
5193                            ;; to allow navigation.
5194                            (or (string-match
5195                                 anything-locate-db-file-regexp x)
5196                                (file-directory-p x))
5197                            x)))))
5198    init))
5199 ;; (anything-locate-1 t)
5200
5201 (defun anything-locate-with-db (&optional db initial-input)
5202   "Run locate -d DB.
5203 If DB is not given or nil use locate without -d option.
5204 Argument DB can be given as a string or list of db files.
5205 Argument INITIAL-INPUT is a string to use as initial-input.
5206 See also `anything-locate'."
5207   (when (and db (stringp db)) (setq db (list db)))
5208   (unless anything-c-locate-command
5209     (setq anything-c-locate-command
5210           (case system-type
5211             ('gnu/linux "locate -i -r %s")
5212             ('berkeley-unix "locate -i %s")
5213             ('windows-nt "es -i -r %s")
5214             (t "locate %s"))))
5215   (let ((anything-c-locate-command
5216          (if db
5217              (replace-regexp-in-string
5218               "locate"
5219               (format "locate -d %s"
5220                       (mapconcat 'identity
5221                                  ;; Remove eventually
5222                                  ;; marked directories by error.
5223                                  (loop for i in db
5224                                        unless (file-directory-p i)
5225                                        collect i) ":"))
5226               anything-c-locate-command)
5227              anything-c-locate-command)))
5228     (anything :sources 'anything-c-source-locate
5229               :buffer "*anything locate*"
5230               :input initial-input
5231               :keymap anything-generic-files-map)))
5232 ;; (anything-locate-with-db "~/locate.db")
5233
5234 (defun anything-c-locate-init ()
5235   "Initialize async locate process for `anything-c-source-locate'."
5236   (setq mode-line-format
5237         '(" " mode-line-buffer-identification " "
5238           (line-number-mode "%l") " "
5239           (:eval (propertize "(Locate Process Running) "
5240                   'face '((:foreground "red"))))))
5241   (prog1
5242       (start-process-shell-command "locate-process" nil
5243                                    (format anything-c-locate-command
5244                                            anything-pattern))
5245     (set-process-sentinel (get-process "locate-process")
5246                           #'(lambda (process event)
5247                               (when (string= event "finished\n")
5248                                 (with-anything-window
5249                                   (force-mode-line-update nil)
5250                                   (anything-update-move-first-line)))))))
5251
5252 (defvar anything-c-source-locate
5253   `((name . "Locate")
5254     (candidates . anything-c-locate-init)
5255     (type . file)
5256     (requires-pattern . 3)
5257     (keymap . ,anything-generic-files-map)
5258     (help-message . anything-generic-file-help-message)
5259     (candidate-number-limit . 9999)
5260     (mode-line . anything-generic-file-mode-line-string)
5261     (delayed))
5262   "Find files matching the current input pattern with locate.")
5263
5264 (defun anything-c-locate-read-file-name (prompt &optional init)
5265   "Search a file with locate and return it's filename.
5266 Use argument PROMPT and INIT for `anything' arguments
5267 prompt and input."
5268   (anything :sources
5269             '((name . "Locate")
5270               (candidates . anything-c-locate-init)
5271               (action . identity)
5272               (requires-pattern . 3)
5273               (candidate-number-limit . 9999)
5274               (mode-line . anything-generic-file-mode-line-string)
5275               (delayed))
5276             :prompt prompt
5277             :input init
5278             :buffer "*anything locate rfn*"))
5279
5280
5281 \f
5282 ;;; Anything Incremental Grep.
5283 ;;
5284 ;;
5285 ;; Allow to grep incrementally with anything interface.
5286 ;; It allow also to Grep files recursively without using 'find' shell command.
5287 ;; On Windows you will need at least Grep version 2.5.4 of Gnuwin32.
5288 (defvar anything-c-grep-default-command
5289   "grep -d skip %e -niH -e %p %f"
5290   "Default grep format command for `anything-do-grep-1'.
5291 Where:
5292 '%e' format spec is for --exclude or --include grep options.
5293 '%p' format spec is for pattern.
5294 '%f' format spec is for filenames.")
5295
5296 (defvar anything-c-grep-default-recurse-command
5297   "grep -d recurse %e -niH -e %p %f"
5298   "Default recursive grep format command for `anything-do-grep-1'.
5299 See `anything-c-grep-default-command' for format specs.")
5300
5301 (defvar anything-c-default-zgrep-command "zgrep -niH -e %p %f")
5302
5303 (defvar anything-c-rzgrep-cache (make-hash-table :test 'equal))
5304
5305 (defvar anything-c-grep-default-function 'anything-c-grep-init)
5306
5307 (defvar anything-c-grep-debug-command-line nil
5308   "Turn on anything grep command-line debugging when non--nil.")
5309
5310 (defvar anything-c-zgrep-recurse-flag nil)
5311
5312 (defvar anything-c-grep-history nil)
5313
5314 (defvar anything-c-grep-max-length-history 100
5315   "*Max number of elements to save in `anything-c-grep-history'.")
5316
5317 (defun anything-c-grep-prepare-candidates (candidates)
5318   "Prepare filenames and directories CANDIDATES for grep command line."
5319   ;; If one or more candidate is a directory, search in all files
5320   ;; of this candidate (e.g /home/user/directory/*).
5321   ;; If r option is enabled search also in subdidrectories.
5322   ;; We need here to expand wildcards to support crap windows filenames
5323   ;; as grep doesn't accept quoted wildcards (e.g "dir/*.el").
5324   (if anything-c-zgrep-recurse-flag
5325       (mapconcat 'shell-quote-argument candidates " ")
5326       (loop for i in candidates append
5327             (cond ( ;; Candidate is a directory and we use recursion.
5328                    (and (file-directory-p i)
5329                         (anything-c-grep-recurse-p))
5330                    (list (expand-file-name i)))
5331                   ;; Candidate is a directory, search in all files.
5332                   ((file-directory-p i)
5333                    (file-expand-wildcards
5334                     (concat (file-name-as-directory (expand-file-name i)) "*") t))
5335                   ;; Candidate is a file or wildcard and we use recursion, use the
5336                   ;; current directory instead of candidate.
5337                   ((and (or (file-exists-p i) (string-match "\*" i))
5338                         (anything-c-grep-recurse-p))
5339                    (list (expand-file-name
5340                           (directory-file-name ; Needed for windoze.
5341                            (file-name-directory (directory-file-name i))))))
5342                   ;; Candidate use wildcard.
5343                   ((string-match "^\*" (anything-c-basename i))
5344                    (file-expand-wildcards i t))
5345                   ;; Else should be one or more file.
5346                   (t (list i))) into all-files
5347             finally return
5348             (mapconcat 'shell-quote-argument all-files " "))))
5349
5350 (defun anything-c-grep-recurse-p ()
5351   "Check if `anything-do-grep-1' have switched to recursive."
5352   (let ((args (replace-regexp-in-string
5353                "grep" "" anything-c-grep-default-command)))
5354     (string-match-p "r\\|recurse" args)))
5355
5356 (defun anything-c-grep-init (only-files &optional include zgrep)
5357   "Start an asynchronous grep process in ONLY-FILES list."
5358   (let* ((fnargs        (anything-c-grep-prepare-candidates
5359                          (if (file-remote-p anything-ff-default-directory)
5360                              (mapcar #'(lambda (x)
5361                                          (file-remote-p x 'localname))
5362                                      only-files)
5363                              only-files)))
5364          (ignored-files (mapconcat
5365                          #'(lambda (x)
5366                              (concat "--exclude=" (shell-quote-argument x)))
5367                          grep-find-ignored-files " "))
5368          (ignored-dirs  (mapconcat
5369                          ;; Need grep version >=2.5.4 of Gnuwin32 on windoze.
5370                          #'(lambda (x)
5371                              (concat "--exclude-dir=" (shell-quote-argument x)))
5372                          grep-find-ignored-directories " "))
5373          (exclude       (if (anything-c-grep-recurse-p)
5374                             (concat (or include ignored-files) " " ignored-dirs)
5375                             ignored-files))
5376          (cmd-line      (format-spec
5377                          anything-c-grep-default-command
5378                          (delq nil
5379                                (list (unless zgrep (cons ?e exclude))
5380                                      (cons ?p (shell-quote-argument anything-pattern))
5381                                      (cons ?f fnargs))))))
5382     (when anything-c-grep-debug-command-line
5383       (with-current-buffer (get-buffer-create "*any grep debug*")
5384         (goto-char (point-max))
5385         (insert (concat ">>> " cmd-line "\n\n"))))
5386     (setq mode-line-format
5387           '(" " mode-line-buffer-identification " "
5388             (line-number-mode "%l") " "
5389             (:eval (when (get-process "grep-process")
5390                      (propertize "[Grep Process Running] "
5391                                  'face 'anything-grep-running)))))
5392     (force-mode-line-update nil)
5393     (prog1
5394         (let ((default-directory anything-ff-default-directory))
5395           (start-file-process-shell-command "grep-process" nil cmd-line))
5396       (message nil)
5397       (set-process-sentinel
5398        (get-process "grep-process")
5399        #'(lambda (process event)
5400            (when (string= event "finished\n")
5401              (with-anything-window
5402                (anything-update-move-first-line)
5403                (setq mode-line-format
5404                      '(" " mode-line-buffer-identification " "
5405                        (line-number-mode "%l") " "
5406                        (:eval (propertize
5407                                (format "[Grep Process Finished - (%s results)] "
5408                                        (let ((nlines (1- (count-lines
5409                                                           (point-min)
5410                                                           (point-max)))))
5411                                          (if (> nlines 0) nlines 0)))
5412                                'face 'anything-grep-finish))))
5413                (force-mode-line-update nil))))))))
5414
5415 (defun anything-c-grep-action (candidate &optional where mark)
5416   "Define a default action for `anything-do-grep' on CANDIDATE.
5417 WHERE can be one of other-window, elscreen, other-frame."
5418   (let* ((split        (anything-c-grep-split-line candidate))
5419          (lineno       (string-to-number (nth 1 split)))
5420          (loc-fname    (car split))
5421          (tramp-method (file-remote-p anything-ff-default-directory 'method))
5422          (tramp-host   (file-remote-p anything-ff-default-directory 'host))
5423          (tramp-prefix (concat "/" tramp-method ":" tramp-host ":"))
5424          (fname        (if tramp-host
5425                            (concat tramp-prefix loc-fname) loc-fname)))
5426     (case where
5427       (other-window (find-file-other-window fname))
5428       (elscreen     (anything-elscreen-find-file fname))
5429       (other-frame  (find-file-other-frame fname))
5430       (grep         (anything-c-grep-save-results-1))
5431       (t (find-file fname)))
5432     (unless (eq where 'grep)
5433       (anything-goto-line lineno))
5434     (when mark
5435       (set-marker (mark-marker) (point))
5436       (push-mark (point) 'nomsg))
5437     ;; Save history
5438     (unless (or anything-in-persistent-action
5439                 (string= anything-pattern ""))
5440       (setq anything-c-grep-history
5441             (cons anything-pattern
5442                   (delete anything-pattern anything-c-grep-history)))
5443       (when (> (length anything-c-grep-history)
5444                anything-c-grep-max-length-history)
5445         (setq anything-c-grep-history
5446               (delete (car (last anything-c-grep-history))
5447                       anything-c-grep-history))))))
5448
5449 (defun anything-c-grep-other-window (candidate)
5450   "Jump to result in other window from anything grep."
5451   (anything-c-grep-action candidate 'other-window))
5452
5453 (defun anything-c-grep-other-frame (candidate)
5454   "Jump to result in other frame from anything grep."
5455   (anything-c-grep-action candidate 'other-frame))
5456
5457 (defun anything-c-grep-jump-elscreen (candidate)
5458   "Jump to result in elscreen from anything grep."
5459   (anything-c-grep-action candidate 'elscreen))
5460
5461 (defun anything-c-grep-save-results (_candidate)
5462   (anything-c-grep-action _candidate 'grep))
5463
5464 (defun anything-c-grep-save-results-1 ()
5465   "Save anything grep result in a `grep-mode' buffer."
5466   (let ((buf "*grep*")
5467         new-buf)
5468     (when (get-buffer buf)
5469       (setq new-buf (read-string "GrepBufferName: " buf))
5470       (loop for b in (anything-c-buffer-list)
5471             when (and (string= new-buf b)
5472                       (not (y-or-n-p
5473                             (format "Buffer `%s' already exists overwrite? "
5474                                     new-buf))))
5475             do (setq new-buf (read-string "GrepBufferName: " "*grep ")))
5476       (setq buf new-buf))
5477     (with-current-buffer (get-buffer-create buf)
5478       (let ((inhibit-read-only t))
5479         (erase-buffer)
5480         (insert "-*- mode: grep -*-\n\n"
5481                 (format "Grep Results for `%s':\n\n" anything-pattern))
5482         (save-excursion
5483           (insert (with-current-buffer anything-buffer
5484                     (goto-char (point-min)) (forward-line 1)
5485                     (buffer-substring (point) (point-max))))
5486           (grep-mode))))
5487     (message "Anything Grep Results saved in `%s' buffer" buf)))
5488
5489 (defun anything-c-grep-persistent-action (candidate)
5490   "Persistent action for `anything-do-grep'.
5491 With a prefix arg record CANDIDATE in `mark-ring'."
5492   (if current-prefix-arg
5493       (anything-c-grep-action candidate nil 'mark)
5494       (anything-c-grep-action candidate))
5495   (anything-match-line-color-current-line))
5496
5497 (defun anything-c-grep-guess-extensions (files)
5498   "Try to guess file extensions in FILES list when using grep recurse.
5499 These extensions will be added to command line with --include arg of grep."
5500   (loop
5501         with glob-list = nil
5502         with lst = (if (file-directory-p (car files))
5503                        (directory-files
5504                         (car files) nil
5505                         directory-files-no-dot-files-regexp)
5506                        files)
5507         for i in lst
5508         for ext = (file-name-extension i t)
5509         for glob = (and ext (not (string= ext ""))
5510                         (concat "*" ext))
5511         unless (or (not glob)
5512                    (member glob glob-list)
5513                    (member glob grep-find-ignored-files))
5514         collect glob into glob-list
5515         finally return glob-list))
5516
5517 (defun anything-do-grep-1 (only &optional recurse zgrep)
5518   "Launch grep with a list of ONLY files.
5519 When RECURSE is given use -r option of grep and prompt user
5520 to set the --include args of grep.
5521 You can give more than one arg separated by space.
5522 e.g *.el *.py *.tex.
5523 If it's empty --exclude `grep-find-ignored-files' is used instead."
5524   (let* ((anything-compile-source-functions
5525           ;; rule out anything-match-plugin because the input is one regexp.
5526           (delq 'anything-compile-source--match-plugin
5527                 (copy-sequence anything-compile-source-functions)))
5528          (exts (anything-c-grep-guess-extensions only))
5529          (globs (and (not zgrep) (mapconcat 'identity exts " ")))
5530          (include-files (and recurse (not zgrep)
5531                              (read-string "OnlyExt(*.[ext]): "
5532                                           globs)))
5533          ;; Set `minibuffer-history' AFTER includes-files
5534          ;; to avoid storing wild-cards here.
5535          (minibuffer-history anything-c-grep-history)
5536          (anything-c-grep-default-command (cond ((and recurse zgrep) anything-c-default-zgrep-command)
5537                                                 (recurse anything-c-grep-default-recurse-command)
5538                                                 (zgrep anything-c-default-zgrep-command)
5539                                                 (t anything-c-grep-default-command)))
5540          ;; Disable match-plugin and use here own highlighting.
5541          (anything-mp-highlight-delay     nil))
5542     (when include-files
5543       (setq include-files
5544             (and (not (string= include-files ""))
5545                  (mapconcat #'(lambda (x)
5546                                 (concat "--include=" (shell-quote-argument x)))
5547                             (split-string include-files) " "))))
5548     ;; When called as action from an other source e.g *-find-files
5549     ;; we have to kill action buffer.
5550     (when (get-buffer anything-action-buffer)
5551       (kill-buffer anything-action-buffer))
5552     ;; `anything-find-files' haven't already started,
5553     ;; give a default value to `anything-ff-default-directory'.
5554     (setq anything-ff-default-directory (or anything-ff-default-directory
5555                                             default-directory))
5556     (anything
5557      :sources
5558      `(((name . "Grep")
5559         (header-name . (lambda (name)
5560                          (concat name "(C-c ? Help)")))
5561         (candidates
5562          . (lambda ()
5563              (funcall anything-c-grep-default-function only include-files zgrep)))
5564         (filtered-candidate-transformer anything-c-grep-cand-transformer)
5565         (candidate-number-limit . 9999)
5566         (mode-line . anything-grep-mode-line-string)
5567         (keymap . ,anything-c-grep-map)
5568         (action . ,(delq
5569                     nil
5570                     `(("Find File" . anything-c-grep-action)
5571                       ("Find file other frame" . anything-c-grep-other-frame)
5572                       ,(and (locate-library "elscreen")
5573                             '("Find file in Elscreen"
5574                               . anything-c-grep-jump-elscreen))
5575                       ("Save results in grep buffer" . anything-c-grep-save-results)
5576                       ("Find file other window" . anything-c-grep-other-window))))
5577         (persistent-action . anything-c-grep-persistent-action)
5578         (persistent-help . "Jump to line (`C-u' Record in mark ring)")
5579         (requires-pattern . 3)
5580         (delayed)))
5581      :buffer "*anything grep*")))
5582
5583 (defun anything-ff-zgrep-1 (flist recursive)
5584   (unwind-protect
5585        (let* ((def-dir (or anything-ff-default-directory
5586                            default-directory))
5587               (only    (if recursive
5588                            (or (gethash def-dir anything-c-rzgrep-cache)
5589                                (puthash
5590                                 def-dir
5591                                 (anything-c-walk-directory
5592                                  def-dir
5593                                  :directories nil
5594                                  :path 'full
5595                                  :match ".*\\(\.gz\\|\.bz\\|\.xz\\|\.lzma\\)$")
5596                                 anything-c-rzgrep-cache))
5597                            flist)))
5598          (when recursive (setq anything-c-zgrep-recurse-flag t))
5599          (anything-do-grep-1 only recursive 'zgrep))
5600     (setq anything-c-zgrep-recurse-flag nil)))
5601
5602 (defun anything-c-grep-split-line (line)
5603   "Split a grep output line."
5604   (let (beg fname lineno str)
5605     ;; Don't print until grep line is valid.
5606     (when (string-match "\\(.*\\)\\(:[0-9]+:\\)\\(.*\\)" line)
5607       (with-temp-buffer
5608         (insert line)
5609         (goto-char (point-min))
5610         (setq beg (point))
5611         (forward-char 2)
5612         (re-search-forward ":" nil t)
5613         (setq fname (buffer-substring-no-properties beg (1- (point))))
5614         (setq beg (point))
5615         (re-search-forward ":" nil t)
5616         (setq lineno (buffer-substring-no-properties beg (1- (point))))
5617         (setq str (buffer-substring-no-properties (point) (point-at-eol))))
5618       (list fname lineno str))))
5619
5620 (defun anything-c-grep-cand-transformer (candidates sources)
5621   "Filtered candidate transformer function for `anything-do-grep'."
5622   (loop for i in candidates
5623         for split  = (and i (anything-c-grep-split-line i))
5624         for fname  = (car split)
5625         for lineno = (nth 1 split)
5626         for str    = (nth 2 split)
5627         when (and fname lineno str)
5628         collect
5629         (cons (concat (propertize (file-name-nondirectory fname)
5630                                   'face 'anything-grep-file
5631                                   'help-echo fname) ":"
5632                                   (propertize lineno 'face 'anything-grep-lineno) ":"
5633                                   (anything-c-grep-highlight-match str))
5634               i)))
5635
5636 (defun anything-c-grep-highlight-match (str)
5637   "Highlight in string STR all occurences matching `anything-pattern'."
5638   (condition-case nil
5639       (with-temp-buffer
5640         (insert str)
5641         (goto-char (point-min))
5642         (while (and (re-search-forward anything-pattern nil t)
5643                     (> (- (match-end 0) (match-beginning 0)) 0))
5644           (add-text-properties
5645            (match-beginning 0) (match-end 0)
5646            '(face anything-grep-match)))
5647         (buffer-string))
5648     (error nil)))
5649
5650 ;; Go to next or precedent file (common to etags and grep).
5651 (defun anything-c-goto-next-or-prec-file (n)
5652   "Go to next or precedent candidate file in anything grep/etags buffers.
5653 If N is positive go forward otherwise go backward."
5654   (with-anything-window
5655     (let* ((current-line-list  (split-string
5656                                 (buffer-substring
5657                                  (point-at-bol)
5658                                  (point-at-eol)) ":"))
5659            (current-fname      (nth 0 current-line-list))
5660            (fn-b-o-f           (if (eq n 1) 'eobp 'bobp)))
5661       (catch 'break
5662         (while (not (funcall fn-b-o-f))
5663           (forward-line n) ; Go forward or backward depending of n value.
5664           (unless (search-forward current-fname (point-at-eol) t)
5665             (anything-mark-current-line)
5666             (throw 'break nil))))
5667       (cond ((and (eq n 1) (eobp))
5668              (re-search-backward ".")
5669              (forward-line 0)
5670              (anything-mark-current-line))
5671             ((and (< n 1) (bobp))
5672              (forward-line 1)
5673              (anything-mark-current-line))))))
5674
5675 ;;;###autoload
5676 (defun anything-c-goto-precedent-file ()
5677   "Go to precedent file in anything grep/etags buffers."
5678   (interactive)
5679   (anything-c-goto-next-or-prec-file -1))
5680
5681 ;;;###autoload
5682 (defun anything-c-goto-next-file ()
5683   "Go to precedent file in anything grep/etags buffers."
5684   (interactive)
5685   (anything-c-goto-next-or-prec-file 1))
5686
5687 ;;;###autoload
5688 (defun anything-c-grep-run-persistent-action ()
5689   "Run grep persistent action from `anything-do-grep-1'."
5690   (interactive)
5691   (anything-attrset 'jump-persistent 'anything-c-grep-persistent-action)
5692   (anything-execute-persistent-action 'jump-persistent))
5693
5694 ;;;###autoload
5695 (defun anything-c-grep-run-default-action ()
5696   "Run grep default action from `anything-do-grep-1'."
5697   (interactive)
5698   (anything-c-quit-and-execute-action 'anything-c-grep-action))
5699
5700 ;;;###autoload
5701 (defun anything-c-grep-run-other-window-action ()
5702   "Run grep goto other window action from `anything-do-grep-1'."
5703   (interactive)
5704   (anything-c-quit-and-execute-action 'anything-c-grep-other-window))
5705
5706 ;;;###autoload
5707 (defun anything-c-grep-run-save-buffer ()
5708   "Run grep save results action from `anything-do-grep-1'."
5709   (interactive)
5710   (anything-c-quit-and-execute-action 'anything-c-grep-save-results))
5711
5712 ;; Grep buffers
5713 (defun anything-c-grep-buffers-1 (candidate &optional zgrep)
5714   "Run grep on all file--buffers or CANDIDATE if it is a file--buffer.
5715 If one of selected buffers is not a file--buffer,
5716 it is ignored and grep will run on all others file--buffers.
5717 If only one candidate is selected and it is not a file--buffer,
5718 switch to this buffer and run `anything-occur'.
5719 If a prefix arg is given run grep on all buffers ignoring non--file-buffers."
5720   (let* ((prefarg (or current-prefix-arg anything-current-prefix-arg))
5721          (cands (if prefarg
5722                     (buffer-list)
5723                     (anything-marked-candidates)))
5724          (win-conf (current-window-configuration))
5725          ;; Non--fname buffers are ignored.
5726          (bufs (loop for buf in cands
5727                      for fname = (buffer-file-name (get-buffer buf))
5728                      when fname
5729                      collect (expand-file-name fname))))
5730     (if bufs
5731         (if zgrep
5732             (anything-do-grep-1 bufs nil 'zgrep)
5733             (anything-do-grep-1 bufs))
5734         ;; bufs is empty, thats mean we have only CANDIDATE
5735         ;; and it is not a buffer-filename, fallback to occur.
5736         (anything-c-switch-to-buffer candidate)
5737         (when (get-buffer anything-action-buffer)
5738           (kill-buffer anything-action-buffer))
5739         (anything-occur)
5740         (when (eq anything-exit-status 1)
5741           (set-window-configuration win-conf)))))
5742
5743 (defun anything-c-grep-buffers (candidate)
5744   "Action to grep buffers."
5745   (anything-c-grep-buffers-1 candidate))
5746
5747 (defun anything-c-zgrep-buffers (candidate)
5748   "Action to zgrep buffers."
5749   (anything-c-grep-buffers-1 candidate 'zgrep))
5750
5751 \f
5752 ;;; Anything interface for pdfgrep
5753 ;;  pdfgrep program <http://pdfgrep.sourceforge.net/>
5754 ;;  and a pdf-reader (e.g xpdf) are needed.
5755 ;;
5756 (defvar anything-c-pdfgrep-default-command "pdfgrep --color never -niH %s %s")
5757 (defvar anything-c-pdfgrep-default-function 'anything-c-pdfgrep-init)
5758 (defvar anything-c-pdfgrep-debug-command-line nil)
5759
5760 (defun anything-c-pdfgrep-init (only-files)
5761   "Start an asynchronous pdfgrep process in ONLY-FILES list."
5762   (let* ((fnargs   (anything-c-grep-prepare-candidates
5763                     (if (file-remote-p anything-ff-default-directory)
5764                         (mapcar #'(lambda (x)
5765                                     (file-remote-p x 'localname))
5766                                 only-files)
5767                         only-files)))
5768          (cmd-line (format anything-c-pdfgrep-default-command
5769                            anything-pattern
5770                            fnargs)))
5771     (when anything-c-pdfgrep-debug-command-line
5772       (with-current-buffer (get-buffer-create "*any pdfgrep debug*")
5773         (goto-char (point-max))
5774         (insert (concat ">>> " cmd-line "\n\n"))))
5775     (setq mode-line-format
5776           '(" " mode-line-buffer-identification " "
5777             (line-number-mode "%l") " "
5778             (:eval (propertize "(Pdfgrep Process Running) "
5779                     'face '((:foreground "red"))))))
5780     (prog1
5781         (let ((default-directory anything-ff-default-directory))
5782           (start-file-process-shell-command "pdfgrep-process" nil cmd-line))
5783       (message nil)
5784       (set-process-sentinel
5785        (get-process "pdfgrep-process")
5786        #'(lambda (process event)
5787            (when (string= event "finished\n")
5788              (with-anything-window
5789                (anything-update-move-first-line))
5790              (force-mode-line-update nil)))))))
5791
5792
5793 (defun anything-do-pdfgrep-1 (only)
5794   "Launch pdfgrep with a list of ONLY files."
5795   (unless (executable-find "pdfgrep")
5796     (error "Error: No such program `pdfgrep'."))
5797   (let* ((anything-compile-source-functions
5798           ;; rule out anything-match-plugin because the input is one regexp.
5799           (delq 'anything-compile-source--match-plugin
5800                 (copy-sequence anything-compile-source-functions)))
5801          ;; Disable match-plugin and use here own highlighting.
5802          (anything-mp-highlight-delay nil))
5803     ;; When called as action from an other source e.g *-find-files
5804     ;; we have to kill action buffer.
5805     (when (get-buffer anything-action-buffer)
5806       (kill-buffer anything-action-buffer))
5807     ;; If `anything-find-files' haven't already started,
5808     ;; give a default value to `anything-ff-default-directory'.
5809     (setq anything-ff-default-directory (or anything-ff-default-directory
5810                                             default-directory))
5811     (anything
5812      :sources
5813      `(((name . "PdfGrep")
5814         (candidates
5815          . (lambda ()
5816              (funcall anything-c-pdfgrep-default-function only)))
5817         (filtered-candidate-transformer anything-c-grep-cand-transformer)
5818         (candidate-number-limit . 9999)
5819         (mode-line . anything-pdfgrep-mode-line-string)
5820         (action . anything-c-pdfgrep-action)
5821         (persistent-help . "Jump to PDF Page")
5822         (requires-pattern . 3)
5823         (delayed)))
5824      :keymap anything-c-pdfgrep-map
5825      :buffer "*anything grep*")))
5826
5827
5828 (defun anything-c-pdfgrep-action (candidate)
5829   (let* ((split  (anything-c-grep-split-line candidate))
5830          (pageno (nth 1 split))
5831          (fname  (car split)))
5832     (start-file-process-shell-command
5833      "pdf-reader" nil
5834      (format-spec anything-c-pdfgrep-default-read-command
5835                   (list (cons ?f fname) (cons ?p pageno))))))
5836
5837 \f
5838 ;; Yank text at point.
5839 ;;
5840 ;;
5841 ;; Internal
5842 (defvar anything-yank-point nil)
5843
5844 ;;;###autoload
5845 (defun anything-yank-text-at-point ()
5846   "Yank text at point in minibuffer."
5847   (interactive)
5848   (let (input)
5849     (flet ((insert-in-minibuffer (word)
5850              (with-selected-window (minibuffer-window)
5851                (let ((str anything-pattern))
5852                  (delete-minibuffer-contents)
5853                  (set-text-properties 0 (length word) nil word)
5854                  (insert (concat str word))))))
5855       (with-anything-current-buffer
5856         ;; Start to initial point if C-w have never been hit.
5857         (unless anything-yank-point (setq anything-yank-point (point)))
5858         (and anything-yank-point (goto-char anything-yank-point))
5859         (forward-word 1)
5860         (setq input (buffer-substring-no-properties anything-yank-point (point)))
5861         (setq anything-yank-point (point))) ; End of last forward-word
5862       (insert-in-minibuffer input))))
5863
5864 (defun anything-reset-yank-point ()
5865   (setq anything-yank-point nil))
5866
5867 (add-hook 'anything-after-persistent-action-hook 'anything-reset-yank-point)
5868 (add-hook 'anything-cleanup-hook 'anything-reset-yank-point)
5869
5870 \f
5871 ;;; Recentf files
5872 ;;
5873 ;;
5874 (defvar anything-c-source-recentf
5875   `((name . "Recentf")
5876     (init . (lambda ()
5877               (require 'recentf)
5878               (or recentf-mode (recentf-mode 1))))
5879     ;; Needed for filenames with capitals letters.
5880     ;;(disable-shortcuts)
5881     (candidates . recentf-list)
5882     (keymap . ,anything-generic-files-map)
5883     (help-message . anything-generic-file-help-message)
5884     (mode-line . anything-generic-file-mode-line-string)
5885     (match anything-c-match-on-basename)
5886     (type . file))
5887   "See (info \"(emacs)File Conveniences\").
5888 Set `recentf-max-saved-items' to a bigger value if default is too small.")
5889
5890 ;;; ffap
5891 (eval-when-compile (require 'ffap))
5892 (defvar anything-c-source-ffap-guesser
5893   `((name . "File at point")
5894     (init . (lambda () (require 'ffap)))
5895     (candidates . (lambda ()
5896                     (anything-aif
5897                         (with-anything-current-buffer
5898                           (ffap-guesser))
5899                         (list it))))
5900     (keymap . ,anything-generic-files-map)
5901     (help-message . anything-generic-file-help-message)
5902     (mode-line . anything-generic-file-mode-line-string)
5903     (type . file)))
5904
5905 ;;; ffap with line number
5906 (defun anything-c-ffap-file-line-at-point ()
5907   "Get (FILENAME . LINENO) at point."
5908   (anything-aif (let (ffap-alist) (ffap-file-at-point))
5909       (save-excursion
5910         (beginning-of-line)
5911         (when (and (search-forward it nil t)
5912                    (looking-at ":\\([0-9]+\\)"))
5913           (cons it (string-to-number (match-string 1)))))))
5914
5915 (defun anything-c-ffap-line-candidates ()
5916   (with-anything-current-buffer
5917     (anything-attrset 'ffap-line-location (anything-c-ffap-file-line-at-point)))
5918   (anything-aif (anything-attr 'ffap-line-location)
5919     (destructuring-bind (file . line) it
5920       (list (cons (format "%s (line %d)" file line) file)))))
5921
5922 ;;; Goto line after opening file by `anything-c-source-ffap-line'.
5923 (defun anything-c-ffap-line-goto-line ()
5924   (when (car (anything-attr 'ffap-line-location))
5925     (unwind-protect
5926         (ignore-errors
5927           (with-selected-window
5928               (get-buffer-window
5929                (get-file-buffer (car (anything-attr 'ffap-line-location))))
5930             (anything-goto-line (cdr (anything-attr 'ffap-line-location)))))
5931       (anything-attrset 'ffap-line-location nil))))
5932 (add-hook 'anything-after-action-hook 'anything-c-ffap-line-goto-line)
5933 (add-hook 'anything-after-persistent-action-hook 'anything-c-ffap-line-goto-line)
5934
5935 (defvar anything-c-source-ffap-line
5936   `((name . "File/Lineno at point")
5937     (init . (lambda () (require 'ffap)))
5938     (candidates . anything-c-ffap-line-candidates)
5939     (keymap . ,anything-map)
5940     (type . file)))
5941
5942 ;;; list of files gleaned from every dired buffer
5943 (defun anything-c-files-in-all-dired-candidates ()
5944   (save-excursion
5945     (mapcan
5946      (lambda (dir)
5947        (cond ((listp dir)               ;filelist
5948               dir)
5949              ((equal "" (file-name-nondirectory dir)) ;dir
5950               (directory-files dir t))
5951              (t                         ;wildcard
5952               (file-expand-wildcards dir t))))
5953      (delq nil
5954            (mapcar (lambda (buf)
5955                      (set-buffer buf)
5956                      (when (eq major-mode 'dired-mode)
5957                        (if (consp dired-directory)
5958                            (cdr dired-directory) ;filelist
5959                            dired-directory))) ;dir or wildcard
5960                    (buffer-list))))))
5961 ;; (dired '("~/" "~/.emacs-custom.el" "~/.emacs.bmk"))
5962
5963 (defvar anything-c-source-files-in-all-dired
5964   '((name . "Files in all dired buffer.")
5965     (candidates . anything-c-files-in-all-dired-candidates)
5966     (type . file)))
5967
5968 (defvar anything-c-source-filelist
5969   '((name . "FileList")
5970     (grep-candidates . anything-c-filelist-file-name)
5971     (candidate-number-limit . 200)
5972     (requires-pattern . 4)
5973     (type . file))
5974   "Source to find files instantly.
5975 See `anything-c-filelist-file-name' docstring for usage.")
5976
5977 \f
5978 ;;;; <info>
5979 ;;; Info pages
5980 (defvar anything-c-info-pages nil
5981   "All info pages on system.
5982 Will be calculated the first time you invoke anything with this
5983 source.")
5984
5985 (defun anything-c-info-pages-init ()
5986   "Collect candidates for initial Info node Top."
5987   (if anything-c-info-pages
5988       anything-c-info-pages
5989       (let ((info-topic-regexp "\\* +\\([^:]+: ([^)]+)[^.]*\\)\\.")
5990             topics)
5991         (require 'info)
5992         (with-temp-buffer
5993           (Info-find-node "dir" "top")
5994           (goto-char (point-min))
5995           (while (re-search-forward info-topic-regexp nil t)
5996             (push (match-string-no-properties 1) topics))
5997           (kill-buffer))
5998         (setq anything-c-info-pages topics))))
5999
6000 (defvar anything-c-source-info-pages
6001   `((name . "Info Pages")
6002     (init . anything-c-info-pages-init)
6003     (candidates . anything-c-info-pages)
6004     (action . (("Show with Info" .(lambda (node-str)
6005                                     (info (replace-regexp-in-string
6006                                            "^[^:]+: " "" node-str))))))
6007     (requires-pattern . 2)))
6008
6009 \f
6010 ;;; Man and woman UI
6011 ;;
6012 ;;
6013 (defvar anything-c-man-pages nil
6014   "All man pages on system.
6015 Will be calculated the first time you invoke anything with this
6016 source.")
6017
6018 (defun anything-c-man-default-action (candidate)
6019   "Default action for jumping to a woman or man page from anything."
6020   (let ((wfiles (woman-file-name-all-completions candidate)))
6021     (condition-case err
6022         (if (> (length wfiles) 1)
6023             (woman-find-file
6024              (anything-comp-read
6025               "ManFile: " wfiles :must-match t))
6026             (woman candidate))
6027       ;; If woman is unable to format correctly
6028       ;; use man instead.
6029       (error (kill-buffer) ; Kill woman buffer.
6030              (let ((Man-notify-method 'meek))
6031                (Man-getpage-in-background candidate))))))
6032
6033 (defvar anything-c-source-man-pages
6034   `((name . "Manual Pages")
6035     (candidates . (lambda ()
6036                     (if anything-c-man-pages
6037                         anything-c-man-pages
6038                         ;; XEmacs doesn't have a woman :)
6039                         (setq anything-c-man-pages
6040                               (ignore-errors
6041                                 (require 'woman)
6042                                 (woman-file-name "")
6043                                 (sort (mapcar 'car woman-topic-all-completions)
6044                                       'string-lessp))))))
6045     (action  ("Show with Woman" . anything-c-man-default-action))
6046     ;; Woman does not work OS X
6047     ;; http://xahlee.org/emacs/modernization_man_page.html
6048     (action-transformer . (lambda (actions candidate)
6049                             (if (eq system-type 'darwin)
6050                                 '(("Show with Man" . man))
6051                                 actions)))
6052     (requires-pattern . 2)))
6053
6054 \f
6055 ;;;; <Command>
6056 ;;; Anything M-x - Enhanced M-x UI
6057 ;;
6058 ;;
6059 ;; Another replacement of `M-x' that act exactly like the
6060 ;; vanilla Emacs one, no problem of windows configuration, prefix args
6061 ;; can be passed before calling `M-x' (e.g C-u M-x..) but also during
6062 ;; anything invocation.
6063 ;; Documentation of commands available without quitting,
6064 ;; Show keybindings of commands.
6065 ;; Show history.
6066 (defvar anything-M-x-input-history nil)
6067
6068 (defun* anything-M-x-get-major-mode-command-alist (mode-map)
6069   "Return alist of MODE-MAP."
6070   (loop for key being the key-seqs of mode-map using (key-bindings com)
6071         for str-key  = (key-description key)
6072         for ismenu   = (string-match "<menu-bar>" str-key)
6073         unless ismenu collect (cons str-key com)))
6074
6075 (defun anything-get-mode-map-from-mode (mode)
6076   "Guess the mode-map name according to MODE.
6077 Some modes don't use conventional mode-map name
6078 so we need to guess mode-map name. e.g python-mode ==> py-mode-map.
6079 Return nil if no mode-map found."
6080   (loop
6081         ;; Start with a conventional mode-map name.
6082         with mode-map    = (intern-soft (format "%s-map" mode))
6083         with mode-string = (symbol-name mode)
6084         with mode-name   = (replace-regexp-in-string "-mode" "" mode-string)
6085         while (not mode-map)
6086         for count downfrom (length mode-name)
6087         ;; Return when no result after parsing entire string.
6088         when (eq count 0) return nil
6089         for sub-name = (substring mode-name 0 count)
6090         do (setq mode-map (intern-soft (format "%s-map" (concat sub-name "-mode"))))
6091         finally return mode-map))
6092
6093 (defun anything-M-x-current-mode-map-alist ()
6094   "Return mode-map alist of current `major-mode'."
6095   (let ((map (anything-get-mode-map-from-mode major-mode)))
6096     (when (and map (boundp map))
6097       (anything-M-x-get-major-mode-command-alist (symbol-value map)))))
6098
6099
6100 (defun anything-M-x-transformer (candidates sources)
6101   "filtered-candidate-transformer to show bindings in emacs commands.
6102 Show global bindings and local bindings according to current `major-mode'."
6103   (with-anything-current-buffer
6104     (loop with local-map = (anything-M-x-current-mode-map-alist)
6105           for cand in candidates
6106           for local-key  = (car (rassq cand local-map))
6107           for key        = (substitute-command-keys (format "\\[%s]" cand))
6108           collect
6109           (cons (cond ((and (string-match "^M-x" key) local-key)
6110                        (format "%s (%s)"
6111                                cand (propertize
6112                                      local-key
6113                                      'face 'anything-M-x-key-face)))
6114                       ((string-match "^M-x" key) cand)
6115                       (t (format "%s (%s)"
6116                                  cand (propertize
6117                                        key
6118                                        'face 'anything-M-x-key-face))))
6119                 cand) into ls
6120           finally return
6121           (sort ls #'(lambda (x y) (string-lessp (car x) (car y)))))))
6122
6123 \f
6124 ;;; Complex command history
6125 ;;
6126 ;;
6127 (defvar anything-c-source-complex-command-history
6128   '((name . "Complex Command History")
6129     (candidates . (lambda () (mapcar 'prin1-to-string command-history)))
6130     (type . sexp)))
6131
6132 ;;; M-x history (not related to `anything-M-x')
6133 ;;
6134 ;;
6135 (defvar anything-c-source-extended-command-history
6136   '((name . "Emacs Commands History")
6137     (candidates
6138      . (lambda ()
6139          (anything-fast-remove-dups extended-command-history :test 'equal)))
6140     (type . command)))
6141
6142 ;;; Emacs commands (Basic source for emacs commands)
6143 ;;
6144 ;;
6145 (defvar anything-c-source-emacs-commands
6146   '((name . "Emacs Commands")
6147     (candidates . (lambda ()
6148                     (let (commands)
6149                       (mapatoms (lambda (a)
6150                                   (if (commandp a)
6151                                       (push (symbol-name a)
6152                                             commands))))
6153                       (sort commands 'string-lessp))))
6154     (type . command)
6155     (requires-pattern . 2))
6156   "Source for completing and invoking Emacs commands.
6157 A command is a function with interactive spec that can
6158 be invoked with `M-x'.
6159
6160 To get non-interactive functions listed, use
6161 `anything-c-source-emacs-functions'.")
6162
6163 \f
6164 ;;;; <Function>
6165 ;;; Emacs functions
6166 ;;
6167 ;;
6168 (defvar anything-c-source-emacs-functions
6169   '((name . "Emacs Functions")
6170     (candidates . (lambda ()
6171                     (let (commands)
6172                       (mapatoms (lambda (a)
6173                                   (if (functionp a)
6174                                       (push (symbol-name a) commands))))
6175                       (sort commands 'string-lessp))))
6176     (type . function)
6177     (requires-pattern . 2))
6178   "Source for completing Emacs functions.")
6179
6180 ;;; With abbrev expansion
6181 ;;; Similar to my exec-abbrev-cmd.el
6182 ;;; See http://www.tsdh.de/cgi-bin/wiki.pl/exec-abbrev-cmd.el
6183 (defvar anything-c-function-abbrev-regexp nil
6184   "The regexp for `anything-c-source-emacs-functions-with-abbrevs'.
6185 Regexp built from the current `anything-pattern' interpreting it
6186 as abbreviation.
6187 Only for internal use.")
6188
6189 (defun anything-c-match-function-by-abbrev (candidate)
6190   "Return non-nil if `anything-pattern' is an abbreviation of the function CANDIDATE.
6191
6192 Abbreviations are made by taking the first character from each
6193 word in the function's name, e.g. \"bb\" is an abbrev for
6194 `bury-buffer', \"stb\" is an abbrev for `anything-c-switch-to-buffer'."
6195   (string-match anything-c-function-abbrev-regexp candidate))
6196
6197 (defvar anything-c-source-emacs-functions-with-abbrevs
6198   (append anything-c-source-emacs-functions
6199           '((match anything-c-match-function-by-abbrev
6200              anything-c-string-match))
6201           '((init
6202              . (lambda ()
6203                  (defadvice anything-update
6204                      (before anything-c-update-function-abbrev-regexp activate)
6205                    (let ((char-list (append anything-pattern nil))
6206                          (str "^"))
6207                      (dolist (c char-list)
6208                        (setq str (concat str (list c) "[^-]*-")))
6209                      (setq str (concat (substring str 0 (1- (length str))) "$"))
6210                      (setq anything-c-function-abbrev-regexp str))))))))
6211
6212 (defvar anything-c-source-advice
6213   '((name . "Function Advice")
6214     (candidates . anything-c-advice-candidates)
6215     (action ("Toggle Enable/Disable" . anything-c-advice-toggle))
6216     (persistent-action . anything-c-advice-persistent-action)
6217     (multiline)
6218     (persistent-help . "Describe function / C-u C-z: Toggle advice")))
6219 ;; (let ((debug-on-signal t))(anything 'anything-c-source-advice))
6220 ;; (testadvice)
6221
6222 (defun anything-c-advice-candidates ()
6223   (require 'advice)
6224   (loop for (fname) in ad-advised-functions
6225         for function = (intern fname)
6226         append
6227         (loop for class in ad-advice-classes append
6228               (loop for advice in (ad-get-advice-info-field function class)
6229                     for enabled = (ad-advice-enabled advice)
6230                     collect
6231                     (cons (format
6232                            "%s %s %s"
6233                            (if enabled "Enabled " "Disabled")
6234                            (propertize fname 'face 'font-lock-function-name-face)
6235                            (ad-make-single-advice-docstring advice class nil))
6236                           (list function class advice))))))
6237
6238 (defun anything-c-advice-persistent-action (func-class-advice)
6239   (if current-prefix-arg
6240       (anything-c-advice-toggle func-class-advice)
6241       (describe-function (car func-class-advice))))
6242
6243 (defun anything-c-advice-toggle (func-class-advice)
6244   (destructuring-bind (function class advice) func-class-advice
6245     (cond ((ad-advice-enabled advice)
6246            (ad-advice-set-enabled advice nil)
6247            (message "Disabled"))
6248           (t                            ;disabled
6249            (ad-advice-set-enabled advice t)
6250            (message "Enabled")))
6251     (ad-activate function)
6252     (and anything-in-persistent-action
6253          (anything-c-advice-update-current-display-string))))
6254
6255 (defun anything-c-advice-update-current-display-string ()
6256   (anything-edit-current-selection
6257     (let ((newword (cond ((looking-at "Disabled") "Enabled")
6258                          ((looking-at "Enabled")  "Disabled")))
6259           realvalue)
6260       (when newword
6261         (delete-region (point) (progn (forward-word 1) (point)))
6262         (insert newword)))))
6263
6264 \f
6265 ;;;; <Variable>
6266 ;;; Emacs variables
6267 ;;
6268 ;;
6269 (defvar anything-c-source-emacs-variables
6270   '((name . "Emacs Variables")
6271     (candidates . (lambda ()
6272                     (sort (all-completions "" obarray 'boundp) 'string-lessp)))
6273     (type . variable)
6274     (requires-pattern . 2))
6275   "Source for completing Emacs variables.")
6276
6277 \f
6278 ;;; LaCarte
6279 (defvar anything-c-source-lacarte
6280   '((name . "Lacarte")
6281     (init . (lambda () (require 'lacarte )))
6282     (candidates . (lambda () (delete '(nil) (lacarte-get-overall-menu-item-alist))))
6283     (candidate-number-limit . 9999)
6284     (action . anything-c-call-interactively))
6285   "Needs lacarte.el.
6286
6287 http://www.emacswiki.org/cgi-bin/wiki/download/lacarte.el")
6288
6289 \f
6290 ;;; Bookmarks
6291 ;;
6292 ;;
6293 ;; Bind some faces for bookmarks.
6294 (defvar anything-c-bookmarks-face1 'anything-ff-directory)
6295 (defvar anything-c-bookmarks-face2 'anything-ff-file)
6296 (defvar anything-c-bookmarks-face3 'anything-bookmarks-su-face)
6297
6298 (eval-when-compile (require 'bookmark))
6299 (defvar anything-c-source-bookmarks
6300   `((name . "Bookmarks")
6301     (init . (lambda ()
6302               (require 'bookmark)))
6303     (candidates . bookmark-all-names)
6304     (type . bookmark))
6305   "See (info \"(emacs)Bookmarks\").")
6306
6307 ;;; bookmark-set
6308 (defvar anything-c-source-bookmark-set
6309   '((name . "Set Bookmark")
6310     (dummy)
6311     (action . bookmark-set))
6312   "See (info \"(emacs)Bookmarks\").")
6313
6314 ;;; Visible Bookmarks
6315 ;; (install-elisp "http://cvs.savannah.gnu.org/viewvc/*checkout*/bm/bm/bm.el")
6316
6317
6318 ;; http://d.hatena.ne.jp/grandVin/20080911/1221114327
6319 (defvar anything-c-source-bm
6320   '((name . "Visible Bookmarks")
6321     (init . anything-c-bm-init)
6322     (candidates-in-buffer)
6323     (type . line))
6324   "Needs bm.el.
6325
6326 http://www.nongnu.org/bm/")
6327
6328 (defun anything-c-bm-init ()
6329   "Init function for `anything-c-source-bm'."
6330   (when (require 'bm nil t)
6331     (with-no-warnings
6332       (let ((bookmarks (bm-lists))
6333             (buf (anything-candidate-buffer 'global)))
6334         (dolist (bm (sort* (append (car bookmarks) (cdr bookmarks))
6335                            '< :key 'overlay-start))
6336           (let ((start (overlay-start bm))
6337                 (end (overlay-end bm))
6338                 (annotation (or (overlay-get bm 'annotation) "")))
6339             (unless (< (- end start) 1) ; org => (if (< (- end start) 2)
6340               (let ((str (format "%5d: [%s]: %s\n"
6341                                  (line-number-at-pos start)
6342                                  annotation
6343                                  (buffer-substring start (1- end)))))
6344                 (with-current-buffer buf (insert str))))))))))
6345
6346 ;;; Special bookmarks
6347 (defvar anything-c-source-bookmarks-ssh
6348   '((name . "Bookmarks-ssh")
6349     (init . (lambda ()
6350               (require 'bookmark)))
6351     (candidates . (lambda () (anything-c-collect-bookmarks :ssh t)))
6352     (type . bookmark))
6353   "See (info \"(emacs)Bookmarks\").")
6354
6355 (defvar anything-c-source-bookmarks-su
6356   '((name . "Bookmarks-root")
6357     (init . (lambda ()
6358               (require 'bookmark)))
6359     (candidates . (lambda () (anything-c-collect-bookmarks :su t)))
6360     (filtered-candidate-transformer anything-c-highlight-bookmark-su)
6361
6362     (type . bookmark))
6363   "See (info \"(emacs)Bookmarks\").")
6364
6365 (defvar anything-c-source-bookmarks-local
6366   '((name . "Bookmarks-Local")
6367     (init . (lambda ()
6368               (require 'bookmark)))
6369     (candidates . (lambda () (anything-c-collect-bookmarks :local t)))
6370     (filtered-candidate-transformer
6371      anything-c-adaptive-sort
6372      anything-c-highlight-bookmark)
6373     (type . bookmark))
6374   "See (info \"(emacs)Bookmarks\").")
6375
6376 (defun* anything-c-collect-bookmarks (&key local su sudo ssh)
6377   (let* ((lis-all (bookmark-all-names))
6378          (lis-loc (cond (local (loop for i in lis-all
6379                                      unless (string-match "^(ssh)\\|^(su)" i)
6380                                      collect i))
6381                         (su (loop for i in lis-all
6382                                   when (string-match "^(su)" i)
6383                                   collect i))
6384                         (sudo (loop for i in lis-all
6385                                     when (string-match "^(sudo)" i)
6386                                     collect i))
6387                         (ssh (loop for i in lis-all
6388                                    when (string-match "^(ssh)" i)
6389                                    collect i)))))
6390     (sort lis-loc 'string-lessp)))
6391
6392 (defun anything-c-bookmark-root-logged-p ()
6393   (catch 'break
6394     (dolist (i (mapcar #'buffer-name (buffer-list)))
6395       (when (string-match (format "*tramp/%s ." anything-su-or-sudo) i)
6396         (throw 'break t)))))
6397
6398 (defun anything-c-highlight-bookmark-su (files source)
6399   (if (anything-c-bookmark-root-logged-p)
6400       (anything-c-highlight-bookmark files source)
6401       (anything-c-highlight-not-logged files source)))
6402
6403 (defun anything-c-highlight-not-logged (files source)
6404   (loop for i in files
6405         collect (propertize i 'face anything-c-bookmarks-face3)))
6406
6407 (defun anything-c-highlight-bookmark (bookmarks source)
6408   "Used as `candidate-transformer' to colorize bookmarks.
6409 Work both with standard Emacs bookmarks and bookmark-extensions.el."
6410   (loop for i in bookmarks
6411         for isfile        = (bookmark-get-filename i)
6412         for bufp          = (and (fboundp 'bmkext-get-buffer-name)
6413                                  (bmkext-get-buffer-name i))
6414         for handlerp      = (and (fboundp 'bookmark-get-handler)
6415                                  (bookmark-get-handler i))
6416         for isw3m         = (and (fboundp 'bmkext-w3m-bookmark-p)
6417                                  (bmkext-w3m-bookmark-p i))
6418         for isgnus        = (and (fboundp 'bmkext-gnus-bookmark-p)
6419                                  (bmkext-gnus-bookmark-p i))
6420         for isman         = (and (fboundp 'bmkext-man-bookmark-p) ; Man
6421                                  (bmkext-man-bookmark-p i))
6422         for iswoman       = (and (fboundp 'bmkext-woman-bookmark-p) ; Woman
6423                                  (bmkext-woman-bookmark-p i))
6424         for handlerp      = (bookmark-get-handler i)
6425         for isannotation  = (bookmark-get-annotation i)
6426         for isabook       = (string= (bookmark-prop-get i 'type) "addressbook")
6427         for isinfo        = (eq handlerp 'Info-bookmark-jump)
6428         ;; Add a * if bookmark have annotation
6429         if (and isannotation (not (string-equal isannotation "")))
6430         do (setq i (concat "*" i))
6431         collect (cond (;; info buffers
6432                        isinfo
6433                        (propertize i 'face 'anything-bmkext-info 'help-echo isfile))
6434                       (;; w3m buffers
6435                        isw3m
6436                        (propertize i 'face 'anything-bmkext-w3m 'help-echo isfile))
6437                       (;; gnus buffers
6438                        isgnus
6439                        (propertize i 'face 'anything-bmkext-gnus 'help-echo isfile))
6440                       (;; Man Woman
6441                        (or iswoman isman)
6442                        (propertize i 'face 'anything-bmkext-man 'help-echo isfile))
6443                       (;; Addressbook
6444                        isabook
6445                        (propertize i 'face '((:foreground "Tomato"))))
6446                       (;; directories
6447                        (and isfile (file-directory-p isfile))
6448                        (propertize i 'face anything-c-bookmarks-face1 'help-echo isfile))
6449                       (;; regular files
6450                        t
6451                        (propertize i 'face 'anything-bmkext-file 'help-echo isfile)))))
6452
6453 (defun anything-c-bookmark-jump (candidate)
6454   "Jump to bookmark from keyboard."
6455   (let ((current-prefix-arg anything-current-prefix-arg))
6456     (bookmark-jump candidate)))
6457
6458 ;;;###autoload
6459 (defun anything-c-bookmark-run-jump-other-window ()
6460   "Jump to bookmark from keyboard."
6461   (interactive)
6462   (anything-c-quit-and-execute-action 'bookmark-jump-other-window))
6463
6464 ;;;###autoload
6465 (defun anything-c-bookmark-run-delete ()
6466   "Delete bookmark from keyboard."
6467   (interactive)
6468   (when (y-or-n-p "Delete bookmark?")
6469     (anything-c-quit-and-execute-action 'anything-delete-marked-bookmarks)))
6470
6471 \f
6472 ;;; Sources to filter bookmark-extensions bookmarks.
6473 ;;
6474 ;;
6475 ;; Dependency: http://mercurial.intuxication.org/hg/emacs-bookmark-extension
6476 ;; If you want to enable google-maps in addressbook you will need
6477 ;; Julien Danjou google-maps-el package available here:
6478 ;; http://julien.danjou.info/google-maps-el.html
6479
6480 (defun anything-c-bmkext-filter-setup-alist (fn &rest args)
6481   "Return a filtered `bookmark-alist' sorted alphabetically."
6482   (loop
6483         with alist = (if args
6484                          (apply #'(lambda (x) (funcall fn x)) args)
6485                          (funcall fn))
6486         for i in alist
6487         for b = (car i)
6488         collect b into sa
6489         finally return (sort sa 'string-lessp)))
6490
6491 ;;;###autoload
6492 (defun anything-c-bmkext-run-edit ()
6493   "Run `bmkext-edit-bookmark' from keyboard."
6494   (interactive)
6495   (anything-c-quit-and-execute-action 'bmkext-edit-bookmark))
6496
6497 ;;; Addressbook.
6498 ;;
6499 ;;
6500 (defvar anything-c-source-bmkext-addressbook
6501   '((name . "Bookmark Addressbook")
6502     (init . (lambda ()
6503               (require 'bookmark-extensions)
6504               (bookmark-maybe-load-default-file)))
6505     (candidates . anything-c-bmkext-addressbook-setup-alist)
6506     (persistent-action
6507      . (lambda (candidate)
6508          (let ((bmk (anything-bookmark-get-bookmark-from-name
6509                      candidate)))
6510            (bookmark--jump-via bmk 'pop-to-buffer))))
6511     (persistent-help . "Show contact - Prefix with C-u to append")
6512     (filtered-candidate-transformer
6513      anything-c-adaptive-sort
6514      anything-c-highlight-bookmark)
6515     (action . (("Show Contact(s)"
6516                 . (lambda (candidate)
6517                     (let* ((contacts (anything-marked-candidates))
6518                            (current-prefix-arg (or anything-current-prefix-arg
6519                                                    (> (length contacts) 1))))
6520                       (bookmark-jump
6521                        (anything-bookmark-get-bookmark-from-name (car contacts)))
6522                       (anything-aif (cdr contacts)
6523                           (loop for bmk in it do
6524                                 (bookmark-jump
6525                                  (anything-bookmark-get-bookmark-from-name bmk)))))))
6526                ("Send Mail"
6527                 . (lambda (candidate)
6528                     (let* ((contacts (anything-marked-candidates))
6529                            (bmk      (anything-bookmark-get-bookmark-from-name
6530                                       (car contacts)))
6531                            (append   (message-buffers)))
6532                       (if append
6533                           (addressbook-set-mail-buffer1 bmk 'append)
6534                           (addressbook-set-mail-buffer1 bmk))
6535                       (setq contacts (cdr contacts))
6536                       (when contacts
6537                         (loop for bmk in contacts do
6538                               (addressbook-set-mail-buffer1 bmk 'append))))))
6539                ("Edit Bookmark"
6540                 . (lambda (candidate)
6541                     (let ((bmk (anything-bookmark-get-bookmark-from-name
6542                                 candidate)))
6543                       (addressbook-bookmark-edit
6544                        (assoc bmk bookmark-alist)))))
6545                ("Insert Email at point"
6546                 . (lambda (candidate)
6547                     (let* ((bmk   (anything-bookmark-get-bookmark-from-name
6548                                    candidate))
6549                            (mlist (split-string
6550                                    (assoc-default
6551                                     'email (assoc bmk bookmark-alist))
6552                                    ", ")))
6553                       (insert
6554                        (if (> (length mlist) 1)
6555                            (anything-comp-read
6556                             "Insert Mail Address: " mlist :must-match t)
6557                            (car mlist))))))
6558                ("Show annotation"
6559                 . (lambda (candidate)
6560                     (let ((bmk (anything-bookmark-get-bookmark-from-name
6561                                 candidate)))
6562                       (bookmark-show-annotation bmk))))
6563                ("Edit annotation"
6564                 . (lambda (candidate)
6565                     (let ((bmk (anything-bookmark-get-bookmark-from-name
6566                                 candidate)))
6567                       (bookmark-edit-annotation bmk))))
6568                ("Show Google map"
6569                 . (lambda (candidate)
6570                     (let* ((bmk (anything-bookmark-get-bookmark-from-name
6571                                  candidate))
6572                            (full-bmk (assoc bmk bookmark-alist)))
6573                       (addressbook-google-map full-bmk))))))))
6574
6575
6576 (defun anything-c-bmkext-addressbook-setup-alist ()
6577   "Specialized filter function for bookmarks w3m."
6578   (anything-c-bmkext-filter-setup-alist 'bmkext-addressbook-alist-only))
6579
6580 ;; W3m bookmarks from bookmark-extensions.
6581 (defvar anything-c-source-bookmark-w3m
6582   '((name . "Bookmark W3m")
6583     (init . (lambda ()
6584               (require 'bookmark-extensions)
6585               (bookmark-maybe-load-default-file)))
6586     (candidates . anything-c-bookmark-w3m-setup-alist)
6587     (filtered-candidate-transformer
6588      anything-c-adaptive-sort
6589      anything-c-highlight-bookmark)
6590     (type . bookmark)))
6591
6592 (defun anything-c-bookmark-w3m-setup-alist ()
6593   "Specialized filter function for bookmarks w3m."
6594   (anything-c-bmkext-filter-setup-alist 'bmkext-w3m-alist-only))
6595
6596 ;; Images
6597 (defvar anything-c-source-bookmark-images
6598   '((name . "Bookmark Images")
6599     (init . (lambda ()
6600               (require 'bookmark-extensions)
6601               (bookmark-maybe-load-default-file)))
6602     (candidates . anything-c-bookmark-images-setup-alist)
6603     (filtered-candidate-transformer
6604      anything-c-adaptive-sort
6605      anything-c-highlight-bookmark)
6606     (type . bookmark)))
6607
6608 (defun anything-c-bookmark-images-setup-alist ()
6609   "Specialized filter function for images bookmarks."
6610   (anything-c-bmkext-filter-setup-alist 'bmkext-image-file-alist-only))
6611
6612 ;; Woman Man
6613 (defvar anything-c-source-bookmark-man
6614   '((name . "Bookmark Woman&Man")
6615     (init . (lambda ()
6616               (require 'bookmark-extensions)
6617               (bookmark-maybe-load-default-file)))
6618     (candidates . anything-c-bookmark-man-setup-alist)
6619     (filtered-candidate-transformer
6620      anything-c-adaptive-sort
6621      anything-c-highlight-bookmark)
6622     (type . bookmark)))
6623
6624 (defun anything-c-bookmark-man-setup-alist ()
6625   "Specialized filter function for bookmarks w3m."
6626   (append (anything-c-bmkext-filter-setup-alist 'bmkext-man-alist-only)
6627           (anything-c-bmkext-filter-setup-alist 'bmkext-woman-alist-only)))
6628
6629 ;; Gnus
6630 (defvar anything-c-source-bookmark-gnus
6631   '((name . "Bookmark Gnus")
6632     (init . (lambda ()
6633               (require 'bookmark-extensions)
6634               (bookmark-maybe-load-default-file)))
6635     (candidates . anything-c-bookmark-gnus-setup-alist)
6636     (filtered-candidate-transformer
6637      anything-c-adaptive-sort
6638      anything-c-highlight-bookmark)
6639     (type . bookmark)))
6640
6641 (defun anything-c-bookmark-gnus-setup-alist ()
6642   "Specialized filter function for bookmarks gnus."
6643   (anything-c-bmkext-filter-setup-alist 'bmkext-gnus-alist-only))
6644
6645 ;; Info
6646 (defvar anything-c-source-bookmark-info
6647   '((name . "Bookmark Info")
6648     (init . (lambda ()
6649               (require 'bookmark-extensions)
6650               (bookmark-maybe-load-default-file)))
6651     (candidates . anything-c-bookmark-info-setup-alist)
6652     (filtered-candidate-transformer
6653      anything-c-adaptive-sort
6654      anything-c-highlight-bookmark)
6655     (type . bookmark)))
6656
6657 (defun anything-c-bookmark-info-setup-alist ()
6658   "Specialized filter function for bookmarks info."
6659   (anything-c-bmkext-filter-setup-alist 'bmkext-info-alist-only))
6660
6661 ;; Local Files&directories
6662 (defvar anything-c-source-bookmark-files&dirs
6663   '((name . "Bookmark Files&Directories")
6664     (init . (lambda ()
6665               (require 'bookmark-extensions)
6666               (bookmark-maybe-load-default-file)))
6667     (candidates . anything-c-bookmark-local-files-setup-alist)
6668     (filtered-candidate-transformer
6669      anything-c-adaptive-sort
6670      anything-c-highlight-bookmark)
6671     (type . bookmark)))
6672
6673 (defun anything-c-bookmark-local-files-setup-alist ()
6674   "Specialized filter function for bookmarks locals files."
6675   (anything-c-bmkext-filter-setup-alist 'bmkext-local-file-alist-only))
6676
6677 ;; Su Files&directories
6678 (defvar anything-c-source-bookmark-su-files&dirs
6679   '((name . "Bookmark Root-Files&Directories")
6680     (init . (lambda ()
6681               (require 'bookmark-extensions)
6682               (bookmark-maybe-load-default-file)))
6683     (candidates . anything-c-bookmark-su-files-setup-alist)
6684     (filtered-candidate-transformer
6685      anything-c-adaptive-sort
6686      anything-c-highlight-bookmark-su)
6687     (type . bookmark)))
6688
6689 (defun anything-c-bookmark-su-files-setup-alist ()
6690   "Specialized filter function for bookmarks su/sudo files."
6691   (declare (special bmkext-su-or-sudo-regexp))
6692   (loop
6693         with l = (anything-c-bmkext-filter-setup-alist 'bmkext-remote-file-alist-only)
6694         for i in l
6695         for isfile = (bookmark-get-filename i)
6696         for istramp = (and isfile (boundp 'tramp-file-name-regexp)
6697                            (save-match-data
6698                              (string-match tramp-file-name-regexp isfile)))
6699         for issu = (and istramp
6700                         (string-match bmkext-su-or-sudo-regexp isfile))
6701         if issu
6702         collect i))
6703
6704 ;; Ssh Files&directories
6705 (defvar anything-c-source-bookmark-ssh-files&dirs
6706   '((name . "Bookmark Ssh-Files&Directories")
6707     (init . (lambda ()
6708               (require 'bookmark-extensions)
6709               (bookmark-maybe-load-default-file)))
6710     (candidates . anything-c-bookmark-ssh-files-setup-alist)
6711     (filtered-candidate-transformer . anything-c-adaptive-sort)
6712     (type . bookmark)))
6713
6714 (defun anything-c-bookmark-ssh-files-setup-alist ()
6715   "Specialized filter function for bookmarks ssh files."
6716   (loop
6717         with l = (anything-c-bmkext-filter-setup-alist 'bmkext-remote-file-alist-only)
6718         for i in l
6719         for isfile = (bookmark-get-filename i)
6720         for istramp = (and isfile (boundp 'tramp-file-name-regexp)
6721                            (save-match-data
6722                              (string-match tramp-file-name-regexp isfile)))
6723         for isssh = (and istramp
6724                          (string-match "/ssh:" isfile))
6725         if isssh
6726         collect i))
6727
6728
6729 \f
6730 ;;; Firefox bookmarks
6731 ;;
6732 ;;
6733 ;; You will have to set firefox to import bookmarks in his html file bookmarks.html.
6734 ;; (only for firefox versions >=3)
6735 ;; To achieve that, open about:config in firefox and double click on this line to enable value
6736 ;; to true:
6737 ;; user_pref("browser.bookmarks.autoExportHTML", false);
6738 ;; You should have now:
6739 ;; user_pref("browser.bookmarks.autoExportHTML", true);
6740 ;; NOTE: This is also working in the same way for mozilla aka seamonkey.
6741
6742 (defvar anything-firefox-bookmark-url-regexp "\\(https\\|http\\|ftp\\|about\\|file\\)://[^ \"]*")
6743 (defvar anything-firefox-bookmarks-regexp ">\\([^><]+.[^</a>]\\)")
6744
6745 (defun anything-get-firefox-user-init-dir ()
6746   "Guess the default Firefox user directory name."
6747   (let* ((moz-dir (concat (getenv "HOME") "/.mozilla/firefox/"))
6748          (moz-user-dir
6749           (with-current-buffer (find-file-noselect (concat moz-dir "profiles.ini"))
6750             (goto-char (point-min))
6751             (prog1
6752                 (when (search-forward "Path=" nil t)
6753                   (buffer-substring-no-properties (point) (point-at-eol)))
6754               (kill-buffer)))))
6755     (file-name-as-directory (concat moz-dir moz-user-dir))))
6756
6757 (defun anything-guess-firefox-bookmark-file ()
6758   "Return the path of the Firefox bookmarks file."
6759   (concat (anything-get-firefox-user-init-dir) "bookmarks.html"))
6760
6761 (defun anything-html-bookmarks-to-alist (file url-regexp bmk-regexp)
6762   "Parse html bookmark FILE and return an alist with (title . url) as elements."
6763   (let (bookmarks-alist url title)
6764     (with-temp-buffer
6765       (insert-file-contents file)
6766       (goto-char (point-min))
6767       (while (re-search-forward "href=\\|^ *<DT><A HREF=" nil t)
6768         (forward-line 0)
6769         (when (re-search-forward url-regexp nil t)
6770           (setq url (match-string 0)))
6771         (when (re-search-forward bmk-regexp nil t)
6772           (setq title (match-string 1)))
6773         (push (cons title url) bookmarks-alist)
6774         (forward-line)))
6775     (nreverse bookmarks-alist)))
6776
6777 (defvar anything-c-firefox-bookmarks-alist nil)
6778 (defvar anything-c-source-firefox-bookmarks
6779   '((name . "Firefox Bookmarks")
6780     (init . (lambda ()
6781               (setq anything-c-firefox-bookmarks-alist
6782                     (anything-html-bookmarks-to-alist
6783                      (anything-guess-firefox-bookmark-file)
6784                      anything-firefox-bookmark-url-regexp
6785                      anything-firefox-bookmarks-regexp))))
6786     (candidates . (lambda ()
6787                     (mapcar #'car anything-c-firefox-bookmarks-alist)))
6788     (filtered-candidate-transformer
6789      anything-c-adaptive-sort
6790      anything-c-highlight-firefox-bookmarks)
6791     (action . (("Browse Url"
6792                 . (lambda (candidate)
6793                     (anything-c-browse-url
6794                      (anything-c-firefox-bookmarks-get-value candidate))))
6795                ("Copy Url"
6796                 . (lambda (elm)
6797                     (kill-new (anything-c-w3m-bookmarks-get-value elm))))))))
6798
6799
6800 (defun anything-c-firefox-bookmarks-get-value (elm)
6801   (assoc-default elm anything-c-firefox-bookmarks-alist))
6802
6803 (defun anything-c-highlight-firefox-bookmarks (bookmarks source)
6804   (loop for i in bookmarks
6805         collect (propertize
6806                  i 'face '((:foreground "YellowGreen"))
6807                  'help-echo (anything-c-firefox-bookmarks-get-value i))))
6808
6809
6810 \f
6811 ;;; W3m bookmark - anything interface.
6812 ;;
6813 ;;
6814 ;; Some users have the emacs-w3m library in load-path
6815 ;; without having the w3m executable :-;
6816 ;; So check if w3m program is present before trying to load
6817 ;; emacs-w3m.
6818 (eval-when-compile
6819   (when (executable-find "w3m")
6820     (require 'w3m-bookmark nil t)))
6821
6822 (defvar w3m-bookmark-file "~/.w3m/bookmark.html")
6823 (defvar anything-w3m-bookmarks-regexp ">\\([^><]+.[^</a>]\\)")
6824 (defvar anything-w3m-bookmark-url-regexp "\\(https\\|http\\|ftp\\|file\\)://[^>]*")
6825 (defvar anything-c-w3m-bookmarks-alist nil)
6826 (defvar anything-c-source-w3m-bookmarks
6827   '((name . "W3m Bookmarks")
6828     (init . (lambda ()
6829               (setq anything-c-w3m-bookmarks-alist
6830                     (anything-html-bookmarks-to-alist
6831                      w3m-bookmark-file
6832                      anything-w3m-bookmark-url-regexp
6833                      anything-w3m-bookmarks-regexp))))
6834     (candidates . (lambda ()
6835                     (mapcar #'car anything-c-w3m-bookmarks-alist)))
6836     (filtered-candidate-transformer
6837      anything-c-adaptive-sort
6838      anything-c-highlight-w3m-bookmarks)
6839     (action . (("Browse Url"
6840                 . (lambda (candidate)
6841                     (anything-c-w3m-browse-bookmark candidate)))
6842                ("Copy Url"
6843                 . (lambda (elm)
6844                     (kill-new (anything-c-w3m-bookmarks-get-value elm))))
6845                ("Browse Url Externally"
6846                 . (lambda (candidate)
6847                     (anything-c-w3m-browse-bookmark candidate t)))
6848                ("Delete Bookmark"
6849                 . (lambda (candidate)
6850                     (anything-c-w3m-delete-bookmark candidate)))
6851                ("Rename Bookmark"
6852                 . (lambda (candidate)
6853                     (anything-c-w3m-rename-bookmark candidate)))))
6854     (persistent-action . (lambda (candidate)
6855                            (if current-prefix-arg
6856                                (anything-c-w3m-browse-bookmark candidate t)
6857                                (anything-c-w3m-browse-bookmark candidate nil t))))
6858     (persistent-help . "Open URL with emacs-w3m in new tab / \
6859 C-u \\[anything-execute-persistent-action]: Open URL with Firefox"))
6860   "Needs w3m and emacs-w3m.
6861
6862 w3m: http://w3m.sourceforge.net/
6863 emacs-w3m: http://emacs-w3m.namazu.org/")
6864
6865
6866 (defun anything-c-w3m-bookmarks-get-value (elm)
6867   (replace-regexp-in-string
6868    "\"" "" (cdr (assoc elm anything-c-w3m-bookmarks-alist))))
6869
6870 (defun anything-c-w3m-browse-bookmark (elm &optional use-external new-tab)
6871   (let* ((fn  (if use-external 'anything-c-browse-url 'w3m-browse-url))
6872          (arg (and (eq fn 'w3m-browse-url) new-tab)))
6873     (funcall fn (anything-c-w3m-bookmarks-get-value elm) arg)))
6874
6875 (defun anything-c-highlight-w3m-bookmarks (bookmarks source)
6876   (loop for i in bookmarks
6877         collect (propertize
6878                  i 'face 'anything-w3m-bookmarks-face
6879                  'help-echo (anything-c-w3m-bookmarks-get-value i))))
6880
6881
6882 (defun anything-c-w3m-delete-bookmark (elm)
6883   "Delete w3m bookmark from `w3m-bookmark-file'."
6884   (with-current-buffer
6885       (find-file-literally w3m-bookmark-file)
6886     (goto-char (point-min))
6887     (when (re-search-forward elm nil t)
6888       (beginning-of-line)
6889       (delete-region (point)
6890                      (line-end-position))
6891       (delete-blank-lines))
6892     (save-buffer)
6893     (kill-buffer)))
6894
6895 (defun anything-c-w3m-rename-bookmark (elm)
6896   "Rename w3m bookmark in `w3m-bookmark-file'."
6897   (let* ((old-title (replace-regexp-in-string ">" "" elm))
6898          (new-title (read-string "NewTitle: " old-title)))
6899     (with-current-buffer
6900         (find-file-literally w3m-bookmark-file)
6901       (goto-char (point-min))
6902       (when (re-search-forward (concat elm "<") nil t)
6903         (goto-char (1- (point)))
6904         (delete-char (- (length old-title)))
6905         (insert new-title))
6906       (save-buffer)
6907       (kill-buffer))))
6908
6909 \f
6910 ;;;; <Library>
6911 ;;; Elisp library scan
6912 ;;
6913 ;;
6914 (defvar anything-c-source-elisp-library-scan
6915   '((name . "Elisp libraries (Scan)")
6916     (init . (anything-c-elisp-library-scan-init))
6917     (candidates-in-buffer)
6918     (action ("Find library"
6919              . (lambda (candidate) (find-file (find-library-name candidate))))
6920      ("Find library other window"
6921       . (lambda (candidate)
6922           (find-file-other-window (find-library-name candidate))))
6923      ("Load library"
6924       . (lambda (candidate) (load-library candidate))))))
6925
6926 (defun anything-c-elisp-library-scan-init ()
6927   "Init anything buffer status."
6928   (let ((anything-buffer (anything-candidate-buffer 'global))
6929         (library-list (anything-c-elisp-library-scan-list)))
6930     (with-current-buffer anything-buffer
6931       (dolist (library library-list)
6932         (insert (format "%s\n" library))))))
6933
6934 (defun anything-c-elisp-library-scan-list (&optional dirs string)
6935   "Do completion for file names passed to `locate-file'.
6936 DIRS is directory to search path.
6937 STRING is string to match."
6938   ;; Use `load-path' as path when ignore `dirs'.
6939   (or dirs (setq dirs load-path))
6940   ;; Init with blank when ignore `string'.
6941   (or string (setq string ""))
6942   ;; Get library list.
6943   (let ((string-dir (file-name-directory string))
6944         ;; File regexp that suffix match `load-file-rep-suffixes'.
6945         (match-regexp (format "^.*\\.el%s$" (regexp-opt load-file-rep-suffixes)))
6946         name
6947         names)
6948     (dolist (dir dirs)
6949       (unless dir
6950         (setq dir default-directory))
6951       (if string-dir
6952           (setq dir (expand-file-name string-dir dir)))
6953       (when (file-directory-p dir)
6954         (dolist (file (file-name-all-completions
6955                        (file-name-nondirectory string) dir))
6956           ;; Suffixes match `load-file-rep-suffixes'.
6957           (setq name (if string-dir (concat string-dir file) file))
6958           (if (string-match match-regexp name)
6959               (add-to-list 'names name)))))
6960     names))
6961
6962 \f
6963 ;;;; <Programming>
6964 ;;
6965 ;;
6966
6967 ;;; Imenu
6968 ;;
6969 ;;
6970 (defvar anything-c-imenu-delimiter " / ")
6971
6972 (defvar anything-c-imenu-index-filter nil)
6973 (make-variable-buffer-local 'anything-c-imenu-index-filter)
6974
6975 (defvar anything-c-cached-imenu-alist nil)
6976 (make-variable-buffer-local 'anything-c-cached-imenu-alist)
6977
6978 (defvar anything-c-cached-imenu-candidates nil)
6979 (make-variable-buffer-local 'anything-c-cached-imenu-candidates)
6980
6981 (defvar anything-c-cached-imenu-tick nil)
6982 (make-variable-buffer-local 'anything-c-cached-imenu-tick)
6983
6984 (eval-when-compile (require 'imenu))
6985 (setq imenu-auto-rescan t)
6986
6987 (defun anything-imenu-create-candidates (entry)
6988   "Create candidates with ENTRY."
6989   (if (listp (cdr entry))
6990       (mapcan
6991        (lambda (sub)
6992          (if (consp (cdr sub))
6993              (mapcar
6994               (lambda (subentry)
6995                 (concat (car entry) anything-c-imenu-delimiter subentry))
6996               (anything-imenu-create-candidates sub))
6997              (list (concat (car entry) anything-c-imenu-delimiter (car sub)))))
6998        (cdr entry))
6999       (list entry)))
7000
7001 (defvar anything-c-source-imenu
7002   '((name . "Imenu")
7003     (init . (lambda () (require 'imenu)))
7004     (candidates . anything-c-imenu-candidates)
7005     (persistent-action . (lambda (elm)
7006                            (anything-c-imenu-default-action elm)
7007                            (unless (fboundp 'semantic-imenu-tag-overlay)
7008                              (anything-match-line-color-current-line))))
7009     (persistent-help . "Show this entry")
7010     (action . anything-c-imenu-default-action))
7011   "See (info \"(emacs)Imenu\")")
7012
7013
7014 (defun anything-c-imenu-candidates ()
7015   (with-anything-current-buffer
7016     (let ((tick (buffer-modified-tick)))
7017       (if (eq anything-c-cached-imenu-tick tick)
7018           anything-c-cached-imenu-candidates
7019           (setq imenu--index-alist nil)
7020           (setq anything-c-cached-imenu-tick tick
7021                 anything-c-cached-imenu-candidates
7022                 (ignore-errors
7023                   (mapcan
7024                    'anything-imenu-create-candidates
7025                    (setq anything-c-cached-imenu-alist
7026                          (let ((index (imenu--make-index-alist)))
7027                            (if anything-c-imenu-index-filter
7028                                (funcall anything-c-imenu-index-filter index)
7029                                index))))))
7030           (setq anything-c-cached-imenu-candidates
7031                 (mapcar #'(lambda (x)
7032                             (if (stringp x)
7033                                 x
7034                                 (car x)))
7035                         anything-c-cached-imenu-candidates))))))
7036
7037 (setq imenu-default-goto-function 'imenu-default-goto-function)
7038 (defun anything-c-imenu-default-action (elm)
7039   "The default action for `anything-c-source-imenu'."
7040   (let ((path (split-string elm anything-c-imenu-delimiter))
7041         (alist anything-c-cached-imenu-alist))
7042     (dolist (elm path)
7043       (setq alist (assoc elm alist)))
7044     (imenu alist)))
7045
7046
7047 \f
7048 ;;; Ctags
7049 ;;
7050 ;;
7051 (defvar anything-c-ctags-modes
7052   '( c-mode c++-mode awk-mode csharp-mode java-mode javascript-mode lua-mode
7053     makefile-mode pascal-mode perl-mode cperl-mode php-mode python-mode
7054     scheme-mode sh-mode slang-mode sql-mode tcl-mode ))
7055
7056 (defun anything-c-source-ctags-init ()
7057   (when (and buffer-file-name
7058              (memq major-mode anything-c-ctags-modes)
7059              (anything-current-buffer-is-modified))
7060     (with-current-buffer (anything-candidate-buffer 'local)
7061       (call-process-shell-command
7062        (if (string-match "\\.el\\.gz$" anything-buffer-file-name)
7063            (format "ctags -e -u -f- --language-force=lisp --fields=n =(zcat %s) "
7064                    anything-buffer-file-name)
7065            (format "ctags -e -u -f- --fields=n %s " anything-buffer-file-name))
7066        nil (current-buffer))
7067       (goto-char (point-min))
7068       (forward-line 2)
7069       (delete-region (point-min) (point))
7070       (loop while (and (not (eobp)) (search-forward "\001" (point-at-eol) t))
7071             for lineno-start = (point)
7072             for lineno = (buffer-substring
7073                           lineno-start
7074                           (1- (search-forward "," (point-at-eol) t)))
7075             do
7076             (beginning-of-line)
7077             (insert (format "%5s:" lineno))
7078             (search-forward "\177" (point-at-eol) t)
7079             (delete-region (1- (point)) (point-at-eol))
7080             (forward-line 1)))))
7081
7082 (defvar anything-c-source-ctags
7083   '((name . "Exuberant ctags")
7084     (init . anything-c-source-ctags-init)
7085     (candidates-in-buffer)
7086     (adjust)
7087     (type . line))
7088   "Needs Exuberant Ctags.
7089
7090 http://ctags.sourceforge.net/")
7091
7092 \f
7093 ;;; Etags
7094 ;;
7095 ;;
7096 ;; anything-etags.el is deprecated, if this file is found,
7097 ;; warn user at compile time.
7098 (eval-when-compile
7099   (when (locate-library "anything-etags.el")
7100     (display-warning
7101      '(anything-config)
7102      "You are using obsolete library `anything-etags.el' and should remove it."
7103      :warning)))
7104
7105 (defvar anything-c-etags-tag-file-dir nil
7106   "Etags file directory.")
7107 (defvar anything-c-etags-mtime-alist nil
7108   "Store the last modification time of etags files here.")
7109 (defvar anything-c-etags-cache (make-hash-table :test 'equal)
7110   "Cache content of etags files used here for faster access.")
7111
7112 (defun anything-c-etags-get-tag-file (&optional directory)
7113   "Return the path of etags file if found."
7114   ;; Get tag file from `default-directory' or upper directory.
7115   (let ((current-dir (anything-c-etags-find-tag-file-directory
7116                       (or directory default-directory))))
7117     ;; Return nil if not find tag file.
7118     (when current-dir
7119       ;; Set tag file directory.
7120       (setq anything-c-etags-tag-file-dir current-dir)
7121       (expand-file-name anything-c-etags-tag-file-name current-dir))))
7122
7123 (defun anything-c-etags-find-tag-file-directory (current-dir)
7124   "Try to find the directory containing tag file.
7125 If not found in CURRENT-DIR search in upper directory."
7126   (flet ((file-exists? (dir)
7127            (let ((tag-path (expand-file-name
7128                             anything-c-etags-tag-file-name dir)))
7129              (and (stringp tag-path)
7130                   (file-regular-p tag-path)
7131                   (file-readable-p tag-path)))))
7132     (loop with count = 0
7133           until (file-exists? current-dir)
7134           ;; Return nil if outside the value of
7135           ;; `anything-c-etags-tag-file-search-limit'.
7136           if (= count anything-c-etags-tag-file-search-limit)
7137           do (return nil)
7138           ;; Or search upper directories.
7139           else
7140           do (incf count)
7141           (setq current-dir (expand-file-name (concat current-dir "../")))
7142           finally return current-dir)))
7143
7144 (defun anything-c-source-etags-header-name (x)
7145   "Create header name for this anything etags session."
7146   (concat "Etags in "
7147           (with-anything-current-buffer
7148             (anything-c-etags-get-tag-file))))
7149
7150 (defmacro anything-c-etags-create-buffer (file)
7151   "Create the `anything-buffer' based on contents of etags tag FILE."
7152   `(let* ((tag-fname ,file)
7153           max
7154           (split (with-current-buffer (find-file-noselect tag-fname)
7155                    (prog1
7156                        (split-string (buffer-string) "\n" 'omit-nulls)
7157                      (setq max (line-number-at-pos (point-max)))
7158                      (kill-buffer))))
7159           (progress-reporter (make-progress-reporter "Loading tag file..." 0 max)))
7160      (loop
7161            with fname
7162            with cand
7163            for i in split for count from 0
7164            for elm = (unless (string-match "^\x0c" i)
7165                        (anything-aif (string-match "\177" i)
7166                            (substring i 0 it)
7167                          i))
7168            do (cond ((and elm (string-match "^\\(.+\\),[0-9]+" elm))
7169                      (setq fname (match-string 1 elm)))
7170                     (elm (setq cand (concat fname ": " elm)))
7171                     (t (setq cand nil)))
7172            when cand do (progn
7173                           (insert (concat cand "\n"))
7174                           (progress-reporter-update progress-reporter count)))))
7175
7176 (defun anything-c-etags-init ()
7177   "Feed `anything-buffer' using `anything-c-etags-cache' or tag file.
7178 If no entry in cache, create one."
7179   (let ((tagfile (anything-c-etags-get-tag-file)))
7180     (when tagfile
7181       (with-current-buffer (anything-candidate-buffer 'global)
7182         (anything-aif (gethash tagfile anything-c-etags-cache)
7183             ;; An entry is present in cache, insert it.
7184             (insert it)
7185           ;; No entry, create a new buffer using content of tag file (slower).
7186           (anything-c-etags-create-buffer tagfile)
7187           ;; Store content of buffer in cache.
7188           (puthash tagfile (buffer-string) anything-c-etags-cache)
7189           ;; Store or set the last modification of tag file.
7190           (anything-aif (assoc tagfile anything-c-etags-mtime-alist)
7191               ;; If an entry exists modify it.
7192               (setcdr it (anything-c-etags-mtime tagfile))
7193             ;; No entry create a new one.
7194             (add-to-list 'anything-c-etags-mtime-alist
7195                          (cons tagfile (anything-c-etags-mtime tagfile)))))))))
7196
7197 (defvar anything-c-source-etags-select
7198   '((name . "Etags")
7199     (header-name . anything-c-source-etags-header-name)
7200     (init . anything-c-etags-init)
7201     (candidates-in-buffer)
7202     (search . (anything-c-etags-search-fn))
7203     (mode-line . anything-etags-mode-line-string)
7204     (action . anything-c-etags-default-action)
7205     (persistent-action . (lambda (candidate)
7206                            (anything-c-etags-default-action candidate)
7207                            (anything-match-line-color-current-line))))
7208   "Anything source for Etags.")
7209
7210 (defun anything-c-etags-search-fn (pattern)
7211   "Search function for `anything-c-source-etags-select'."
7212   (re-search-forward
7213    (if anything-c-etags-use-regexp-search
7214        (format anything-c-etags-search-regexp pattern)
7215        pattern)
7216    nil t))
7217
7218 (defun anything-c-etags-default-action (candidate)
7219   "Anything default action to jump to an etags entry."
7220   (let* ((split (split-string candidate ": "))
7221          (fname (expand-file-name
7222                  (car split) anything-c-etags-tag-file-dir))
7223          (elm   (cadr split)))
7224     (find-file fname)
7225     (goto-char (point-min))
7226     (search-forward elm nil t)
7227     (goto-char (match-beginning 0))))
7228
7229 (defun anything-c-etags-mtime (file)
7230   "Last modification time of etags tag FILE."
7231   (cadr (nth 5 (file-attributes file))))
7232
7233 (defun anything-c-etags-file-modified-p (file)
7234   "Check if tag FILE have been modified in this session.
7235 If FILE is nil return nil."
7236   (let ((last-modif (and file
7237                          (assoc-default file anything-c-etags-mtime-alist))))
7238     (and last-modif
7239          (/= last-modif (anything-c-etags-mtime file)))))
7240
7241
7242 \f
7243 ;;; Semantic
7244 ;;
7245 ;;
7246 (defvar anything-semantic-candidates nil)
7247
7248 (defun anything-semantic-construct-candidates (tags depth)
7249   (when (require 'semantic nil t)
7250     (apply
7251      'append
7252      (mapcar
7253       (lambda (tag)
7254         (if (listp tag)
7255             (let ((type (semantic-tag-type tag))
7256                   (class (semantic-tag-class tag)))
7257               (if (or (and (stringp type)
7258                            (or (string= type "class")
7259                                (string= type "namespace")))
7260                       (eq class 'function)
7261                       (eq class 'variable))
7262                   (cons (cons (concat (make-string (* depth 2) ?\s)
7263                                       (semantic-format-tag-summarize tag nil t))
7264                               tag)
7265                         (anything-semantic-construct-candidates
7266                          (semantic-tag-components tag) (1+ depth)))))))
7267       tags))))
7268
7269 (defun anything-semantic-default-action (candidate)
7270   (let ((tag (cdr (assoc candidate anything-semantic-candidates))))
7271     (semantic-go-to-tag tag)))
7272
7273 (defvar anything-c-source-semantic
7274   '((name . "Semantic Tags")
7275     (init . (lambda ()
7276               (setq anything-semantic-candidates
7277                     (ignore-errors (anything-semantic-construct-candidates
7278                                     (semantic-fetch-tags) 0)))))
7279     (candidates . (lambda ()
7280                     (if anything-semantic-candidates
7281                         (mapcar 'car anything-semantic-candidates))))
7282     (persistent-action . (lambda (elm)
7283                            (anything-semantic-default-action elm)
7284                            (anything-match-line-color-current-line)))
7285     (persistent-help . "Show this entry")
7286     (action . anything-semantic-default-action)
7287     "Needs semantic in CEDET.
7288
7289 semantic: http://cedet.sourceforge.net/semantic.shtml
7290 CEDET: http://cedet.sourceforge.net/"))
7291
7292
7293 \f
7294 ;;; Anything interface of `simple-call-tree.el'.
7295 ;;
7296 ;; <http://www.emacswiki.org/cgi-bin/wiki/download/simple-call-tree.el>
7297 ;;
7298 ;; Function is called by
7299 (defvar anything-c-source-simple-call-tree-functions-callers
7300   '((name . "Function is called by")
7301     (init . anything-c-simple-call-tree-functions-callers-init)
7302     (multiline)
7303     (candidates . anything-c-simple-call-tree-candidates)
7304     (persistent-action . anything-c-simple-call-tree-persistent-action)
7305     (persistent-help . "Show function definitions by rotation")
7306     (action ("Find definition selected by persistent-action" .
7307              anything-c-simple-call-tree-find-definition)))
7308   "Needs simple-call-tree.el.
7309 http://www.emacswiki.org/cgi-bin/wiki/download/simple-call-tree.el")
7310
7311 (defvar anything-c-simple-call-tree-tick nil)
7312 (make-variable-buffer-local 'anything-c-simple-call-tree-tick)
7313 (defun anything-c-simple-call-tree-analyze-maybe ()
7314   (unless (eq (buffer-chars-modified-tick) anything-c-simple-call-tree-tick)
7315     (simple-call-tree-analyze)
7316     (setq anything-c-simple-call-tree-tick (buffer-chars-modified-tick))))
7317
7318 (defun anything-c-simple-call-tree-init-base (function message)
7319   (require 'simple-call-tree)
7320   (with-no-warnings
7321     (when (anything-current-buffer-is-modified)
7322       (anything-c-simple-call-tree-analyze-maybe)
7323       (let ((list (funcall function simple-call-tree-alist)))
7324         (with-current-buffer (anything-candidate-buffer 'local)
7325           (dolist (entry list)
7326             (let ((funcs (concat "  " (mapconcat #'identity (cdr entry) "\n  "))))
7327               (insert (car entry) message
7328                       (if (string= funcs "  ")
7329                           "  no functions."
7330                           funcs)
7331                       "\n\n"))))))))
7332
7333 (defun anything-c-simple-call-tree-functions-callers-init ()
7334   (anything-c-simple-call-tree-init-base 'simple-call-tree-invert
7335                                          " is called by\n"))
7336
7337 (defun anything-c-simple-call-tree-candidates ()
7338   (with-current-buffer (anything-candidate-buffer)
7339     (split-string (buffer-string) "\n\n")))
7340
7341 (defvar anything-c-simple-call-tree-related-functions nil)
7342 (defvar anything-c-simple-call-tree-function-index 0)
7343 (defun anything-c-simple-call-tree-persistent-action (candidate)
7344   (unless (eq last-command 'anything-execute-persistent-action)
7345     (setq anything-c-simple-call-tree-related-functions
7346           (delete "no functions."
7347                   (split-string
7348                    (replace-regexp-in-string "  \\| is called by\\| calls "
7349                                              "" candidate)
7350                    "\n")))
7351     (setq anything-c-simple-call-tree-function-index -1))
7352   (incf anything-c-simple-call-tree-function-index)
7353   (anything-c-simple-call-tree-find-definition candidate))
7354
7355 (defun anything-c-simple-call-tree-find-definition (candidate)
7356   (find-function
7357    (intern
7358     (nth (mod anything-c-simple-call-tree-function-index
7359               (length anything-c-simple-call-tree-related-functions))
7360          anything-c-simple-call-tree-related-functions))))
7361
7362
7363 ;;; Function calls
7364 (defvar anything-c-source-simple-call-tree-callers-functions
7365   '((name . "Function calls")
7366     (init . anything-c-simple-call-tree-callers-functions-init)
7367     (multiline)
7368     (candidates . anything-c-simple-call-tree-candidates)
7369     (persistent-action . anything-c-simple-call-tree-persistent-action)
7370     (persistent-help . "Show function definitions by rotation")
7371     (action ("Find definition selected by persistent-action" .
7372              anything-c-simple-call-tree-find-definition)))
7373   "Needs simple-call-tree.el.
7374 http://www.emacswiki.org/cgi-bin/wiki/download/simple-call-tree.el")
7375
7376 (defun anything-c-simple-call-tree-callers-functions-init ()
7377   (anything-c-simple-call-tree-init-base 'identity " calls \n"))
7378
7379
7380
7381 \f
7382 ;;; Anything UI of auto-document.el
7383 ;;
7384 ;; <http://www.emacswiki.org/cgi-bin/wiki/download/auto-document.el>
7385 ;;
7386 ;; Commands/Options with doc
7387 (defvar anything-c-auto-document-data nil)
7388 (make-variable-buffer-local 'anything-c-auto-document-data)
7389 (defvar anything-c-source-commands-and-options-in-file
7390   '((name . "Commands/Options in file")
7391     (header-name
7392      . (lambda (x) (format "Commands/Options in %s"
7393                            (buffer-local-value 'buffer-file-name
7394                                                anything-current-buffer))))
7395     (candidates . anything-command-and-options-candidates)
7396     (multiline)
7397     (action . imenu))
7398   "List Commands and Options with doc. It needs auto-document.el .
7399
7400 http://www.emacswiki.org/cgi-bin/wiki/download/auto-document.el")
7401
7402 (eval-when-compile (require 'auto-document nil t))
7403 (defun anything-command-and-options-candidates ()
7404   (with-anything-current-buffer
7405     (when (and (require 'auto-document nil t)
7406                (eq major-mode 'emacs-lisp-mode)
7407                (or (anything-current-buffer-is-modified)
7408                    (not anything-c-auto-document-data)))
7409       (or imenu--index-alist (imenu--make-index-alist t))
7410       (setq anything-c-auto-document-data
7411             (destructuring-bind (commands options)
7412                 (adoc-construct anything-current-buffer)
7413               (append
7414                (loop for (command . doc) in commands
7415                      for cmdname = (symbol-name command)
7416                      collect
7417                      (cons
7418                       (format "Command: %s\n %s"
7419                               (propertize cmdname 'face font-lock-function-name-face)
7420                               (adoc-first-line doc))
7421                       (assoc cmdname imenu--index-alist)))
7422                (loop with var-alist = (cdr (assoc "Variables" imenu--index-alist))
7423                      for (option doc default) in options
7424                      for optname = (symbol-name option)
7425                      collect
7426                      (cons
7427                       (format "Option: %s\n %s\n default = %s"
7428                               (propertize optname 'face font-lock-variable-name-face)
7429                               (adoc-first-line doc)
7430                               (adoc-prin1-to-string default))
7431                       (assoc optname
7432                              var-alist)))))))
7433     anything-c-auto-document-data))
7434
7435
7436 \f
7437 ;;;; <Color and Face>
7438 ;;
7439
7440 ;;; Customize Face
7441 ;;
7442 ;;
7443 (defvar anything-c-source-customize-face
7444   '((name . "Customize Face")
7445     (init . (lambda ()
7446               (unless (anything-candidate-buffer)
7447                 (save-selected-window
7448                   (list-faces-display))
7449                 (anything-candidate-buffer (get-buffer "*Faces*")))))
7450     (candidates-in-buffer)
7451     (get-line . buffer-substring)
7452     (action . (lambda (line)
7453                 (customize-face (intern (car (split-string line))))))
7454     (requires-pattern . 3))
7455   "See (info \"(emacs)Faces\")")
7456
7457 ;;; Colors browser
7458 ;;
7459 ;;
7460 (defvar anything-c-source-colors
7461   '((name . "Colors")
7462     (init . (lambda () (unless (anything-candidate-buffer)
7463                          (save-selected-window
7464                            (list-colors-display))
7465                          (anything-candidate-buffer (get-buffer "*Colors*")))))
7466     (candidates-in-buffer)
7467     (get-line . buffer-substring)
7468     (action
7469      ("Copy Name" . (lambda (candidate)
7470                       (kill-new (anything-c-colors-get-name candidate))))
7471      ("Copy RGB" . (lambda (candidate)
7472                      (kill-new (anything-c-colors-get-rgb candidate))))
7473      ("Insert Name" . (lambda (candidate)
7474                         (with-anything-current-buffer
7475                           (insert (anything-c-colors-get-name candidate)))))
7476      ("Insert RGB" . (lambda (candidate)
7477                        (with-anything-current-buffer
7478                          (insert (anything-c-colors-get-rgb candidate))))))))
7479
7480 (defun anything-c-colors-get-name (candidate)
7481   "Get color name."
7482   (replace-regexp-in-string
7483    " " ""
7484    (with-temp-buffer
7485      (insert (capitalize candidate))
7486      (goto-char (point-min))
7487      (search-forward-regexp "\\s-\\{2,\\}")
7488      (delete-region (point) (point-max))
7489      (buffer-string))))
7490
7491 (defun anything-c-colors-get-rgb (candidate)
7492   "Get color RGB."
7493   (replace-regexp-in-string
7494    " " ""
7495    (with-temp-buffer
7496      (insert (capitalize candidate))
7497      (goto-char (point-max))
7498      (search-backward-regexp "\\s-\\{2,\\}")
7499      (delete-region (point) (point-min))
7500      (buffer-string))))
7501
7502 \f
7503 ;;;; <Search Engine>
7504 ;;; Tracker desktop search
7505 (defvar anything-c-source-tracker-search
7506   '((name . "Tracker Search")
7507     (candidates . (lambda ()
7508                     (start-process "tracker-search-process" nil
7509                                    "tracker-search"
7510                                    anything-pattern)))
7511     (type . file)
7512     (requires-pattern . 3)
7513     (delayed))
7514   "Source for retrieving files matching the current input pattern
7515 with the tracker desktop search.")
7516
7517 ;;; Spotlight (MacOS X desktop search)
7518 (defvar anything-c-source-mac-spotlight
7519   '((name . "mdfind")
7520     (candidates
7521      . (lambda () (start-process "mdfind-process" nil "mdfind" anything-pattern)))
7522     (type . file)
7523     (requires-pattern . 3)
7524     (delayed))
7525   "Source for retrieving files via Spotlight's command line
7526 utility mdfind.")
7527
7528 ;;; Picklist
7529 (defvar anything-c-source-picklist
7530   '((name . "Picklist")
7531     (candidates . (lambda () (mapcar 'car picklist-list)))
7532     (type . file)))
7533
7534
7535 \f
7536 ;;; Kill ring
7537 ;;
7538 ;;
7539 (defvar anything-c-source-kill-ring
7540   `((name . "Kill Ring")
7541     (init . (lambda () (anything-attrset 'last-command last-command)))
7542     (candidates . anything-c-kill-ring-candidates)
7543     (filtered-candidate-transformer anything-c-kill-ring-transformer)
7544     (action . anything-c-kill-ring-action)
7545     (keymap . ,anything-kill-ring-map)
7546     (last-command)
7547     (migemo)
7548     (multiline))
7549   "Source for browse and insert contents of kill-ring.")
7550
7551 (defun anything-c-kill-ring-candidates ()
7552   (loop for kill in (anything-fast-remove-dups kill-ring :test 'equal)
7553         unless (or (< (length kill) anything-kill-ring-threshold)
7554                    (string-match "^[\\s\\t]+$" kill))
7555         collect kill))
7556
7557 (defun anything-c-kill-ring-transformer (candidates source)
7558   "Display only the `anything-c-kill-ring-max-lines-number' lines of candidate."
7559   (loop for i in candidates
7560         for nlines = (with-temp-buffer (insert i) (count-lines (point-min) (point-max)))
7561         if (and anything-c-kill-ring-max-lines-number
7562                 (> nlines anything-c-kill-ring-max-lines-number))
7563         collect (cons
7564                  (with-temp-buffer
7565                    (insert i)
7566                    (goto-char (point-min))
7567                    (concat
7568                     (buffer-substring
7569                      (point-min)
7570                      (save-excursion
7571                        (forward-line anything-c-kill-ring-max-lines-number)
7572                        (point)))
7573                     "[...]")) i)
7574         else collect i))
7575
7576 (defun anything-c-kill-ring-action (str)
7577   "Insert STR in `kill-ring' and set STR to the head.
7578 If this action is executed just after `yank',
7579 replace with STR as yanked string."
7580   (setq kill-ring (delete str kill-ring))
7581   (if (not (eq (anything-attr 'last-command) 'yank))
7582       (insert-for-yank str)
7583       ;; from `yank-pop'
7584       (let ((inhibit-read-only t)
7585             (before (< (point) (mark t))))
7586         (if before
7587             (funcall (or yank-undo-function 'delete-region) (point) (mark t))
7588             (funcall (or yank-undo-function 'delete-region) (mark t) (point)))
7589         (setq yank-undo-function nil)
7590         (set-marker (mark-marker) (point) (current-buffer))
7591         (insert-for-yank str)
7592         ;; Set the window start back where it was in the yank command,
7593         ;; if possible.
7594         (set-window-start (selected-window) yank-window-start t)
7595         (if before
7596             ;; This is like exchange-point-and-mark, but doesn't activate the mark.
7597             ;; It is cleaner to avoid activation, even though the command
7598             ;; loop would deactivate the mark because we inserted text.
7599             (goto-char (prog1 (mark t)
7600                          (set-marker (mark-marker) (point) (current-buffer)))))))
7601   (kill-new str))
7602
7603
7604 \f
7605 ;;;; <Mark ring>
7606 ;; DO NOT include these sources in `anything-sources' use
7607 ;; the commands `anything-mark-ring', `anything-global-mark-ring' or
7608 ;; `anything-all-mark-rings' instead.
7609
7610 (defun anything-c-source-mark-ring-candidates ()
7611   (flet ((get-marks (pos)
7612            (save-excursion
7613              (goto-char pos)
7614              (beginning-of-line)
7615              (let ((line  (car (split-string (thing-at-point 'line) "[\n\r]"))))
7616                (when (string= "" line)
7617                  (setq line  "<EMPTY LINE>"))
7618                (format "%7d: %s" (line-number-at-pos) line)))))
7619     (with-anything-current-buffer
7620       (loop
7621             with marks = (if (mark) (cons (mark-marker) mark-ring) mark-ring)
7622             with recip = nil
7623             for i in marks
7624             for m = (get-marks i)
7625             unless (member m recip)
7626             collect m into recip
7627             finally return recip))))
7628
7629 (defvar anything-mark-ring-cache nil)
7630 (defvar anything-c-source-mark-ring
7631   '((name . "mark-ring")
7632     (init . (lambda ()
7633               (setq anything-mark-ring-cache
7634                     (ignore-errors (anything-c-source-mark-ring-candidates)))))
7635     (candidates . (lambda ()
7636                     (anything-aif anything-mark-ring-cache
7637                         it)))
7638     (action . (("Goto line"
7639                 . (lambda (candidate)
7640                     (anything-goto-line (string-to-number candidate))))))
7641     (persistent-action . (lambda (candidate)
7642                            (anything-goto-line (string-to-number candidate))
7643                            (anything-match-line-color-current-line)))
7644     (persistent-help . "Show this line")))
7645
7646
7647 ;;; Global-mark-ring
7648 (defvar anything-c-source-global-mark-ring
7649   '((name . "global-mark-ring")
7650     (candidates . anything-c-source-global-mark-ring-candidates)
7651     (action . (("Goto line"
7652                 . (lambda (candidate)
7653                     (let ((items (split-string candidate ":")))
7654                       (anything-c-switch-to-buffer (second items))
7655                       (anything-goto-line (string-to-number (car items))))))))
7656     (persistent-action . (lambda (candidate)
7657                            (let ((items (split-string candidate ":")))
7658                              (anything-c-switch-to-buffer (second items))
7659                              (anything-goto-line (string-to-number (car items)))
7660                              (anything-match-line-color-current-line))))
7661     (persistent-help . "Show this line")))
7662
7663 (defun anything-c-source-global-mark-ring-candidates ()
7664   (flet ((buf-fn (m)
7665            (with-current-buffer (marker-buffer m)
7666              (goto-char m)
7667              (beginning-of-line)
7668              (let (line)
7669                (if (string= "" line)
7670                    (setq line  "<EMPTY LINE>")
7671                    (setq line (car (split-string (thing-at-point 'line)
7672                                                  "[\n\r]"))))
7673                (format "%7d:%s:    %s"
7674                        (line-number-at-pos) (marker-buffer m) line)))))
7675     (loop
7676           with marks = global-mark-ring
7677           with recip = nil
7678           for i in marks
7679           for gm = (unless (or (string-match
7680                                 "^ " (format "%s" (marker-buffer i)))
7681                                (null (marker-buffer i)))
7682                      (buf-fn i))
7683           when (and gm (not (member gm recip)))
7684           collect gm into recip
7685           finally return recip)))
7686
7687
7688 \f
7689 ;;;; <Register>
7690 ;;; Insert from register
7691 (defvar anything-c-source-register
7692   '((name . "Registers")
7693     (candidates . anything-c-register-candidates)
7694     (action-transformer . anything-c-register-action-transformer)
7695     (multiline)
7696     (action))
7697   "See (info \"(emacs)Registers\")")
7698
7699 (defun anything-c-register-candidates ()
7700   "Collecting register contents and appropriate commands."
7701   (loop for (char . val) in register-alist
7702         for key    = (single-key-description char)
7703         for string-actions =
7704         (cond
7705           ((numberp val)
7706            (list (int-to-string val)
7707                  'insert-register
7708                  'increment-register))
7709           ((markerp val)
7710            (let ((buf (marker-buffer val)))
7711              (if (null buf)
7712                  (list "a marker in no buffer")
7713                  (list (concat
7714                         "a buffer position:"
7715                         (buffer-name buf)
7716                         ", position "
7717                         (int-to-string (marker-position val)))
7718                        'jump-to-register
7719                        'insert-register))))
7720           ((and (consp val) (window-configuration-p (car val)))
7721            (list "window configuration."
7722                  'jump-to-register))
7723           ((and (consp val) (frame-configuration-p (car val)))
7724            (list "frame configuration."
7725                  'jump-to-register))
7726           ((and (consp val) (eq (car val) 'file))
7727            (list (concat "file:"
7728                          (prin1-to-string (cdr val))
7729                          ".")
7730                  'jump-to-register))
7731           ((and (consp val) (eq (car val) 'file-query))
7732            (list (concat "file:a file-query reference: file "
7733                          (car (cdr val))
7734                          ", position "
7735                          (int-to-string (car (cdr (cdr val))))
7736                          ".")
7737                  'jump-to-register))
7738           ((consp val)
7739            (let ((lines (format "%4d" (length val))))
7740              (list (format "%s: %s\n" lines
7741                            (truncate-string-to-width
7742                             (mapconcat 'identity (list (car val))
7743                                        "^J") (- (window-width) 15)))
7744                    'insert-register)))
7745           ((stringp val)
7746            (list
7747             ;; without properties
7748             (concat (substring-no-properties
7749                      val 0 (min (length val) anything-c-register-max-offset))
7750                     (if (> (length val) anything-c-register-max-offset)
7751                         "[...]" ""))
7752             'insert-register
7753             'append-to-register
7754             'prepend-to-register))
7755           ((vectorp val)
7756            (list
7757             "Undo-tree entry."
7758             'undo-tree-restore-state-from-register))
7759           (t
7760            "GARBAGE!"))
7761         collect (cons (format "register %3s: %s" key (car string-actions))
7762                       (cons char (cdr string-actions)))))
7763
7764 (defun anything-c-register-action-transformer (actions register-and-functions)
7765   "Decide actions by the contents of register."
7766   (loop with func-actions =
7767         '((insert-register
7768            "Insert Register" .
7769            (lambda (c) (insert-register (car c))))
7770           (jump-to-register
7771            "Jump to Register" .
7772            (lambda (c) (jump-to-register (car c))))
7773           (append-to-register
7774            "Append Region to Register" .
7775            (lambda (c) (append-to-register
7776                         (car c) (region-beginning) (region-end))))
7777           (prepend-to-register
7778            "Prepend Region to Register" .
7779            (lambda (c) (prepend-to-register
7780                         (car c) (region-beginning) (region-end))))
7781           (increment-register
7782            "Increment Prefix Arg to Register" .
7783            (lambda (c) (increment-register
7784                         anything-current-prefix-arg (car c))))
7785           (undo-tree-restore-state-from-register
7786            "Restore Undo-tree register"
7787            (lambda (c) (and (fboundp 'undo-tree-restore-state-from-register)
7788                             (undo-tree-restore-state-from-register (car c))))))
7789         for func in (cdr register-and-functions)
7790         for cell = (assq func func-actions)
7791         when cell
7792         collect (cdr cell)))
7793
7794
7795 \f
7796 ;;; Latex completion
7797 (defun anything-c-latex-math-candidates ()
7798   "Collect candidates for latex math completion."
7799   (declare (special LaTeX-math-menu))
7800   (loop for i in (cddr LaTeX-math-menu)
7801         for elm = (loop for s in i when (vectorp s)
7802                         collect (cons (aref s 0) (aref s 1)))
7803         append elm))
7804
7805 (defvar anything-c-source-latex-math
7806   '((name . "Latex Math Menu")
7807     (init . (lambda ()
7808               (with-anything-current-buffer
7809                 (LaTeX-math-mode 1))))
7810     (candidate-number-limit . 9999)
7811     (candidates . anything-c-latex-math-candidates)
7812     (action . (lambda (candidate)
7813                 (call-interactively candidate)))))
7814
7815 \f
7816 ;;;; <Headline Extraction>
7817 (defvar anything-c-source-fixme
7818   '((name . "TODO/FIXME/DRY comments")
7819     (headline . "^.*\\<\\(TODO\\|FIXME\\|DRY\\)\\>.*$")
7820     (adjust)
7821     (recenter))
7822   "Show TODO/FIXME/DRY comments in current file.")
7823
7824 (defvar anything-c-source-rd-headline
7825   '((name . "RD HeadLine")
7826     (headline  "^= \\(.+\\)$" "^== \\(.+\\)$" "^=== \\(.+\\)$" "^==== \\(.+\\)$")
7827     (condition . (memq major-mode '(rdgrep-mode rd-mode)))
7828     (migemo)
7829     (subexp . 1))
7830   "Show RD headlines.
7831
7832 RD is Ruby's POD.
7833 http://en.wikipedia.org/wiki/Ruby_Document_format")
7834
7835 (defvar anything-c-source-oddmuse-headline
7836   '((name . "Oddmuse HeadLine")
7837     (headline  "^= \\(.+\\) =$" "^== \\(.+\\) ==$"
7838      "^=== \\(.+\\) ===$" "^==== \\(.+\\) ====$")
7839     (condition . (memq major-mode '(oddmuse-mode yaoddmuse-mode)))
7840     (migemo)
7841     (subexp . 1))
7842   "Show Oddmuse headlines, such as EmacsWiki.")
7843
7844 (defvar anything-c-source-emacs-source-defun
7845   '((name . "Emacs Source DEFUN")
7846     (headline . "DEFUN\\|DEFVAR")
7847     (condition . (string-match "/emacs2[0-9].+/src/.+c$"
7848                   (or buffer-file-name ""))))
7849   "Show DEFUN/DEFVAR in Emacs C source file.")
7850
7851 (defvar anything-c-source-emacs-lisp-expectations
7852   '((name . "Emacs Lisp Expectations")
7853     (headline . "(desc[ ]\\|(expectations")
7854     (condition . (eq major-mode 'emacs-lisp-mode)))
7855   "Show descriptions (desc) in Emacs Lisp Expectations.
7856
7857 http://www.emacswiki.org/cgi-bin/wiki/download/el-expectations.el")
7858
7859 (defvar anything-c-source-emacs-lisp-toplevels
7860   '((name . "Emacs Lisp Toplevel / Level 3 Comment / Linkd Star / interactive")
7861     (headline . "^(\\|(@\\*\\|^;;;\\|(interactive\\b")
7862     (get-line . buffer-substring)
7863     (condition . (eq major-mode 'emacs-lisp-mode))
7864     (adjust))
7865   "Show top-level forms, level 4 comments and linkd stars (optional) in Emacs Lisp.
7866 linkd.el is optional because linkd stars are extracted by regexp.
7867 http://www.emacswiki.org/cgi-bin/wiki/download/linkd.el")
7868
7869 \f
7870 ;;; Anything yaoddmuse
7871 ;;
7872 ;; Be sure to have yaoddmuse.el installed
7873 ;; install-elisp may be required if you want to install elisp file from here.
7874 (defvar anything-yaoddmuse-use-cache-file nil)
7875 (defvar anything-c-yaoddmuse-cache-file "~/.emacs.d/yaoddmuse-cache.el")
7876 (defvar anything-c-yaoddmuse-ew-cache nil)
7877
7878 (defun anything-yaoddmuse-get-candidates ()
7879   (declare (special yaoddmuse-pages-hash))
7880   (if anything-yaoddmuse-use-cache-file
7881       (ignore-errors
7882         (unless anything-c-yaoddmuse-ew-cache
7883           (load anything-c-yaoddmuse-cache-file)
7884           (setq anything-c-yaoddmuse-ew-cache
7885                 (gethash "EmacsWiki" yaoddmuse-pages-hash)))
7886         anything-c-yaoddmuse-ew-cache)
7887       (yaoddmuse-update-pagename t)
7888       (gethash "EmacsWiki" yaoddmuse-pages-hash)))
7889
7890 (defvar anything-c-source-yaoddmuse-emacswiki-edit-or-view
7891   '((name . "Yaoddmuse Edit or View (EmacsWiki)")
7892     (candidates . anything-yaoddmuse-get-candidates)
7893     (action . (("Edit page" . (lambda (candidate)
7894                                 (yaoddmuse-edit "EmacsWiki" candidate)))
7895                ("Browse page"
7896                 . (lambda (candidate)
7897                     (yaoddmuse-browse-page "EmacsWiki" candidate)))
7898                ("Browse page other window"
7899                 . (lambda (candidate)
7900                     (if (one-window-p)
7901                         (split-window-vertically))
7902                     (yaoddmuse-browse-page "EmacsWiki" candidate)))
7903                ("Browse diff"
7904                 . (lambda (candidate)
7905                     (yaoddmuse-browse-page-diff "EmacsWiki" candidate)))
7906                ("Copy URL"
7907                 . (lambda (candidate)
7908                     (kill-new (yaoddmuse-url "EmacsWiki" candidate))
7909                     (message "Have copy page %s's URL to yank." candidate)))
7910                ("Create page"
7911                 . (lambda (candidate)
7912                     (yaoddmuse-edit "EmacsWiki" anything-input)))
7913                ("Update cache"
7914                 . (lambda (candidate)
7915                     (if anything-yaoddmuse-use-cache-file
7916                         (progn
7917                           (anything-yaoddmuse-cache-pages t)
7918                           (setq anything-c-yaoddmuse-ew-cache
7919                                 (gethash "EmacsWiki" yaoddmuse-pages-hash)))
7920                         (yaoddmuse-update-pagename))))))
7921     (action-transformer anything-c-yaoddmuse-action-transformer))
7922   "Needs yaoddmuse.el.
7923
7924 http://www.emacswiki.org/emacs/download/yaoddmuse.el")
7925
7926
7927 (defvar anything-c-source-yaoddmuse-emacswiki-post-library
7928   '((name . "Yaoddmuse Post library (EmacsWiki)")
7929     (init . (anything-yaoddmuse-init))
7930     (candidates-in-buffer)
7931     (action . (("Post library and Browse"
7932                 . (lambda (candidate)
7933                     (yaoddmuse-post-file
7934                      (find-library-name candidate)
7935                      "EmacsWiki"
7936                      (file-name-nondirectory (find-library-name candidate))
7937                      nil t)))
7938                ("Post library"
7939                 . (lambda (candidate)
7940                     (yaoddmuse-post-file
7941                      (find-library-name candidate)
7942                      "EmacsWiki"
7943                      (file-name-nondirectory
7944                       (find-library-name candidate))))))))
7945   "Needs yaoddmuse.el.
7946
7947 http://www.emacswiki.org/emacs/download/yaoddmuse.el")
7948
7949
7950 (defun anything-c-yaoddmuse-action-transformer (actions candidate)
7951   "Allow the use of `install-elisp' only on elisp files."
7952   (if (string-match "\.el$" candidate)
7953       (append actions '(("Install Elisp"
7954                          . (lambda (elm)
7955                              (install-elisp-from-emacswiki elm)))))
7956       actions))
7957
7958 ;;;###autoload
7959 (defun anything-yaoddmuse-cache-pages (&optional load)
7960   "Fetch the list of files on emacswiki and create cache file.
7961 If load is non--nil load the file and feed `yaoddmuse-pages-hash'."
7962   (interactive)
7963   (declare (special yaoddmuse-pages-hash))
7964   (yaoddmuse-update-pagename)
7965   (save-excursion
7966     (find-file anything-c-yaoddmuse-cache-file)
7967     (erase-buffer)
7968     (insert "(puthash \"EmacsWiki\" '(")
7969     (loop for i in (gethash "EmacsWiki" yaoddmuse-pages-hash)
7970           do
7971           (insert (concat "(\"" (car i) "\") ")))
7972     (insert ") yaoddmuse-pages-hash)\n")
7973     (save-buffer)
7974     (kill-buffer (current-buffer))
7975     (when (or current-prefix-arg
7976               load)
7977       (load anything-c-yaoddmuse-cache-file))))
7978
7979 (defun anything-yaoddmuse-init ()
7980   "Init anything buffer status."
7981   (let ((anything-buffer (anything-candidate-buffer 'global))
7982         (library-list (yaoddmuse-get-library-list)))
7983     (with-current-buffer anything-buffer
7984       ;; Insert library name.
7985       (dolist (library library-list)
7986         (insert (format "%s\n" library)))
7987       ;; Sort lines.
7988       (sort-lines nil (point-min) (point-max)))))
7989
7990 \f
7991 ;;; Eev anchors
7992 (defvar anything-c-source-eev-anchor
7993   '((name . "Anchors")
7994     (candidates
7995      . (lambda ()
7996          (ignore-errors
7997            (with-anything-current-buffer
7998              (loop initially (goto-char (point-min))
7999                    while (re-search-forward
8000                           (format ee-anchor-format "\\([^\.].+\\)") nil t)
8001                    for anchor = (match-string-no-properties 1)
8002                    collect (cons (format "%5d:%s"
8003                                          (line-number-at-pos (match-beginning 0))
8004                                          (format ee-anchor-format anchor))
8005                                  anchor))))))
8006     (persistent-action . (lambda (item)
8007                            (ee-to item)
8008                            (anything-match-line-color-current-line)))
8009     (migemo)
8010     (persistent-help . "Show this entry")
8011     (action . (("Goto link" . ee-to)))))
8012
8013 \f
8014 ;;; Org headlines
8015 ;;
8016 ;;
8017 (defvar anything-c-source-org-headline
8018   `((name . "Org HeadLine")
8019     (headline
8020      ,@(mapcar
8021         (lambda (num)
8022           (format "^\\*\\{%d\\} \\(.+?\\)\\([ \t]*:[a-zA-Z0-9_@:]+:\\)?[ \t]*$"
8023                   num))
8024         (number-sequence 1 8)))
8025     (condition . (eq major-mode 'org-mode))
8026     (migemo)
8027     (subexp . 1)
8028     (persistent-action . anything-c-action-line-goto)
8029     (action-transformer
8030      . (lambda (actions candidate)
8031          '(("Go to Line" . anything-c-action-line-goto)
8032            ("Refile to this Headline" . anything-c-org-headline-refile)
8033            ("Insert Link to This Headline"
8034             . anything-c-org-headline-insert-link-to-headline)))))
8035   "Show Org headlines.
8036 org-mode is very very much extended text-mode/outline-mode.
8037
8038 See (find-library \"org.el\")
8039 See http://orgmode.org for the latest version.")
8040
8041 (defun anything-c-org-headline-insert-link-to-headline (lineno-and-content)
8042   (insert
8043    (save-excursion
8044      (anything-goto-line (car lineno-and-content))
8045      (and (looking-at org-complex-heading-regexp)
8046           (org-make-link-string (concat "*" (match-string 4)))))))
8047
8048 (defun anything-c-org-headline-refile (lineno-and-content)
8049   "Refile current org entry to LINENO-AND-CONTENT."
8050   (with-anything-current-buffer
8051     (org-cut-subtree)
8052     (anything-goto-line (car lineno-and-content))
8053     (org-end-of-subtree t t)
8054     (let ((org-yank-adjusted-subtrees t))
8055       (org-yank))))
8056
8057
8058 ;;; Org keywords
8059 ;;
8060 ;;
8061 (defvar anything-c-source-org-keywords
8062   '((name . "Org Keywords")
8063     (init . anything-c-org-keywords-init)
8064     (candidates . anything-c-org-keywords-candidates)
8065     (action . anything-c-org-keywords-insert)
8066     (persistent-action . anything-c-org-keywords-show-help)
8067     (persistent-help . "Show an example and info page to describe this keyword.")
8068     (keywords-examples)
8069     (keywords)))
8070
8071 (defvar anything-c-org-keywords-info-location
8072   '(("#+TITLE:" . "(org)Export options")
8073     ("#+AUTHOR:" . "(org)Export options")
8074     ("#+DATE:" . "(org)Export options")
8075     ("#+EMAIL:" . "(org)Export options")
8076     ("#+DESCRIPTION:" . "(org)Export options")
8077     ("#+KEYWORDS:" . "(org)Export options")
8078     ("#+LANGUAGE:" . "(org)Export options")
8079     ("#+TEXT:" . "(org)Export options")
8080     ("#+TEXT:" . "(org)Export options")
8081     ("#+OPTIONS:" . "(org)Export options")
8082     ("#+BIND:" . "(org)Export options")
8083     ("#+LINK_UP:" . "(org)Export options")
8084     ("#+LINK_HOME:" . "(org)Export options")
8085     ("#+LATEX_HEADER:" . "(org)Export options")
8086     ("#+EXPORT_SELECT_TAGS:" . "(org)Export options")
8087     ("#+EXPORT_EXCLUDE_TAGS:" . "(org)Export options")
8088     ("#+INFOJS_OPT" . "(org)Javascript support")
8089     ("#+BEGIN_HTML" . "(org)Quoting HTML tags")
8090     ("#+BEGIN_LaTeX" . "(org)Quoting LaTeX code")
8091     ("#+ORGTBL" . "(org)Radio tables")
8092     ("#+HTML:" . "(org)Quoting HTML tags")
8093     ("#+LaTeX:" . "(org)Quoting LaTeX code")
8094     ("#+BEGIN:" . "(org)Dynamic blocks") ;clocktable columnview
8095     ("#+BEGIN_EXAMPLE" . "(org)Literal examples")
8096     ("#+BEGIN_QUOTE" . "(org)Paragraphs")
8097     ("#+BEGIN_VERSE" . "(org)Paragraphs")
8098     ("#+BEGIN_SRC" . "(org)Literal examples")
8099     ("#+CAPTION" . "(org)Tables in HTML export")
8100     ("#+LABEL" . "(org)Tables in LaTeX export")
8101     ("#+ATTR_HTML" . "(org)Links")
8102     ("#+ATTR_LaTeX" . "(org)Images in LaTeX export")))
8103
8104 (defun anything-c-org-keywords-init ()
8105   (unless (anything-attr 'keywords-examples)
8106     (require 'org)
8107     (anything-attrset 'keywords-examples
8108                       (append
8109                        (mapcar
8110                         (lambda (x)
8111                           (string-match "^#\\+\\(\\([A-Z_]+:?\\).*\\)" x)
8112                           (cons (match-string 2 x) (match-string 1 x)))
8113                         (org-split-string (org-get-current-options) "\n"))
8114                        (mapcar 'list org-additional-option-like-keywords)))
8115     (anything-attrset 'keywords (mapcar 'car (anything-attr 'keywords-examples)))))
8116
8117 (defun anything-c-org-keywords-candidates ()
8118   (and (or (eq (buffer-local-value 'major-mode anything-current-buffer) 'org-mode)
8119            (eq (buffer-local-value 'major-mode anything-current-buffer) 'message-mode))
8120        (anything-attr 'keywords)))
8121
8122 (defun anything-c-org-keywords-insert (keyword)
8123   (cond ((and (string-match "BEGIN" keyword)
8124               (anything-region-active-p))
8125          (let ((beg (region-beginning))
8126                (end (region-end)))
8127            (goto-char end)
8128            (insert "\n#+" (replace-regexp-in-string
8129                            "BEGIN" "END" keyword) "\n")
8130            (goto-char beg)
8131            (insert "#+" keyword " ")
8132            (save-excursion (insert "\n"))))
8133         ((string-match "BEGIN" keyword)
8134          (insert "#+" keyword " ")
8135          (save-excursion
8136            (insert "\n#+" (replace-regexp-in-string
8137                            "BEGIN" "END" keyword) "\n")))
8138         (t (insert "#+" keyword " "))))
8139
8140 (defun anything-c-org-keywords-show-help (keyword)
8141   (info (or (assoc-default (concat "#+" keyword) anything-c-org-keywords-info-location)
8142             "(org)In-buffer settings"))
8143   (search-forward (concat "#+" keyword) nil t)
8144   (anything-persistent-highlight-point)
8145   (message "%s" (or (cdr (assoc keyword (anything-attr 'keywords-examples))) "")))
8146
8147
8148 \f
8149 ;;; bbdb
8150 ;;
8151 ;;
8152 (defvar bbdb-records)
8153 (defvar bbdb-buffer-name)
8154
8155 (defun anything-c-bbdb-candidates ()
8156   "Return a list of all names in the bbdb database.  The format
8157 is \"Firstname Lastname\"."
8158   (mapcar (lambda (bbdb-record)
8159             (replace-regexp-in-string
8160              "\\s-+$" ""
8161              (concat (aref bbdb-record 0) " " (aref bbdb-record 1))))
8162           (bbdb-records)))
8163
8164 (defun anything-c-bbdb-create-contact (actions candidate)
8165   "Action transformer that returns only an entry to add the
8166 current `anything-pattern' as new contact.  All other actions are
8167 removed."
8168   (if (string= candidate "*Add to contacts*")
8169       '(("Add to contacts" . (lambda (actions)
8170                                (bbdb-create-internal
8171                                 (read-from-minibuffer "Name: " anything-c-bbdb-name)
8172                                 (read-from-minibuffer "Company: ")
8173                                 (read-from-minibuffer "Email: ")
8174                                 nil
8175                                 nil
8176                                 (read-from-minibuffer "Note: ")))))
8177       actions))
8178
8179 (defun anything-c-bbdb-get-record (candidate)
8180   "Return record that match CANDIDATE."
8181   (bbdb candidate nil)
8182   (set-buffer "*BBDB*")
8183   (bbdb-current-record))
8184
8185 (defvar anything-c-bbdb-name nil
8186   "Only for internal use.")
8187
8188 (defvar anything-c-source-bbdb
8189   '((name . "BBDB")
8190     (candidates . anything-c-bbdb-candidates)
8191     (action ("Send a mail" . anything-c-bbdb-compose-mail)
8192      ("View person's data" . anything-c-bbdb-view-person-action))
8193     (filtered-candidate-transformer . (lambda (candidates source)
8194                                         (setq anything-c-bbdb-name anything-pattern)
8195                                         (if (not candidates)
8196                                             (list "*Add to contacts*")
8197                                             candidates)))
8198     (action-transformer . (lambda (actions candidate)
8199                             (anything-c-bbdb-create-contact actions candidate))))
8200   "Needs BBDB.
8201
8202 http://bbdb.sourceforge.net/")
8203
8204 (defun anything-c-bbdb-view-person-action (candidate)
8205   "View BBDB data of single CANDIDATE or marked candidates."
8206   (anything-aif (anything-marked-candidates)
8207       (let ((bbdb-append-records (length it)))
8208         (dolist (i it)
8209           (bbdb-redisplay-one-record (anything-c-bbdb-get-record i))))
8210     (bbdb-redisplay-one-record (anything-c-bbdb-get-record candidate))))
8211
8212 (defun anything-c-bbdb-collect-mail-addresses ()
8213   "Return a list of all mail addresses of records in bbdb buffer."
8214   (with-current-buffer bbdb-buffer-name
8215     (loop for i in bbdb-records
8216           if (bbdb-record-net (car i))
8217           collect (bbdb-dwim-net-address (car i)))))
8218
8219 (defun anything-c-bbdb-compose-mail (candidate)
8220   "Compose a mail with all records of bbdb buffer."
8221   (anything-c-bbdb-view-person-action candidate)
8222   (let* ((address-list (anything-c-bbdb-collect-mail-addresses))
8223          (address-str  (mapconcat 'identity address-list ",\n    ")))
8224     (compose-mail address-str)))
8225
8226 \f
8227 ;;; Evaluation Result
8228 ;;
8229 ;;
8230 ;; Internal
8231 (defvar anything-eldoc-active-minibuffers-list nil)
8232 (defvar anything-eval-expression-input-history nil)
8233
8234 (defvar anything-c-source-evaluation-result
8235   '((name . "Evaluation Result")
8236     ;;(disable-shortcuts)
8237     (dummy)
8238     (multiline)
8239     (mode-line . "C-RET: nl-and-indent, tab: reindent, C-tab:complete, C-p/n: next/prec-line.")
8240     (filtered-candidate-transformer . (lambda (candidates source)
8241                                         (list
8242                                          (condition-case nil
8243                                              (with-anything-current-buffer
8244                                                (pp-to-string
8245                                                 (eval (read anything-pattern))))
8246                                            (error "Error")))))
8247     (action . (("Copy result to kill-ring" . (lambda (candidate)
8248                                                (with-current-buffer anything-buffer
8249                                                  (let ((end (save-excursion
8250                                                               (goto-char (point-max))
8251                                                               (search-backward "\n")
8252                                                               (point))))
8253                                                    (kill-region (point) end)))))
8254                ("copy sexp to kill-ring" . (lambda (candidate)
8255                                              (kill-new anything-input)))))))
8256
8257 (defun anything-eval-new-line-and-indent ()
8258   (interactive)
8259   (newline) (lisp-indent-line))
8260
8261 (defun anything-eldoc-store-minibuffer ()
8262   "Store minibuffer buffer name in `anything-eldoc-active-minibuffers-list'."
8263   (with-selected-window (minibuffer-window)
8264     (push (buffer-name) anything-eldoc-active-minibuffers-list)))
8265
8266 (defun anything-eldoc-show-in-eval ()
8267   "Return eldoc in mode-line for current minibuffer input."
8268   (let ((buf (with-selected-window (minibuffer-window)
8269                (buffer-name))))
8270     (when (member buf anything-eldoc-active-minibuffers-list)
8271       (let* ((str-all (with-current-buffer buf
8272                         (minibuffer-completion-contents)))
8273              (sym     (when str-all
8274                         (with-temp-buffer
8275                           (insert str-all)
8276                           (goto-char (point-max))
8277                           (unless (looking-back ")\\|\"") (forward-char -1))
8278                           (eldoc-current-symbol))))
8279              (info-fn (eldoc-fnsym-in-current-sexp))
8280              (doc     (or (eldoc-get-var-docstring sym)
8281                           (eldoc-get-fnsym-args-string
8282                            (car info-fn) (cadr info-fn)))))
8283         (when doc (funcall anything-c-eldoc-in-minibuffer-show-fn doc))))))
8284
8285 (defun anything-c-show-info-in-mode-line (str)
8286   "Display string STR in mode-line."
8287   (save-selected-window
8288     (with-current-buffer anything-buffer
8289       (let ((mode-line-format (concat " " str)))
8290         (force-mode-line-update)
8291         (sit-for anything-c-show-info-in-mode-line-delay))
8292       (force-mode-line-update))))
8293
8294 ;;; Calculation Result
8295 ;;
8296 ;;
8297 (defvar anything-c-source-calculation-result
8298   '((name . "Calculation Result")
8299     (dummy)
8300     (filtered-candidate-transformer . (lambda (candidates source)
8301                                         (list
8302                                          (condition-case nil
8303                                              (calc-eval anything-pattern)
8304                                            (error "error")))))
8305     (action ("Copy result to kill-ring" . kill-new))))
8306
8307 \f
8308 ;;; Google Suggestions
8309 ;;
8310 ;;
8311 ;; Internal
8312 (defvar anything-ggs-max-length-real-flag 0)
8313 (defvar anything-ggs-max-length-num-flag 0)
8314
8315 (defun anything-c-google-suggest-fetch (input)
8316   "Fetch suggestions for INPUT from XML buffer.
8317 Return an alist with elements like (data . number_results)."
8318   (setq anything-ggs-max-length-real-flag 0
8319         anything-ggs-max-length-num-flag 0)
8320   (let ((request (concat anything-c-google-suggest-url
8321                          (url-hexify-string input))))
8322     (flet ((fetch ()
8323              (loop
8324                    with result-alist = (xml-get-children
8325                                         (car (xml-parse-region
8326                                               (point-min) (point-max)))
8327                                         'CompleteSuggestion)
8328                    for i in result-alist
8329                    for data = (cdr (caadr (assoc 'suggestion i)))
8330                    for nqueries = (cdr (caadr (assoc 'num_queries i)))
8331                    for lqueries = (length (anything-c-ggs-set-number-result
8332                                            nqueries))
8333                    for ldata = (length data)
8334                    do
8335                    (progn
8336                      (when (> ldata anything-ggs-max-length-real-flag)
8337                        (setq anything-ggs-max-length-real-flag ldata))
8338                      (when (> lqueries anything-ggs-max-length-num-flag)
8339                        (setq anything-ggs-max-length-num-flag lqueries)))
8340                    collect (cons data nqueries) into cont
8341                    finally return cont)))
8342       (if anything-google-suggest-use-curl-p
8343           (with-temp-buffer
8344             (call-process "curl" nil t nil request)
8345             (fetch))
8346           (with-current-buffer
8347               (url-retrieve-synchronously request)
8348             (fetch))))))
8349
8350 (defun anything-c-google-suggest-set-candidates (&optional request-prefix)
8351   "Set candidates with result and number of google results found."
8352   (let ((suggestions
8353          (loop with suggested-results = (anything-c-google-suggest-fetch
8354                                          (or (and request-prefix
8355                                                   (concat request-prefix
8356                                                           " " anything-pattern))
8357                                              anything-pattern))
8358                for (real . numresult) in suggested-results
8359                ;; Prepare number of results with ","
8360                for fnumresult = (anything-c-ggs-set-number-result numresult)
8361                ;; Calculate number of spaces to add before fnumresult
8362                ;; if it is smaller than longest result
8363                ;; `anything-ggs-max-length-num-flag'.
8364                ;; e.g 1,234,567
8365                ;;       345,678
8366                ;; To be sure it is aligned properly.
8367                for nspaces = (if (< (length fnumresult)
8368                                     anything-ggs-max-length-num-flag)
8369                                  (- anything-ggs-max-length-num-flag
8370                                     (length fnumresult))
8371                                  0)
8372                ;; Add now the spaces before fnumresult.
8373                for align-fnumresult = (concat (make-string nspaces ? )
8374                                               fnumresult)
8375                for interval = (- anything-ggs-max-length-real-flag
8376                                  (length real))
8377                for spaces   = (make-string (+ 2 interval) ? )
8378                for display = (format "%s%s(%s results)"
8379                                      real spaces align-fnumresult)
8380                collect (cons display real))))
8381     (if (loop for (disp . dat) in suggestions
8382               thereis (equal dat anything-pattern))
8383         suggestions
8384         ;; if there is no suggestion exactly matching the input then
8385         ;; prepend a Search on Google item to the list
8386         (append
8387          suggestions
8388          (list (cons (concat "Search for " "'" anything-input "'" " on Google")
8389                      anything-input))))))
8390
8391 (defun anything-c-ggs-set-number-result (num)
8392   (if num
8393       (progn
8394         (and (numberp num) (setq num (number-to-string num)))
8395         (loop for i in (reverse (split-string num "" t))
8396               for count from 1
8397               append (list i) into C
8398               when (= count 3)
8399               append (list ",") into C
8400               and do (setq count 0)
8401               finally return
8402               (replace-regexp-in-string
8403                "^," "" (mapconcat 'identity (reverse C) ""))))
8404       "?"))
8405
8406 (defvar anything-c-google-suggest-default-browser-function nil
8407   "*The browse url function you prefer to use with google suggest.
8408 When nil, use the first browser function available
8409 See `anything-browse-url-default-browser-alist'.")
8410
8411 (defun anything-c-google-suggest-action (candidate)
8412   "Default action to jump to a google suggested candidate."
8413   (let ((arg (concat anything-c-google-suggest-search-url
8414                      (url-hexify-string candidate))))
8415     (anything-aif anything-c-google-suggest-default-browser-function
8416         (funcall it arg)
8417       (anything-c-browse-url arg))))
8418
8419 (defvar anything-c-google-suggest-default-function
8420   'anything-c-google-suggest-set-candidates
8421   "Default function to use in anything google suggest.")
8422
8423 (defvar anything-c-source-google-suggest
8424   '((name . "Google Suggest")
8425     (candidates . (lambda ()
8426                     (funcall anything-c-google-suggest-default-function)))
8427     (action . (("Google Search" . anything-c-google-suggest-action)))
8428     (volatile)
8429     (requires-pattern . 3)
8430     (delayed)))
8431
8432 (defun anything-c-google-suggest-emacs-lisp ()
8433   "Try to emacs lisp complete with google suggestions."
8434   (anything-c-google-suggest-set-candidates "emacs lisp"))
8435
8436
8437 ;;; Yahoo suggestions
8438 ;;
8439 ;;
8440 (defun anything-c-yahoo-suggest-fetch (input)
8441   "Fetch Yahoo suggestions for INPUT from XML buffer.
8442 Return an alist with elements like (data . number_results)."
8443   (let ((request (concat anything-c-yahoo-suggest-url
8444                          (url-hexify-string input))))
8445     (flet ((fetch ()
8446              (loop
8447                    with result-alist = (xml-get-children
8448                                         (car (xml-parse-region
8449                                               (point-min) (point-max)))
8450                                         'Result)
8451                    for i in result-alist
8452                    collect (caddr i))))
8453       (with-current-buffer
8454           (url-retrieve-synchronously request)
8455         (fetch)))))
8456
8457 (defun anything-c-yahoo-suggest-set-candidates ()
8458   "Set candidates with Yahoo results found."
8459   (let ((suggestions (anything-c-yahoo-suggest-fetch anything-input)))
8460     (or suggestions
8461         (append
8462          suggestions
8463          (list (cons (concat "Search for " "'" anything-input "'" " on Yahoo")
8464                      anything-input))))))
8465
8466 (defun anything-c-yahoo-suggest-action (candidate)
8467   "Default action to jump to a Yahoo suggested candidate."
8468   (anything-c-browse-url (concat anything-c-yahoo-suggest-search-url
8469                                  (url-hexify-string candidate))))
8470
8471 (defvar anything-c-source-yahoo-suggest
8472   '((name . "Yahoo Suggest")
8473     (candidates . anything-c-yahoo-suggest-set-candidates)
8474     (action . (("Yahoo Search" . anything-c-yahoo-suggest-action)))
8475     (volatile)
8476     (requires-pattern . 3)
8477     (delayed)))
8478
8479
8480 \f
8481 ;;; Web browser functions.
8482 ;;
8483 ;;
8484 (require 'browse-url)
8485 ;; If default setting of `w3m-command' is not
8486 ;; what you want you and you modify it, you will have to reeval
8487 ;; also `anything-browse-url-default-browser-alist'.
8488 (defvar w3m-command "/usr/bin/w3m")
8489 (defvar anything-c-home-url "http://www.google.fr"
8490   "*Default url to use as home url.")
8491
8492 (defvar ac-browse-url-chromium-program "chromium-browser")
8493 (defvar ac-browse-url-uzbl-program "uzbl-browser")
8494 (defvar anything-browse-url-default-browser-alist
8495   `((,w3m-command . w3m-browse-url)
8496     (,browse-url-firefox-program . browse-url-firefox)
8497     (,ac-browse-url-chromium-program . ac-browse-url-chromium)
8498     (,ac-browse-url-uzbl-program . ac-browse-url-uzbl)
8499     (,browse-url-kde-program . browse-url-kde)
8500     (,browse-url-gnome-moz-program . browse-url-gnome-moz)
8501     (,browse-url-mozilla-program . browse-url-mozilla)
8502     (,browse-url-galeon-program . browse-url-galeon)
8503     (,browse-url-netscape-program . browse-url-netscape)
8504     (,browse-url-mosaic-program . browse-url-mosaic)
8505     (,browse-url-xterm-program . browse-url-text-xterm))
8506   "*Alist of \(executable . function\) to try to find a suitable url browser.")
8507
8508 (defun* anything-c-generic-browser (url name &rest args)
8509   "Browse URL with NAME browser."
8510   (let ((proc (concat name " " url)))
8511     (message "Starting %s..." name)
8512     (apply 'start-process proc nil name
8513            (append args (list url)))
8514     (set-process-sentinel
8515      (get-process proc)
8516      #'(lambda (process event)
8517          (when (string= event "finished\n")
8518            (message "%s process %s" process event))))))
8519
8520 (defun ac-browse-url-chromium (url)
8521   "Browse URL with google chrome browser."
8522   (interactive "sURL: ")
8523   (anything-c-generic-browser
8524    url ac-browse-url-chromium-program))
8525
8526 (defun ac-browse-url-uzbl (url &optional ignore)
8527   "Browse URL with uzbl browser."
8528   (interactive "sURL: ")
8529   (anything-c-generic-browser url ac-browse-url-uzbl-program "-u"))
8530
8531 (defun anything-browse-url-default-browser (url &rest args)
8532   "Find the first available browser and ask it to load URL."
8533   (let ((default-browser-fn
8534          (loop for (exe . fn) in anything-browse-url-default-browser-alist
8535                thereis (and exe (executable-find exe) fn))))
8536     (if default-browser-fn
8537         (apply default-browser-fn url args)
8538         (error "No usable browser found"))))
8539
8540 (defun anything-c-browse-url (url &rest args)
8541   "Default command to browse URL."
8542   (if browse-url-browser-function
8543       (browse-url url args)
8544       (anything-browse-url-default-browser url args)))
8545
8546 \f
8547 ;;; Surfraw
8548 ;;
8549 ;; Need external program surfraw.
8550 ;; <http://surfraw.alioth.debian.org/>
8551
8552 (defvar anything-surfraw-default-browser-function nil
8553   "*The browse url function you prefer to use with surfraw.
8554 When nil, fallback to `browse-url-browser-function'.")
8555
8556 ;; Internal
8557 (defvar anything-surfraw-engines-history nil)
8558 (defvar anything-surfraw-input-history nil)
8559
8560 (defun anything-c-build-elvi-list ()
8561   "Return list of all engines and descriptions handled by surfraw."
8562   (cdr
8563    (with-temp-buffer
8564      (call-process "surfraw" nil t nil
8565                    "-elvi")
8566      (split-string (buffer-string) "\n"))))
8567
8568 \f
8569 ;;; Emms
8570 ;;
8571 ;;
8572 (defun anything-emms-stream-edit-bookmark (elm)
8573   "Change the information of current emms-stream bookmark from anything."
8574   (declare (special emms-stream-list))
8575   (let* ((cur-buf anything-current-buffer)
8576          (bookmark (assoc elm emms-stream-list))
8577          (name     (read-from-minibuffer "Description: "
8578                                          (nth 0 bookmark)))
8579          (url      (read-from-minibuffer "URL: "
8580                                          (nth 1 bookmark)))
8581          (fd       (read-from-minibuffer "Feed Descriptor: "
8582                                          (int-to-string (nth 2 bookmark))))
8583          (type     (read-from-minibuffer "Type (url, streamlist, or lastfm): "
8584                                          (format "%s" (car (last bookmark))))))
8585     (save-window-excursion
8586       (emms-streams)
8587       (when (re-search-forward (concat "^" name) nil t)
8588         (beginning-of-line)
8589         (emms-stream-delete-bookmark)
8590         (emms-stream-add-bookmark name url (string-to-number fd) type)
8591         (emms-stream-save-bookmarks-file)
8592         (emms-stream-quit)
8593         (anything-c-switch-to-buffer cur-buf)))))
8594
8595 (defun anything-emms-stream-delete-bookmark (candidate)
8596   "Delete emms-streams bookmarks from anything."
8597   (let* ((cands   (anything-marked-candidates))
8598          (bmks    (loop for bm in cands collect
8599                         (car (assoc bm emms-stream-list))))
8600          (bmk-reg (mapconcat 'regexp-quote bmks "\\|^")))
8601     (when (y-or-n-p (format "Really delete radios\n -%s: ? "
8602                             (mapconcat 'identity bmks "\n -")))
8603       (save-window-excursion
8604         (emms-streams)
8605         (goto-char (point-min))
8606         (loop while (re-search-forward bmk-reg nil t)
8607               do (progn (beginning-of-line)
8608                         (emms-stream-delete-bookmark))
8609               finally do (progn
8610                            (emms-stream-save-bookmarks-file)
8611                            (emms-stream-quit)))))))
8612
8613 (defvar anything-c-source-emms-streams
8614   '((name . "Emms Streams")
8615     (init . (lambda ()
8616               (emms-stream-init)))
8617     (candidates . (lambda ()
8618                     (declare (special emms-stream-list))
8619                     (mapcar 'car emms-stream-list)))
8620     (action . (("Play" . (lambda (elm)
8621                            (declare (special emms-stream-list))
8622                            (let* ((stream (assoc elm emms-stream-list))
8623                                   (fn (intern (concat "emms-play-" (symbol-name (car (last stream))))))
8624                                   (url (second stream)))
8625                              (funcall fn url))))
8626                ("Delete" . anything-emms-stream-delete-bookmark)
8627                ("Edit" . anything-emms-stream-edit-bookmark)))
8628     (filtered-candidate-transformer . anything-c-adaptive-sort)))
8629
8630 ;; Don't forget to set `emms-source-file-default-directory'
8631 (defvar anything-c-source-emms-dired
8632   '((name . "Music Directory")
8633     (candidates . (lambda ()
8634                     (cddr (directory-files emms-source-file-default-directory))))
8635     (action .
8636      (("Play Directory" . (lambda (item)
8637                             (emms-play-directory
8638                              (expand-file-name
8639                               item
8640                               emms-source-file-default-directory))))
8641       ("Open dired in file's directory" . (lambda (item)
8642                                             (anything-c-open-dired
8643                                              (expand-file-name
8644                                               item
8645                                               emms-source-file-default-directory))))))
8646     (filtered-candidate-transformer . anything-c-adaptive-sort)))
8647
8648
8649 (defun anything-c-emms-files-modifier (candidates source)
8650   (let ((current-playlist (with-current-emms-playlist
8651                               (loop with cur-list = (emms-playlist-tracks-in-region
8652                                                      (point-min) (point-max))
8653                                     for i in cur-list
8654                                     for name = (assoc-default 'name i)
8655                                     when name
8656                                     collect name))))
8657     (loop for i in candidates
8658           if (member (cdr i) current-playlist)
8659           collect (cons (propertize (car i)
8660                                     'face 'anything-emms-playlist)
8661                         (cdr i)) into lis
8662           else collect i into lis
8663           finally return (reverse lis))))
8664
8665 (defun anything-c-emms-play-current-playlist ()
8666   "Play current playlist."
8667   (with-current-emms-playlist
8668       (emms-playlist-first)
8669     (emms-playlist-mode-play-smart)))
8670
8671 (defvar anything-c-source-emms-files
8672   '((name . "Emms files")
8673     (candidates . (lambda ()
8674                     (loop for v being the hash-values in emms-cache-db
8675                           for name      = (assoc-default 'name v)
8676                           for artist    = (or (assoc-default 'info-artist v) "unknown")
8677                           for genre     = (or (assoc-default 'info-genre v) "unknown")
8678                           for tracknum  = (or (assoc-default 'info-tracknumber v) "unknown")
8679                           for song      = (or (assoc-default 'info-title v) "unknown")
8680                           for info      = (concat artist " - " genre " - " tracknum ": " song)
8681                           unless (string-match "^\\(http\\|mms\\):" name)
8682                           collect (cons info name))))
8683     (filtered-candidate-transformer . anything-c-emms-files-modifier)
8684     (candidate-number-limit . 9999)
8685     (action . (("Play file" . emms-play-file)
8686                ("Add to Playlist and play (C-u clear current)"
8687                 . (lambda (candidate)
8688                     (when anything-current-prefix-arg
8689                       (emms-playlist-current-clear))
8690                     (emms-playlist-new)
8691                     (mapc 'emms-add-playlist-file (anything-marked-candidates))
8692                     (unless emms-player-playing-p
8693                       (anything-c-emms-play-current-playlist))))))))
8694
8695
8696 \f
8697 ;;; Jabber Contacts (jabber.el)
8698 (defun anything-c-jabber-online-contacts ()
8699   "List online Jabber contacts."
8700   (with-no-warnings
8701     (let (jids)
8702       (dolist (item (jabber-concat-rosters) jids)
8703         (when (get item 'connected)
8704           (push (if (get item 'name)
8705                     (cons (get item 'name) item)
8706                     (cons (symbol-name item) item)) jids))))))
8707
8708 (defvar anything-c-source-jabber-contacts
8709   '((name . "Jabber Contacts")
8710     (init . (lambda () (require 'jabber)))
8711     (candidates . (lambda () (mapcar 'car (anything-c-jabber-online-contacts))))
8712     (action . (lambda (x)
8713                 (jabber-chat-with
8714                  (jabber-read-account)
8715                  (symbol-name
8716                   (cdr (assoc x (anything-c-jabber-online-contacts)))))))))
8717
8718
8719 \f
8720 ;;; Call source.
8721 (defvar anything-source-select-buffer "*anything source select*")
8722 (defvar anything-c-source-call-source
8723   `((name . "Call anything source")
8724     (candidate-number-limit)
8725     (candidates
8726      . (lambda ()
8727          (loop for vname in (all-completions "anything-c-source-" obarray)
8728                for var = (intern vname)
8729                for name = (ignore-errors (assoc-default 'name (symbol-value var)))
8730                if name collect
8731                (cons (format "%s `%s'"
8732                              name (propertize vname 'face 'font-lock-variable-name-face))
8733                      var))))
8734     (action
8735      . (("Invoke anything with selected source"
8736          .
8737          (lambda (candidate)
8738            (setq anything-candidate-number-limit 9999)
8739            (anything candidate nil nil nil nil
8740                      anything-source-select-buffer)))
8741         ("Describe variable" . describe-variable)
8742         ("Find variable" . find-variable)))
8743     (persistent-action . describe-variable)
8744     (persistent-help . "Show description of this source")))
8745
8746 (defun anything-call-source-from-anything ()
8747   "Call anything source within `anything' session."
8748   (interactive)
8749   (setq anything-input-idle-delay 0)
8750   (anything-set-sources '(anything-c-source-call-source)))
8751
8752 ;;; Execute Preconfigured anything.
8753 (defvar anything-c-source-anything-commands
8754   '((name . "Preconfigured Anything")
8755     (candidates . anything-c-anything-commands-candidates)
8756     (type . command)
8757     (candidate-number-limit)))
8758
8759 (defun anything-c-anything-commands-candidates ()
8760   (loop for (cmd . desc) in (anything-c-list-preconfigured-anything)
8761         collect (cons (if (where-is-internal cmd nil t)
8762                           (substitute-command-keys (format "M-x %s (\\[%s]) : %s" cmd cmd desc))
8763                           (substitute-command-keys (format "\\[%s] : %s" cmd desc)))
8764                       cmd)))
8765
8766 \f
8767 ;;; Occur
8768 ;;
8769 ;;
8770 (defun anything-c-occur-init ()
8771   "Create the initial anything occur buffer.
8772 If region is active use region as buffer contents
8773 instead of whole buffer."
8774   (with-current-buffer (anything-candidate-buffer 'global)
8775     (erase-buffer)
8776     (let ((buf-contents
8777            (with-anything-current-buffer
8778              (if (anything-region-active-p)
8779                  (buffer-substring (region-beginning) (region-end))
8780                  (buffer-substring (point-min) (point-max))))))
8781       (insert buf-contents))))
8782
8783 (defun anything-c-occur-get-line (s e)
8784   (format "%7d:%s" (line-number-at-pos (1- s)) (buffer-substring s e)))
8785
8786 (defun anything-c-occur-query-replace-regexp (candidate)
8787   "Query replace regexp starting from CANDIDATE.
8788 If region is active ignore CANDIDATE and replace only in region.
8789 With a prefix arg replace only matches surrounded by word boundaries,
8790 i.e Don't replace inside a word, regexp is surrounded with \\bregexp\\b."
8791   (let ((regexp anything-input))
8792     (unless (anything-region-active-p)
8793       (anything-c-action-line-goto candidate))
8794     (apply 'query-replace-regexp
8795            (anything-c-query-replace-args regexp))))
8796
8797 (defun anything-occur-run-query-replace-regexp ()
8798   "Run `query-replace-regexp' in anything occur from keymap."
8799   (interactive)
8800   (anything-c-quit-and-execute-action
8801    'anything-c-occur-query-replace-regexp))
8802
8803 (defvar anything-c-source-occur
8804   `((name . "Occur")
8805     (init . anything-c-occur-init)
8806     (candidates-in-buffer)
8807     (migemo)
8808     (get-line . anything-c-occur-get-line)
8809     (display-to-real . anything-c-display-to-real-line)
8810     (action . (("Go to Line" . anything-c-action-line-goto)
8811                ("Query replace regexp (C-u Not inside word.)"
8812                 . anything-c-occur-query-replace-regexp)))
8813     (recenter)
8814     (mode-line . anything-occur-mode-line)
8815     (keymap . ,anything-occur-map)
8816     (requires-pattern . 1)
8817     (delayed)))
8818
8819 \f
8820 ;;; Anything browse code.
8821 (defun anything-c-browse-code-get-line (beg end)
8822   "Select line if it match the regexp corresponding to current `major-mode'.
8823 Line is parsed for BEG position to END position."
8824   (let ((str-line (buffer-substring beg end))
8825         (regexp   (assoc-default major-mode
8826                                  anything-c-browse-code-regexp-alist))
8827         (num-line (if (string= anything-pattern "") beg (1- beg))))
8828     (when (and regexp (string-match regexp str-line))
8829       (format "%4d:%s" (line-number-at-pos num-line) str-line))))
8830
8831
8832 (defvar anything-c-source-browse-code
8833   '((name . "Browse code")
8834     (init . (lambda ()
8835               (anything-candidate-buffer anything-current-buffer)
8836               (with-anything-current-buffer
8837                 (jit-lock-fontify-now))))
8838     (candidate-number-limit . 9999)
8839     (candidates-in-buffer)
8840     (get-line . anything-c-browse-code-get-line)
8841     (type . line)
8842     (recenter)))
8843
8844 \f
8845 ;; Do many actions for input
8846 (defvar anything-c-source-create
8847   '((name . "Create")
8848     (dummy)
8849     (action)
8850     (action-transformer . anything-create--actions))
8851   "Do many create actions from `anything-pattern'.
8852 See also `anything-create--actions'.")
8853
8854 (defun anything-create-from-anything ()
8855   "Run `anything-create' from `anything' as a fallback."
8856   (interactive)
8857   (anything-run-after-quit 'anything-create nil anything-pattern))
8858
8859 (defun anything-create--actions (&rest ignored)
8860   "Default actions for `anything-create' / `anything-c-source-create'."
8861   (remove-if-not
8862    (lambda (pair) (and (consp pair) (functionp (cdr pair))))
8863    (append anything-create--actions-private
8864            '(("find-file" . find-file)
8865              ("find-file other window" . find-file-other-window)
8866              ("New buffer" . anything-c-switch-to-buffer)
8867              ("New buffer other window" . switch-to-buffer-other-window)
8868              ("Bookmark Set" . bookmark-set)
8869              ("Set Register" .
8870               (lambda (x) (set-register (read-char "Register: ") x)))
8871              ("Insert Linkd star" . linkd-insert-star)
8872              ("Insert Linkd Tag" . linkd-insert-tag)
8873              ("Insert Linkd Link" . linkd-insert-link)
8874              ("Insert Linkd Lisp" . linkd-insert-lisp)
8875              ("Insert Linkd Wiki" . linkd-insert-wiki)
8876              ("Google Search" . google)))))
8877
8878 \f
8879 ;; Minibuffer History
8880 ;;
8881 ;;
8882 (defvar anything-c-source-minibuffer-history
8883   '((name . "Minibuffer History")
8884     (header-name . (lambda (name)
8885                      (format "%s (%s)" name minibuffer-history-variable)))
8886     (candidates
8887      . (lambda ()
8888          (let ((history (loop for i in
8889                               (symbol-value minibuffer-history-variable)
8890                               unless (string= "" i) collect i)))
8891            (if (consp (car history))
8892                (mapcar 'prin1-to-string history)
8893                history))))
8894     (migemo)
8895     (action . (lambda (candidate)
8896                 (delete-minibuffer-contents)
8897                 (insert candidate)))))
8898
8899 \f
8900 ;;; Elscreen
8901 ;;
8902 ;;
8903 (defvar anything-c-source-elscreen
8904   '((name . "Elscreen")
8905     (candidates
8906      . (lambda ()
8907          (if (cdr (elscreen-get-screen-to-name-alist))
8908              (sort
8909               (loop for sname in (elscreen-get-screen-to-name-alist)
8910                     append (list (format "[%d] %s" (car sname) (cdr sname))))
8911               #'(lambda (a b) (compare-strings a nil nil b nil nil))))))
8912     (action
8913      . (("Change Screen" .
8914                          (lambda (candidate)
8915                            (elscreen-goto (- (aref candidate 1) (aref "0" 0)))))
8916         ("Kill Screen(s)" .
8917                           (lambda (candidate)
8918                             (dolist (i (anything-marked-candidates))
8919                               (elscreen-goto (- (aref i 1) (aref "0" 0)))
8920                               (elscreen-kill))))
8921         ("Only Screen" .
8922                        (lambda (candidate)
8923                          (elscreen-goto (- (aref candidate 1) (aref "0" 0)))
8924                          (elscreen-kill-others)))))))
8925
8926 \f
8927 ;;;; <System>
8928
8929 ;;; Top (process)
8930 (defvar anything-c-top-command "COLUMNS=%s top -b -n 1"
8931   "Top command (batch mode). %s is replaced with `frame-width'.")
8932 (defvar anything-c-source-top
8933   '((name . "Top (Press C-c C-u to refresh)")
8934     (init . anything-c-top-init)
8935     (candidates-in-buffer)
8936     (display-to-real . anything-c-top-display-to-real)
8937     (persistent-action . anything-c-top-sh-persistent-action)
8938     (persistent-help . "SIGTERM")
8939     (action
8940      ("kill (TERM)" . (lambda (pid)
8941                         (anything-c-top-sh (format "kill -TERM %s" pid))))
8942      ("kill (KILL)" . (lambda (pid)
8943                         (anything-c-top-sh (format "kill -KILL %s" pid))))
8944      ("Copy PID" . (lambda (pid) (kill-new pid))))))
8945
8946 (defun anything-c-top-sh (cmd)
8947   (message "Executed %s\n%s" cmd (shell-command-to-string cmd)))
8948
8949 (defun anything-c-top-sh-persistent-action (pid)
8950   (delete-other-windows)
8951   (anything-c-top-sh (format "kill -TERM %s" pid))
8952   (anything-force-update))
8953
8954 (defun anything-c-top-init ()
8955   (with-current-buffer (anything-candidate-buffer 'global)
8956     (call-process-shell-command
8957      (format anything-c-top-command
8958              (- (frame-width) (if anything-enable-digit-shortcuts 4 0)))
8959      nil (current-buffer))))
8960
8961 (defun anything-c-top-display-to-real (line)
8962   (car (split-string line)))
8963
8964 ;;; Timers
8965 (defvar anything-c-source-absolute-time-timers
8966   '((name . "Absolute Time Timers")
8967     (candidates . timer-list)
8968     (type . timer)))
8969
8970 (defvar anything-c-source-idle-time-timers
8971   '((name . "Idle Time Timers")
8972     (candidates . timer-idle-list)
8973     (type . timer)))
8974
8975 (defun anything-c-timer-real-to-display (timer)
8976   (destructuring-bind (triggered t1 t2 t3 repeat-delay func args idle-delay _)
8977       (append timer nil)                ;use `append' to convert vector->list
8978     (format "%s repeat=%5S %s(%s)"
8979             (let ((time (list t1 t2 t3)))
8980               (if idle-delay
8981                   (format-time-string "idle-for=%5s" time)
8982                   (format-time-string "%m/%d %T" time)))
8983             repeat-delay
8984             func
8985             (mapconcat 'prin1-to-string args " "))))
8986
8987 ;;; X RandR resolution change
8988 ;;
8989 ;;
8990 ;;; FIXME I do not care multi-display.
8991
8992 (defun anything-c-xrandr-info ()
8993   "Return a pair with current X screen number and current X display name."
8994   (with-temp-buffer
8995     (call-process "xrandr" nil (current-buffer) nil
8996                   "--current")
8997     (let (screen output)
8998       (goto-char (point-min))
8999       (save-excursion
9000         (when (re-search-forward "\\(^Screen \\)\\([0-9]\\):" nil t)
9001           (setq screen (match-string 2))))
9002       (when (re-search-forward "^\\(.*\\) connected" nil t)
9003         (setq output (match-string 1)))
9004       (list screen output))))
9005
9006 (defun anything-c-xrandr-screen ()
9007   "Return current X screen number."
9008   (car (anything-c-xrandr-info)))
9009
9010 (defun anything-c-xrandr-output ()
9011   "Return current X display name."
9012   (cadr (anything-c-xrandr-info)))
9013
9014 (defvar anything-c-source-xrandr-change-resolution
9015   '((name . "Change Resolution")
9016     (candidates
9017      . (lambda ()
9018          (with-temp-buffer
9019            (call-process "xrandr" nil (current-buffer) nil
9020                          "--screen" (anything-c-xrandr-screen) "-q")
9021            (goto-char 1)
9022            (loop with modes = nil
9023                  while (re-search-forward "   \\([0-9]+x[0-9]+\\)" nil t)
9024                  for mode = (match-string 1)
9025                  unless (member mode modes)
9026                  collect mode into modes
9027                  finally return modes))))
9028     (action
9029      ("Change Resolution"
9030       . (lambda (mode)
9031           (call-process "xrandr" nil nil nil
9032                         "--screen" (anything-c-xrandr-screen)
9033                         "--output" (anything-c-xrandr-output)
9034                         "--mode" mode))))))
9035
9036 ;;; Xfont selection
9037 ;;
9038 ;;
9039 (defun anything-c-persistent-xfont-action (elm)
9040   "Show current font temporarily"
9041   (let ((current-font (cdr (assoc 'font (frame-parameters))))
9042         (default-font elm))
9043     (unwind-protect
9044          (progn (set-frame-font default-font 'keep-size) (sit-for 2))
9045       (set-frame-font current-font))))
9046
9047 (defvar anything-c-xfonts-cache nil)
9048 (defvar anything-c-source-xfonts
9049   '((name . "X Fonts")
9050     (init . (lambda ()
9051               (unless anything-c-xfonts-cache
9052                 (setq anything-c-xfonts-cache
9053                       (x-list-fonts "*")))))
9054     (candidates . anything-c-xfonts-cache)
9055     (action . (("Copy to kill ring" . (lambda (elm)
9056                                         (kill-new elm)))
9057                ("Set Font" . (lambda (elm)
9058                                (kill-new elm)
9059                                (set-frame-font elm 'keep-size)
9060                                (message "New font have been copied to kill ring")))))
9061     (persistent-action . anything-c-persistent-xfont-action)
9062     (persistent-help . "Switch to this font temporarily")))
9063
9064 ;;; 𝕌𝕔𝕤 𝕊𝕪𝕞𝕓𝕠𝕝 𝕔𝕠𝕞𝕡𝕝𝕖𝕥𝕚𝕠𝕟
9065 ;;
9066 ;;
9067 (defvar anything-c-ucs-max-len 0)
9068 (defun anything-c-calculate-ucs-max-len ()
9069   "Calculate the length of longest `ucs-names' candidate."
9070   (loop with count = 0
9071         for (n . v) in (ucs-names)
9072         for len = (length n)
9073         if (> len count)
9074         do (setq count len)
9075         finally return count))
9076
9077 (defun anything-c-ucs-init ()
9078   "Initialize an anything buffer with ucs symbols.
9079 Only math* symbols are collected."
9080   (unless (> anything-c-ucs-max-len 0)
9081     (setq anything-c-ucs-max-len
9082           (anything-c-calculate-ucs-max-len)))
9083   (with-current-buffer (anything-candidate-buffer
9084                         (get-buffer-create "*anything ucs*"))
9085     ;; `ucs-names' fn will not run again, data is cached in
9086     ;; var `ucs-names'.
9087     (loop for (n . v) in (ucs-names)
9088           for len = (length n)
9089           for diff = (+ (- anything-c-ucs-max-len len) 2)
9090           unless (string= "" n)
9091           do (progn (insert (concat
9092                              n ":"
9093                              (make-string
9094                               diff ? )))
9095                     (ucs-insert v)
9096                     (insert "\n")))))
9097
9098 (defun anything-c-ucs-forward-char (candidate)
9099   (with-anything-current-buffer
9100     (forward-char 1)))
9101
9102 (defun anything-c-ucs-backward-char (candidate)
9103   (with-anything-current-buffer
9104     (forward-char -1)))
9105
9106 (defun anything-c-ucs-delete-backward (candidate)
9107   (with-anything-current-buffer
9108     (delete-char -1)))
9109
9110 (defun anything-c-ucs-insert-char (candidate)
9111   (with-anything-current-buffer
9112     (insert
9113      (replace-regexp-in-string
9114       " " ""
9115       (cadr (split-string candidate ":"))))))
9116
9117 (defun anything-c-ucs-persistent-insert ()
9118   (interactive)
9119   (anything-attrset 'action-insert 'anything-c-ucs-insert-char)
9120   (anything-execute-persistent-action 'action-insert))
9121
9122 (defun anything-c-ucs-persistent-forward ()
9123   (interactive)
9124   (anything-attrset 'action-forward 'anything-c-ucs-forward-char)
9125   (anything-execute-persistent-action 'action-forward))
9126
9127 (defun anything-c-ucs-persistent-backward ()
9128   (interactive)
9129   (anything-attrset 'action-back 'anything-c-ucs-backward-char)
9130   (anything-execute-persistent-action 'action-back))
9131
9132 (defun anything-c-ucs-persistent-delete ()
9133   (interactive)
9134   (anything-attrset 'action-delete 'anything-c-ucs-delete-backward)
9135   (anything-execute-persistent-action 'action-delete))
9136
9137 (defvar anything-c-source-ucs
9138   '((name . "Ucs names")
9139     (init . anything-c-ucs-init)
9140     (candidate-number-limit . 9999)
9141     (candidates-in-buffer)
9142     (mode-line . anything-c-ucs-mode-line-string)
9143     (action . (("Insert" . anything-c-ucs-insert-char)
9144                ("Forward char" . anything-c-ucs-forward-char)
9145                ("Backward char" . anything-c-ucs-backward-char)
9146                ("Delete char backward" . anything-c-ucs-delete-backward))))
9147   "Source for collecting `ucs-names' math symbols.")
9148
9149
9150 ;;; Emacs process
9151 ;;
9152 ;;
9153 (defvar anything-c-source-emacs-process
9154   '((name . "Emacs Process")
9155     (candidates . (lambda () (mapcar #'process-name (process-list))))
9156     (persistent-action . (lambda (elm)
9157                            (delete-process (get-process elm))
9158                            (anything-delete-current-selection)))
9159     (persistent-help . "Kill Process")
9160     (action ("Kill Process" . (lambda (elm)
9161                                 (delete-process (get-process elm)))))))
9162
9163 ;;; World time
9164 ;;
9165 ;;
9166 (defvar anything-c-source-time-world
9167   '((name . "Time World List")
9168     (init . (lambda ()
9169               (let ((anything-buffer (anything-candidate-buffer 'global)))
9170                 (with-current-buffer anything-buffer
9171                   (display-time-world-display display-time-world-list)))))
9172     (candidates-in-buffer)))
9173
9174
9175 \f
9176 ;;; Anything interface for Debian/Ubuntu packages (apt-*)
9177 ;;
9178 ;;
9179 (defvar anything-c-source-apt
9180   '((name . "APT")
9181     (init . anything-c-apt-init)
9182     (candidates-in-buffer)
9183     (candidate-transformer anything-c-apt-candidate-transformer)
9184     (display-to-real . anything-c-apt-display-to-real)
9185     (requires-pattern . 2)
9186     (update . anything-c-apt-refresh)
9187     (action
9188      ("Show package description" . anything-c-apt-cache-show)
9189      ("Install package" . anything-c-apt-install)
9190      ("Reinstall package" . anything-c-apt-reinstall)
9191      ("Remove package" . anything-c-apt-uninstall)
9192      ("Purge package" . anything-c-apt-purge))
9193     (persistent-action . anything-c-apt-persistent-action)
9194     (persistent-help . "Show package description")))
9195
9196 (defvar anything-c-apt-query "emacs")
9197 (defvar anything-c-apt-search-command "apt-cache search '%s'")
9198 (defvar anything-c-apt-show-command "apt-cache show '%s'")
9199 (defvar anything-c-apt-installed-packages nil)
9200 (defvar anything-c-apt-all-packages nil)
9201 (defvar anything-c-apt-input-history nil)
9202
9203 (defun anything-c-apt-refresh ()
9204   "Refresh installed candidates list."
9205   (setq anything-c-apt-installed-packages nil)
9206   (setq anything-c-apt-all-packages nil))
9207
9208 (defun anything-c-apt-persistent-action (candidate)
9209   "Persistent action for APT source."
9210   (anything-c-apt-cache-show candidate))
9211
9212 (defun anything-c-apt-candidate-transformer (candidates)
9213   "Show installed CANDIDATES and the ones to deinstall in a different color."
9214   (loop for cand in candidates
9215         for name = (anything-c-apt-display-to-real cand)
9216         collect (cond ((string= (assoc-default
9217                                  name anything-c-apt-installed-packages)
9218                                 "deinstall")
9219                        (propertize cand 'face 'anything-apt-deinstalled))
9220                       ((string= (assoc-default
9221                                  name anything-c-apt-installed-packages)
9222                                 "install")
9223                        (propertize cand 'face 'anything-apt-installed))
9224                       (t cand))))
9225
9226 (defun anything-c-apt-init ()
9227   "Initialize list of debian packages."
9228   (let ((query ""))
9229     (unless (and anything-c-apt-installed-packages
9230                  anything-c-apt-all-packages)
9231       (message "Loading package list...")
9232       (setq anything-c-apt-installed-packages
9233             (with-temp-buffer
9234               (call-process-shell-command "dpkg --get-selections"
9235                                           nil (current-buffer))
9236               (loop for i in (split-string (buffer-string) "\n" t)
9237                     for p = (split-string i)
9238                     collect (cons (car p) (cadr p)))))
9239       (setq anything-c-apt-all-packages
9240             (with-current-buffer
9241                 (anything-candidate-buffer
9242                  (get-buffer-create (format "*anything-apt*")))
9243               (erase-buffer)
9244               (call-process-shell-command
9245                (format anything-c-apt-search-command query)
9246                nil (current-buffer))))
9247       (message "Loading package list done")
9248       (sit-for 0.5))))
9249
9250 (defun anything-c-apt-display-to-real (line)
9251   "Return only name of a debian package.
9252 LINE is displayed like:
9253 package name - description."
9254   (car (split-string line " - ")))
9255
9256 (defun anything-c-shell-command-if-needed (command)
9257   "Run shell command COMMAND to describe package.
9258 If a buffer named COMMAND already exists, just switch to it."
9259   (let ((buf (get-buffer command)))
9260     (anything-c-switch-to-buffer (get-buffer-create command))
9261     (unless buf (insert (shell-command-to-string command)))))
9262
9263 (defun anything-c-apt-cache-show (package)
9264   "Show information on apt package PACKAGE."
9265   (anything-c-shell-command-if-needed
9266    (format anything-c-apt-show-command package)))
9267
9268 (defun anything-c-apt-install (package)
9269   "Run 'apt-get install' shell command on PACKAGE."
9270   (anything-c-apt-generic-action :action 'install))
9271
9272 (defun anything-c-apt-reinstall (package)
9273   "Run 'apt-get install --reinstall' shell command on PACKAGE."
9274   (anything-c-apt-generic-action :action 'reinstall))
9275
9276 (defun anything-c-apt-uninstall (package)
9277   "Run 'apt-get remove' shell command on PACKAGE."
9278   (anything-c-apt-generic-action :action 'uninstall))
9279
9280 (defun anything-c-apt-purge (package)
9281   "Run 'apt-get purge' shell command on PACKAGE."
9282   (anything-c-apt-generic-action :action 'purge))
9283
9284 (defun* anything-c-apt-generic-action (&key action)
9285   "Run 'apt-get ACTION'.
9286 Support install, remove and purge actions."
9287   (ansi-term (getenv "SHELL") "anything apt")
9288   (term-line-mode)
9289   (let ((command   (case action
9290                      ('install   "sudo apt-get install ")
9291                      ('reinstall "sudo apt-get install --reinstall ")
9292                      ('uninstall "sudo apt-get remove ")
9293                      ('purge     "sudo apt-get purge ")
9294                      (t          (error "Unknow action"))))
9295         (beg       (point))
9296         end
9297         (cand-list (mapconcat #'(lambda (x) (format "'%s'" x))
9298                               (anything-marked-candidates) " ")))
9299     (goto-char (point-max))
9300     (insert (concat command cand-list))
9301     (setq end (point))
9302     (if (y-or-n-p (format "%s package" (symbol-name action)))
9303         (progn
9304           (setq anything-c-external-commands-list nil)
9305           (setq anything-c-apt-installed-packages nil)
9306           (term-char-mode) (term-send-input))
9307         (delete-region beg end) (term-send-eof) (kill-buffer))))
9308
9309 ;; (anything-c-apt-install "jed")
9310
9311 \f
9312 ;;; Anything UI for gentoo portage.
9313 ;;
9314 ;;
9315 (defvar anything-c-gentoo-use-flags nil)
9316 (defvar anything-c-gentoo-buffer "*anything-gentoo-output*")
9317 (defvar anything-c-cache-gentoo nil)
9318 (defvar anything-c-cache-world nil)
9319 (defvar anything-c-source-gentoo
9320   '((name . "Portage sources")
9321     (init . (lambda ()
9322               (get-buffer-create anything-c-gentoo-buffer)
9323               (unless anything-c-cache-gentoo
9324                 (anything-c-gentoo-setup-cache))
9325               (unless anything-c-cache-world
9326                 (setq anything-c-cache-world (anything-c-gentoo-get-world)))
9327               (anything-c-gentoo-init-list)))
9328     (candidates-in-buffer)
9329     (match . identity)
9330     (candidate-transformer anything-c-highlight-world)
9331     (action . (("Show package" . (lambda (elm)
9332                                    (anything-c-gentoo-eshell-action elm "eix")))
9333                ("Show history" . (lambda (elm)
9334                                    (if (member elm anything-c-cache-world)
9335                                        (anything-c-gentoo-eshell-action elm "genlop -qe")
9336                                        (message "No infos on packages not yet installed"))))
9337                ("Copy in kill-ring" . kill-new)
9338                ("insert at point" . insert)
9339                ("Browse HomePage" . (lambda (elm)
9340                                       (let ((urls (anything-c-gentoo-get-url elm)))
9341                                         (browse-url (anything-comp-read "Url: " urls :must-match t)))))
9342                ("Show extra infos" . (lambda (elm)
9343                                        (if (member elm anything-c-cache-world)
9344                                            (anything-c-gentoo-eshell-action elm "genlop -qi")
9345                                            (message "No infos on packages not yet installed"))))
9346                ("Show use flags" . (lambda (elm)
9347                                      (anything-c-gentoo-default-action elm "equery" "-C" "u")
9348                                      (font-lock-add-keywords nil '(("^\+.*" . font-lock-variable-name-face)))
9349                                      (font-lock-mode 1)))
9350                ("Run emerge pretend" . (lambda (elm)
9351                                          (anything-c-gentoo-eshell-action elm "emerge -p")))
9352                ("Emerge" . (lambda (elm)
9353                              (anything-gentoo-install elm :action 'install)))
9354                ("Unmerge" . (lambda (elm)
9355                               (anything-gentoo-install elm :action 'uninstall)))
9356                ("Show dependencies" . (lambda (elm)
9357                                         (anything-c-gentoo-default-action elm "equery" "-C" "d")))
9358                ("Show related files" . (lambda (elm)
9359                                          (anything-c-gentoo-default-action elm "equery" "files")))
9360                ("Refresh" . (lambda (elm)
9361                               (anything-c-gentoo-setup-cache)
9362                               (setq anything-c-cache-world (anything-c-gentoo-get-world))))))))
9363
9364
9365 (defun* anything-gentoo-install (candidate &key action)
9366   (setq anything-c-external-commands-list nil)
9367   (ansi-term (getenv "SHELL") "Gentoo emerge")
9368   (term-line-mode)
9369   (let ((command (case action
9370                    ('install "sudo emerge -av ")
9371                    ('uninstall "sudo emerge -avC ")
9372                    (t (error "Unknow action"))))
9373         (elms (mapconcat 'identity (anything-marked-candidates) " "))
9374         (beg (point)) end)
9375     (goto-char (point-max))
9376     (insert (concat command elms))
9377     (setq end (point))
9378     (term-char-mode) (term-send-input)))
9379
9380 (defun anything-c-gentoo-default-action (elm command &rest args)
9381   "Gentoo default action that use `anything-c-gentoo-buffer'."
9382   (if (member elm anything-c-cache-world)
9383       (progn
9384         (anything-c-switch-to-buffer anything-c-gentoo-buffer)
9385         (erase-buffer)
9386         (let ((com-list (append args (list elm))))
9387           (apply #'call-process command nil t nil
9388                  com-list)))
9389       (message "No infos on packages not yet installed")))
9390
9391 (defvar anything-c-source-use-flags
9392   '((name . "Use Flags")
9393     (init . (lambda ()
9394               (unless anything-c-gentoo-use-flags
9395                 (anything-c-gentoo-setup-use-flags-cache))
9396               (anything-c-gentoo-get-use)))
9397     (candidates-in-buffer)
9398     (match . identity)
9399     (candidate-transformer anything-c-highlight-local-use)
9400     (action . (("Description"
9401                 . (lambda (elm)
9402                     (anything-c-switch-to-buffer anything-c-gentoo-buffer)
9403                     (erase-buffer)
9404                     (apply #'call-process "euse" nil t nil
9405                            `("-i"
9406                              ,elm))
9407                     (font-lock-add-keywords nil `((,elm . font-lock-variable-name-face)))
9408                     (font-lock-mode 1)))
9409                ("Enable"
9410                 . (lambda (elm)
9411                     (anything-c-gentoo-eshell-action elm "*sudo -p Password: euse -E")))
9412                ("Disable"
9413                 . (lambda (elm)
9414                     (anything-c-gentoo-eshell-action elm "*sudo -p Password: euse -D")))
9415                ("Remove"
9416                 . (lambda (elm)
9417                     (anything-c-gentoo-eshell-action elm "*sudo -p Password: euse -P")))
9418                ("Show which dep use this flag"
9419                 . (lambda (elm)
9420                     (anything-c-switch-to-buffer anything-c-gentoo-buffer)
9421                     (erase-buffer)
9422                     (apply #'call-process "equery" nil t nil
9423                            `("-C"
9424                              "h"
9425                              ,elm))))))))
9426
9427
9428
9429 (defun anything-c-gentoo-init-list ()
9430   "Initialize buffer with all packages in Portage."
9431   (let* ((portage-buf (get-buffer-create "*anything-gentoo*"))
9432          (buf (anything-candidate-buffer 'portage-buf)))
9433     (with-current-buffer buf
9434       (dolist (i anything-c-cache-gentoo)
9435         (insert (concat i "\n"))))))
9436
9437 (defun anything-c-gentoo-setup-cache ()
9438   "Set up `anything-c-cache-gentoo'"
9439   (setq anything-c-cache-gentoo
9440         (split-string (with-temp-buffer
9441                         (call-process "eix" nil t nil
9442                                       "--only-names")
9443                         (buffer-string)))))
9444
9445 (defun anything-c-gentoo-eshell-action (elm command)
9446   (when (get-buffer "*EShell Command Output*")
9447     (kill-buffer "*EShell Command Output*"))
9448   (message "Wait searching...")
9449   (let ((buf-fname (buffer-file-name anything-current-buffer)))
9450     (if (and buf-fname (string-match tramp-file-name-regexp buf-fname))
9451         (progn
9452           (save-window-excursion
9453             (pop-to-buffer "*scratch*")
9454             (eshell-command (format "%s %s" command elm)))
9455           (pop-to-buffer "*EShell Command Output*"))
9456         (eshell-command (format "%s %s" command elm)))))
9457
9458 (defun anything-c-gentoo-get-use ()
9459   "Initialize buffer with all use flags."
9460   (let* ((use-buf (get-buffer-create "*anything-gentoo-use*"))
9461          (buf (anything-candidate-buffer 'use-buf)))
9462     (with-current-buffer buf
9463       (dolist (i anything-c-gentoo-use-flags)
9464         (insert (concat i "\n"))))))
9465
9466
9467 (defun anything-c-gentoo-setup-use-flags-cache ()
9468   "Setup `anything-c-gentoo-use-flags'"
9469   (setq anything-c-gentoo-use-flags
9470         (split-string (with-temp-buffer
9471                         (call-process "eix" nil t nil
9472                                       "--print-all-useflags")
9473                         (buffer-string)))))
9474
9475 (defun anything-c-gentoo-get-url (elm)
9476   "Return a list of urls from eix output."
9477   (loop
9478         with url-list = (split-string
9479                          (with-temp-buffer
9480                            (call-process "eix" nil t nil
9481                                          elm "--format" "<homepage>\n")
9482                            (buffer-string)))
9483         with all
9484         for i in url-list
9485         when (and (string-match "^http://.*" i)
9486                   (not (member i all)))
9487         collect i into all
9488         finally return all))
9489
9490 (defun anything-c-gentoo-get-world ()
9491   "Return list of all installed package on your system."
9492   (split-string (with-temp-buffer
9493                   (call-process "qlist" nil t nil
9494                                 "-I")
9495                   (buffer-string))))
9496
9497 (defun anything-c-gentoo-get-local-use ()
9498   (split-string (with-temp-buffer
9499                   (call-process "portageq" nil t nil
9500                                 "envvar"
9501                                 "USE")
9502                   (buffer-string))))
9503
9504
9505 (defun anything-c-highlight-world (eix)
9506   "Highlight all installed package."
9507   (loop for i in eix
9508         if (member i anything-c-cache-world)
9509         collect (propertize i 'face 'anything-gentoo-match-face)
9510         else
9511         collect i))
9512
9513 (defun anything-c-highlight-local-use (use-flags)
9514   (let ((local-uses (anything-c-gentoo-get-local-use)))
9515     (loop for i in use-flags
9516           if (member i local-uses)
9517           collect (propertize i 'face 'anything-gentoo-match-face)
9518           else
9519           collect i)))
9520
9521
9522 \f
9523 ;;; Anything ratpoison UI
9524 ;;
9525 ;;
9526 (defvar anything-c-source-ratpoison-commands
9527   '((name . "Ratpoison Commands")
9528     (init . anything-c-ratpoison-commands-init)
9529     (candidates-in-buffer)
9530     (action ("Execute the command" . anything-c-ratpoison-commands-execute))
9531     (display-to-real . anything-c-ratpoison-commands-display-to-real)
9532     (candidate-number-limit)))
9533
9534 (defun anything-c-ratpoison-commands-init ()
9535   (unless (anything-candidate-buffer)
9536     (with-current-buffer (anything-candidate-buffer 'global)
9537       ;; with ratpoison prefix key
9538       (save-excursion
9539         (call-process "ratpoison" nil (current-buffer) nil "-c" "help"))
9540       (while (re-search-forward "^\\([^ ]+\\) \\(.+\\)$" nil t)
9541         (replace-match "<ratpoison> \\1: \\2"))
9542       (goto-char (point-max))
9543       ;; direct binding
9544       (save-excursion
9545         (call-process "ratpoison" nil (current-buffer) nil "-c" "help top"))
9546       (while (re-search-forward "^\\([^ ]+\\) \\(.+\\)$" nil t)
9547         (replace-match "\\1: \\2")))))
9548
9549 (defun anything-c-ratpoison-commands-display-to-real (display)
9550   (and (string-match ": " display)
9551        (substring display (match-end 0))))
9552
9553 (defun anything-c-ratpoison-commands-execute (candidate)
9554   (call-process "ratpoison" nil nil nil "-ic" candidate))
9555
9556
9557 \f
9558 ;;; Anything `completing-read' replacement
9559 ;;
9560 ;;
9561 (defvar anything-comp-read-map
9562   (let ((map (make-sparse-keymap)))
9563     (set-keymap-parent map anything-map)
9564     (define-key map (kbd "<C-return>") 'anything-cr-empty-string)
9565     (define-key map (kbd "<M-RET>") 'anything-cr-empty-string)
9566     map)
9567   "Keymap for `anything-comp-read'.")
9568
9569 (defun anything-cr-empty-string ()
9570   "Return empty string."
9571   (interactive)
9572   (when anything-alive-p
9573     (anything-exit-and-execute-action
9574      (lambda (_candidate)
9575        (identity "")))))
9576
9577 (defun anything-comp-read-get-candidates (collection &optional test sort-fn alistp)
9578   "Convert COLLECTION to list removing elements that don't match TEST.
9579 See `anything-comp-read' about supported COLLECTION arguments.
9580
9581 SORT-FN is a predicate to sort COLLECTION.
9582
9583 ALISTP when non--nil will not use `all-completions' to collect
9584 candidates because it doesn't handle alists correctly for anything.
9585 i.e In `all-completions' the keys \(cars of elements\)
9586 are the possible completions. In anything we want to use the cdr instead
9587 like \(display . real\).
9588
9589 e.g
9590
9591 \(setq A '((a . 1) (b . 2) (c . 3)))
9592 ==>((a . 1) (b . 2) (c . 3))
9593 \(anything-comp-read \"test: \" A :alistp nil
9594                                   :exec-when-only-one t
9595                                   :initial-input \"a\")
9596 ==>\"a\"
9597 \(anything-comp-read \"test: \" A :alistp t
9598                                   :exec-when-only-one t
9599                                   :initial-input \"1\")
9600 ==>\"1\"
9601
9602 See docstring of `all-completions' for more info.
9603
9604 If COLLECTION is an `obarray', a TEST should be needed. See `obarray'."
9605   (let ((cands
9606          (cond ((and (eq collection obarray) test)
9607                 (all-completions "" collection test))
9608                ((and (vectorp collection) test)
9609                 (loop for i across collection when (funcall test i) collect i))
9610                ((vectorp collection)
9611                 (loop for i across collection collect i))
9612                ((and alistp test)
9613                 (loop for i in collection when (funcall test i) collect i))
9614                ((and (symbolp collection) (boundp collection))
9615                 (symbol-value collection))
9616                (alistp collection)
9617                ((and collection test)
9618                 (all-completions "" collection test))
9619                (t (all-completions "" collection)))))
9620     (if sort-fn (sort cands sort-fn) cands)))
9621
9622 (defun anything-cr-default-transformer (candidates source)
9623   "Default filter candidate function for `anything-comp-read'.
9624 Do nothing, just return candidate list unmodified."
9625   candidates)
9626
9627 (defun* anything-comp-read (prompt collection
9628                                    &key
9629                                    test
9630                                    initial-input
9631                                    default
9632                                    preselect
9633                                    (buffer "*Anything Completions*")
9634                                    must-match
9635                                    (requires-pattern 0)
9636                                    (history nil)
9637                                    input-history
9638                                    (persistent-action nil)
9639                                    (persistent-help "DoNothing")
9640                                    (mode-line anything-mode-line-string)
9641                                    (keymap anything-comp-read-map)
9642                                    (name "Anything Completions")
9643                                    candidates-in-buffer
9644                                    exec-when-only-one
9645                                    (volatile t)
9646                                    sort
9647                                    (fc-transformer 'anything-cr-default-transformer)
9648                                    (marked-candidates nil)
9649                                    (alistp t))
9650   "Read a string in the minibuffer, with anything completion.
9651
9652 It is anything `completing-read' equivalent.
9653
9654 - PROMPT is the prompt name to use.
9655
9656 - COLLECTION can be a list, vector, obarray or hash-table.
9657   It can be also a function that receives three arguments:
9658   the values string, predicate and t. See `all-completions' for more details.
9659
9660 Keys description:
9661
9662 - TEST: A predicate called with one arg i.e candidate.
9663
9664 - INITIAL-INPUT: Same as input arg in `anything'.
9665
9666 - PRESELECT: See preselect arg of `anything'.
9667
9668 - DEFAULT: This option is used only for compatibility with regular
9669   Emacs `completing-read'.
9670
9671 - BUFFER: Name of anything-buffer.
9672
9673 - MUST-MATCH: Candidate selected must be one of COLLECTION.
9674
9675 - REQUIRES-PATTERN: Same as anything attribute, default is 0.
9676
9677 - HISTORY: A list containing specific history, default is nil.
9678   When it is non--nil, all elements of HISTORY are displayed in
9679   a special source before COLLECTION.
9680
9681 - INPUT-HISTORY: A symbol. the minibuffer input history will be
9682   stored there, if nil or not provided, `minibuffer-history'
9683   will be used instead.
9684
9685 - PERSISTENT-ACTION: A function called with one arg i.e candidate.
9686
9687 - PERSISTENT-HELP: A string to document PERSISTENT-ACTION.
9688
9689 - MODE-LINE: A string or list to display in mode line.
9690   (See `anything-mode-line-string')
9691
9692 - KEYMAP: A keymap to use in this `anything-comp-read'.
9693   (The keymap will be shared with history source)
9694
9695 - NAME: The name related to this local source.
9696
9697 - EXEC-WHEN-ONLY-ONE: Bound `anything-execute-action-at-once-if-one'
9698   to non--nil. (possibles values are t or nil).
9699
9700 - VOLATILE: Use volatile attribute \(enabled by default\).
9701
9702 - SORT: A predicate to give to `sort' e.g `string-lessp'.
9703
9704 - FC-TRANSFORMER: A `filtered-candidate-transformer' function.
9705
9706 - MARKED-CANDIDATES: If non--nil return candidate or marked candidates as a list.
9707
9708 - ALISTP: \(default is non--nil\) See `anything-comp-read-get-candidates'.
9709
9710 - CANDIDATES-IN-BUFFER: when non--nil use a source build with
9711   `anything-candidates-in-buffer' which is much faster.
9712   Argument VOLATILE have no effect when CANDIDATES-IN-BUFFER is non--nil.
9713
9714 Any prefix args passed during `anything-comp-read' invocation will be recorded
9715 in `anything-current-prefix-arg', otherwise if prefix args were given before
9716 `anything-comp-read' invocation, the value of `current-prefix-arg' will be used.
9717 That's mean you can pass prefix args before or after calling a command
9718 that use `anything-comp-read' See `anything-M-x' for example."
9719   (when (get-buffer anything-action-buffer)
9720     (kill-buffer anything-action-buffer))
9721   (flet ((action-fn (candidate)
9722            (if marked-candidates
9723                (anything-marked-candidates)
9724                (identity candidate))))
9725     ;; Assume completion have been already required,
9726     ;; so always use 'confirm.
9727     (when (eq must-match 'confirm-after-completion)
9728       (setq must-match 'confirm))
9729     (let* ((minibuffer-completion-confirm must-match)
9730            (must-match-map (when must-match
9731                              (let ((map (make-sparse-keymap)))
9732                                (define-key map (kbd "RET")
9733                                  'anything-confirm-and-exit-minibuffer)
9734                                map)))
9735            (anything-map (if must-match-map
9736                              (make-composed-keymap
9737                               must-match-map (or keymap anything-map))
9738                              (or keymap anything-map)))
9739            (src-hist `((name . ,(format "%s History" name))
9740                        (candidates
9741                         . (lambda ()
9742                             (let ((all (anything-comp-read-get-candidates
9743                                         history nil nil ,alistp)))
9744                               (delete
9745                                ""
9746                                (anything-fast-remove-dups
9747                                 (if (and default (not (string= default "")))
9748                                     (delq nil (cons default
9749                                                     (delete default all)))
9750                                     all)
9751                                 :test 'equal)))))
9752                        (filtered-candidate-transformer
9753                         . (lambda (candidates sources)
9754                             (loop for i in candidates
9755                                   do (set-text-properties 0 (length i) nil i)
9756                                   collect i)))
9757                        (persistent-action . ,persistent-action)
9758                        (persistent-help . ,persistent-help)
9759                        (mode-line . ,mode-line)
9760                        (action . ,'action-fn)))
9761            (src `((name . ,name)
9762                   (candidates
9763                    . (lambda ()
9764                        (let ((cands (anything-comp-read-get-candidates
9765                                      collection test sort alistp)))
9766                          (unless (or must-match (string= anything-pattern ""))
9767                            (setq cands (append (list anything-pattern) cands)))
9768                          (if (and default (not (string= default "")))
9769                              (delq nil (cons default (delete default cands)))
9770                              cands))))
9771                   (filtered-candidate-transformer ,fc-transformer)
9772                   (requires-pattern . ,requires-pattern)
9773                   (persistent-action . ,persistent-action)
9774                   (persistent-help . ,persistent-help)
9775                   (mode-line . ,mode-line)
9776                   (action . ,'action-fn)))
9777            (src-1 `((name . ,name)
9778                     (init
9779                      . (lambda ()
9780                          (let ((cands (anything-comp-read-get-candidates
9781                                        collection test sort alistp)))
9782                            (unless (or must-match (string= anything-pattern ""))
9783                              (setq cands (append (list anything-pattern) cands)))
9784                            (with-current-buffer (anything-candidate-buffer 'global)
9785                              (loop for i in
9786                                    (if (and default (not (string= default "")))
9787                                        (delq nil (cons default (delete default cands)))
9788                                        cands)
9789                                    do (insert (concat i "\n")))))))
9790                     (candidates-in-buffer)
9791                     (filtered-candidate-transformer ,fc-transformer)
9792                     (requires-pattern . ,requires-pattern)
9793                     (persistent-action . ,persistent-action)
9794                     (persistent-help . ,persistent-help)
9795                     (mode-line . ,mode-line)
9796                     (action . ,'action-fn)))
9797            (src-list (list src-hist
9798                            (if candidates-in-buffer
9799                                src-1
9800                                (if volatile
9801                                    (append src '((volatile)))
9802                                    src))))
9803            (anything-execute-action-at-once-if-one exec-when-only-one)
9804            (ret (or
9805                  (anything
9806                   :sources src-list
9807                   :input initial-input
9808                   :default default
9809                   :preselect preselect
9810                   :prompt prompt
9811                   :resume 'noresume
9812                   :keymap anything-map
9813                   :history (and (symbolp input-history) input-history)
9814                   :buffer buffer)
9815                  (when (and (eq anything-exit-status 0)
9816                             (eq must-match 'confirm))
9817                    ;; Return empty string only if it is the DEFAULT
9818                    ;; value and anything-pattern is empty.
9819                    ;; otherwise return anything-pattern
9820                    (if (and (string= anything-pattern "") default)
9821                        default (identity anything-pattern)))
9822                  (unless (or (eq anything-exit-status 1)
9823                              must-match) ; FIXME this should not be needed now.
9824                    default)
9825                  (keyboard-quit)))
9826            (not-uninternp (condition-case _
9827                               (intern-soft ret)
9828                             (error t)))
9829            (retsym (if (stringp ret) (intern ret) ret)))
9830       (unwind-protect
9831           (if (and (listp collection)
9832                    (or (memq retsym collection)
9833                        (assq retsym collection)))
9834               retsym
9835             ret)
9836         (unless not-uninternp
9837           (unintern retsym obarray))))))
9838
9839 ;; Generic completing-read
9840 ;;
9841 ;; Support also function as collection.
9842 ;; e.g M-x man is supported.
9843 ;; Support hash-table and vectors as collection.
9844 ;; NOTE:
9845 ;; Some crap emacs functions may not be supported
9846 ;; like ffap-alternate-file (bad use of completing-read)
9847 ;; and maybe others.
9848 ;; Provide a mode `anything-completion-mode' which turn on
9849 ;; anything in all `completing-read' and `read-file-name' in Emacs.
9850 ;;
9851 (defvar anything-completion-mode-string " AC")
9852
9853 (defvar anything-completion-mode-quit-message
9854   "Anything completion disabled")
9855
9856 (defvar anything-completion-mode-start-message
9857   "Anything completion enabled")
9858
9859 (defvar anything-completion-types '(complete file)
9860   "If you do not want to use anything version of `read-file-name',
9861 set this variable to (complete).")
9862
9863 ;;; Specialized handlers
9864 ;;
9865 ;;
9866 (defun anything-completing-read-symbols
9867     (prompt collection test require-match init
9868      hist default inherit-input-method name buffer)
9869   "Specialized function for fast symbols completion in `ac-mode'."
9870   (or
9871    (anything
9872     :sources `((name . ,name)
9873                (init . (lambda ()
9874                          (with-current-buffer (anything-candidate-buffer 'global)
9875                            (goto-char (point-min))
9876                            (when (and default (stringp default)
9877                                       ;; Some defaults args result as
9878                                       ;; (symbol-name nil) == "nil".
9879                                       ;; e.g debug-on-entry.
9880                                       (not (string= default "nil"))
9881                                       (not (string= default "")))
9882                              (insert (concat default "\n")))
9883                            (loop with all = (all-completions "" collection test)
9884                                  for sym in all
9885                                  unless (and default (eq sym default))
9886                                  do (insert (concat sym "\n"))))))
9887                (persistent-action . anything-lisp-completion-persistent-action)
9888                (persistent-help . "Show brief doc in mode-line")
9889                (candidates-in-buffer)
9890                (action . identity))
9891     :prompt prompt
9892     :buffer buffer
9893     :input init
9894     :history hist
9895     :resume 'noresume
9896     :default (or default ""))
9897    (keyboard-quit)))
9898
9899
9900 ;;; Generic completing read
9901 ;;
9902 ;;
9903 (defun anything-completing-read-default-1
9904     (prompt collection test require-match
9905      init hist default inherit-input-method
9906      name buffer &optional cands-in-buffer exec-when-only-one)
9907   "Call `anything-comp-read' with same args as `completing-read'.
9908 Extra optional arg CANDS-IN-BUFFER mean use `candidates-in-buffer'
9909 method which is faster.
9910 It should be used when candidate list don't need to rebuild dynamically."
9911   (let ((history (or (car-safe hist) hist)))
9912     (anything-comp-read
9913      prompt collection
9914      :test test
9915      :history history
9916      :input-history history
9917      :must-match require-match
9918      :alistp nil ; Be sure `all-completions' is used.
9919      :name name
9920      :requires-pattern (if (and (string= default "")
9921                                 (or (eq require-match 'confirm)
9922                                     (eq require-match
9923                                         'confirm-after-completion)))
9924                            1 0)
9925      :candidates-in-buffer cands-in-buffer
9926      :exec-when-only-one exec-when-only-one
9927      :buffer buffer
9928      ;; If DEF is not provided, fallback to empty string
9929      ;; to avoid `thing-at-point' to be appended on top of list
9930      :default (or default "")
9931      ;; Use `regexp-quote' to fix initial input
9932      ;; with special characters (e.g nnimap+gmail:)
9933      :initial-input (and (stringp init) (regexp-quote init)))))
9934
9935 (defun anything-completing-read-with-cands-in-buffer
9936     (prompt collection test require-match
9937      init hist default inherit-input-method
9938      name buffer)
9939   "Same as `anything-completing-read-default-1' but use candidates-in-buffer."
9940   ;; Some commands like find-tag may use `read-file-name' from inside
9941   ;; the calculation of collection. in this case it clash with
9942   ;; candidates-in-buffer that reuse precedent data (files) which is wrong.
9943   ;; So (re)calculate collection outside of main anything-session.
9944   (let ((cands (all-completions "" collection)))
9945     (anything-completing-read-default-1 prompt cands test require-match
9946                                         init hist default inherit-input-method
9947                                         name buffer t)))
9948
9949 (defun* anything-completing-read-default
9950     (prompt collection &optional
9951             predicate require-match
9952             initial-input hist def
9953             inherit-input-method)
9954   "An anything replacement of `completing-read'.
9955 This function should be used only as a `completing-read-function'.
9956
9957 Don't use it directly, use instead `anything-comp-read' in your programs.
9958
9959 See documentation of `completing-read' and `all-completions' for details."
9960   (declare (special anything-completion-mode))
9961   (let* ((current-command this-command)
9962          (str-command     (symbol-name current-command))
9963          (buf-name        (format "*ac-mode-%s*" str-command))
9964          (entry           (assq current-command
9965                                 anything-completing-read-handlers-alist))
9966          (def-com         (cdr-safe entry))
9967          (str-defcom      (and def-com (symbol-name def-com)))
9968          (def-args        (list prompt collection predicate require-match
9969                                 initial-input hist def inherit-input-method))
9970          ;; Append the two extra args needed to set the buffer and source name
9971          ;; in anything specialized functions.
9972          (any-args        (append def-args (list str-command buf-name)))
9973          anything-completion-mode-start-message ; Be quiet
9974          anything-completion-mode-quit-message
9975          (minibuffer-completion-table collection)
9976          (minibuffer-completion-predicate predicate)
9977          ;; Be sure this pesty *completion* buffer doesn't popup.
9978          (minibuffer-setup-hook (remove 'minibuffer-completion-help
9979                                         minibuffer-setup-hook)))
9980     (when (eq def-com 'ido) (setq def-com 'ido-completing-read))
9981     (unless (or (not entry) def-com)
9982       ;; An entry in *read-handlers-alist exists but have
9983       ;; a nil value, so we exit from here, disable `ac-mode'
9984       ;; and run the command again with it original behavior.
9985       ;; `ac-mode' will be restored on exit.
9986       (return-from anything-completing-read-default
9987         (unwind-protect
9988              (progn
9989                (ac-mode -1)
9990                (apply completing-read-function def-args))
9991           (ac-mode 1))))
9992     ;; If we use now `completing-read' we MUST turn off `ac-mode'
9993     ;; to avoid infinite recursion and CRASH. It will be reenabled on exit.
9994     (when (or (eq def-com 'completing-read)
9995               ;; All specialized functions are prefixed by "anything"
9996               (and (stringp str-defcom)
9997                    (not (string-match "^anything" str-defcom))))
9998       (ac-mode -1))
9999     (unwind-protect
10000          (cond (;; An anything specialized function exists, run it.
10001                 (and def-com anything-completion-mode)
10002                 (apply def-com any-args))
10003                (;; Try to handle `ido-completing-read' everywhere.
10004                 (and def-com (eq def-com 'ido-completing-read))
10005                 (setcar (memq collection def-args)
10006                         (all-completions "" collection predicate))
10007                 (apply def-com def-args))
10008                (;; User set explicitely `completing-read' or something similar
10009                 ;; in *read-handlers-alist, use this with exactly the same
10010                 ;; args as in `completing-read'.
10011                 ;; If we are here `anything-completion-mode' is now disabled.
10012                 def-com
10013                 (apply def-com def-args))
10014                (t ; Fall back to classic `anything-comp-read'.
10015                 (anything-completing-read-default-1
10016                  prompt collection predicate require-match
10017                  initial-input hist def inherit-input-method
10018                  str-command buf-name)))
10019       (ac-mode 1)
10020       ;; When exiting minibuffer, `this-command' is set to
10021       ;; `anything-exit-minibuffer', which is unwanted when starting
10022       ;; on another `completing-read', so restore `this-command' to
10023       ;; initial value when exiting.
10024       (setq this-command current-command))))
10025
10026 (defun* anything-generic-read-file-name
10027     (prompt &optional dir default-filename mustmatch initial predicate)
10028   "An anything replacement of `read-file-name'."
10029   (declare (special anything-completion-mode))
10030   (let* ((default (and default-filename
10031                        (if (listp default-filename)
10032                            (car default-filename)
10033                            default-filename)))
10034          (init (or default initial dir default-directory))
10035          (ini-input (and init (expand-file-name init)))
10036          (current-command this-command)
10037          (str-command (symbol-name current-command))
10038          (anything-file-completion-sources
10039           (cons str-command
10040                 (remove str-command anything-file-completion-sources)))
10041          (buf-name (format "*ac-mode-%s*" str-command))
10042          (entry (assq current-command
10043                       anything-completing-read-handlers-alist))
10044          (def-com  (cdr-safe entry))
10045          (str-defcom (symbol-name def-com))
10046          (def-args (list prompt dir default-filename mustmatch initial predicate))
10047          ;; Append the two extra args needed to set the buffer and source name
10048          ;; in anything specialized functions.
10049          (any-args (append def-args (list str-command buf-name)))
10050          (ido-state ido-mode)
10051          anything-completion-mode-start-message ; Be quiet
10052          anything-completion-mode-quit-message  ; Same here
10053          fname)
10054     ;; Some functions that normally call `completing-read' can switch
10055     ;; brutally to `read-file-name' (e.g find-tag), in this case
10056     ;; the anything specialized function will fail because it is build
10057     ;; for `completing-read', so set it to 'incompatible to be sure
10058     ;; we switch to `anything-c-read-file-name' and don't try to call it
10059     ;; with wrong number of args.
10060     (when (and def-com (> (length (help-function-arglist def-com)) 8))
10061       (setq def-com 'incompatible))
10062     (when (eq def-com 'ido) (setq def-com 'ido-read-file-name))
10063     (unless (or (not entry) def-com)
10064       (return-from anything-generic-read-file-name
10065         (unwind-protect
10066              (progn
10067                (ac-mode -1)
10068                (apply read-file-name-function def-args))
10069           (ac-mode 1))))
10070     ;; If we use now `read-file-name' we MUST turn off `ac-mode'
10071     ;; to avoid infinite recursion and CRASH. It will be reenabled on exit.
10072     (when (or (eq def-com 'read-file-name)
10073               (eq def-com 'ido-read-file-name)
10074               (and (stringp str-defcom)
10075                    (not (string-match "^anything" str-defcom))))
10076       (ac-mode -1))
10077     (unwind-protect
10078          (setq fname
10079                (cond (;; A specialized function exists, run it
10080                       ;; with the two extra args specific to anything..
10081                       (and def-com anything-completion-mode
10082                            (not (eq def-com 'ido-read-file-name))
10083                            (not (eq def-com 'incompatible)))
10084                       (apply def-com any-args))
10085                      (;; Def-com value is `ido-read-file-name'
10086                       ;; run it with default args.
10087                       (and def-com (eq def-com 'ido-read-file-name))
10088                       (ido-mode 1)
10089                       (apply def-com def-args))
10090                      (;; Def-com value is `read-file-name'
10091                       ;; run it with default args.
10092                       (eq def-com 'read-file-name)
10093                       (apply def-com def-args))
10094                      (t ; Fall back to classic `anything-c-read-file-name'.
10095                       (anything-c-read-file-name
10096                        prompt
10097                        :name str-command
10098                        :buffer buf-name
10099                        :initial-input (expand-file-name init dir)
10100                        :alistp nil
10101                        :must-match mustmatch
10102                        :test predicate))))
10103       (ac-mode 1)
10104       (ido-mode (if ido-state 1 -1))
10105       ;; Same comment as in `anything-completing-read-default'.
10106       (setq this-command current-command))
10107     fname))
10108
10109 (defun anything-read-file-name-default (&rest them)
10110   "Use normal `read-file-name' even if `anything-completion-mode' is enabled."
10111   (let ((completing-read-function 'completing-read-default))
10112     (apply 'read-file-name-default them)))
10113
10114 ;;;###autoload
10115 (define-minor-mode anything-completion-mode
10116   "Toggle generic anything completion.
10117
10118 All functions in Emacs that use `completing-read'
10119 or `read-file-name' and friends will use anything interface
10120 when this mode is turned on.
10121 However you can modify this behavior for functions of your choice
10122 with `anything-completing-read-handlers-alist'.
10123
10124 Called with a positive arg, turn on unconditionally, with a
10125 negative arg turn off.
10126 You can turn it on with `ac-mode'.
10127
10128 Some crap emacs functions may not be supported,
10129 e.g `ffap-alternate-file' and maybe others
10130 You can add such functions to `anything-completing-read-handlers-alist'
10131 with a nil value.
10132
10133 If you do not want to use anything version of `read-file-name',
10134 set `anything-completion-types' to (complete)."
10135   :group 'anything
10136   :global t
10137   :lighter anything-completion-mode-string
10138   (declare (special completing-read-function))
10139   (cond ((and anything-completion-mode
10140               (memq 'file anything-completion-types))
10141          (setq completing-read-function 'anything-completing-read-default
10142                read-file-name-function  'anything-generic-read-file-name)
10143          (message anything-completion-mode-start-message))
10144         ((and anything-completion-mode
10145               (not (memq 'file anything-completion-types)))
10146          (setq completing-read-function 'anything-completing-read-default
10147                read-file-name-function  'anything-read-file-name-default)
10148          (message anything-completion-mode-start-message))
10149         ((null anything-completion-mode)
10150          (setq completing-read-function (and (fboundp 'completing-read-default)
10151                                              'completing-read-default)
10152                read-file-name-function  (and (fboundp 'read-file-name-default)
10153                                              'read-file-name-default))
10154          (message anything-completion-mode-quit-message))))
10155
10156 (defalias 'ac-mode 'anything-completion-mode)
10157
10158
10159 \f
10160 ;;; Eshell completion.
10161 ;;
10162 ;; Enable like this in .emacs:
10163 ;;
10164 ;; (add-hook 'eshell-mode-hook
10165 ;;           #'(lambda ()
10166 ;;               (define-key eshell-mode-map [remap pcomplete] 'anything-esh-pcomplete)))
10167 ;;
10168 (defvar anything-c-source-esh
10169   '((name . "Eshell completions")
10170     (init . (lambda ()
10171               (setq pcomplete-current-completions nil
10172                     pcomplete-last-completion-raw nil)
10173               ;; Eshell-command add this hook in all minibuffers
10174               ;; Remove it for the anything one. (Fixed in Emacs24)
10175               (remove-hook 'minibuffer-setup-hook 'eshell-mode)))
10176     (candidates . anything-esh-get-candidates)
10177     (action . anything-ec-insert))
10178   "Anything source for Eshell completion.")
10179
10180 ;; Internal.
10181 (defvar anything-ec-target "")
10182 (defun anything-ec-insert (candidate)
10183   "Replace text at point with CANDIDATE.
10184 The function that call this should set `anything-ec-target' to thing at point.
10185 This is the same as `ac-insert', just inlined here for compatibility."
10186   (let ((pt (point)))
10187     (when (and anything-ec-target
10188                (search-backward anything-ec-target nil t)
10189                (string= (buffer-substring (point) pt) anything-ec-target))
10190       (delete-region (point) pt)))
10191   (insert (anything-quote-whitespace candidate)))
10192
10193 (defun anything-esh-get-candidates ()
10194   "Get candidates for eshell completion using `pcomplete'."
10195   (catch 'pcompleted
10196     (let* ((pcomplete-stub)
10197            pcomplete-seen pcomplete-norm-func
10198            pcomplete-args pcomplete-last pcomplete-index
10199            (pcomplete-autolist pcomplete-autolist)
10200            (pcomplete-suffix-list pcomplete-suffix-list))
10201       (with-anything-current-buffer
10202         (loop with table  = (pcomplete-completions)
10203               with entry  = (condition-case nil
10204                                 ;; On Emacs24 `try-completion' return
10205                                 ;; pattern when more than one result.
10206                                 ;; Otherwise Emacs23 return nil, which
10207                                 ;; is wrong, in this case use pattern
10208                                 ;; to behave like Emacs24.
10209                                 (or (try-completion anything-pattern
10210                                                     (pcomplete-entries))
10211                                     anything-pattern)
10212                               ;; In Emacs23 `pcomplete-entries' may fail
10213                               ;; with error, so try this instead.
10214                               (error
10215                                nil
10216                                (let ((fc (car (last
10217                                                (pcomplete-parse-arguments)))))
10218                                  ;; Check if last arg require fname completion.
10219                                  (and (file-name-directory fc) fc))))
10220               for i in (all-completions pcomplete-stub table)
10221               for file-cand = (and entry
10222                                    (if (file-remote-p i) i
10223                                        (expand-file-name
10224                                         i (file-name-directory entry))))
10225               if (and file-cand (or (file-remote-p file-cand)
10226                                     (file-exists-p file-cand)))
10227               collect file-cand into ls
10228               else collect i into ls
10229               finally return
10230               (if (and entry (not (string= entry "")) (file-exists-p entry))
10231                   (append (list (expand-file-name entry default-directory)) ls)
10232                   ls))))))
10233
10234 ;;; Eshell history.
10235 ;;
10236 ;;
10237 (defvar anything-c-source-eshell-history
10238   `((name . "Eshell history")
10239     (init . (lambda ()
10240               (let (eshell-hist-ignoredups)
10241                 ;; Write the content's of ring to file.
10242                 (eshell-write-history eshell-history-file-name t)
10243                 (with-current-buffer (anything-candidate-buffer 'global)
10244                   (insert-file-contents eshell-history-file-name)))
10245               ;; Same comment as in `anything-c-source-esh'
10246               (remove-hook 'minibuffer-setup-hook 'eshell-mode)))
10247     (candidates-in-buffer)
10248     (keymap . ,anything-eshell-history-map)
10249     (filtered-candidate-transformer . (lambda (candidates sources)
10250                                         (reverse candidates)))
10251     (candidate-number-limit . 9999)
10252     (action . (lambda (candidate)
10253                 (eshell-kill-input)
10254                 (insert candidate))))
10255   "Anything source for Eshell history.")
10256
10257 \f
10258 ;;; Show completion - an alternative of anything-show-completion.el.
10259 ;;
10260 ;; Provide show completion with macro `with-anything-show-completion'.
10261
10262
10263 ;; Called each time cursor move in anything-buffer.
10264 (defun anything-c-show-completion ()
10265   (with-anything-current-buffer
10266     (overlay-put anything-c-show-completion-overlay
10267                  'display (anything-get-selection))))
10268
10269 (defun anything-c-show-completion-init-overlay (beg end)
10270   (and anything-c-turn-on-show-completion
10271        (setq anything-c-show-completion-overlay (make-overlay beg end))
10272        (overlay-put anything-c-show-completion-overlay
10273                     'face 'anything-lisp-show-completion)))
10274
10275 (defun anything-c-show-completion-display-function (buffer)
10276   "A special resized anything window is used depending on position in BUFFER."
10277   (with-selected-window (selected-window)
10278     (let* ((screen-size  (+ (count-screen-lines (window-start) (point) t)
10279                             1                             ; mode-line
10280                             (if header-line-format 1 0))) ; header-line
10281            (def-size     (- (window-height)
10282                             anything-c-show-completion-min-window-height))
10283            (upper-height (max window-min-height (min screen-size def-size)))
10284            split-window-keep-point)
10285       (recenter -1)
10286       (set-window-buffer (if (active-minibuffer-window)
10287                              (minibuffer-selected-window)
10288                              (split-window nil upper-height))
10289                          buffer))))
10290
10291 (defmacro with-anything-show-completion (beg end &rest body)
10292   "Show anything candidate in an overlay at point.
10293 BEG and END are the beginning and end position of the current completion
10294 in `anything-current-buffer'.
10295 BODY is an anything call where we want to enable show completion.
10296 If `anything-c-turn-on-show-completion' is nil just do nothing."
10297   (declare (indent 2) (debug t))
10298   `(let ((anything-move-selection-after-hook
10299           (and anything-c-turn-on-show-completion
10300                (append (list 'anything-c-show-completion)
10301                        anything-move-selection-after-hook))))
10302      (unwind-protect
10303           (progn
10304             (anything-c-show-completion-init-overlay ,beg ,end)
10305             (let ((anything-display-function
10306                    (if anything-c-show-completion-use-special-display
10307                        'anything-c-show-completion-display-function
10308                        'anything-default-display-buffer)))
10309               ,@body))
10310        (and anything-c-turn-on-show-completion
10311             (delete-overlay anything-c-show-completion-overlay)))))
10312
10313 \f
10314 ;;; Lisp symbol completion.
10315 ;;
10316 ;;
10317 ;;;###autoload
10318 (defun anything-lisp-completion-at-point ()
10319   "Anything lisp symbol completion at point."
10320   (interactive)
10321   (let* ((data       (lisp-completion-at-point))
10322          (beg        (car data))
10323          (end        (point)) ; 'cadr data' is wrong when no space after point.
10324          (plist      (nthcdr 3 data))
10325          (pred       (plist-get plist :predicate))
10326          (lgst-len   0)
10327          (target     (and beg end (buffer-substring-no-properties beg end)))
10328          (candidates (all-completions target (nth 2 data) pred))
10329          (anything-quit-if-no-candidate t)
10330
10331          (anything-execute-action-at-once-if-one t)
10332          (anything-match-plugin-enabled
10333           (member 'anything-compile-source--match-plugin
10334                   anything-compile-source-functions)))
10335     (if candidates
10336         (with-anything-show-completion beg end
10337           ;; Overlay is initialized now in anything-current-buffer.
10338           (anything
10339            :sources
10340            '((name . "Lisp completion")
10341              (init . (lambda ()
10342                        (with-current-buffer (anything-candidate-buffer 'global)
10343                          (loop for sym in candidates
10344                                for len = (length sym)
10345                                when (> len lgst-len) do (setq lgst-len len)
10346                                do (insert (concat sym "\n"))))))
10347              (candidates-in-buffer)
10348              (persistent-action . anything-lisp-completion-persistent-action)
10349              (persistent-help . "Show brief doc in mode-line")
10350              (filtered-candidate-transformer anything-lisp-completion-transformer)
10351              (action . (lambda (candidate)
10352                          (delete-region beg end)
10353                          (insert candidate))))
10354            :input (if anything-match-plugin-enabled (concat target " ") target)))
10355         (message "[No Match]"))))
10356
10357 (defun anything-lisp-completion-persistent-action (candidate)
10358   (let ((cursor-in-echo-area t)
10359         mode-line-in-non-selected-windows)
10360     (anything-c-show-info-in-mode-line
10361      (propertize
10362       (anything-c-get-first-line-documentation
10363        (intern candidate))
10364       'face 'anything-lisp-completion-info))))
10365
10366 (defun anything-lisp-completion-transformer (candidates source)
10367   "Anything candidates transformer for lisp completion."
10368   (declare (special lgst-len))
10369   (loop for c in candidates
10370         for sym = (intern c)
10371         for annot = (cond ((commandp sym) " (Com)")
10372                           ((fboundp sym)  " (Fun)")
10373                           ((boundp sym)   " (Var)")
10374                           ((facep sym)    " (Face)"))
10375         for spaces = (make-string (- lgst-len (length c)) ? )
10376         collect (cons (concat c spaces annot) c)))
10377
10378 (defun anything-c-get-first-line-documentation (sym)
10379   "Return first line documentation of symbol SYM.
10380 If SYM is not documented, return \"Not documented\"."
10381   (let ((doc (cond ((fboundp sym)
10382                     (documentation sym t))
10383                    ((boundp sym)
10384                     (documentation-property sym 'variable-documentation t))
10385                    ((facep sym)
10386                     (face-documentation sym))
10387                    (t nil))))
10388     (if (and doc (not (string= doc ""))
10389              ;; `documentation' return "\n\n(args...)"
10390              ;; for CL-style functions.
10391              (not (string-match-p "^\n\n" doc)))
10392         (car (split-string doc "\n"))
10393         "Not documented")))
10394
10395 ;;; File completion.
10396 ;;
10397 ;; Complete file name at point.
10398 (defun anything-c-thing-before-point ()
10399   "Get symbol name before point.
10400 Borrowed from anything-complete.el, inlined here for compatibility."
10401   (save-excursion
10402     (let ((beg (point)))
10403       ;; older regexp "\(\\|\\s-\\|^\\|\\_<\\|\r\\|'\\|#'"
10404       (when (re-search-backward
10405              "\\_<" (field-beginning nil nil (point-at-bol)) t)
10406         (buffer-substring-no-properties beg (match-end 0))))))
10407
10408 ;;;###autoload
10409 (defun anything-c-complete-file-name-at-point ()
10410   "Complete file name at point."
10411   (interactive)
10412   (let* ((init (substring-no-properties (thing-at-point 'filename)))
10413          (end  (point))
10414          (beg  (- (point) (length init)))
10415          (anything-quit-if-no-candidate t)
10416          (anything-execute-action-at-once-if-one t)
10417          completion)
10418     (with-anything-show-completion beg end
10419       (setq completion (anything-c-read-file-name "FileName: "
10420                                                   :initial-input init)))
10421     (anything-c-insert-file-name-completion-at-point completion)))
10422
10423 ;; Internal
10424 (defvar anything-lisp-completion-counter 0)
10425 ;;;###autoload
10426 (defun anything-lisp-completion-at-point-or-indent (arg)
10427   "First call indent and second call complete lisp symbol.
10428 The second call should happen before `anything-lisp-completion-or-indent-delay',
10429 after this delay, next call will indent again.
10430 After completion, next call is always indent.
10431 See that like click and double mouse click.
10432 One hit indent, two quick hits maybe indent and complete."
10433   (interactive "P")
10434   ;; Be sure `indent-for-tab-command' will not try
10435   ;; to use `completion-at-point'.
10436   (let ((tab-always-indent (if (eq tab-always-indent 'complete)
10437                                t tab-always-indent)))
10438     (incf anything-lisp-completion-counter)
10439     (unwind-protect
10440          (if (> anything-lisp-completion-counter 1)
10441              (anything-lisp-completion-or-file-name-at-point)
10442              (indent-for-tab-command arg))
10443       ;; After `anything-lisp-completion-or-indent-delay' seconds
10444       ;; reset to 0.
10445       (run-with-timer anything-lisp-completion-or-indent-delay nil
10446                       #'(lambda ()
10447                           (setq anything-lisp-completion-counter 0)))
10448       ;; Always reset to 0 at second hit.
10449       (when (eq anything-lisp-completion-counter 2)
10450         (setq anything-lisp-completion-counter 0)))))
10451
10452 ;;;###autoload
10453 (defun anything-lisp-completion-or-file-name-at-point ()
10454   "Complete lisp symbol or filename at point.
10455 Filename completion happen if filename is started in
10456 or between double quotes."
10457   (interactive)
10458   (let ((tap (substring-no-properties (thing-at-point 'filename))))
10459     (if (and tap (string-match "^\\(~/\\|/\\|[a-zA-Z]\:/\\).*" tap)
10460              (save-excursion (search-backward "\"" (point-at-bol) t)))
10461         (anything-c-complete-file-name-at-point)
10462         (anything-lisp-completion-at-point))))
10463
10464 (defun anything-c-apropos-init (test default)
10465   "Init candidates buffer for `anything-c-apropos' sources."
10466   (with-current-buffer (anything-candidate-buffer 'global)
10467     (goto-char (point-min))
10468     (when (and default (stringp default)
10469                ;; Some defaults args result as
10470                ;; (symbol-name nil) == "nil".
10471                ;; e.g debug-on-entry.
10472                (not (string= default "nil"))
10473                (funcall test (intern default)))
10474       (insert (concat default "\n")))
10475     (loop with all = (all-completions "" obarray test)
10476           for sym in all
10477           unless (and default (eq sym default))
10478           do (insert (concat sym "\n")))))
10479
10480 \f
10481 ;;; Run Externals commands within Emacs with anything completion
10482 ;;
10483 ;;
10484 (defvar anything-external-command-history nil)
10485
10486 (defun anything-c-external-commands-list-1 (&optional sort)
10487   "Returns a list of all external commands the user can execute.
10488 If `anything-c-external-commands-list' is non-nil it will
10489 return its contents.  Else it calculates all external commands
10490 and sets `anything-c-external-commands-list'."
10491   (if anything-c-external-commands-list
10492       anything-c-external-commands-list
10493       (setq anything-c-external-commands-list
10494             (loop
10495                   with paths = (split-string (getenv "PATH") path-separator)
10496                   with completions = ()
10497                   for dir in paths
10498                   when (and (file-exists-p dir) (file-accessible-directory-p dir))
10499                   for lsdir = (loop for i in (directory-files dir t)
10500                                     for bn = (file-name-nondirectory i)
10501                                     when (and (not (member bn completions))
10502                                               (not (file-directory-p i))
10503                                               (file-executable-p i))
10504                                     collect bn)
10505                   append lsdir into completions
10506                   finally return (if sort (sort completions 'string-lessp) completions)))))
10507
10508 (defun anything-run-or-raise (exe &optional file)
10509   "Generic command that run asynchronously EXE.
10510 If EXE is already running just jump to his window if `anything-raise-command'
10511 is non--nil.
10512 When FILE argument is provided run EXE with FILE.
10513 In this case EXE must be provided as \"EXE %s\"."
10514   (lexical-let* ((real-com (car (split-string (replace-regexp-in-string
10515                                                "%s" "" exe))))
10516                  (proc     (if file (concat real-com " " file) real-com)))
10517     (if (get-process proc)
10518         (if anything-raise-command
10519             (shell-command  (format anything-raise-command real-com))
10520             (error "Error: %s is already running" real-com))
10521         (when (loop for i in anything-c-external-commands-list thereis real-com)
10522           (message "Starting %s..." real-com)
10523           (if file
10524               (start-process-shell-command
10525                proc nil (format exe (shell-quote-argument
10526                                      (if (eq system-type 'windows-nt)
10527                                          (anything-w32-prepare-filename file)
10528                                          file))))
10529               (start-process-shell-command proc nil real-com))
10530           (set-process-sentinel
10531            (get-process proc)
10532            #'(lambda (process event)
10533                (when (and (string= event "finished\n")
10534                           anything-raise-command
10535                           (not (anything-c-get-pid-from-process-name real-com)))
10536                  (shell-command  (format anything-raise-command "emacs")))
10537                (message "%s process...Finished." process))))
10538         (setq anything-c-external-commands-list
10539               (cons real-com
10540                     (delete real-com anything-c-external-commands-list))))))
10541
10542
10543 \f
10544 ;;; Generic action functions
10545 ;;
10546 ;;
10547 (defun anything-c-file-buffers (filename)
10548   "Returns a list of buffer names corresponding to FILENAME."
10549   (let ((name     (expand-file-name filename))
10550         (buf-list ()))
10551     (dolist (buf (buffer-list) buf-list)
10552       (let ((bfn (buffer-file-name buf)))
10553         (when (and bfn (string= name bfn))
10554           (push (buffer-name buf) buf-list))))))
10555
10556 (defun anything-revert-buffer (candidate)
10557   (with-current-buffer candidate
10558     (when (or (buffer-modified-p)
10559               (not (verify-visited-file-modtime
10560                     (get-buffer candidate))))
10561       (revert-buffer t t))))
10562
10563 (defun anything-revert-marked-buffers (ignore)
10564   (mapc 'anything-revert-buffer (anything-marked-candidates)))
10565
10566 (defun anything-kill-marked-buffers (ignore)
10567   (mapc 'kill-buffer (anything-marked-candidates)))
10568
10569 (defun anything-c-delete-file (file &optional error-if-dot-file-p)
10570   "Delete the given file after querying the user.
10571 Ask to kill buffers associated with that file, too."
10572   (when (and error-if-dot-file-p
10573              (anything-ff-dot-file-p file))
10574     (error "Error: Cannot operate on `.' or `..'"))
10575   (let ((buffers (anything-c-file-buffers file)))
10576     (if (< emacs-major-version 24)
10577         ;; `dired-delete-file' in Emacs versions < 24
10578         ;; doesn't support delete-by-moving-to-trash
10579         ;; so use `delete-directory' and `delete-file'
10580         ;; that handle it.
10581         (cond ((and (not (file-symlink-p file))
10582                     (file-directory-p file)
10583                     (directory-files file t dired-re-no-dot))
10584                (when (y-or-n-p (format "Recursive delete of `%s'? " file))
10585                  (delete-directory file 'recursive)))
10586               ((and (not (file-symlink-p file))
10587                     (file-directory-p file))
10588                (delete-directory file))
10589               (t (delete-file file)))
10590         (dired-delete-file
10591          file 'dired-recursive-deletes delete-by-moving-to-trash))
10592     (when buffers
10593       (dolist (buf buffers)
10594         (when (y-or-n-p (format "Kill buffer %s, too? " buf))
10595           (kill-buffer buf))))))
10596
10597 (defun anything-get-mailcap-for-file (filename)
10598   "Get the command to use for FILENAME from mailcap files.
10599 The command is like <command %s> and is meant to use with `format'."
10600   (mailcap-parse-mailcaps)
10601   (let* ((ext  (file-name-extension filename))
10602          (mime (when ext (mailcap-extension-to-mime ext)))
10603          (result (when mime (mailcap-mime-info mime))))
10604     ;; If elisp file have no associations in .mailcap
10605     ;; `mailcap-maybe-eval' is returned, in this case just return nil.
10606     (when (stringp result) result)))
10607
10608 (defun anything-get-default-program-for-file (filename)
10609   "Try to find a default program to open FILENAME.
10610 Try first in `anything-c-external-programs-associations' and then in mailcap file
10611 if nothing found return nil."
10612   (let* ((ext      (file-name-extension filename))
10613          (def-prog (assoc-default ext anything-c-external-programs-associations)))
10614     (cond ((and def-prog (not (string= def-prog "")))
10615            (concat def-prog " %s"))
10616           ((and anything-c-default-external-file-browser
10617                 (file-directory-p filename))
10618            (concat anything-c-default-external-file-browser " %s"))
10619           (t (anything-get-mailcap-for-file filename)))))
10620
10621 (defun anything-c-open-file-externally (file)
10622   "Open FILE with an external program.
10623 Try to guess which program to use with `anything-get-default-program-for-file'.
10624 If not found or a prefix arg is given query the user which tool to use."
10625   (let* ((fname          (expand-file-name file))
10626          (collection     (anything-c-external-commands-list-1 'sort))
10627          (def-prog       (anything-get-default-program-for-file fname))
10628          (real-prog-name (if (or anything-current-prefix-arg (not def-prog))
10629                              ;; Prefix arg or no default program.
10630                              (prog1
10631                                  (anything-comp-read
10632                                   "Program: " collection
10633                                   :must-match t
10634                                   :name "Open file Externally"
10635                                   :history anything-external-command-history)
10636                                ;; Always prompt to set this program as default.
10637                                (setq def-prog nil))
10638                              ;; No prefix arg or default program exists.
10639                              (replace-regexp-in-string " %s\\| '%s'" "" def-prog)))
10640          (program        (concat real-prog-name " %s")))
10641     (unless (or def-prog ; Association exists, no need to record it.
10642                 ;; Don't try to record non--filenames associations (e.g urls).
10643                 (not (file-exists-p fname)))
10644       (when
10645           (y-or-n-p
10646            (format
10647             "Do you want to make `%s' the default program for this kind of files? "
10648             real-prog-name))
10649         (anything-aif (assoc (file-name-extension fname)
10650                              anything-c-external-programs-associations)
10651             (setq anything-c-external-programs-associations
10652                   (delete it anything-c-external-programs-associations)))
10653         (push (cons (file-name-extension fname)
10654                     (read-string
10655                      "Program (Add args maybe and confirm): " real-prog-name))
10656               anything-c-external-programs-associations)
10657         (customize-save-variable 'anything-c-external-programs-associations
10658                                  anything-c-external-programs-associations)))
10659     (anything-run-or-raise program file)
10660     (setq anything-external-command-history
10661           (cons real-prog-name
10662                 (delete real-prog-name
10663                         (loop for i in anything-external-command-history
10664                               when (executable-find i) collect i))))))
10665
10666 (defun anything-c-find-file-or-marked (candidate)
10667   "Open file CANDIDATE or open anything marked files in background."
10668   (let ((marked (anything-marked-candidates))
10669         (ffap-newfile-prompt anything-ff-newfile-prompt-p)
10670         (find-file-wildcards nil))
10671     (if (> (length marked) 1)
10672         ;; Open all marked files in background and display
10673         ;; the first one.
10674         (progn (mapc 'find-file-noselect (cdr marked))
10675                (find-file (car marked)))
10676         (if (and (not (file-exists-p candidate))
10677                  (and ffap-url-regexp
10678                       (not (string-match ffap-url-regexp candidate)))
10679                  (string-match "/$" candidate))
10680             ;; A a non--existing filename ending with /
10681             ;; Create a directory and jump to it.
10682             (when (y-or-n-p (format "Create directory `%s'? " candidate))
10683               (let ((dirfname (directory-file-name candidate)))
10684                 (if (file-exists-p dirfname)
10685                     (error "Mkdir: Unable to create directory `%s': file exists."
10686                            (anything-c-basename dirfname))
10687                     (make-directory candidate 'parent)))
10688               (anything-find-files-1 candidate))
10689             ;; A non--existing filename NOT ending with / or
10690             ;; an existing filename, create or jump to it.
10691             (find-file-at-point (car marked))))))
10692
10693 (defun anything-delete-marked-files (ignore)
10694   (let* ((files (anything-marked-candidates))
10695          (len (length files)))
10696     (if (not (y-or-n-p
10697               (format "Delete *%s File(s):\n%s"
10698                       len
10699                       (mapconcat (lambda (f) (format "- %s\n" f)) files ""))))
10700         (message "(No deletions performed)")
10701         (dolist (i files)
10702           (set-text-properties 0 (length i) nil i)
10703           (anything-c-delete-file i anything-ff-signal-error-on-dot-files))
10704         (message "%s File(s) deleted" len))))
10705
10706 (defun anything-ediff-marked-buffers (candidate &optional merge)
10707   "Ediff 2 marked buffers or CANDIDATE and `anything-current-buffer'.
10708 With optional arg MERGE call `ediff-merge-buffers'."
10709   (let ((lg-lst (length (anything-marked-candidates)))
10710         buf1 buf2)
10711     (case lg-lst
10712       (0
10713        (error "Error:You have to mark at least 1 buffer"))
10714       (1
10715        (setq buf1 anything-current-buffer
10716              buf2 (first (anything-marked-candidates))))
10717       (2
10718        (setq buf1 (first (anything-marked-candidates))
10719              buf2 (second (anything-marked-candidates))))
10720       (t
10721        (error "Error:To much buffers marked!")))
10722     (if merge
10723         (ediff-merge-buffers buf1 buf2)
10724         (ediff-buffers buf1 buf2))))
10725
10726 (defun anything-ediff-marked-buffers-merge (candidate)
10727   "Ediff merge `anything-current-buffer' with CANDIDATE.
10728 See `anything-ediff-marked-buffers'."
10729   (anything-ediff-marked-buffers candidate t))
10730
10731 (defun anything-bookmark-get-bookmark-from-name (bmk)
10732   "Return bookmark name even if it is a bookmark with annotation.
10733 e.g prepended with *.
10734 Return nil if bmk is not a valid bookmark."
10735   (let ((bookmark (replace-regexp-in-string "\*" "" bmk)))
10736     (if (assoc bookmark bookmark-alist)
10737         bookmark
10738         (when (assoc bmk bookmark-alist)
10739           bmk))))
10740
10741 (defun anything-delete-marked-bookmarks (ignore)
10742   "Delete this bookmark or all marked bookmarks."
10743   (dolist (i (anything-marked-candidates))
10744     (bookmark-delete (anything-bookmark-get-bookmark-from-name i)
10745                      'batch)))
10746
10747 (defun anything-require-or-error (feature function)
10748   (or (require feature nil t)
10749       (error "Need %s to use `%s'." feature function)))
10750
10751 (defun anything-find-buffer-on-elscreen (candidate)
10752   "Open buffer in new screen, if marked buffers open all in elscreens."
10753   (anything-require-or-error 'elscreen 'anything-find-buffer-on-elscreen)
10754   (anything-aif (anything-marked-candidates)
10755       (dolist (i it)
10756         (let ((target-screen (elscreen-find-screen-by-buffer
10757                               (get-buffer i) 'create)))
10758           (elscreen-goto target-screen)))
10759     (let ((target-screen (elscreen-find-screen-by-buffer
10760                           (get-buffer candidate) 'create)))
10761       (elscreen-goto target-screen))))
10762
10763 (defun anything-elscreen-find-file (file)
10764   (anything-require-or-error 'elscreen 'anything-elscreen-find-file)
10765   (elscreen-find-file file))
10766
10767 (defun anything-w32-prepare-filename (file)
10768   "Convert filename FILE to something usable by external w32 executables."
10769   (replace-regexp-in-string ; For UNC paths
10770    "/" "\\"
10771    (replace-regexp-in-string ; Strip cygdrive paths
10772     "/cygdrive/\\(.\\)" "\\1:"
10773     file nil nil) nil t))
10774
10775 ;;;###autoload
10776 (defun anything-w32-shell-execute-open-file (file)
10777   (interactive "fOpen file:")
10778   (with-no-warnings
10779     (w32-shell-execute "open" (anything-w32-prepare-filename file))))
10780
10781 (defun anything-c-open-file-with-default-tool (file)
10782   "Open FILE with the default tool on this platform."
10783   (if (eq system-type 'windows-nt)
10784       (anything-w32-shell-execute-open-file file)
10785       (start-process "anything-c-open-file-with-default-tool"
10786                      nil
10787                      (cond ((eq system-type 'gnu/linux)
10788                             "xdg-open")
10789                            ((or (eq system-type 'darwin) ;; Mac OS X
10790                                 (eq system-type 'macos)) ;; Mac OS 9
10791                             "open"))
10792                      file)))
10793
10794 (defun anything-c-open-dired (file)
10795   "Opens a dired buffer in FILE's directory.  If FILE is a
10796 directory, open this directory."
10797   (if (file-directory-p file)
10798       (dired file)
10799       (dired (file-name-directory file))
10800       (dired-goto-file file)))
10801
10802 (defun anything-c-display-to-real-line (candidate)
10803   (if (string-match "^ *\\([0-9]+\\):\\(.*\\)$" candidate)
10804       (list (string-to-number (match-string 1 candidate)) (match-string 2 candidate))
10805       (error "Line number not found")))
10806
10807 (defun anything-c-action-line-goto (lineno-and-content)
10808   (apply #'anything-goto-file-line (anything-interpret-value (anything-attr 'target-file))
10809          (append lineno-and-content
10810                  (list (if (and (anything-attr-defined 'target-file)
10811                                 (not anything-in-persistent-action))
10812                            'find-file-other-window
10813                            'find-file)))))
10814
10815 (defun* anything-c-action-file-line-goto (file-line-content &optional (find-file-function #'find-file))
10816   (apply #'anything-goto-file-line
10817          (if (stringp file-line-content)
10818              ;; Case: filtered-candidate-transformer is skipped
10819              (cdr (anything-c-filtered-candidate-transformer-file-line-1 file-line-content))
10820              file-line-content)))
10821
10822 (require 'compile)
10823 (defun anything-c-filtered-candidate-transformer-file-line (candidates source)
10824   (delq nil (mapcar 'anything-c-filtered-candidate-transformer-file-line-1 candidates)))
10825
10826 (defun anything-c-filtered-candidate-transformer-file-line-1 (candidate)
10827   (when (string-match "^\\(.+?\\):\\([0-9]+\\):\\(.*\\)$" candidate)
10828     (let ((filename (match-string 1 candidate))
10829           (lineno (match-string 2 candidate))
10830           (content (match-string 3 candidate)))
10831       (cons (format "%s:%s\n %s"
10832                     (propertize filename 'face compilation-info-face)
10833                     (propertize lineno 'face compilation-line-face)
10834                     content)
10835             (list (expand-file-name
10836                    filename
10837                    (or (anything-interpret-value (anything-attr 'default-directory))
10838                        (and (anything-candidate-buffer)
10839                             (buffer-local-value
10840                              'default-directory (anything-candidate-buffer)))))
10841                   (string-to-number lineno) content)))))
10842
10843 (defun* anything-goto-file-line (file lineno content &optional (find-file-function #'find-file))
10844   (anything-aif (anything-attr 'before-jump-hook)
10845       (funcall it))
10846   (when file (funcall find-file-function file))
10847   (if (anything-attr-defined 'adjust)
10848       (anything-c-goto-line-with-adjustment
10849        lineno content (not (anything-attr-defined 'recenter)))
10850     (anything-goto-line lineno nil (not (anything-attr-defined 'recenter))))
10851   (anything-aif (anything-attr 'after-jump-hook)
10852       (funcall it))
10853   (when anything-in-persistent-action
10854     (anything-match-line-color-current-line)))
10855
10856 (defun anything-find-file-as-root (candidate)
10857   (find-file (concat "/" anything-su-or-sudo "::" (expand-file-name candidate))))
10858
10859 (defun anything-find-many-files (ignore)
10860   (mapc 'find-file (anything-marked-candidates)))
10861
10862 ;; borrowed from etags.el
10863 ;; (anything-c-goto-line-with-adjustment (line-number-at-pos) ";; borrowed from etags.el")
10864 (defun anything-c-goto-line-with-adjustment (line line-content &optional show-top)
10865   (let ((startpos)
10866         offset found pat)
10867     ;; This constant is 1/2 the initial search window.
10868     ;; There is no sense in making it too small,
10869     ;; since just going around the loop once probably
10870     ;; costs about as much as searching 2000 chars.
10871     (setq offset 1000
10872           found nil
10873           pat (concat (if (eq selective-display t)
10874                           "\\(^\\|\^m\\) *" "^ *") ;allow indent
10875                       (regexp-quote line-content)))
10876     ;; If no char pos was given, try the given line number.
10877     (setq startpos (progn (anything-goto-line line nil show-top) (point)))
10878     (or startpos (setq startpos (point-min)))
10879     ;; First see if the tag is right at the specified location.
10880     (goto-char startpos)
10881     (setq found (looking-at pat))
10882     (while (and (not found)
10883                 (progn
10884                   (goto-char (- startpos offset))
10885                   (not (bobp))))
10886       (setq found
10887             (re-search-forward pat (+ startpos offset) t)
10888             offset (* 3 offset)))       ; expand search window
10889     (or found
10890         (re-search-forward pat nil t)
10891         (error "not found")))
10892   ;; Position point at the right place
10893   ;; if the search string matched an extra Ctrl-m at the beginning.
10894   (and (eq selective-display t)
10895        (looking-at "\^m")
10896        (forward-char 1))
10897   (beginning-of-line))
10898
10899 (anything-document-attribute 'default-directory "type . file-line"
10900                              "`default-directory' to interpret file.")
10901 (anything-document-attribute 'before-jump-hook "type . file-line / line"
10902                              "Function to call before jumping to the target location.")
10903 (anything-document-attribute 'after-jump-hook "type . file-line / line"
10904                              "Function to call after jumping to the target location.")
10905 (anything-document-attribute 'adjust "type . file-line"
10906                              "Search around line matching line contents.")
10907 (anything-document-attribute 'recenter "type . file-line / line"
10908                              "`recenter' after jumping.")
10909 (anything-document-attribute 'target-file "type . line"
10910                              "Goto line of target-file.")
10911
10912 ;;;###autoload
10913 (defun anything-c-call-interactively (cmd-or-name)
10914   "Execute CMD-OR-NAME as Emacs command.
10915 It is added to `extended-command-history'.
10916 `anything-current-prefix-arg' is used as the command's prefix argument."
10917   (setq extended-command-history
10918         (cons (anything-c-stringify cmd-or-name)
10919               (delete (anything-c-stringify cmd-or-name) extended-command-history)))
10920   (let ((current-prefix-arg anything-current-prefix-arg)
10921         (cmd (anything-c-symbolify cmd-or-name)))
10922     (if (stringp (symbol-function cmd))
10923         (execute-kbd-macro (symbol-function cmd))
10924         (setq this-command cmd)
10925         (unwind-protect
10926             (call-interactively cmd)
10927           (run-with-timer 0.1 nil 'set 'last-repeatable-command cmd)))))
10928
10929 ;;;###autoload
10930 (defun anything-c-set-variable (var)
10931   "Set value to VAR interactively."
10932   (interactive)
10933   (let ((sym (anything-c-symbolify var)))
10934     (set sym (eval-minibuffer (format "Set %s: " var)
10935                               (prin1-to-string (symbol-value sym))))))
10936 ;; (setq hh 12)
10937 ;; (anything-c-set-variable 'hh)
10938
10939
10940 \f
10941 ;;; Persistent Action Helpers
10942 ;;
10943 ;;
10944 (defvar anything-match-line-overlay-face nil)
10945 (defvar anything-match-line-overlay nil)
10946
10947 (defun anything-match-line-color-current-line (&optional start end buf face rec)
10948   "Highlight and underline current position"
10949   (let ((args (list (or start (line-beginning-position))
10950                     (or end (1+ (line-end-position)))
10951                     buf)))
10952     (if (not anything-match-line-overlay)
10953         (setq anything-match-line-overlay (apply 'make-overlay args))
10954         (apply 'move-overlay anything-match-line-overlay args)))
10955   (overlay-put anything-match-line-overlay
10956                'face (or face anything-match-line-overlay-face))
10957   (when rec
10958     (goto-char start)
10959     (recenter)))
10960
10961 (defalias 'anything-persistent-highlight-point 'anything-match-line-color-current-line)
10962
10963
10964 (setq anything-match-line-overlay-face 'anything-overlay-line-face)
10965
10966 (defun anything-match-line-cleanup ()
10967   (when anything-match-line-overlay
10968     (delete-overlay anything-match-line-overlay)
10969     (setq anything-match-line-overlay nil)))
10970
10971 (defun anything-match-line-update ()
10972   (when anything-match-line-overlay
10973     (delete-overlay anything-match-line-overlay)
10974     (anything-match-line-color-current-line)))
10975
10976 (add-hook 'anything-cleanup-hook 'anything-match-line-cleanup)
10977 (add-hook 'anything-after-persistent-action-hook 'anything-match-line-update)
10978
10979 \f
10980 ;;; Actions Transformers
10981 ;;
10982 ;;
10983 ;;; Files
10984 (defun anything-c-transform-file-load-el (actions candidate)
10985   "Add action to load the file CANDIDATE if it is an emacs lisp
10986 file.  Else return ACTIONS unmodified."
10987   (if (member (file-name-extension candidate) '("el" "elc"))
10988       (append actions '(("Load Emacs Lisp File" . load-file)))
10989       actions))
10990
10991 (defun anything-c-transform-file-browse-url (actions candidate)
10992   "Add an action to browse the file CANDIDATE if it in a html
10993 file or URL.  Else return ACTIONS unmodified."
10994   (let ((browse-action '("Browse with Browser" . browse-url)))
10995     (cond ((string-match "^http\\|^ftp" candidate)
10996            (cons browse-action actions))
10997           ((string-match "\\.html?$" candidate)
10998            (append actions (list browse-action)))
10999           (t actions))))
11000
11001 ;;; Function
11002 (defun anything-c-transform-function-call-interactively (actions candidate)
11003   "Add an action to call the function CANDIDATE interactively if
11004 it is a command.  Else return ACTIONS unmodified."
11005   (if (commandp (intern-soft candidate))
11006       (append actions '(("Call Interactively"
11007                          .
11008                          anything-c-call-interactively)))
11009       actions))
11010
11011 ;;;; S-Expressions
11012 (defun anything-c-transform-sexp-eval-command-sexp (actions candidate)
11013   "If CANDIDATE's `car' is a command, then add an action to
11014 evaluate it and put it onto the `command-history'."
11015   (if (commandp (car (read candidate)))
11016       ;; Make it first entry
11017       (cons '("Eval and put onto command-history" .
11018               (lambda (sexp)
11019                 (let ((sym (read sexp)))
11020                   (eval sym)
11021                   (setq command-history
11022                         (cons sym command-history)))))
11023             actions)
11024       actions))
11025
11026 \f
11027 ;;; Candidate Transformers
11028 ;;
11029 ;;
11030 ;;; Buffers
11031 (defun anything-c-skip-boring-buffers (buffers)
11032   (anything-c-skip-entries buffers anything-c-boring-buffer-regexp))
11033
11034 (defun anything-c-skip-current-buffer (buffers)
11035   "[DEPRECATED] Skip current buffer in buffer lists.
11036 This transformer should not be used as this is now handled directly
11037 in `anything-c-buffer-list' and `anything-c-highlight-buffers'."
11038   (if anything-allow-skipping-current-buffer
11039       (remove (buffer-name anything-current-buffer) buffers)
11040       buffers))
11041
11042 (defun anything-c-shadow-boring-buffers (buffers)
11043   "Buffers matching `anything-c-boring-buffer-regexp' will be
11044 displayed with the `file-name-shadow' face if available."
11045   (anything-c-shadow-entries buffers anything-c-boring-buffer-regexp))
11046
11047 (defvar anything-c-buffer-display-string-functions
11048   '(anything-c-buffer-display-string--compilation
11049     anything-c-buffer-display-string--shell
11050     anything-c-buffer-display-string--eshell)
11051   "Functions to setup display string for buffer.
11052
11053 Function has one argument, buffer name.
11054 If it returns string, use it.
11055 If it returns nil, display buffer name.
11056 See `anything-c-buffer-display-string--compilation' for example.")
11057
11058 (defun anything-c-transform-buffer-display-string (buffers)
11059   "Setup display string for buffer candidates
11060 using `anything-c-buffer-display-string-functions'."
11061   (loop for buf in buffers
11062         if (consp buf)
11063         collect buf
11064         else
11065         for disp = (progn (set-buffer buf)
11066                           (run-hook-with-args-until-success
11067                            'anything-c-buffer-display-string-functions buf))
11068         collect (if disp (cons disp buf) buf)))
11069
11070 (defun anything-c-buffer-display-string--compilation (buf)
11071   (anything-aif (car compilation-arguments)
11072       (format "%s: %s [%s]" buf it default-directory)))
11073
11074 (defun anything-c-buffer-display-string--eshell (buf)
11075   (declare (special eshell-history-ring))
11076   (when (eq major-mode 'eshell-mode)
11077     (format "%s: %s [%s]" buf
11078             (ignore-errors (ring-ref eshell-history-ring 0))
11079             default-directory)))
11080
11081 (defun anything-c-buffer-display-string--shell (buf)
11082   (when (eq major-mode 'shell-mode)
11083     (format "%s: %s [%s]" buf
11084             (ignore-errors (ring-ref comint-input-ring 0))
11085             default-directory)))
11086
11087 ;;; Files
11088 (defun anything-c-shadow-boring-files (files)
11089   "Files matching `anything-c-boring-file-regexp' will be
11090 displayed with the `file-name-shadow' face if available."
11091   (anything-c-shadow-entries files anything-c-boring-file-regexp))
11092
11093 (defun anything-c-skip-boring-files (files)
11094   "Files matching `anything-c-boring-file-regexp' will be skipped."
11095   (anything-c-skip-entries files anything-c-boring-file-regexp))
11096 ;; (anything-c-skip-boring-files '("README" "/src/.svn/hoge"))
11097
11098 (defun anything-c-skip-current-file (files)
11099   "Current file will be skipped."
11100   (remove (buffer-file-name anything-current-buffer) files))
11101
11102 (defun anything-c-w32-pathname-transformer (args)
11103   "Change undesirable features of windows pathnames to ones more acceptable to
11104 other candidate transformers."
11105   (if (eq system-type 'windows-nt)
11106       (anything-transform-mapcar
11107        (lambda (x)
11108          (replace-regexp-in-string
11109           "/cygdrive/\\(.\\)" "\\1:"
11110           (replace-regexp-in-string "\\\\" "/" x)))
11111        args)
11112     args))
11113
11114 (defun anything-c-shorten-home-path (files)
11115   "Replaces /home/user with ~."
11116   (let ((home (replace-regexp-in-string "\\\\" "/" ; stupid Windows...
11117                                         (getenv "HOME"))))
11118     (anything-transform-mapcar
11119      (lambda (file)
11120        (if (and (stringp file) (string-match home file))
11121            (replace-match "~" nil nil file)
11122          file))
11123      files)))
11124
11125 ;;; Functions
11126 (defun anything-c-mark-interactive-functions (functions)
11127   "Mark interactive functions (commands) with (i) after the function name."
11128   (let (list)
11129     (loop for function in functions
11130           do (push (cons (concat function
11131                                  (when (commandp (intern-soft function)) " (i)"))
11132                          function)
11133                    list)
11134           finally (return (nreverse list)))))
11135
11136 \f
11137 ;;; Adaptive Sorting of Candidates
11138 ;;
11139 ;;
11140 ;; Internal
11141 (defvar anything-c-adaptive-done nil
11142   "nil if history information is not yet stored for the current
11143 selection.")
11144
11145 (defvar anything-c-adaptive-history nil
11146   "Contains the stored history information.
11147 Format: ((SOURCE-NAME (SELECTED-CANDIDATE (PATTERN . NUMBER-OF-USE) ...) ...) ...)")
11148
11149 ;; Should run at beginning of `anything-initial-setup'.
11150 (add-hook 'anything-before-initialize-hook #'(lambda ()
11151                                                (when anything-c-use-adaptative-sorting
11152                                                  (setq anything-c-adaptive-done nil))))
11153
11154 ;; Should run at beginning of `anything-exit-minibuffer'.
11155 (add-hook 'anything-before-action-hook #'(lambda ()
11156                                           (when anything-c-use-adaptative-sorting
11157                                             (anything-c-adaptive-store-selection))))
11158
11159 ;; Should run at beginning of `anything-select-action'.
11160 (add-hook 'anything-select-action-hook #'(lambda ()
11161                                            (when anything-c-use-adaptative-sorting
11162                                              (anything-c-adaptive-store-selection))))
11163
11164 (defun anything-c-source-use-adaptative-p (&optional source-name)
11165   "Return current source only if it use adaptative history, nil otherwise."
11166   (when anything-c-use-adaptative-sorting
11167     (let* ((source (or source-name (anything-get-current-source)))
11168            (adapt-source (or (assoc-default 'filtered-candidate-transformer
11169                                             (assoc (assoc-default 'type source)
11170                                                    anything-type-attributes))
11171                              (assoc-default 'candidate-transformer
11172                                             (assoc (assoc-default 'type source)
11173                                                    anything-type-attributes))
11174                              (assoc-default 'filtered-candidate-transformer source)
11175                              (assoc-default 'candidate-transformer source))))
11176       (if (listp adapt-source)
11177           (when (member 'anything-c-adaptive-sort adapt-source) source)
11178           (when (eq adapt-source 'anything-c-adaptive-sort) source)))))
11179
11180 (defun anything-c-adaptive-store-selection ()
11181   "Store history information for the selected candidate."
11182   (unless anything-c-adaptive-done
11183     (setq anything-c-adaptive-done t)
11184     (let ((source (anything-c-source-use-adaptative-p)))
11185       (when source
11186         (let* ((source-name (or (assoc-default 'type source)
11187                                 (assoc-default 'name source)))
11188                (source-info (or (assoc source-name anything-c-adaptive-history)
11189                                 (progn
11190                                   (push (list source-name) anything-c-adaptive-history)
11191                                   (car anything-c-adaptive-history))))
11192                (selection (anything-get-selection))
11193                (selection-info (progn
11194                                  (setcdr source-info
11195                                          (cons
11196                                           (let ((found (assoc selection (cdr source-info))))
11197                                             (if (not found)
11198                                                 ;; new entry
11199                                                 (list selection)
11200
11201                                                 ;; move entry to the beginning of the
11202                                                 ;; list, so that it doesn't get
11203                                                 ;; trimmed when the history is
11204                                                 ;; truncated
11205                                                 (setcdr source-info
11206                                                         (delete found (cdr source-info)))
11207                                                 found))
11208                                           (cdr source-info)))
11209                                  (cadr source-info)))
11210                (pattern-info (progn
11211                                (setcdr selection-info
11212                                        (cons
11213                                         (let ((found (assoc anything-pattern (cdr selection-info))))
11214                                           (if (not found)
11215                                               ;; new entry
11216                                               (cons anything-pattern 0)
11217
11218                                               ;; move entry to the beginning of the
11219                                               ;; list, so if two patterns used the
11220                                               ;; same number of times then the one
11221                                               ;; used last appears first in the list
11222                                               (setcdr selection-info
11223                                                       (delete found (cdr selection-info)))
11224                                               found))
11225                                         (cdr selection-info)))
11226                                (cadr selection-info))))
11227
11228           ;; increase usage count
11229           (setcdr pattern-info (1+ (cdr pattern-info)))
11230
11231           ;; truncate history if needed
11232           (if (> (length (cdr selection-info)) anything-c-adaptive-history-length)
11233               (setcdr selection-info
11234                       (subseq (cdr selection-info) 0 anything-c-adaptive-history-length))))))))
11235
11236 (defun anything-c-adaptative-maybe-load-history ()
11237   (when (and anything-c-use-adaptative-sorting
11238              (file-readable-p anything-c-adaptive-history-file))
11239     (load-file anything-c-adaptive-history-file)))
11240
11241 (add-hook 'emacs-startup-hook 'anything-c-adaptative-maybe-load-history)
11242 (add-hook 'kill-emacs-hook 'anything-c-adaptive-save-history)
11243
11244 (defun anything-c-adaptive-save-history (&optional arg)
11245   "Save history information to file given by `anything-c-adaptive-history-file'."
11246   (interactive "p")
11247   (when anything-c-use-adaptative-sorting
11248     (with-temp-buffer
11249       (insert
11250        ";; -*- mode: emacs-lisp -*-\n"
11251        ";; History entries used for anything adaptive display.\n")
11252       (prin1 `(setq anything-c-adaptive-history ',anything-c-adaptive-history)
11253              (current-buffer))
11254       (insert ?\n)
11255       (write-region (point-min) (point-max) anything-c-adaptive-history-file nil
11256                     (unless arg 'quiet)))))
11257
11258 (defun anything-c-adaptive-sort (candidates source)
11259   "Sort the CANDIDATES for SOURCE by usage frequency.
11260 This is a filtered candidate transformer you can use for the
11261 attribute `filtered-candidate-transformer' of a source in
11262 `anything-sources' or a type in `anything-type-attributes'."
11263   (let* ((source-name (or (assoc-default 'type source)
11264                           (assoc-default 'name source)))
11265          (source-info (assoc source-name anything-c-adaptive-history)))
11266     (if source-info
11267         (let ((usage
11268                ;; ... assemble a list containing the (CANIDATE . USAGE-COUNT)
11269                ;; pairs
11270                (mapcar (lambda (candidate-info)
11271                          (let ((count 0))
11272                            (dolist (pattern-info (cdr candidate-info))
11273                              (if (not (equal (car pattern-info)
11274                                              anything-pattern))
11275                                  (incf count (cdr pattern-info))
11276
11277                                  ;; if current pattern is equal to the previously
11278                                  ;; used one then this candidate has priority
11279                                  ;; (that's why its count is boosted by 10000) and
11280                                  ;; it only has to compete with other candidates
11281                                  ;; which were also selected with the same pattern
11282                                  (setq count (+ 10000 (cdr pattern-info)))
11283                                  (return)))
11284                            (cons (car candidate-info) count)))
11285                        (cdr source-info)))
11286               sorted)
11287           (if (and usage (consp usage))
11288               ;; sort the list in descending order, so candidates with highest
11289               ;; priorty come first
11290               (progn
11291                 (setq usage (sort usage (lambda (first second)
11292                                           (> (cdr first) (cdr second)))))
11293
11294                 ;; put those candidates first which have the highest usage count
11295                 (dolist (info usage)
11296                   (when (member* (car info) candidates
11297                                  :test 'anything-c-adaptive-compare)
11298                     (push (car info) sorted)
11299                     (setq candidates (remove* (car info) candidates
11300                                               :test 'anything-c-adaptive-compare))))
11301
11302                 ;; and append the rest
11303                 (append (reverse sorted) candidates nil))
11304               (message "Your `%s' is maybe corrupted or too old, \
11305 you should reinitialize it with `anything-c-reset-adaptative-history'"
11306                        anything-c-adaptive-history-file)
11307               (sit-for 1)
11308               candidates))
11309         ;; if there is no information stored for this source then do nothing
11310         candidates)))
11311
11312 ;;;###autoload
11313 (defun anything-c-reset-adaptative-history ()
11314   "Delete all `anything-c-adaptive-history' and his file.
11315 Useful when you have a old or corrupted `anything-c-adaptive-history-file'."
11316   (interactive)
11317   (when (y-or-n-p "Really delete all your `anything-c-adaptive-history'? ")
11318     (setq anything-c-adaptive-history nil)
11319     (delete-file anything-c-adaptive-history-file)))
11320
11321 (defun anything-c-adaptive-compare (x y)
11322   "Compare candidates X and Y taking into account that the
11323 candidate can be in (DISPLAY . REAL) format."
11324   (equal (if (listp x)
11325              (cdr x)
11326              x)
11327          (if (listp y)
11328              (cdr y)
11329              y)))
11330
11331
11332 \f
11333 ;;; Outliner
11334 ;;
11335 ;;
11336 (defvar anything-outline-goto-near-line-flag t)
11337 (defvar anything-outline-using nil)
11338 (defun anything-after-update-hook--outline ()
11339   (if (and (eq anything-outline-using t)
11340            (eq anything-outline-goto-near-line-flag t))
11341       (anything-outline-goto-near-line)))
11342 (add-hook 'anything-after-update-hook 'anything-after-update-hook--outline)
11343
11344 (defun anything-outline-goto-near-line ()
11345   (with-anything-window
11346     ;; TODO need consideration whether to update position by every input.
11347     (unless (anything-empty-buffer-p) ;  when t                   ; (equal anything-pattern "")
11348       (anything-goto-line 2)
11349       (let ((lineno (with-anything-current-buffer
11350                       (line-number-at-pos (car anything-current-position)))))
11351         (block exit
11352           (while (<= (progn (skip-chars-forward " ")
11353                             (or (number-at-point) lineno))
11354                      lineno)
11355             (forward-line 1)
11356             (when (eobp)
11357               (forward-line -1)
11358               (return-from exit))))
11359         (forward-line -1)
11360         (and (bobp) (forward-line 1))
11361         (and (anything-pos-header-line-p) (forward-line -2))
11362         (anything-mark-current-line)))))
11363
11364
11365 \f
11366 ;;; Plug-in
11367 ;;
11368 ;;
11369 ;; Plug-in: info-index
11370 (defun* anything-c-info-init (&optional (file (anything-attr 'info-file)))
11371   (let (result)
11372     (unless (anything-candidate-buffer)
11373       (save-window-excursion
11374         (info file)
11375         (let (Info-history
11376               (tobuf (anything-candidate-buffer 'global))
11377               (infobuf (current-buffer))
11378               s e)
11379           (dolist (node (or (anything-attr 'index-nodes) (Info-index-nodes)))
11380             (Info-goto-node node)
11381             (goto-char (point-min))
11382             (while (search-forward "\n* " nil t)
11383               (unless (search-forward "Menu:\n" (1+ (point-at-eol)) t)
11384                 '(save-current-buffer (buffer-substring-no-properties (point-at-bol) (point-at-eol)) result)
11385                 (setq s (point-at-bol)
11386                       e (point-at-eol))
11387                 (with-current-buffer tobuf
11388                   (insert-buffer-substring infobuf s e)
11389                   (insert "\n"))))))))))
11390
11391 (defun anything-c-info-goto (node-line)
11392   (Info-goto-node (car node-line))
11393   (anything-goto-line (cdr node-line)))
11394
11395 (defun anything-c-info-display-to-real (line)
11396   (and (string-match
11397         ;; This regexp is stolen from Info-apropos-matches
11398         "\\* +\\([^\n]*.+[^\n]*\\):[ \t]+\\([^\n]*\\)\\.\\(?:[ \t\n]*(line +\\([0-9]+\\))\\)?" line)
11399        (cons (format "(%s)%s" (anything-attr 'info-file) (match-string 2 line))
11400              (string-to-number (or (match-string 3 line) "1")))))
11401
11402 (defun anything-c-make-info-source (source file)
11403   `(,@source
11404     (name . ,(concat "Info Index: " file))
11405     (info-file . ,file)
11406     (init . anything-c-info-init)
11407     (display-to-real . anything-c-info-display-to-real)
11408     (get-line . buffer-substring)
11409     (candidates-in-buffer)
11410     (action ("Goto node" . anything-c-info-goto))))
11411
11412 (defun anything-compile-source--info-index (source)
11413   (anything-aif (anything-interpret-value (assoc-default 'info-index source))
11414       (anything-c-make-info-source source it)
11415     source))
11416 (add-to-list 'anything-compile-source-functions 'anything-compile-source--info-index)
11417
11418 (anything-document-attribute 'info-index "info-index plugin"
11419                              "Create a source of info index very easily.
11420
11421 ex. (defvar anything-c-source-info-wget '((info-index . \"wget\"))")
11422
11423 (anything-document-attribute 'index-nodes "info-index plugin (optional)"
11424                              "Index nodes of info file.
11425
11426 If it is omitted, `Info-index-nodes' is used to collect index nodes.
11427 Some info files are missing index specification.
11428
11429 ex. See `anything-c-source-info-screen'.")
11430
11431 ;; Plug-in: candidates-file
11432 (defun anything-compile-source--candidates-file (source)
11433   (if (assoc-default 'candidates-file source)
11434       `((init anything-p-candidats-file-init
11435               ,@(let ((orig-init (assoc-default 'init source)))
11436                      (cond ((null orig-init) nil)
11437                            ((functionp orig-init) (list orig-init))
11438                            (t orig-init))))
11439         (candidates-in-buffer)
11440         ,@source)
11441       source))
11442 (add-to-list 'anything-compile-source-functions 'anything-compile-source--candidates-file)
11443
11444 (defun anything-p-candidats-file-init ()
11445   (destructuring-bind (file &optional updating)
11446       (anything-mklist (anything-attr 'candidates-file))
11447     (setq file (anything-interpret-value file))
11448     (with-current-buffer (anything-candidate-buffer (find-file-noselect file))
11449       (when updating
11450         (buffer-disable-undo)
11451         (font-lock-mode -1)
11452         (auto-revert-mode 1)))))
11453
11454 (anything-document-attribute 'candidates-file "candidates-file plugin"
11455                              "Use a file as the candidates buffer.
11456
11457 1st argument is a filename, string or function name or variable name.
11458 If optional 2nd argument is non-nil, the file opened with `auto-revert-mode'.")
11459
11460 ;; Plug-in: headline
11461 (defun anything-compile-source--anything-headline (source)
11462   (if (assoc-default 'headline source)
11463       (append '((init . anything-headline-init)
11464                 (get-line . buffer-substring)
11465                 (type . line))
11466               source
11467               '((candidates-in-buffer)
11468                 (persistent-help . "Show this line")))
11469       source))
11470 (add-to-list 'anything-compile-source-functions 'anything-compile-source--anything-headline)
11471
11472 (defun anything-headline-init ()
11473   (when (and (anything-current-buffer-is-modified)
11474              (with-anything-current-buffer
11475                (eval (or (anything-attr 'condition) t))))
11476     (anything-headline-make-candidate-buffer
11477      (anything-interpret-value (anything-attr 'headline))
11478      (anything-interpret-value (anything-attr 'subexp)))))
11479
11480 (anything-document-attribute 'headline "Headline plug-in"
11481                              "Regexp string for anything-headline to scan.")
11482 (anything-document-attribute 'condition "Headline plug-in"
11483                              "A sexp representing the condition to use anything-headline.")
11484 (anything-document-attribute 'subexp "Headline plug-in"
11485                              "Display (match-string-no-properties subexp).")
11486
11487 ;; Le Wang: Note on how `anything-head-line-get-candidates' works with a list
11488 ;; of regexps.
11489 ;;
11490 ;;   1. Create list of ((title . start-of-match) . hiearchy)
11491 ;;   2. Sort this list by start-of-match.
11492 ;;   3. Go through sorted list and return titles that reflect full hiearchy.
11493 ;;
11494 ;; It's quite brilliantly written.
11495 ;;
11496
11497
11498 (defun anything-headline-get-candidates (regexp subexp)
11499   (with-anything-current-buffer
11500     (save-excursion
11501       (goto-char (point-min))
11502       (if (functionp regexp) (setq regexp (funcall regexp)))
11503       (let (hierarchy curhead)
11504         (flet ((matched ()
11505                  (if (numberp subexp)
11506                      (cons (match-string-no-properties subexp) (match-beginning subexp))
11507                      (cons (buffer-substring (point-at-bol) (point-at-eol))
11508                            (point-at-bol))))
11509                (hierarchies (headlines)
11510                  (1+ (loop for (_ . hierarchy) in headlines
11511                            maximize hierarchy)))
11512                (vector-0-n (v n)
11513                  (loop for i from 0 to hierarchy
11514                        collecting (aref curhead i)))
11515                (arrange (headlines)
11516                  (unless (null headlines) ; FIX headlines empty bug!
11517                    (loop with curhead = (make-vector (hierarchies headlines) "")
11518                          for ((str . pt) . hierarchy) in headlines
11519                          do (aset curhead hierarchy str)
11520                          collecting
11521                          (cons
11522                           (format "H%d:%s" (1+ hierarchy)
11523                                   (mapconcat 'identity (vector-0-n curhead hierarchy) " / "))
11524                           pt)))))
11525           (if (listp regexp)
11526               (arrange
11527                (sort
11528                 (loop for re in regexp
11529                       for hierarchy from 0
11530                       do (goto-char (point-min))
11531                       appending
11532                       (loop
11533                             while (re-search-forward re nil t)
11534                             collect (cons (matched) hierarchy)))
11535                 (lambda (a b) (> (cdar b) (cdar a)))))
11536               (loop while (re-search-forward regexp nil t)
11537                     collect (matched))))))))
11538
11539
11540 (defun anything-headline-make-candidate-buffer (regexp subexp)
11541   (with-current-buffer (anything-candidate-buffer 'local)
11542     (loop for (content . pos) in (anything-headline-get-candidates regexp subexp)
11543           do (insert
11544               (format "%5d:%s\n"
11545                       (with-anything-current-buffer
11546                         (line-number-at-pos pos))
11547                       content)))))
11548
11549 (defun anything-headline-goto-position (pos recenter)
11550   (goto-char pos)
11551   (unless recenter
11552     (set-window-start (get-buffer-window anything-current-buffer) (point))))
11553
11554
11555 ;; Plug-in: persistent-help
11556 (defun anything-compile-source--persistent-help (source)
11557   (append source '((header-line . anything-persistent-help-string))))
11558 (add-to-list 'anything-compile-source-functions 'anything-compile-source--persistent-help)
11559
11560 (defun anything-persistent-help-string ()
11561   (substitute-command-keys
11562    (concat "\\<anything-map>\\[anything-execute-persistent-action]: "
11563            (or (anything-interpret-value (anything-attr 'persistent-help))
11564                (anything-aif (or (assoc-default 'persistent-action
11565                                                 (anything-get-current-source))
11566                                  (assoc-default 'action
11567                                                 (anything-get-current-source)))
11568                    (cond ((symbolp it) (symbol-name it))
11569                          ((listp it) (or (ignore-errors (caar it))  ""))))
11570                "")
11571            " (keeping session)")))
11572
11573 (anything-document-attribute 'persistent-help "persistent-help plug-in"
11574                              "A string to explain persistent-action of this source.
11575 It also accepts a function or a variable name.")
11576
11577 ;;; (anything '(((name . "persistent-help test")(candidates "a")(persistent-help . "TEST"))))
11578
11579 ;; Plug-in: Type customize
11580 (defun anything-c-uniq-list (lst)
11581   "Like `remove-duplicates' in CL.
11582 But cut deeper duplicates and test by `equal'. "
11583   (reverse (remove-duplicates (reverse lst) :test 'equal)))
11584 (defvar anything-additional-type-attributes nil)
11585 (defun anything-c-arrange-type-attribute (type spec)
11586   "Override type attributes by `define-anything-type-attribute'.
11587
11588 The SPEC is like source. The symbol `REST' is replaced
11589 with original attribute value.
11590
11591  Example: Set `play-sound-file' as default action
11592    (anything-c-arrange-type-attribute 'file
11593       '((action (\"Play sound\" . play-sound-file)
11594          REST ;; Rest of actions (find-file, find-file-other-window, etc...)."
11595   (setq anything-additional-type-attributes
11596         (delete (assq type anything-additional-type-attributes)
11597                 anything-additional-type-attributes))
11598   (add-to-list 'anything-additional-type-attributes
11599                (cons type
11600                      (loop with typeattr = (assoc-default
11601                                             type anything-type-attributes)
11602                            for (attr . value) in spec
11603                            if (listp value)
11604                            collect (cons attr
11605                                          (anything-c-uniq-list
11606                                           (loop for v in value
11607                                                 if (eq v 'REST)
11608                                                 append
11609                                                 (assoc-default attr typeattr)
11610                                                 else
11611                                                 collect v)))
11612                            else
11613                            collect (cons attr value)))))
11614 (put 'anything-c-arrange-type-attribute 'lisp-indent-function 1)
11615
11616 (defun anything-compile-source--type-customize (source)
11617   (anything-aif (assoc-default 'type source)
11618       (append source
11619               (assoc-default it anything-additional-type-attributes)
11620               (assoc-default it anything-type-attributes)
11621               nil)
11622     source))
11623 (setq anything-compile-source-functions
11624       (delete 'anything-compile-source--type anything-compile-source-functions))
11625 (add-to-list 'anything-compile-source-functions
11626              'anything-compile-source--type-customize t)
11627
11628 ;; Plug-in: default-action
11629 (defun anything-compile-source--default-action (source)
11630   (anything-aif (assoc-default 'default-action source)
11631       (append `((action ,it ,@(remove it (assoc-default 'action source))))
11632               source)
11633     source))
11634 (add-to-list 'anything-compile-source-functions
11635              'anything-compile-source--default-action t)
11636 (anything-document-attribute 'default-action "default-action plug-in"
11637                              "Default action.")
11638
11639 \f
11640 ;;; Type Attributes
11641 ;;
11642 ;;
11643 (define-anything-type-attribute 'buffer
11644     `((action
11645        ("Switch to buffer" . anything-c-switch-to-buffer)
11646        ,(and (locate-library "popwin") '("Switch to buffer in popup window" . popwin:popup-buffer))
11647        ("Switch to buffer other window" . switch-to-buffer-other-window)
11648        ("Switch to buffer other frame" . switch-to-buffer-other-frame)
11649        ,(and (locate-library "elscreen") '("Display buffer in Elscreen" . anything-find-buffer-on-elscreen))
11650        ("Query replace regexp" . anything-c-buffer-query-replace-regexp)
11651        ("Query replace" . anything-c-buffer-query-replace)
11652        ("View buffer" . view-buffer)
11653        ("Display buffer"   . display-buffer)
11654        ("Grep buffers (C-u grep all buffers)" . anything-c-zgrep-buffers)
11655        ("Revert buffer(s)" . anything-revert-marked-buffers)
11656        ("Insert buffer" . insert-buffer)
11657        ("Kill buffer(s)" . anything-kill-marked-buffers)
11658        ("Diff with file" . diff-buffer-with-file)
11659        ("Ediff Marked buffers" . anything-ediff-marked-buffers)
11660        ("Ediff Merge marked buffers" . (lambda (candidate)
11661                                          (anything-ediff-marked-buffers candidate t))))
11662       (persistent-help . "Show this buffer")
11663       (candidate-transformer anything-c-skip-boring-buffers
11664                              anything-c-transform-buffer-display-string))
11665   "Buffer or buffer name.")
11666
11667 (define-anything-type-attribute 'file
11668     `((action
11669        ("Find file" . anything-find-many-files)
11670        ,(and (locate-library "popwin") '("Find file in popup window" . popwin:find-file))
11671        ("Find file as root" . anything-find-file-as-root)
11672        ("Find file other window" . find-file-other-window)
11673        ("Find file other frame" . find-file-other-frame)
11674        ("Open dired in file's directory" . anything-c-open-dired)
11675        ("Grep File(s) `C-u recurse'" . anything-find-files-grep)
11676        ("Zgrep File(s) `C-u Recurse'" . anything-ff-zgrep)
11677        ("Pdfgrep File(s)" . anything-ff-pdfgrep)
11678        ("Checksum File" . anything-ff-checksum)
11679        ("Ediff File" . anything-find-files-ediff-files)
11680        ("Ediff Merge File" . anything-find-files-ediff-merge-files)
11681        ("View file" . view-file)
11682        ("Insert file" . insert-file)
11683        ("Delete file(s)" . anything-delete-marked-files)
11684        ("Open file externally (C-u to choose)" . anything-c-open-file-externally)
11685        ("Open file with default tool" . anything-c-open-file-with-default-tool)
11686        ("Find file in hex dump" . hexl-find-file))
11687       (persistent-help . "Show this file")
11688       (action-transformer anything-c-transform-file-load-el
11689                           anything-c-transform-file-browse-url)
11690       (candidate-transformer anything-c-w32-pathname-transformer
11691                              anything-c-skip-current-file
11692                              anything-c-skip-boring-files
11693                              anything-c-shorten-home-path))
11694   "File name.")
11695
11696 (let ((actions '(("Describe command" . describe-function)
11697                  ("Add command to kill ring" . anything-c-kill-new)
11698                  ("Go to command's definition" . find-function)
11699                  ("Debug on entry" . debug-on-entry)
11700                  ("Cancel debug on entry" . cancel-debug-on-entry)
11701                  ("Trace function" . trace-function)
11702                  ("Trace function (background)" . trace-function-background)
11703                  ("Untrace function" . untrace-function))))
11704   (define-anything-type-attribute 'command
11705       `((action ("Call interactively" . anything-c-call-interactively)
11706                 ,@actions)
11707         (coerce . anything-c-symbolify)
11708         (persistent-action . describe-function))
11709     "Command. (string or symbol)")
11710
11711   (define-anything-type-attribute 'function
11712       `((action . ,actions)
11713         (action-transformer anything-c-transform-function-call-interactively)
11714         (candidate-transformer anything-c-mark-interactive-functions)
11715         (coerce . anything-c-symbolify))
11716     "Function. (string or symbol)"))
11717
11718 (define-anything-type-attribute 'variable
11719     '((action ("Describe variable" . describe-variable)
11720        ("Add variable to kill ring" . anything-c-kill-new)
11721        ("Go to variable's definition" . find-variable)
11722        ("Set variable" . anything-c-set-variable))
11723       (coerce . anything-c-symbolify))
11724   "Variable.")
11725
11726 (define-anything-type-attribute 'sexp
11727     '((action ("Eval s-expression" . (lambda (c) (eval (read c))))
11728        ("Add s-expression to kill ring" . kill-new))
11729       (action-transformer anything-c-transform-sexp-eval-command-sexp))
11730   "String representing S-Expressions.")
11731
11732 (define-anything-type-attribute 'bookmark
11733     `((coerce . anything-bookmark-get-bookmark-from-name)
11734       (action
11735        ("Jump to bookmark" . anything-c-bookmark-jump)
11736        ("Jump to BM other window" . bookmark-jump-other-window)
11737        ("Bookmark edit annotation" . bookmark-edit-annotation)
11738        ("Bookmark show annotation" . bookmark-show-annotation)
11739        ("Delete bookmark(s)" . anything-delete-marked-bookmarks)
11740        ,@(and (locate-library "bookmark-extensions")
11741               `(("Edit Bookmark" . bmkext-edit-bookmark)))
11742        ("Rename bookmark" . bookmark-rename)
11743        ("Relocate bookmark" . bookmark-relocate))
11744       (keymap . ,anything-c-bookmark-map)
11745       (mode-line . anything-bookmark-mode-line-string))
11746   "Bookmark name.")
11747
11748 (define-anything-type-attribute 'line
11749     '((display-to-real . anything-c-display-to-real-line)
11750       (action ("Go to Line" . anything-c-action-line-goto)))
11751   "LINENO:CONTENT string, eg. \"  16:foo\".
11752
11753 Optional `target-file' attribute is a name of target file.
11754
11755 Optional `before-jump-hook' attribute is a function with no
11756 arguments which is called before jumping to position.
11757
11758 Optional `after-jump-hook' attribute is a function with no
11759 arguments which is called after jumping to position.
11760
11761 If `adjust' attribute is specified, searches the line whose
11762 content is CONTENT near the LINENO.
11763
11764 If `recenter' attribute is specified, the line is displayed at
11765 the center of window, otherwise at the top of window.
11766 ")
11767
11768 (define-anything-type-attribute 'file-line
11769     `((filtered-candidate-transformer anything-c-filtered-candidate-transformer-file-line)
11770       (multiline)
11771       (action ("Go to" . anything-c-action-file-line-goto)))
11772   "FILENAME:LINENO:CONTENT string, eg. \"~/.emacs:16:;; comment\".
11773
11774 Optional `default-directory' attribute is a default-directory
11775 FILENAME is interpreted.
11776
11777 Optional `before-jump-hook' attribute is a function with no
11778 arguments which is called before jumping to position.
11779
11780 Optional `after-jump-hook' attribute is a function with no
11781 arguments which is called after jumping to position.
11782
11783 If `adjust' attribute is specified, searches the line whose
11784 content is CONTENT near the LINENO.
11785
11786 If `recenter' attribute is specified, the line is displayed at
11787 the center of window, otherwise at the top of window.
11788 ")
11789
11790 (define-anything-type-attribute 'timer
11791     '((real-to-display . anything-c-timer-real-to-display)
11792       (action ("Cancel Timer" . cancel-timer)
11793        ("Describe Function" . (lambda (tm) (describe-function (timer--function tm))))
11794        ("Find Function" . (lambda (tm) (find-function (timer--function tm)))))
11795       (persistent-action . (lambda (tm) (describe-function (timer--function tm))))
11796       (persistent-help . "Describe Function"))
11797   "Timer.")
11798
11799 \f
11800 ;;; Default `anything-sources'
11801 ;; Setting `anything-sources' is DEPRECATED, but it seems that newbies
11802 ;; tend to invoke M-x anything directly. So I offer default setting.
11803 (setq anything-sources
11804       '(anything-c-source-buffers-list
11805         anything-c-source-recentf
11806         anything-c-source-files-in-current-dir+))
11807
11808 \f
11809 ;;; Preconfigured Anything
11810 ;;
11811 ;;
11812 ;;;###autoload
11813 (defun anything-mini ()
11814   "Preconfigured `anything' lightweight version \(buffer -> recentf\)."
11815   (interactive)
11816   (anything-other-buffer '(anything-c-source-buffers-list
11817                            anything-c-source-recentf
11818                            anything-c-source-buffer-not-found)
11819                          "*anything mini*"))
11820 ;;;###autoload
11821 (defun anything-for-files ()
11822   "Preconfigured `anything' for opening files.
11823 ffap -> recentf -> buffer -> bookmark -> file-cache -> files-in-current-dir -> locate."
11824   (interactive)
11825   (anything-other-buffer anything-for-files-prefered-list "*anything for files*"))
11826
11827 ;;;###autoload
11828 (defun anything-recentf ()
11829   "Preconfigured `anything' for `recentf'."
11830   (interactive)
11831   (anything-other-buffer 'anything-c-source-recentf "*anything recentf*"))
11832
11833 ;;;###autoload
11834 (defun anything-info-at-point (arg)
11835   "Preconfigured `anything' for searching info at point.
11836 With a prefix-arg insert symbol at point."
11837   (interactive "P")
11838   (let ((anything-c-google-suggest-default-function
11839          'anything-c-google-suggest-emacs-lisp))
11840     (anything :sources '(anything-c-source-info-elisp
11841                          anything-c-source-info-cl
11842                          anything-c-source-info-pages
11843                          anything-c-source-google-suggest)
11844               :input (and arg (thing-at-point 'symbol))
11845               :buffer "*anything info*")))
11846
11847 ;;;###autoload
11848 (defun anything-show-kill-ring ()
11849   "Preconfigured `anything' for `kill-ring'.
11850 It is drop-in replacement of `yank-pop'.
11851 You may bind this command to M-y.
11852 First call open the kill-ring browser, next calls move to next line."
11853   (interactive)
11854   (let ((enable-recursive-minibuffers t))
11855     (anything :sources 'anything-c-source-kill-ring
11856               :buffer "*anything kill-ring*")))
11857
11858 ;;;###autoload
11859 (defun anything-minibuffer-history ()
11860   "Preconfigured `anything' for `minibuffer-history'."
11861   (interactive)
11862   (let ((enable-recursive-minibuffers t))
11863     (anything-other-buffer 'anything-c-source-minibuffer-history
11864                            "*anything minibuffer-history*")))
11865
11866 ;;;###autoload
11867 (defun anything-gentoo ()
11868   "Preconfigured `anything' for gentoo linux."
11869   (interactive)
11870   (anything-other-buffer '(anything-c-source-gentoo
11871                            anything-c-source-use-flags)
11872                          "*anything gentoo*"))
11873
11874 ;;;###autoload
11875 (defun anything-imenu ()
11876   "Preconfigured `anything' for `imenu'."
11877   (interactive)
11878   (anything :sources 'anything-c-source-imenu
11879             :buffer "*anything imenu*"))
11880
11881 ;;;###autoload
11882 (defun anything-google-suggest ()
11883   "Preconfigured `anything' for google search with google suggest."
11884   (interactive)
11885   (anything-other-buffer 'anything-c-source-google-suggest "*anything google*"))
11886
11887 ;;;###autoload
11888 (defun anything-yahoo-suggest ()
11889   "Preconfigured `anything' for Yahoo searching with Yahoo suggest."
11890   (interactive)
11891   (anything-other-buffer 'anything-c-source-yahoo-suggest "*anything yahoo*"))
11892
11893 ;;; Converted from anything-show-*-only
11894 ;;;###autoload
11895 (defun anything-for-buffers ()
11896   "Preconfigured `anything' for buffers."
11897   (interactive)
11898   (anything-other-buffer 'anything-c-source-buffers "*anything for buffers*"))
11899
11900 ;;;###autoload
11901 (defun anything-buffers-list ()
11902   "Preconfigured `anything' to list buffers.
11903 It is an enhanced version of `anything-for-buffers'."
11904   (interactive)
11905   (anything :sources '(anything-c-source-buffers-list
11906                        anything-c-source-buffer-not-found)
11907             :buffer "*anything buffers*" :keymap anything-c-buffer-map))
11908
11909 (defalias 'anything-buffers+ 'anything-buffers-list
11910   "Preconfigured `anything' to list buffers.
11911 It is an alias of `anything-buffers-list'.")
11912
11913 ;;;###autoload
11914 (defun anything-bbdb ()
11915   "Preconfigured `anything' for BBDB.
11916
11917 Needs BBDB.
11918
11919 http://bbdb.sourceforge.net/"
11920   (interactive)
11921   (anything-other-buffer 'anything-c-source-bbdb "*anything bbdb*"))
11922
11923 ;;;###autoload
11924 (defun anything-locate (arg)
11925   "Preconfigured `anything' for Locate.
11926 Note: you can add locate options after entering pattern.
11927 See 'man locate' for valid options.
11928
11929 You can specify a specific database with prefix argument ARG \(C-u\).
11930 Many databases can be used: navigate and mark them.
11931 See also `anything-locate-with-db'.
11932
11933 To create a user specific db, use
11934 \"updatedb -l 0 -o db_path -U directory\".
11935 Where db_path is a filename matched by
11936 `anything-locate-db-file-regexp'."
11937   (interactive "P")
11938   (setq anything-ff-default-directory default-directory)
11939   (anything-locate-1 arg))
11940
11941 ;;;###autoload
11942 (defun anything-w3m-bookmarks ()
11943   "Preconfigured `anything' for w3m bookmark.
11944
11945 Needs w3m and emacs-w3m.
11946
11947 w3m: http://w3m.sourceforge.net/
11948 emacs-w3m: http://emacs-w3m.namazu.org/"
11949   (interactive)
11950   (anything-other-buffer 'anything-c-source-w3m-bookmarks
11951                          "*anything w3m bookmarks*"))
11952
11953 ;;;###autoload
11954 (defun anything-firefox-bookmarks ()
11955   "Preconfigured `anything' for firefox bookmark.
11956 You will have to enable html bookmarks in firefox:
11957 open about:config in firefox and double click on this line to enable value \
11958 to true:
11959
11960 user_pref(\"browser.bookmarks.autoExportHTML\", false);
11961
11962 You should have now:
11963
11964 user_pref(\"browser.bookmarks.autoExportHTML\", true);
11965
11966 After closing firefox, you will be able to browse you bookmarks.
11967 "
11968   (interactive)
11969   (anything-other-buffer 'anything-c-source-firefox-bookmarks
11970                          "*Anything Firefox*"))
11971
11972 ;;;###autoload
11973 (defun anything-colors ()
11974   "Preconfigured `anything' for color."
11975   (interactive)
11976   (anything-other-buffer
11977    '(anything-c-source-colors anything-c-source-customize-face)
11978    "*anything colors*"))
11979
11980 ;;;###autoload
11981 (defun anything-bookmarks ()
11982   "Preconfigured `anything' for bookmarks."
11983   (interactive)
11984   (anything-other-buffer 'anything-c-source-bookmarks "*anything bookmarks*"))
11985
11986 ;;;###autoload
11987 (defun anything-c-pp-bookmarks ()
11988   "Preconfigured `anything' for bookmarks (pretty-printed)."
11989   (interactive)
11990   (anything-other-buffer '(anything-c-source-bookmarks-local
11991                            anything-c-source-bookmarks-su
11992                            anything-c-source-bookmarks-ssh)
11993                          "*anything pp bookmarks*"))
11994
11995 ;;;###autoload
11996 (defun anything-c-insert-latex-math ()
11997   "Preconfigured anything for latex math symbols completion."
11998   (interactive)
11999   (anything-other-buffer 'anything-c-source-latex-math "*anything latex*"))
12000
12001 ;;;###autoload
12002 (defun anything-register ()
12003   "Preconfigured `anything' for Emacs registers."
12004   (interactive)
12005   (anything-other-buffer 'anything-c-source-register "*anything register*"))
12006
12007 ;;;###autoload
12008 (defun anything-man-woman ()
12009   "Preconfigured `anything' for Man and Woman pages."
12010   (interactive)
12011   (anything-other-buffer 'anything-c-source-man-pages "*Anything man woman*"))
12012
12013 ;;;###autoload
12014 (defun anything-org-keywords ()
12015   "Preconfigured `anything' for org keywords."
12016   (interactive)
12017   (anything-other-buffer 'anything-c-source-org-keywords "*org keywords*"))
12018
12019 ;;;###autoload
12020 (defun anything-emms ()
12021   "Preconfigured `anything' for emms sources."
12022   (interactive)
12023   (anything :sources '(anything-c-source-emms-streams
12024                        anything-c-source-emms-files
12025                        anything-c-source-emms-dired)
12026             :buffer "*Anything Emms*"))
12027
12028 ;;;###autoload
12029 (defun anything-eev-anchors ()
12030   "Preconfigured `anything' for eev anchors."
12031   (interactive)
12032   (anything-other-buffer 'anything-c-source-eev-anchor "*Anything eev anchors*"))
12033
12034 ;;;###autoload
12035 (defun anything-bm-list ()
12036   "Preconfigured `anything' for visible bookmarks.
12037
12038 Needs bm.el
12039
12040 http://cvs.savannah.gnu.org/viewvc/*checkout*/bm/bm/bm.el"
12041   (interactive)
12042   (let ((anything-outline-using t))
12043     (anything-other-buffer 'anything-c-source-bm "*anything bm list*")))
12044
12045 ;;;###autoload
12046 (defun anything-timers ()
12047   "Preconfigured `anything' for timers."
12048   (interactive)
12049   (anything-other-buffer '(anything-c-source-absolute-time-timers
12050                            anything-c-source-idle-time-timers)
12051                          "*anything timers*"))
12052
12053 ;;;###autoload
12054 (defun anything-list-emacs-process ()
12055   "Preconfigured `anything' for emacs process."
12056   (interactive)
12057   (anything-other-buffer 'anything-c-source-emacs-process "*anything process*"))
12058
12059 ;;;###autoload
12060 (defun anything-occur ()
12061   "Preconfigured Anything for Occur source.
12062 If region is active, search only in region,
12063 otherwise search in whole buffer."
12064   (interactive)
12065   (let ((anything-compile-source-functions
12066          ;; rule out anything-match-plugin because the input is one regexp.
12067          (delq 'anything-compile-source--match-plugin
12068                (copy-sequence anything-compile-source-functions))))
12069     (anything :sources 'anything-c-source-occur
12070               :buffer "*Anything Occur*"
12071               :history 'anything-c-grep-history)))
12072
12073 ;;;###autoload
12074 (defun anything-browse-code ()
12075   "Preconfigured anything to browse code."
12076   (interactive)
12077   (anything :sources 'anything-c-source-browse-code
12078             :buffer "*anything browse code*"
12079             :default (thing-at-point 'symbol)))
12080
12081 ;;;###autoload
12082 (defun anything-org-headlines ()
12083   "Preconfigured anything to show org headlines."
12084   (interactive)
12085   (anything-other-buffer 'anything-c-source-org-headline "*org headlines*"))
12086
12087 ;;;###autoload
12088 (defun anything-regexp ()
12089   "Preconfigured anything to build regexps.
12090 `query-replace-regexp' can be run from there against found regexp."
12091   (interactive)
12092   (save-restriction
12093     (let ((anything-compile-source-functions
12094            ;; rule out anything-match-plugin because the input is one regexp.
12095            (delq 'anything-compile-source--match-plugin
12096                  (copy-sequence anything-compile-source-functions))))
12097       (when (and (anything-region-active-p)
12098                  ;; Don't narrow to region if buffer is already narrowed.
12099                  (not (anything-current-buffer-narrowed-p)))
12100         (narrow-to-region (region-beginning) (region-end)))
12101       (anything :sources anything-c-source-regexp
12102                 :buffer "*anything regexp*"
12103                 :prompt "Regexp: "
12104                 :history 'anything-build-regexp-history))))
12105
12106 ;;;###autoload
12107 (defun anything-c-copy-files-async ()
12108   "Preconfigured anything to copy file list FLIST to DEST asynchronously."
12109   (interactive)
12110   (let* ((flist (anything-c-read-file-name
12111                  "Copy File async: "
12112                  :marked-candidates t))
12113          (dest  (anything-c-read-file-name
12114                  "Copy File async To: "
12115                  :preselect (car flist)
12116                  :initial-input (car anything-ff-history)
12117                  :history (anything-find-files-history :comp-read nil))))
12118     (anything-c-copy-async-with-log flist dest)))
12119
12120 ;;;###autoload
12121 (defun anything-find-files (arg)
12122   "Preconfigured `anything' for anything implementation of `find-file'.
12123 Called with a prefix arg show history if some.
12124 Don't call it from programs, use `anything-find-files-1' instead.
12125 This is the starting point for nearly all actions you can do on files."
12126   (interactive "P")
12127   (let ((any-input (if (and arg anything-ff-history)
12128                        (anything-find-files-history)
12129                        (anything-find-files-initial-input)))
12130         (presel    (buffer-file-name (current-buffer))))
12131     (when (and (eq major-mode 'org-agenda-mode)
12132                org-directory
12133                (not any-input))
12134       (setq any-input (expand-file-name org-directory)))
12135     (set-text-properties 0 (length any-input) nil any-input)
12136     (if any-input
12137         (anything-find-files-1 any-input)
12138         (setq any-input (expand-file-name (anything-c-current-directory)))
12139         (anything-find-files-1
12140          any-input (if anything-ff-transformer-show-only-basename
12141                        (and presel (anything-c-basename presel))
12142                        presel)))))
12143
12144 ;;;###autoload
12145 (defun anything-write-file ()
12146   "Preconfigured `anything' providing completion for `write-file'."
12147   (interactive)
12148   (let ((anything-mp-highlight-delay nil))
12149     (anything :sources 'anything-c-source-write-file
12150               :input (expand-file-name default-directory)
12151               :prompt "Write buffer to file: "
12152               :buffer "*Anything write file*")))
12153
12154 ;;;###autoload
12155 (defun anything-insert-file ()
12156   "Preconfigured `anything' providing completion for `insert-file'."
12157   (interactive)
12158   (let ((anything-mp-highlight-delay nil))
12159     (anything :sources 'anything-c-source-insert-file
12160               :input (expand-file-name default-directory)
12161               :prompt "Insert file: "
12162               :buffer "*Anything insert file*")))
12163
12164 ;;;###autoload
12165 (defun anything-dired-rename-file ()
12166   "Preconfigured `anything' to rename files from dired."
12167   (interactive)
12168   (anything-dired-do-action-on-file :action 'rename))
12169
12170 ;;;###autoload
12171 (defun anything-dired-copy-file ()
12172   "Preconfigured `anything' to copy files from dired."
12173   (interactive)
12174   (anything-dired-do-action-on-file :action 'copy))
12175
12176 ;;;###autoload
12177 (defun anything-dired-symlink-file ()
12178   "Preconfigured `anything' to symlink files from dired."
12179   (interactive)
12180   (anything-dired-do-action-on-file :action 'symlink))
12181
12182 ;;;###autoload
12183 (defun anything-dired-hardlink-file ()
12184   "Preconfigured `anything' to hardlink files from dired."
12185   (interactive)
12186   (anything-dired-do-action-on-file :action 'hardlink))
12187
12188 ;;;###autoload
12189 (defun anything-do-grep ()
12190   "Preconfigured anything for grep.
12191 Contrarily to Emacs `grep' no default directory is given, but
12192 the full path of candidates in ONLY.
12193 That allow to grep different files not only in `default-directory' but anywhere
12194 by marking them (C-<SPACE>). If one or more directory is selected
12195 grep will search in all files of these directories.
12196 You can use also wildcard in the base name of candidate.
12197 If a prefix arg is given use the -r option of grep.
12198 The prefix arg can be passed before or after start.
12199 See also `anything-do-grep-1'."
12200   (interactive)
12201   (let ((only    (anything-c-read-file-name
12202                   "Search in file(s): "
12203                   :marked-candidates t
12204                   :preselect (or (dired-get-filename nil t)
12205                                  (buffer-file-name (current-buffer)))))
12206         (prefarg (or current-prefix-arg anything-current-prefix-arg)))
12207     (anything-do-grep-1 only prefarg)))
12208
12209 ;;;###autoload
12210 (defun anything-do-zgrep ()
12211   "Preconfigured anything for zgrep."
12212   (interactive)
12213   (let ((prefarg (or current-prefix-arg anything-current-prefix-arg))
12214         (ls (anything-c-read-file-name
12215              "Search in file(s): "
12216              :marked-candidates t
12217              :preselect (or (dired-get-filename nil t)
12218                             (buffer-file-name (current-buffer))))))
12219     (anything-ff-zgrep-1 ls prefarg)))
12220
12221 ;;;###autoload
12222 (defun anything-do-pdfgrep ()
12223   "Preconfigured anything for pdfgrep."
12224   (interactive)
12225   (let ((only (anything-c-read-file-name
12226                "Search in file(s): "
12227                :marked-candidates t
12228                :test #'(lambda (file)
12229                          (or (string= (file-name-extension file) "pdf")
12230                              (string= (file-name-extension file) "PDF")
12231                              (file-directory-p file)))
12232                :preselect (or (dired-get-filename nil t)
12233                               (buffer-file-name (current-buffer)))))
12234         (anything-c-grep-default-function 'anything-c-pdfgrep-init))
12235     (anything-do-pdfgrep-1 only)))
12236
12237 ;;;###autoload
12238 (defun anything-c-etags-select (arg)
12239   "Preconfigured anything for etags.
12240 Called with one prefix arg use symbol at point as initial input.
12241 Called with two prefix arg reinitialize cache.
12242 If tag file have been modified reinitialize cache."
12243   (interactive "P")
12244   (let ((tag  (anything-c-etags-get-tag-file))
12245         (init (and (equal arg '(4)) (thing-at-point 'symbol)))
12246         (anything-quit-if-no-candidate t)
12247         (anything-execute-action-at-once-if-one t)
12248         (anything-compile-source-functions
12249          (if anything-c-etags-use-regexp-search
12250              ;; rule out anything-match-plugin because the input is one regexp.
12251              (delq 'anything-compile-source--match-plugin
12252                    (copy-sequence anything-compile-source-functions))
12253              anything-compile-source-functions)))
12254     (when (or (equal arg '(16))
12255               (and anything-c-etags-mtime-alist
12256                    (anything-c-etags-file-modified-p tag)))
12257       (remhash tag anything-c-etags-cache))
12258     (if (and tag (file-exists-p tag))
12259         (anything :sources 'anything-c-source-etags-select
12260                   :keymap anything-c-etags-map
12261                   :input init
12262                   :buffer "*anything etags*")
12263         (message "Error: No tag file found, please create one with etags shell command."))))
12264
12265 ;;;###autoload
12266 (defun anything-filelist ()
12267   "Preconfigured `anything' to open files instantly.
12268
12269 See `anything-c-filelist-file-name' docstring for usage."
12270   (interactive)
12271   (anything-other-buffer 'anything-c-source-filelist "*anything file list*"))
12272
12273 ;;;###autoload
12274 (defun anything-filelist+ ()
12275   "Preconfigured `anything' to open files/buffers/bookmarks instantly.
12276
12277 This is a replacement for `anything-for-files'.
12278 See `anything-c-filelist-file-name' docstring for usage."
12279   (interactive)
12280   (anything-other-buffer
12281    '(anything-c-source-ffap-line
12282      anything-c-source-ffap-guesser
12283      anything-c-source-buffers-list
12284      anything-c-source-recentf
12285      anything-c-source-bookmarks
12286      anything-c-source-file-cache
12287      anything-c-source-filelist)
12288    "*anything file list*"))
12289
12290 ;;;###autoload
12291 (defun anything-M-x ()
12292   "Preconfigured `anything' for Emacs commands.
12293 It is `anything' replacement of regular `M-x' `execute-extended-command'."
12294   (interactive)
12295   (let* (in-help
12296          help-cand
12297          special-display-buffer-names
12298          special-display-regexps
12299          anything-persistent-action-use-special-display
12300          (history (loop with hist
12301                         for i in extended-command-history
12302                         for com = (intern i)
12303                         when (fboundp com)
12304                         collect i into hist finally return hist)))
12305     (flet ((pers-help (candidate)
12306              (let ((hbuf (get-buffer (help-buffer))))
12307                (if (and in-help (string= candidate help-cand))
12308                    (progn
12309                      ;; When M-x is started from a help buffer,
12310                      ;; Don't kill it as it is anything-current-buffer.
12311                      (unless (equal hbuf anything-current-buffer)
12312                        (kill-buffer hbuf))
12313                      (setq in-help nil))
12314                    ;; Be sure anything-current-buffer
12315                    ;; have not a dedicated window.
12316                    (set-window-dedicated-p
12317                     (get-buffer-window anything-current-buffer) nil)
12318                    (describe-function (intern candidate))
12319                    (message nil) ; Erase the new stupid message Type "q"[...]
12320                    (setq in-help t))
12321                (setq help-cand candidate))))
12322       (let* ((command (anything-comp-read
12323                        "M-x " obarray
12324                        :test 'commandp
12325                        :requires-pattern anything-M-x-requires-pattern
12326                        :name "Emacs Commands"
12327                        :buffer "*anything M-x*"
12328                        :persistent-action 'pers-help
12329                        :persistent-help "Describe this command"
12330                        :history history
12331                        :must-match t
12332                        :candidates-in-buffer t
12333                        :fc-transformer 'anything-M-x-transformer))
12334              (sym-com (intern command)))
12335         (unless current-prefix-arg
12336           (setq current-prefix-arg anything-current-prefix-arg))
12337         ;; Avoid having `this-command' set to *exit-minibuffer.
12338         (setq this-command sym-com)
12339         (call-interactively sym-com)
12340         (setq extended-command-history
12341               (cons command (delete command history)))))))
12342
12343 ;;;###autoload
12344 (defun anything-manage-advice ()
12345   "Preconfigured `anything' to disable/enable function advices."
12346   (interactive)
12347   (anything-other-buffer 'anything-c-source-advice "*anything advice*"))
12348
12349 ;;;###autoload
12350 (defun anything-bookmark-ext ()
12351   "Preconfigured `anything' for bookmark-extensions sources.
12352 Needs bookmark-ext.el:
12353 <http://mercurial.intuxication.org/hg/emacs-bookmark-extension>.
12354 Contain also `anything-c-source-google-suggest'."
12355   (interactive)
12356   (anything
12357    :sources
12358    '(anything-c-source-bookmark-files&dirs
12359      anything-c-source-bookmark-w3m
12360      anything-c-source-google-suggest
12361      anything-c-source-bmkext-addressbook
12362      anything-c-source-bookmark-gnus
12363      anything-c-source-bookmark-info
12364      anything-c-source-bookmark-man
12365      anything-c-source-bookmark-images
12366      anything-c-source-bookmark-su-files&dirs
12367      anything-c-source-bookmark-ssh-files&dirs)
12368    :prompt "SearchBookmark: "
12369    :buffer "*anything bmkext*"))
12370
12371 ;;;###autoload
12372 (defun anything-simple-call-tree ()
12373   "Preconfigured `anything' for simple-call-tree. List function relationships.
12374
12375 Needs simple-call-tree.el.
12376 http://www.emacswiki.org/cgi-bin/wiki/download/simple-call-tree.el"
12377   (interactive)
12378   (anything-other-buffer
12379    '(anything-c-source-simple-call-tree-functions-callers
12380      anything-c-source-simple-call-tree-callers-functions)
12381    "*anything simple-call-tree*"))
12382
12383 ;;;###autoload
12384 (defun anything-mark-ring ()
12385   "Preconfigured `anything' for `anything-c-source-mark-ring'."
12386   (interactive)
12387   (anything :sources 'anything-c-source-mark-ring))
12388
12389 ;;;###autoload
12390 (defun anything-global-mark-ring ()
12391   "Preconfigured `anything' for `anything-c-source-global-mark-ring'."
12392   (interactive)
12393   (anything :sources 'anything-c-source-global-mark-ring))
12394
12395 ;;;###autoload
12396 (defun anything-all-mark-rings ()
12397   "Preconfigured `anything' for `anything-c-source-global-mark-ring' and \
12398 `anything-c-source-mark-ring'."
12399   (interactive)
12400   (anything :sources '(anything-c-source-mark-ring
12401                        anything-c-source-global-mark-ring)))
12402
12403 ;;;###autoload
12404 (defun anything-yaoddmuse-emacswiki-edit-or-view ()
12405   "Preconfigured `anything' to edit or view EmacsWiki page.
12406
12407 Needs yaoddmuse.el.
12408
12409 http://www.emacswiki.org/emacs/download/yaoddmuse.el"
12410   (interactive)
12411   (anything :sources 'anything-c-source-yaoddmuse-emacswiki-edit-or-view))
12412
12413 ;;;###autoload
12414 (defun anything-yaoddmuse-emacswiki-post-library ()
12415   "Preconfigured `anything' to post library to EmacsWiki.
12416
12417 Needs yaoddmuse.el.
12418
12419 http://www.emacswiki.org/emacs/download/yaoddmuse.el"
12420   (interactive)
12421   (anything :sources 'anything-c-source-yaoddmuse-emacswiki-post-library))
12422
12423 ;;;###autoload
12424 (defun anything-eval-expression (arg)
12425   "Preconfigured anything for `anything-c-source-evaluation-result'."
12426   (interactive "P")
12427   (anything :sources 'anything-c-source-evaluation-result
12428             :input (when arg (thing-at-point 'sexp))
12429             :buffer "*anything eval*"
12430             :history 'anything-eval-expression-input-history
12431             :keymap anything-eval-expression-map))
12432
12433 ;;;###autoload
12434 (defun anything-eval-expression-with-eldoc ()
12435   "Preconfigured anything for `anything-c-source-evaluation-result' with `eldoc' support. "
12436   (interactive)
12437   (declare (special eldoc-idle-delay))
12438   (let ((timer (run-with-idle-timer eldoc-idle-delay
12439                                     'repeat 'anything-eldoc-show-in-eval))
12440         (minibuffer-completing-symbol t) ; Enable lisp completion.
12441         (completion-cycle-threshold t))  ; Always cycle, no pesty completion buffer (emacs24 only).
12442     (unwind-protect
12443          (minibuffer-with-setup-hook
12444              'anything-eldoc-store-minibuffer
12445            (call-interactively 'anything-eval-expression))
12446       (and timer (cancel-timer timer))
12447       (setq anything-eldoc-active-minibuffers-list
12448             (cdr anything-eldoc-active-minibuffers-list)))))
12449
12450 ;;;###autoload
12451 (defun anything-calcul-expression ()
12452   "Preconfigured anything for `anything-c-source-calculation-result'."
12453   (interactive)
12454   (anything-other-buffer 'anything-c-source-calculation-result "*anything calcul*"))
12455
12456 ;;;###autoload
12457 (defun anything-surfraw (pattern engine)
12458   "Preconfigured `anything' to search PATTERN with search ENGINE."
12459   (interactive (list (read-string "SearchFor: "
12460                                   nil 'anything-surfraw-input-history)
12461                      (anything-comp-read
12462                       "Engine: "
12463                       (anything-c-build-elvi-list)
12464                       :must-match t
12465                       :name "Surfraw Search Engines"
12466                       :history anything-surfraw-engines-history)))
12467   (let* ((engine-nodesc (car (split-string engine)))
12468          (url (with-temp-buffer
12469                 (apply 'call-process "surfraw" nil t nil
12470                        ;;JAVE
12471                        (append  (list engine-nodesc "-p") (split-string pattern)))
12472                 (replace-regexp-in-string
12473                  "\n" "" (buffer-string))))
12474          (browse-url-browser-function (or anything-surfraw-default-browser-function
12475                                           browse-url-browser-function)))
12476     (if (string= engine-nodesc "W")
12477         (anything-c-browse-url anything-c-home-url)
12478         (anything-c-browse-url url)
12479         (setq anything-surfraw-engines-history
12480               (cons engine (delete engine anything-surfraw-engines-history))))))
12481
12482 ;;;###autoload
12483 (defun anything-call-source ()
12484   "Preconfigured `anything' to call anything source."
12485   (interactive)
12486   (anything :sources 'anything-c-source-call-source
12487             :buffer anything-source-select-buffer))
12488
12489 ;;;###autoload
12490 (defun anything-execute-anything-command ()
12491   "Preconfigured `anything' to execute preconfigured `anything'."
12492   (interactive)
12493   (anything-other-buffer 'anything-c-source-anything-commands
12494                          "*anything commands*"))
12495
12496 ;;;###autoload
12497 (defun anything-create (&optional string initial-input)
12498   "Preconfigured `anything' to do many create actions from STRING.
12499 See also `anything-create--actions'."
12500   (interactive)
12501   (setq string (or string (read-string "Create Anything: " initial-input)))
12502   (anything :sources '(((name . "Anything Create")
12503                         (header-name . (lambda (_) (format "Action for \"%s\"" string)))
12504                         (candidates . anything-create--actions)
12505                         (candidate-number-limit)
12506                         (action . (lambda (func) (funcall func string)))))))
12507
12508 ;;;###autoload
12509 (defun anything-top ()
12510   "Preconfigured `anything' for top command."
12511   (interactive)
12512   (let ((anything-samewindow t)
12513         (anything-enable-shortcuts)
12514         (anything-display-function 'anything-default-display-buffer)
12515         (anything-candidate-number-limit 9999))
12516     (save-window-excursion
12517       (delete-other-windows)
12518       (anything-other-buffer 'anything-c-source-top "*anything top*"))))
12519
12520 ;;;###autoload
12521 (defun anything-select-xfont ()
12522   "Preconfigured `anything' to select Xfont."
12523   (interactive)
12524   (anything-other-buffer 'anything-c-source-xfonts "*anything select* xfont"))
12525
12526 ;;;###autoload
12527 (defun anything-world-time ()
12528   "Preconfigured `anything' to show world time."
12529   (interactive)
12530   (anything-other-buffer 'anything-c-source-time-world "*anything world time*"))
12531
12532 ;;;###autoload
12533 (defun anything-apt (arg)
12534   "Preconfigured `anything' : frontend of APT package manager.
12535 With a prefix arg reload cache."
12536   (interactive "P")
12537   (let ((query (read-string "Search Package: " nil 'anything-c-apt-input-history)))
12538     (when arg (anything-c-apt-refresh))
12539     (anything :sources 'anything-c-source-apt
12540               :prompt "Search Package: "
12541               :input query
12542               :history 'anything-c-apt-input-history)))
12543
12544 ;;;###autoload
12545 (defun anything-esh-pcomplete ()
12546   "Preconfigured anything to provide anything completion in eshell."
12547   (interactive)
12548   (let* ((anything-quit-if-no-candidate t)
12549          (anything-execute-action-at-once-if-one t)
12550          (target (thing-at-point 'symbol))
12551          (end (point))
12552          (beg (or (and target (- end (length target)))
12553                   ;; Nothing at point.
12554                   (progn (insert " ") (point)))))
12555     (setq anything-ec-target (or target " "))
12556     (with-anything-show-completion beg end
12557       (anything :sources 'anything-c-source-esh
12558                 :buffer "*anything pcomplete*"
12559                 :input (anything-ff-set-pattern ; Handle tramp filenames.
12560                         (car (last (ignore-errors ; Needed in lisp symbols completion.
12561                                      (pcomplete-parse-arguments)))))))))
12562
12563 ;;;###autoload
12564 (defun anything-eshell-history ()
12565   "Preconfigured anything for eshell history."
12566   (interactive)
12567   (let* ((end (point))
12568          (beg (save-excursion (eshell-bol) (point)))
12569          (input (buffer-substring beg end))
12570          flag-empty)
12571     (when (eq beg end)
12572       (insert " ")
12573       (setq flag-empty t)
12574       (setq end (point)))
12575     (unwind-protect
12576          (with-anything-show-completion beg end
12577            (anything :sources 'anything-c-source-eshell-history
12578                      :buffer "*Eshell history*"
12579                      :input input))
12580       (when (and flag-empty
12581                  (looking-back " "))
12582         (delete-char -1)))))
12583
12584 ;;;###autoload
12585 (defun anything-c-run-external-command (program)
12586   "Preconfigured `anything' to run External PROGRAM asyncronously from Emacs.
12587 If program is already running exit with error.
12588 You can set your own list of commands with
12589 `anything-c-external-commands-list'."
12590   (interactive (list
12591                 (anything-comp-read
12592                  "RunProgram: "
12593                  (anything-c-external-commands-list-1 'sort)
12594                  :must-match t
12595                  :name "External Commands"
12596                  :history anything-external-command-history)))
12597   (anything-run-or-raise program)
12598   (setq anything-external-command-history
12599         (cons program (delete program
12600                               (loop for i in anything-external-command-history
12601                                     when (executable-find i) collect i)))))
12602
12603 ;;;###autoload
12604 (defun anything-ratpoison-commands ()
12605   "Preconfigured `anything' to execute ratpoison commands."
12606   (interactive)
12607   (anything-other-buffer 'anything-c-source-ratpoison-commands
12608                          "*anything ratpoison commands*"))
12609
12610 ;;;###autoload
12611 (defun anything-ucs ()
12612   "Preconfigured anything for `ucs-names' math symbols."
12613   (interactive)
12614   (anything :sources 'anything-c-source-ucs
12615             :keymap  anything-c-ucs-map))
12616
12617 ;;;###autoload
12618 (defun anything-c-apropos ()
12619   "Preconfigured anything to describe commands, functions, variables and faces."
12620   (interactive)
12621   (let ((default (thing-at-point 'symbol)))
12622     (anything :sources
12623               `(((name . "Commands")
12624                  (init . (lambda ()
12625                            (anything-c-apropos-init 'commandp ,default)))
12626                  (persistent-action . anything-lisp-completion-persistent-action)
12627                  (persistent-help . "Show brief doc in mode-line")
12628                  (candidates-in-buffer)
12629                  (action . (lambda (candidate)
12630                              (describe-function (intern candidate)))))
12631                 ((name . "Functions")
12632                  (init . (lambda ()
12633                            (anything-c-apropos-init #'(lambda (x) (and (fboundp x)
12634                                                                        (not (commandp x))))
12635                                                     ,default)))
12636                  (persistent-action . anything-lisp-completion-persistent-action)
12637                  (persistent-help . "Show brief doc in mode-line")
12638                  (candidates-in-buffer)
12639                  (action . (lambda (candidate)
12640                              (describe-function (intern candidate)))))
12641                 ((name . "Variables")
12642                  (init . (lambda ()
12643                            (anything-c-apropos-init 'boundp ,default)))
12644                  (persistent-action . anything-lisp-completion-persistent-action)
12645                  (persistent-help . "Show brief doc in mode-line")
12646                  (candidates-in-buffer)
12647                  (action . (lambda (candidate)
12648                              (describe-variable (intern candidate)))))
12649                 ((name . "Faces")
12650                  (init . (lambda ()
12651                            (anything-c-apropos-init 'facep ,default)))
12652                  (persistent-action . anything-lisp-completion-persistent-action)
12653                  (persistent-help . "Show brief doc in mode-line")
12654                  (candidates-in-buffer)
12655                  (filtered-candidate-transformer . (lambda (candidates source)
12656                                                      (loop for c in candidates
12657                                                            collect (propertize c 'face (intern c)))))
12658                  (action . (lambda (candidate)
12659                              (describe-face (intern candidate)))))
12660                 ((name . "Anything attributes")
12661                  (candidates . (lambda ()
12662                                  (mapcar 'symbol-name anything-additional-attributes)))
12663                  (action . (lambda (candidate)
12664                              (with-output-to-temp-buffer "*Help*"
12665                                (princ (get (intern candidate) 'anything-attrdoc))))))))))
12666
12667 ;;;###autoload
12668 (defun anything-xrandr-set ()
12669   (interactive)
12670   (anything :sources 'anything-c-source-xrandr-change-resolution
12671             :buffer "*anything xrandr*"))
12672
12673 ;;;###autoload
12674 (defun anything-ctags-current-file ()
12675   "Preconfigured `anything' to list function/variable definitions.
12676
12677 Needs Exuberant Ctags.
12678
12679 http://ctags.sourceforge.net/"
12680   (interactive)
12681   (anything :sources 'anything-c-source-ctags
12682             :buffer "*anything ctags*"))
12683 \f
12684 ;;; Unit tests are now in ../developer-tools/unit-test-anything-config.el.
12685
12686 (provide 'anything-config)
12687
12688 ;; Local Variables:
12689 ;; coding: utf-8
12690 ;; End:
12691
12692 ;;; anything-config.el ends here