anything-config.el

   1 ;;; anything-config.el --- Applications libary for `anything.el'
   2
   3 ;; Filename: anything-config.el
   4
   5 ;; Description: Applications libary for `anything.el'
   6
   7 ;; Author: Tassilo Horn <tassilo@member.fsf.org>
   8
   9 ;; Maintainer: Tassilo Horn <tassilo@member.fsf.org>
  10 ;;             rubikitch    <rubikitch@ruby-lang.org>
  11 ;;             Thierry Volpiatto <thierry.volpiatto@gmail.com>
  12 ;; Copyright (C) 2007 ~ 2011, Tassilo Horn, all rights reserved.
  13 ;; Copyright (C) 2009, Andy Stewart, all rights reserved.
  14 ;; Copyright (C) 2009 ~ 2012, rubikitch, all rights reserved.
  15 ;; Copyright (C) 2009 ~ 2012, Thierry Volpiatto, all rights reserved.
  16
  17 ;; Created: 2009-02-16 21:38:23
  18
  19 ;; X-URL: <http://repo.or.cz/w/anything-config.git>
  20
  21 ;; MailingList: <https://groups.google.com/group/emacs-anything?hl=en>
  22
  23 ;; Keywords: anything, anything-config
  24
  25 ;; Compatibility: GNU Emacs 22 ~ 24
  26
  27 ;; Dependencies: `anything.el', `anything-match-plugin.el'.
  28
  29 ;;; This file is NOT part of GNU Emacs
  30
  31 ;;; License
  32 ;;
  33 ;; This program is free software; you can redistribute it and/or modify
  34 ;; it under the terms of the GNU General Public License as published by
  35 ;; the Free Software Foundation; either version 3, or (at your option)
  36 ;; any later version.
  37
  38 ;; This program is distributed in the hope that it will be useful,
  39 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  40 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  41 ;; GNU General Public License for more details.
  42
  43 ;; You should have received a copy of the GNU General Public License
  44 ;; along with this program; see the file COPYING.  If not, write to
  45 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
  46 ;; Floor, Boston, MA 02110-1301, USA.
  47
  48 ;;; Commentary:
  49 ;;
  50 ;; Predefined configurations for `anything.el'
  51 ;;
  52 ;; For quick start, try `anything-for-files' to open files.
  53 ;;
  54 ;; To configure anything you should define anything command
  55 ;; with your favorite sources, like below:
  56 ;;
  57 ;; (defun my-anything ()
  58 ;;   (interactive)
  59 ;;   (anything-other-buffer
  60 ;;    '(anything-c-source-buffers
  61 ;;      anything-c-source-file-name-history
  62 ;;      anything-c-source-info-pages
  63 ;;      anything-c-source-info-elisp
  64 ;;      anything-c-source-man-pages
  65 ;;      anything-c-source-locate
  66 ;;      anything-c-source-emacs-commands)
  67 ;;    " *my-anything*"))
  68 ;;
  69 ;; Then type M-x my-anything to use sources.
  70 ;;
  71 ;; Defining own command is better than setup `anything-sources'
  72 ;; directly, because you can define multiple anything commands with
  73 ;; different sources. Each anything command should have own anything
  74 ;; buffer, because M-x anything-resume revives anything command.
  75
  76 ;; NOTE: What you find on Emacswiki is mostly deprecated and not maintained,
  77 ;;       don't complain if you use such code or configuration and something
  78 ;;       doesn't work.
  79
  80 \f
  81 ;;; Autodoc documentation:
  82 ;;  ---------------------
  83
  84 ;;  * Commands defined here are:
  85 ;; [EVAL] (autodoc-document-lisp-buffer :type 'command :prefix "anything-" :docstring t)
  86 ;; `anything-configuration'
  87 ;; Customize `anything'.
  88 ;; `anything-c-buffer-help'
  89 ;; Help command for anything buffers.
  90 ;; `anything-ff-help'
  91 ;; Help command for `anything-find-files'.
  92 ;; `anything-read-file-name-help'
  93 ;; Not documented.
  94 ;; `anything-generic-file-help'
  95 ;; Not documented.
  96 ;; `anything-grep-help'
  97 ;; Not documented.
  98 ;; `anything-pdfgrep-help'
  99 ;; Not documented.
 100 ;; `anything-etags-help'
 101 ;; The help function for etags.
 102 ;; `anything-c-ucs-help'
 103 ;; Help command for `anything-ucs'.
 104 ;; `anything-c-bookmark-help'
 105 ;; Help command for bookmarks.
 106 ;; `anything-show-this-source-only'
 107 ;; Show all candidates of this source.
 108 ;; `anything-test-sources'
 109 ;; List all anything sources for test.
 110 ;; `anything-select-source'
 111 ;; [OBSOLETE] Select source.
 112 ;; `anything-insert-buffer-name'
 113 ;; Insert buffer name.
 114 ;; `anything-quit-and-find-file'
 115 ;; Drop into `anything-find-files' from `anything'.
 116 ;; `anything-mark-all'
 117 ;; Mark all visible unmarked candidates in current source.
 118 ;; `anything-unmark-all'
 119 ;; Unmark all candidates in all sources of current anything session.
 120 ;; `anything-toggle-all-marks'
 121 ;; Toggle all marks.
 122 ;; `anything-buffer-diff-persistent'
 123 ;; Toggle diff buffer without quitting anything.
 124 ;; `anything-buffer-revert-persistent'
 125 ;; Revert buffer without quitting anything.
 126 ;; `anything-buffer-save-persistent'
 127 ;; Save buffer without quitting anything.
 128 ;; `anything-buffer-run-kill-buffers'
 129 ;; Run kill buffer action from `anything-c-source-buffers-list'.
 130 ;; `anything-buffer-run-grep'
 131 ;; Run Grep action from `anything-c-source-buffers-list'.
 132 ;; `anything-buffer-run-zgrep'
 133 ;; Run Grep action from `anything-c-source-buffers-list'.
 134 ;; `anything-buffer-run-query-replace-regexp'
 135 ;; Run Query replace regexp action from `anything-c-source-buffers-list'.
 136 ;; `anything-buffer-run-query-replace'
 137 ;; Run Query replace action from `anything-c-source-buffers-list'.
 138 ;; `anything-buffer-switch-other-window'
 139 ;; Run switch to other window action from `anything-c-source-buffers-list'.
 140 ;; `anything-buffer-switch-other-frame'
 141 ;; Run switch to other frame action from `anything-c-source-buffers-list'.
 142 ;; `anything-buffer-switch-to-elscreen'
 143 ;; Run switch to elscreen  action from `anything-c-source-buffers-list'.
 144 ;; `anything-buffer-run-ediff'
 145 ;; Run ediff action from `anything-c-source-buffers-list'.
 146 ;; `anything-buffer-run-ediff-merge'
 147 ;; Run ediff action from `anything-c-source-buffers-list'.
 148 ;; `anything-ff-run-toggle-auto-update'
 149 ;; Not documented.
 150 ;; `anything-ff-run-switch-to-history'
 151 ;; Run Switch to history action from `anything-c-source-find-files'.
 152 ;; `anything-ff-run-grep'
 153 ;; Run Grep action from `anything-c-source-find-files'.
 154 ;; `anything-ff-run-pdfgrep'
 155 ;; Run Pdfgrep action from `anything-c-source-find-files'.
 156 ;; `anything-ff-run-zgrep'
 157 ;; Run Grep action from `anything-c-source-find-files'.
 158 ;; `anything-ff-run-copy-file'
 159 ;; Run Copy file action from `anything-c-source-find-files'.
 160 ;; `anything-ff-run-rename-file'
 161 ;; Run Rename file action from `anything-c-source-find-files'.
 162 ;; `anything-ff-run-byte-compile-file'
 163 ;; Run Byte compile file action from `anything-c-source-find-files'.
 164 ;; `anything-ff-run-load-file'
 165 ;; Run Load file action from `anything-c-source-find-files'.
 166 ;; `anything-ff-run-eshell-command-on-file'
 167 ;; Run eshell command on file action from `anything-c-source-find-files'.
 168 ;; `anything-ff-run-ediff-file'
 169 ;; Run Ediff file action from `anything-c-source-find-files'.
 170 ;; `anything-ff-run-ediff-merge-file'
 171 ;; Run Ediff merge file action from `anything-c-source-find-files'.
 172 ;; `anything-ff-run-symlink-file'
 173 ;; Run Symlink file action from `anything-c-source-find-files'.
 174 ;; `anything-ff-run-hardlink-file'
 175 ;; Run Hardlink file action from `anything-c-source-find-files'.
 176 ;; `anything-ff-run-delete-file'
 177 ;; Run Delete file action from `anything-c-source-find-files'.
 178 ;; `anything-ff-run-complete-fn-at-point'
 179 ;; Run complete file name action from `anything-c-source-find-files'.
 180 ;; `anything-ff-run-switch-to-eshell'
 181 ;; Run switch to eshell action from `anything-c-source-find-files'.
 182 ;; `anything-ff-run-switch-other-window'
 183 ;; Run switch to other window action from `anything-c-source-find-files'.
 184 ;; `anything-ff-run-switch-other-frame'
 185 ;; Run switch to other frame action from `anything-c-source-find-files'.
 186 ;; `anything-ff-run-open-file-externally'
 187 ;; Run open file externally command action from `anything-c-source-find-files'.
 188 ;; `anything-ff-run-locate'
 189 ;; Run locate action from `anything-c-source-find-files'.
 190 ;; `anything-ff-run-gnus-attach-files'
 191 ;; Run gnus attach files command action from `anything-c-source-find-files'.
 192 ;; `anything-ff-run-etags'
 193 ;; Run Etags command action from `anything-c-source-find-files'.
 194 ;; `anything-ff-run-print-file'
 195 ;; Run Print file action from `anything-c-source-find-files'.
 196 ;; `anything-ff-run-toggle-basename'
 197 ;; Not documented.
 198 ;; `anything-find-files-down-one-level'
 199 ;; Go down one level like unix command `cd ..'.
 200 ;; `anything-ff-properties-persistent'
 201 ;; Show properties without quitting anything.
 202 ;; `anything-ff-persistent-delete'
 203 ;; Delete current candidate without quitting.
 204 ;; `anything-ff-run-kill-buffer-persistent'
 205 ;; Execute `anything-ff-kill-buffer-fname' whitout quitting.
 206 ;; `anything-ff-rotate-left-persistent'
 207 ;; Rotate image left without quitting anything.
 208 ;; `anything-ff-rotate-right-persistent'
 209 ;; Rotate image right without quitting anything.
 210 ;; `anything-c-goto-precedent-file'
 211 ;; Go to precedent file in anything grep/etags buffers.
 212 ;; `anything-c-goto-next-file'
 213 ;; Go to precedent file in anything grep/etags buffers.
 214 ;; `anything-c-grep-run-persistent-action'
 215 ;; Run grep persistent action from `anything-do-grep-1'.
 216 ;; `anything-c-grep-run-default-action'
 217 ;; Run grep default action from `anything-do-grep-1'.
 218 ;; `anything-c-grep-run-other-window-action'
 219 ;; Run grep goto other window action from `anything-do-grep-1'.
 220 ;; `anything-c-grep-run-save-buffer'
 221 ;; Run grep save results action from `anything-do-grep-1'.
 222 ;; `anything-yank-text-at-point'
 223 ;; Yank text at point in minibuffer.
 224 ;; `anything-c-bookmark-run-jump-other-window'
 225 ;; Jump to bookmark from keyboard.
 226 ;; `anything-c-bookmark-run-delete'
 227 ;; Delete bookmark from keyboard.
 228 ;; `anything-c-bmkext-run-edit'
 229 ;; Run `bmkext-edit-bookmark' from keyboard.
 230 ;; `anything-yaoddmuse-cache-pages'
 231 ;; Fetch the list of files on emacswiki and create cache file.
 232 ;; `anything-eval-new-line-and-indent'
 233 ;; Not documented.
 234 ;; `anything-call-source-from-anything'
 235 ;; Call anything source within `anything' session.
 236 ;; `anything-create-from-anything'
 237 ;; Run `anything-create' from `anything' as a fallback.
 238 ;; `anything-c-ucs-persistent-insert'
 239 ;; Not documented.
 240 ;; `anything-c-ucs-persistent-forward'
 241 ;; Not documented.
 242 ;; `anything-c-ucs-persistent-backward'
 243 ;; Not documented.
 244 ;; `anything-c-ucs-persistent-delete'
 245 ;; Not documented.
 246 ;; `anything-lisp-completion-at-point'
 247 ;; Anything lisp symbol completion at point.
 248 ;; `anything-c-complete-file-name-at-point'
 249 ;; Complete file name at point.
 250 ;; `anything-lisp-completion-at-point-or-indent'
 251 ;; First call indent and second call complete lisp symbol.
 252 ;; `anything-lisp-completion-or-file-name-at-point'
 253 ;; Complete lisp symbol or filename at point.
 254 ;; `anything-w32-shell-execute-open-file'
 255 ;; Not documented.
 256 ;; `anything-c-set-variable'
 257 ;; Set value to VAR interactively.
 258 ;; `anything-c-adaptive-save-history'
 259 ;; Save history information to file given by `anything-c-adaptive-history-file'.
 260 ;; `anything-c-reset-adaptative-history'
 261 ;; Delete all `anything-c-adaptive-history' and his file.
 262 ;; `anything-mini'
 263 ;; Preconfigured `anything' lightweight version (buffer -> recentf).
 264 ;; `anything-for-files'
 265 ;; Preconfigured `anything' for opening files.
 266 ;; `anything-recentf'
 267 ;; Preconfigured `anything' for `recentf'.
 268 ;; `anything-info-at-point'
 269 ;; Preconfigured `anything' for searching info at point.
 270 ;; `anything-show-kill-ring'
 271 ;; Preconfigured `anything' for `kill-ring'.
 272 ;; `anything-minibuffer-history'
 273 ;; Preconfigured `anything' for `minibuffer-history'.
 274 ;; `anything-gentoo'
 275 ;; Preconfigured `anything' for gentoo linux.
 276 ;; `anything-imenu'
 277 ;; Preconfigured `anything' for `imenu'.
 278 ;; `anything-google-suggest'
 279 ;; Preconfigured `anything' for google search with google suggest.
 280 ;; `anything-yahoo-suggest'
 281 ;; Preconfigured `anything' for Yahoo searching with Yahoo suggest.
 282 ;; `anything-for-buffers'
 283 ;; Preconfigured `anything' for buffers.
 284 ;; `anything-buffers-list'
 285 ;; Preconfigured `anything' to list buffers.
 286 ;; `anything-bbdb'
 287 ;; Preconfigured `anything' for BBDB.
 288 ;; `anything-locate'
 289 ;; Preconfigured `anything' for Locate.
 290 ;; `anything-w3m-bookmarks'
 291 ;; Preconfigured `anything' for w3m bookmark.
 292 ;; `anything-firefox-bookmarks'
 293 ;; Preconfigured `anything' for firefox bookmark.
 294 ;; `anything-colors'
 295 ;; Preconfigured `anything' for color.
 296 ;; `anything-bookmarks'
 297 ;; Preconfigured `anything' for bookmarks.
 298 ;; `anything-c-pp-bookmarks'
 299 ;; Preconfigured `anything' for bookmarks       (pretty-printed).
 300 ;; `anything-c-insert-latex-math'
 301 ;; Preconfigured anything for latex math symbols completion.
 302 ;; `anything-register'
 303 ;; Preconfigured `anything' for Emacs registers.
 304 ;; `anything-man-woman'
 305 ;; Preconfigured `anything' for Man and Woman pages.
 306 ;; `anything-org-keywords'
 307 ;; Preconfigured `anything' for org keywords.
 308 ;; `anything-emms'
 309 ;; Preconfigured `anything' for emms sources.
 310 ;; `anything-eev-anchors'
 311 ;; Preconfigured `anything' for eev anchors.
 312 ;; `anything-bm-list'
 313 ;; Preconfigured `anything' for visible bookmarks.
 314 ;; `anything-timers'
 315 ;; Preconfigured `anything' for timers.
 316 ;; `anything-list-emacs-process'
 317 ;; Preconfigured `anything' for emacs process.
 318 ;; `anything-occur'
 319 ;; Preconfigured Anything for Occur source.
 320 ;; `anything-browse-code'
 321 ;; Preconfigured anything to browse code.
 322 ;; `anything-org-headlines'
 323 ;; Preconfigured anything to show org headlines.
 324 ;; `anything-regexp'
 325 ;; Preconfigured anything to build regexps.
 326 ;; `anything-c-copy-files-async'
 327 ;; Preconfigured anything to copy file list FLIST to DEST asynchronously.
 328 ;; `anything-find-files'
 329 ;; Preconfigured `anything' for anything implementation of `find-file'.
 330 ;; `anything-write-file'
 331 ;; Preconfigured `anything' providing completion for `write-file'.
 332 ;; `anything-insert-file'
 333 ;; Preconfigured `anything' providing completion for `insert-file'.
 334 ;; `anything-dired-rename-file'
 335 ;; Preconfigured `anything' to rename files from dired.
 336 ;; `anything-dired-copy-file'
 337 ;; Preconfigured `anything' to copy files from dired.
 338 ;; `anything-dired-symlink-file'
 339 ;; Preconfigured `anything' to symlink files from dired.
 340 ;; `anything-dired-hardlink-file'
 341 ;; Preconfigured `anything' to hardlink files from dired.
 342 ;; `anything-do-grep'
 343 ;; Preconfigured anything for grep.
 344 ;; `anything-do-pdfgrep'
 345 ;; Preconfigured anything for pdfgrep.
 346 ;; `anything-c-etags-select'
 347 ;; Preconfigured anything for etags.
 348 ;; `anything-filelist'
 349 ;; Preconfigured `anything' to open files instantly.
 350 ;; `anything-filelist+'
 351 ;; Preconfigured `anything' to open files/buffers/bookmarks instantly.
 352 ;; `anything-M-x'
 353 ;; Preconfigured `anything' for Emacs commands.
 354 ;; `anything-manage-advice'
 355 ;; Preconfigured `anything' to disable/enable function advices.
 356 ;; `anything-bookmark-ext'
 357 ;; Preconfigured `anything' for bookmark-extensions sources.
 358 ;; `anything-simple-call-tree'
 359 ;; Preconfigured `anything' for simple-call-tree. List function relationships.
 360 ;; `anything-mark-ring'
 361 ;; Preconfigured `anything' for `anything-c-source-mark-ring'.
 362 ;; `anything-global-mark-ring'
 363 ;; Preconfigured `anything' for `anything-c-source-global-mark-ring'.
 364 ;; `anything-all-mark-rings'
 365 ;; Preconfigured `anything' for `anything-c-source-global-mark-ring' and `anything-c-source-mark-ring'.
 366 ;; `anything-yaoddmuse-emacswiki-edit-or-view'
 367 ;; Preconfigured `anything' to edit or view EmacsWiki page.
 368 ;; `anything-yaoddmuse-emacswiki-post-library'
 369 ;; Preconfigured `anything' to post library to EmacsWiki.
 370 ;; `anything-eval-expression'
 371 ;; Preconfigured anything for `anything-c-source-evaluation-result'.
 372 ;; `anything-eval-expression-with-eldoc'
 373 ;; Preconfigured anything for `anything-c-source-evaluation-result' with `eldoc' support.
 374 ;; `anything-calcul-expression'
 375 ;; Preconfigured anything for `anything-c-source-calculation-result'.
 376 ;; `anything-surfraw'
 377 ;; Preconfigured `anything' to search PATTERN with search ENGINE.
 378 ;; `anything-call-source'
 379 ;; Preconfigured `anything' to call anything source.
 380 ;; `anything-execute-anything-command'
 381 ;; Preconfigured `anything' to execute preconfigured `anything'.
 382 ;; `anything-create'
 383 ;; Preconfigured `anything' to do many create actions from STRING.
 384 ;; `anything-top'
 385 ;; Preconfigured `anything' for top command.
 386 ;; `anything-select-xfont'
 387 ;; Preconfigured `anything' to select Xfont.
 388 ;; `anything-world-time'
 389 ;; Preconfigured `anything' to show world time.
 390 ;; `anything-apt'
 391 ;; Preconfigured `anything' : frontend of APT package manager.
 392 ;; `anything-esh-pcomplete'
 393 ;; Preconfigured anything to provide anything completion in eshell.
 394 ;; `anything-eshell-history'
 395 ;; Preconfigured anything for eshell history.
 396 ;; `anything-c-run-external-command'
 397 ;; Preconfigured `anything' to run External PROGRAM asyncronously from Emacs.
 398 ;; `anything-ratpoison-commands'
 399 ;; Preconfigured `anything' to execute ratpoison commands.
 400 ;; `anything-ucs'
 401 ;; Preconfigured anything for `ucs-names' math symbols.
 402 ;; `anything-c-apropos'
 403 ;; Preconfigured anything to describe commands, functions, variables and faces.
 404 ;; `anything-xrandr-set'
 405 ;; Not documented.
 406
 407 ;;  * User variables defined here:
 408 ;; [EVAL] (autodoc-document-lisp-buffer :type 'user-variable :prefix "anything-" :var-value t)
 409 ;; `anything-c-adaptive-history-file'
 410 ;; Default Value: "~/.emacs.d/anything-c-adaptive-history"
 411 ;; `anything-c-adaptive-history-length'
 412 ;; Default Value: 50
 413 ;; `anything-c-google-suggest-url'
 414 ;; Default Value: "http://google.com/complete/search?output=toolbar&q="
 415 ;; `anything-c-google-suggest-search-url'
 416 ;; Default Value: "http://www.google.com/search?ie=utf-8&oe=utf-8&q="
 417 ;; `anything-google-suggest-use-curl-p'
 418 ;; Default Value: nil
 419 ;; `anything-c-yahoo-suggest-url'
 420 ;; Default Value: "http://search.yahooapis.com/WebSearchService/V1/relatedSuggestion?appid=G [...]
 421 ;; `anything-c-yahoo-suggest-search-url'
 422 ;; Default Value: "http://search.yahoo.com/search?&ei=UTF-8&fr&h=c&p="
 423 ;; `anything-c-boring-buffer-regexp'
 424 ;; Default Value: "\\   (\\` \\)\\|\\*anything\\|\\*ac-mode\\| \\*Echo Area\\| \\*Minibuf"
 425 ;; `anything-c-boring-file-regexp'
 426 ;; Default Value: "/\\  (?:\\(?:\\.\\(?:git\\|hg\\|svn\\)\\|CVS\\|_darcs\\)\\)\\(?:/\\|$\\)\\| [...]
 427 ;; `anything-kill-ring-threshold'
 428 ;; Default Value: 10
 429 ;; `anything-c-kill-ring-max-lines-number'
 430 ;; Default Value: nil
 431 ;; `anything-su-or-sudo'
 432 ;; Default Value: "su"
 433 ;; `anything-for-files-prefered-list'
 434 ;; Default Value:       (anything-c-source-ffap-line anything-c-source-ffap-guesser anything-c-sou [...]
 435 ;; `anything-create--actions-private'
 436 ;; Default Value: nil
 437 ;; `anything-allow-skipping-current-buffer'
 438 ;; Default Value: nil
 439 ;; `anything-c-enable-eval-defun-hack'
 440 ;; Default Value: t
 441 ;; `anything-tramp-verbose'
 442 ;; Default Value: 0
 443 ;; `anything-raise-command'
 444 ;; Default Value: nil
 445 ;; `anything-command-map-prefix-key'
 446 ;; Default Value: "<f5> a"
 447 ;; `anything-c-browse-code-regexp-lisp'
 448 ;; Default Value: "^ *  (def\\(un\\|subst\\|macro\\|face\\|alias\\|advice\\|struct\\|type\\|th [...]
 449 ;; `anything-c-browse-code-regexp-python'
 450 ;; Default Value: "\\<def\\>\\|\\<class\\>"
 451 ;; `anything-c-browse-code-regexp-alist'
 452 ;; Default Value:       ((lisp-interaction-mode . "^ *(def\\(un\\|subst\\|macro\\|face\\|alias\\|a [...]
 453 ;; `anything-c-external-programs-associations'
 454 ;; Default Value: nil
 455 ;; `anything-ff-auto-update-initial-value'
 456 ;; Default Value: t
 457 ;; `anything-c-copy-async-prefered-emacs'
 458 ;; Default Value: "emacs"
 459 ;; `anything-ff-lynx-style-map'
 460 ;; Default Value: t
 461 ;; `anything-ff-history-max-length'
 462 ;; Default Value: 100
 463 ;; `anything-ff-smart-completion'
 464 ;; Default Value: t
 465 ;; `anything-ff-default-kbsize'
 466 ;; Default Value: 1024.0
 467 ;; `anything-ff-tramp-not-fancy'
 468 ;; Default Value: t
 469 ;; `anything-ff-exif-data-program'
 470 ;; Default Value: "exiftran"
 471 ;; `anything-ff-exif-data-program-args'
 472 ;; Default Value: "-d"
 473 ;; `anything-c-grep-use-ioccur-style-keys'
 474 ;; Default Value: t
 475 ;; `anything-c-pdfgrep-default-read-command'
 476 ;; Default Value: "xpdf '%f' %p"
 477 ;; `anything-c-etags-tag-file-name'
 478 ;; Default Value: "TAGS"
 479 ;; `anything-c-etags-tag-file-search-limit'
 480 ;; Default Value: 10
 481 ;; `anything-c-etags-use-regexp-search'
 482 ;; Default Value: nil
 483 ;; `anything-c-etags-search-regexp'
 484 ;; Default Value: "^.+: .+ \\<%s"
 485 ;; `anything-c-filelist-file-name'
 486 ;; Default Value: nil
 487 ;; `anything-c-eldoc-in-minibuffer-show-fn'
 488 ;; Default Value: anything-c-show-info-in-mode-line
 489 ;; `anything-c-turn-on-show-completion'
 490 ;; Default Value: t
 491 ;; `anything-c-show-completion-use-special-display'
 492 ;; Default Value: t
 493 ;; `anything-c-show-completion-min-window-height'
 494 ;; Default Value: 7
 495 ;; `anything-lisp-completion-or-indent-delay'
 496 ;; Default Value: 0.6
 497 ;; `anything-c-default-external-file-browser'
 498 ;; Default Value: "nautilus"
 499 ;; `anything-c-use-adaptative-sorting'
 500 ;; Default Value: nil
 501 ;; `anything-ff-newfile-prompt-p'
 502 ;; Default Value: t
 503 ;; `anything-ff-avfs-directory'
 504 ;; Default Value: nil
 505 ;; `anything-ff-file-compressed-list'
 506 ;; Default Value:       ("gz" "bz2" "zip" "7z")
 507 ;; `anything-locate-db-file-regexp'
 508 ;; Default Value: "m?locate.db$"
 509 ;; `anything-c-locate-command'
 510 ;; Default Value: nil
 511 ;; `anything-c-show-info-in-mode-line-delay'
 512 ;; Default Value: 12
 513 ;; `anything-c-copy-files-async-log-file'
 514 ;; Default Value: "/tmp/dired.log"
 515 ;; `anything-ff-printer-list'
 516 ;; Default Value: nil
 517 ;; `anything-ff-transformer-show-only-basename'
 518 ;; Default Value: nil
 519 ;; `anything-ff-quick-delete-dont-prompt-for-deletion'
 520 ;; Default Value: nil
 521 ;; `anything-ff-signal-error-on-dot-files'
 522 ;; Default Value: t
 523 ;; `anything-completing-read-handlers-alist'
 524 ;; Default Value:       ((describe-function . anything-completing-read-symbols)  (describe-variabl [...]
 525
 526 ;;  * Anything sources defined here:
 527 ;; [EVAL] (autodoc-document-lisp-buffer :type 'anything-source :prefix "anything-" :any-sname t)
 528 ;; `anything-c-source-regexp'                                   (Regexp Builder)
 529 ;; `anything-c-source-buffers'                                  (Buffers)
 530 ;; `anything-c-source-buffer-not-found'                         (Create buffer)
 531 ;; `anything-c-source-buffers-list'                             (Buffers)
 532 ;; `anything-c-source-file-name-history'                        (File Name History)
 533 ;; `anything-c-source-files-in-current-dir'                     (Files from Current Directory)
 534 ;; `anything-c-source-files-in-current-dir+'                    (Files from Current Directory)
 535 ;; `anything-c-source-find-files'                               (Find Files)
 536 ;; `anything-c-source-write-file'                               (Write File)
 537 ;; `anything-c-source-insert-file'                              (Insert File)
 538 ;; `anything-c-source-copy-files'                               (Copy Files)
 539 ;; `anything-c-source-symlink-files'                            (Symlink Files)
 540 ;; `anything-c-source-hardlink-files'                           (Hardlink Files)
 541 ;; `anything-c-source-file-cache'                               (File Cache)
 542 ;; `anything-c-source-locate'                                   (Locate)
 543 ;; `anything-c-source-recentf'                                  (Recentf)
 544 ;; `anything-c-source-ffap-guesser'                             (File at point)
 545 ;; `anything-c-source-ffap-line'                                (File/Lineno at point)
 546 ;; `anything-c-source-files-in-all-dired'                       (Files in all dired buffer.)
 547 ;; `anything-c-source-filelist'                                 (FileList)
 548 ;; `anything-c-source-info-pages'                               (Info Pages)
 549 ;; `anything-c-source-man-pages'                                (Manual Pages)
 550 ;; `anything-c-source-complex-command-history'                  (Complex Command History)
 551 ;; `anything-c-source-extended-command-history'                 (Emacs Commands History)
 552 ;; `anything-c-source-emacs-commands'                           (Emacs Commands)
 553 ;; `anything-c-source-emacs-functions'                          (Emacs Functions)
 554 ;; `anything-c-source-emacs-functions-with-abbrevs'             (Emacs Functions)
 555 ;; `anything-c-source-advice'                                   (Function Advice)
 556 ;; `anything-c-source-emacs-variables'                          (Emacs Variables)
 557 ;; `anything-c-source-lacarte'                                  (Lacarte)
 558 ;; `anything-c-source-bookmarks'                                (Bookmarks)
 559 ;; `anything-c-source-bookmark-set'                             (Set Bookmark)
 560 ;; `anything-c-source-bm'                                       (Visible Bookmarks)
 561 ;; `anything-c-source-bookmarks-ssh'                            (Bookmarks-ssh)
 562 ;; `anything-c-source-bookmarks-su'                             (Bookmarks-root)
 563 ;; `anything-c-source-bookmarks-local'                          (Bookmarks-Local)
 564 ;; `anything-c-source-bmkext-addressbook'                       (Bookmark Addressbook)
 565 ;; `anything-c-source-bookmark-w3m'                             (Bookmark W3m)
 566 ;; `anything-c-source-bookmark-images'                          (Bookmark Images)
 567 ;; `anything-c-source-bookmark-man'                             (Bookmark Woman&Man)
 568 ;; `anything-c-source-bookmark-gnus'                            (Bookmark Gnus)
 569 ;; `anything-c-source-bookmark-info'                            (Bookmark Info)
 570 ;; `anything-c-source-bookmark-files&dirs'                      (Bookmark Files&Directories)
 571 ;; `anything-c-source-bookmark-su-files&dirs'                   (Bookmark Root-Files&Directories)
 572 ;; `anything-c-source-bookmark-ssh-files&dirs'                  (Bookmark Ssh-Files&Directories)
 573 ;; `anything-c-source-firefox-bookmarks'                        (Firefox Bookmarks)
 574 ;; `anything-c-source-w3m-bookmarks'                            (W3m Bookmarks)
 575 ;; `anything-c-source-elisp-library-scan'                       (Elisp libraries (Scan))
 576 ;; `anything-c-source-imenu'                                    (Imenu)
 577 ;; `anything-c-source-ctags'                                    (Exuberant ctags)
 578 ;; `anything-c-source-etags-select'                             (Etags)
 579 ;; `anything-c-source-semantic'                                 (Semantic Tags)
 580 ;; `anything-c-source-simple-call-tree-functions-callers'       (Function is called by)
 581 ;; `anything-c-source-simple-call-tree-callers-functions'       (Function calls)
 582 ;; `anything-c-source-commands-and-options-in-file'             (Commands/Options in file)
 583 ;; `anything-c-source-customize-face'                           (Customize Face)
 584 ;; `anything-c-source-colors'                                   (Colors)
 585 ;; `anything-c-source-tracker-search'                           (Tracker Search)
 586 ;; `anything-c-source-mac-spotlight'                            (mdfind)
 587 ;; `anything-c-source-picklist'                                 (Picklist)
 588 ;; `anything-c-source-kill-ring'                                (Kill Ring)
 589 ;; `anything-c-source-mark-ring'                                (mark-ring)
 590 ;; `anything-c-source-global-mark-ring'                         (global-mark-ring)
 591 ;; `anything-c-source-register'                                 (Registers)
 592 ;; `anything-c-source-latex-math'                               (Latex Math Menu)
 593 ;; `anything-c-source-fixme'                                    (TODO/FIXME/DRY comments)
 594 ;; `anything-c-source-rd-headline'                              (RD HeadLine)
 595 ;; `anything-c-source-oddmuse-headline'                         (Oddmuse HeadLine)
 596 ;; `anything-c-source-emacs-source-defun'                       (Emacs Source DEFUN)
 597 ;; `anything-c-source-emacs-lisp-expectations'                  (Emacs Lisp Expectations)
 598 ;; `anything-c-source-emacs-lisp-toplevels'                     (Emacs Lisp Toplevel / Level 4 Comment / Linkd Star)
 599 ;; `anything-c-source-yaoddmuse-emacswiki-edit-or-view'         (Yaoddmuse Edit or View (EmacsWiki))
 600 ;; `anything-c-source-yaoddmuse-emacswiki-post-library'         (Yaoddmuse Post library (EmacsWiki))
 601 ;; `anything-c-source-eev-anchor'                               (Anchors)
 602 ;; `anything-c-source-org-headline'                             (Org HeadLine)
 603 ;; `anything-c-source-org-keywords'                             (Org Keywords)
 604 ;; `anything-c-source-bbdb'                                     (BBDB)
 605 ;; `anything-c-source-evaluation-result'                        (Evaluation Result)
 606 ;; `anything-c-source-calculation-result'                       (Calculation Result)
 607 ;; `anything-c-source-google-suggest'                           (Google Suggest)
 608 ;; `anything-c-source-yahoo-suggest'                            (Yahoo Suggest)
 609 ;; `anything-c-source-emms-streams'                             (Emms Streams)
 610 ;; `anything-c-source-emms-dired'                               (Music Directory)
 611 ;; `anything-c-source-emms-files'                               (Emms files)
 612 ;; `anything-c-source-jabber-contacts'                          (Jabber Contacts)
 613 ;; `anything-c-source-call-source'                              (Call anything source)
 614 ;; `anything-c-source-anything-commands'                        (Preconfigured Anything)
 615 ;; `anything-c-source-occur'                                    (Occur)
 616 ;; `anything-c-source-browse-code'                              (Browse code)
 617 ;; `anything-c-source-create'                                   (Create)
 618 ;; `anything-c-source-minibuffer-history'                       (Minibuffer History)
 619 ;; `anything-c-source-elscreen'                                 (Elscreen)
 620 ;; `anything-c-source-top'                                      (Top (Press C-c C-u to refresh))
 621 ;; `anything-c-source-absolute-time-timers'                     (Absolute Time Timers)
 622 ;; `anything-c-source-idle-time-timers'                         (Idle Time Timers)
 623 ;; `anything-c-source-xrandr-change-resolution'                 (Change Resolution)
 624 ;; `anything-c-source-xfonts'                                   (X Fonts)
 625 ;; `anything-c-source-ucs'                                      (Ucs names)
 626 ;; `anything-c-source-emacs-process'                            (Emacs Process)
 627 ;; `anything-c-source-time-world'                               (Time World List)
 628 ;; `anything-c-source-apt'                                      (APT)
 629 ;; `anything-c-source-gentoo'                                   (Portage sources)
 630 ;; `anything-c-source-use-flags'                                (Use Flags)
 631 ;; `anything-c-source-ratpoison-commands'                       (Ratpoison Commands)
 632 ;; `anything-c-source-esh'                                      (Eshell completions)
 633 ;; `anything-c-source-eshell-history'                           (Eshell history)
 634
 635 ;;  *** END auto-documentation
 636
 637 ;;; For Maintainers:
 638 ;;
 639 ;; Install developer-tools/autodoc.el and
 640 ;; Evaluate (autodoc-update-all) before commit or run it interactively.
 641 ;; This function generates anything-c-source-* / functions / options list.
 642 ;;
 643 ;; [EVAL IT] (autodoc-update-all)
 644 ;;
 645 ;; Please write details documentation about function, then others will
 646 ;; read code more easier.   -- Andy Stewart
 647 ;;
 648
 649 \f
 650 ;;; Change log:
 651 ;;
 652 ;;  Change log of this file is found at
 653 ;;  http://repo.or.cz/w/anything-config.git/history/master:/anything-config.el
 654 ;;
 655 ;;  Change log of this project is found at
 656 ;;  http://repo.or.cz/w/anything-config.git?a=shortlog
 657
 658 ;;; Contributors:
 659 ;;
 660 ;;     Tamas Patrovics
 661 ;;     Tassilo Horn <tassilo@member.fsf.org>
 662 ;;     Vagn Johansen <gonz808@hotmail.com>
 663 ;;     Mathias Dahl <mathias.dahl@gmail.com>
 664 ;;     Bill Clementson <billclem@gmail.com>
 665 ;;     Stefan Kamphausen (see http://www.skamphausen.de for more informations)
 666 ;;     Drew Adams <drew.adams@oracle.com>
 667 ;;     Jason McBrayer <jmcbray@carcosa.net>
 668 ;;     Andy Stewart <lazycat.manatee@gmail.com>
 669 ;;     Thierry Volpiatto <thierry.volpiatto@gmail.com>
 670 ;;     rubikitch <rubikitch@ruby-lang.org>
 671 ;;     Scott Vokes <vokes.s@gmail.com>
 672 ;;     Kenichirou Oyama <k1lowxb@gmail.com>
 673
 674
 675 ;;; TODO
 676 ;;
 677 ;; - Fix documentation, now many functions haven't documentations.
 678 ;;
 679
 680 \f
 681 ;;; Code:
 682
 683 ;;; Require
 684 ;;
 685 ;;
 686 (require 'anything)
 687 (require 'thingatpt)
 688 (require 'ffap)
 689 (require 'cl)
 690 (eval-when-compile (require 'dired))
 691 (require 'dired-aux)
 692 (require 'dired-x)
 693 (require 'tramp)
 694 (require 'grep)
 695 (require 'url)
 696 (require 'xml)
 697 (eval-when-compile (require 'org)) ; Shut up byte compiler about org-directory.
 698 (eval-when-compile (require 'semantic nil t))
 699 (require 'anything-match-plugin)
 700
 701
 702 \f
 703 ;;; Declare external functions
 704 ;;
 705 ;;
 706 (declare-function gnus-dired-attach "ext:gnus-dired.el" (files-to-attach))
 707 (declare-function image-dired-display-image "image-dired.el" (file &optional original-size))
 708 (declare-function image-dired-update-property "image-dired.el" (prop value))
 709 (declare-function woman-file-name-all-completions "woman.el" (topic))
 710 (declare-function Man-getpage-in-background "man.el" (topic))
 711 (declare-function simple-call-tree-analyze "ext:simple-call-tree.el" (&optional test))
 712 (declare-function yaoddmuse-update-pagename "ext:yaoddmuse.el" (&optional unforced))
 713 (declare-function yaoddmuse-get-library-list "ext:yaoddmuse.el" (&optional dirs string))
 714 (declare-function org-get-current-options "ext:org-exp.el")
 715 (declare-function emms-streams "ext:emms-streams")
 716 (declare-function emms-stream-delete-bookmark "ext:emms-streams")
 717 (declare-function emms-stream-add-bookmark "ext:emms-streams" (name url fd type))
 718 (declare-function emms-stream-save-bookmarks-file "ext:emms-streams")
 719 (declare-function emms-stream-quit "ext:emms-streams")
 720 (declare-function with-current-emms-playlist "ext:emms" (&rest body))
 721 (declare-function emms-playlist-tracks-in-region "ext:emms" (beg end))
 722 (declare-function emms-playlist-first "ext:emms")
 723 (declare-function emms-playlist-mode-play-smart "ext:emms-playlist-mode")
 724 (declare-function term-line-mode "term")
 725 (declare-function term-char-mode "term")
 726 (declare-function term-send-input "term")
 727 (declare-function term-send-eof "term")
 728 (declare-function Info-index-nodes "info" (&optional file))
 729 (declare-function Info-goto-node "info" (&optional fork))
 730 (declare-function Info-find-node "info.el" (filename nodename &optional no-going-back))
 731 (declare-function elscreen-find-screen-by-buffer "ext:elscreen.el" (buffer &optional create))
 732 (declare-function elscreen-find-file "ext:elscreen.el" (filename))
 733 (declare-function elscreen-goto "ext:elscreen.el" (screen))
 734 (declare-function semantic-format-tag-summarize "ext:format.el" (tag &optional parent color) t)
 735 (declare-function semantic-tag-components "ext:tag.el" (tag) t)
 736 (declare-function semantic-go-to-tag "ext:tag-file.el" (tag) t)
 737 (declare-function semantic-tag-type "ext:tag-file.el" (tag) t)
 738 (declare-function semantic-tag-class "ext:tag-file.el" (tag) t)
 739 (declare-function bbdb "ext:bbdb-com")
 740 (declare-function bbdb-current-record "ext:bbdb-com")
 741 (declare-function bbdb-redisplay-one-record "ext:bbdb-com")
 742 (declare-function bbdb-record-net "ext:bbdb-com" (string) t)
 743 (declare-function bbdb-current-record "ext:bbdb-com")
 744 (declare-function bbdb-dwim-net-address "ext:bbdb-com")
 745 (declare-function bbdb-records "ext:bbdb-com"
 746                   (&optional dont-check-disk already-in-db-buffer))
 747 (declare-function eshell-read-aliases-list "em-alias")
 748 (declare-function eshell-send-input "esh-mode" (&optional use-region queue-p no-newline))
 749 (declare-function eshell-bol "esh-mode")
 750 (declare-function eldoc-current-symbol "eldoc")
 751 (declare-function eldoc-get-fnsym-args-string "eldoc" (sym &optional index))
 752 (declare-function eldoc-get-var-docstring "eldoc" (sym))
 753 (declare-function eldoc-fnsym-in-current-sexp "eldoc")
 754 (declare-function find-library-name "find-func.el" (library))
 755 (declare-function adoc-construct "ext:auto-document.el" (buf))
 756 (declare-function adoc-first-line "ext:auto-document.el" (str))
 757 (declare-function adoc-prin1-to-string "ext:auto-document.el" (object))
 758 (declare-function secure-hash "ext:fns.c" (algorithm object &optional start end binary))
 759 (declare-function w32-shell-execute "ext:w32fns.c" (operation document &optional parameters show-flag))
 760 (declare-function undo-tree-restore-state-from-register "ext:undo-tree.el" (register))
 761
 762 \f
 763 ;;; compatibility
 764 ;;
 765 ;;
 766 (unless (fboundp 'window-system)
 767   (defun window-system (&optional arg)
 768     window-system))
 769
 770 (unless (fboundp 'make-composed-keymap)
 771   (defun make-composed-keymap (maps &optional parent)
 772     "Construct a new keymap composed of MAPS and inheriting from PARENT.
 773 When looking up a key in the returned map, the key is looked in each
 774 keymap of MAPS in turn until a binding is found.
 775 If no binding is found in MAPS, the lookup continues in PARENT, if non-nil.
 776 As always with keymap inheritance, a nil binding in MAPS overrides
 777 any corresponding binding in PARENT, but it does not override corresponding
 778 bindings in other keymaps of MAPS.
 779 MAPS can be a list of keymaps or a single keymap.
 780 PARENT if non-nil should be a keymap."
 781     `(keymap
 782       ,@(if (keymapp maps) (list maps) maps)
 783       ,@parent)))
 784
 785 (unless (fboundp 'apply-partially)
 786   (defun apply-partially (fun &rest args)
 787     "Return a function that is a partial application of FUN to ARGS.
 788 ARGS is a list of the first N arguments to pass to FUN.
 789 The result is a new function which does the same as FUN, except that
 790 the first N arguments are fixed at the values with which this function
 791 was called."
 792     (lexical-let ((fun fun) (args1 args))
 793       (lambda (&rest args2) (apply fun (append args1 args2))))))
 794
 795 \f
 796 ;;; Customize
 797 ;;
 798 ;;
 799 (defgroup anything-config nil
 800   "Predefined configurations for `anything.el'."
 801   :group 'anything)
 802
 803 (defcustom anything-c-adaptive-history-file
 804   "~/.emacs.d/anything-c-adaptive-history"
 805   "Path of file where history information is stored."
 806   :type 'string
 807   :group 'anything-config)
 808
 809 (defcustom anything-c-adaptive-history-length 50
 810   "Maximum number of candidates stored for a source."
 811   :type 'number
 812   :group 'anything-config)
 813
 814 (defcustom anything-c-google-suggest-url
 815   "http://google.com/complete/search?output=toolbar&q="
 816   "URL used for looking up Google suggestions."
 817   :type 'string
 818   :group 'anything-config)
 819
 820 (defcustom anything-c-google-suggest-search-url
 821   "http://www.google.com/search?ie=utf-8&oe=utf-8&q="
 822   "URL used for Google searching."
 823   :type 'string
 824   :group 'anything-config)
 825
 826 (defcustom anything-google-suggest-use-curl-p nil
 827   "When non--nil use CURL to get info from `anything-c-google-suggest-url'.
 828 Otherwise `url-retrieve-synchronously' is used."
 829   :type 'boolean
 830   :group 'anything-config)
 831
 832 (defcustom anything-c-yahoo-suggest-url
 833   "http://search.yahooapis.com/WebSearchService/V1/relatedSuggestion?appid=Generic&query="
 834   "Url used for looking up Yahoo suggestions."
 835   :type 'string
 836   :group 'anything-config)
 837
 838 (defcustom anything-c-yahoo-suggest-search-url
 839   "http://search.yahoo.com/search?&ei=UTF-8&fr&h=c&p="
 840   "Url used for Yahoo searching."
 841   :type 'string
 842   :group 'anything-config)
 843
 844 (defcustom anything-c-boring-buffer-regexp
 845   (rx (or
 846        (group bos  " ")
 847        ;; anything-buffers
 848        "*anything" "*ac-mode"
 849        ;; echo area
 850        " *Echo Area" " *Minibuf"))
 851   "The regexp that match boring buffers.
 852 Buffer candidates matching this regular expression will be
 853 filtered from the list of candidates if the
 854 `anything-c-skip-boring-buffers' candidate transformer is used, or
 855 they will be displayed with face `file-name-shadow' if
 856 `anything-c-shadow-boring-buffers' is used."
 857   :type 'string
 858   :group 'anything-config)
 859 ;; (string-match anything-c-boring-buffer-regexp "buf")
 860 ;; (string-match anything-c-boring-buffer-regexp " hidden")
 861 ;; (string-match anything-c-boring-buffer-regexp " *Minibuf-1*")
 862
 863 (defcustom anything-c-boring-file-regexp
 864   (rx (or
 865        ;; Boring directories
 866        (and "/" (or ".svn" "CVS" "_darcs" ".git" ".hg") (or "/" eol))
 867        ;; Boring files
 868        (and line-start  ".#")
 869        (and (or ".class" ".la" ".o" "~") eol)))
 870   "The regexp that match boring files.
 871 File candidates matching this regular expression will be
 872 filtered from the list of candidates if the
 873 `anything-c-skip-boring-files' candidate transformer is used, or
 874 they will be displayed with face `file-name-shadow' if
 875 `anything-c-shadow-boring-files' is used."
 876   :type 'string
 877   :group 'anything-config)
 878
 879 (defcustom anything-kill-ring-threshold 10
 880   "Minimum length to be listed by `anything-c-source-kill-ring'."
 881   :type 'integer
 882   :group 'anything-config)
 883
 884 (defcustom anything-c-kill-ring-max-lines-number nil
 885   "Max number of lines displayed per candidate in kill-ring browser.
 886 If nil or zero, don't truncate candidate, show all."
 887   :type 'integer
 888   :group 'anything-config)
 889
 890 (defcustom anything-su-or-sudo "su"
 891   "What command to use for root access."
 892   :type 'string
 893   :group 'anything-config)
 894
 895 (defcustom anything-for-files-prefered-list
 896   '(anything-c-source-ffap-line
 897     anything-c-source-ffap-guesser
 898     anything-c-source-buffers-list
 899     anything-c-source-recentf
 900     anything-c-source-bookmarks
 901     anything-c-source-file-cache
 902     anything-c-source-files-in-current-dir+
 903     anything-c-source-locate)
 904   "Your prefered sources to find files."
 905   :type 'list
 906   :group 'anything-config)
 907
 908 (defcustom anything-create--actions-private nil
 909   "User defined actions for `anything-create' / `anything-c-source-create'.
 910 It is a list of (DISPLAY . FUNCTION) pairs like `action'
 911 attribute of `anything-sources'.
 912
 913 It is prepended to predefined pairs."
 914   :type 'list
 915   :group 'anything-config)
 916
 917 (defcustom anything-allow-skipping-current-buffer nil
 918   "Show current buffer or not in anything buffer"
 919   :type 'boolean
 920   :group 'anything-config)
 921
 922 (defcustom anything-c-enable-eval-defun-hack t
 923   "If non-nil, execute `anything' using the source at point when C-M-x is pressed.
 924 This hack is invoked when pressing C-M-x in the form \
 925  (defvar anything-c-source-XXX ...) or (setq anything-c-source-XXX ...)."
 926   :type 'boolean
 927   :group 'anything-config)
 928
 929 (defcustom anything-tramp-verbose 0
 930   "Just like `tramp-verbose' but specific to anything.
 931 When set to 0 don't show tramp messages in anything.
 932 If you want to have the default tramp messages set it to 3."
 933   :type 'integer
 934   :group 'anything-config)
 935
 936 (defcustom anything-raise-command nil
 937   "A shell command to jump to a window running specific program.
 938 Need external program wmctrl.
 939 This will be use with `format', so use something like \"wmctrl -xa %s\"."
 940   :type 'string
 941   :group 'anything-config)
 942
 943 (defun anything-set-anything-command-map-prefix-key (var key)
 944   "The customize set function for `anything-command-map-prefix-key'."
 945   (when (boundp var)
 946     (define-key global-map (read-kbd-macro (symbol-value var)) nil))
 947   (set var key)
 948   (define-key global-map
 949       (read-kbd-macro (symbol-value var)) 'anything-command-map))
 950
 951 (defcustom anything-command-map-prefix-key "C-x c"
 952   "The prefix key for all `anything-command-map' commands."
 953   :type  'string
 954   :set   'anything-set-anything-command-map-prefix-key
 955   :group 'anything-config)
 956
 957 (defcustom anything-c-browse-code-regexp-lisp
 958   "^ *\(def\\(un\\|subst\\|macro\\|face\\|alias\\|advice\\|struct\\|\
 959 type\\|theme\\|var\\|group\\|custom\\|const\\|method\\|class\\)"
 960   "Regexp used to parse lisp buffer when browsing code."
 961   :type 'string
 962   :group 'anything-config)
 963
 964 (defcustom anything-c-browse-code-regexp-python
 965   "\\<def\\>\\|\\<class\\>"
 966   "Regexp used to parse python buffer when browsing code."
 967   :type 'string
 968   :group 'anything-config)
 969
 970 (defcustom anything-c-browse-code-regexp-alist
 971   `((lisp-interaction-mode . ,anything-c-browse-code-regexp-lisp)
 972     (emacs-lisp-mode . ,anything-c-browse-code-regexp-lisp)
 973     (lisp-mode . ,anything-c-browse-code-regexp-lisp)
 974     (python-mode . ,anything-c-browse-code-regexp-python))
 975   "Alist to store regexps for browsing code corresponding \
 976 to a specific `major-mode'."
 977   :type 'list
 978   :group 'anything-config)
 979
 980 (defcustom anything-c-external-programs-associations nil
 981   "Alist to store externals programs associated with file extension.
 982 This variable overhide setting in .mailcap file.
 983 e.g : '\(\(\"jpg\" . \"gqview\"\) (\"pdf\" . \"xpdf\"\)\) "
 984   :type 'list
 985   :group 'anything-config)
 986
 987 (defcustom anything-ff-auto-update-initial-value t
 988   "Auto update when only one candidate directory is matched.
 989 This is the default value when starting `anything-find-files'."
 990   :group 'anything-config
 991   :type  'boolean)
 992
 993 (defcustom anything-c-copy-async-prefered-emacs "emacs"
 994   "Path to the emacs you want to use for copying async.
 995 Emacs versions < 24 fail to copy directory due to a bug not fixed
 996 in `copy-directory'."
 997   :group 'anything-config
 998   :type 'string)
 999
1000 (defcustom anything-ff-lynx-style-map t
1001   "Use arrow keys to navigate with `anything-find-files'.
1002 You will have to restart Emacs or reeval `anything-find-files-map'
1003 and `anything-c-read-file-map' for this take effect."
1004   :group 'anything-config
1005   :type 'boolean)
1006
1007 (defcustom anything-ff-history-max-length 100
1008   "Number of elements shown in `anything-find-files' history."
1009   :group 'anything-config
1010   :type 'integer)
1011
1012 (defcustom anything-ff-smart-completion t
1013   "Try to complete filenames smarter when non--nil.
1014 See `anything-ff-transform-fname-for-completion' for more info."
1015   :group 'anything-config
1016   :type 'boolean)
1017
1018 (defcustom anything-ff-default-kbsize 1024.0
1019   "Default Kbsize to use for showing files size.
1020 It is a float, usually 1024.0 but could be 1000.0 on some systems."
1021   :group 'anything-config
1022   :type 'float)
1023
1024 (defcustom anything-ff-tramp-not-fancy t
1025   "No colors when listing remote files when set to non--nil.
1026 This make listing much faster, specially on slow machines."
1027   :group 'anything-config
1028   :type  'boolean)
1029
1030 (defcustom anything-ff-exif-data-program "exiftran"
1031   "Program used to extract exif data of an image file."
1032   :group 'anything-config
1033   :type 'string)
1034
1035 (defcustom anything-ff-exif-data-program-args "-d"
1036   "*Arguments used for `anything-ff-exif-data-program'."
1037   :group 'anything-config
1038   :type 'string)
1039
1040 (defcustom anything-c-grep-use-ioccur-style-keys t
1041   "Use Arrow keys to jump to occurences."
1042   :group 'anything-config
1043   :type  'boolean)
1044
1045 (defcustom anything-c-pdfgrep-default-read-command "xpdf '%f' %p"
1046   "Default command to read pdf files from pdfgrep.
1047 Where '%f' format spec is filename and '%p' is page number"
1048   :group 'anything-config
1049   :type  'string)
1050
1051 (defcustom anything-c-etags-tag-file-name "TAGS"
1052   "Etags tag file name."
1053   :type  'string
1054   :group 'anything-config)
1055
1056 (defcustom anything-c-etags-tag-file-search-limit 10
1057   "The limit level of directory to search tag file.
1058 Don't search tag file deeply if outside this value."
1059   :type  'number
1060   :group 'anything-config)
1061
1062 (defcustom anything-c-etags-use-regexp-search nil
1063   "When non--nil search etags candidates by regexp.
1064 This disable anything-match-plugin when enabled.
1065 When nil search is performed directly on patter and *match-plugin is used
1066 if available.  You can customize `anything-c-etags-search-regexp'."
1067   :group 'anything-config
1068   :type  'boolean)
1069
1070 (defcustom anything-c-etags-search-regexp "^.+: .+ \\<%s"
1071   "Regexp that match tags in an anything etags buffer.
1072 The format spec is replaced by pattern.
1073 This regexp have no effect when `anything-c-etags-use-regexp-search'
1074 is nil."
1075   :group 'anything-config
1076   :type  'regexp)
1077
1078 (defcustom anything-c-filelist-file-name nil
1079   "Filename of file list.
1080 Accept a list of string for multiple files.
1081
1082 This file tend to be very large \(> 100MB\) and recommend to be in ramdisk for speed.
1083 File list is created by make-filelist.rb script.
1084
1085 Usage:
1086   ruby make-filelist.rb > /tmp/all.filelist
1087
1088 Then
1089  ;; Assume that /tmp is ramdisk or tmpfs
1090  \(setq anything-grep-candidates-fast-directory-regexp \"^/tmp/\"\)
1091  \(setq anything-c-filelist-file-name \"/tmp/all.filelist\"\)
1092 "
1093   :type 'string
1094   :group 'anything-config)
1095
1096 (defcustom anything-c-eldoc-in-minibuffer-show-fn
1097   'anything-c-show-info-in-mode-line
1098   "A function to display eldoc info.
1099 Should take one arg: the string to display."
1100   :group 'anything-config
1101   :type  'symbol)
1102
1103 (defcustom anything-c-turn-on-show-completion t
1104   "Display candidate in buffer while moving selection when non--nil."
1105   :group 'anything-config
1106   :type  'boolean)
1107
1108 (defcustom anything-c-show-completion-use-special-display t
1109   "A special display will be used in lisp completion if non--nil.
1110 All functions that are wrapped in macro `with-anything-show-completion'
1111 will be affected."
1112   :group 'anything-config
1113   :type  'boolean)
1114
1115 (defcustom anything-c-show-completion-min-window-height 7
1116   "Minimum completion window height used in show completion.
1117 This is used in macro `with-anything-show-completion'."
1118   :group 'anything-config
1119   :type  'integer)
1120
1121 (defcustom anything-lisp-completion-or-indent-delay 0.6
1122   "After this delay `anything-lisp-completion-counter' is reset to 0.
1123 This allow to indent again without completing lisp symbol after this delay.
1124 Default is 0.6 seconds."
1125   :group 'anything-config
1126   :type  'number)
1127
1128 (defcustom anything-c-default-external-file-browser "nautilus"
1129   "Default external file browser for your system.
1130 Directories will be opened externally with it when
1131 opening file externally in `anything-find-files'.
1132 Set to nil if you do not have external file browser
1133 or do not want to use it.
1134 Windows users should set that to \"explorer.exe\"."
1135   :group 'anything-config
1136   :type  'string)
1137
1138 (defcustom anything-c-use-adaptative-sorting nil
1139   "Wheter to use or not adaptative sorting.
1140 Even if a source use it, it will have no effect when set to nil."
1141   :type 'boolean
1142   :group 'anything-config)
1143
1144 (defcustom anything-ff-newfile-prompt-p t
1145   "Whether Prompt or not when creating new file.
1146 This set `ffap-newfile-prompt'."
1147   :type  'boolean
1148   :group 'anything-config)
1149
1150
1151 (defcustom anything-ff-avfs-directory nil
1152   "The default avfs directory, usually '.avfs'.
1153 When this is set you will be able to expand archive filenames with `C-z'
1154 inside an avfs directory mounted with mountavfs.
1155 See <http://sourceforge.net/projects/avf/>."
1156   :type  'boolean
1157   :group 'anything-config)
1158
1159 (defcustom anything-ff-file-compressed-list '("gz" "bz2" "zip" "7z")
1160   "Minimal list of compressed files extension."
1161   :type  'list
1162   :group 'anything-config)
1163
1164 (defcustom anything-locate-db-file-regexp "m?locate\.db$"
1165   "Default regexp to match locate database.
1166 If nil Search in all files."
1167   :type  'string
1168   :group 'anything-config)
1169
1170 (defcustom anything-ff-locate-db-filename "locate.db"
1171   "The basename of the locatedb file you use locally in your directories.
1172 When this is set and `anything' find such a file in the directory from
1173 where you launch locate, it will use this file and will not prompt you
1174 for a db file.
1175 Note that this happen only when locate is launched with a prefix arg."
1176   :group 'anything-config
1177   :type 'string)
1178
1179 (defcustom anything-c-locate-command nil
1180   "A list of arguments for locate program.
1181 If nil it will be calculated when `anything-locate' startup
1182 with these default values for different systems:
1183
1184 Gnu/linux: \"locate -i -r %s\"
1185 berkeley-unix: \"locate -i %s\"
1186 windows-nt: \"es -i -r %s\"
1187 Others: \"locate %s\"
1188
1189 This string will be passed to format so it should end with `%s'.
1190 The \"-r\" option must be the last option."
1191   :type 'string
1192   :group 'anything-config)
1193
1194 (defcustom anything-c-show-info-in-mode-line-delay 12
1195   "Eldoc will show info in mode-line during this delay if user is idle."
1196   :type  'integer
1197   :group 'anything-config)
1198
1199 (defcustom anything-c-copy-files-async-log-file "/tmp/dired.log"
1200   "The file used to communicate with two emacs when copying files async."
1201   :type  'string
1202   :group 'anything-config)
1203
1204 (defcustom anything-ff-printer-list nil
1205   "A list of available printers on your system.
1206 When non--nil let you choose a printer to print file.
1207 Otherwise when nil the variable `printer-name' will be used.
1208 On Unix based systems (lpstat command needed) you don't need to set this,
1209 `anything-ff-find-printers' will find a list of available printers for you."
1210   :type 'list
1211   :group 'anything-config)
1212
1213 (defcustom anything-ff-transformer-show-only-basename nil
1214   "Show only basename of candidates in `anything-find-files'.
1215 This can be toggled at anytime from `anything-find-files' with \
1216 \\<anything-find-files-map>0\\[anything-ff-run-toggle-basename]."
1217   :type 'boolean
1218   :group 'anything-config)
1219
1220 (defcustom anything-ff-quick-delete-dont-prompt-for-deletion nil
1221   "Don't ask in persistent deletion of files when non--nil."
1222   :group 'anything-config
1223   :type 'boolean)
1224
1225 (defcustom anything-ff-signal-error-on-dot-files t
1226   "Signal error when file is `.' or `..' on file deletion when non--nil.
1227 Default is non--nil.
1228 WARNING: Setting this to nil is unsafe and can cause deletion of a whole tree."
1229   :group 'anything-config
1230   :type 'boolean)
1231
1232 (defcustom anything-completing-read-handlers-alist
1233   '((describe-function . anything-completing-read-symbols)
1234     (describe-variable . anything-completing-read-symbols)
1235     (debug-on-entry . anything-completing-read-symbols)
1236     (find-function . anything-completing-read-symbols)
1237     (trace-function . anything-completing-read-symbols)
1238     (trace-function-background . anything-completing-read-symbols)
1239     (find-tag . anything-completing-read-with-cands-in-buffer)
1240     (ffap-alternate-file . nil))
1241   "Alist of handlers to replace `completing-read', `read-file-name' in `ac-mode'.
1242 Each entry is a cons cell like \(emacs_command . completing-read_handler\)
1243 where key and value are symbols.
1244
1245 Each key is an Emacs command that use originaly `completing-read'.
1246
1247 Each value maybe an anything function that take same arguments as
1248 `completing-read' plus NAME and BUFFER, where NAME is the name of the new
1249 anything source and BUFFER the name of the buffer we will use.
1250 This function prefix name must start by \"anything\".
1251
1252 See `anything-completing-read-symbols' for example.
1253
1254 If the value of an entry is nil completion will fall back to
1255 emacs vanilla behavior.
1256 e.g If you want to disable anything completion for `describe-function':
1257 \(describe-function . nil\).
1258
1259 Ido is also supported, you can use `ido-completing-read' and
1260 `ido-read-file-name' as value of an entry or just 'ido.
1261 e.g ido completion for `find-file':
1262 \(find-file . ido\)
1263 same as
1264 \(find-file . ido-read-file-name\)
1265 Note that you don't need to enable `ido-mode' for this to work."
1266   :group 'anything-config
1267   :type '(alist :key-type symbol :value-type symbol))
1268
1269 (defcustom anything-M-x-requires-pattern 2
1270   "Value of requires-pattern for `anything-M-x'.
1271 Set it to 0 to disable requires-pattern in `anything-M-x'."
1272   :group 'anything-config
1273   :type 'boolean)
1274
1275 ;;; Build info-index sources with info-index plug-in.
1276 ;;
1277 ;;
1278 (defun anything-c-build-info-index-command (name doc source buffer)
1279   "Define an anything command NAME with documentation DOC.
1280 Arg SOURCE will be an existing anything source named
1281 `anything-c-source-info-<NAME>' and BUFFER a string buffer name."
1282   (eval (list 'defun name nil doc
1283               (list 'interactive)
1284               (list 'anything
1285                     :sources source
1286                     :buffer buffer
1287                     :candidate-number-limit 1000))))
1288
1289 (defun anything-c-define-info-index-sources (var-value &optional commands)
1290   "Define anything sources named anything-c-source-info-<NAME>.
1291 Sources are generated for all entries of `anything-c-default-info-index-list'.
1292 If COMMANDS arg is non--nil build also commands named `anything-info<NAME>'.
1293 Where NAME is one of `anything-c-default-info-index-list'."
1294   (loop with symbols = (loop for str in var-value
1295                              collect
1296                              (intern (concat "anything-c-source-info-" str)))
1297         for sym in symbols
1298         for str in var-value
1299         do (set sym (list (cons 'name (format "Info index: %s" str))
1300                           (cons 'info-index str)))
1301         when commands
1302         do (let ((com (intern (concat "anything-info-" str))))
1303              (anything-c-build-info-index-command com
1304                (format "Predefined anything for %s info." str) sym
1305                (format "*anything info %s*" str)))))
1306
1307 (defun anything-info-index-set (var value)
1308   (set var value)
1309   (anything-c-define-info-index-sources value t))
1310
1311 (defcustom anything-c-default-info-index-list
1312   '("elisp" "cl" "org" "gnus" "tramp" "ratpoison"
1313     "zsh" "bash" "coreutils" "fileutils"
1314     "find" "sh-utils" "textutils" "libc"
1315     "make" "automake" "autoconf" "emacs-lisp-intro"
1316     "emacs" "elib" "eieio" "gauche-refe" "guile"
1317     "guile-tut" "goops" "screen" "latex" "gawk"
1318     "sed" "m4" "wget" "binutils" "as" "bfd" "gprof"
1319     "ld" "diff" "flex" "grep" "gzip" "libtool"
1320     "texinfo" "info" "gdb" "stabs" "cvsbook" "cvs"
1321     "bison" "id-utils" "global")
1322   "Info Manual entries to use for building anything info index commands."
1323   :group 'anything-config
1324   :type 'list
1325   :set 'anything-info-index-set)
1326
1327 (defcustom anything-c-register-max-offset 160
1328   "Max size of string register entries before truncating."
1329   :group 'anything-config
1330   :type 'integer)
1331
1332 \f
1333 ;;; General internal variables
1334 ;;
1335 ;; Some internals variable that need to be loaded
1336 ;; here to avoid compiler warnings.
1337 (defvar anything-c-external-commands-list nil
1338   "A list of all external commands the user can execute.  If this
1339 variable is not set by the user, it will be calculated
1340 automatically.")
1341
1342 (defvar anything-c-show-completion-overlay nil)
1343
1344
1345 \f
1346 ;;; Faces
1347 ;;
1348 ;;
1349 (defface anything-buffer-saved-out
1350     '((t (:foreground "red")))
1351   "*Face used for buffer files modified outside of emacs."
1352   :group 'anything-config)
1353
1354 (defface anything-buffer-not-saved
1355     '((t (:foreground "Indianred2")))
1356   "*Face used for buffer files not already saved on disk."
1357   :group 'anything-config)
1358
1359 (defface anything-ff-prefix
1360     '((t (:background "yellow" :foreground "black")))
1361   "*Face used to prefix new file or url paths in `anything-find-files'."
1362   :group 'anything-config)
1363
1364 (defface anything-ff-executable
1365     '((t (:foreground "green")))
1366   "*Face used for executable files in `anything-find-files'."
1367   :group 'anything-config)
1368
1369 (defface anything-ff-directory
1370     '((t (:foreground "DarkRed" :background "LightGray")))
1371   "*Face used for directories in `anything-find-files'."
1372   :group 'anything-config)
1373
1374 (defface anything-ff-symlink
1375     '((t (:foreground "DarkOrange")))
1376   "*Face used for symlinks in `anything-find-files'."
1377   :group 'anything-config)
1378
1379 (defface anything-ff-invalid-symlink
1380     '((t (:foreground "black" :background "red")))
1381   "*Face used for invalid symlinks in `anything-find-files'."
1382   :group 'anything-config)
1383
1384 (defface anything-ff-file
1385     '((t (:foreground "CadetBlue" :underline t)))
1386   "*Face used for file names in `anything-find-files'."
1387   :group 'anything-config)
1388
1389 (defface anything-grep-match
1390     '((t (:inherit match)))
1391   "Face used to highlight grep matches."
1392   :group 'anything-config)
1393
1394 (defface anything-grep-file
1395     '((t (:foreground "BlueViolet" :underline t)))
1396   "Face used to highlight grep results filenames."
1397   :group 'anything-config)
1398
1399 (defface anything-grep-lineno
1400     '((t (:foreground "Darkorange1")))
1401   "Face used to highlight grep number lines."
1402   :group 'anything-config)
1403
1404 (defface anything-grep-running
1405     '((t (:foreground "Red")))
1406   "Face used in mode line when grep is running."
1407   :group 'anything-config)
1408
1409 (defface anything-grep-finish
1410     '((t (:foreground "Green")))
1411   "Face used in mode line when grep is finish."
1412   :group 'anything-config)
1413
1414 (defface anything-M-x-key-face '((t (:foreground "orange" :underline t)))
1415   "*Face used in anything-M-x to show keybinding."
1416   :group 'anything)
1417
1418 (defface anything-bmkext-info
1419     '((t (:foreground "green")))
1420   "*Face used for W3m Emacs bookmarks (not w3m bookmarks)."
1421   :group 'anything)
1422
1423 (defface anything-bmkext-w3m
1424     '((t (:foreground "yellow")))
1425   "*Face used for W3m Emacs bookmarks (not w3m bookmarks)."
1426   :group 'anything)
1427
1428 (defface anything-bmkext-gnus
1429     '((t (:foreground "magenta")))
1430   "*Face used for Gnus bookmarks."
1431   :group 'anything)
1432
1433 (defface anything-bmkext-man
1434     '((t (:foreground "Orange4")))
1435   "*Face used for Woman/man bookmarks."
1436   :group 'anything)
1437
1438 (defface anything-bmkext-no--file
1439     '((t (:foreground "grey")))
1440   "*Face used for non--file bookmarks."
1441   :group 'anything)
1442
1443 (defface anything-bmkext-file
1444     '((t (:foreground "Deepskyblue2")))
1445   "*Face used for non--file bookmarks."
1446   :group 'anything)
1447
1448 (defface anything-bookmarks-su-face '((t (:foreground "red")))
1449   "Face for su/sudo bookmarks."
1450   :group 'anything)
1451
1452 (defface anything-w3m-bookmarks-face '((t (:foreground "cyan1" :underline t)))
1453   "Face for w3m bookmarks" :group 'anything)
1454
1455 (defface anything-emms-playlist
1456     '((t (:foreground "Springgreen4" :underline t)))
1457   "*Face used for tracks in current emms playlist."
1458   :group 'anything)
1459
1460 (defface anything-apt-installed
1461     '((t (:foreground "green")))
1462   "*Face used for apt installed candidates."
1463   :group 'anything)
1464
1465 (defface anything-apt-deinstalled
1466     '((t (:foreground "DimGray")))
1467   "*Face used for apt deinstalled candidates."
1468   :group 'anything)
1469
1470 (defface anything-gentoo-match-face '((t (:foreground "red")))
1471   "Face for anything-gentoo installed packages."
1472   :group 'traverse-faces)
1473
1474 (defface anything-lisp-show-completion
1475     '((t (:background "DarkSlateGray")))
1476   "*Face used for showing candidates in `anything-lisp-completion'."
1477   :group 'anything-config)
1478
1479 (defface anything-lisp-completion-info
1480     '((t (:foreground "red")))
1481   "*Face used for showing info in `anything-lisp-completion'."
1482   :group 'anything-config)
1483
1484 (defface anything-overlay-line-face '((t (:background "IndianRed4" :underline t)))
1485   "Face for source header in the anything buffer." :group 'anything)
1486
1487 ;;;###autoload
1488 (defun anything-configuration ()
1489   "Customize `anything'."
1490   (interactive)
1491   (customize-group "anything-config"))
1492
1493
1494 \f
1495 ;;; Anything-command-map
1496 ;;
1497 ;;
1498 ;;;###autoload
1499 (defvar anything-command-map)
1500 (define-prefix-command 'anything-command-map)
1501
1502
1503 (define-key anything-command-map (kbd "<SPC>")     'anything-execute-anything-command)
1504 (define-key anything-command-map (kbd "a")         'anything-c-apropos)
1505 (define-key anything-command-map (kbd "e")         'anything-c-etags-select)
1506 (define-key anything-command-map (kbd "l")         'anything-locate)
1507 (define-key anything-command-map (kbd "s")         'anything-surfraw)
1508 (define-key anything-command-map (kbd "r")         'anything-regexp)
1509 (define-key anything-command-map (kbd "w")         'anything-w3m-bookmarks)
1510 (define-key anything-command-map (kbd "x")         'anything-firefox-bookmarks)
1511 (define-key anything-command-map (kbd "#")         'anything-emms)
1512 (define-key anything-command-map (kbd "m")         'anything-man-woman)
1513 (define-key anything-command-map (kbd "t")         'anything-top)
1514 (define-key anything-command-map (kbd "i")         'anything-imenu)
1515 (define-key anything-command-map (kbd "<tab>")     'anything-lisp-completion-at-point)
1516 (define-key anything-command-map (kbd "p")         'anything-list-emacs-process)
1517 (define-key anything-command-map (kbd "C-x r b")   'anything-c-pp-bookmarks)
1518 (define-key anything-command-map (kbd "M-y")       'anything-show-kill-ring)
1519 (define-key anything-command-map (kbd "C-c <SPC>") 'anything-all-mark-rings)
1520 (define-key anything-command-map (kbd "C-x C-f")   'anything-find-files)
1521 (define-key anything-command-map (kbd "f")         'anything-for-files)
1522 (define-key anything-command-map (kbd "C-:")       'anything-eval-expression-with-eldoc)
1523 (define-key anything-command-map (kbd "C-,")       'anything-calcul-expression)
1524 (define-key anything-command-map (kbd "M-x")       'anything-M-x)
1525 (define-key anything-command-map (kbd "C-x C-w")   'anything-write-file)
1526 (define-key anything-command-map (kbd "C-x i")     'anything-insert-file)
1527 (define-key anything-command-map (kbd "M-s o")     'anything-occur)
1528 (define-key anything-command-map (kbd "M-g s")     'anything-do-grep)
1529 (define-key anything-command-map (kbd "c")         'anything-colors)
1530 (define-key anything-command-map (kbd "F")         'anything-select-xfont)
1531 (define-key anything-command-map (kbd "C-c f")     'anything-recentf)
1532 (define-key anything-command-map (kbd "C-c g")     'anything-google-suggest)
1533 (define-key anything-command-map (kbd "h i")       'anything-info-at-point)
1534 (define-key anything-command-map (kbd "h r")       'anything-info-emacs)
1535 (define-key anything-command-map (kbd "h g")       'anything-info-gnus)
1536 (define-key anything-command-map (kbd "C-x C-b")   'anything-buffers-list)
1537 (define-key anything-command-map (kbd "C-c C-b")   'anything-browse-code)
1538 (define-key anything-command-map (kbd "C-x r i")   'anything-register)
1539 (define-key anything-command-map (kbd "C-c C-x")   'anything-c-run-external-command)
1540
1541 ;; In Emacs 23.1.50, minibuffer-local-must-match-filename-map was renamed to
1542 ;; minibuffer-local-filename-must-match-map.
1543 (defvar minibuffer-local-filename-must-match-map (make-sparse-keymap)) ;; Emacs 23.1.+
1544 (defvar minibuffer-local-must-match-filename-map (make-sparse-keymap)) ;; Older Emacsen
1545 (dolist (map (list minibuffer-local-filename-completion-map
1546                    minibuffer-local-completion-map
1547                    minibuffer-local-must-match-filename-map
1548                    minibuffer-local-filename-must-match-map
1549                    minibuffer-local-map
1550                    minibuffer-local-isearch-map
1551                    minibuffer-local-must-match-map
1552                    minibuffer-local-ns-map))
1553   (define-key map "\C-r" 'anything-minibuffer-history))
1554
1555
1556 \f
1557 ;;; Menu
1558 ;;
1559 ;;
1560 (easy-menu-define nil global-map
1561   "`anything' menu"
1562   '("Anything"
1563     ["All anything commands" anything-execute-anything-command t]
1564     ["Find any Files/Buffers" anything-for-files t]
1565     ["Anything Everywhere (Toggle)" ac-mode t]
1566     "----"
1567     ("Files:"
1568      ["Find files" anything-find-files t]
1569      ["Recent Files" anything-recentf t]
1570      ["Locate" anything-locate t]
1571      ["Bookmarks" anything-c-pp-bookmarks t])
1572     ("Buffers:"
1573      ["Find buffers" anything-buffers-list t])
1574     ("Commands:"
1575      ["Emacs Commands" anything-M-x t]
1576      ["Externals Commands" anything-c-run-external-command t])
1577     ("Help:"
1578      ["Anything Apropos" anything-c-apropos t])
1579     ("Info:"
1580      ["Info at point" anything-info-at-point t]
1581      ["Emacs Manual index" anything-info-emacs t]
1582      ["Gnus Manual index" anything-info-gnus t])
1583     ("Org:"
1584      ["Org keywords" anything-org-keywords t]
1585      ["Org headlines" anything-org-headlines t])
1586     ("Tools:"
1587      ["Occur" anything-occur t]
1588      ["Grep" anything-do-grep t]
1589      ["Etags" anything-c-etags-select t]
1590      ["Lisp complete at point" anything-lisp-completion-at-point t]
1591      ["Browse Kill ring" anything-show-kill-ring t]
1592      ["Browse register" anything-register t]
1593      ["Browse code" anything-browse-code t]
1594      ["Mark Ring" anything-all-mark-rings t]
1595      ["Regexp handler" anything-regexp t]
1596      ["Colors & Faces" anything-colors t]
1597      ["Show xfonts" anything-select-xfont t]
1598      ["Ucs Symbols" anything-ucs t]
1599      ["Imenu" anything-imenu t]
1600      ["Google Suggest" anything-google-suggest t]
1601      ["Eval expression" anything-eval-expression-with-eldoc t]
1602      ["Calcul expression" anything-calcul-expression t]
1603      ["Man pages" anything-man-woman t]
1604      ["Top externals process" anything-top t]
1605      ["Emacs internals process" anything-list-emacs-process t])
1606     "----"
1607     ["Prefered Options" anything-configuration t]))
1608
1609 ;;; Anything map add ons
1610 ;;
1611 ;;
1612 (define-key anything-map (kbd "C-x C-f") 'anything-quit-and-find-file)
1613 (define-key anything-map (kbd "M-m")     'anything-toggle-all-marks)
1614 (define-key anything-map (kbd "C-w")     'anything-yank-text-at-point)
1615
1616 \f
1617 ;;; Specialized keymaps
1618 ;;
1619 ;;
1620 (defun anything-c-make-child-map (parent)
1621   (let ((map (make-sparse-keymap)))
1622     (set-keymap-parent map parent)
1623     map))
1624
1625 (defvar anything-c-buffer-map
1626   (let ((map (anything-c-make-child-map anything-map)))
1627     (define-key map (kbd "C-c ?")     'anything-c-buffer-help)
1628     ;; No need to have separate command for grep and zgrep
1629     ;; as we don't use recursivity for buffers.
1630     ;; So use zgrep for both as it is capable to handle non--compressed files.
1631     (define-key map (kbd "M-g s")     'anything-buffer-run-zgrep)
1632     (define-key map (kbd "C-c o")     'anything-buffer-switch-other-window)
1633     (define-key map (kbd "C-c C-o")   'anything-buffer-switch-other-frame)
1634     (define-key map (kbd "C-c =")     'anything-buffer-run-ediff)
1635     (define-key map (kbd "M-=")       'anything-buffer-run-ediff-merge)
1636     (define-key map (kbd "C-=")       'anything-buffer-diff-persistent)
1637     (define-key map (kbd "M-U")       'anything-buffer-revert-persistent)
1638     (define-key map (kbd "M-D")       'anything-buffer-run-kill-buffers)
1639     (define-key map (kbd "C-x C-s")   'anything-buffer-save-persistent)
1640     (define-key map (kbd "C-M-%")     'anything-buffer-run-query-replace-regexp)
1641     (define-key map (kbd "M-%")       'anything-buffer-run-query-replace)
1642     (define-key map (kbd "M-m")       'anything-toggle-all-marks)
1643     (define-key map (kbd "M-a")       'anything-mark-all)
1644     (when (locate-library "elscreen")
1645       (define-key map (kbd "<C-tab>") 'anything-buffer-switch-to-elscreen))
1646     (delq nil map))
1647   "Keymap for buffer sources in anything.")
1648
1649 (defvar anything-find-files-map
1650   (let ((map (anything-c-make-child-map anything-map)))
1651     (define-key map (kbd "C-]")           'anything-ff-run-toggle-basename)
1652     (define-key map (kbd "C-x C-f")       'anything-ff-run-locate)
1653     (define-key map (kbd "M-g s")         'anything-ff-run-grep)
1654     (define-key map (kbd "M-g p")         'anything-ff-run-pdfgrep)
1655     (define-key map (kbd "M-g z")         'anything-ff-run-zgrep)
1656     (define-key map (kbd "M-.")           'anything-ff-run-etags)
1657     (define-key map (kbd "M-R")           'anything-ff-run-rename-file)
1658     (define-key map (kbd "M-C")           'anything-ff-run-copy-file)
1659     (define-key map (kbd "M-B")           'anything-ff-run-byte-compile-file)
1660     (define-key map (kbd "M-L")           'anything-ff-run-load-file)
1661     (define-key map (kbd "M-S")           'anything-ff-run-symlink-file)
1662     (define-key map (kbd "M-H")           'anything-ff-run-hardlink-file)
1663     (define-key map (kbd "M-D")           'anything-ff-run-delete-file)
1664     (define-key map (kbd "M-K")           'anything-ff-run-kill-buffer-persistent)
1665     (define-key map (kbd "C-d")           'anything-ff-persistent-delete)
1666     (define-key map (kbd "M-e")           'anything-ff-run-switch-to-eshell)
1667     (define-key map (kbd "<M-tab>")       'anything-ff-run-complete-fn-at-point)
1668     (define-key map (kbd "C-c o")         'anything-ff-run-switch-other-window)
1669     (define-key map (kbd "C-c C-o")       'anything-ff-run-switch-other-frame)
1670     (define-key map (kbd "C-c C-x")       'anything-ff-run-open-file-externally)
1671     (define-key map (kbd "M-!")           'anything-ff-run-eshell-command-on-file)
1672     (define-key map (kbd "C-=")           'anything-ff-run-ediff-file)
1673     (define-key map (kbd "C-c =")         'anything-ff-run-ediff-merge-file)
1674     (define-key map (kbd "M-p")           'anything-ff-run-switch-to-history)
1675     (define-key map (kbd "M-i")           'anything-ff-properties-persistent)
1676     (define-key map (kbd "C-c ?")         'anything-ff-help)
1677     (define-key map (kbd "C-}")           'anything-narrow-window)
1678     (define-key map (kbd "C-{")           'anything-enlarge-window)
1679     (define-key map (kbd "C-<backspace>") 'anything-ff-run-toggle-auto-update)
1680     (define-key map (kbd "M-a")           'anything-mark-all)
1681     (define-key map (kbd "M-m")           'anything-toggle-all-marks)
1682     (define-key map (kbd "M-u")           'anything-unmark-all)
1683     (define-key map (kbd "C-c C-a")       'anything-ff-run-gnus-attach-files)
1684     (define-key map (kbd "C-c p")         'anything-ff-run-print-file)
1685     ;; Next 2 have no effect if candidate is not an image file.
1686     (define-key map (kbd "M-l")           'anything-ff-rotate-left-persistent)
1687     (define-key map (kbd "M-r")           'anything-ff-rotate-right-persistent)
1688     (define-key map (kbd "C-.")           'anything-find-files-down-one-level)
1689     (define-key map (kbd "C-l")           'anything-find-files-down-one-level)
1690     (define-key map (kbd "C-h C-b")       'anything-send-bug-report-from-anything)
1691     (define-key map (kbd "C-h C-d")       'anything-debug-output)
1692     (when anything-ff-lynx-style-map
1693       (define-key map (kbd "<left>")      'anything-find-files-down-one-level)
1694       (define-key map (kbd "<right>")     'anything-execute-persistent-action))
1695     (delq nil map))
1696   "Keymap for `anything-find-files'.")
1697
1698 (defvar anything-c-read-file-map
1699   (let ((map (anything-c-make-child-map anything-map)))
1700     (define-key map (kbd "C-]")           'anything-ff-run-toggle-basename)
1701     (define-key map (kbd "C-.")           'anything-find-files-down-one-level)
1702     (define-key map (kbd "C-l")           'anything-find-files-down-one-level)
1703     (define-key map (kbd "C-<backspace>") 'anything-ff-run-toggle-auto-update)
1704     (define-key map (kbd "C-c ?")         'anything-read-file-name-help)
1705     (when anything-ff-lynx-style-map
1706       (define-key map (kbd "<left>")      'anything-find-files-down-one-level)
1707       (define-key map (kbd "<right>")     'anything-execute-persistent-action)
1708       (define-key map (kbd "C-o")         nil)
1709       (define-key map (kbd "<M-left>")    'anything-previous-source)
1710       (define-key map (kbd "<M-right>")   'anything-next-source))
1711     (delq nil map))
1712   "Keymap for `anything-c-read-file-name'.")
1713
1714 (defvar anything-generic-files-map
1715   (let ((map (anything-c-make-child-map anything-map)))
1716     (define-key map (kbd "M-g s")   'anything-ff-run-grep)
1717     (define-key map (kbd "M-g z")   'anything-ff-run-zgrep)
1718     (define-key map (kbd "M-g p")   'anything-ff-run-pdfgrep)
1719     (define-key map (kbd "M-D")     'anything-ff-run-delete-file)
1720     (define-key map (kbd "C-=")     'anything-ff-run-ediff-file)
1721     (define-key map (kbd "C-c =")   'anything-ff-run-ediff-merge-file)
1722     (define-key map (kbd "C-c o")   'anything-ff-run-switch-other-window)
1723     (define-key map (kbd "M-i")     'anything-ff-properties-persistent)
1724     (define-key map (kbd "C-c C-x") 'anything-ff-run-open-file-externally)
1725     (define-key map (kbd "C-w")     'anything-yank-text-at-point)
1726     (define-key map (kbd "C-c ?")   'anything-generic-file-help)
1727     map)
1728   "Generic Keymap for files.")
1729
1730 (defvar anything-c-grep-map
1731   (let ((map (anything-c-make-child-map anything-map)))
1732     (define-key map (kbd "M-<down>") 'anything-c-goto-next-file)
1733     (define-key map (kbd "M-<up>")   'anything-c-goto-precedent-file)
1734     (define-key map (kbd "C-c o")    'anything-c-grep-run-other-window-action)
1735     (define-key map (kbd "C-w")      'anything-yank-text-at-point)
1736     (define-key map (kbd "C-x C-s")  'anything-c-grep-run-save-buffer)
1737     (when anything-c-grep-use-ioccur-style-keys
1738       (define-key map (kbd "<right>")  'anything-c-grep-run-persistent-action)
1739       (define-key map (kbd "<left>")  'anything-c-grep-run-default-action))
1740     (define-key map (kbd "C-c ?")    'anything-grep-help)
1741     (delq nil map))
1742   "Keymap used in Grep sources.")
1743
1744 (defvar anything-c-pdfgrep-map
1745   (let ((map (anything-c-make-child-map anything-map)))
1746     (define-key map (kbd "M-<down>") 'anything-c-goto-next-file)
1747     (define-key map (kbd "M-<up>")   'anything-c-goto-precedent-file)
1748     (define-key map (kbd "C-w")      'anything-yank-text-at-point)
1749     (define-key map (kbd "C-c ?")    'anything-pdfgrep-help)
1750     map)
1751   "Keymap used in pdfgrep.")
1752
1753 (defvar anything-c-etags-map
1754   (let ((map (anything-c-make-child-map anything-map)))
1755     (define-key map (kbd "M-<down>") 'anything-c-goto-next-file)
1756     (define-key map (kbd "M-<up>")   'anything-c-goto-precedent-file)
1757     (define-key map (kbd "C-w")      'anything-yank-text-at-point)
1758     (define-key map (kbd "C-c ?")    'anything-etags-help)
1759     map)
1760   "Keymap used in Etags.")
1761
1762 (defvar anything-eval-expression-map
1763   (let ((map (anything-c-make-child-map anything-map)))
1764     (define-key map (kbd "<C-return>") 'anything-eval-new-line-and-indent)
1765     (define-key map (kbd "<tab>")      'lisp-indent-line)
1766     (define-key map (kbd "<C-tab>")    'lisp-complete-symbol)
1767     (define-key map (kbd "C-p")        'previous-line)
1768     (define-key map (kbd "C-n")        'next-line)
1769     (define-key map (kbd "<up>")       'previous-line)
1770     (define-key map (kbd "<down>")     'next-line)
1771     (define-key map (kbd "<right>")    'forward-char)
1772     (define-key map (kbd "<left>")     'backward-char)
1773     map))
1774
1775 (defvar anything-c-ucs-map
1776   (let ((map (anything-c-make-child-map anything-map)))
1777     (define-key map (kbd "<C-backspace>") 'anything-c-ucs-persistent-delete)
1778     (define-key map (kbd "<C-left>")      'anything-c-ucs-persistent-backward)
1779     (define-key map (kbd "<C-right>")     'anything-c-ucs-persistent-forward)
1780     (define-key map (kbd "<C-return>")    'anything-c-ucs-persistent-insert)
1781     (define-key map (kbd "C-c ?")         'anything-c-ucs-help)
1782     map)
1783   "Keymap for `anything-ucs'.")
1784
1785 (defvar anything-c-bookmark-map
1786   (let ((map (anything-c-make-child-map anything-map)))
1787     (define-key map (kbd "C-c o") 'anything-c-bookmark-run-jump-other-window)
1788     (define-key map (kbd "C-d")   'anything-c-bookmark-run-delete)
1789     (when (locate-library "bookmark-extensions")
1790       (define-key map (kbd "M-e") 'anything-c-bmkext-run-edit))
1791     (define-key map (kbd "C-c ?") 'anything-c-bookmark-help)
1792     (delq nil map))
1793   "Generic Keymap for emacs bookmark sources.")
1794
1795 (defvar anything-esh-on-file-map
1796   (let ((map (anything-c-make-child-map anything-map)))
1797     (define-key map (kbd "C-c ?")    'anything-esh-help)
1798     map)
1799   "Keymap for `anything-find-files-eshell-command-on-file'.")
1800
1801 (defvar anything-eshell-history-map
1802   (let ((map (anything-c-make-child-map anything-map)))
1803     (define-key map (kbd "M-p") 'anything-next-line)
1804     map)
1805   "Keymap for `anything-eshell-history'.")
1806
1807 (defvar anything-kill-ring-map
1808   (let ((map (anything-c-make-child-map anything-map)))
1809     (define-key map (kbd "M-y") 'anything-next-line)
1810     (define-key map (kbd "M-u") 'anything-previous-line)
1811     map)
1812   "Keymap for `anything-show-kill-ring'.")
1813
1814 (defvar anything-occur-map
1815   (let ((map (anything-c-make-child-map anything-map)))
1816     (define-key map (kbd "C-M-%") 'anything-occur-run-query-replace-regexp)
1817     map)
1818   "Keymap for `anything-occur'.")
1819
1820 \f
1821 ;;; Embeded documentation.
1822 ;;
1823 ;;
1824 (defun anything-c-list-preconfigured-anything ()
1825   "Collect preconfigured anything functions in this file."
1826   (loop with doc
1827         with sym
1828         for entry in (cdr (assoc
1829                            (file-truename (locate-library "anything-config"))
1830                            load-history))
1831         if (and (consp entry)
1832                 (eq (car entry) 'defun)
1833                 (string-match "^Preconfigured.+$"
1834                               (setq doc (or (documentation (setq sym (cdr entry)))
1835                                             ""))))
1836         collect (cons sym (match-string 0 doc))))
1837
1838 (defun anything-c-format-preconfigured-anything ()
1839   (mapcar (lambda (x) (format "\\[%s] : %s\n" (car x) (cdr x)))
1840           (anything-c-list-preconfigured-anything)))
1841
1842 ;;; Global help message - Used by `anything-help'
1843 ;;
1844 ;;
1845 (setq anything-help-message
1846       (lambda ()
1847         (concat
1848          "\\<anything-map>"
1849          "`anything' is QuickSilver-like candidate-selection framework.
1850
1851 Narrow the list by typing some pattern,
1852 Multiple patterns are allowed by splitting by space.
1853 Select with natural Emacs operations, choose with RET.
1854
1855 If you have any problems, press C-c C-x C-b!!
1856 Feel free to send bug reports. I'll fix them.
1857 The steps are described in the beginning of anything.el file.
1858
1859 == Basic Operations ==
1860 C-p, Up: Previous Line
1861 C-n, Down : Next Line
1862 M-v, PageUp : Previous Page
1863 C-v, PageDown : Next Page
1864 Enter : Execute first (default) action / Select
1865 M-< : First Line
1866 M-> : Last Line
1867 M-PageUp, C-M-S-v, C-M-y : Previous Page (other-window)
1868 M-PageDown, C-M-v : Next Page (other-window)
1869
1870 Tab, C-i : Show action list
1871 Left : Previous Source
1872 Right, C-o : Next Source
1873 C-k : Delete pattern
1874 C-z : Persistent Action (Execute action with anything session kept)
1875 C-c C-x C-b: Send a bug report
1876
1877 == Shortcuts For 2nd/3rd Action ==
1878 \\[anything-select-2nd-action-or-end-of-line] : Execute 2nd Action (if the minibuffer cursor is at end of line)
1879 \\[anything-select-3rd-action] : Execute 3rd Action
1880
1881 == Visible Marks ==
1882 Visible marks store candidate. Some actions uses marked candidates.
1883
1884 \\[anything-toggle-visible-mark] : Toggle Visible Mark
1885 \\[anything-prev-visible-mark] : Previous Mark
1886 \\[anything-next-visible-mark] : Next Mark
1887
1888 == Miscellaneous Commands ==
1889 \\[anything-toggle-resplit-window] : Toggle vertical/horizontal split anything window
1890 \\[anything-quit-and-find-file] : Drop into `find-file'
1891 \\[anything-delete-current-selection] : Delete Selected Item (visually)
1892 \\[anything-kill-selection-and-quit] : Set Item Into the kill-ring And Quit
1893 \\[anything-yank-selection] : Yank Selected Item Into Pattern
1894 \\[anything-follow-mode] : Toggle Automatical Execution Of Persistent Action
1895 \\[anything-force-update] : Recalculate And Redisplay Candidates
1896
1897 == Global Commands ==
1898 \\<global-map>\\[anything-resume] revives last `anything' session.
1899 It is very useful, so you should bind any key.
1900
1901 Single source is executed by \\[anything-call-source].
1902
1903 == Preconfigured `anything' ==
1904 Preconfigured `anything' is commands that uses `anything' interface.
1905 You can use them without configuration.
1906
1907 "
1908          (apply 'concat (anything-c-format-preconfigured-anything))
1909          "
1910 Enjoy!")))
1911
1912 ;;; `anything-buffer-list' help
1913 ;;
1914 ;;
1915 (defvar anything-c-buffer-help-message
1916   "== Anything Buffer ==
1917 \nTips:
1918 You can enter a partial name of major-mode (e.g lisp, sh) to narrow down buffers.
1919 Enter then a space and a pattern to narrow down to buffers matching this pattern.
1920 \nSpecific commands for `anything-buffers-list':
1921 \\<anything-c-buffer-map>
1922 \\[anything-buffer-run-zgrep]\t\t->Grep Buffer(s) works as zgrep too. (C-u grep all buffers but non--file buffers).
1923 \\[anything-buffer-switch-other-window]\t\t->Switch other window.
1924 \\[anything-buffer-switch-other-frame]\t\t->Switch other frame.
1925 \\[anything-buffer-run-query-replace-regexp]\t\t->Query replace regexp in marked buffers.
1926 \\[anything-buffer-run-query-replace]\t\t->Query replace in marked buffers.
1927 \\[anything-buffer-switch-to-elscreen]\t\t->Find buffer in Elscreen.
1928 \\[anything-buffer-run-ediff]\t\t->Ediff current buffer with candidate.  If two marked buffers ediff those buffers.
1929 \\[anything-buffer-run-ediff-merge]\t\t->Ediff merge current buffer with candidate.  If two marked buffers ediff merge those buffers.
1930 \\[anything-buffer-diff-persistent]\t\t->Toggle Diff buffer with saved file without quitting.
1931 \\[anything-buffer-revert-persistent]\t\t->Revert buffer without quitting.
1932 \\[anything-buffer-save-persistent]\t\t->Save buffer without quitting.
1933 \\[anything-buffer-run-kill-buffers]\t\t->Delete marked buffers and quit.
1934 \\[anything-toggle-all-marks]\t\t->Toggle all marks.
1935 \\[anything-mark-all]\t\t->Mark all.
1936 \\[anything-c-buffer-help]\t\t->Display this help.
1937 \n== Anything Map ==
1938 \\{anything-map}")
1939
1940 ;;;###autoload
1941 (defun anything-c-buffer-help ()
1942   "Help command for anything buffers."
1943   (interactive)
1944   (let ((anything-help-message anything-c-buffer-help-message))
1945     (anything-help)))
1946
1947 ;;; Find files help (`anything-find-files')
1948 ;;
1949 ;;
1950 (defvar anything-ff-help-message
1951   "== Anything Find Files ==
1952 \nTips:
1953 \n- Enter `~/' at end of pattern to quickly reach home directory.
1954 - Enter `/' at end of pattern to quickly reach root of your file system.
1955 - Enter `./' at end of pattern to quickly reach `default-directory' (initial start of session).
1956 - You can complete with partial basename \(e.g \"fb\" will complete \"foobar\"\).
1957 - Use `C-u C-z' to watch an image.
1958 - To browse images directories turn on `anything-follow-mode' and navigate with arrow keys.
1959 - When entered ediff, hitting `C-g' will ask you to use locate to find the file to ediff with.
1960
1961 \nSpecific commands for `anything-find-files':
1962 \\<anything-find-files-map>
1963 \\[anything-ff-run-locate]\t\t->Run Locate on basename of candidate (C-u to specify locate db).
1964 \\[anything-ff-run-grep]\t\t->Run Grep (C-u Recursive).
1965 \\[anything-ff-run-pdfgrep]\t\t->Run Pdfgrep on marked files.
1966 \\[anything-ff-run-zgrep]\t\t->Run zgrep (C-u Recursive).
1967 \\[anything-ff-run-etags]\t\t->Run Etags (C-u use thing-at-point `C-u C-u' reload cache)
1968 \\[anything-ff-run-rename-file]\t\t->Rename File (C-u Follow).
1969 \\[anything-ff-run-copy-file]\t\t->Copy File (C-u Follow).
1970 \\[anything-ff-run-byte-compile-file]\t\t->Byte Compile File (C-u Load).
1971 \\[anything-ff-run-load-file]\t\t->Load File.
1972 \\[anything-ff-run-symlink-file]\t\t->Symlink File.
1973 \\[anything-ff-run-hardlink-file]\t\t->Hardlink file.
1974 \\[anything-ff-run-delete-file]\t\t->Delete File.
1975 \\[anything-ff-run-kill-buffer-persistent]\t\t->Kill buffer candidate without quitting.
1976 \\[anything-ff-persistent-delete]\t\t->Delete file without quitting.
1977 \\[anything-ff-run-switch-to-eshell]\t\t->Switch to Eshell.
1978 \\[anything-ff-run-eshell-command-on-file]\t\t->Eshell command on file (C-u Run on all marked files at once).
1979 \\[anything-ff-run-ediff-file]\t\t->Ediff file.
1980 \\[anything-ff-run-ediff-merge-file]\t\t->Ediff merge file.
1981 \\[anything-ff-run-complete-fn-at-point]\t\t->Complete file name at point.
1982 \\[anything-ff-run-switch-other-window]\t\t->Switch other window.
1983 \\[anything-ff-run-switch-other-frame]\t\t->Switch other frame.
1984 \\[anything-ff-run-open-file-externally]\t\t->Open file with external program (C-u to choose).
1985 \\[anything-ff-rotate-left-persistent]\t\t->Rotate Image Left.
1986 \\[anything-ff-rotate-right-persistent]\t\t->Rotate Image Right.
1987 \\[anything-find-files-down-one-level]\t\t->Go down precedent directory.
1988 \\[anything-ff-run-switch-to-history]\t\t->Switch to anything find-files history.
1989 \\[anything-ff-properties-persistent]\t\t->Show file properties in a tooltip.
1990 \\[anything-mark-all]\t\t->Mark all visibles candidates.
1991 \\[anything-ff-run-toggle-auto-update]\t->Toggle auto expansion of directories.
1992 \\[anything-unmark-all]\t\t->Unmark all candidates, visibles and invisibles.
1993 \\[anything-ff-run-gnus-attach-files]\t\t->Gnus attach files to message buffer.
1994 \\[anything-ff-run-print-file]\t\t->Print file, (C-u to refresh printers list).
1995 \\[anything-enlarge-window]\t\t->Enlarge anything window.
1996 \\[anything-narrow-window]\t\t->Narrow anything window.
1997 \\[anything-ff-run-toggle-basename]\t\t->Toggle basename/fullpath.
1998 \\[anything-send-bug-report-from-anything]\t\t->Send Bug report.
1999 \\[anything-ff-help]\t\t->Display this help info.
2000 \n== Anything Map ==
2001 \\{anything-map}")
2002
2003 ;;;###autoload
2004 (defun anything-ff-help ()
2005   "Help command for `anything-find-files'."
2006   (interactive)
2007   (let ((anything-help-message anything-ff-help-message))
2008     (anything-help)))
2009
2010 ;;; Help for `anything-c-read-file-name'
2011 ;;
2012 ;;
2013 (defvar anything-read-file-name-help-message
2014   "== Anything read file name Map ==\
2015 \nSpecific commands for anything-c-read-file-name:
2016 \\<anything-c-read-file-map>
2017 \\[anything-find-files-down-one-level]\t\t->Go down precedent directory.
2018 \\[anything-ff-run-toggle-auto-update]\t->Toggle auto expansion of directories.
2019 \\[anything-next-source]\t->Goto next source.
2020 \\[anything-previous-source]\t->Goto previous source.
2021 \\[anything-read-file-name-help]\t\t->Display this help info.
2022 \n== Anything Map ==
2023 \\{anything-map}")
2024
2025 ;;;###autoload
2026 (defun anything-read-file-name-help ()
2027   (interactive)
2028   (let ((anything-help-message anything-read-file-name-help-message))
2029     (anything-help)))
2030
2031 ;;; Generic file help - Used by locate.
2032 ;;
2033 ;;
2034 (defvar anything-generic-file-help-message
2035   "== Anything Generic files Map ==\
2036 \nSpecific commands for anything locate and others files sources:
2037 \\<anything-generic-files-map>
2038 \\[anything-ff-run-grep]\t\t->Run grep (C-u recurse).
2039 \\[anything-ff-run-pdfgrep]\t\t->Run Pdfgrep on marked files.
2040 \\[anything-ff-run-delete-file]\t\t->Delete file.
2041 \\[anything-ff-run-ediff-file]\t\t->Ediff file.
2042 \\[anything-ff-run-ediff-merge-file]\t\t->Ediff merge file.
2043 \\[anything-ff-run-switch-other-window]\t\t->Switch other window.
2044 \\[anything-ff-properties-persistent]\t\t->Show file properties.
2045 \\[anything-yank-text-at-point]\t\t->Yank text at point.
2046 \\[anything-ff-run-open-file-externally]\t\t->Open file with external program (C-u to choose).
2047 \nLocate tips:
2048 You can add after writing search pattern any of the locate command line options.
2049 e.g -b, -e, -n <number>...etc.
2050 See Man locate for more infos.
2051 \n== Anything Map ==
2052 \\{anything-map}")
2053
2054 ;;;###autoload
2055 (defun anything-generic-file-help ()
2056   (interactive)
2057   (let ((anything-help-message anything-generic-file-help-message))
2058     (anything-help)))
2059
2060 ;;; Grep help
2061 ;;
2062 ;;
2063 (defvar anything-grep-help-message
2064   "== Anything Grep Map ==\
2065 \nAnything Grep tips:
2066 You can start grep with a prefix arg to recurse in subdirectories.
2067 You can use wild card when selecting files (e.g *.el)
2068 You can grep in many differents directories by marking files or wild cards.
2069 You can save your results in a grep-mode buffer, see below.
2070
2071 \nSpecific commands for Anything Grep:
2072 \\<anything-c-grep-map>
2073 \\[anything-c-goto-next-file]\t->Next File.
2074 \\[anything-c-goto-precedent-file]\t\t->Precedent File.
2075 \\[anything-yank-text-at-point]\t\t->Yank Text at point in minibuffer.
2076 \\[anything-c-grep-run-other-window-action]\t\t->Jump other window.
2077 \\[anything-c-grep-run-persistent-action]\t\t->Run persistent action (Same as `C-z').
2078 \\[anything-c-grep-run-default-action]\t\t->Run default action (Same as RET).
2079 \\[anything-c-grep-run-save-buffer]\t\t->Save to a `grep-mode' enabled buffer.
2080 \\[anything-grep-help]\t\t->Show this help.
2081 \n== Anything Map ==
2082 \\{anything-map}")
2083
2084 ;;;###autoload
2085 (defun anything-grep-help ()
2086   (interactive)
2087   (let ((anything-help-message anything-grep-help-message))
2088     (anything-help)))
2089
2090 ;;; Pdf grep help
2091 ;;
2092 ;;
2093 (defvar anything-pdfgrep-help-message
2094   "== Anything PdfGrep Map ==\
2095 \nSpecific commands for Pdf Grep:
2096 \\<anything-c-pdfgrep-map>
2097 \\[anything-c-goto-next-file]\t->Next File.
2098 \\[anything-c-goto-precedent-file]\t\t->Precedent File.
2099 \\[anything-yank-text-at-point]\t\t->Yank Text at point in minibuffer.
2100 \\[anything-pdfgrep-help]\t\t->Show this help.
2101 \n== Anything Map ==
2102 \\{anything-map}")
2103
2104 ;;;###autoload
2105 (defun anything-pdfgrep-help ()
2106   (interactive)
2107   (let ((anything-help-message anything-pdfgrep-help-message))
2108     (anything-help)))
2109
2110 ;;; Etags help
2111 ;;
2112 ;;
2113 (defvar anything-etags-help-message
2114   "== Anything Etags Map ==\
2115 \nSpecific commands for Etags:
2116 \\<anything-c-etags-map>
2117 \\[anything-c-goto-next-file]\t->Next File.
2118 \\[anything-c-goto-precedent-file]\t\t->Precedent File.
2119 \\[anything-yank-text-at-point]\t\t->Yank Text at point in minibuffer.
2120 \\[anything-etags-help]\t\t->Show this help.
2121 \n== Anything Map ==
2122 \\{anything-map}")
2123
2124 ;;;###autoload
2125 (defun anything-etags-help ()
2126   "The help function for etags."
2127   (interactive)
2128   (let ((anything-help-message anything-etags-help-message))
2129     (anything-help)))
2130
2131 ;;; Ucs help
2132 ;;
2133 ;;
2134 (defvar anything-c-ucs-help-message
2135   "== Anything Ucs ==
2136 \nSpecific commands for `anything-ucs':
2137 \\<anything-c-ucs-map>
2138 \\[anything-c-ucs-persistent-insert]\t->Insert char.
2139 \\[anything-c-ucs-persistent-forward]\t->Forward char.
2140 \\[anything-c-ucs-persistent-backward]\t->Backward char.
2141 \\[anything-c-ucs-persistent-delete]\t->Delete char backward.
2142 \\[anything-c-ucs-help]\t\t->Show this help.
2143
2144 \n== Anything Map ==
2145 \\{anything-map}")
2146
2147 (defun anything-c-ucs-help ()
2148   "Help command for `anything-ucs'."
2149   (interactive)
2150   (let ((anything-help-message anything-c-ucs-help-message))
2151     (anything-help)))
2152
2153 ;;; Bookmark help
2154 ;;
2155 ;;
2156 (defvar anything-bookmark-help-message
2157   "== Anything bookmark name Map ==\
2158 \nSpecific commands for bookmarks:
2159 \\<anything-c-bookmark-map>
2160 \\[anything-c-bookmark-run-jump-other-window]\t\t->Jump other window.
2161 \\[anything-c-bookmark-run-delete]\t\t->Delete bookmark.
2162 \\[anything-c-bmkext-run-edit]\t\t->Edit bookmark (only for bmkext).
2163 \\[anything-c-bookmark-help]\t\t->Run this help.
2164 \n== Anything Map ==
2165 \\{anything-map}")
2166
2167 (defun anything-c-bookmark-help ()
2168   "Help command for bookmarks."
2169   (interactive)
2170   (let ((anything-help-message anything-bookmark-help-message))
2171     (anything-help)))
2172
2173 ;;; Eshell command on file help
2174 ;;
2175 ;;
2176 (defvar anything-c-esh-help-message
2177   "== Anything eshell on file ==
2178 \nTips:
2179
2180 - Passing extra args after filename:
2181
2182 Normally your command or alias will be called with file as argument.
2183
2184 e.g <command> 'candidate_file'
2185
2186 But you can also pass an argument or more after 'candidate_file' like this:
2187
2188 <command> %s [extra_args]\n
2189
2190 'candidate_file' will be inserted at '%s' and your command will look at this:
2191
2192 <command> 'candidate_file' [args]
2193
2194 - Specify many files as args (marked files):
2195
2196 e.g <command> file1 file2 ...
2197
2198 Please restart and use a prefix arg to call `anything-find-files-eshell-command-on-file'.
2199 Otherwise your command will be called many times like this:
2200
2201 <command> file1 <command> file2 etc...
2202
2203 \nSpecific commands for `anything-find-files-eshell-command-on-file':
2204 \\<anything-esh-on-file-map>
2205 \\[anything-esh-help]\t\t->Display this help.
2206 \n== Anything Map ==
2207 \\{anything-map}")
2208
2209 (defun anything-esh-help ()
2210   "Help command for `anything-find-files-eshell-command-on-file'."
2211   (interactive)
2212   (let ((anything-help-message anything-c-esh-help-message))
2213     (anything-help)))
2214
2215 \f
2216 ;;; Mode line strings
2217 ;;
2218 ;;
2219 (defvar anything-buffer-mode-line-string
2220   '("Buffer(s)"
2221     "\\<anything-c-buffer-map>\
2222 \\[anything-c-buffer-help]:Help, \
2223 \\<anything-map>\
2224 \\[anything-select-action]:Acts,\
2225 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
2226 \\[anything-select-3rd-action]:NthAct,\
2227 \\[anything-send-bug-report-from-anything]:BugReport."
2228     "String displayed in mode-line in `anything-c-source-buffers-list'"))
2229
2230 (defvar anything-ff-mode-line-string
2231   "\\<anything-find-files-map>\
2232 \\[anything-ff-help]:Help, \
2233 \\[anything-send-bug-report-from-anything]:BugReport, \
2234 \\<anything-map>\
2235 \\[anything-select-action]:Acts, \
2236 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
2237 \\[anything-select-3rd-action]:NthAct"
2238   "String displayed in mode-line in `anything-c-source-find-files'")
2239
2240 (defvar anything-read-file-name-mode-line-string
2241   "\\<anything-c-read-file-map>\
2242 \\[anything-read-file-name-help]:Help, \
2243 \\<anything-map>\
2244 \\[anything-select-action]:Acts,\
2245 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
2246 \\[anything-select-3rd-action]:NthAct"
2247   "String displayed in mode-line in `anything-c-source-find-files'")
2248
2249 (defvar anything-generic-file-mode-line-string
2250   "\\<anything-generic-files-map>\
2251 \\[anything-generic-file-help]:Help, \
2252 \\<anything-map>\
2253 \\[anything-select-action]:Acts,\
2254 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
2255 \\[anything-select-3rd-action]:NthAct,\
2256 \\[anything-send-bug-report-from-anything]:BugReport."
2257   "String displayed in mode-line in Locate.")
2258
2259 (defvar anything-grep-mode-line-string
2260   "\\<anything-c-grep-map>\
2261 \\[anything-grep-help]:Help,\
2262 \\<anything-map>\
2263 \\[anything-select-action]:Acts,\
2264 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
2265 \\[anything-select-3rd-action]:NthAct,\
2266 \\[anything-send-bug-report-from-anything]:BugReport."
2267   "String displayed in mode-line in `anything-do-grep'.")
2268
2269 (defvar anything-pdfgrep-mode-line-string
2270   "\\<anything-c-pdfgrep-map>\
2271 \\[anything-pdfgrep-help]:Help,\
2272 \\<anything-map>\
2273 \\[anything-select-action]:Acts,\
2274 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
2275 \\[anything-select-3rd-action]:NthAct,\
2276 \\[anything-send-bug-report-from-anything]:BugReport."
2277   "String displayed in mode-line in `anything-do-pdfgrep'.")
2278
2279 (defvar anything-etags-mode-line-string
2280   "\\<anything-c-etags-map>\
2281 \\[anything-etags-help]:Help,\
2282 \\<anything-map>\
2283 \\[anything-select-action]:Acts,\
2284 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
2285 \\[anything-select-3rd-action]:NthAct,\
2286 \\[anything-send-bug-report-from-anything]:BugReport."
2287   "String displayed in mode-line in `anything-c-etags-select'.")
2288
2289
2290 (defvar anything-c-ucs-mode-line-string
2291   "\\<anything-c-ucs-map>\
2292 \\[anything-c-ucs-help]:Help, \
2293 \\<anything-map>\
2294 \\[anything-select-action]:Acts,\
2295 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
2296 \\[anything-select-3rd-action]:NthAct."
2297   "String displayed in mode-line in `anything-ucs'.")
2298
2299 (defvar anything-bookmark-mode-line-string
2300   '("Bookmark(s)"
2301     "\\<anything-c-bookmark-map>\
2302 \\[anything-c-bookmark-help]:Help, \
2303 \\<anything-map>\
2304 \\[anything-select-action]:Acts,\
2305 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
2306 \\[anything-select-3rd-action]:NthAct,\
2307 \\[anything-send-bug-report-from-anything]:BugReport."
2308     "String displayed in mode-line in `anything-c-source-buffers-list'"))
2309
2310 (defvar anything-occur-mode-line
2311   "\\<anything-map>\
2312 \\[anything-help]:Help,\
2313 \\<anything-occur-map>\
2314 \\[anything-occur-run-query-replace-regexp]:Query replace regexp,\
2315 \\<anything-map>\
2316 \\[anything-select-action]:Acts,\
2317 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
2318 \\[anything-select-3rd-action]:NthAct,\
2319 \\[anything-send-bug-report-from-anything]:BugReport.")
2320
2321 \f
2322 ;;; Utilities Functions
2323 ;;
2324 ;;
2325 (defun anything-ff-find-printers ()
2326   "Return a list of available printers on Unix systems."
2327   (when (executable-find "lpstat")
2328     (let ((printer-list (with-temp-buffer
2329                           (call-process "lpstat" nil t nil "-a")
2330                           (split-string (buffer-string) "\n"))))
2331       (loop for p in printer-list
2332             for printer = (car (split-string p))
2333             when printer
2334             collect printer))))
2335
2336 ;; Shut up byte compiler in emacs24*.
2337 (defun anything-c-switch-to-buffer (buffer-or-name)
2338   "Same as `switch-to-buffer' whithout warnings at compile time."
2339   (with-no-warnings
2340     (switch-to-buffer buffer-or-name)))
2341
2342 (defun* anything-c-position (item seq &key (test 'eq) all)
2343   "A simple and faster replacement of CL `position'.
2344 Return position of first occurence of ITEM found in SEQ.
2345 Argument SEQ can be a string, in this case ITEM have to be a char.
2346 Argument ALL, if non--nil specify to return a list of positions of
2347 all ITEM found in SEQ."
2348   (let ((key (if (stringp seq) 'across 'in)))
2349     (eval
2350      `(loop for c ,key seq
2351             for index from 0
2352             when (funcall test c item)
2353             if all collect index into ls
2354             else return index
2355             finally return ls))))
2356
2357 (defun anything-c-get-pid-from-process-name (process-name)
2358   "Get pid from running process PROCESS-NAME."
2359   (loop with process-list = (list-system-processes)
2360         for pid in process-list
2361         for process = (assoc-default 'comm (process-attributes pid))
2362         when (and process (string-match process-name process))
2363         return pid))
2364
2365 (defun* anything-current-buffer-narrowed-p (&optional
2366                                             (buffer anything-current-buffer))
2367   "Check if BUFFER is narrowed.
2368 Default is `anything-current-buffer'."
2369   (with-current-buffer buffer
2370     (let ((beg (point-min))
2371           (end (point-max))
2372           (total (buffer-size)))
2373       (or (/= beg 1) (/= end (1+ total))))))
2374
2375 (defun anything-region-active-p ()
2376   (and transient-mark-mode mark-active (/= (mark) (point))))
2377
2378 (defun anything-goto-char (loc)
2379   "Go to char, revealing if necessary."
2380   (goto-char loc)
2381   (when (or (eq major-mode 'org-mode)
2382             (and (boundp 'outline-minor-mode)
2383                  outline-minor-mode))
2384     (require 'org) ; On some old Emacs versions org may not be loaded.
2385     (org-reveal)))
2386
2387 (defun anything-goto-line (lineno &optional noanim)
2388   "Goto LINENO opening only outline headline if needed.
2389 Animation is used unless NOANIM is non--nil."
2390   (goto-char (point-min))
2391   (anything-goto-char (point-at-bol lineno))
2392   (unless noanim
2393     (anything-match-line-color-current-line)
2394     (sit-for 0.3)
2395     (anything-match-line-cleanup)))
2396
2397 (defun anything-show-this-source-only ()
2398   "Show all candidates of this source."
2399   (interactive)
2400   (let (anything-candidate-number-limit)
2401     (anything-set-source-filter
2402      (list (assoc-default 'name (anything-get-current-source))))))
2403
2404 ;;;###autoload
2405 (defun anything-test-sources ()
2406   "List all anything sources for test.
2407 The output is sexps which are evaluated by \\[eval-last-sexp]."
2408   (interactive)
2409   (with-output-to-temp-buffer "*Anything Test Sources*"
2410     (mapc (lambda (s) (princ (format ";; (anything '%s)\n" s)))
2411           (apropos-internal "^anything-c-source" #'boundp))
2412     (pop-to-buffer standard-output)))
2413
2414 (defun anything-displaying-source-names ()
2415   "Display sources name."
2416   (with-current-buffer anything-buffer
2417     (goto-char (point-min))
2418     (loop with pos
2419           while (setq pos (next-single-property-change (point) 'anything-header))
2420           do (goto-char pos)
2421           collect (buffer-substring-no-properties (point-at-bol)(point-at-eol))
2422           do (forward-line 1))))
2423
2424 ;; [Obsolete]
2425 (defun anything-select-source ()
2426   "[OBSOLETE] Select source."
2427   (interactive)
2428   (let ((default (assoc-default 'name (anything-get-current-source)))
2429         (source-names (anything-displaying-source-names))
2430         (all-source-names (mapcar (lambda (s) (assoc-default 'name s))
2431                                   (anything-get-sources))))
2432     (setq anything-candidate-number-limit 9999)
2433     (anything-aif
2434         (let (anything-source-filter)
2435           (anything-nest '(((name . "Anything Source")
2436                             (candidates . source-names)
2437                             (action . identity))
2438                            ((name . "Anything Source (ALL)")
2439                             (candidates . all-source-names)
2440                             (action . identity)))
2441                          nil "Source: " nil
2442                          default "*anything select source*"))
2443         (anything-set-source-filter (list it))
2444       (anything-set-source-filter nil))))
2445
2446 (defun anything-insert-string (str)
2447   "Insert STR."
2448   (anything-set-pattern str 'noupdate))
2449
2450 ;;;###autoload
2451 (defun anything-insert-buffer-name ()
2452   "Insert buffer name."
2453   (interactive)
2454   (anything-set-pattern
2455    (with-anything-current-buffer
2456      (if buffer-file-name (file-name-nondirectory buffer-file-name)
2457        (buffer-name)))))
2458
2459 (defalias 'anything-insert-symbol 'next-history-element)
2460 (defalias 'anything-insert-selection 'anything-yank-selection)
2461
2462 (defun anything-c-match-on-file-name (candidate)
2463   "Return non-nil if `anything-pattern' match basename of filename CANDIDATE."
2464   (string-match anything-pattern (file-name-nondirectory candidate)))
2465
2466 (defun anything-c-match-on-directory-name (candidate)
2467   "Return non-nil if `anything-pattern' match directory part of CANDIDATE."
2468   (anything-aif (file-name-directory candidate)
2469       (string-match anything-pattern it)))
2470
2471 (defun anything-c-match-on-basename (candidate)
2472   "Return non-nil if `anything-pattern' match basename of filename CANDIDATE."
2473   (string-match anything-pattern (anything-c-basename candidate)))
2474
2475 (defun anything-c-string-match (candidate)
2476   "Return non-nil if `anything-pattern' match CANDIDATE.
2477 The match is done with `string-match'."
2478   (string-match anything-pattern candidate))
2479
2480 (defun anything-c-skip-entries (list regexp)
2481   "Remove entries which matches REGEXP from LIST."
2482   (remove-if (lambda (x) (and (stringp x) (string-match regexp x)))
2483              list))
2484
2485 (defun anything-c-shadow-entries (list regexp)
2486   "Display elements of LIST matching REGEXP with the `file-name-shadow' face."
2487   (mapcar (lambda (file)
2488             ;; Add shadow face property to boring files.
2489             (let ((face (if (facep 'file-name-shadow)
2490                             'file-name-shadow
2491                             ;; fall back to default on XEmacs
2492                             'default)))
2493               (if (string-match regexp file)
2494                   (setq file (propertize file 'face face))))
2495             file)
2496           list))
2497
2498 (defsubst anything-c-stringify (str-or-sym)
2499   "Get string of STR-OR-SYM."
2500   (if (stringp str-or-sym)
2501       str-or-sym
2502       (symbol-name str-or-sym)))
2503
2504 (defsubst anything-c-symbolify (str-or-sym)
2505   "Get symbol of STR-OR-SYM."
2506   (if (symbolp str-or-sym)
2507       str-or-sym
2508       (intern str-or-sym)))
2509
2510 (defun anything-c-describe-function (func)
2511   "FUNC is symbol or string."
2512   (describe-function (anything-c-symbolify func)))
2513
2514 (defun anything-c-describe-variable (var)
2515   "VAR is symbol or string."
2516   (describe-variable (anything-c-symbolify var)))
2517
2518 (defun anything-c-find-function (func)
2519   "FUNC is symbol or string."
2520   (find-function (anything-c-symbolify func)))
2521
2522 (defun anything-c-find-variable (var)
2523   "VAR is symbol or string."
2524   (find-variable (anything-c-symbolify var)))
2525
2526 (defun anything-c-kill-new (candidate &optional replace)
2527   "CANDIDATE is symbol or string.
2528 See `kill-new' for argument REPLACE."
2529   (kill-new (anything-c-stringify candidate) replace))
2530
2531 (defun* anything-fast-remove-dups (seq &key (test 'eq))
2532   "Remove duplicates elements in list SEQ.
2533 This is same as `remove-duplicates' but with memoisation.
2534 It is much faster, especially in large lists.
2535 A test function can be provided with TEST argument key.
2536 Default is `eq'."
2537   (loop with cont = (make-hash-table :test test)
2538         for elm in seq
2539         unless (gethash elm cont)
2540         do (puthash elm elm cont)
2541         finally return
2542         (loop for i being the hash-values in cont collect i)))
2543
2544 (defadvice eval-defun (after anything-source-hack activate)
2545   "Allow immediate execution of anything source when evaling it.
2546 See `anything-c-enable-eval-defun-hack'."
2547   (when anything-c-enable-eval-defun-hack
2548     (let ((varsym (save-excursion
2549                     (beginning-of-defun)
2550                     (forward-char 1)
2551                     (when (memq (read (current-buffer)) '(defvar setq))
2552                       (read (current-buffer))))))
2553       (when (string-match "^anything-c-source-" (symbol-name varsym))
2554         (anything varsym)))))
2555 ;; (progn (ad-disable-advice 'eval-defun 'after 'anything-source-hack) (ad-update 'eval-defun))
2556
2557
2558 ;; Move this function from anything.el and redefine here
2559 ;; to avoid an unneeded defadvice.
2560 (defun anything-quit-and-find-file ()
2561   "Drop into `anything-find-files' from `anything'.
2562 If current selection is a buffer or a file, `anything-find-files'
2563 from its directory."
2564   (interactive)
2565   (anything-run-after-quit
2566    (lambda (f)
2567      (if (file-exists-p f)
2568          (anything-find-files-1 (file-name-directory f)
2569                                 (if anything-ff-transformer-show-only-basename
2570                                     (anything-c-basename f) f))
2571          (anything-find-files-1 f)))
2572    (anything-aif (get-buffer (anything-get-selection))
2573        (or (buffer-file-name it)
2574            (car (rassoc it dired-buffers))
2575            (and (with-current-buffer it
2576                   (eq major-mode 'org-agenda-mode))
2577                 org-directory
2578                 (expand-file-name org-directory))
2579            default-directory)
2580      (let ((sel (anything-get-selection)))
2581        (cond ((or (file-remote-p sel)
2582                   (file-exists-p sel))
2583               (expand-file-name sel))
2584              ((string-match ffap-url-regexp sel)
2585               sel)
2586              (t default-directory))))))
2587
2588
2589 (defmacro* anything-c-walk-directory (directory &key path (directories t) match)
2590   "Walk through DIRECTORY tree.
2591 PATH can be one of basename, relative, or full.
2592 DIRECTORIES when non--nil (default) return also directories names, otherwise
2593 skip directories names.
2594 MATCH match only filenames matching regexp MATCH."
2595   `(let (result
2596          (fn (case ,path
2597                (basename 'file-name-nondirectory)
2598                (relative 'file-relative-name)
2599                (full     'identity)
2600                (t        'file-name-nondirectory))))
2601      (labels ((ls-R (dir)
2602                 (loop with ls = (directory-files dir t directory-files-no-dot-files-regexp)
2603                       for f in ls
2604                       if (file-directory-p f)
2605                       do (progn (when ,directories
2606                                   (push (funcall fn f) result))
2607                                 ;; Don't recurse in directory symlink.
2608                                 (unless (file-symlink-p f)
2609                                   (ls-R f)))
2610                       else do
2611                       (unless (and ,match (not (string-match ,match (file-name-nondirectory f))))
2612                         (push (funcall fn f) result)))))
2613        (ls-R ,directory)
2614        (nreverse result))))
2615
2616 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Anything Applications ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2617
2618 ;;; Anything regexp.
2619 ;;
2620 ;;
2621 (defvar anything-build-regexp-history nil)
2622 (defun anything-c-query-replace-regexp (candidate)
2623   "Query replace regexp from `anything-regexp'.
2624 With a prefix arg replace only matches surrounded by word boundaries,
2625 i.e Don't replace inside a word, regexp is surrounded with \\bregexp\\b."
2626   (let ((regexp (funcall (anything-attr 'regexp))))
2627     (apply 'query-replace-regexp
2628            (anything-c-query-replace-args regexp))))
2629
2630 (defun anything-c-kill-regexp-as-sexp (candidate)
2631   "Kill regexp in a format usable in lisp code."
2632   (anything-c-regexp-kill-new
2633    (prin1-to-string (funcall (anything-attr 'regexp)))))
2634
2635 (defun anything-c-kill-regexp (candidate)
2636   "Kill regexp as it is in `anything-pattern'."
2637   (anything-c-regexp-kill-new (funcall (anything-attr 'regexp))))
2638
2639 (defun anything-c-query-replace-args (regexp)
2640   "create arguments of `query-replace-regexp' action in `anything-regexp'."
2641   (let ((region-only (anything-region-active-p)))
2642     (list
2643      regexp
2644      (query-replace-read-to regexp
2645                             (format "Query replace %sregexp %s"
2646                                     (if anything-current-prefix-arg "word " "")
2647                                     (if region-only "in region " ""))
2648                             t)
2649      anything-current-prefix-arg
2650      (when region-only (region-beginning))
2651      (when region-only (region-end)))))
2652
2653 (defvar anything-c-source-regexp
2654   '((name . "Regexp Builder")
2655     (init . (lambda ()
2656               (anything-candidate-buffer anything-current-buffer)))
2657     (candidates-in-buffer)
2658     (get-line . anything-c-regexp-get-line)
2659     (persistent-action . anything-c-regexp-persistent-action)
2660     (persistent-help . "Show this line")
2661     (multiline)
2662     (delayed)
2663     (requires-pattern . 2)
2664     (mode-line . "Press TAB to select action.")
2665     (regexp . (lambda () anything-input))
2666     (action . (("Kill Regexp as sexp" . anything-c-kill-regexp-as-sexp)
2667                ("Query Replace Regexp (C-u Not inside word.)"
2668                 . anything-c-query-replace-regexp)
2669                ("Kill Regexp" . anything-c-kill-regexp)))))
2670
2671 (defun anything-c-regexp-get-line (s e)
2672   (propertize
2673    (apply 'concat
2674           ;; Line contents
2675           (format "%5d: %s" (line-number-at-pos (1- s)) (buffer-substring s e))
2676           ;; subexps
2677           (loop for i from 0 to (1- (/ (length (match-data)) 2))
2678                 collect (format "\n         %s'%s'"
2679                                 (if (zerop i) "Group 0: " (format "Group %d: " i))
2680                                 (match-string i))))
2681    ;; match beginning
2682    ;; KLUDGE: point of anything-candidate-buffer is +1 than that of anything-current-buffer.
2683    ;; It is implementation problem of candidates-in-buffer.
2684    'anything-realvalue
2685    (1- s)))
2686
2687 (defun anything-c-regexp-persistent-action (pt)
2688   (anything-goto-char pt)
2689   (anything-persistent-highlight-point))
2690
2691 (defun anything-c-regexp-kill-new (input)
2692   (kill-new input)
2693   (message "Killed: %s" input))
2694
2695 (defun anything-quote-whitespace (candidate)
2696   "Quote whitespace, if some, in string CANDIDATE."
2697   (replace-regexp-in-string " " "\\\\ " candidate))
2698
2699 \f
2700 ;;; Toggle all marks.
2701 ;;
2702 ;;
2703 ;;;###autoload
2704 (defun anything-mark-all ()
2705   "Mark all visible unmarked candidates in current source."
2706   (interactive)
2707   (with-anything-window
2708     (save-excursion
2709       (goto-char (anything-get-previous-header-pos))
2710       (anything-next-line)
2711       (let* ((next-head (anything-get-next-header-pos))
2712              (end       (and next-head
2713                              (save-excursion
2714                                (goto-char next-head)
2715                                (forward-line -1)
2716                                (point))))
2717              (maxpoint  (or end (point-max))))
2718         (while (< (point) maxpoint)
2719           (anything-mark-current-line)
2720           (let* ((prefix (get-text-property (point-at-bol) 'display))
2721                  (cand   (anything-get-selection))
2722                  (bn     (and (anything-file-completion-source-p)
2723                               (anything-c-basename cand)))
2724                  (src    (assoc-default 'name (anything-get-current-source))))
2725             (when (and (not (anything-this-visible-mark))
2726                        (not (or (string= prefix "[?]")
2727                                 (string= prefix "[@]"))))
2728               ;; Don't mark possibles directories ending with . or ..
2729               ;; autosave files/links and non--existent file.
2730               (unless
2731                   (and (or (anything-file-completion-source-p)
2732                            (equal src "Files from Current Directory"))
2733                        (or (string-match "^\\.#.*\\|^#.*#$\\|\\.$" bn)
2734                            ;; We need to test here when not using a transformer
2735                            ;; that tag prefix (i.e on tramp)
2736                            (not (file-exists-p cand))))
2737                 (anything-make-visible-mark))))
2738           (forward-line 1) (end-of-line))))
2739     (anything-mark-current-line)
2740     (message "%s candidates marked" (length anything-marked-candidates))))
2741
2742 ;;;###autoload
2743 (defun anything-unmark-all ()
2744   "Unmark all candidates in all sources of current anything session."
2745   (interactive)
2746   (with-anything-window
2747     (let ((len (length anything-marked-candidates)))
2748       (save-excursion
2749         (anything-clear-visible-mark))
2750       (setq anything-marked-candidates nil)
2751       (anything-mark-current-line)
2752       (message "%s candidates unmarked" len))))
2753
2754 ;;;###autoload
2755 (defun anything-toggle-all-marks ()
2756   "Toggle all marks.
2757 Mark all visible candidates of current source or unmark all candidates
2758 visible or invisible in all sources of current anything session"
2759   (interactive)
2760   (let ((marked (anything-marked-candidates)))
2761     (if (and (>= (length marked) 1)
2762              (with-anything-window anything-visible-mark-overlays))
2763         (anything-unmark-all)
2764         (anything-mark-all))))
2765
2766
2767 \f
2768 ;;; Buffers
2769 ;;
2770 ;;
2771 (defun anything-c-buffer-list ()
2772   "Return a list of buffer names.
2773 The first buffer in the list will be the last recently used
2774 buffer that is not the current buffer unless
2775 `anything-allow-skipping-current-buffer' is nil."
2776   (let ((buffers (mapcar 'buffer-name (buffer-list))))
2777     (if anything-allow-skipping-current-buffer
2778         (progn
2779           (setq buffers (remove (buffer-name anything-current-buffer) buffers))
2780           (append (cdr buffers) (list (car buffers))))
2781         buffers)))
2782
2783 (defvar anything-c-source-buffers
2784   '((name . "Buffers")
2785     (candidates . anything-c-buffer-list)
2786     (type . buffer)))
2787
2788 (defvar anything-c-source-buffer-not-found
2789   `((name . "Create buffer")
2790     (dummy)
2791     (filtered-candidate-transformer (lambda (cands source)
2792                                       (list anything-pattern)))
2793     (keymap . ,anything-map)
2794     (action . (lambda (candidate)
2795                 (anything-c-switch-to-buffer (get-buffer-create candidate))))))
2796
2797 ;;; Buffers-list (was buffers+)
2798 ;;
2799 ;;
2800 (defun anything-c-highlight-buffers (buffers)
2801   "Transformer function to highlight BUFFERS list.
2802 Should be called after others transformers i.e (boring buffers)."
2803   (loop with buflist = (if anything-allow-skipping-current-buffer
2804                            buffers
2805                            (cons (pop (cdr buffers)) buffers))
2806         for i in buflist
2807         for buf = (get-buffer i)
2808         for bfname = (buffer-file-name buf)
2809         collect
2810         (cond (;; A dired buffer.
2811                (rassoc buf dired-buffers)
2812                (propertize i 'face 'anything-ff-directory
2813                            'help-echo (car (rassoc buf dired-buffers))))
2814               ;; A buffer file modified somewhere outside of emacs.
2815               ((and bfname (not (file-remote-p bfname))
2816                     (file-exists-p bfname)
2817                     (not (verify-visited-file-modtime buf)))
2818                (propertize i 'face 'anything-buffer-saved-out
2819                            'help-echo bfname))
2820               ;; A new buffer file not already saved on disk.
2821               ((and bfname (not (file-remote-p bfname))
2822                     (not (verify-visited-file-modtime buf)))
2823                (propertize i 'face 'anything-buffer-not-saved
2824                            'help-echo bfname))
2825               ;; A Remote buffer file modified and not saved on disk.
2826               ((and bfname (file-remote-p bfname) (buffer-modified-p buf))
2827                (let ((prefix (propertize
2828                               " " 'display
2829                               (propertize "@ " 'face 'anything-ff-prefix))))
2830                  (cons (concat prefix (propertize i 'face 'anything-ff-symlink
2831                                                   'help-echo bfname)) i)))
2832               ;; A buffer file modified and not saved on disk.
2833               ((and bfname (buffer-modified-p buf))
2834                (propertize i 'face 'anything-ff-symlink
2835                            'help-echo bfname))
2836               ;; A remote buffer file not modified and saved on disk.
2837               ((and bfname (file-remote-p bfname))
2838                (let ((prefix (propertize
2839                               " " 'display
2840                               (propertize "@ " 'face 'anything-ff-prefix))))
2841                  (cons (concat prefix (propertize i 'face 'font-lock-type-face
2842                                                   'help-echo bfname)) i)))
2843               ;; A buffer file not modified and saved on disk.
2844               (bfname
2845                (propertize i 'face 'font-lock-type-face
2846                            'help-echo bfname))
2847               ;; Any non--file buffer.
2848               (t (propertize i 'face 'italic)))))
2849
2850
2851 (defvar anything-c-source-buffers-list
2852   `((name . "Buffers")
2853     (candidates . anything-c-buffer-list)
2854     (type . buffer)
2855     (match anything-c-buffer-match-major-mode)
2856     (candidate-transformer anything-c-skip-boring-buffers
2857                            anything-c-highlight-buffers)
2858     (persistent-action . anything-c-buffers-list-persistent-action)
2859     (keymap . ,anything-c-buffer-map)
2860     (volatile)
2861     (mode-line . anything-buffer-mode-line-string)
2862     (persistent-help . "Show this buffer / C-u \\[anything-execute-persistent-action]: Kill this buffer")))
2863
2864 (defvaralias 'anything-c-source-buffers+ 'anything-c-source-buffers-list)
2865
2866 (defun anything-c-buffer-match-major-mode (candidate)
2867   "Match maybe buffer by major-mode.
2868 If you give a major-mode or partial major-mode,
2869 it will list all buffers of this major-mode and/or buffers with name
2870 matching this major-mode.
2871 If you add a space after major-mode and then a space,
2872 it will match all buffers of the major-mode
2873 before space matching pattern after space.
2874 If you give a pattern which doesn't match a major-mode, it will search buffer
2875 with name matching pattern."
2876   (let* ((cand (replace-regexp-in-string "^\\s-\\{1\\}" "" candidate))
2877          (buf  (get-buffer cand)))
2878     (when buf
2879       (with-current-buffer buf
2880         (let ((mjm   (symbol-name major-mode))
2881               (split (split-string anything-pattern)))
2882           (cond ((string-match "\\s-$" anything-pattern)
2883                  (string-match (car split) mjm))
2884                 ((string-match "\\s-" anything-pattern)
2885                  (and (string-match (car split) mjm)
2886                       (string-match (cadr split) cand)))
2887                 (t (or (string-match anything-pattern mjm)
2888                        (string-match anything-pattern cand)))))))))
2889
2890 (defun anything-c-buffer-query-replace-1 (&optional regexp-flag)
2891   "Query replace in marked buffers.
2892 If REGEXP-FLAG is given use `query-replace-regexp'."
2893   (let ((fn     (if regexp-flag 'query-replace-regexp 'query-replace))
2894         (prompt (if regexp-flag "Query replace regexp" "Query replace"))
2895         (bufs   (anything-marked-candidates)))
2896     (loop
2897           with replace = (query-replace-read-from prompt regexp-flag)
2898           with tostring = (unless (consp replace)
2899                             (query-replace-read-to
2900                              replace prompt regexp-flag))
2901           for buf in bufs
2902           do
2903           (save-window-excursion
2904             (anything-c-switch-to-buffer buf)
2905             (save-excursion
2906               (let ((case-fold-search t))
2907                 (goto-char (point-min))
2908                 (if (consp replace)
2909                     (apply fn (list (car replace) (cdr replace)))
2910                     (apply fn (list replace tostring)))))))))
2911
2912 (defun anything-c-buffer-query-replace-regexp (candidate)
2913   (anything-c-buffer-query-replace-1 'regexp))
2914
2915 (defun anything-c-buffer-query-replace (candidate)
2916   (anything-c-buffer-query-replace-1))
2917
2918 (defun anything-buffer-toggle-diff (candidate)
2919   "Toggle diff buffer CANDIDATE with it's file."
2920   (if (get-buffer-window "*Diff*")
2921       (kill-buffer "*Diff*")
2922       (diff-buffer-with-file (get-buffer candidate))))
2923
2924 ;;;###autoload
2925 (defun anything-buffer-diff-persistent ()
2926   "Toggle diff buffer without quitting anything."
2927   (interactive)
2928   (anything-attrset 'diff-action 'anything-buffer-toggle-diff)
2929   (anything-execute-persistent-action 'diff-action))
2930
2931 (defun anything-buffer-revert-and-update (candidate)
2932   (let ((marked (anything-marked-candidates)))
2933     (loop for buf in marked do (anything-revert-buffer buf))
2934     (anything-force-update candidate)))
2935
2936 ;;;###autoload
2937 (defun anything-buffer-revert-persistent ()
2938   "Revert buffer without quitting anything."
2939   (interactive)
2940   (anything-attrset 'revert-action 'anything-buffer-revert-and-update)
2941   (anything-execute-persistent-action 'revert-action 'onewindow))
2942
2943 (defun anything-buffer-save-and-update (candidate)
2944   (let ((marked (anything-marked-candidates))
2945         (enable-recursive-minibuffers t))
2946     (loop for buf in marked do
2947           (with-current-buffer (get-buffer buf)
2948             (save-buffer)))
2949     (anything-force-update candidate)))
2950
2951 ;;;###autoload
2952 (defun anything-buffer-save-persistent ()
2953   "Save buffer without quitting anything."
2954   (interactive)
2955   (anything-attrset 'save-action 'anything-buffer-save-and-update)
2956   (anything-execute-persistent-action 'save-action 'onewindow))
2957
2958 ;;;###autoload
2959 (defun anything-buffer-run-kill-buffers ()
2960   "Run kill buffer action from `anything-c-source-buffers-list'."
2961   (interactive)
2962   (anything-c-quit-and-execute-action 'anything-kill-marked-buffers))
2963
2964 ;;;###autoload
2965 (defun anything-buffer-run-grep ()
2966   "Run Grep action from `anything-c-source-buffers-list'."
2967   (interactive)
2968   (anything-c-quit-and-execute-action 'anything-c-grep-buffers))
2969
2970 ;;;###autoload
2971 (defun anything-buffer-run-zgrep ()
2972   "Run Grep action from `anything-c-source-buffers-list'."
2973   (interactive)
2974   (anything-c-quit-and-execute-action 'anything-c-zgrep-buffers))
2975
2976 ;;;###autoload
2977 (defun anything-buffer-run-query-replace-regexp ()
2978   "Run Query replace regexp action from `anything-c-source-buffers-list'."
2979   (interactive)
2980   (anything-c-quit-and-execute-action 'anything-c-buffer-query-replace-regexp))
2981
2982 ;;;###autoload
2983 (defun anything-buffer-run-query-replace ()
2984   "Run Query replace action from `anything-c-source-buffers-list'."
2985   (interactive)
2986   (anything-c-quit-and-execute-action 'anything-c-buffer-query-replace))
2987
2988 ;;;###autoload
2989 (defun anything-buffer-switch-other-window ()
2990   "Run switch to other window action from `anything-c-source-buffers-list'."
2991   (interactive)
2992   (anything-c-quit-and-execute-action 'switch-to-buffer-other-window))
2993
2994 ;;;###autoload
2995 (defun anything-buffer-switch-other-frame ()
2996   "Run switch to other frame action from `anything-c-source-buffers-list'."
2997   (interactive)
2998   (anything-c-quit-and-execute-action 'switch-to-buffer-other-frame))
2999
3000 ;;;###autoload
3001 (defun anything-buffer-switch-to-elscreen ()
3002   "Run switch to elscreen  action from `anything-c-source-buffers-list'."
3003   (interactive)
3004   (anything-c-quit-and-execute-action 'anything-find-buffer-on-elscreen))
3005
3006 ;;;###autoload
3007 (defun anything-buffer-run-ediff ()
3008   "Run ediff action from `anything-c-source-buffers-list'."
3009   (interactive)
3010   (anything-c-quit-and-execute-action 'anything-ediff-marked-buffers))
3011
3012 (defun anything-buffer-run-ediff-merge ()
3013   "Run ediff action from `anything-c-source-buffers-list'."
3014   (interactive)
3015   (anything-c-quit-and-execute-action 'anything-ediff-marked-buffers-merge))
3016
3017 (defun anything-c-buffers-persistent-kill (buffer)
3018   "Persistent action to kill buffer."
3019   (with-current-buffer (get-buffer buffer)
3020     (if (and (buffer-modified-p)
3021              (buffer-file-name (current-buffer)))
3022         (progn
3023           (save-buffer)
3024           (kill-buffer buffer))
3025         (kill-buffer buffer)))
3026   (anything-delete-current-selection))
3027
3028 (defun anything-c-buffers-list-persistent-action (candidate)
3029   (if current-prefix-arg
3030       (anything-c-buffers-persistent-kill candidate)
3031       (anything-c-switch-to-buffer candidate)))
3032
3033 \f
3034 ;;;; <File>
3035 ;;
3036 ;;
3037 ;;; File name history
3038 (defvar anything-c-source-file-name-history
3039   '((name . "File Name History")
3040     (candidates . file-name-history)
3041     (match anything-c-match-on-basename)
3042     (type . file)))
3043
3044 ;;; Files in current dir
3045 ;;
3046 ;;
3047 (defvar anything-c-source-files-in-current-dir
3048   '((name . "Files from Current Directory")
3049     (candidates . (lambda ()
3050                     (with-anything-current-buffer
3051                       (directory-files (anything-c-current-directory)))))
3052     ;; volatile is not needed, I think.
3053     (type . file)))
3054
3055 (defun anything-c-highlight-files (files)
3056   (loop for i in files
3057         if (file-directory-p i)
3058         collect (propertize (file-name-nondirectory i)
3059                             'face 'anything-ff-directory
3060                             'help-echo (expand-file-name i))
3061         else
3062         collect (propertize (file-name-nondirectory i)
3063                             'face 'anything-ff-file
3064                             'help-echo (expand-file-name i))))
3065
3066 (defvar anything-c-source-files-in-current-dir+
3067   `((name . "Files from Current Directory")
3068     (candidates . (lambda ()
3069                     (with-anything-current-buffer
3070                       (directory-files (anything-c-current-directory) t))))
3071     (keymap . ,anything-generic-files-map)
3072     (help-message . anything-generic-file-help-message)
3073     (mode-line . anything-generic-file-mode-line-string)
3074     (candidate-transformer anything-c-highlight-files)
3075     ;; volatile is not needed, I think.
3076     (type . file)))
3077
3078
3079 \f
3080 ;;; Anything-find-files - The anything files browser.
3081 ;;
3082 ;;
3083 ;; Internal.
3084 (defvar anything-c-find-files-doc-header " (`C-l': Go to precedent level)"
3085   "*The doc that is inserted in the Name header of a find-files or dired source.")
3086 (defvar anything-ff-auto-update-flag nil
3087   "Internal, flag to turn on/off auto-update in `anything-find-files'.
3088 Don't set it directly, use instead `anything-ff-auto-update-initial-value'.")
3089 (defvar anything-ff-last-expanded nil
3090   "Store last expanded directory or file.")
3091 (defvar anything-ff-default-directory nil)
3092 (defvar anything-ff-history nil)
3093 (defvar anything-ff-cand-to-mark nil)
3094 (defvar anything-ff-url-regexp
3095   "\\`\\(news\\(post\\)?:\\|nntp:\\|mailto:\\|file:\\|\\(ftp\\|https?\\|telnet\\|gopher\\|www\\|wais\\):/?/?\\).*"
3096   "Same as `ffap-url-regexp' but match earlier possible url.")
3097
3098 (defvar anything-c-source-find-files
3099   `((name . "Find Files")
3100     (header-name . (lambda (name)
3101                      (concat name anything-c-find-files-doc-header)))
3102     ;; It is needed for filenames with capital letters
3103     (disable-shortcuts)
3104     (init . (lambda ()
3105               (setq anything-ff-auto-update-flag
3106                     anything-ff-auto-update-initial-value)))
3107     (candidates . anything-find-files-get-candidates)
3108     (filtered-candidate-transformer anything-c-find-files-transformer)
3109     (persistent-action . anything-find-files-persistent-action)
3110     (persistent-help . "Hit1 Expand Candidate, Hit2 or (C-u) Find file")
3111     (mode-line . anything-ff-mode-line-string)
3112     (volatile)
3113     (candidate-number-limit . 9999)
3114     (action-transformer . anything-find-files-action-transformer)
3115     (action
3116      . ,(delq
3117          nil
3118          `(("Find File" . anything-c-find-file-or-marked)
3119            ("Find file in Dired" . anything-c-point-file-in-dired)
3120            ,(and (locate-library "elscreen")
3121                  '("Find file in Elscreen"  . anything-elscreen-find-file))
3122            ,(and (locate-library "popwin")
3123                  '("Find file in popup window" . popwin:find-file))
3124            ("Checksum File" . anything-ff-checksum)
3125            ("Complete at point `M-tab'"
3126             . anything-c-insert-file-name-completion-at-point)
3127            ("Open file externally `C-c C-x, C-u to choose'"
3128             . anything-c-open-file-externally)
3129            ("Grep File(s) `M-g s, C-u Recurse'" . anything-find-files-grep)
3130            ("Zgrep File(s) `M-g z, C-u Recurse'" . anything-ff-zgrep)
3131            ("Switch to Eshell `M-e'" . anything-ff-switch-to-eshell)
3132            ("Etags `M-., C-u tap, C-u C-u reload tag file'" . anything-ff-etags-select)
3133            ("Eshell command on file(s) `M-!, C-u run on all marked at once.'"
3134             . anything-find-files-eshell-command-on-file)
3135            ("Find file as root" . anything-find-file-as-root)
3136            ("Find file in hex dump" . hexl-find-file)
3137            ("Ediff File `C-='" . anything-find-files-ediff-files)
3138            ("Ediff Merge File `C-c ='" . anything-find-files-ediff-merge-files)
3139            ("Delete File(s) `M-D'" . anything-delete-marked-files)
3140            ("Copy file(s) `M-C, C-u to follow'" . anything-find-files-copy)
3141            ("Copy file(s) Async" . anything-ff-copy-async)
3142            ("Rename file(s) `M-R, C-u to follow'" . anything-find-files-rename)
3143            ("Serial rename files" . anything-ff-serial-rename)
3144            ("Serial rename by symlinking files" . anything-ff-serial-rename-by-symlink)
3145            ("Serial rename by copying files" . anything-ff-serial-rename-by-copying)
3146            ("Symlink files(s) `M-S, C-u to follow'" . anything-find-files-symlink)
3147            ("Relsymlink file(s) `C-u to follow'" . anything-find-files-relsymlink)
3148            ("Hardlink file(s) `M-H, C-u to follow'" . anything-find-files-hardlink)
3149            ("Find file other window `C-o'" . find-file-other-window)
3150            ("Switch to history `M-p'" . anything-find-files-switch-to-hist)
3151            ("Find file other frame `C-c C-o'" . find-file-other-frame)
3152            ("Print File `C-c p, C-u to refresh'" . anything-ff-print)
3153            ("Locate `C-x C-f, C-u to specify locate db'" . anything-ff-locate))))))
3154
3155 (defun anything-find-files-set-prompt-for-action (action files)
3156   "Set prompt for action ACTION for FILES."
3157   (let ((len (length files)))
3158     (format "%s *%s File(s)\n%s to: "
3159             action len
3160             (mapconcat (lambda (f)
3161                          (format "- %s\n" f)) files ""))))
3162
3163 (defun anything-dwim-target-directory ()
3164   "Return value of `default-directory' of buffer in other window.
3165 If there is only one window return the value ot `default-directory'
3166 for current buffer."
3167   (with-anything-current-buffer
3168     (let ((num-windows (length (window-list))))
3169       (if (> num-windows 1)
3170           (save-selected-window
3171             (other-window 1)
3172             default-directory)
3173           (car anything-ff-history)))))
3174
3175 (defun anything-find-files-do-action (action)
3176   "Generic function for creating action from `anything-c-source-find-files'.
3177 ACTION must be an action supported by `anything-dired-action'."
3178   (let* ((ifiles (mapcar 'expand-file-name ; Allow modify '/foo/.' -> '/foo'
3179                          (anything-marked-candidates)))
3180          (cand   (anything-get-selection)) ; Target
3181          (prompt (anything-find-files-set-prompt-for-action
3182                   (capitalize (symbol-name action)) ifiles))
3183          (parg   anything-current-prefix-arg)
3184          (dest   (anything-c-read-file-name
3185                   prompt
3186                   :preselect (if anything-ff-transformer-show-only-basename
3187                                  (anything-c-basename cand) cand)
3188                   :initial-input (anything-dwim-target-directory)
3189                   :history (anything-find-files-history :comp-read nil))))
3190     (anything-dired-action
3191      dest :files ifiles :action action :follow parg)))
3192
3193 (defun anything-find-files-copy (candidate)
3194   "Copy files from `anything-find-files'."
3195   (anything-find-files-do-action 'copy))
3196
3197 (defun anything-find-files-rename (candidate)
3198   "Rename files from `anything-find-files'."
3199   (anything-find-files-do-action 'rename))
3200
3201 (defun anything-find-files-symlink (candidate)
3202   "Symlink files from `anything-find-files'."
3203   (anything-find-files-do-action 'symlink))
3204
3205 (defun anything-find-files-relsymlink (candidate)
3206   "Relsymlink files from `anything-find-files'."
3207   (anything-find-files-do-action 'relsymlink))
3208
3209 (defun anything-find-files-hardlink (candidate)
3210   "Hardlink files from `anything-find-files'."
3211   (anything-find-files-do-action 'hardlink))
3212
3213 (defun anything-find-files-byte-compile (candidate)
3214   "Byte compile elisp files from `anything-find-files'."
3215   (let ((files    (anything-marked-candidates))
3216         (parg     anything-current-prefix-arg))
3217     (loop for fname in files
3218           do (byte-compile-file fname parg))))
3219
3220 (defun anything-find-files-load-files (candidate)
3221   "Load elisp files from `anything-find-files'."
3222   (let ((files    (anything-marked-candidates)))
3223     (loop for fname in files
3224           do (load fname))))
3225
3226 (defun anything-find-files-ediff-files-1 (candidate &optional merge)
3227   "Generic function to ediff/merge files in `anything-find-files'."
3228   (let ((bname  (anything-c-basename candidate))
3229         (prompt (if merge "Ediff Merge `%s' With File: "
3230                     "Ediff `%s' With File: "))
3231         (fun    (if merge 'ediff-merge-files 'ediff-files)))
3232     (funcall fun
3233              candidate
3234              (condition-case quit
3235                  (anything-c-read-file-name
3236                   (format prompt bname))
3237                (quit ;; Hit C-g ask user to fallback to locate.
3238                 (if (y-or-n-p "Search file for ediff with locate? ")
3239                     (anything-c-locate-read-file-name
3240                      (format prompt bname)
3241                      ;; Check if -b option is available.
3242                      (if (and (eq system-type 'windows-nt)
3243                               (string-match "^es" anything-c-locate-command))
3244                          bname
3245                          (concat bname " -b")))
3246                     (error "Error: Ediff Operation aborted")))))))
3247
3248 (defun anything-find-files-ediff-files (candidate)
3249   (anything-find-files-ediff-files-1 candidate))
3250
3251 (defun anything-find-files-ediff-merge-files (candidate)
3252   (anything-find-files-ediff-files-1 candidate 'merge))
3253
3254 (defun anything-find-files-grep (candidate)
3255   "Default action to grep files from `anything-find-files'."
3256   (anything-do-grep-1 (anything-marked-candidates)
3257                       anything-current-prefix-arg))
3258
3259 (defun anything-ff-zgrep (candidate)
3260   "Default action to zgrep files from `anything-find-files'."
3261   (let ((prefarg anything-current-prefix-arg)
3262         (ls      (anything-marked-candidates)))
3263     (anything-ff-zgrep-1 ls prefarg)))
3264
3265 (defun anything-ff-pdfgrep (candidate)
3266   "Default action to pdfgrep files from `anything-find-files'."
3267   (let ((cands (loop for file in (anything-marked-candidates)
3268                      if (or (string= (file-name-extension file) "pdf")
3269                             (string= (file-name-extension file) "PDF"))
3270                      collect file))
3271         (anything-c-pdfgrep-default-function 'anything-c-pdfgrep-init))
3272     (when cands
3273       (anything-do-pdfgrep-1 cands))))
3274
3275 (defun anything-ff-etags-select (candidate)
3276   "Default action to jump to etags from `anything-find-files'."
3277   (when (get-buffer anything-action-buffer)
3278     (kill-buffer anything-action-buffer))
3279   (let ((default-directory anything-ff-default-directory))
3280     (anything-c-etags-select anything-current-prefix-arg)))
3281
3282 (defun anything-find-files-switch-to-hist (candidate)
3283   "Switch to anything-find-files history."
3284   (anything-find-files t))
3285
3286 ;;; Asynchronous copy of files.
3287 ;;
3288 ;;
3289 (defun anything-c-copy-files-async-1 (flist dest)
3290   "Copy a list of Files FLIST to DEST asynchronously.
3291 It use another emacs process to do the job.
3292 Communication with background emacs is done with temp file
3293 `anything-c-copy-files-async-log-file'."
3294   (start-file-process "emacs-batch" nil anything-c-copy-async-prefered-emacs
3295                       "-Q" "--batch" "--eval"
3296                       (format "(progn
3297   (require 'dired) (require 'cl)
3298   (let ((dired-recursive-copies 'always)
3299         failures success
3300         (ovw-count 0)
3301         (cpf-count 0))
3302     (dolist (f '%S)
3303        (condition-case err
3304              (let ((file-exists (file-exists-p
3305                                  (expand-file-name
3306                                   (file-name-nondirectory (directory-file-name f))
3307                                    (file-name-directory
3308                                      (file-name-as-directory \"%s\"))))))
3309                 (dired-copy-file f \"%s\" t)
3310                 (if file-exists
3311                     (progn (push (cons \"Overwriting\" f) success)
3312                            (incf ovw-count))
3313                     (push (cons \"Copying\" f) success)
3314                     (incf cpf-count)))
3315           (file-error
3316            (push (dired-make-relative
3317                    (expand-file-name
3318                      (file-name-nondirectory (directory-file-name f))
3319                      (file-name-directory \"%s\")))
3320                  failures))))
3321     (with-current-buffer (find-file-noselect \"%s\")
3322        (erase-buffer)
3323        (when failures
3324          (dolist (fail (reverse failures))
3325            (insert (concat \"Failed to copy \" fail \"\n\"))))
3326        (when success
3327          (loop for (a . s) in (reverse success) do
3328            (insert (concat a \" \" s  \" to %s done\n\"))))
3329        (and (/= cpf-count 0) (insert (concat (int-to-string cpf-count) \" File(s) Copied\n\")))
3330        (and (/= ovw-count 0) (insert (concat (int-to-string ovw-count) \" File(s) Overwrited\n\")))
3331        (and failures (insert (concat (int-to-string (length failures)) \" File(s) Failed to copy\n\")))
3332        (save-buffer))))"
3333                               flist dest dest dest anything-c-copy-files-async-log-file dest)))
3334
3335 (defun anything-c-copy-async-with-log (flist dest)
3336   "Copy file list FLIST to DEST showing log.
3337 Log is send to `anything-c-copy-files-async-log-file'.
3338 Copying is done asynchronously with `anything-c-copy-files-async-1'."
3339   (declare (special auto-revert-interval))
3340   (pop-to-buffer (find-file-noselect anything-c-copy-files-async-log-file))
3341   (set (make-local-variable 'auto-revert-interval) 1)
3342   (erase-buffer)
3343   (insert "Wait copying files...\n")
3344   (sit-for 0.5) (save-buffer)
3345   (goto-char (point-max))
3346   (auto-revert-mode 1)
3347   (anything-c-copy-files-async-1 flist dest))
3348
3349 (defun anything-ff-copy-async (candidate)
3350   "Anything find files action to copy files async.
3351 Copying is done asynchronously with `anything-c-copy-files-async-1'."
3352   (let* ((flist (anything-marked-candidates))
3353          (dest  (anything-c-read-file-name
3354                  (anything-find-files-set-prompt-for-action
3355                   "Copy Async" flist)
3356                  :preselect candidate
3357                  :initial-input (car anything-ff-history)
3358                  :history (anything-find-files-history :comp-read nil))))
3359     (anything-c-copy-async-with-log flist dest)))
3360
3361 (defvar eshell-command-aliases-list nil)
3362 (defvar anything-eshell-command-on-file-input-history nil)
3363 (defun anything-find-files-eshell-command-on-file-1 (candidate &optional map)
3364   "Run `eshell-command' on CANDIDATE or marked candidates.
3365 This is done possibly with an eshell alias, if no alias found, you can type in
3366 an eshell command.
3367
3368 Basename of CANDIDATE can be a wild-card.
3369 e.g you can do \"eshell-command command *.el\"
3370 Where \"*.el\" is the CANDIDATE.
3371
3372 It is possible to do eshell-command command <CANDIDATE> <some more args>
3373 like this: \"command %s some more args\".
3374
3375 If MAP is given run `eshell-command' on all marked files at once,
3376 Otherwise, run `eshell-command' on each marked files.
3377 In other terms, with a prefix arg do on the three marked files
3378 \"foo\" \"bar\" \"baz\":
3379
3380 \"eshell-command command foo bar baz\"
3381
3382 otherwise do
3383
3384 \"eshell-command command foo\"
3385 \"eshell-command command bar\"
3386 \"eshell-command command baz\"
3387
3388 Note:
3389 If `eshell' or `eshell-command' have not been run once,
3390 or if you have no eshell aliases `eshell-command-aliases-list'
3391 will not be loaded first time you use this."
3392   (when (or eshell-command-aliases-list
3393             (y-or-n-p "Eshell is not loaded, run eshell-command without alias anyway? "))
3394     (and eshell-command-aliases-list (eshell-read-aliases-list))
3395     (let* ((cand-list (anything-marked-candidates))
3396            (default-directory (or anything-ff-default-directory
3397                                   ;; If candidate is an url *-ff-default-directory is nil
3398                                   ;; so keep value of default-directory.
3399                                   default-directory))
3400            (command (anything-comp-read
3401                      "Command: "
3402                      (loop for (a . c) in eshell-command-aliases-list
3403                            when (string-match "\\(\\$1\\|\\$\\*\\)$" (car c))
3404                            collect (propertize a 'help-echo (car c)) into ls
3405                            finally return (sort ls 'string<))
3406                      :buffer "*esh command on file*"
3407                      :name "Eshell command"
3408                      :keymap anything-esh-on-file-map
3409                      :mode-line
3410                      '("Eshell alias"
3411                        "C-c ?: Help, \\[universal-argument]: Insert output at point")
3412                      :input-history
3413                      'anything-eshell-command-on-file-input-history))
3414            (alias-value (car (assoc-default command eshell-command-aliases-list))))
3415       (when (and (= (length cand-list) 1)
3416                  (string-match "[*]" (anything-c-basename (car cand-list))))
3417         (setq cand-list (file-expand-wildcards (car cand-list) t)))
3418       ;; Be sure output don't go in current buffer
3419       ;; but allow sending output to current buffer
3420       ;; if a prefix arg have been passed during the
3421       ;; `anything-comp-read' call.
3422       (setq current-prefix-arg anything-current-prefix-arg)
3423       ;; MAP have been set before calling `anything-comp-read'
3424       ;; by `anything-current-prefix-arg'.
3425       (if (and (or map ; prefix-arg
3426                    (and alias-value
3427                         ;; If command is an alias be sure it accept
3428                         ;; more than one arg i.e $*.
3429                         (string-match "\\$\\*$" alias-value)))
3430                (> (length cand-list) 1))
3431
3432           ;; Run eshell-command with ALL marked files as arguments.
3433           (let ((mapfiles (mapconcat 'shell-quote-argument cand-list " ")))
3434             (if (string-match "'%s'\\|\"%s\"\\|%s" command)
3435                 (eshell-command (format command mapfiles)) ; See [1]
3436                 (eshell-command (format "%s %s" command mapfiles))))
3437
3438           ;; Run eshell-command on EACH marked files.
3439           (loop for i in cand-list
3440                 for bn = (anything-c-basename i)
3441                 for files = (format "'%s'" i)
3442                 for com = (if (string-match "'%s'\\|\"%s\"\\|%s" command)
3443                               ;; [1] This allow to enter other args AFTER filename
3444                               ;; i.e <command %s some_more_args>
3445                               (format command files)
3446                               (format "%s %s" command files))
3447                 do (eshell-command com))))))
3448
3449 (defun anything-find-files-eshell-command-on-file (candidate)
3450   "Run `eshell-command' on CANDIDATE or marked candidates.
3451 See `anything-find-files-eshell-command-on-file-1' for more info."
3452   (anything-find-files-eshell-command-on-file-1
3453    candidate anything-current-prefix-arg))
3454
3455 (defun anything-ff-switch-to-eshell (candidate)
3456   "Switch to eshell and cd to `anything-ff-default-directory'."
3457   (flet ((cd-eshell ()
3458            (goto-char (point-max))
3459            (insert
3460             (format "cd '%s'" anything-ff-default-directory))
3461            (eshell-send-input)))
3462     (if (get-buffer "*eshell*")
3463         (progn
3464           (anything-c-switch-to-buffer "*eshell*")
3465           (cd-eshell))
3466         (call-interactively 'eshell)
3467         (cd-eshell))))
3468
3469 (defun anything-ff-serial-rename-action (method)
3470   "Rename all marked files to `anything-ff-default-directory' with METHOD.
3471 See `anything-ff-serial-rename-1'."
3472   (let* ((cands     (anything-marked-candidates))
3473          (def-name  (car cands))
3474          (name      (read-string "NewName: "
3475                                  (replace-regexp-in-string
3476                                   "[0-9]+$" ""
3477                                   (anything-c-basename
3478                                    def-name
3479                                    (file-name-extension def-name)))))
3480          (start     (read-number "StartAtNumber: "))
3481          (extension (read-string "Extension: "
3482                                  (file-name-extension (car cands))))
3483          (dir       (expand-file-name
3484                      (anything-c-read-file-name
3485                       "Serial Rename to directory: "
3486                       :initial-input
3487                       (expand-file-name anything-ff-default-directory)
3488                       :test 'file-directory-p
3489                       :must-match t)))
3490          (res       (loop for f in cands
3491                           for bn = (anything-c-basename f)
3492                           for count from start
3493                           concat (format "%s <-> %s%s.%s\n"
3494                                          bn name count extension))))
3495     (if (y-or-n-p
3496          (format "Result:\n %sRename like this to <%s> ? " res dir))
3497         (progn
3498           (anything-ff-serial-rename-1
3499            dir cands name start extension :method method)
3500           (message nil)
3501           (anything-find-files-1 dir))
3502         (message "Operation aborted"))))
3503
3504 (defun anything-ff-member-directory-p (file directory)
3505   (let ((dir-file (expand-file-name
3506                    (file-name-as-directory (file-name-directory file))))
3507         (cur-dir  (expand-file-name (file-name-as-directory directory))))
3508     (string= dir-file cur-dir)))
3509
3510 (defun* anything-ff-serial-rename-1
3511     (directory collection new-name start-at-num extension &key (method 'rename))
3512   "rename files in COLLECTION to DIRECTORY with the prefix name NEW-NAME.
3513 Rename start at number START-AT-NUM - ex: prefixname-01.jpg.
3514 EXTENSION is the file extension to use, in empty prompt,
3515 reuse the original extension of file.
3516 METHOD can be one of rename, copy or symlink.
3517 Files will be renamed if they are files of current directory, otherwise they
3518 will be treated with METHOD.
3519 Default METHOD is rename."
3520   ;; Maybe remove directories selected by error in collection.
3521   (setq collection (remove-if 'file-directory-p collection))
3522   (flet ((symlink-file (file dest)
3523            (let ((flist (list file)))
3524              (anything-dired-action
3525               dest :action 'symlink :files flist))))
3526
3527     (let* ((tmp-dir  (file-name-as-directory
3528                       (concat (file-name-as-directory directory)
3529                               (symbol-name (gensym "tmp")))))
3530            (fn       (case method
3531                        (copy    'copy-file)
3532                        (symlink 'symlink-file)
3533                        (rename  'rename-file)
3534                        (t (error "Error: Unknow method %s" method)))))
3535       (make-directory tmp-dir)
3536       (unwind-protect
3537            (progn
3538              ;; Rename all files to tmp-dir with new-name.
3539              ;; If files are not from start directory, use method
3540              ;; to move files to tmp-dir.
3541              (loop for i in collection
3542                    for count from start-at-num
3543                    for fnum = (if (< count 10) "0%s" "%s")
3544                    for nname = (concat tmp-dir new-name (format fnum count)
3545                                        (if (not (string= extension ""))
3546                                            (format ".%s" (replace-regexp-in-string
3547                                                           "[.]" "" extension))
3548                                            (file-name-extension i 'dot)))
3549                    do (if (anything-ff-member-directory-p i directory)
3550                           (rename-file i nname)
3551                           (funcall fn i nname)))
3552              ;; Now move all from tmp-dir to destination.
3553              (loop with dirlist = (directory-files
3554                                    tmp-dir t directory-files-no-dot-files-regexp)
3555                    for f in dirlist do
3556                    (if (file-symlink-p f)
3557                        (symlink-file (file-truename f)
3558                                      (concat (file-name-as-directory directory)
3559                                              (anything-c-basename f)))
3560                        (rename-file f directory))))
3561         (delete-directory tmp-dir t)))))
3562
3563 (defun anything-ff-serial-rename (candidate)
3564   "Serial rename all marked files to `anything-ff-default-directory'.
3565 Rename only file of current directory, and symlink files coming from
3566 other directories.
3567 See `anything-ff-serial-rename-1'."
3568   (anything-ff-serial-rename-action 'rename))
3569
3570 (defun anything-ff-serial-rename-by-symlink (candidate)
3571   "Serial rename all marked files to `anything-ff-default-directory'.
3572 Rename only file of current directory, and symlink files coming from
3573 other directories.
3574 See `anything-ff-serial-rename-1'."
3575   (anything-ff-serial-rename-action 'symlink))
3576
3577 (defun anything-ff-serial-rename-by-copying (candidate)
3578   "Serial rename all marked files to `anything-ff-default-directory'.
3579 Rename only file of current directory, and copy files coming from
3580 other directories.
3581 See `anything-ff-serial-rename-1'."
3582   (anything-ff-serial-rename-action 'copy))
3583
3584 (defun anything-c-quit-and-execute-action (action)
3585   "Quit current anything session and execute ACTION."
3586   (setq anything-saved-action action)
3587   (anything-exit-minibuffer))
3588
3589 (defun anything-ff-toggle-auto-update (candidate)
3590   (setq anything-ff-auto-update-flag (not anything-ff-auto-update-flag))
3591   (message "[Auto expansion %s]"
3592            (if anything-ff-auto-update-flag "enabled" "disabled")))
3593
3594 ;;;###autoload
3595 (defun anything-ff-run-toggle-auto-update ()
3596   (interactive)
3597   (when (anything-file-completion-source-p)
3598     (anything-attrset 'toggle-auto-update 'anything-ff-toggle-auto-update)
3599     (anything-execute-persistent-action 'toggle-auto-update)))
3600
3601 ;;;###autoload
3602 (defun anything-ff-run-switch-to-history ()
3603   "Run Switch to history action from `anything-c-source-find-files'."
3604   (interactive)
3605   (when (anything-file-completion-source-p)
3606     (anything-c-quit-and-execute-action 'anything-find-files-switch-to-hist)))
3607
3608 ;;;###autoload
3609 (defun anything-ff-run-grep ()
3610   "Run Grep action from `anything-c-source-find-files'."
3611   (interactive)
3612   (when (anything-file-completion-source-p)
3613     (anything-c-quit-and-execute-action 'anything-find-files-grep)))
3614
3615 ;;;###autoload
3616 (defun anything-ff-run-pdfgrep ()
3617   "Run Pdfgrep action from `anything-c-source-find-files'."
3618   (interactive)
3619   (when (anything-file-completion-source-p)
3620     (anything-c-quit-and-execute-action 'anything-ff-pdfgrep)))
3621
3622 ;;;###autoload
3623 (defun anything-ff-run-zgrep ()
3624   "Run Grep action from `anything-c-source-find-files'."
3625   (interactive)
3626   (when (anything-file-completion-source-p)
3627     (anything-c-quit-and-execute-action 'anything-ff-zgrep)))
3628
3629 ;;;###autoload
3630 (defun anything-ff-run-copy-file ()
3631   "Run Copy file action from `anything-c-source-find-files'."
3632   (interactive)
3633   (when (anything-file-completion-source-p)
3634     (anything-c-quit-and-execute-action 'anything-find-files-copy)))
3635
3636 ;;;###autoload
3637 (defun anything-ff-run-rename-file ()
3638   "Run Rename file action from `anything-c-source-find-files'."
3639   (interactive)
3640   (when (anything-file-completion-source-p)
3641     (anything-c-quit-and-execute-action 'anything-find-files-rename)))
3642
3643 ;;;###autoload
3644 (defun anything-ff-run-byte-compile-file ()
3645   "Run Byte compile file action from `anything-c-source-find-files'."
3646   (interactive)
3647   (when (anything-file-completion-source-p)
3648     (anything-c-quit-and-execute-action 'anything-find-files-byte-compile)))
3649
3650 ;;;###autoload
3651 (defun anything-ff-run-load-file ()
3652   "Run Load file action from `anything-c-source-find-files'."
3653   (interactive)
3654   (when (anything-file-completion-source-p)
3655     (anything-c-quit-and-execute-action 'anything-find-files-load-files)))
3656
3657 ;;;###autoload
3658 (defun anything-ff-run-eshell-command-on-file ()
3659   "Run eshell command on file action from `anything-c-source-find-files'."
3660   (interactive)
3661   (when (anything-file-completion-source-p)
3662     (anything-c-quit-and-execute-action
3663      'anything-find-files-eshell-command-on-file)))
3664
3665 ;;;###autoload
3666 (defun anything-ff-run-ediff-file ()
3667   "Run Ediff file action from `anything-c-source-find-files'."
3668   (interactive)
3669   (when (anything-file-completion-source-p)
3670     (anything-c-quit-and-execute-action 'anything-find-files-ediff-files)))
3671
3672 ;;;###autoload
3673 (defun anything-ff-run-ediff-merge-file ()
3674   "Run Ediff merge file action from `anything-c-source-find-files'."
3675   (interactive)
3676   (when (anything-file-completion-source-p)
3677     (anything-c-quit-and-execute-action
3678      'anything-find-files-ediff-merge-files)))
3679
3680 ;;;###autoload
3681 (defun anything-ff-run-symlink-file ()
3682   "Run Symlink file action from `anything-c-source-find-files'."
3683   (interactive)
3684   (when (anything-file-completion-source-p)
3685     (anything-c-quit-and-execute-action 'anything-find-files-symlink)))
3686
3687 ;;;###autoload
3688 (defun anything-ff-run-hardlink-file ()
3689   "Run Hardlink file action from `anything-c-source-find-files'."
3690   (interactive)
3691   (when (anything-file-completion-source-p)
3692     (anything-c-quit-and-execute-action 'anything-find-files-hardlink)))
3693
3694 ;;;###autoload
3695 (defun anything-ff-run-delete-file ()
3696   "Run Delete file action from `anything-c-source-find-files'."
3697   (interactive)
3698   (when (anything-file-completion-source-p)
3699     (anything-c-quit-and-execute-action 'anything-delete-marked-files)))
3700
3701 ;;;###autoload
3702 (defun anything-ff-run-complete-fn-at-point ()
3703   "Run complete file name action from `anything-c-source-find-files'."
3704   (interactive)
3705   (when (anything-file-completion-source-p)
3706     (anything-c-quit-and-execute-action
3707      'anything-c-insert-file-name-completion-at-point)))
3708
3709 ;;;###autoload
3710 (defun anything-ff-run-switch-to-eshell ()
3711   "Run switch to eshell action from `anything-c-source-find-files'."
3712   (interactive)
3713   (when (anything-file-completion-source-p)
3714     (anything-c-quit-and-execute-action 'anything-ff-switch-to-eshell)))
3715
3716 ;;;###autoload
3717 (defun anything-ff-run-switch-other-window ()
3718   "Run switch to other window action from `anything-c-source-find-files'."
3719   (interactive)
3720   (when (anything-file-completion-source-p)
3721     (anything-c-quit-and-execute-action 'find-file-other-window)))
3722
3723 ;;;###autoload
3724 (defun anything-ff-run-switch-other-frame ()
3725   "Run switch to other frame action from `anything-c-source-find-files'."
3726   (interactive)
3727   (when (anything-file-completion-source-p)
3728     (anything-c-quit-and-execute-action 'find-file-other-frame)))
3729
3730 ;;;###autoload
3731 (defun anything-ff-run-open-file-externally ()
3732   "Run open file externally command action from `anything-c-source-find-files'."
3733   (interactive)
3734   (when (anything-file-completion-source-p)
3735     (anything-c-quit-and-execute-action 'anything-c-open-file-externally)))
3736
3737 (defun anything-ff-locate (candidate)
3738   "Locate action function for `anything-find-files'."
3739   (let ((input (concat (anything-c-basename
3740                         (expand-file-name
3741                          candidate
3742                          anything-ff-default-directory))
3743                        ;; The locate '-b' option doesn't exists
3744                        ;; in everything.
3745                        (unless (and (eq system-type 'windows-nt)
3746                                     (string-match "^es" anything-c-locate-command))
3747                          " -b")))
3748         (anything-mp-highlight-delay 0.7))
3749     (anything-locate-1 anything-current-prefix-arg input 'from-ff)))
3750
3751 ;;;###autoload
3752 (defun anything-ff-run-locate ()
3753   "Run locate action from `anything-c-source-find-files'."
3754   (interactive)
3755   (when (anything-file-completion-source-p)
3756     (anything-c-quit-and-execute-action 'anything-ff-locate)))
3757
3758 ;;;###autoload
3759 (defun anything-ff-run-gnus-attach-files ()
3760   "Run gnus attach files command action from `anything-c-source-find-files'."
3761   (interactive)
3762   (when (anything-file-completion-source-p)
3763     (anything-c-quit-and-execute-action 'anything-ff-gnus-attach-files)))
3764
3765 ;;;###autoload
3766 (defun anything-ff-run-etags ()
3767   "Run Etags command action from `anything-c-source-find-files'."
3768   (interactive)
3769   (when (anything-file-completion-source-p)
3770     (anything-c-quit-and-execute-action 'anything-ff-etags-select)))
3771
3772 (defun anything-ff-print (candidate)
3773   "Print marked files.
3774 You have to set in order
3775 variables `lpr-command',`lpr-switches' and/or `printer-name'.
3776
3777 e.g:
3778 \(setq lpr-command \"gtklp\"\)
3779 \(setq lpr-switches '(\"-P\")\)
3780 \(setq printer-name \"Epson-Stylus-Photo-R265\"\)
3781
3782 Same as `dired-do-print' but for anything."
3783   (when (or anything-current-prefix-arg
3784             (not anything-ff-printer-list))
3785     (setq anything-ff-printer-list
3786           (anything-ff-find-printers)))
3787   (let* ((file-list (anything-marked-candidates))
3788          (len (length file-list))
3789          (printer-name (if anything-ff-printer-list
3790                            (anything-comp-read
3791                             "Printer: " anything-ff-printer-list)
3792                            printer-name))
3793          (command (read-string
3794                    (format "Print *%s File(s):\n%s with: "
3795                            len
3796                            (mapconcat
3797                             (lambda (f) (format "- %s\n" f))
3798                             file-list ""))
3799                    (when (and lpr-command
3800                               (or lpr-switches
3801                                   printer-name))
3802                      (mapconcat 'identity
3803                                 (cons lpr-command
3804                                       (append (if (stringp lpr-switches)
3805                                                   (list lpr-switches)
3806                                                   lpr-switches)
3807                                               (list printer-name)))
3808                                 " "))))
3809          (file-args (mapconcat #'(lambda (x)
3810                                    (format "'%s'" x))
3811                                file-list " "))
3812          (cmd-line (concat command " " file-args)))
3813     (if command
3814         (start-process-shell-command "anything-print" nil cmd-line)
3815         (error "Error: Please verify your printer settings in Emacs."))))
3816
3817 ;;;###autoload
3818 (defun anything-ff-run-print-file ()
3819   "Run Print file action from `anything-c-source-find-files'."
3820   (interactive)
3821   (when (anything-file-completion-source-p)
3822     (anything-c-quit-and-execute-action 'anything-ff-print)))
3823
3824 (defun anything-ff-checksum (file)
3825   "Calculate the checksum of FILE.
3826 Provide completion on different algorithms to use on Emacs24.
3827 On Emacs23 only 'sha1' is available.
3828 The checksum is copied to kill-ring."
3829   (let ((algo-list (and (fboundp 'secure-hash)
3830                         '(md5 sha1 sha224 sha256 sha384 sha512))))
3831     (kill-new
3832      (if algo-list
3833          (secure-hash (intern
3834                        (anything-comp-read
3835                         "Algorithm: " algo-list))
3836                       file)
3837          (sha1 (with-temp-buffer
3838                  (insert-file-contents file)
3839                  (buffer-string)))))
3840     (message "Checksum copied to kill-ring.")))
3841
3842 (defun anything-ff-toggle-basename (candidate)
3843   (setq anything-ff-transformer-show-only-basename
3844         (not anything-ff-transformer-show-only-basename))
3845   (let ((target (if anything-ff-transformer-show-only-basename
3846                     (anything-c-basename candidate) candidate)))
3847     (anything-force-update target)))
3848
3849 (defun anything-ff-run-toggle-basename ()
3850   (interactive)
3851   (when (anything-file-completion-source-p)
3852     (anything-attrset 'toggle-basename 'anything-ff-toggle-basename)
3853     (anything-execute-persistent-action 'toggle-basename)))
3854
3855 (defun* anything-reduce-file-name (fname level &key unix-close expand)
3856   "Reduce FNAME by LEVEL from end or beginning depending LEVEL value.
3857 If LEVEL is positive reduce from end else from beginning.
3858 If UNIX-CLOSE is non--nil close filename with /.
3859 If EXPAND is non--nil expand-file-name."
3860   (let* ((exp-fname  (expand-file-name fname))
3861          (fname-list (split-string (if (or (string= fname "~/") expand)
3862                                        exp-fname fname) "/" t))
3863          (len        (length fname-list))
3864          (pop-list   (if (< level 0)
3865                          (subseq fname-list (* level -1))
3866                          (subseq fname-list 0 (- len level))))
3867          (result     (mapconcat 'identity pop-list "/"))
3868          (empty      (string= result "")))
3869     (when unix-close (setq result (concat result "/")))
3870     (if (string-match "^~" result)
3871         (if (string= result "~/") "~/" result)
3872         (if (< level 0)
3873             (if empty "../" (concat "../" result))
3874             (cond ((eq system-type 'windows-nt)
3875                    (if empty (expand-file-name "/") ; Expand to "/" or "c:/".
3876                        result))
3877                   (empty "/")
3878                   (t
3879                    (concat "/" result)))))))
3880
3881 ;; Internal
3882 (defvar anything-file-completion-sources
3883   '("Find Files" "Read File Name"
3884     "Read File Name History" "Copy Files"
3885     "Rename Files" "Symlink Files"
3886     "Hardlink Files" "Write File" "Insert File")
3887   "Sources that use the *find-files mechanism can be added here.
3888 Sources generated by `ac-mode' don't need to be added here, it will
3889 be done automatically.
3890 You should not modify this yourself unless you know what you do.")
3891
3892 (defun anything-file-completion-source-p ()
3893   "Return non--nil if current source is a file completion source.
3894 A source is a file completion source if it is
3895 one of `anything-file-completion-sources'.
3896 Return nil if anything is not running."
3897   (let ((cur-source (cdr (assoc 'name (anything-get-current-source)))))
3898     (loop for i in anything-file-completion-sources
3899           thereis (string= cur-source i))))
3900
3901 (defun anything-find-files-down-one-level (arg)
3902   "Go down one level like unix command `cd ..'.
3903 If prefix numeric arg is given go ARG level down."
3904   (interactive "p")
3905   (when (and (anything-file-completion-source-p)
3906              (not (anything-ff-invalid-tramp-name-p)))
3907     (with-anything-window
3908       (setq anything-follow-mode nil))
3909     ;; When going to precedent level we want to be at the line
3910     ;; corresponding to actual directory, so store this info
3911     ;; in `anything-ff-last-expanded'.
3912     (if (and (not (file-directory-p anything-pattern))
3913              (file-exists-p anything-pattern))
3914         (setq anything-ff-last-expanded anything-pattern)
3915         (setq anything-ff-last-expanded anything-ff-default-directory))
3916     (let ((new-pattern (anything-reduce-file-name anything-pattern arg
3917                                                   :unix-close t :expand t)))
3918       (anything-set-pattern new-pattern))))
3919
3920 (defun anything-ff-retrieve-last-expanded ()
3921   "Move overlay to last visited directory `anything-ff-last-expanded'.
3922 This happen after using `anything-find-files-down-one-level',
3923 or hitting C-z on \"..\"."
3924   (when (and anything-ff-last-expanded
3925              (anything-file-completion-source-p))
3926     (let ((presel (if anything-ff-transformer-show-only-basename
3927                        (anything-c-basename
3928                         (directory-file-name anything-ff-last-expanded))
3929                        (directory-file-name anything-ff-last-expanded))))
3930       (with-anything-window
3931         (when (re-search-forward
3932                (concat "^" (regexp-quote presel) "$") nil t)
3933           (forward-line 0)
3934           (anything-mark-current-line)))
3935       (setq anything-ff-last-expanded nil))))
3936 (add-hook 'anything-after-update-hook 'anything-ff-retrieve-last-expanded)
3937
3938 ;; Auto-update - anything-find-files auto expansion of directories.
3939 ;;
3940 (defun anything-ff-update-when-only-one-matched ()
3941   "Expand to directory when sole completion.
3942 When only one candidate is remaining and it is a directory,
3943 expand to this directory."
3944   (when (and anything-ff-auto-update-flag
3945              (anything-file-completion-source-p)
3946              (not (anything-ff-invalid-tramp-name-p)))
3947     (let* ((history-p   (string= (assoc-default
3948                                   'name (anything-get-current-source))
3949                                  "Read File Name History"))
3950            (pat         (if (string-match tramp-file-name-regexp
3951                                           anything-pattern)
3952                             (anything-create-tramp-name anything-pattern)
3953                             anything-pattern))
3954            (completed-p (string= (file-name-as-directory pat)
3955                                  anything-ff-default-directory)))
3956       (when (and (or
3957                   ;; Only one candidate remaining
3958                   ;; and at least 2 char in basename.
3959                   (and (<= (anything-approximate-candidate-number) 2)
3960                        (>= (length (anything-c-basename anything-pattern)) 2))
3961                   ;; Already completed.
3962                   completed-p)
3963                  (not history-p)) ; Don't try to auto complete in history.
3964         (with-anything-window
3965           (let ((cur-cand (prog2
3966                               (unless completed-p
3967                                 ;; Only one non--existing candidate
3968                                 ;; and one directory candidate, move to it.
3969                                 (anything-next-line))
3970                               (anything-get-selection))))
3971             (when (and (stringp cur-cand) (file-directory-p cur-cand))
3972               (if (and (not (string-match "^.*[.]\\{1,2\\}$" cur-cand)) ; [1]
3973                        ;; Maybe we are here because completed-p is true
3974                        ;; but check this again to be sure. (Windows fix)
3975                        (<= (anything-approximate-candidate-number) 2)) ; [2]
3976                   ;; If after going to next line the candidate
3977                   ;; is not one of "." or ".." [1]
3978                   ;; and only one candidate is remaining [2],
3979                   ;; assume candidate is a new directory to expand, and do it.
3980                   (anything-set-pattern (file-name-as-directory cur-cand))
3981                   ;; The candidate is one of "." or ".."
3982                   ;; that mean we have entered the last letter of the directory name
3983                   ;; in prompt, so expansion is already done, just add the "/" at end
3984                   ;; of name unless anything-pattern ends with "."
3985                   ;; (i.e we are writing something starting with ".")
3986                   (unless (string-match "^.*[.]\\{1\\}$" anything-pattern)
3987                     (anything-set-pattern
3988                      ;; Need to expand-file-name to avoid e.g /ssh:host:./ in prompt.
3989                      (expand-file-name (file-name-as-directory anything-pattern)))))
3990               (anything-check-minibuffer-input-1))))))))
3991 (add-hook 'anything-after-update-hook 'anything-ff-update-when-only-one-matched)
3992
3993 ;; Allow expanding to home directory or root
3994 ;; when entering respectively "~/" or "//" at end of pattern.
3995 ;; e.g /home/thierry/labo/anything-config-qp/~/
3996 ;; will expand to "~/"
3997 ;; and /home/thierry/labo/anything-config-qp//
3998 ;; will expand to "/"
3999 (defun anything-ff-auto-expand-to-home-or-root ()
4000   "Goto home, root or default directory when pattern ends with ~/, /, or ./.
4001 This happen only in function using sources that are
4002 `anything-file-completion-source-p' compliant."
4003   (when (and (anything-file-completion-source-p)
4004              (string-match ".*\\(/~/\\|/\\{2\\}\\|/[.]\\{1\\}/\\)$"
4005                            anything-pattern)
4006              (not (string-match anything-ff-url-regexp anything-pattern)))
4007     (let ((match (match-string 1 anything-pattern)))
4008       (cond ((string= match "//")
4009              ;; Expand to "/" or "c:/"
4010              (setq anything-pattern (expand-file-name "/")))
4011             ((string= match "/~/")
4012              (if (eq system-type 'windows-nt)
4013                  (setq anything-pattern (file-name-as-directory (getenv "HOME")))
4014                  (setq anything-pattern "~/")))
4015             ((string= match "/./")
4016              (setq anything-pattern
4017                    (with-anything-current-buffer
4018                      (expand-file-name default-directory))))))
4019     (setq anything-ff-default-directory anything-pattern)
4020     ;; For some reasons, i must use here with-current-buffer => mini buffer
4021     ;; and not `anything-set-pattern' that use with-selected-window => mini win.
4022     (with-current-buffer (window-buffer (minibuffer-window))
4023       (delete-minibuffer-contents)
4024       (insert anything-pattern))))
4025
4026 (add-hook 'anything-after-update-hook 'anything-ff-auto-expand-to-home-or-root)
4027
4028 (defun anything-c-point-file-in-dired (file)
4029   "Put point on filename FILE in dired buffer."
4030   (dired (file-name-directory file))
4031   (dired-goto-file file))
4032
4033 (defun anything-create-tramp-name (fname)
4034   "Build filename for `anything-pattern' like /su:: or /sudo::."
4035   (apply #'tramp-make-tramp-file-name
4036          (loop with v = (tramp-dissect-file-name fname)
4037                for i across v collect i)))
4038
4039 (defun* anything-ff-tramp-hostnames (&optional (pattern anything-pattern))
4040   "Get a list of hosts for tramp method found in `anything-pattern'.
4041 Argument PATTERN default to `anything-pattern', it is here only for debugging
4042 purpose."
4043   (when (string-match tramp-file-name-regexp pattern)
4044     (let ((method      (match-string 1 pattern))
4045           (tn          (match-string 0 pattern))
4046           (all-methods (mapcar 'car tramp-methods)))
4047       (anything-fast-remove-dups
4048        (loop for (f . h) in (tramp-get-completion-function method)
4049              append (loop for e in (funcall f (car h))
4050                           for host = (and (consp e) (cadr e))
4051                           when (and host (not (member host all-methods)))
4052                           collect (concat tn host)))
4053        :test 'equal))))
4054
4055 (defun anything-ff-before-action-hook-fn ()
4056   "Exit anything when user try to execute action on an invalid tramp fname."
4057   (let ((cand (anything-get-selection)))
4058     (when (and (anything-file-completion-source-p)
4059                (anything-ff-invalid-tramp-name-p cand) ; Check candidate.
4060                (anything-ff-invalid-tramp-name-p)) ; check anything-pattern.
4061       (error "Error: Unknow file or directory `%s'" cand))))
4062 (add-hook 'anything-before-action-hook 'anything-ff-before-action-hook-fn)
4063
4064 (defun* anything-ff-invalid-tramp-name-p (&optional (pattern anything-pattern))
4065   "Return non--nil when PATTERN is an invalid tramp filename."
4066   (string= (anything-ff-set-pattern pattern)
4067            "Invalid tramp file name"))
4068
4069 (defun anything-ff-set-pattern (pattern)
4070   "Handle tramp filenames in `anything-pattern'."
4071   (let ((methods (mapcar 'car tramp-methods))
4072         (reg "\\`/\\([^[/:]+\\|[^/]+]\\):.*:")
4073         cur-method tramp-name)
4074     (cond ((string= pattern "") "")
4075           ((string-match ".*\\(~?/?[.]\\{1\\}/\\)$" pattern)
4076            (with-anything-current-buffer
4077              (expand-file-name default-directory)))
4078           ((and (string-match ".*\\(~//\\|//\\)$" pattern)
4079                 (not (string-match anything-ff-url-regexp anything-pattern)))
4080            (expand-file-name "/") ; Expand to "/" or "c:/"
4081            )
4082           ((string-match "^~\\|.*/~/$" pattern)
4083            (let* ((home (expand-file-name (getenv "HOME"))))
4084              (replace-match home nil t pattern)))
4085           ;; Match "/method:maybe_hostname:"
4086           ((and (string-match reg pattern)
4087                 (setq cur-method (match-string 1 pattern))
4088                 (member cur-method methods))
4089            (setq tramp-name (anything-create-tramp-name
4090                              (match-string 0 pattern)))
4091            (replace-match tramp-name nil t pattern))
4092           ;; Match "/hostname:"
4093           ((and (string-match  tramp-file-name-regexp pattern)
4094                 (setq cur-method (match-string 1 pattern))
4095                 (and cur-method (not (member cur-method methods))))
4096            (setq tramp-name (anything-create-tramp-name
4097                              (match-string 0 pattern)))
4098            (replace-match tramp-name nil t pattern))
4099           ;; Match "/method:" in this case don't try to connect.
4100           ((and (not (string-match reg pattern))
4101                 (string-match tramp-file-name-regexp pattern)
4102                 (member (match-string 1 pattern) methods))
4103            "Invalid tramp file name")   ; Write in anything-buffer.
4104           ;; PATTERN is a directory, end it with "/".
4105           ;; This will make PATTERN not ending yet with "/"
4106           ;; candidate for `anything-ff-default-directory',
4107           ;; allowing `anything-ff-retrieve-last-expanded' to retrieve it
4108           ;; when descending level.
4109           ((file-directory-p pattern)
4110            (file-name-as-directory pattern))
4111           ;; Return PATTERN unchanged.
4112           (t pattern))))
4113
4114 (defun anything-find-files-get-candidates (&optional require-match)
4115   "Create candidate list for `anything-c-source-find-files'."
4116   (let* ((path          (anything-ff-set-pattern anything-pattern))
4117          (path-name-dir (if (file-directory-p path)
4118                             (file-name-as-directory path)
4119                             (file-name-directory path)))
4120          (tramp-verbose anything-tramp-verbose)) ; No tramp message when 0.
4121     (set-text-properties 0 (length path) nil path)
4122     ;; Don't set now `anything-pattern' if `path' == "Invalid tramp file name"
4123     ;; like that the actual value (e.g /ssh:) is passed to
4124     ;; `anything-ff-tramp-hostnames'.
4125     (unless (string= path "Invalid tramp file name")
4126       (setq anything-pattern (anything-ff-transform-fname-for-completion path)))
4127     (setq anything-ff-default-directory
4128           (if (string= anything-pattern "")
4129               (expand-file-name "/") ; Expand to "/" or "c:/"
4130               ;; If path is an url *default-directory have to be nil.
4131               (unless (or (string-match anything-ff-url-regexp path)
4132                           (string-match ffap-url-regexp path))
4133                 path-name-dir)))
4134     (cond ((string= path "Invalid tramp file name")
4135            (or (anything-ff-tramp-hostnames) ; Hostnames completion.
4136                (prog2
4137                    ;; `anything-pattern' have not been modified yet.
4138                    ;; Set it here to the value of `path' that should be now
4139                    ;; "Invalid tramp file name" and set the candidates list
4140                    ;; to ("Invalid tramp file name") to make `anything-pattern'
4141                    ;; match single candidate "Invalid tramp file name".
4142                    (setq anything-pattern path)
4143                    ;; "Invalid tramp file name" is now printed
4144                    ;; in `anything-buffer'.
4145                    (list path))))
4146           ((or (file-regular-p path)
4147                ;; `ffap-url-regexp' don't match until url is complete.
4148                (string-match anything-ff-url-regexp path)
4149                (and (not (file-exists-p path)) (string-match "/$" path))
4150                (and ffap-url-regexp (string-match ffap-url-regexp path)))
4151            (list path))
4152           ((string= path "") (anything-ff-directory-files "/" t))
4153           ((and (file-directory-p path) (not (file-readable-p path)))
4154            (list (format "Opening directory: access denied, `%s'" path)))
4155           ((file-directory-p path) (anything-ff-directory-files path t))
4156           (t
4157            (append (list path) ; No need to check for must-match.
4158                    (anything-ff-directory-files path-name-dir t))))))
4159
4160 (defun anything-ff-directory-files (directory &optional full)
4161   "List contents of DIRECTORY.
4162 Argument FULL mean absolute path.
4163 It is same as `directory-files' but always returns the
4164 dotted filename '.' and '..' on root directories on Windows
4165 systems."
4166   (setq directory (expand-file-name directory))
4167   (let ((ls (directory-files directory full))
4168         dot dot2 lsdir)
4169     (if (or
4170          ;; A windows volume.
4171          (string-match "^[a-zA-Z]\\{1\\}:/$" directory)
4172          ;; Empty directories on ftp hosts may have no dot dirs.
4173          (and (file-remote-p directory)
4174               (string-match "^/ftp:" directory)))
4175         (progn (setq dot (concat directory "."))
4176                (setq dot2 (concat directory ".."))
4177                (setq lsdir (remove dot2 (remove dot ls)))
4178                (append (list dot dot2) lsdir))
4179         ls)))
4180
4181 (defun anything-ff-transform-fname-for-completion (fname)
4182   "Return FNAME with it's basename modified as a regexp.
4183 e.g foo => f.*o.*o .
4184 If basename contain one or more space or FNAME is a valid directory name
4185 return FNAME unchanged."
4186   (let ((bn (anything-c-basename fname)))
4187     (if (or (not anything-ff-smart-completion)
4188             (string-match "\\s-" bn)
4189             (string-match "/$" fname) ; Allow mkdir.
4190             (file-directory-p fname)
4191             (string-match anything-ff-url-regexp fname))
4192         fname ; Fall back to match-plugin.
4193         (setq bn (if (> (length bn) 2) ; Normal completion on first 2 char.
4194                      (mapconcat 'identity (split-string bn "" t) ".*") bn))
4195         (concat (file-name-directory fname) bn))))
4196
4197 (defun anything-ff-save-history ()
4198   "Store the last value of `anything-ff-default-directory' \
4199 in `anything-ff-history'."
4200   (when (and anything-ff-default-directory
4201              (anything-file-completion-source-p))
4202     (push anything-ff-default-directory anything-ff-history)))
4203 (add-hook 'anything-cleanup-hook 'anything-ff-save-history)
4204
4205 (defun anything-ff-valid-symlink-p (file)
4206   (file-exists-p (file-truename file)))
4207
4208 (defun anything-ff-properties (candidate)
4209   "Show file properties of CANDIDATE in a tooltip or message."
4210   (let ((type       (anything-ff-attributes candidate :type t))
4211         (dired-line (anything-ff-attributes candidate :dired t :human-size t)))
4212     (if (window-system)
4213         (tooltip-show
4214          (concat
4215           (anything-c-basename candidate) "\n"
4216           "Type: " type "\n"
4217           (when (string= type "symlink")
4218             (format "True name: '%s'\n"
4219                     (cond ((string-match "^\.#" (anything-c-basename candidate))
4220                            "Autosave symlink")
4221                           ((anything-ff-valid-symlink-p candidate)
4222                            (file-truename candidate))
4223                           (t "Invalid Symlink"))))
4224           dired-line))
4225         (message dired-line) (sit-for 5))))
4226
4227 ;;;###autoload
4228 (defun anything-ff-properties-persistent ()
4229   "Show properties without quitting anything."
4230   (interactive)
4231   (anything-attrset 'properties-action 'anything-ff-properties)
4232   (anything-execute-persistent-action 'properties-action))
4233
4234 ;;;###autoload
4235 (defun anything-ff-persistent-delete ()
4236   "Delete current candidate without quitting."
4237   (interactive)
4238   (anything-attrset 'quick-delete 'anything-ff-quick-delete)
4239   (anything-execute-persistent-action 'quick-delete))
4240
4241 (defun anything-ff-dot-file-p (file)
4242   "Check if FILE is `.' or `..'."
4243   (member (anything-c-basename file) '("." "..")))
4244
4245 (defun anything-ff-quick-delete (candidate)
4246   "Delete file CANDIDATE without quitting."
4247   (let ((presel (prog1 (save-excursion
4248                          (let (sel)
4249                            (anything-next-line)
4250                            (setq sel (anything-get-selection))
4251                            (if (string= sel candidate)
4252                                (progn (anything-previous-line)
4253                                       (anything-get-selection))
4254                                sel)))
4255                   (anything-mark-current-line))))
4256     (setq presel (if (and anything-ff-transformer-show-only-basename
4257                           (not (anything-ff-dot-file-p presel)))
4258                      (anything-c-basename presel) presel))
4259     (if anything-ff-quick-delete-dont-prompt-for-deletion
4260         (anything-c-delete-file candidate
4261                                 anything-ff-signal-error-on-dot-files)
4262         (save-selected-window
4263           (when (y-or-n-p (format "Really Delete file `%s'? " candidate))
4264             (anything-c-delete-file candidate
4265                                     anything-ff-signal-error-on-dot-files)
4266             (message nil))))
4267     (anything-force-update presel)))
4268
4269 (defun anything-ff-kill-buffer-fname (candidate)
4270   (let* ((buf (get-file-buffer candidate))
4271          (buf-name (buffer-name buf)))
4272     (if buf
4273         (progn
4274           (kill-buffer buf) (message "Buffer `%s' killed" buf))
4275         (message "No buffer to kill"))))
4276
4277 (defun anything-ff-kill-or-find-buffer-fname (candidate)
4278   "Find file CANDIDATE or kill it's buffer if it is visible.
4279 Never kill `anything-current-buffer'.
4280 Never kill buffer modified.
4281 This is called normally on third hit of \
4282 \\<anything-map>\\[anything-execute-persistent-action]
4283 in `anything-find-files-persistent-action'."
4284   (let* ((buf      (get-file-buffer candidate))
4285          (buf-name (buffer-name buf)))
4286     (if (and buf (get-buffer-window buf)
4287              (not (eq buf (get-buffer anything-current-buffer)))
4288              (not (buffer-modified-p buf)))
4289         (progn
4290           (kill-buffer buf) (message "Buffer `%s' killed" buf-name))
4291         (find-file candidate))))
4292
4293 ;;;###autoload
4294 (defun anything-ff-run-kill-buffer-persistent ()
4295   "Execute `anything-ff-kill-buffer-fname' whitout quitting."
4296   (interactive)
4297   (when (anything-file-completion-source-p)
4298     (anything-attrset 'kill-buffer-fname 'anything-ff-kill-buffer-fname)
4299     (anything-execute-persistent-action 'kill-buffer-fname)))
4300
4301 (defun anything-ff-human-size (size)
4302   "Return a string showing SIZE of a file in human readable form.
4303 SIZE can be an integer or a float depending it's value.
4304 `file-attributes' will take care of that to avoid overflow error.
4305 KBSIZE if a floating point number, default value is 1024.0."
4306   (let ((M (cons "M" (/ size (expt anything-ff-default-kbsize 2))))
4307         (G (cons "G" (/ size (expt anything-ff-default-kbsize 3))))
4308         (K (cons "K" (/ size anything-ff-default-kbsize)))
4309         (B (cons "B" size)))
4310     (loop with result = B
4311           for (a . b) in
4312           (loop for (x . y) in (list M G K B)
4313                 unless (< y 1) collect (cons x y))
4314           when (< b (cdr result)) do (setq result (cons a b))
4315           finally return (if (string= (car result) "B")
4316                              (format "%s" size)
4317                              (format "%.1f%s" (cdr result) (car result))))))
4318
4319 (defun* anything-ff-attributes
4320     (file &key type links uid gid access-time modif-time
4321           status size mode gid-change inode device-num dired human-size)
4322   "Easy interface for `file-attributes'."
4323   (let ((all (destructuring-bind
4324                    (type links uid gid access-time modif-time
4325                          status size mode gid-change inode device-num)
4326                  (file-attributes file 'string)
4327                (list :type        type
4328                      :links       links
4329                      :uid         uid
4330                      :gid         gid
4331                      :access-time access-time
4332                      :modif-time  modif-time
4333                      :status      status
4334                      :size        size
4335                      :mode        mode
4336                      :gid-change  gid-change
4337                      :inode       inode
4338                      :device-num  device-num))))
4339     (cond (type
4340            (let ((result (getf all :type)))
4341              (cond ((stringp result)
4342                     "symlink")
4343                    (result "directory")
4344                    (t "file"))))
4345           (links (getf all :links))
4346           (uid   (getf all :uid))
4347           (gid   (getf all :gid))
4348           (access-time
4349            (format-time-string "%Y-%m-%d %R" (getf all :access-time)))
4350           (modif-time
4351            (format-time-string "%Y-%m-%d %R" (getf all :modif-time)))
4352           (status
4353            (format-time-string "%Y-%m-%d %R" (getf all :status)))
4354           (size (if human-size (anything-ff-human-size (getf all :size))
4355                     (getf all :size)))
4356           (mode (getf all :mode))
4357           (gid-change (getf all :gid-change))
4358           (inode (getf all :inode))
4359           (device-num (getf all :device-num))
4360           (dired
4361            (concat
4362             (getf all :mode) " "
4363             (number-to-string (getf all :links)) " "
4364             (getf all :uid) ":"
4365             (getf all :gid) " "
4366             (if human-size (anything-ff-human-size (getf all :size))
4367                 (int-to-string (getf all :size))) " "
4368                 (format-time-string "%Y-%m-%d %R" (getf all :modif-time))))
4369           (t all))))
4370
4371 (defun anything-ff-prefix-filename (fname &optional file-or-symlinkp new-file)
4372   "Return filename FNAME maybe prefixed with [?] or [@].
4373 If FILE-OR-SYMLINKP is non--nil this mean we assume FNAME is an
4374 existing filename or valid symlink and there is no need to test it.
4375 NEW-FILE when non--nil mean FNAME is a non existing file and
4376 return FNAME prefixed with [?]."
4377   (let* ((prefix-new (propertize
4378                       " " 'display
4379                       (propertize "[?]" 'face 'anything-ff-prefix)))
4380          (prefix-url (propertize
4381                       " " 'display
4382                       (propertize "[@]" 'face 'anything-ff-prefix))))
4383     (cond ((or file-or-symlinkp (file-exists-p fname)) fname)
4384           ((or (string-match anything-ff-url-regexp fname)
4385                (string-match ffap-url-regexp fname))
4386            (concat prefix-url " " fname))
4387           ((or new-file (not (file-exists-p fname)))
4388            (concat prefix-new " " fname)))))
4389
4390 (defun anything-c-find-files-transformer (files sources)
4391   "Transformer for `anything-c-source-find-files'.
4392 Tramp files are not highlighted unless `anything-ff-tramp-not-fancy'
4393 is non--nil."
4394   (if (and (string-match tramp-file-name-regexp anything-pattern)
4395            anything-ff-tramp-not-fancy)
4396       (if anything-ff-transformer-show-only-basename
4397           (loop for i in files collect
4398                 (if (string-match "[.]\\{1,2\\}$" i)
4399                     i (cons (anything-c-basename i) i)))
4400           files)
4401       (anything-ff-highlight-files files sources)))
4402
4403 (defun anything-ff-highlight-files (files sources)
4404   "Candidate transformer for `anything-c-source-find-files' without icons."
4405   (loop for i in files
4406         for disp = (if (and anything-ff-transformer-show-only-basename
4407                             (not (string-match "[.]\\{1,2\\}$" i))
4408                             (not (string-match ffap-url-regexp i))
4409                             (not (string-match anything-ff-url-regexp i)))
4410                        (anything-c-basename i) i)
4411         collect
4412         (cond ((and (stringp (car (file-attributes i)))
4413                     (not (anything-ff-valid-symlink-p i))
4414                     (not (string-match "^\.#" (anything-c-basename i))))
4415                (cons (anything-ff-prefix-filename
4416                       (propertize disp 'face 'anything-ff-invalid-symlink) t)
4417                      i))
4418               ((stringp (car (file-attributes i)))
4419                (cons (anything-ff-prefix-filename
4420                       (propertize disp 'face 'anything-ff-symlink) t)
4421                      i))
4422               ((eq t (car (file-attributes i)))
4423                (cons (anything-ff-prefix-filename
4424                       (propertize disp 'face 'anything-ff-directory) t)
4425                      i))
4426               ((file-executable-p i)
4427                (cons (anything-ff-prefix-filename
4428                       (propertize disp 'face 'anything-ff-executable) t)
4429                      i))
4430               ((file-exists-p i)
4431                (cons (anything-ff-prefix-filename
4432                       (propertize disp 'face 'anything-ff-file) t)
4433                      i))
4434               (t
4435                (cons (anything-ff-prefix-filename
4436                       (propertize disp 'face 'anything-ff-file) nil 'new-file)
4437                      i)))))
4438
4439 (defun anything-find-files-action-transformer (actions candidate)
4440   "Action transformer for `anything-c-source-find-files'."
4441   (cond ((with-anything-current-buffer
4442            (eq major-mode 'message-mode))
4443          (append (subseq actions 0 4)
4444                  '(("Gnus attach file(s)" . anything-ff-gnus-attach-files))
4445                  (subseq actions 4)))
4446         ((string-match (image-file-name-regexp) candidate)
4447          (append (subseq actions 0 4)
4448                  '(("Rotate image right `M-r'" . anything-ff-rotate-image-right)
4449                    ("Rotate image left `M-l'" . anything-ff-rotate-image-left))
4450                  (subseq actions 4)))
4451         ((string-match "\.el$" (anything-aif (anything-marked-candidates)
4452                                    (car it) candidate))
4453          (append (subseq actions 0 4)
4454                  '(("Byte compile lisp file(s) `M-B, C-u to load'"
4455                     . anything-find-files-byte-compile)
4456                    ("Load File(s) `M-L'" . anything-find-files-load-files))
4457                  (subseq actions 4)))
4458         ((and (string-match "\.html?$" candidate)
4459               (file-exists-p candidate))
4460          (append (subseq actions 0 4)
4461                  '(("Browse url file" . browse-url-of-file))
4462                  (subseq actions 5)))
4463         ((or (string= (file-name-extension candidate) "pdf")
4464              (string= (file-name-extension candidate) "PDF"))
4465          (append (subseq actions 0 4)
4466                  '(("Pdfgrep File(s)" . anything-ff-pdfgrep))
4467                  (subseq actions 5)))
4468         (t actions)))
4469
4470 (defun anything-ff-gnus-attach-files (candidate)
4471   "Run `gnus-dired-attach' on `anything-marked-candidates' or CANDIDATE."
4472   (let ((flist (anything-marked-candidates)))
4473     (gnus-dired-attach flist)))
4474
4475 (defun anything-ff-rotate-current-image-1 (file &optional num-arg)
4476   "Rotate current image at NUM-ARG degrees.
4477 This is a destructive operation on FILE made by external tool mogrify."
4478   (declare (special image-dired-display-image-buffer))
4479   (setq file (file-truename file)) ; For symlinked images.
4480   ;; When FILE is not an image-file, do nothing.
4481   (when (string-match (image-file-name-regexp) file)
4482     (if (executable-find "mogrify")
4483         (progn
4484           (shell-command (format "mogrify -rotate %s %s"
4485                                  (or num-arg 90)
4486                                  (shell-quote-argument file)))
4487           (when (buffer-live-p image-dired-display-image-buffer)
4488             (kill-buffer image-dired-display-image-buffer))
4489           (image-dired-display-image file)
4490           (message nil)
4491           (display-buffer (get-buffer image-dired-display-image-buffer)))
4492         (error "mogrify not found"))))
4493
4494 (defun anything-ff-rotate-image-left (candidate)
4495   "Rotate image file CANDIDATE left.
4496 This affect directly file CANDIDATE."
4497   (anything-ff-rotate-current-image-1 candidate -90))
4498
4499 (defun anything-ff-rotate-image-right (candidate)
4500   "Rotate image file CANDIDATE right.
4501 This affect directly file CANDIDATE."
4502   (anything-ff-rotate-current-image-1 candidate))
4503
4504 (defun anything-ff-rotate-left-persistent ()
4505   "Rotate image left without quitting anything."
4506   (interactive)
4507   (anything-attrset 'image-action1 'anything-ff-rotate-image-left)
4508   (anything-execute-persistent-action 'image-action1))
4509
4510 (defun anything-ff-rotate-right-persistent ()
4511   "Rotate image right without quitting anything."
4512   (interactive)
4513   (anything-attrset 'image-action2 'anything-ff-rotate-image-right)
4514   (anything-execute-persistent-action 'image-action2))
4515
4516 (defun anything-ff-exif-data (candidate)
4517   "Extract exif data from file CANDIDATE using `anything-ff-exif-data-program'."
4518   (if (and anything-ff-exif-data-program
4519            (executable-find anything-ff-exif-data-program))
4520       (shell-command-to-string (format "%s %s %s"
4521                                        anything-ff-exif-data-program
4522                                        anything-ff-exif-data-program-args
4523                                        candidate))
4524       (format "No program %s found to extract exif"
4525               anything-ff-exif-data-program)))
4526
4527 (defun anything-find-files-persistent-action (candidate)
4528   "Open subtree CANDIDATE without quitting anything.
4529 If CANDIDATE is not a directory expand CANDIDATE filename.
4530 If CANDIDATE is alone, open file CANDIDATE filename.
4531 That's mean:
4532 First hit on C-z expand CANDIDATE second hit open file.
4533 If a prefix arg is given or `anything-follow-mode' is on open file."
4534   (let ((follow        (buffer-local-value
4535                         'anything-follow-mode
4536                         (get-buffer-create anything-buffer)))
4537         (new-pattern   (anything-get-selection))
4538         (num-lines-buf (with-current-buffer anything-buffer
4539                          (count-lines (point-min) (point-max)))))
4540     (flet ((insert-in-minibuffer (fname)
4541              (with-selected-window (minibuffer-window)
4542                (unless follow
4543                  (delete-minibuffer-contents)
4544                  (set-text-properties 0 (length fname) nil fname)
4545                  (insert fname)))))
4546       (cond ((and (string= (anything-ff-set-pattern anything-pattern)
4547                            "Invalid tramp file name")
4548                   (string-match tramp-file-name-regexp candidate))
4549              ;; First hit insert hostname and
4550              ;; second hit insert ":" and expand.
4551              (if (string= candidate anything-pattern)
4552                  (insert-in-minibuffer (concat candidate ":"))
4553                  (insert-in-minibuffer candidate)))
4554             (;; A symlink directory, expand it's truename.
4555              (and (file-directory-p candidate) (file-symlink-p candidate))
4556              (insert-in-minibuffer (file-name-as-directory
4557                                     (file-truename
4558                                      (expand-file-name candidate)))))
4559             ;; A directory, open it.
4560             ((file-directory-p candidate)
4561              (when (string= (anything-c-basename candidate) "..")
4562                (setq anything-ff-last-expanded anything-ff-default-directory))
4563              (insert-in-minibuffer (file-name-as-directory
4564                                     (expand-file-name candidate))))
4565             ;; A symlink file, expand to it's true name. (first hit)
4566             ((and (file-symlink-p candidate) (not current-prefix-arg) (not follow))
4567              (insert-in-minibuffer (file-truename candidate)))
4568             ;; A regular file, expand it, (first hit)
4569             ((and (>= num-lines-buf 3) (not current-prefix-arg) (not follow))
4570              (insert-in-minibuffer new-pattern))
4571             ;; An image file and it is the second hit on C-z,
4572             ;; show the file in `image-dired'.
4573             ((string-match (image-file-name-regexp) candidate)
4574              (when (buffer-live-p image-dired-display-image-buffer)
4575                (kill-buffer image-dired-display-image-buffer))
4576              (image-dired-display-image candidate)
4577              (message nil)
4578              (anything-c-switch-to-buffer image-dired-display-image-buffer)
4579              (with-current-buffer image-dired-display-image-buffer
4580                (let ((exif-data (anything-ff-exif-data candidate)))
4581                  (image-dired-update-property 'help-echo exif-data))))
4582             ;; Allow browsing archive on avfs fs.
4583             ;; Assume volume is already mounted with mountavfs.
4584             ((and anything-ff-avfs-directory
4585                   (string-match
4586                    (regexp-quote (expand-file-name anything-ff-avfs-directory))
4587                    (file-name-directory candidate))
4588                   (anything-ff-file-compressed-p candidate))
4589              (insert-in-minibuffer (concat candidate "#")))
4590             ;; On second hit we open file.
4591             ;; On Third hit we kill it's buffer maybe.
4592             (t
4593              (anything-ff-kill-or-find-buffer-fname candidate))))))
4594
4595 (defun anything-ff-file-compressed-p (candidate)
4596   "Whether CANDIDATE is a compressed file or not."
4597   (member (file-name-extension candidate)
4598           anything-ff-file-compressed-list))
4599
4600 (defun anything-c-insert-file-name-completion-at-point (candidate)
4601   "Insert file name completion at point."
4602   (with-anything-current-buffer
4603     (if buffer-read-only
4604         (error "Error: Buffer `%s' is read-only" (buffer-name))
4605         (let* ((end         (point))
4606                (guess       (substring-no-properties (thing-at-point 'filename)))
4607                (beg         (- (point) (length guess)))
4608                (full-path-p (or (string-match-p (concat "^" (getenv "HOME")) guess)
4609                                 (string-match-p "^[^\~]" guess))))
4610           (set-text-properties 0 (length candidate) nil candidate)
4611           (if (and guess (not (string= guess ""))
4612                    (string-match-p "^~\\|/.*" guess))
4613               (progn
4614                 (delete-region beg end)
4615                 (insert (if full-path-p
4616                             (expand-file-name candidate)
4617                             (abbreviate-file-name candidate))))
4618               (error "Aborting completion: No valid file name at point"))))))
4619
4620 (defun* anything-find-files-history (&key (comp-read t))
4621   "The `anything-find-files' history.
4622 Show the first `anything-ff-history-max-length' elements of
4623 `anything-ff-history' in an `anything-comp-read'."
4624   (let ((history (when anything-ff-history
4625                    (anything-fast-remove-dups anything-ff-history
4626                                               :test 'equal))))
4627     (when history
4628       (setq anything-ff-history
4629             (if (>= (length history) anything-ff-history-max-length)
4630                 (subseq history 0 anything-ff-history-max-length)
4631                 history))
4632       (if comp-read
4633           (anything-comp-read
4634            "Switch to Directory: "
4635            anything-ff-history
4636            :name "Anything Find Files History"
4637            :must-match t)
4638           anything-ff-history))))
4639
4640 (defun anything-find-files-1 (fname &optional preselect)
4641   "Find FNAME with `anything' completion.
4642 Like `find-file' but with `anything' support.
4643 Use it for non--interactive calls of `anything-find-files'."
4644   (when (get-buffer anything-action-buffer)
4645     (kill-buffer anything-action-buffer))
4646   (let ((anything-mp-highlight-delay nil)
4647         ;; Be sure we don't erase the precedent minibuffer if some.
4648         (anything-ff-auto-update-initial-value
4649          (and anything-ff-auto-update-initial-value
4650               (not (minibuffer-window-active-p (minibuffer-window)))))
4651         anything-samewindow)
4652     (anything :sources 'anything-c-source-find-files
4653               :input fname
4654               :preselect preselect
4655               :keymap anything-find-files-map
4656               :prompt "Find Files or Url: "
4657               :buffer "*Anything Find Files*")))
4658
4659
4660 (defun anything-find-files-initial-input (&optional input)
4661   "Return INPUT if present, otherwise try to guess it."
4662   (or (and input (or (and (file-remote-p input) input)
4663                      (expand-file-name input)))
4664       (anything-find-files-input
4665        (ffap-guesser)
4666        (thing-at-point 'filename))))
4667
4668 (defun anything-find-files-input (fap tap)
4669   "Default input of `anything-find-files'."
4670   (let* ((def-dir (anything-c-current-directory))
4671          (lib     (anything-find-library-at-point))
4672          (url     (anything-ff-find-url-at-point))
4673          (remp    (and fap (file-remote-p fap)))
4674          (file-p  (and (not remp)
4675                        fap
4676                        (not (string= fap ""))
4677                        (file-exists-p fap)
4678                        tap (not (string= tap ""))
4679                        (file-exists-p
4680                         (file-name-directory (expand-file-name tap def-dir))))))
4681     (cond (lib) ; e.g we are inside a require sexp.
4682           (url) ; String at point is an hyperlink.
4683           (remp fap)
4684           (file-p (expand-file-name tap def-dir))
4685           (t (and (not (string= fap "")) fap)))))
4686
4687 (defun anything-c-current-directory ()
4688   "Return current-directory name at point.
4689 Useful in dired buffers when there is inserted subdirs."
4690   (if (eq major-mode 'dired-mode)
4691       (dired-current-directory)
4692       default-directory))
4693
4694 (defun anything-ff-find-url-at-point ()
4695   "Try to find link to an url in text-property at point."
4696   (let* ((he      (get-text-property (point) 'help-echo))
4697          (ov      (overlays-at (point)))
4698          (ov-he   (and ov (overlay-get
4699                            (car (overlays-at (point))) 'help-echo)))
4700          (w3m-l   (get-text-property (point) 'w3m-href-anchor))
4701          (nt-prop (get-text-property (point) 'nt-link)))
4702     ;; Org link.
4703     (when (and (stringp he) (string-match "^LINK: " he))
4704       (setq he (replace-match "" t t he)))
4705     (loop for i in (list he ov-he w3m-l nt-prop)
4706           thereis (and (stringp i) (string-match ffap-url-regexp i) i))))
4707
4708 (defun anything-find-library-at-point ()
4709   "Try to find library path at point.
4710 Find inside `require' and `declare-function' sexp."
4711   (require 'find-func)
4712   (let* ((beg-sexp (save-excursion (search-backward "(" (point-at-bol) t)))
4713          (end-sexp (save-excursion (search-forward ")" (point-at-eol) t)))
4714          (sexp     (and beg-sexp end-sexp
4715                         (buffer-substring-no-properties
4716                          (1+ beg-sexp) (1- end-sexp)))))
4717     (ignore-errors
4718       (cond ((and sexp (string-match "require \'.+[^)]" sexp))
4719              (find-library-name
4720               (replace-regexp-in-string
4721                "'\\|\)\\|\(" ""
4722                ;; If require use third arg, ignore it,
4723                ;; always use library path found in `load-path'.
4724                (second (split-string (match-string 0 sexp))))))
4725             ((and sexp (string-match-p "^declare-function" sexp))
4726              (find-library-name
4727               (replace-regexp-in-string
4728                "\"\\|ext:" ""
4729                (third (split-string sexp)))))
4730             (t nil)))))
4731
4732 ;;; Anything completion for `write-file'.==> C-x C-w
4733 (defvar anything-c-source-write-file
4734   `((name . "Write File")
4735     (header-name . (lambda (name)
4736                      (concat name anything-c-find-files-doc-header)))
4737     ;; It is needed for filenames with capital letters
4738     (disable-shortcuts)
4739     (candidates . anything-find-files-get-candidates)
4740     (filtered-candidate-transformer anything-c-find-files-transformer)
4741     (persistent-action . anything-find-files-persistent-action)
4742     (persistent-help . "Expand Candidate")
4743     (volatile)
4744     (action .
4745             (("Write File" . (lambda (candidate)
4746                                (write-file candidate 'confirm)))))))
4747
4748 ;;; Anything completion for `insert-file'.==> C-x i
4749 (defvar anything-c-source-insert-file
4750   `((name . "Insert File")
4751     (header-name . (lambda (name)
4752                      (concat name anything-c-find-files-doc-header)))
4753     ;; It is needed for filenames with capital letters
4754     (disable-shortcuts)
4755     (candidates . anything-find-files-get-candidates)
4756     (filtered-candidate-transformer anything-c-find-files-transformer)
4757     (persistent-action . anything-find-files-persistent-action)
4758     (persistent-help . "Expand Candidate")
4759     (volatile)
4760     (action .
4761             (("Insert File" . (lambda (candidate)
4762                                 (when (y-or-n-p (format "Really insert %s in %s "
4763                                                         candidate anything-current-buffer))
4764                                   (insert-file-contents candidate))))))))
4765
4766 ;;; Anything completion for copy, rename and (rel)sym/hard/link files from dired.
4767 (defvar anything-c-source-copy-files
4768   `((name . "Copy Files")
4769     (header-name . (lambda (name)
4770                      (concat name anything-c-find-files-doc-header)))
4771     ;; It is needed for filenames with capital letters
4772     (disable-shortcuts)
4773     (candidates . anything-find-files-get-candidates)
4774     (filtered-candidate-transformer anything-c-find-files-transformer)
4775     (persistent-action . anything-find-files-persistent-action)
4776     (persistent-help . "Expand Candidate")
4777     (volatile)
4778     (action .
4779             (("Copy File"
4780               . (lambda (candidate)
4781                   (anything-dired-action candidate :action 'copy)))
4782              ("Copy and Follow"
4783               . (lambda (candidate)
4784                   (anything-dired-action candidate :action 'copy :follow t)))))))
4785
4786
4787 (defvar  anything-c-source-rename-files
4788   `((name . "Rename Files")
4789     (header-name . (lambda (name)
4790                      (concat name anything-c-find-files-doc-header)))
4791     ;; It is needed for filenames with capital letters
4792     (disable-shortcuts)
4793     (candidates . anything-find-files-get-candidates)
4794     (filtered-candidate-transformer anything-c-find-files-transformer)
4795     (persistent-action . anything-find-files-persistent-action)
4796     (persistent-help . "Expand Candidate")
4797     (volatile)
4798     (action .
4799             (("Rename File"
4800               . (lambda (candidate)
4801                   (anything-dired-action candidate :action 'rename)))
4802              ("Rename and Follow"
4803               . (lambda (candidate)
4804                   (anything-dired-action candidate :action 'rename :follow t)))))))
4805
4806 (defvar anything-c-source-symlink-files
4807   `((name . "Symlink Files")
4808     (header-name . (lambda (name)
4809                      (concat name anything-c-find-files-doc-header)))
4810     ;; It is needed for filenames with capital letters
4811     (disable-shortcuts)
4812     (candidates . anything-find-files-get-candidates)
4813     (filtered-candidate-transformer anything-c-find-files-transformer)
4814     (persistent-action . anything-find-files-persistent-action)
4815     (persistent-help . "Expand Candidate")
4816     (volatile)
4817     (action
4818      . (("Symlink File"
4819          . (lambda (candidate)
4820              (anything-dired-action candidate :action 'symlink)))
4821         ("RelSymlink File"
4822          . (lambda (candidate)
4823              (anything-dired-action candidate :action 'relsymlink)))))))
4824
4825
4826 (defvar anything-c-source-hardlink-files
4827   `((name . "Hardlink Files")
4828     (header-name . (lambda (name)
4829                      (concat name anything-c-find-files-doc-header)))
4830     ;; It is needed for filenames with capital letters
4831     (disable-shortcuts)
4832     (candidates . anything-find-files-get-candidates)
4833     (filtered-candidate-transformer anything-c-find-files-transformer)
4834     (persistent-action . anything-find-files-persistent-action)
4835     (persistent-help . "Expand Candidate")
4836     (volatile)
4837     (action
4838      . (("Hardlink File"
4839          . (lambda (candidate)
4840              (anything-dired-action candidate :action 'hardlink)))))))
4841
4842 (defun* anything-dired-action (candidate &key action follow (files (dired-get-marked-files)))
4843   "Copy, rename or symlink file at point or marked files in dired to CANDIDATE.
4844 ACTION is a key that can be one of 'copy, 'rename, 'symlink, 'relsymlink."
4845   (when (get-buffer dired-log-buffer) (kill-buffer dired-log-buffer))
4846   (let ((fn     (case action
4847                   ('copy       'dired-copy-file)
4848                   ('rename     'dired-rename-file)
4849                   ('symlink    'make-symbolic-link)
4850                   ('relsymlink 'dired-make-relative-symlink)
4851                   ('hardlink   'dired-hardlink)))
4852         (marker (case action
4853                   ((copy rename)   dired-keep-marker-copy)
4854                   ('symlink        dired-keep-marker-symlink)
4855                   ('relsymlink     dired-keep-marker-relsymlink)
4856                   ('hardlink       dired-keep-marker-hardlink)))
4857         (dirflag (and (= (length files) 1)
4858                       (file-directory-p (car files))
4859                       (not (file-directory-p candidate)))))
4860     (dired-create-files
4861      fn (symbol-name action) files
4862      ;; CANDIDATE is the destination.
4863      (if (file-directory-p candidate)
4864          ;; When CANDIDATE is a directory, build file-name in this directory.
4865          ;; Else we use CANDIDATE.
4866          #'(lambda (from)
4867              (expand-file-name (file-name-nondirectory from) candidate))
4868          #'(lambda (from) candidate))
4869      marker)
4870     (push (file-name-as-directory
4871            (if (file-directory-p candidate)
4872                (expand-file-name candidate)
4873                (file-name-directory candidate)))
4874            anything-ff-history)
4875     (when (and follow (not (get-buffer dired-log-buffer)))
4876       (let ((target (directory-file-name candidate)))
4877         (unwind-protect
4878              (progn
4879                (setq anything-ff-cand-to-mark
4880                      (anything-get-dest-fnames-from-list files candidate dirflag))
4881                (if (and dirflag (eq action 'rename))
4882                    (anything-find-files-1 (file-name-directory target)
4883                                           (if anything-ff-transformer-show-only-basename
4884                                               (anything-c-basename target) target))
4885                    (anything-find-files-1 (expand-file-name candidate))))
4886           (setq anything-ff-cand-to-mark nil))))))
4887
4888 (defun anything-c-basename (fname &optional ext)
4889   "Print FNAME  with any  leading directory  components removed.
4890 If specified, also remove filename extension EXT."
4891   (if (and ext (or (string= (file-name-extension fname) ext)
4892                    (string= (file-name-extension fname t) ext))
4893            (not (file-directory-p fname)))
4894       (file-name-sans-extension (file-name-nondirectory fname))
4895       (file-name-nondirectory (directory-file-name fname))))
4896
4897 (defun anything-get-dest-fnames-from-list (flist dest-cand rename-dir-flag)
4898   "Transform filenames of FLIST to abs of DEST-CAND.
4899 If RENAME-DIR-FLAG is non--nil collect the `directory-file-name' of transformed
4900 members of FLIST."
4901   ;; At this point files have been renamed/copied at destination.
4902   ;; That's mean DEST-CAND exists.
4903   (loop
4904         with dest = (expand-file-name dest-cand)
4905         for src in flist
4906         for basename-src = (anything-c-basename src)
4907         for fname = (cond (rename-dir-flag (directory-file-name dest))
4908                           ((file-directory-p dest)
4909                            (concat (file-name-as-directory dest) basename-src))
4910                           (t dest))
4911         when (file-exists-p fname)
4912         collect fname into tmp-list
4913         finally return (sort tmp-list 'string<)))
4914
4915 (defun anything-ff-maybe-mark-candidates ()
4916   "Mark all candidates of list `anything-ff-cand-to-mark'."
4917   (when (and (string= (assoc-default 'name (anything-get-current-source))
4918                       (assoc-default 'name anything-c-source-find-files))
4919              anything-ff-cand-to-mark)
4920     (with-anything-window
4921       (while anything-ff-cand-to-mark
4922         (if (string= (car anything-ff-cand-to-mark) (anything-get-selection))
4923             (progn
4924               (anything-make-visible-mark)
4925               (anything-next-line)
4926               (setq anything-ff-cand-to-mark (cdr anything-ff-cand-to-mark)))
4927             (anything-next-line)))
4928       (unless (anything-this-visible-mark)
4929         (anything-prev-visible-mark)))))
4930
4931 (add-hook 'anything-after-update-hook #'anything-ff-maybe-mark-candidates)
4932
4933 (defun* anything-dired-do-action-on-file (&key action)
4934   (let* ((files     (dired-get-marked-files))
4935          (len       (length files))
4936          (fname     (if (> len 1)
4937                         (format "* %d Files" len)
4938                         (car files)))
4939          (source    (case action
4940                       ('copy     'anything-c-source-copy-files)
4941                       ('rename   'anything-c-source-rename-files)
4942                       ('symlink  'anything-c-source-symlink-files)
4943                       ('hardlink 'anything-c-source-hardlink-files)))
4944          (prompt-fm (case action
4945                       ('copy     "Copy %s to: ")
4946                       ('rename   "Rename %s to: ")
4947                       ('symlink  "Symlink %s to: ")
4948                       ('hardlink "Hardlink %s to: ")))
4949          (buffer    (case action
4950                       ('copy     "*Anything Copy Files*")
4951                       ('rename   "*Anything Rename Files*")
4952                       ('symlink  "*Anything Symlink Files*")
4953                       ('hardlink "*Anything Hardlink Files*")))
4954          (anything-mp-highlight-delay     nil))
4955     (anything :sources source
4956               :input (or (dired-dwim-target-directory)
4957                          (expand-file-name (anything-c-current-directory)))
4958               :preselect (dired-get-filename)
4959               :prompt (format prompt-fm fname)
4960               :keymap anything-c-read-file-map
4961               :buffer buffer)))
4962
4963 ;;;###autoload
4964 (define-minor-mode anything-dired-mode ()
4965   "Enable anything completion in Dired functions.
4966 Bindings affected are C, R, S, H.
4967 This is deprecated for Emacs24+ users, use `ac-mode' instead."
4968   :group 'anything-config
4969   :global t
4970   (if anything-dired-mode
4971       (progn
4972         (substitute-key-definition
4973          'dired-do-copy 'anything-dired-copy-file dired-mode-map)
4974         (substitute-key-definition
4975          'dired-do-rename 'anything-dired-rename-file dired-mode-map)
4976         (substitute-key-definition
4977          'dired-do-symlink 'anything-dired-symlink-file dired-mode-map)
4978         (substitute-key-definition
4979          'dired-do-hardlink 'anything-dired-hardlink-file dired-mode-map))
4980       (substitute-key-definition
4981        'anything-dired-copy-file 'dired-do-copy dired-mode-map)
4982       (substitute-key-definition
4983        'anything-dired-rename-file 'dired-do-rename dired-mode-map)
4984       (substitute-key-definition
4985        'anything-dired-symlink-file 'dired-do-symlink dired-mode-map)
4986       (substitute-key-definition
4987        'anything-dired-hardlink-file 'dired-do-hardlink dired-mode-map)))
4988
4989 (defalias 'anything-dired-bindings 'anything-dired-mode)
4990
4991 (defun* anything-c-read-file-name
4992     (prompt
4993      &key
4994      (name "Read File Name")
4995      (initial-input (expand-file-name default-directory))
4996      (buffer "*Anything Completions*")
4997      test
4998      (preselect nil)
4999      (history nil)
5000      must-match
5001      (marked-candidates nil)
5002      (alistp t)
5003      (persistent-action 'anything-find-files-persistent-action)
5004      (persistent-help "Hit1 Expand Candidate, Hit2 or (C-u) Find file"))
5005   "Read a file name with anything completion.
5006 It is anything `read-file-name' emulation.
5007
5008 Argument PROMPT is the default prompt to use.
5009
5010 Keys description:
5011
5012 - NAME: Source name, default to \"Read File Name\".
5013
5014 - INITIAL-INPUT: Where to start read file name, default to `default-directory'.
5015
5016 - BUFFER: `anything-buffer' name default to \"*Anything Completions*\".
5017
5018 - TEST: A predicate called with one arg 'candidate'.
5019
5020 - PRESELECT: anything preselection.
5021
5022 - HISTORY: Display HISTORY in a special source.
5023
5024 - MUST-MATCH: Can be 'confirm, nil, or t.
5025
5026 - MARKED-CANDIDATES: When non--nil return a list of marked candidates.
5027
5028 - ALISTP: Don't use `all-completions' in history (take effect only on history).
5029
5030 - PERSISTENT-ACTION: a persistent action function.
5031
5032 - PERSISTENT-HELP: persistent help message."
5033   (when (get-buffer anything-action-buffer)
5034     (kill-buffer anything-action-buffer))
5035
5036   ;; Assume completion have been already required,
5037   ;; so always use 'confirm.
5038   (when (eq must-match 'confirm-after-completion)
5039     (setq must-match 'confirm))
5040
5041   (flet ((action-fn (candidate)
5042            (if marked-candidates
5043                (anything-marked-candidates)
5044                (identity candidate))))
5045
5046     (let* ((anything-mp-highlight-delay nil)
5047            ;; Be sure we don't erase the underlying minibuffer if some.
5048            (anything-ff-auto-update-initial-value
5049             (and anything-ff-auto-update-initial-value
5050                  (not (minibuffer-window-active-p (minibuffer-window)))))
5051            anything-same-window
5052            (hist (and history (anything-comp-read-get-candidates
5053                                history nil nil alistp)))
5054            (minibuffer-completion-confirm must-match)
5055            (must-match-map (when must-match
5056                              (let ((map (make-sparse-keymap)))
5057                                (define-key map (kbd "RET")
5058                                  'anything-confirm-and-exit-minibuffer)
5059                                map)))
5060            (anything-map (if must-match-map
5061                              (make-composed-keymap
5062                               must-match-map anything-c-read-file-map)
5063                              anything-c-read-file-map)))
5064
5065       (or (anything
5066            :sources
5067            `(((name . ,(format "%s History" name))
5068               (header-name . (lambda (name)
5069                                (concat name anything-c-find-files-doc-header)))
5070               (disable-shortcuts)
5071               (mode-line . anything-read-file-name-mode-line-string)
5072               (candidates . hist)
5073               (persistent-action . ,persistent-action)
5074               (persistent-help . ,persistent-help)
5075               (action . ,'action-fn))
5076              ((name . ,name)
5077               (header-name . (lambda (name)
5078                                (concat name anything-c-find-files-doc-header)))
5079               (init . (lambda ()
5080                         (setq anything-ff-auto-update-flag
5081                               anything-ff-auto-update-initial-value)))
5082               ;; It is needed for filenames with capital letters
5083               (disable-shortcuts)
5084               (mode-line . anything-read-file-name-mode-line-string)
5085               (candidates
5086                . (lambda ()
5087                    (if test
5088                        (loop with hn = (anything-ff-tramp-hostnames)
5089                              for i in (anything-find-files-get-candidates
5090                                        must-match)
5091                              when (or (member i hn)            ; A tramp host
5092                                       (funcall test i)         ; Test ok
5093                                       (not (file-exists-p i))) ; A new file.
5094                              collect i)
5095                        (anything-find-files-get-candidates must-match))))
5096               (filtered-candidate-transformer anything-c-find-files-transformer)
5097               (persistent-action . ,persistent-action)
5098               (candidate-number-limit . 9999)
5099               (toggle-auto-update . anything-ff-toggle-auto-update)
5100               (persistent-help . ,persistent-help)
5101               (volatile)
5102               (action . ,'action-fn)))
5103            :input initial-input
5104            :prompt prompt
5105            :resume 'noresume
5106            :buffer buffer
5107            :preselect preselect)
5108           (when (and (not (string= anything-pattern ""))
5109                      (eq anything-exit-status 0)
5110                      (eq must-match 'confirm))
5111             (identity anything-pattern))
5112           (keyboard-quit)))))
5113
5114 \f
5115 ;;; File Cache
5116 (defvar anything-c-file-cache-initialized-p nil)
5117
5118 (defvar anything-c-file-cache-files nil)
5119
5120 (defvar anything-c-source-file-cache
5121   `((name . "File Cache")
5122     (init
5123      . (lambda ()
5124          (require 'filecache nil t)
5125          (unless anything-c-file-cache-initialized-p
5126            (setq anything-c-file-cache-files
5127                  (loop for item in file-cache-alist append
5128                        (destructuring-bind (base &rest dirs) item
5129                          (loop for dir in dirs collect
5130                                (concat dir base)))))
5131            (defadvice file-cache-add-file (after file-cache-list activate)
5132              (add-to-list 'anything-c-file-cache-files (expand-file-name file)))
5133            (setq anything-c-file-cache-initialized-p t))))
5134     (keymap . ,anything-generic-files-map)
5135     (help-message . anything-generic-file-help-message)
5136     (mode-line . anything-generic-file-mode-line-string)
5137     (candidates . anything-c-file-cache-files)
5138     (match anything-c-match-on-basename)
5139     (type . file)))
5140
5141 \f
5142 ;;; Locate
5143 ;;
5144 ;;
5145 ;; NOTE for WINDOZE users:
5146 ;; You have to install Everything with his command line interface here:
5147 ;; http://www.voidtools.com/download.php
5148
5149 (defun anything-ff-find-locatedb (&optional from-ff)
5150   "Try to find if a local locatedb file is available.
5151 The search is done in `anything-ff-default-directory' or
5152 fall back to `default-directory' if FROM-FF is nil."
5153   (when anything-ff-locate-db-filename
5154     (cond ((and anything-ff-default-directory
5155                 from-ff
5156                 (file-exists-p (expand-file-name
5157                                 anything-ff-locate-db-filename
5158                                 anything-ff-default-directory))
5159                 (expand-file-name
5160                  anything-ff-locate-db-filename
5161                  anything-ff-default-directory)))
5162           ((and (not from-ff)
5163                 (file-exists-p (expand-file-name
5164                                 anything-ff-locate-db-filename
5165                                 default-directory))
5166                 (expand-file-name
5167                  anything-ff-locate-db-filename
5168                  default-directory))))))
5169
5170 (defun anything-locate-1 (&optional localdb init from-ff)
5171   "Generic function to run Locate.
5172 if LOCALDB is non--nil search and use a local locate db file.
5173 INIT is a string to use as initial input in prompt.
5174 See `anything-locate-with-db' and `anything-locate'."
5175   (anything-locate-with-db
5176    (and localdb
5177         (or (anything-ff-find-locatedb from-ff)
5178             (anything-c-read-file-name
5179              "LocateDBFiles: "
5180              :initial-input (or anything-ff-default-directory
5181                                 default-directory)
5182              :marked-candidates t
5183              :preselect anything-locate-db-file-regexp
5184              :test #'(lambda (x)
5185                        (if anything-locate-db-file-regexp
5186                            ;; Select only locate db files and directories
5187                            ;; to allow navigation.
5188                            (or (string-match
5189                                 anything-locate-db-file-regexp x)
5190                                (file-directory-p x))
5191                            x)))))
5192    init))
5193 ;; (anything-locate-1 t)
5194
5195 (defun anything-locate-with-db (&optional db initial-input)
5196   "Run locate -d DB.
5197 If DB is not given or nil use locate without -d option.
5198 Argument DB can be given as a string or list of db files.
5199 Argument INITIAL-INPUT is a string to use as initial-input.
5200 See also `anything-locate'."
5201   (when (and db (stringp db)) (setq db (list db)))
5202   (unless anything-c-locate-command
5203     (setq anything-c-locate-command
5204           (case system-type
5205             ('gnu/linux "locate -i -r %s")
5206             ('berkeley-unix "locate -i %s")
5207             ('windows-nt "es -i -r %s")
5208             (t "locate %s"))))
5209   (let ((anything-c-locate-command
5210          (if db
5211              (replace-regexp-in-string
5212               "locate"
5213               (format "locate -d %s"
5214                       (mapconcat 'identity
5215                                  ;; Remove eventually
5216                                  ;; marked directories by error.
5217                                  (loop for i in db
5218                                        unless (file-directory-p i)
5219                                        collect i) ":"))
5220               anything-c-locate-command)
5221              anything-c-locate-command)))
5222     (anything :sources 'anything-c-source-locate
5223               :buffer "*anything locate*"
5224               :input initial-input
5225               :keymap anything-generic-files-map)))
5226 ;; (anything-locate-with-db "~/locate.db")
5227
5228 (defun anything-c-locate-init ()
5229   "Initialize async locate process for `anything-c-source-locate'."
5230   (setq mode-line-format
5231         '(" " mode-line-buffer-identification " "
5232           (line-number-mode "%l") " "
5233           (:eval (propertize "(Locate Process Running) "
5234                   'face '((:foreground "red"))))))
5235   (prog1
5236       (start-process-shell-command "locate-process" nil
5237                                    (format anything-c-locate-command
5238                                            anything-pattern))
5239     (set-process-sentinel (get-process "locate-process")
5240                           #'(lambda (process event)
5241                               (when (string= event "finished\n")
5242                                 (with-anything-window
5243                                   (force-mode-line-update nil)
5244                                   (anything-update-move-first-line)))))))
5245
5246 (defvar anything-c-source-locate
5247   `((name . "Locate")
5248     (candidates . anything-c-locate-init)
5249     (type . file)
5250     (requires-pattern . 3)
5251     (keymap . ,anything-generic-files-map)
5252     (help-message . anything-generic-file-help-message)
5253     (candidate-number-limit . 9999)
5254     (mode-line . anything-generic-file-mode-line-string)
5255     (delayed))
5256   "Find files matching the current input pattern with locate.")
5257
5258 (defun anything-c-locate-read-file-name (prompt &optional init)
5259   "Search a file with locate and return it's filename.
5260 Use argument PROMPT and INIT for `anything' arguments
5261 prompt and input."
5262   (anything :sources
5263             '((name . "Locate")
5264               (candidates . anything-c-locate-init)
5265               (action . identity)
5266               (requires-pattern . 3)
5267               (candidate-number-limit . 9999)
5268               (mode-line . anything-generic-file-mode-line-string)
5269               (delayed))
5270             :prompt prompt
5271             :input init
5272             :buffer "*anything locate rfn*"))
5273
5274
5275 \f
5276 ;;; Anything Incremental Grep.
5277 ;;
5278 ;;
5279 ;; Allow to grep incrementally with anything interface.
5280 ;; It allow also to Grep files recursively without using 'find' shell command.
5281 ;; On Windows you will need at least Grep version 2.5.4 of Gnuwin32.
5282 (defvar anything-c-grep-default-command
5283   "grep -d skip %e -niH -e %p %f"
5284   "Default grep format command for `anything-do-grep-1'.
5285 Where:
5286 '%e' format spec is for --exclude or --include grep options.
5287 '%p' format spec is for pattern.
5288 '%f' format spec is for filenames.")
5289
5290 (defvar anything-c-grep-default-recurse-command
5291   "grep -d recurse %e -niH -e %p %f"
5292   "Default recursive grep format command for `anything-do-grep-1'.
5293 See `anything-c-grep-default-command' for format specs.")
5294
5295 (defvar anything-c-default-zgrep-command "zgrep -niH -e %p %f")
5296
5297 (defvar anything-c-rzgrep-cache (make-hash-table :test 'equal))
5298
5299 (defvar anything-c-grep-default-function 'anything-c-grep-init)
5300
5301 (defvar anything-c-grep-debug-command-line nil
5302   "Turn on anything grep command-line debugging when non--nil.")
5303
5304 (defvar anything-c-zgrep-recurse-flag nil)
5305
5306 (defvar anything-c-grep-history nil)
5307
5308 (defvar anything-c-grep-max-length-history 100
5309   "*Max number of elements to save in `anything-c-grep-history'.")
5310
5311 (defun anything-c-grep-prepare-candidates (candidates)
5312   "Prepare filenames and directories CANDIDATES for grep command line."
5313   ;; If one or more candidate is a directory, search in all files
5314   ;; of this candidate (e.g /home/user/directory/*).
5315   ;; If r option is enabled search also in subdidrectories.
5316   ;; We need here to expand wildcards to support crap windows filenames
5317   ;; as grep doesn't accept quoted wildcards (e.g "dir/*.el").
5318   (if anything-c-zgrep-recurse-flag
5319       (mapconcat 'shell-quote-argument candidates " ")
5320       (loop for i in candidates append
5321             (cond ( ;; Candidate is a directory and we use recursion.
5322                    (and (file-directory-p i)
5323                         (anything-c-grep-recurse-p))
5324                    (list (expand-file-name i)))
5325                   ;; Candidate is a directory, search in all files.
5326                   ((file-directory-p i)
5327                    (file-expand-wildcards
5328                     (concat (file-name-as-directory (expand-file-name i)) "*") t))
5329                   ;; Candidate is a file or wildcard and we use recursion, use the
5330                   ;; current directory instead of candidate.
5331                   ((and (or (file-exists-p i) (string-match "\*" i))
5332                         (anything-c-grep-recurse-p))
5333                    (list (expand-file-name
5334                           (directory-file-name ; Needed for windoze.
5335                            (file-name-directory (directory-file-name i))))))
5336                   ;; Candidate use wildcard.
5337                   ((string-match "^\*" (anything-c-basename i))
5338                    (file-expand-wildcards i t))
5339                   ;; Else should be one or more file.
5340                   (t (list i))) into all-files
5341             finally return
5342             (mapconcat 'shell-quote-argument all-files " "))))
5343
5344 (defun anything-c-grep-recurse-p ()
5345   "Check if `anything-do-grep-1' have switched to recursive."
5346   (let ((args (replace-regexp-in-string
5347                "grep" "" anything-c-grep-default-command)))
5348     (string-match-p "r\\|recurse" args)))
5349
5350 (defun anything-c-grep-init (only-files &optional include zgrep)
5351   "Start an asynchronous grep process in ONLY-FILES list."
5352   (let* ((fnargs        (anything-c-grep-prepare-candidates
5353                          (if (file-remote-p anything-ff-default-directory)
5354                              (mapcar #'(lambda (x)
5355                                          (file-remote-p x 'localname))
5356                                      only-files)
5357                              only-files)))
5358          (ignored-files (mapconcat
5359                          #'(lambda (x)
5360                              (concat "--exclude=" (shell-quote-argument x)))
5361                          grep-find-ignored-files " "))
5362          (ignored-dirs  (mapconcat
5363                          ;; Need grep version >=2.5.4 of Gnuwin32 on windoze.
5364                          #'(lambda (x)
5365                              (concat "--exclude-dir=" (shell-quote-argument x)))
5366                          grep-find-ignored-directories " "))
5367          (exclude       (if (anything-c-grep-recurse-p)
5368                             (concat (or include ignored-files) " " ignored-dirs)
5369                             ignored-files))
5370          (cmd-line      (format-spec
5371                          anything-c-grep-default-command
5372                          (delq nil
5373                                (list (unless zgrep (cons ?e exclude))
5374                                      (cons ?p (shell-quote-argument anything-pattern))
5375                                      (cons ?f fnargs))))))
5376     (when anything-c-grep-debug-command-line
5377       (with-current-buffer (get-buffer-create "*any grep debug*")
5378         (goto-char (point-max))
5379         (insert (concat ">>> " cmd-line "\n\n"))))
5380     (setq mode-line-format
5381           '(" " mode-line-buffer-identification " "
5382             (line-number-mode "%l") " "
5383             (:eval (when (get-process "grep-process")
5384                      (propertize "[Grep Process Running] "
5385                                  'face 'anything-grep-running)))))
5386     (force-mode-line-update nil)
5387     (prog1
5388         (let ((default-directory anything-ff-default-directory))
5389           (start-file-process-shell-command "grep-process" nil cmd-line))
5390       (message nil)
5391       (set-process-sentinel
5392        (get-process "grep-process")
5393        #'(lambda (process event)
5394            (when (string= event "finished\n")
5395              (with-anything-window
5396                (anything-update-move-first-line)
5397                (setq mode-line-format
5398                      '(" " mode-line-buffer-identification " "
5399                        (line-number-mode "%l") " "
5400                        (:eval (propertize
5401                                (format "[Grep Process Finished - (%s results)] "
5402                                        (let ((nlines (1- (count-lines
5403                                                           (point-min)
5404                                                           (point-max)))))
5405                                          (if (> nlines 0) nlines 0)))
5406                                'face 'anything-grep-finish))))
5407                (force-mode-line-update nil))))))))
5408
5409 (defun anything-c-grep-action (candidate &optional where mark)
5410   "Define a default action for `anything-do-grep' on CANDIDATE.
5411 WHERE can be one of other-window, elscreen, other-frame."
5412   (let* ((split        (anything-c-grep-split-line candidate))
5413          (lineno       (string-to-number (nth 1 split)))
5414          (loc-fname    (car split))
5415          (tramp-method (file-remote-p anything-ff-default-directory 'method))
5416          (tramp-host   (file-remote-p anything-ff-default-directory 'host))
5417          (tramp-prefix (concat "/" tramp-method ":" tramp-host ":"))
5418          (fname        (if tramp-host
5419                            (concat tramp-prefix loc-fname) loc-fname)))
5420     (case where
5421       (other-window (find-file-other-window fname))
5422       (elscreen     (anything-elscreen-find-file fname))
5423       (other-frame  (find-file-other-frame fname))
5424       (grep         (anything-c-grep-save-results-1))
5425       (t (find-file fname)))
5426     (unless (eq where 'grep)
5427       (anything-goto-line lineno))
5428     (when mark
5429       (set-marker (mark-marker) (point))
5430       (push-mark (point) 'nomsg))
5431     ;; Save history
5432     (unless (or anything-in-persistent-action
5433                 (string= anything-pattern ""))
5434       (setq anything-c-grep-history
5435             (cons anything-pattern
5436                   (delete anything-pattern anything-c-grep-history)))
5437       (when (> (length anything-c-grep-history)
5438                anything-c-grep-max-length-history)
5439         (setq anything-c-grep-history
5440               (delete (car (last anything-c-grep-history))
5441                       anything-c-grep-history))))))
5442
5443 (defun anything-c-grep-other-window (candidate)
5444   "Jump to result in other window from anything grep."
5445   (anything-c-grep-action candidate 'other-window))
5446
5447 (defun anything-c-grep-other-frame (candidate)
5448   "Jump to result in other frame from anything grep."
5449   (anything-c-grep-action candidate 'other-frame))
5450
5451 (defun anything-c-grep-jump-elscreen (candidate)
5452   "Jump to result in elscreen from anything grep."
5453   (anything-c-grep-action candidate 'elscreen))
5454
5455 (defun anything-c-grep-save-results (_candidate)
5456   (anything-c-grep-action _candidate 'grep))
5457
5458 (defun anything-c-grep-save-results-1 ()
5459   "Save anything grep result in a `grep-mode' buffer."
5460   (let ((buf "*grep*")
5461         new-buf)
5462     (when (get-buffer buf)
5463       (setq new-buf (read-string "GrepBufferName: " buf))
5464       (loop for b in (anything-c-buffer-list)
5465             when (and (string= new-buf b)
5466                       (not (y-or-n-p
5467                             (format "Buffer `%s' already exists overwrite? "
5468                                     new-buf))))
5469             do (setq new-buf (read-string "GrepBufferName: " "*grep ")))
5470       (setq buf new-buf))
5471     (with-current-buffer (get-buffer-create buf)
5472       (let ((inhibit-read-only t))
5473         (erase-buffer)
5474         (insert "-*- mode: grep -*-\n\n"
5475                 (format "Grep Results for `%s':\n\n" anything-pattern))
5476         (save-excursion
5477           (insert (with-current-buffer anything-buffer
5478                     (goto-char (point-min)) (forward-line 1)
5479                     (buffer-substring (point) (point-max))))
5480           (grep-mode))))
5481     (message "Anything Grep Results saved in `%s' buffer" buf)))
5482
5483 (defun anything-c-grep-persistent-action (candidate)
5484   "Persistent action for `anything-do-grep'.
5485 With a prefix arg record CANDIDATE in `mark-ring'."
5486   (if current-prefix-arg
5487       (anything-c-grep-action candidate nil 'mark)
5488       (anything-c-grep-action candidate))
5489   (anything-match-line-color-current-line))
5490
5491 (defun anything-c-grep-guess-extensions (files)
5492   "Try to guess file extensions in FILES list when using grep recurse.
5493 These extensions will be added to command line with --include arg of grep."
5494   (loop
5495         with glob-list = nil
5496         with lst = (if (file-directory-p (car files))
5497                        (directory-files
5498                         (car files) nil
5499                         directory-files-no-dot-files-regexp)
5500                        files)
5501         for i in lst
5502         for ext = (file-name-extension i t)
5503         for glob = (and ext (not (string= ext ""))
5504                         (concat "*" ext))
5505         unless (or (not glob)
5506                    (member glob glob-list)
5507                    (member glob grep-find-ignored-files))
5508         collect glob into glob-list
5509         finally return glob-list))
5510
5511 (defun anything-do-grep-1 (only &optional recurse zgrep)
5512   "Launch grep with a list of ONLY files.
5513 When RECURSE is given use -r option of grep and prompt user
5514 to set the --include args of grep.
5515 You can give more than one arg separated by space.
5516 e.g *.el *.py *.tex.
5517 If it's empty --exclude `grep-find-ignored-files' is used instead."
5518   (let* ((anything-compile-source-functions
5519           ;; rule out anything-match-plugin because the input is one regexp.
5520           (delq 'anything-compile-source--match-plugin
5521                 (copy-sequence anything-compile-source-functions)))
5522          (exts (anything-c-grep-guess-extensions only))
5523          (globs (and (not zgrep) (mapconcat 'identity exts " ")))
5524          (include-files (and recurse (not zgrep)
5525                              (read-string "OnlyExt(*.[ext]): "
5526                                           globs)))
5527          ;; Set `minibuffer-history' AFTER includes-files
5528          ;; to avoid storing wild-cards here.
5529          (minibuffer-history anything-c-grep-history)
5530          (anything-c-grep-default-command (cond ((and recurse zgrep) anything-c-default-zgrep-command)
5531                                                 (recurse anything-c-grep-default-recurse-command)
5532                                                 (zgrep anything-c-default-zgrep-command)
5533                                                 (t anything-c-grep-default-command)))
5534          ;; Disable match-plugin and use here own highlighting.
5535          (anything-mp-highlight-delay     nil))
5536     (when include-files
5537       (setq include-files
5538             (and (not (string= include-files ""))
5539                  (mapconcat #'(lambda (x)
5540                                 (concat "--include=" (shell-quote-argument x)))
5541                             (split-string include-files) " "))))
5542     ;; When called as action from an other source e.g *-find-files
5543     ;; we have to kill action buffer.
5544     (when (get-buffer anything-action-buffer)
5545       (kill-buffer anything-action-buffer))
5546     ;; `anything-find-files' haven't already started,
5547     ;; give a default value to `anything-ff-default-directory'.
5548     (setq anything-ff-default-directory (or anything-ff-default-directory
5549                                             default-directory))
5550     (anything
5551      :sources
5552      `(((name . "Grep")
5553         (header-name . (lambda (name)
5554                          (concat name "(C-c ? Help)")))
5555         (candidates
5556          . (lambda ()
5557              (funcall anything-c-grep-default-function only include-files zgrep)))
5558         (filtered-candidate-transformer anything-c-grep-cand-transformer)
5559         (candidate-number-limit . 9999)
5560         (mode-line . anything-grep-mode-line-string)
5561         (keymap . ,anything-c-grep-map)
5562         (action . ,(delq
5563                     nil
5564                     `(("Find File" . anything-c-grep-action)
5565                       ("Find file other frame" . anything-c-grep-other-frame)
5566                       ,(and (locate-library "elscreen")
5567                             '("Find file in Elscreen"
5568                               . anything-c-grep-jump-elscreen))
5569                       ("Save results in grep buffer" . anything-c-grep-save-results)
5570                       ("Find file other window" . anything-c-grep-other-window))))
5571         (persistent-action . anything-c-grep-persistent-action)
5572         (persistent-help . "Jump to line (`C-u' Record in mark ring)")
5573         (requires-pattern . 3)
5574         (delayed)))
5575      :buffer "*anything grep*")))
5576
5577 (defun anything-ff-zgrep-1 (flist recursive)
5578   (unwind-protect
5579        (let* ((def-dir (or anything-ff-default-directory
5580                            default-directory))
5581               (only    (if recursive
5582                            (or (gethash def-dir anything-c-rzgrep-cache)
5583                                (puthash
5584                                 def-dir
5585                                 (anything-c-walk-directory
5586                                  def-dir
5587                                  :directories nil
5588                                  :path 'full
5589                                  :match ".*\\(\.gz\\|\.bz\\|\.xz\\|\.lzma\\)$")
5590                                 anything-c-rzgrep-cache))
5591                            flist)))
5592          (when recursive (setq anything-c-zgrep-recurse-flag t))
5593          (anything-do-grep-1 only recursive 'zgrep))
5594     (setq anything-c-zgrep-recurse-flag nil)))
5595
5596 (defun anything-c-grep-split-line (line)
5597   "Split a grep output line."
5598   (let (beg fname lineno str)
5599     ;; Don't print until grep line is valid.
5600     (when (string-match "\\(.*\\)\\(:[0-9]+:\\)\\(.*\\)" line)
5601       (with-temp-buffer
5602         (insert line)
5603         (goto-char (point-min))
5604         (setq beg (point))
5605         (forward-char 2)
5606         (re-search-forward ":" nil t)
5607         (setq fname (buffer-substring-no-properties beg (1- (point))))
5608         (setq beg (point))
5609         (re-search-forward ":" nil t)
5610         (setq lineno (buffer-substring-no-properties beg (1- (point))))
5611         (setq str (buffer-substring-no-properties (point) (point-at-eol))))
5612       (list fname lineno str))))
5613
5614 (defun anything-c-grep-cand-transformer (candidates sources)
5615   "Filtered candidate transformer function for `anything-do-grep'."
5616   (loop for i in candidates
5617         for split  = (and i (anything-c-grep-split-line i))
5618         for fname  = (car split)
5619         for lineno = (nth 1 split)
5620         for str    = (nth 2 split)
5621         when (and fname lineno str)
5622         collect
5623         (cons (concat (propertize (file-name-nondirectory fname)
5624                                   'face 'anything-grep-file
5625                                   'help-echo fname) ":"
5626                                   (propertize lineno 'face 'anything-grep-lineno) ":"
5627                                   (anything-c-grep-highlight-match str))
5628               i)))
5629
5630 (defun anything-c-grep-highlight-match (str)
5631   "Highlight in string STR all occurences matching `anything-pattern'."
5632   (condition-case nil
5633       (with-temp-buffer
5634         (insert str)
5635         (goto-char (point-min))
5636         (while (and (re-search-forward anything-pattern nil t)
5637                     (> (- (match-end 0) (match-beginning 0)) 0))
5638           (add-text-properties
5639            (match-beginning 0) (match-end 0)
5640            '(face anything-grep-match)))
5641         (buffer-string))
5642     (error nil)))
5643
5644 ;; Go to next or precedent file (common to etags and grep).
5645 (defun anything-c-goto-next-or-prec-file (n)
5646   "Go to next or precedent candidate file in anything grep/etags buffers.
5647 If N is positive go forward otherwise go backward."
5648   (with-anything-window
5649     (let* ((current-line-list  (split-string
5650                                 (buffer-substring
5651                                  (point-at-bol)
5652                                  (point-at-eol)) ":"))
5653            (current-fname      (nth 0 current-line-list))
5654            (fn-b-o-f           (if (eq n 1) 'eobp 'bobp)))
5655       (catch 'break
5656         (while (not (funcall fn-b-o-f))
5657           (forward-line n) ; Go forward or backward depending of n value.
5658           (unless (search-forward current-fname (point-at-eol) t)
5659             (anything-mark-current-line)
5660             (throw 'break nil))))
5661       (cond ((and (eq n 1) (eobp))
5662              (re-search-backward ".")
5663              (forward-line 0)
5664              (anything-mark-current-line))
5665             ((and (< n 1) (bobp))
5666              (forward-line 1)
5667              (anything-mark-current-line))))))
5668
5669 ;;;###autoload
5670 (defun anything-c-goto-precedent-file ()
5671   "Go to precedent file in anything grep/etags buffers."
5672   (interactive)
5673   (anything-c-goto-next-or-prec-file -1))
5674
5675 ;;;###autoload
5676 (defun anything-c-goto-next-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-grep-run-persistent-action ()
5683   "Run grep persistent action from `anything-do-grep-1'."
5684   (interactive)
5685   (anything-attrset 'jump-persistent 'anything-c-grep-persistent-action)
5686   (anything-execute-persistent-action 'jump-persistent))
5687
5688 ;;;###autoload
5689 (defun anything-c-grep-run-default-action ()
5690   "Run grep default action from `anything-do-grep-1'."
5691   (interactive)
5692   (anything-c-quit-and-execute-action 'anything-c-grep-action))
5693
5694 ;;;###autoload
5695 (defun anything-c-grep-run-other-window-action ()
5696   "Run grep goto other window action from `anything-do-grep-1'."
5697   (interactive)
5698   (anything-c-quit-and-execute-action 'anything-c-grep-other-window))
5699
5700 ;;;###autoload
5701 (defun anything-c-grep-run-save-buffer ()
5702   "Run grep save results action from `anything-do-grep-1'."
5703   (interactive)
5704   (anything-c-quit-and-execute-action 'anything-c-grep-save-results))
5705
5706 ;; Grep buffers
5707 (defun anything-c-grep-buffers-1 (candidate &optional zgrep)
5708   "Run grep on all file--buffers or CANDIDATE if it is a file--buffer.
5709 If one of selected buffers is not a file--buffer,
5710 it is ignored and grep will run on all others file--buffers.
5711 If only one candidate is selected and it is not a file--buffer,
5712 switch to this buffer and run `anything-occur'.
5713 If a prefix arg is given run grep on all buffers ignoring non--file-buffers."
5714   (let* ((prefarg (or current-prefix-arg anything-current-prefix-arg))
5715          (cands (if prefarg
5716                     (buffer-list)
5717                     (anything-marked-candidates)))
5718          (win-conf (current-window-configuration))
5719          ;; Non--fname buffers are ignored.
5720          (bufs (loop for buf in cands
5721                      for fname = (buffer-file-name (get-buffer buf))
5722                      when fname
5723                      collect (expand-file-name fname))))
5724     (if bufs
5725         (if zgrep
5726             (anything-do-grep-1 bufs nil 'zgrep)
5727             (anything-do-grep-1 bufs))
5728         ;; bufs is empty, thats mean we have only CANDIDATE
5729         ;; and it is not a buffer-filename, fallback to occur.
5730         (anything-c-switch-to-buffer candidate)
5731         (when (get-buffer anything-action-buffer)
5732           (kill-buffer anything-action-buffer))
5733         (anything-occur)
5734         (when (eq anything-exit-status 1)
5735           (set-window-configuration win-conf)))))
5736
5737 (defun anything-c-grep-buffers (candidate)
5738   "Action to grep buffers."
5739   (anything-c-grep-buffers-1 candidate))
5740
5741 (defun anything-c-zgrep-buffers (candidate)
5742   "Action to zgrep buffers."
5743   (anything-c-grep-buffers-1 candidate 'zgrep))
5744
5745 \f
5746 ;;; Anything interface for pdfgrep
5747 ;;  pdfgrep program <http://pdfgrep.sourceforge.net/>
5748 ;;  and a pdf-reader (e.g xpdf) are needed.
5749 ;;
5750 (defvar anything-c-pdfgrep-default-command "pdfgrep --color never -niH %s %s")
5751 (defvar anything-c-pdfgrep-default-function 'anything-c-pdfgrep-init)
5752 (defvar anything-c-pdfgrep-debug-command-line nil)
5753
5754 (defun anything-c-pdfgrep-init (only-files)
5755   "Start an asynchronous pdfgrep process in ONLY-FILES list."
5756   (let* ((fnargs   (anything-c-grep-prepare-candidates
5757                     (if (file-remote-p anything-ff-default-directory)
5758                         (mapcar #'(lambda (x)
5759                                     (file-remote-p x 'localname))
5760                                 only-files)
5761                         only-files)))
5762          (cmd-line (format anything-c-pdfgrep-default-command
5763                            anything-pattern
5764                            fnargs)))
5765     (when anything-c-pdfgrep-debug-command-line
5766       (with-current-buffer (get-buffer-create "*any pdfgrep debug*")
5767         (goto-char (point-max))
5768         (insert (concat ">>> " cmd-line "\n\n"))))
5769     (setq mode-line-format
5770           '(" " mode-line-buffer-identification " "
5771             (line-number-mode "%l") " "
5772             (:eval (propertize "(Pdfgrep Process Running) "
5773                     'face '((:foreground "red"))))))
5774     (prog1
5775         (let ((default-directory anything-ff-default-directory))
5776           (start-file-process-shell-command "pdfgrep-process" nil cmd-line))
5777       (message nil)
5778       (set-process-sentinel
5779        (get-process "pdfgrep-process")
5780        #'(lambda (process event)
5781            (when (string= event "finished\n")
5782              (with-anything-window
5783                (anything-update-move-first-line))
5784              (force-mode-line-update nil)))))))
5785
5786
5787 (defun anything-do-pdfgrep-1 (only)
5788   "Launch pdfgrep with a list of ONLY files."
5789   (unless (executable-find "pdfgrep")
5790     (error "Error: No such program `pdfgrep'."))
5791   (let* ((anything-compile-source-functions
5792           ;; rule out anything-match-plugin because the input is one regexp.
5793           (delq 'anything-compile-source--match-plugin
5794                 (copy-sequence anything-compile-source-functions)))
5795          ;; Disable match-plugin and use here own highlighting.
5796          (anything-mp-highlight-delay nil))
5797     ;; When called as action from an other source e.g *-find-files
5798     ;; we have to kill action buffer.
5799     (when (get-buffer anything-action-buffer)
5800       (kill-buffer anything-action-buffer))
5801     ;; If `anything-find-files' haven't already started,
5802     ;; give a default value to `anything-ff-default-directory'.
5803     (setq anything-ff-default-directory (or anything-ff-default-directory
5804                                             default-directory))
5805     (anything
5806      :sources
5807      `(((name . "PdfGrep")
5808         (candidates
5809          . (lambda ()
5810              (funcall anything-c-pdfgrep-default-function only)))
5811         (filtered-candidate-transformer anything-c-grep-cand-transformer)
5812         (candidate-number-limit . 9999)
5813         (mode-line . anything-pdfgrep-mode-line-string)
5814         (action . anything-c-pdfgrep-action)
5815         (persistent-help . "Jump to PDF Page")
5816         (requires-pattern . 3)
5817         (delayed)))
5818      :keymap anything-c-pdfgrep-map
5819      :buffer "*anything grep*")))
5820
5821
5822 (defun anything-c-pdfgrep-action (candidate)
5823   (let* ((split  (anything-c-grep-split-line candidate))
5824          (pageno (nth 1 split))
5825          (fname  (car split)))
5826     (start-file-process-shell-command
5827      "pdf-reader" nil
5828      (format-spec anything-c-pdfgrep-default-read-command
5829                   (list (cons ?f fname) (cons ?p pageno))))))
5830
5831 \f
5832 ;; Yank text at point.
5833 ;;
5834 ;;
5835 ;; Internal
5836 (defvar anything-yank-point nil)
5837
5838 ;;;###autoload
5839 (defun anything-yank-text-at-point ()
5840   "Yank text at point in minibuffer."
5841   (interactive)
5842   (let (input)
5843     (flet ((insert-in-minibuffer (word)
5844              (with-selected-window (minibuffer-window)
5845                (let ((str anything-pattern))
5846                  (delete-minibuffer-contents)
5847                  (set-text-properties 0 (length word) nil word)
5848                  (insert (concat str word))))))
5849       (with-anything-current-buffer
5850         ;; Start to initial point if C-w have never been hit.
5851         (unless anything-yank-point (setq anything-yank-point (point)))
5852         (and anything-yank-point (goto-char anything-yank-point))
5853         (forward-word 1)
5854         (setq input (buffer-substring-no-properties anything-yank-point (point)))
5855         (setq anything-yank-point (point))) ; End of last forward-word
5856       (insert-in-minibuffer input))))
5857
5858 (defun anything-reset-yank-point ()
5859   (setq anything-yank-point nil))
5860
5861 (add-hook 'anything-after-persistent-action-hook 'anything-reset-yank-point)
5862 (add-hook 'anything-cleanup-hook 'anything-reset-yank-point)
5863
5864 \f
5865 ;;; Recentf files
5866 ;;
5867 ;;
5868 (defvar anything-c-source-recentf
5869   `((name . "Recentf")
5870     (init . (lambda ()
5871               (require 'recentf)
5872               (or recentf-mode (recentf-mode 1))))
5873     ;; Needed for filenames with capitals letters.
5874     (disable-shortcuts)
5875     (candidates . recentf-list)
5876     (keymap . ,anything-generic-files-map)
5877     (help-message . anything-generic-file-help-message)
5878     (mode-line . anything-generic-file-mode-line-string)
5879     (match anything-c-match-on-basename)
5880     (type . file))
5881   "See (info \"(emacs)File Conveniences\").
5882 Set `recentf-max-saved-items' to a bigger value if default is too small.")
5883
5884 ;;; ffap
5885 (eval-when-compile (require 'ffap))
5886 (defvar anything-c-source-ffap-guesser
5887   `((name . "File at point")
5888     (init . (lambda () (require 'ffap)))
5889     (candidates . (lambda ()
5890                     (anything-aif
5891                         (with-anything-current-buffer
5892                           (ffap-guesser))
5893                         (list it))))
5894     (keymap . ,anything-generic-files-map)
5895     (help-message . anything-generic-file-help-message)
5896     (mode-line . anything-generic-file-mode-line-string)
5897     (type . file)))
5898
5899 ;;; ffap with line number
5900 (defun anything-c-ffap-file-line-at-point ()
5901   "Get (FILENAME . LINENO) at point."
5902   (anything-aif (let (ffap-alist) (ffap-file-at-point))
5903       (save-excursion
5904         (beginning-of-line)
5905         (when (and (search-forward it nil t)
5906                    (looking-at ":\\([0-9]+\\)"))
5907           (cons it (string-to-number (match-string 1)))))))
5908
5909 (defun anything-c-ffap-line-candidates ()
5910   (with-anything-current-buffer
5911     (anything-attrset 'ffap-line-location (anything-c-ffap-file-line-at-point)))
5912   (anything-aif (anything-attr 'ffap-line-location)
5913     (destructuring-bind (file . line) it
5914       (list (cons (format "%s (line %d)" file line) file)))))
5915
5916 ;;; Goto line after opening file by `anything-c-source-ffap-line'.
5917 (defun anything-c-ffap-line-goto-line ()
5918   (when (car (anything-attr 'ffap-line-location))
5919     (unwind-protect
5920         (ignore-errors
5921           (with-selected-window
5922               (get-buffer-window
5923                (get-file-buffer (car (anything-attr 'ffap-line-location))))
5924             (anything-goto-line (cdr (anything-attr 'ffap-line-location)))))
5925       (anything-attrset 'ffap-line-location nil))))
5926 (add-hook 'anything-after-action-hook 'anything-c-ffap-line-goto-line)
5927 (add-hook 'anything-after-persistent-action-hook 'anything-c-ffap-line-goto-line)
5928
5929 (defvar anything-c-source-ffap-line
5930   `((name . "File/Lineno at point")
5931     (init . (lambda () (require 'ffap)))
5932     (candidates . anything-c-ffap-line-candidates)
5933     (keymap . ,anything-map)
5934     (type . file)))
5935
5936 ;;; list of files gleaned from every dired buffer
5937 (defun anything-c-files-in-all-dired-candidates ()
5938   (save-excursion
5939     (mapcan
5940      (lambda (dir)
5941        (cond ((listp dir)               ;filelist
5942               dir)
5943              ((equal "" (file-name-nondirectory dir)) ;dir
5944               (directory-files dir t))
5945              (t                         ;wildcard
5946               (file-expand-wildcards dir t))))
5947      (delq nil
5948            (mapcar (lambda (buf)
5949                      (set-buffer buf)
5950                      (when (eq major-mode 'dired-mode)
5951                        (if (consp dired-directory)
5952                            (cdr dired-directory) ;filelist
5953                            dired-directory))) ;dir or wildcard
5954                    (buffer-list))))))
5955 ;; (dired '("~/" "~/.emacs-custom.el" "~/.emacs.bmk"))
5956
5957 (defvar anything-c-source-files-in-all-dired
5958   '((name . "Files in all dired buffer.")
5959     (candidates . anything-c-files-in-all-dired-candidates)
5960     (type . file)))
5961
5962 (defvar anything-c-source-filelist
5963   '((name . "FileList")
5964     (grep-candidates . anything-c-filelist-file-name)
5965     (candidate-number-limit . 200)
5966     (requires-pattern . 4)
5967     (type . file))
5968   "Source to find files instantly.
5969 See `anything-c-filelist-file-name' docstring for usage.")
5970
5971 \f
5972 ;;;; <info>
5973 ;;; Info pages
5974 (defvar anything-c-info-pages nil
5975   "All info pages on system.
5976 Will be calculated the first time you invoke anything with this
5977 source.")
5978
5979 (defun anything-c-info-pages-init ()
5980   "Collect candidates for initial Info node Top."
5981   (if anything-c-info-pages
5982       anything-c-info-pages
5983       (let ((info-topic-regexp "\\* +\\([^:]+: ([^)]+)[^.]*\\)\\.")
5984             topics)
5985         (require 'info)
5986         (with-temp-buffer
5987           (Info-find-node "dir" "top")
5988           (goto-char (point-min))
5989           (while (re-search-forward info-topic-regexp nil t)
5990             (push (match-string-no-properties 1) topics))
5991           (kill-buffer))
5992         (setq anything-c-info-pages topics))))
5993
5994 (defvar anything-c-source-info-pages
5995   `((name . "Info Pages")
5996     (init . anything-c-info-pages-init)
5997     (candidates . anything-c-info-pages)
5998     (action . (("Show with Info" .(lambda (node-str)
5999                                     (info (replace-regexp-in-string
6000                                            "^[^:]+: " "" node-str))))))
6001     (requires-pattern . 2)))
6002
6003 \f
6004 ;;; Man and woman UI
6005 ;;
6006 ;;
6007 (defvar anything-c-man-pages nil
6008   "All man pages on system.
6009 Will be calculated the first time you invoke anything with this
6010 source.")
6011
6012 (defun anything-c-man-default-action (candidate)
6013   "Default action for jumping to a woman or man page from anything."
6014   (let ((wfiles (woman-file-name-all-completions candidate)))
6015     (condition-case err
6016         (if (> (length wfiles) 1)
6017             (woman-find-file
6018              (anything-comp-read
6019               "ManFile: " wfiles :must-match t))
6020             (woman candidate))
6021       ;; If woman is unable to format correctly
6022       ;; use man instead.
6023       (error (kill-buffer) ; Kill woman buffer.
6024              (let ((Man-notify-method 'meek))
6025                (Man-getpage-in-background candidate))))))
6026
6027 (defvar anything-c-source-man-pages
6028   `((name . "Manual Pages")
6029     (candidates . (lambda ()
6030                     (if anything-c-man-pages
6031                         anything-c-man-pages
6032                         ;; XEmacs doesn't have a woman :)
6033                         (setq anything-c-man-pages
6034                               (ignore-errors
6035                                 (require 'woman)
6036                                 (woman-file-name "")
6037                                 (sort (mapcar 'car woman-topic-all-completions)
6038                                       'string-lessp))))))
6039     (action  ("Show with Woman" . anything-c-man-default-action))
6040     ;; Woman does not work OS X
6041     ;; http://xahlee.org/emacs/modernization_man_page.html
6042     (action-transformer . (lambda (actions candidate)
6043                             (if (eq system-type 'darwin)
6044                                 '(("Show with Man" . man))
6045                                 actions)))
6046     (requires-pattern . 2)))
6047
6048 \f
6049 ;;;; <Command>
6050 ;;; Anything M-x - Enhanced M-x UI
6051 ;;
6052 ;;
6053 ;; Another replacement of `M-x' that act exactly like the
6054 ;; vanilla Emacs one, no problem of windows configuration, prefix args
6055 ;; can be passed before calling `M-x' (e.g C-u M-x..) but also during
6056 ;; anything invocation.
6057 ;; Documentation of commands available without quitting,
6058 ;; Show keybindings of commands.
6059 ;; Show history.
6060 (defvar anything-M-x-input-history nil)
6061
6062 (defun* anything-M-x-get-major-mode-command-alist (mode-map)
6063   "Return alist of MODE-MAP."
6064   (loop for key being the key-seqs of mode-map using (key-bindings com)
6065         for str-key  = (key-description key)
6066         for ismenu   = (string-match "<menu-bar>" str-key)
6067         unless ismenu collect (cons str-key com)))
6068
6069 (defun anything-get-mode-map-from-mode (mode)
6070   "Guess the mode-map name according to MODE.
6071 Some modes don't use conventional mode-map name
6072 so we need to guess mode-map name. e.g python-mode ==> py-mode-map.
6073 Return nil if no mode-map found."
6074   (loop
6075         ;; Start with a conventional mode-map name.
6076         with mode-map    = (intern-soft (format "%s-map" mode))
6077         with mode-string = (symbol-name mode)
6078         with mode-name   = (replace-regexp-in-string "-mode" "" mode-string)
6079         while (not mode-map)
6080         for count downfrom (length mode-name)
6081         ;; Return when no result after parsing entire string.
6082         when (eq count 0) return nil
6083         for sub-name = (substring mode-name 0 count)
6084         do (setq mode-map (intern-soft (format "%s-map" (concat sub-name "-mode"))))
6085         finally return mode-map))
6086
6087 (defun anything-M-x-current-mode-map-alist ()
6088   "Return mode-map alist of current `major-mode'."
6089   (let ((map (anything-get-mode-map-from-mode major-mode)))
6090     (when (and map (boundp map))
6091       (anything-M-x-get-major-mode-command-alist (symbol-value map)))))
6092
6093
6094 (defun anything-M-x-transformer (candidates sources)
6095   "filtered-candidate-transformer to show bindings in emacs commands.
6096 Show global bindings and local bindings according to current `major-mode'."
6097   (with-anything-current-buffer
6098     (loop with local-map = (anything-M-x-current-mode-map-alist)
6099           for cand in candidates
6100           for local-key  = (car (rassq cand local-map))
6101           for key        = (substitute-command-keys (format "\\[%s]" cand))
6102           collect
6103           (cons (cond ((and (string-match "^M-x" key) local-key)
6104                        (format "%s (%s)"
6105                                cand (propertize
6106                                      local-key
6107                                      'face 'anything-M-x-key-face)))
6108                       ((string-match "^M-x" key) cand)
6109                       (t (format "%s (%s)"
6110                                  cand (propertize
6111                                        key
6112                                        'face 'anything-M-x-key-face))))
6113                 cand) into ls
6114           finally return
6115           (sort ls #'(lambda (x y) (string-lessp (car x) (car y)))))))
6116
6117 \f
6118 ;;; Complex command history
6119 ;;
6120 ;;
6121 (defvar anything-c-source-complex-command-history
6122   '((name . "Complex Command History")
6123     (candidates . (lambda () (mapcar 'prin1-to-string command-history)))
6124     (type . sexp)))
6125
6126 ;;; M-x history (not related to `anything-M-x')
6127 ;;
6128 ;;
6129 (defvar anything-c-source-extended-command-history
6130   '((name . "Emacs Commands History")
6131     (candidates
6132      . (lambda ()
6133          (anything-fast-remove-dups extended-command-history :test 'equal)))
6134     (type . command)))
6135
6136 ;;; Emacs commands (Basic source for emacs commands)
6137 ;;
6138 ;;
6139 (defvar anything-c-source-emacs-commands
6140   '((name . "Emacs Commands")
6141     (candidates . (lambda ()
6142                     (let (commands)
6143                       (mapatoms (lambda (a)
6144                                   (if (commandp a)
6145                                       (push (symbol-name a)
6146                                             commands))))
6147                       (sort commands 'string-lessp))))
6148     (type . command)
6149     (requires-pattern . 2))
6150   "Source for completing and invoking Emacs commands.
6151 A command is a function with interactive spec that can
6152 be invoked with `M-x'.
6153
6154 To get non-interactive functions listed, use
6155 `anything-c-source-emacs-functions'.")
6156
6157 \f
6158 ;;;; <Function>
6159 ;;; Emacs functions
6160 ;;
6161 ;;
6162 (defvar anything-c-source-emacs-functions
6163   '((name . "Emacs Functions")
6164     (candidates . (lambda ()
6165                     (let (commands)
6166                       (mapatoms (lambda (a)
6167                                   (if (functionp a)
6168                                       (push (symbol-name a) commands))))
6169                       (sort commands 'string-lessp))))
6170     (type . function)
6171     (requires-pattern . 2))
6172   "Source for completing Emacs functions.")
6173
6174 ;;; With abbrev expansion
6175 ;;; Similar to my exec-abbrev-cmd.el
6176 ;;; See http://www.tsdh.de/cgi-bin/wiki.pl/exec-abbrev-cmd.el
6177 (defvar anything-c-function-abbrev-regexp nil
6178   "The regexp for `anything-c-source-emacs-functions-with-abbrevs'.
6179 Regexp built from the current `anything-pattern' interpreting it
6180 as abbreviation.
6181 Only for internal use.")
6182
6183 (defun anything-c-match-function-by-abbrev (candidate)
6184   "Return non-nil if `anything-pattern' is an abbreviation of the function CANDIDATE.
6185
6186 Abbreviations are made by taking the first character from each
6187 word in the function's name, e.g. \"bb\" is an abbrev for
6188 `bury-buffer', \"stb\" is an abbrev for `anything-c-switch-to-buffer'."
6189   (string-match anything-c-function-abbrev-regexp candidate))
6190
6191 (defvar anything-c-source-emacs-functions-with-abbrevs
6192   (append anything-c-source-emacs-functions
6193           '((match anything-c-match-function-by-abbrev
6194              anything-c-string-match))
6195           '((init
6196              . (lambda ()
6197                  (defadvice anything-update
6198                      (before anything-c-update-function-abbrev-regexp activate)
6199                    (let ((char-list (append anything-pattern nil))
6200                          (str "^"))
6201                      (dolist (c char-list)
6202                        (setq str (concat str (list c) "[^-]*-")))
6203                      (setq str (concat (substring str 0 (1- (length str))) "$"))
6204                      (setq anything-c-function-abbrev-regexp str))))))))
6205
6206 (defvar anything-c-source-advice
6207   '((name . "Function Advice")
6208     (candidates . anything-c-advice-candidates)
6209     (action ("Toggle Enable/Disable" . anything-c-advice-toggle))
6210     (persistent-action . anything-c-advice-persistent-action)
6211     (multiline)
6212     (persistent-help . "Describe function / C-u C-z: Toggle advice")))
6213 ;; (let ((debug-on-signal t))(anything 'anything-c-source-advice))
6214 ;; (testadvice)
6215
6216 (defun anything-c-advice-candidates ()
6217   (require 'advice)
6218   (loop for (fname) in ad-advised-functions
6219         for function = (intern fname)
6220         append
6221         (loop for class in ad-advice-classes append
6222               (loop for advice in (ad-get-advice-info-field function class)
6223                     for enabled = (ad-advice-enabled advice)
6224                     collect
6225                     (cons (format
6226                            "%s %s %s"
6227                            (if enabled "Enabled " "Disabled")
6228                            (propertize fname 'face 'font-lock-function-name-face)
6229                            (ad-make-single-advice-docstring advice class nil))
6230                           (list function class advice))))))
6231
6232 (defun anything-c-advice-persistent-action (func-class-advice)
6233   (if current-prefix-arg
6234       (anything-c-advice-toggle func-class-advice)
6235       (describe-function (car func-class-advice))))
6236
6237 (defun anything-c-advice-toggle (func-class-advice)
6238   (destructuring-bind (function class advice) func-class-advice
6239     (cond ((ad-advice-enabled advice)
6240            (ad-advice-set-enabled advice nil)
6241            (message "Disabled"))
6242           (t                            ;disabled
6243            (ad-advice-set-enabled advice t)
6244            (message "Enabled")))
6245     (ad-activate function)
6246     (and anything-in-persistent-action
6247          (anything-c-advice-update-current-display-string))))
6248
6249 (defun anything-c-advice-update-current-display-string ()
6250   (anything-edit-current-selection
6251     (let ((newword (cond ((looking-at "Disabled") "Enabled")
6252                          ((looking-at "Enabled")  "Disabled")))
6253           realvalue)
6254       (when newword
6255         (delete-region (point) (progn (forward-word 1) (point)))
6256         (insert newword)))))
6257
6258 \f
6259 ;;;; <Variable>
6260 ;;; Emacs variables
6261 ;;
6262 ;;
6263 (defvar anything-c-source-emacs-variables
6264   '((name . "Emacs Variables")
6265     (candidates . (lambda ()
6266                     (sort (all-completions "" obarray 'boundp) 'string-lessp)))
6267     (type . variable)
6268     (requires-pattern . 2))
6269   "Source for completing Emacs variables.")
6270
6271 \f
6272 ;;; LaCarte
6273 (defvar anything-c-source-lacarte
6274   '((name . "Lacarte")
6275     (init . (lambda () (require 'lacarte )))
6276     (candidates . (lambda () (delete '(nil) (lacarte-get-overall-menu-item-alist))))
6277     (candidate-number-limit . 9999)
6278     (action . anything-c-call-interactively))
6279   "Needs lacarte.el.
6280
6281 http://www.emacswiki.org/cgi-bin/wiki/download/lacarte.el")
6282
6283 \f
6284 ;;; Bookmarks
6285 ;;
6286 ;;
6287 ;; Bind some faces for bookmarks.
6288 (defvar anything-c-bookmarks-face1 'anything-ff-directory)
6289 (defvar anything-c-bookmarks-face2 'anything-ff-file)
6290 (defvar anything-c-bookmarks-face3 'anything-bookmarks-su-face)
6291
6292 (eval-when-compile (require 'bookmark))
6293 (defvar anything-c-source-bookmarks
6294   `((name . "Bookmarks")
6295     (init . (lambda ()
6296               (require 'bookmark)))
6297     (candidates . bookmark-all-names)
6298     (type . bookmark))
6299   "See (info \"(emacs)Bookmarks\").")
6300
6301 ;;; bookmark-set
6302 (defvar anything-c-source-bookmark-set
6303   '((name . "Set Bookmark")
6304     (dummy)
6305     (action . bookmark-set))
6306   "See (info \"(emacs)Bookmarks\").")
6307
6308 ;;; Visible Bookmarks
6309 ;; (install-elisp "http://cvs.savannah.gnu.org/viewvc/*checkout*/bm/bm/bm.el")
6310
6311
6312 ;; http://d.hatena.ne.jp/grandVin/20080911/1221114327
6313 (defvar anything-c-source-bm
6314   '((name . "Visible Bookmarks")
6315     (init . anything-c-bm-init)
6316     (candidates-in-buffer)
6317     (type . line))
6318   "Needs bm.el.
6319
6320 http://www.nongnu.org/bm/")
6321
6322 (defun anything-c-bm-init ()
6323   "Init function for `anything-c-source-bm'."
6324   (when (require 'bm nil t)
6325     (with-no-warnings
6326       (let ((bookmarks (bm-lists))
6327             (buf (anything-candidate-buffer 'global)))
6328         (dolist (bm (sort* (append (car bookmarks) (cdr bookmarks))
6329                            '< :key 'overlay-start))
6330           (let ((start (overlay-start bm))
6331                 (end (overlay-end bm))
6332                 (annotation (or (overlay-get bm 'annotation) "")))
6333             (unless (< (- end start) 1) ; org => (if (< (- end start) 2)
6334               (let ((str (format "%5d: [%s]: %s\n"
6335                                  (line-number-at-pos start)
6336                                  annotation
6337                                  (buffer-substring start (1- end)))))
6338                 (with-current-buffer buf (insert str))))))))))
6339
6340 ;;; Special bookmarks
6341 (defvar anything-c-source-bookmarks-ssh
6342   '((name . "Bookmarks-ssh")
6343     (init . (lambda ()
6344               (require 'bookmark)))
6345     (candidates . (lambda () (anything-c-collect-bookmarks :ssh t)))
6346     (type . bookmark))
6347   "See (info \"(emacs)Bookmarks\").")
6348
6349 (defvar anything-c-source-bookmarks-su
6350   '((name . "Bookmarks-root")
6351     (init . (lambda ()
6352               (require 'bookmark)))
6353     (candidates . (lambda () (anything-c-collect-bookmarks :su t)))
6354     (filtered-candidate-transformer anything-c-highlight-bookmark-su)
6355
6356     (type . bookmark))
6357   "See (info \"(emacs)Bookmarks\").")
6358
6359 (defvar anything-c-source-bookmarks-local
6360   '((name . "Bookmarks-Local")
6361     (init . (lambda ()
6362               (require 'bookmark)))
6363     (candidates . (lambda () (anything-c-collect-bookmarks :local t)))
6364     (filtered-candidate-transformer
6365      anything-c-adaptive-sort
6366      anything-c-highlight-bookmark)
6367     (type . bookmark))
6368   "See (info \"(emacs)Bookmarks\").")
6369
6370 (defun* anything-c-collect-bookmarks (&key local su sudo ssh)
6371   (let* ((lis-all (bookmark-all-names))
6372          (lis-loc (cond (local (loop for i in lis-all
6373                                      unless (string-match "^(ssh)\\|^(su)" i)
6374                                      collect i))
6375                         (su (loop for i in lis-all
6376                                   when (string-match "^(su)" i)
6377                                   collect i))
6378                         (sudo (loop for i in lis-all
6379                                     when (string-match "^(sudo)" i)
6380                                     collect i))
6381                         (ssh (loop for i in lis-all
6382                                    when (string-match "^(ssh)" i)
6383                                    collect i)))))
6384     (sort lis-loc 'string-lessp)))
6385
6386 (defun anything-c-bookmark-root-logged-p ()
6387   (catch 'break
6388     (dolist (i (mapcar #'buffer-name (buffer-list)))
6389       (when (string-match (format "*tramp/%s ." anything-su-or-sudo) i)
6390         (throw 'break t)))))
6391
6392 (defun anything-c-highlight-bookmark-su (files source)
6393   (if (anything-c-bookmark-root-logged-p)
6394       (anything-c-highlight-bookmark files source)
6395       (anything-c-highlight-not-logged files source)))
6396
6397 (defun anything-c-highlight-not-logged (files source)
6398   (loop for i in files
6399         collect (propertize i 'face anything-c-bookmarks-face3)))
6400
6401 (defun anything-c-highlight-bookmark (bookmarks source)
6402   "Used as `candidate-transformer' to colorize bookmarks.
6403 Work both with standard Emacs bookmarks and bookmark-extensions.el."
6404   (loop for i in bookmarks
6405         for isfile        = (bookmark-get-filename i)
6406         for bufp          = (and (fboundp 'bmkext-get-buffer-name)
6407                                  (bmkext-get-buffer-name i))
6408         for handlerp      = (and (fboundp 'bookmark-get-handler)
6409                                  (bookmark-get-handler i))
6410         for isw3m         = (and (fboundp 'bmkext-w3m-bookmark-p)
6411                                  (bmkext-w3m-bookmark-p i))
6412         for isgnus        = (and (fboundp 'bmkext-gnus-bookmark-p)
6413                                  (bmkext-gnus-bookmark-p i))
6414         for isman         = (and (fboundp 'bmkext-man-bookmark-p) ; Man
6415                                  (bmkext-man-bookmark-p i))
6416         for iswoman       = (and (fboundp 'bmkext-woman-bookmark-p) ; Woman
6417                                  (bmkext-woman-bookmark-p i))
6418         for handlerp      = (bookmark-get-handler i)
6419         for isannotation  = (bookmark-get-annotation i)
6420         for isabook       = (string= (bookmark-prop-get i 'type) "addressbook")
6421         for isinfo        = (eq handlerp 'Info-bookmark-jump)
6422         ;; Add a * if bookmark have annotation
6423         if (and isannotation (not (string-equal isannotation "")))
6424         do (setq i (concat "*" i))
6425         collect (cond (;; info buffers
6426                        isinfo
6427                        (propertize i 'face 'anything-bmkext-info 'help-echo isfile))
6428                       (;; w3m buffers
6429                        isw3m
6430                        (propertize i 'face 'anything-bmkext-w3m 'help-echo isfile))
6431                       (;; gnus buffers
6432                        isgnus
6433                        (propertize i 'face 'anything-bmkext-gnus 'help-echo isfile))
6434                       (;; Man Woman
6435                        (or iswoman isman)
6436                        (propertize i 'face 'anything-bmkext-man 'help-echo isfile))
6437                       (;; Addressbook
6438                        isabook
6439                        (propertize i 'face '((:foreground "Tomato"))))
6440                       (;; directories
6441                        (and isfile (file-directory-p isfile))
6442                        (propertize i 'face anything-c-bookmarks-face1 'help-echo isfile))
6443                       (;; regular files
6444                        t
6445                        (propertize i 'face 'anything-bmkext-file 'help-echo isfile)))))
6446
6447 (defun anything-c-bookmark-jump (candidate)
6448   "Jump to bookmark from keyboard."
6449   (let ((current-prefix-arg anything-current-prefix-arg))
6450     (bookmark-jump candidate)))
6451
6452 ;;;###autoload
6453 (defun anything-c-bookmark-run-jump-other-window ()
6454   "Jump to bookmark from keyboard."
6455   (interactive)
6456   (anything-c-quit-and-execute-action 'bookmark-jump-other-window))
6457
6458 ;;;###autoload
6459 (defun anything-c-bookmark-run-delete ()
6460   "Delete bookmark from keyboard."
6461   (interactive)
6462   (when (y-or-n-p "Delete bookmark?")
6463     (anything-c-quit-and-execute-action 'anything-delete-marked-bookmarks)))
6464
6465 \f
6466 ;;; Sources to filter bookmark-extensions bookmarks.
6467 ;;
6468 ;;
6469 ;; Dependency: http://mercurial.intuxication.org/hg/emacs-bookmark-extension
6470 ;; If you want to enable google-maps in addressbook you will need
6471 ;; Julien Danjou google-maps-el package available here:
6472 ;; http://julien.danjou.info/google-maps-el.html
6473
6474 (defun anything-c-bmkext-filter-setup-alist (fn &rest args)
6475   "Return a filtered `bookmark-alist' sorted alphabetically."
6476   (loop
6477         with alist = (if args
6478                          (apply #'(lambda (x) (funcall fn x)) args)
6479                          (funcall fn))
6480         for i in alist
6481         for b = (car i)
6482         collect b into sa
6483         finally return (sort sa 'string-lessp)))
6484
6485 ;;;###autoload
6486 (defun anything-c-bmkext-run-edit ()
6487   "Run `bmkext-edit-bookmark' from keyboard."
6488   (interactive)
6489   (anything-c-quit-and-execute-action 'bmkext-edit-bookmark))
6490
6491 ;;; Addressbook.
6492 ;;
6493 ;;
6494 (defvar anything-c-source-bmkext-addressbook
6495   '((name . "Bookmark Addressbook")
6496     (init . (lambda ()
6497               (require 'bookmark-extensions)
6498               (bookmark-maybe-load-default-file)))
6499     (candidates . anything-c-bmkext-addressbook-setup-alist)
6500     (persistent-action
6501      . (lambda (candidate)
6502          (let ((bmk (anything-bookmark-get-bookmark-from-name
6503                      candidate)))
6504            (bookmark--jump-via bmk 'pop-to-buffer))))
6505     (persistent-help . "Show contact - Prefix with C-u to append")
6506     (filtered-candidate-transformer
6507      anything-c-adaptive-sort
6508      anything-c-highlight-bookmark)
6509     (action . (("Show Contact(s)"
6510                 . (lambda (candidate)
6511                     (let* ((contacts (anything-marked-candidates))
6512                            (current-prefix-arg (or anything-current-prefix-arg
6513                                                    (> (length contacts) 1))))
6514                       (bookmark-jump
6515                        (anything-bookmark-get-bookmark-from-name (car contacts)))
6516                       (anything-aif (cdr contacts)
6517                           (loop for bmk in it do
6518                                 (bookmark-jump
6519                                  (anything-bookmark-get-bookmark-from-name bmk)))))))
6520                ("Send Mail"
6521                 . (lambda (candidate)
6522                     (let* ((contacts (anything-marked-candidates))
6523                            (bmk      (anything-bookmark-get-bookmark-from-name
6524                                       (car contacts)))
6525                            (append   (message-buffers)))
6526                       (if append
6527                           (addressbook-set-mail-buffer1 bmk 'append)
6528                           (addressbook-set-mail-buffer1 bmk))
6529                       (setq contacts (cdr contacts))
6530                       (when contacts
6531                         (loop for bmk in contacts do
6532                               (addressbook-set-mail-buffer1 bmk 'append))))))
6533                ("Edit Bookmark"
6534                 . (lambda (candidate)
6535                     (let ((bmk (anything-bookmark-get-bookmark-from-name
6536                                 candidate)))
6537                       (addressbook-bookmark-edit
6538                        (assoc bmk bookmark-alist)))))
6539                ("Insert Email at point"
6540                 . (lambda (candidate)
6541                     (let* ((bmk   (anything-bookmark-get-bookmark-from-name
6542                                    candidate))
6543                            (mlist (split-string
6544                                    (assoc-default
6545                                     'email (assoc bmk bookmark-alist))
6546                                    ", ")))
6547                       (insert
6548                        (if (> (length mlist) 1)
6549                            (anything-comp-read
6550                             "Insert Mail Address: " mlist :must-match t)
6551                            (car mlist))))))
6552                ("Show annotation"
6553                 . (lambda (candidate)
6554                     (let ((bmk (anything-bookmark-get-bookmark-from-name
6555                                 candidate)))
6556                       (bookmark-show-annotation bmk))))
6557                ("Edit annotation"
6558                 . (lambda (candidate)
6559                     (let ((bmk (anything-bookmark-get-bookmark-from-name
6560                                 candidate)))
6561                       (bookmark-edit-annotation bmk))))
6562                ("Show Google map"
6563                 . (lambda (candidate)
6564                     (let* ((bmk (anything-bookmark-get-bookmark-from-name
6565                                  candidate))
6566                            (full-bmk (assoc bmk bookmark-alist)))
6567                       (addressbook-google-map full-bmk))))))))
6568
6569
6570 (defun anything-c-bmkext-addressbook-setup-alist ()
6571   "Specialized filter function for bookmarks w3m."
6572   (anything-c-bmkext-filter-setup-alist 'bmkext-addressbook-alist-only))
6573
6574 ;; W3m bookmarks from bookmark-extensions.
6575 (defvar anything-c-source-bookmark-w3m
6576   '((name . "Bookmark W3m")
6577     (init . (lambda ()
6578               (require 'bookmark-extensions)
6579               (bookmark-maybe-load-default-file)))
6580     (candidates . anything-c-bookmark-w3m-setup-alist)
6581     (filtered-candidate-transformer
6582      anything-c-adaptive-sort
6583      anything-c-highlight-bookmark)
6584     (type . bookmark)))
6585
6586 (defun anything-c-bookmark-w3m-setup-alist ()
6587   "Specialized filter function for bookmarks w3m."
6588   (anything-c-bmkext-filter-setup-alist 'bmkext-w3m-alist-only))
6589
6590 ;; Images
6591 (defvar anything-c-source-bookmark-images
6592   '((name . "Bookmark Images")
6593     (init . (lambda ()
6594               (require 'bookmark-extensions)
6595               (bookmark-maybe-load-default-file)))
6596     (candidates . anything-c-bookmark-images-setup-alist)
6597     (filtered-candidate-transformer
6598      anything-c-adaptive-sort
6599      anything-c-highlight-bookmark)
6600     (type . bookmark)))
6601
6602 (defun anything-c-bookmark-images-setup-alist ()
6603   "Specialized filter function for images bookmarks."
6604   (anything-c-bmkext-filter-setup-alist 'bmkext-image-file-alist-only))
6605
6606 ;; Woman Man
6607 (defvar anything-c-source-bookmark-man
6608   '((name . "Bookmark Woman&Man")
6609     (init . (lambda ()
6610               (require 'bookmark-extensions)
6611               (bookmark-maybe-load-default-file)))
6612     (candidates . anything-c-bookmark-man-setup-alist)
6613     (filtered-candidate-transformer
6614      anything-c-adaptive-sort
6615      anything-c-highlight-bookmark)
6616     (type . bookmark)))
6617
6618 (defun anything-c-bookmark-man-setup-alist ()
6619   "Specialized filter function for bookmarks w3m."
6620   (append (anything-c-bmkext-filter-setup-alist 'bmkext-man-alist-only)
6621           (anything-c-bmkext-filter-setup-alist 'bmkext-woman-alist-only)))
6622
6623 ;; Gnus
6624 (defvar anything-c-source-bookmark-gnus
6625   '((name . "Bookmark Gnus")
6626     (init . (lambda ()
6627               (require 'bookmark-extensions)
6628               (bookmark-maybe-load-default-file)))
6629     (candidates . anything-c-bookmark-gnus-setup-alist)
6630     (filtered-candidate-transformer
6631      anything-c-adaptive-sort
6632      anything-c-highlight-bookmark)
6633     (type . bookmark)))
6634
6635 (defun anything-c-bookmark-gnus-setup-alist ()
6636   "Specialized filter function for bookmarks gnus."
6637   (anything-c-bmkext-filter-setup-alist 'bmkext-gnus-alist-only))
6638
6639 ;; Info
6640 (defvar anything-c-source-bookmark-info
6641   '((name . "Bookmark Info")
6642     (init . (lambda ()
6643               (require 'bookmark-extensions)
6644               (bookmark-maybe-load-default-file)))
6645     (candidates . anything-c-bookmark-info-setup-alist)
6646     (filtered-candidate-transformer
6647      anything-c-adaptive-sort
6648      anything-c-highlight-bookmark)
6649     (type . bookmark)))
6650
6651 (defun anything-c-bookmark-info-setup-alist ()
6652   "Specialized filter function for bookmarks info."
6653   (anything-c-bmkext-filter-setup-alist 'bmkext-info-alist-only))
6654
6655 ;; Local Files&directories
6656 (defvar anything-c-source-bookmark-files&dirs
6657   '((name . "Bookmark Files&Directories")
6658     (init . (lambda ()
6659               (require 'bookmark-extensions)
6660               (bookmark-maybe-load-default-file)))
6661     (candidates . anything-c-bookmark-local-files-setup-alist)
6662     (filtered-candidate-transformer
6663      anything-c-adaptive-sort
6664      anything-c-highlight-bookmark)
6665     (type . bookmark)))
6666
6667 (defun anything-c-bookmark-local-files-setup-alist ()
6668   "Specialized filter function for bookmarks locals files."
6669   (anything-c-bmkext-filter-setup-alist 'bmkext-local-file-alist-only))
6670
6671 ;; Su Files&directories
6672 (defvar anything-c-source-bookmark-su-files&dirs
6673   '((name . "Bookmark Root-Files&Directories")
6674     (init . (lambda ()
6675               (require 'bookmark-extensions)
6676               (bookmark-maybe-load-default-file)))
6677     (candidates . anything-c-bookmark-su-files-setup-alist)
6678     (filtered-candidate-transformer
6679      anything-c-adaptive-sort
6680      anything-c-highlight-bookmark-su)
6681     (type . bookmark)))
6682
6683 (defun anything-c-bookmark-su-files-setup-alist ()
6684   "Specialized filter function for bookmarks su/sudo files."
6685   (declare (special bmkext-su-or-sudo-regexp))
6686   (loop
6687         with l = (anything-c-bmkext-filter-setup-alist 'bmkext-remote-file-alist-only)
6688         for i in l
6689         for isfile = (bookmark-get-filename i)
6690         for istramp = (and isfile (boundp 'tramp-file-name-regexp)
6691                            (save-match-data
6692                              (string-match tramp-file-name-regexp isfile)))
6693         for issu = (and istramp
6694                         (string-match bmkext-su-or-sudo-regexp isfile))
6695         if issu
6696         collect i))
6697
6698 ;; Ssh Files&directories
6699 (defvar anything-c-source-bookmark-ssh-files&dirs
6700   '((name . "Bookmark Ssh-Files&Directories")
6701     (init . (lambda ()
6702               (require 'bookmark-extensions)
6703               (bookmark-maybe-load-default-file)))
6704     (candidates . anything-c-bookmark-ssh-files-setup-alist)
6705     (filtered-candidate-transformer . anything-c-adaptive-sort)
6706     (type . bookmark)))
6707
6708 (defun anything-c-bookmark-ssh-files-setup-alist ()
6709   "Specialized filter function for bookmarks ssh files."
6710   (loop
6711         with l = (anything-c-bmkext-filter-setup-alist 'bmkext-remote-file-alist-only)
6712         for i in l
6713         for isfile = (bookmark-get-filename i)
6714         for istramp = (and isfile (boundp 'tramp-file-name-regexp)
6715                            (save-match-data
6716                              (string-match tramp-file-name-regexp isfile)))
6717         for isssh = (and istramp
6718                          (string-match "/ssh:" isfile))
6719         if isssh
6720         collect i))
6721
6722
6723 \f
6724 ;;; Firefox bookmarks
6725 ;;
6726 ;;
6727 ;; You will have to set firefox to import bookmarks in his html file bookmarks.html.
6728 ;; (only for firefox versions >=3)
6729 ;; To achieve that, open about:config in firefox and double click on this line to enable value
6730 ;; to true:
6731 ;; user_pref("browser.bookmarks.autoExportHTML", false);
6732 ;; You should have now:
6733 ;; user_pref("browser.bookmarks.autoExportHTML", true);
6734 ;; NOTE: This is also working in the same way for mozilla aka seamonkey.
6735
6736 (defvar anything-firefox-bookmark-url-regexp "\\(https\\|http\\|ftp\\|about\\|file\\)://[^ \"]*")
6737 (defvar anything-firefox-bookmarks-regexp ">\\([^><]+.[^</a>]\\)")
6738
6739 (defun anything-get-firefox-user-init-dir ()
6740   "Guess the default Firefox user directory name."
6741   (let* ((moz-dir (concat (getenv "HOME") "/.mozilla/firefox/"))
6742          (moz-user-dir
6743           (with-current-buffer (find-file-noselect (concat moz-dir "profiles.ini"))
6744             (goto-char (point-min))
6745             (prog1
6746                 (when (search-forward "Path=" nil t)
6747                   (buffer-substring-no-properties (point) (point-at-eol)))
6748               (kill-buffer)))))
6749     (file-name-as-directory (concat moz-dir moz-user-dir))))
6750
6751 (defun anything-guess-firefox-bookmark-file ()
6752   "Return the path of the Firefox bookmarks file."
6753   (concat (anything-get-firefox-user-init-dir) "bookmarks.html"))
6754
6755 (defun anything-html-bookmarks-to-alist (file url-regexp bmk-regexp)
6756   "Parse html bookmark FILE and return an alist with (title . url) as elements."
6757   (let (bookmarks-alist url title)
6758     (with-temp-buffer
6759       (insert-file-contents file)
6760       (goto-char (point-min))
6761       (while (re-search-forward "href=\\|^ *<DT><A HREF=" nil t)
6762         (forward-line 0)
6763         (when (re-search-forward url-regexp nil t)
6764           (setq url (match-string 0)))
6765         (when (re-search-forward bmk-regexp nil t)
6766           (setq title (match-string 1)))
6767         (push (cons title url) bookmarks-alist)
6768         (forward-line)))
6769     (nreverse bookmarks-alist)))
6770
6771 (defvar anything-c-firefox-bookmarks-alist nil)
6772 (defvar anything-c-source-firefox-bookmarks
6773   '((name . "Firefox Bookmarks")
6774     (init . (lambda ()
6775               (setq anything-c-firefox-bookmarks-alist
6776                     (anything-html-bookmarks-to-alist
6777                      (anything-guess-firefox-bookmark-file)
6778                      anything-firefox-bookmark-url-regexp
6779                      anything-firefox-bookmarks-regexp))))
6780     (candidates . (lambda ()
6781                     (mapcar #'car anything-c-firefox-bookmarks-alist)))
6782     (filtered-candidate-transformer
6783      anything-c-adaptive-sort
6784      anything-c-highlight-firefox-bookmarks)
6785     (action . (("Browse Url"
6786                 . (lambda (candidate)
6787                     (anything-c-browse-url
6788                      (anything-c-firefox-bookmarks-get-value candidate))))
6789                ("Copy Url"
6790                 . (lambda (elm)
6791                     (kill-new (anything-c-w3m-bookmarks-get-value elm))))))))
6792
6793
6794 (defun anything-c-firefox-bookmarks-get-value (elm)
6795   (assoc-default elm anything-c-firefox-bookmarks-alist))
6796
6797 (defun anything-c-highlight-firefox-bookmarks (bookmarks source)
6798   (loop for i in bookmarks
6799         collect (propertize
6800                  i 'face '((:foreground "YellowGreen"))
6801                  'help-echo (anything-c-firefox-bookmarks-get-value i))))
6802
6803
6804 \f
6805 ;;; W3m bookmark - anything interface.
6806 ;;
6807 ;;
6808 ;; Some users have the emacs-w3m library in load-path
6809 ;; without having the w3m executable :-;
6810 ;; So check if w3m program is present before trying to load
6811 ;; emacs-w3m.
6812 (eval-when-compile
6813   (when (executable-find "w3m")
6814     (require 'w3m-bookmark nil t)))
6815
6816 (defvar w3m-bookmark-file "~/.w3m/bookmark.html")
6817 (defvar anything-w3m-bookmarks-regexp ">\\([^><]+.[^</a>]\\)")
6818 (defvar anything-w3m-bookmark-url-regexp "\\(https\\|http\\|ftp\\|file\\)://[^>]*")
6819 (defvar anything-c-w3m-bookmarks-alist nil)
6820 (defvar anything-c-source-w3m-bookmarks
6821   '((name . "W3m Bookmarks")
6822     (init . (lambda ()
6823               (setq anything-c-w3m-bookmarks-alist
6824                     (anything-html-bookmarks-to-alist
6825                      w3m-bookmark-file
6826                      anything-w3m-bookmark-url-regexp
6827                      anything-w3m-bookmarks-regexp))))
6828     (candidates . (lambda ()
6829                     (mapcar #'car anything-c-w3m-bookmarks-alist)))
6830     (filtered-candidate-transformer
6831      anything-c-adaptive-sort
6832      anything-c-highlight-w3m-bookmarks)
6833     (action . (("Browse Url"
6834                 . (lambda (candidate)
6835                     (anything-c-w3m-browse-bookmark candidate)))
6836                ("Copy Url"
6837                 . (lambda (elm)
6838                     (kill-new (anything-c-w3m-bookmarks-get-value elm))))
6839                ("Browse Url Externally"
6840                 . (lambda (candidate)
6841                     (anything-c-w3m-browse-bookmark candidate t)))
6842                ("Delete Bookmark"
6843                 . (lambda (candidate)
6844                     (anything-c-w3m-delete-bookmark candidate)))
6845                ("Rename Bookmark"
6846                 . (lambda (candidate)
6847                     (anything-c-w3m-rename-bookmark candidate)))))
6848     (persistent-action . (lambda (candidate)
6849                            (if current-prefix-arg
6850                                (anything-c-w3m-browse-bookmark candidate t)
6851                                (anything-c-w3m-browse-bookmark candidate nil t))))
6852     (persistent-help . "Open URL with emacs-w3m in new tab / \
6853 C-u \\[anything-execute-persistent-action]: Open URL with Firefox"))
6854   "Needs w3m and emacs-w3m.
6855
6856 http://w3m.sourceforge.net/
6857 http://emacs-w3m.namazu.org/")
6858
6859
6860 (defun anything-c-w3m-bookmarks-get-value (elm)
6861   (replace-regexp-in-string
6862    "\"" "" (cdr (assoc elm anything-c-w3m-bookmarks-alist))))
6863
6864 (defun anything-c-w3m-browse-bookmark (elm &optional use-external new-tab)
6865   (let* ((fn  (if use-external 'anything-c-browse-url 'w3m-browse-url))
6866          (arg (and (eq fn 'w3m-browse-url) new-tab)))
6867     (funcall fn (anything-c-w3m-bookmarks-get-value elm) arg)))
6868
6869 (defun anything-c-highlight-w3m-bookmarks (bookmarks source)
6870   (loop for i in bookmarks
6871         collect (propertize
6872                  i 'face 'anything-w3m-bookmarks-face
6873                  'help-echo (anything-c-w3m-bookmarks-get-value i))))
6874
6875
6876 (defun anything-c-w3m-delete-bookmark (elm)
6877   "Delete w3m bookmark from `w3m-bookmark-file'."
6878   (with-current-buffer
6879       (find-file-literally w3m-bookmark-file)
6880     (goto-char (point-min))
6881     (when (re-search-forward elm nil t)
6882       (beginning-of-line)
6883       (delete-region (point)
6884                      (line-end-position))
6885       (delete-blank-lines))
6886     (save-buffer)
6887     (kill-buffer)))
6888
6889 (defun anything-c-w3m-rename-bookmark (elm)
6890   "Rename w3m bookmark in `w3m-bookmark-file'."
6891   (let* ((old-title (replace-regexp-in-string ">" "" elm))
6892          (new-title (read-string "NewTitle: " old-title)))
6893     (with-current-buffer
6894         (find-file-literally w3m-bookmark-file)
6895       (goto-char (point-min))
6896       (when (re-search-forward (concat elm "<") nil t)
6897         (goto-char (1- (point)))
6898         (delete-char (- (length old-title)))
6899         (insert new-title))
6900       (save-buffer)
6901       (kill-buffer))))
6902
6903 \f
6904 ;;;; <Library>
6905 ;;; Elisp library scan
6906 ;;
6907 ;;
6908 (defvar anything-c-source-elisp-library-scan
6909   '((name . "Elisp libraries (Scan)")
6910     (init . (anything-c-elisp-library-scan-init))
6911     (candidates-in-buffer)
6912     (action ("Find library"
6913              . (lambda (candidate) (find-file (find-library-name candidate))))
6914      ("Find library other window"
6915       . (lambda (candidate)
6916           (find-file-other-window (find-library-name candidate))))
6917      ("Load library"
6918       . (lambda (candidate) (load-library candidate))))))
6919
6920 (defun anything-c-elisp-library-scan-init ()
6921   "Init anything buffer status."
6922   (let ((anything-buffer (anything-candidate-buffer 'global))
6923         (library-list (anything-c-elisp-library-scan-list)))
6924     (with-current-buffer anything-buffer
6925       (dolist (library library-list)
6926         (insert (format "%s\n" library))))))
6927
6928 (defun anything-c-elisp-library-scan-list (&optional dirs string)
6929   "Do completion for file names passed to `locate-file'.
6930 DIRS is directory to search path.
6931 STRING is string to match."
6932   ;; Use `load-path' as path when ignore `dirs'.
6933   (or dirs (setq dirs load-path))
6934   ;; Init with blank when ignore `string'.
6935   (or string (setq string ""))
6936   ;; Get library list.
6937   (let ((string-dir (file-name-directory string))
6938         ;; File regexp that suffix match `load-file-rep-suffixes'.
6939         (match-regexp (format "^.*\\.el%s$" (regexp-opt load-file-rep-suffixes)))
6940         name
6941         names)
6942     (dolist (dir dirs)
6943       (unless dir
6944         (setq dir default-directory))
6945       (if string-dir
6946           (setq dir (expand-file-name string-dir dir)))
6947       (when (file-directory-p dir)
6948         (dolist (file (file-name-all-completions
6949                        (file-name-nondirectory string) dir))
6950           ;; Suffixes match `load-file-rep-suffixes'.
6951           (setq name (if string-dir (concat string-dir file) file))
6952           (if (string-match match-regexp name)
6953               (add-to-list 'names name)))))
6954     names))
6955
6956 \f
6957 ;;;; <Programming>
6958 ;;
6959 ;;
6960
6961 ;;; Imenu
6962 ;;
6963 ;;
6964 (defvar anything-c-imenu-delimiter " / ")
6965
6966 (defvar anything-c-imenu-index-filter nil)
6967 (make-variable-buffer-local 'anything-c-imenu-index-filter)
6968
6969 (defvar anything-c-cached-imenu-alist nil)
6970 (make-variable-buffer-local 'anything-c-cached-imenu-alist)
6971
6972 (defvar anything-c-cached-imenu-candidates nil)
6973 (make-variable-buffer-local 'anything-c-cached-imenu-candidates)
6974
6975 (defvar anything-c-cached-imenu-tick nil)
6976 (make-variable-buffer-local 'anything-c-cached-imenu-tick)
6977
6978 (eval-when-compile (require 'imenu))
6979 (setq imenu-auto-rescan t)
6980
6981 (defun anything-imenu-create-candidates (entry)
6982   "Create candidates with ENTRY."
6983   (if (listp (cdr entry))
6984       (mapcan
6985        (lambda (sub)
6986          (if (consp (cdr sub))
6987              (mapcar
6988               (lambda (subentry)
6989                 (concat (car entry) anything-c-imenu-delimiter subentry))
6990               (anything-imenu-create-candidates sub))
6991              (list (concat (car entry) anything-c-imenu-delimiter (car sub)))))
6992        (cdr entry))
6993       (list entry)))
6994
6995 (defvar anything-c-source-imenu
6996   '((name . "Imenu")
6997     (init . (lambda () (require 'imenu)))
6998     (candidates . anything-c-imenu-candidates)
6999     (persistent-action . (lambda (elm)
7000                            (anything-c-imenu-default-action elm)
7001                            (unless (fboundp 'semantic-imenu-tag-overlay)
7002                              (anything-match-line-color-current-line))))
7003     (persistent-help . "Show this entry")
7004     (action . anything-c-imenu-default-action))
7005   "See (info \"(emacs)Imenu\")")
7006
7007
7008 (defun anything-c-imenu-candidates ()
7009   (with-anything-current-buffer
7010     (let ((tick (buffer-modified-tick)))
7011       (if (eq anything-c-cached-imenu-tick tick)
7012           anything-c-cached-imenu-candidates
7013           (setq imenu--index-alist nil)
7014           (setq anything-c-cached-imenu-tick tick
7015                 anything-c-cached-imenu-candidates
7016                 (ignore-errors
7017                   (mapcan
7018                    'anything-imenu-create-candidates
7019                    (setq anything-c-cached-imenu-alist
7020                          (let ((index (imenu--make-index-alist)))
7021                            (if anything-c-imenu-index-filter
7022                                (funcall anything-c-imenu-index-filter index)
7023                                index))))))
7024           (setq anything-c-cached-imenu-candidates
7025                 (mapcar #'(lambda (x)
7026                             (if (stringp x)
7027                                 x
7028                                 (car x)))
7029                         anything-c-cached-imenu-candidates))))))
7030
7031 (setq imenu-default-goto-function 'imenu-default-goto-function)
7032 (defun anything-c-imenu-default-action (elm)
7033   "The default action for `anything-c-source-imenu'."
7034   (let ((path (split-string elm anything-c-imenu-delimiter))
7035         (alist anything-c-cached-imenu-alist))
7036     (dolist (elm path)
7037       (setq alist (assoc elm alist)))
7038     (imenu alist)))
7039
7040
7041 \f
7042 ;;; Ctags
7043 ;;
7044 ;;
7045 (defvar anything-c-ctags-modes
7046   '( c-mode c++-mode awk-mode csharp-mode java-mode javascript-mode lua-mode
7047     makefile-mode pascal-mode perl-mode cperl-mode php-mode python-mode
7048     scheme-mode sh-mode slang-mode sql-mode tcl-mode ))
7049
7050 (defun anything-c-source-ctags-init ()
7051   (when (and buffer-file-name
7052              (memq major-mode anything-c-ctags-modes)
7053              (anything-current-buffer-is-modified))
7054     (with-current-buffer (anything-candidate-buffer 'local)
7055       (call-process-shell-command
7056        (if (string-match "\\.el\\.gz$" anything-buffer-file-name)
7057            (format "ctags -e -u -f- --language-force=lisp --fields=n =(zcat %s) "
7058                    anything-buffer-file-name)
7059            (format "ctags -e -u -f- --fields=n %s " anything-buffer-file-name))
7060        nil (current-buffer))
7061       (goto-char (point-min))
7062       (forward-line 2)
7063       (delete-region (point-min) (point))
7064       (loop while (and (not (eobp)) (search-forward "\001" (point-at-eol) t))
7065             for lineno-start = (point)
7066             for lineno = (buffer-substring
7067                           lineno-start
7068                           (1- (search-forward "," (point-at-eol) t)))
7069             do
7070             (beginning-of-line)
7071             (insert (format "%5s:" lineno))
7072             (search-forward "\177" (point-at-eol) t)
7073             (delete-region (1- (point)) (point-at-eol))
7074             (forward-line 1)))))
7075
7076 (defvar anything-c-source-ctags
7077   '((name . "Exuberant ctags")
7078     (init . anything-c-source-ctags-init)
7079     (candidates-in-buffer)
7080     (adjust)
7081     (type . line))
7082   "Needs Exuberant Ctags.
7083
7084 http://ctags.sourceforge.net/")
7085
7086 \f
7087 ;;; Etags
7088 ;;
7089 ;;
7090 ;; anything-etags.el is deprecated, if this file is found,
7091 ;; warn user at compile time.
7092 (eval-when-compile
7093   (when (locate-library "anything-etags.el")
7094     (display-warning
7095      '(anything-config)
7096      "You are using obsolete library `anything-etags.el' and should remove it."
7097      :warning)))
7098
7099 (defvar anything-c-etags-tag-file-dir nil
7100   "Etags file directory.")
7101 (defvar anything-c-etags-mtime-alist nil
7102   "Store the last modification time of etags files here.")
7103 (defvar anything-c-etags-cache (make-hash-table :test 'equal)
7104   "Cache content of etags files used here for faster access.")
7105
7106 (defun anything-c-etags-get-tag-file (&optional directory)
7107   "Return the path of etags file if found."
7108   ;; Get tag file from `default-directory' or upper directory.
7109   (let ((current-dir (anything-c-etags-find-tag-file-directory
7110                       (or directory default-directory))))
7111     ;; Return nil if not find tag file.
7112     (when current-dir
7113       ;; Set tag file directory.
7114       (setq anything-c-etags-tag-file-dir current-dir)
7115       (expand-file-name anything-c-etags-tag-file-name current-dir))))
7116
7117 (defun anything-c-etags-find-tag-file-directory (current-dir)
7118   "Try to find the directory containing tag file.
7119 If not found in CURRENT-DIR search in upper directory."
7120   (flet ((file-exists? (dir)
7121            (let ((tag-path (expand-file-name
7122                             anything-c-etags-tag-file-name dir)))
7123              (and (stringp tag-path)
7124                   (file-regular-p tag-path)
7125                   (file-readable-p tag-path)))))
7126     (loop with count = 0
7127           until (file-exists? current-dir)
7128           ;; Return nil if outside the value of
7129           ;; `anything-c-etags-tag-file-search-limit'.
7130           if (= count anything-c-etags-tag-file-search-limit)
7131           do (return nil)
7132           ;; Or search upper directories.
7133           else
7134           do (incf count)
7135           (setq current-dir (expand-file-name (concat current-dir "../")))
7136           finally return current-dir)))
7137
7138 (defun anything-c-source-etags-header-name (x)
7139   "Create header name for this anything etags session."
7140   (concat "Etags in "
7141           (with-anything-current-buffer
7142             (anything-c-etags-get-tag-file))))
7143
7144 (defmacro anything-c-etags-create-buffer (file)
7145   "Create the `anything-buffer' based on contents of etags tag FILE."
7146   `(let* ((tag-fname ,file)
7147           max
7148           (split (with-current-buffer (find-file-noselect tag-fname)
7149                    (prog1
7150                        (split-string (buffer-string) "\n" 'omit-nulls)
7151                      (setq max (line-number-at-pos (point-max)))
7152                      (kill-buffer))))
7153           (progress-reporter (make-progress-reporter "Loading tag file..." 0 max)))
7154      (loop
7155            with fname
7156            with cand
7157            for i in split for count from 0
7158            for elm = (unless (string-match "^\x0c" i)
7159                        (anything-aif (string-match "\177" i)
7160                            (substring i 0 it)
7161                          i))
7162            do (cond ((and elm (string-match "^\\(.+\\),[0-9]+" elm))
7163                      (setq fname (match-string 1 elm)))
7164                     (elm (setq cand (concat fname ": " elm)))
7165                     (t (setq cand nil)))
7166            when cand do (progn
7167                           (insert (concat cand "\n"))
7168                           (progress-reporter-update progress-reporter count)))))
7169
7170 (defun anything-c-etags-init ()
7171   "Feed `anything-buffer' using `anything-c-etags-cache' or tag file.
7172 If no entry in cache, create one."
7173   (let ((tagfile (anything-c-etags-get-tag-file)))
7174     (when tagfile
7175       (with-current-buffer (anything-candidate-buffer 'global)
7176         (anything-aif (gethash tagfile anything-c-etags-cache)
7177             ;; An entry is present in cache, insert it.
7178             (insert it)
7179           ;; No entry, create a new buffer using content of tag file (slower).
7180           (anything-c-etags-create-buffer tagfile)
7181           ;; Store content of buffer in cache.
7182           (puthash tagfile (buffer-string) anything-c-etags-cache)
7183           ;; Store or set the last modification of tag file.
7184           (anything-aif (assoc tagfile anything-c-etags-mtime-alist)
7185               ;; If an entry exists modify it.
7186               (setcdr it (anything-c-etags-mtime tagfile))
7187             ;; No entry create a new one.
7188             (add-to-list 'anything-c-etags-mtime-alist
7189                          (cons tagfile (anything-c-etags-mtime tagfile)))))))))
7190
7191 (defvar anything-c-source-etags-select
7192   '((name . "Etags")
7193     (header-name . anything-c-source-etags-header-name)
7194     (init . anything-c-etags-init)
7195     (candidates-in-buffer)
7196     (search . (anything-c-etags-search-fn))
7197     (mode-line . anything-etags-mode-line-string)
7198     (action . anything-c-etags-default-action)
7199     (persistent-action . (lambda (candidate)
7200                            (anything-c-etags-default-action candidate)
7201                            (anything-match-line-color-current-line))))
7202   "Anything source for Etags.")
7203
7204 (defun anything-c-etags-search-fn (pattern)
7205   "Search function for `anything-c-source-etags-select'."
7206   (re-search-forward
7207    (if anything-c-etags-use-regexp-search
7208        (format anything-c-etags-search-regexp pattern)
7209        pattern)
7210    nil t))
7211
7212 (defun anything-c-etags-default-action (candidate)
7213   "Anything default action to jump to an etags entry."
7214   (let* ((split (split-string candidate ": "))
7215          (fname (expand-file-name
7216                  (car split) anything-c-etags-tag-file-dir))
7217          (elm   (cadr split)))
7218     (find-file fname)
7219     (goto-char (point-min))
7220     (search-forward elm nil t)
7221     (goto-char (match-beginning 0))))
7222
7223 (defun anything-c-etags-mtime (file)
7224   "Last modification time of etags tag FILE."
7225   (cadr (nth 5 (file-attributes file))))
7226
7227 (defun anything-c-etags-file-modified-p (file)
7228   "Check if tag FILE have been modified in this session.
7229 If FILE is nil return nil."
7230   (let ((last-modif (and file
7231                          (assoc-default file anything-c-etags-mtime-alist))))
7232     (and last-modif
7233          (/= last-modif (anything-c-etags-mtime file)))))
7234
7235
7236 \f
7237 ;;; Semantic
7238 ;;
7239 ;;
7240 (defvar anything-semantic-candidates nil)
7241
7242 (defun anything-semantic-construct-candidates (tags depth)
7243   (when (require 'semantic nil t)
7244     (apply
7245      'append
7246      (mapcar
7247       (lambda (tag)
7248         (if (listp tag)
7249             (let ((type (semantic-tag-type tag))
7250                   (class (semantic-tag-class tag)))
7251               (if (or (and (stringp type)
7252                            (or (string= type "class")
7253                                (string= type "namespace")))
7254                       (eq class 'function)
7255                       (eq class 'variable))
7256                   (cons (cons (concat (make-string (* depth 2) ?\s)
7257                                       (semantic-format-tag-summarize tag nil t))
7258                               tag)
7259                         (anything-semantic-construct-candidates
7260                          (semantic-tag-components tag) (1+ depth)))))))
7261       tags))))
7262
7263 (defun anything-semantic-default-action (candidate)
7264   (let ((tag (cdr (assoc candidate anything-semantic-candidates))))
7265     (semantic-go-to-tag tag)))
7266
7267 (defvar anything-c-source-semantic
7268   '((name . "Semantic Tags")
7269     (init . (lambda ()
7270               (setq anything-semantic-candidates
7271                     (ignore-errors (anything-semantic-construct-candidates
7272                                     (semantic-fetch-tags) 0)))))
7273     (candidates . (lambda ()
7274                     (if anything-semantic-candidates
7275                         (mapcar 'car anything-semantic-candidates))))
7276     (persistent-action . (lambda (elm)
7277                            (anything-semantic-default-action elm)
7278                            (anything-match-line-color-current-line)))
7279     (persistent-help . "Show this entry")
7280     (action . anything-semantic-default-action)
7281     "Needs semantic in CEDET.
7282
7283 http://cedet.sourceforge.net/semantic.shtml
7284 http://cedet.sourceforge.net/"))
7285
7286
7287 \f
7288 ;;; Anything interface of `simple-call-tree.el'.
7289 ;;
7290 ;; <http://www.emacswiki.org/cgi-bin/wiki/download/simple-call-tree.el>
7291 ;;
7292 ;; Function is called by
7293 (defvar anything-c-source-simple-call-tree-functions-callers
7294   '((name . "Function is called by")
7295     (init . anything-c-simple-call-tree-functions-callers-init)
7296     (multiline)
7297     (candidates . anything-c-simple-call-tree-candidates)
7298     (persistent-action . anything-c-simple-call-tree-persistent-action)
7299     (persistent-help . "Show function definitions by rotation")
7300     (action ("Find definition selected by persistent-action" .
7301              anything-c-simple-call-tree-find-definition)))
7302   "Needs simple-call-tree.el.
7303 http://www.emacswiki.org/cgi-bin/wiki/download/simple-call-tree.el")
7304
7305 (defvar anything-c-simple-call-tree-tick nil)
7306 (make-variable-buffer-local 'anything-c-simple-call-tree-tick)
7307 (defun anything-c-simple-call-tree-analyze-maybe ()
7308   (unless (eq (buffer-chars-modified-tick) anything-c-simple-call-tree-tick)
7309     (simple-call-tree-analyze)
7310     (setq anything-c-simple-call-tree-tick (buffer-chars-modified-tick))))
7311
7312 (defun anything-c-simple-call-tree-init-base (function message)
7313   (require 'simple-call-tree)
7314   (with-no-warnings
7315     (when (anything-current-buffer-is-modified)
7316       (anything-c-simple-call-tree-analyze-maybe)
7317       (let ((list (funcall function simple-call-tree-alist)))
7318         (with-current-buffer (anything-candidate-buffer 'local)
7319           (dolist (entry list)
7320             (let ((funcs (concat "  " (mapconcat #'identity (cdr entry) "\n  "))))
7321               (insert (car entry) message
7322                       (if (string= funcs "  ")
7323                           "  no functions."
7324                           funcs)
7325                       "\n\n"))))))))
7326
7327 (defun anything-c-simple-call-tree-functions-callers-init ()
7328   (anything-c-simple-call-tree-init-base 'simple-call-tree-invert
7329                                          " is called by\n"))
7330
7331 (defun anything-c-simple-call-tree-candidates ()
7332   (with-current-buffer (anything-candidate-buffer)
7333     (split-string (buffer-string) "\n\n")))
7334
7335 (defvar anything-c-simple-call-tree-related-functions nil)
7336 (defvar anything-c-simple-call-tree-function-index 0)
7337 (defun anything-c-simple-call-tree-persistent-action (candidate)
7338   (unless (eq last-command 'anything-execute-persistent-action)
7339     (setq anything-c-simple-call-tree-related-functions
7340           (delete "no functions."
7341                   (split-string
7342                    (replace-regexp-in-string "  \\| is called by\\| calls "
7343                                              "" candidate)
7344                    "\n")))
7345     (setq anything-c-simple-call-tree-function-index -1))
7346   (incf anything-c-simple-call-tree-function-index)
7347   (anything-c-simple-call-tree-find-definition candidate))
7348
7349 (defun anything-c-simple-call-tree-find-definition (candidate)
7350   (find-function
7351    (intern
7352     (nth (mod anything-c-simple-call-tree-function-index
7353               (length anything-c-simple-call-tree-related-functions))
7354          anything-c-simple-call-tree-related-functions))))
7355
7356
7357 ;;; Function calls
7358 (defvar anything-c-source-simple-call-tree-callers-functions
7359   '((name . "Function calls")
7360     (init . anything-c-simple-call-tree-callers-functions-init)
7361     (multiline)
7362     (candidates . anything-c-simple-call-tree-candidates)
7363     (persistent-action . anything-c-simple-call-tree-persistent-action)
7364     (persistent-help . "Show function definitions by rotation")
7365     (action ("Find definition selected by persistent-action" .
7366              anything-c-simple-call-tree-find-definition)))
7367   "Needs simple-call-tree.el.
7368 http://www.emacswiki.org/cgi-bin/wiki/download/simple-call-tree.el")
7369
7370 (defun anything-c-simple-call-tree-callers-functions-init ()
7371   (anything-c-simple-call-tree-init-base 'identity " calls \n"))
7372
7373
7374
7375 \f
7376 ;;; Anything UI of auto-document.el
7377 ;;
7378 ;; <http://www.emacswiki.org/cgi-bin/wiki/download/auto-document.el>
7379 ;;
7380 ;; Commands/Options with doc
7381 (defvar anything-c-auto-document-data nil)
7382 (make-variable-buffer-local 'anything-c-auto-document-data)
7383 (defvar anything-c-source-commands-and-options-in-file
7384   '((name . "Commands/Options in file")
7385     (header-name
7386      . (lambda (x) (format "Commands/Options in %s"
7387                            (buffer-local-value 'buffer-file-name
7388                                                anything-current-buffer))))
7389     (candidates . anything-command-and-options-candidates)
7390     (multiline)
7391     (action . imenu))
7392   "List Commands and Options with doc. It needs auto-document.el .
7393
7394 http://www.emacswiki.org/cgi-bin/wiki/download/auto-document.el")
7395
7396 (eval-when-compile (require 'auto-document nil t))
7397 (defun anything-command-and-options-candidates ()
7398   (with-anything-current-buffer
7399     (when (and (require 'auto-document nil t)
7400                (eq major-mode 'emacs-lisp-mode)
7401                (or (anything-current-buffer-is-modified)
7402                    (not anything-c-auto-document-data)))
7403       (or imenu--index-alist (imenu--make-index-alist t))
7404       (setq anything-c-auto-document-data
7405             (destructuring-bind (commands options)
7406                 (adoc-construct anything-current-buffer)
7407               (append
7408                (loop for (command . doc) in commands
7409                      for cmdname = (symbol-name command)
7410                      collect
7411                      (cons
7412                       (format "Command: %s\n %s"
7413                               (propertize cmdname 'face font-lock-function-name-face)
7414                               (adoc-first-line doc))
7415                       (assoc cmdname imenu--index-alist)))
7416                (loop with var-alist = (cdr (assoc "Variables" imenu--index-alist))
7417                      for (option doc default) in options
7418                      for optname = (symbol-name option)
7419                      collect
7420                      (cons
7421                       (format "Option: %s\n %s\n default = %s"
7422                               (propertize optname 'face font-lock-variable-name-face)
7423                               (adoc-first-line doc)
7424                               (adoc-prin1-to-string default))
7425                       (assoc optname
7426                              var-alist)))))))
7427     anything-c-auto-document-data))
7428
7429
7430 \f
7431 ;;;; <Color and Face>
7432 ;;
7433
7434 ;;; Customize Face
7435 ;;
7436 ;;
7437 (defvar anything-c-source-customize-face
7438   '((name . "Customize Face")
7439     (init . (lambda ()
7440               (unless (anything-candidate-buffer)
7441                 (save-selected-window
7442                   (list-faces-display))
7443                 (anything-candidate-buffer (get-buffer "*Faces*")))))
7444     (candidates-in-buffer)
7445     (get-line . buffer-substring)
7446     (action . (lambda (line)
7447                 (customize-face (intern (car (split-string line))))))
7448     (requires-pattern . 3))
7449   "See (info \"(emacs)Faces\")")
7450
7451 ;;; Colors browser
7452 ;;
7453 ;;
7454 (defvar anything-c-source-colors
7455   '((name . "Colors")
7456     (init . (lambda () (unless (anything-candidate-buffer)
7457                          (save-selected-window
7458                            (list-colors-display))
7459                          (anything-candidate-buffer (get-buffer "*Colors*")))))
7460     (candidates-in-buffer)
7461     (get-line . buffer-substring)
7462     (action
7463      ("Copy Name" . (lambda (candidate)
7464                       (kill-new (anything-c-colors-get-name candidate))))
7465      ("Copy RGB" . (lambda (candidate)
7466                      (kill-new (anything-c-colors-get-rgb candidate))))
7467      ("Insert Name" . (lambda (candidate)
7468                         (with-anything-current-buffer
7469                           (insert (anything-c-colors-get-name candidate)))))
7470      ("Insert RGB" . (lambda (candidate)
7471                        (with-anything-current-buffer
7472                          (insert (anything-c-colors-get-rgb candidate))))))))
7473
7474 (defun anything-c-colors-get-name (candidate)
7475   "Get color name."
7476   (replace-regexp-in-string
7477    " " ""
7478    (with-temp-buffer
7479      (insert (capitalize candidate))
7480      (goto-char (point-min))
7481      (search-forward-regexp "\\s-\\{2,\\}")
7482      (delete-region (point) (point-max))
7483      (buffer-string))))
7484
7485 (defun anything-c-colors-get-rgb (candidate)
7486   "Get color RGB."
7487   (replace-regexp-in-string
7488    " " ""
7489    (with-temp-buffer
7490      (insert (capitalize candidate))
7491      (goto-char (point-max))
7492      (search-backward-regexp "\\s-\\{2,\\}")
7493      (delete-region (point) (point-min))
7494      (buffer-string))))
7495
7496 \f
7497 ;;;; <Search Engine>
7498 ;;; Tracker desktop search
7499 (defvar anything-c-source-tracker-search
7500   '((name . "Tracker Search")
7501     (candidates . (lambda ()
7502                     (start-process "tracker-search-process" nil
7503                                    "tracker-search"
7504                                    anything-pattern)))
7505     (type . file)
7506     (requires-pattern . 3)
7507     (delayed))
7508   "Source for retrieving files matching the current input pattern
7509 with the tracker desktop search.")
7510
7511 ;;; Spotlight (MacOS X desktop search)
7512 (defvar anything-c-source-mac-spotlight
7513   '((name . "mdfind")
7514     (candidates
7515      . (lambda () (start-process "mdfind-process" nil "mdfind" anything-pattern)))
7516     (type . file)
7517     (requires-pattern . 3)
7518     (delayed))
7519   "Source for retrieving files via Spotlight's command line
7520 utility mdfind.")
7521
7522 ;;; Picklist
7523 (defvar anything-c-source-picklist
7524   '((name . "Picklist")
7525     (candidates . (lambda () (mapcar 'car picklist-list)))
7526     (type . file)))
7527
7528
7529 \f
7530 ;;; Kill ring
7531 ;;
7532 ;;
7533 (defvar anything-c-source-kill-ring
7534   `((name . "Kill Ring")
7535     (init . (lambda () (anything-attrset 'last-command last-command)))
7536     (candidates . anything-c-kill-ring-candidates)
7537     (filtered-candidate-transformer anything-c-kill-ring-transformer)
7538     (action . anything-c-kill-ring-action)
7539     (keymap . ,anything-kill-ring-map)
7540     (last-command)
7541     (migemo)
7542     (multiline))
7543   "Source for browse and insert contents of kill-ring.")
7544
7545 (defun anything-c-kill-ring-candidates ()
7546   (loop for kill in (anything-fast-remove-dups kill-ring :test 'equal)
7547         unless (or (< (length kill) anything-kill-ring-threshold)
7548                    (string-match "^[\\s\\t]+$" kill))
7549         collect kill))
7550
7551 (defun anything-c-kill-ring-transformer (candidates source)
7552   "Display only the `anything-c-kill-ring-max-lines-number' lines of candidate."
7553   (loop for i in candidates
7554         for nlines = (with-temp-buffer (insert i) (count-lines (point-min) (point-max)))
7555         if (and anything-c-kill-ring-max-lines-number
7556                 (> nlines anything-c-kill-ring-max-lines-number))
7557         collect (cons
7558                  (with-temp-buffer
7559                    (insert i)
7560                    (goto-char (point-min))
7561                    (concat
7562                     (buffer-substring
7563                      (point-min)
7564                      (save-excursion
7565                        (forward-line anything-c-kill-ring-max-lines-number)
7566                        (point)))
7567                     "[...]")) i)
7568         else collect i))
7569
7570 (defun anything-c-kill-ring-action (str)
7571   "Insert STR in `kill-ring' and set STR to the head.
7572 If this action is executed just after `yank',
7573 replace with STR as yanked string."
7574   (setq kill-ring (delete str kill-ring))
7575   (if (not (eq (anything-attr 'last-command) 'yank))
7576       (insert-for-yank str)
7577       ;; from `yank-pop'
7578       (let ((inhibit-read-only t)
7579             (before (< (point) (mark t))))
7580         (if before
7581             (funcall (or yank-undo-function 'delete-region) (point) (mark t))
7582             (funcall (or yank-undo-function 'delete-region) (mark t) (point)))
7583         (setq yank-undo-function nil)
7584         (set-marker (mark-marker) (point) (current-buffer))
7585         (insert-for-yank str)
7586         ;; Set the window start back where it was in the yank command,
7587         ;; if possible.
7588         (set-window-start (selected-window) yank-window-start t)
7589         (if before
7590             ;; This is like exchange-point-and-mark, but doesn't activate the mark.
7591             ;; It is cleaner to avoid activation, even though the command
7592             ;; loop would deactivate the mark because we inserted text.
7593             (goto-char (prog1 (mark t)
7594                          (set-marker (mark-marker) (point) (current-buffer)))))))
7595   (kill-new str))
7596
7597
7598 \f
7599 ;;;; <Mark ring>
7600 ;; DO NOT include these sources in `anything-sources' use
7601 ;; the commands `anything-mark-ring', `anything-global-mark-ring' or
7602 ;; `anything-all-mark-rings' instead.
7603
7604 (defun anything-c-source-mark-ring-candidates ()
7605   (flet ((get-marks (pos)
7606            (save-excursion
7607              (goto-char pos)
7608              (beginning-of-line)
7609              (let ((line  (car (split-string (thing-at-point 'line) "[\n\r]"))))
7610                (when (string= "" line)
7611                  (setq line  "<EMPTY LINE>"))
7612                (format "%7d: %s" (line-number-at-pos) line)))))
7613     (with-anything-current-buffer
7614       (loop
7615             with marks = (if (mark) (cons (mark-marker) mark-ring) mark-ring)
7616             with recip = nil
7617             for i in marks
7618             for m = (get-marks i)
7619             unless (member m recip)
7620             collect m into recip
7621             finally return recip))))
7622
7623 (defvar anything-mark-ring-cache nil)
7624 (defvar anything-c-source-mark-ring
7625   '((name . "mark-ring")
7626     (init . (lambda ()
7627               (setq anything-mark-ring-cache
7628                     (ignore-errors (anything-c-source-mark-ring-candidates)))))
7629     (candidates . (lambda ()
7630                     (anything-aif anything-mark-ring-cache
7631                         it)))
7632     (action . (("Goto line"
7633                 . (lambda (candidate)
7634                     (anything-goto-line (string-to-number candidate))))))
7635     (persistent-action . (lambda (candidate)
7636                            (anything-goto-line (string-to-number candidate))
7637                            (anything-match-line-color-current-line)))
7638     (persistent-help . "Show this line")))
7639
7640
7641 ;;; Global-mark-ring
7642 (defvar anything-c-source-global-mark-ring
7643   '((name . "global-mark-ring")
7644     (candidates . anything-c-source-global-mark-ring-candidates)
7645     (action . (("Goto line"
7646                 . (lambda (candidate)
7647                     (let ((items (split-string candidate ":")))
7648                       (anything-c-switch-to-buffer (second items))
7649                       (anything-goto-line (string-to-number (car items))))))))
7650     (persistent-action . (lambda (candidate)
7651                            (let ((items (split-string candidate ":")))
7652                              (anything-c-switch-to-buffer (second items))
7653                              (anything-goto-line (string-to-number (car items)))
7654                              (anything-match-line-color-current-line))))
7655     (persistent-help . "Show this line")))
7656
7657 (defun anything-c-source-global-mark-ring-candidates ()
7658   (flet ((buf-fn (m)
7659            (with-current-buffer (marker-buffer m)
7660              (goto-char m)
7661              (beginning-of-line)
7662              (let (line)
7663                (if (string= "" line)
7664                    (setq line  "<EMPTY LINE>")
7665                    (setq line (car (split-string (thing-at-point 'line)
7666                                                  "[\n\r]"))))
7667                (format "%7d:%s:    %s"
7668                        (line-number-at-pos) (marker-buffer m) line)))))
7669     (loop
7670           with marks = global-mark-ring
7671           with recip = nil
7672           for i in marks
7673           for gm = (unless (or (string-match
7674                                 "^ " (format "%s" (marker-buffer i)))
7675                                (null (marker-buffer i)))
7676                      (buf-fn i))
7677           when (and gm (not (member gm recip)))
7678           collect gm into recip
7679           finally return recip)))
7680
7681
7682 \f
7683 ;;;; <Register>
7684 ;;; Insert from register
7685 (defvar anything-c-source-register
7686   '((name . "Registers")
7687     (candidates . anything-c-register-candidates)
7688     (action-transformer . anything-c-register-action-transformer)
7689     (multiline)
7690     (action))
7691   "See (info \"(emacs)Registers\")")
7692
7693 (defun anything-c-register-candidates ()
7694   "Collecting register contents and appropriate commands."
7695   (loop for (char . val) in register-alist
7696         for key    = (single-key-description char)
7697         for string-actions =
7698         (cond
7699           ((numberp val)
7700            (list (int-to-string val)
7701                  'insert-register
7702                  'increment-register))
7703           ((markerp val)
7704            (let ((buf (marker-buffer val)))
7705              (if (null buf)
7706                  (list "a marker in no buffer")
7707                  (list (concat
7708                         "a buffer position:"
7709                         (buffer-name buf)
7710                         ", position "
7711                         (int-to-string (marker-position val)))
7712                        'jump-to-register
7713                        'insert-register))))
7714           ((and (consp val) (window-configuration-p (car val)))
7715            (list "window configuration."
7716                  'jump-to-register))
7717           ((and (consp val) (frame-configuration-p (car val)))
7718            (list "frame configuration."
7719                  'jump-to-register))
7720           ((and (consp val) (eq (car val) 'file))
7721            (list (concat "file:"
7722                          (prin1-to-string (cdr val))
7723                          ".")
7724                  'jump-to-register))
7725           ((and (consp val) (eq (car val) 'file-query))
7726            (list (concat "file:a file-query reference: file "
7727                          (car (cdr val))
7728                          ", position "
7729                          (int-to-string (car (cdr (cdr val))))
7730                          ".")
7731                  'jump-to-register))
7732           ((consp val)
7733            (let ((lines (format "%4d" (length val))))
7734              (list (format "%s: %s\n" lines
7735                            (truncate-string-to-width
7736                             (mapconcat 'identity (list (car val))
7737                                        "^J") (- (window-width) 15)))
7738                    'insert-register)))
7739           ((stringp val)
7740            (list
7741             ;; without properties
7742             (concat (substring-no-properties
7743                      val 0 (min (length val) anything-c-register-max-offset))
7744                     (if (> (length val) anything-c-register-max-offset)
7745                         "[...]" ""))
7746             'insert-register
7747             'append-to-register
7748             'prepend-to-register))
7749           ((vectorp val)
7750            (list
7751             "Undo-tree entry."
7752             'undo-tree-restore-state-from-register))
7753           (t
7754            "GARBAGE!"))
7755         collect (cons (format "register %3s: %s" key (car string-actions))
7756                       (cons char (cdr string-actions)))))
7757
7758 (defun anything-c-register-action-transformer (actions register-and-functions)
7759   "Decide actions by the contents of register."
7760   (loop with func-actions =
7761         '((insert-register
7762            "Insert Register" .
7763            (lambda (c) (insert-register (car c))))
7764           (jump-to-register
7765            "Jump to Register" .
7766            (lambda (c) (jump-to-register (car c))))
7767           (append-to-register
7768            "Append Region to Register" .
7769            (lambda (c) (append-to-register
7770                         (car c) (region-beginning) (region-end))))
7771           (prepend-to-register
7772            "Prepend Region to Register" .
7773            (lambda (c) (prepend-to-register
7774                         (car c) (region-beginning) (region-end))))
7775           (increment-register
7776            "Increment Prefix Arg to Register" .
7777            (lambda (c) (increment-register
7778                         anything-current-prefix-arg (car c))))
7779           (undo-tree-restore-state-from-register
7780            "Restore Undo-tree register"
7781            (lambda (c) (and (fboundp 'undo-tree-restore-state-from-register)
7782                             (undo-tree-restore-state-from-register (car c))))))
7783         for func in (cdr register-and-functions)
7784         for cell = (assq func func-actions)
7785         when cell
7786         collect (cdr cell)))
7787
7788
7789 \f
7790 ;;; Latex completion
7791 (defun anything-c-latex-math-candidates ()
7792   "Collect candidates for latex math completion."
7793   (declare (special LaTeX-math-menu))
7794   (loop for i in (cddr LaTeX-math-menu)
7795         for elm = (loop for s in i when (vectorp s)
7796                         collect (cons (aref s 0) (aref s 1)))
7797         append elm))
7798
7799 (defvar anything-c-source-latex-math
7800   '((name . "Latex Math Menu")
7801     (init . (lambda ()
7802               (with-anything-current-buffer
7803                 (LaTeX-math-mode 1))))
7804     (candidate-number-limit . 9999)
7805     (candidates . anything-c-latex-math-candidates)
7806     (action . (lambda (candidate)
7807                 (call-interactively candidate)))))
7808
7809 \f
7810 ;;;; <Headline Extraction>
7811 (defvar anything-c-source-fixme
7812   '((name . "TODO/FIXME/DRY comments")
7813     (headline . "^.*\\<\\(TODO\\|FIXME\\|DRY\\)\\>.*$")
7814     (adjust)
7815     (recenter))
7816   "Show TODO/FIXME/DRY comments in current file.")
7817
7818 (defvar anything-c-source-rd-headline
7819   '((name . "RD HeadLine")
7820     (headline  "^= \\(.+\\)$" "^== \\(.+\\)$" "^=== \\(.+\\)$" "^==== \\(.+\\)$")
7821     (condition . (memq major-mode '(rdgrep-mode rd-mode)))
7822     (migemo)
7823     (subexp . 1))
7824   "Show RD headlines.
7825
7826 RD is Ruby's POD.
7827 http://en.wikipedia.org/wiki/Ruby_Document_format")
7828
7829 (defvar anything-c-source-oddmuse-headline
7830   '((name . "Oddmuse HeadLine")
7831     (headline  "^= \\(.+\\) =$" "^== \\(.+\\) ==$"
7832      "^=== \\(.+\\) ===$" "^==== \\(.+\\) ====$")
7833     (condition . (memq major-mode '(oddmuse-mode yaoddmuse-mode)))
7834     (migemo)
7835     (subexp . 1))
7836   "Show Oddmuse headlines, such as EmacsWiki.")
7837
7838 (defvar anything-c-source-emacs-source-defun
7839   '((name . "Emacs Source DEFUN")
7840     (headline . "DEFUN\\|DEFVAR")
7841     (condition . (string-match "/emacs2[0-9].+/src/.+c$"
7842                   (or buffer-file-name ""))))
7843   "Show DEFUN/DEFVAR in Emacs C source file.")
7844
7845 (defvar anything-c-source-emacs-lisp-expectations
7846   '((name . "Emacs Lisp Expectations")
7847     (headline . "(desc[ ]\\|(expectations")
7848     (condition . (eq major-mode 'emacs-lisp-mode)))
7849   "Show descriptions (desc) in Emacs Lisp Expectations.
7850
7851 http://www.emacswiki.org/cgi-bin/wiki/download/el-expectations.el")
7852
7853 (defvar anything-c-source-emacs-lisp-toplevels
7854   '((name . "Emacs Lisp Toplevel / Level 4 Comment / Linkd Star")
7855     (headline . "^(\\|(@\\*\\|^;;;;")
7856     (get-line . buffer-substring)
7857     (condition . (eq major-mode 'emacs-lisp-mode))
7858     (adjust))
7859   "Show top-level forms, level 4 comments and linkd stars (optional) in Emacs Lisp.
7860 linkd.el is optional because linkd stars are extracted by regexp.
7861 http://www.emacswiki.org/cgi-bin/wiki/download/linkd.el")
7862
7863 \f
7864 ;;; Anything yaoddmuse
7865 ;;
7866 ;; Be sure to have yaoddmuse.el installed
7867 ;; install-elisp may be required if you want to install elisp file from here.
7868 (defvar anything-yaoddmuse-use-cache-file nil)
7869 (defvar anything-c-yaoddmuse-cache-file "~/.emacs.d/yaoddmuse-cache.el")
7870 (defvar anything-c-yaoddmuse-ew-cache nil)
7871
7872 (defun anything-yaoddmuse-get-candidates ()
7873   (declare (special yaoddmuse-pages-hash))
7874   (if anything-yaoddmuse-use-cache-file
7875       (ignore-errors
7876         (unless anything-c-yaoddmuse-ew-cache
7877           (load anything-c-yaoddmuse-cache-file)
7878           (setq anything-c-yaoddmuse-ew-cache
7879                 (gethash "EmacsWiki" yaoddmuse-pages-hash)))
7880         anything-c-yaoddmuse-ew-cache)
7881       (yaoddmuse-update-pagename t)
7882       (gethash "EmacsWiki" yaoddmuse-pages-hash)))
7883
7884 (defvar anything-c-source-yaoddmuse-emacswiki-edit-or-view
7885   '((name . "Yaoddmuse Edit or View (EmacsWiki)")
7886     (candidates . anything-yaoddmuse-get-candidates)
7887     (action . (("Edit page" . (lambda (candidate)
7888                                 (yaoddmuse-edit "EmacsWiki" candidate)))
7889                ("Browse page"
7890                 . (lambda (candidate)
7891                     (yaoddmuse-browse-page "EmacsWiki" candidate)))
7892                ("Browse page other window"
7893                 . (lambda (candidate)
7894                     (if (one-window-p)
7895                         (split-window-vertically))
7896                     (yaoddmuse-browse-page "EmacsWiki" candidate)))
7897                ("Browse diff"
7898                 . (lambda (candidate)
7899                     (yaoddmuse-browse-page-diff "EmacsWiki" candidate)))
7900                ("Copy URL"
7901                 . (lambda (candidate)
7902                     (kill-new (yaoddmuse-url "EmacsWiki" candidate))
7903                     (message "Have copy page %s's URL to yank." candidate)))
7904                ("Create page"
7905                 . (lambda (candidate)
7906                     (yaoddmuse-edit "EmacsWiki" anything-input)))
7907                ("Update cache"
7908                 . (lambda (candidate)
7909                     (if anything-yaoddmuse-use-cache-file
7910                         (progn
7911                           (anything-yaoddmuse-cache-pages t)
7912                           (setq anything-c-yaoddmuse-ew-cache
7913                                 (gethash "EmacsWiki" yaoddmuse-pages-hash)))
7914                         (yaoddmuse-update-pagename))))))
7915     (action-transformer anything-c-yaoddmuse-action-transformer))
7916   "Needs yaoddmuse.el.
7917
7918 http://www.emacswiki.org/emacs/download/yaoddmuse.el")
7919
7920
7921 (defvar anything-c-source-yaoddmuse-emacswiki-post-library
7922   '((name . "Yaoddmuse Post library (EmacsWiki)")
7923     (init . (anything-yaoddmuse-init))
7924     (candidates-in-buffer)
7925     (action . (("Post library and Browse"
7926                 . (lambda (candidate)
7927                     (yaoddmuse-post-file
7928                      (find-library-name candidate)
7929                      "EmacsWiki"
7930                      (file-name-nondirectory (find-library-name candidate))
7931                      nil t)))
7932                ("Post library"
7933                 . (lambda (candidate)
7934                     (yaoddmuse-post-file
7935                      (find-library-name candidate)
7936                      "EmacsWiki"
7937                      (file-name-nondirectory
7938                       (find-library-name candidate))))))))
7939   "Needs yaoddmuse.el.
7940
7941 http://www.emacswiki.org/emacs/download/yaoddmuse.el")
7942
7943
7944 (defun anything-c-yaoddmuse-action-transformer (actions candidate)
7945   "Allow the use of `install-elisp' only on elisp files."
7946   (if (string-match "\.el$" candidate)
7947       (append actions '(("Install Elisp"
7948                          . (lambda (elm)
7949                              (install-elisp-from-emacswiki elm)))))
7950       actions))
7951
7952 ;;;###autoload
7953 (defun anything-yaoddmuse-cache-pages (&optional load)
7954   "Fetch the list of files on emacswiki and create cache file.
7955 If load is non--nil load the file and feed `yaoddmuse-pages-hash'."
7956   (interactive)
7957   (declare (special yaoddmuse-pages-hash))
7958   (yaoddmuse-update-pagename)
7959   (save-excursion
7960     (find-file anything-c-yaoddmuse-cache-file)
7961     (erase-buffer)
7962     (insert "(puthash \"EmacsWiki\" '(")
7963     (loop for i in (gethash "EmacsWiki" yaoddmuse-pages-hash)
7964           do
7965           (insert (concat "(\"" (car i) "\") ")))
7966     (insert ") yaoddmuse-pages-hash)\n")
7967     (save-buffer)
7968     (kill-buffer (current-buffer))
7969     (when (or current-prefix-arg
7970               load)
7971       (load anything-c-yaoddmuse-cache-file))))
7972
7973 (defun anything-yaoddmuse-init ()
7974   "Init anything buffer status."
7975   (let ((anything-buffer (anything-candidate-buffer 'global))
7976         (library-list (yaoddmuse-get-library-list)))
7977     (with-current-buffer anything-buffer
7978       ;; Insert library name.
7979       (dolist (library library-list)
7980         (insert (format "%s\n" library)))
7981       ;; Sort lines.
7982       (sort-lines nil (point-min) (point-max)))))
7983
7984 \f
7985 ;;; Eev anchors
7986 (defvar anything-c-source-eev-anchor
7987   '((name . "Anchors")
7988     (candidates
7989      . (lambda ()
7990          (ignore-errors
7991            (with-anything-current-buffer
7992              (loop initially (goto-char (point-min))
7993                    while (re-search-forward
7994                           (format ee-anchor-format "\\([^\.].+\\)") nil t)
7995                    for anchor = (match-string-no-properties 1)
7996                    collect (cons (format "%5d:%s"
7997                                          (line-number-at-pos (match-beginning 0))
7998                                          (format ee-anchor-format anchor))
7999                                  anchor))))))
8000     (persistent-action . (lambda (item)
8001                            (ee-to item)
8002                            (anything-match-line-color-current-line)))
8003     (migemo)
8004     (persistent-help . "Show this entry")
8005     (action . (("Goto link" . ee-to)))))
8006
8007 \f
8008 ;;; Org headlines
8009 ;;
8010 ;;
8011 (defvar anything-c-source-org-headline
8012   `((name . "Org HeadLine")
8013     (headline
8014      ,@(mapcar
8015         (lambda (num)
8016           (format "^\\*\\{%d\\} \\(.+?\\)\\([ \t]*:[a-zA-Z0-9_@:]+:\\)?[ \t]*$"
8017                   num))
8018         (number-sequence 1 8)))
8019     (condition . (eq major-mode 'org-mode))
8020     (migemo)
8021     (subexp . 1)
8022     (persistent-action . (lambda (elm)
8023                            (anything-c-action-line-goto elm)
8024                            (org-cycle)))
8025     (action-transformer
8026      . (lambda (actions candidate)
8027          '(("Go to Line" . anything-c-action-line-goto)
8028            ("Refile to this Headline" . anything-c-org-headline-refile)
8029            ("Insert Link to This Headline"
8030             . anything-c-org-headline-insert-link-to-headline)))))
8031   "Show Org headlines.
8032 org-mode is very very much extended text-mode/outline-mode.
8033
8034 See (find-library \"org.el\")
8035 See http://orgmode.org for the latest version.")
8036
8037 (defun anything-c-org-headline-insert-link-to-headline (lineno-and-content)
8038   (insert
8039    (save-excursion
8040      (anything-goto-line (car lineno-and-content))
8041      (and (looking-at org-complex-heading-regexp)
8042           (org-make-link-string (concat "*" (match-string 4)))))))
8043
8044 (defun anything-c-org-headline-refile (lineno-and-content)
8045   "Refile current org entry to LINENO-AND-CONTENT."
8046   (with-anything-current-buffer
8047     (org-cut-subtree)
8048     (anything-goto-line (car lineno-and-content))
8049     (org-end-of-subtree t t)
8050     (let ((org-yank-adjusted-subtrees t))
8051       (org-yank))))
8052
8053
8054 ;;; Org keywords
8055 ;;
8056 ;;
8057 (defvar anything-c-source-org-keywords
8058   '((name . "Org Keywords")
8059     (init . anything-c-org-keywords-init)
8060     (candidates . anything-c-org-keywords-candidates)
8061     (action . anything-c-org-keywords-insert)
8062     (persistent-action . anything-c-org-keywords-show-help)
8063     (persistent-help . "Show an example and info page to describe this keyword.")
8064     (keywords-examples)
8065     (keywords)))
8066
8067 (defvar anything-c-org-keywords-info-location
8068   '(("#+TITLE:" . "(org)Export options")
8069     ("#+AUTHOR:" . "(org)Export options")
8070     ("#+DATE:" . "(org)Export options")
8071     ("#+EMAIL:" . "(org)Export options")
8072     ("#+DESCRIPTION:" . "(org)Export options")
8073     ("#+KEYWORDS:" . "(org)Export options")
8074     ("#+LANGUAGE:" . "(org)Export options")
8075     ("#+TEXT:" . "(org)Export options")
8076     ("#+TEXT:" . "(org)Export options")
8077     ("#+OPTIONS:" . "(org)Export options")
8078     ("#+BIND:" . "(org)Export options")
8079     ("#+LINK_UP:" . "(org)Export options")
8080     ("#+LINK_HOME:" . "(org)Export options")
8081     ("#+LATEX_HEADER:" . "(org)Export options")
8082     ("#+EXPORT_SELECT_TAGS:" . "(org)Export options")
8083     ("#+EXPORT_EXCLUDE_TAGS:" . "(org)Export options")
8084     ("#+INFOJS_OPT" . "(org)Javascript support")
8085     ("#+BEGIN_HTML" . "(org)Quoting HTML tags")
8086     ("#+BEGIN_LaTeX" . "(org)Quoting LaTeX code")
8087     ("#+ORGTBL" . "(org)Radio tables")
8088     ("#+HTML:" . "(org)Quoting HTML tags")
8089     ("#+LaTeX:" . "(org)Quoting LaTeX code")
8090     ("#+BEGIN:" . "(org)Dynamic blocks") ;clocktable columnview
8091     ("#+BEGIN_EXAMPLE" . "(org)Literal examples")
8092     ("#+BEGIN_QUOTE" . "(org)Paragraphs")
8093     ("#+BEGIN_VERSE" . "(org)Paragraphs")
8094     ("#+BEGIN_SRC" . "(org)Literal examples")
8095     ("#+CAPTION" . "(org)Tables in HTML export")
8096     ("#+LABEL" . "(org)Tables in LaTeX export")
8097     ("#+ATTR_HTML" . "(org)Links")
8098     ("#+ATTR_LaTeX" . "(org)Images in LaTeX export")))
8099
8100 (defun anything-c-org-keywords-init ()
8101   (unless (anything-attr 'keywords-examples)
8102     (require 'org)
8103     (anything-attrset 'keywords-examples
8104                       (append
8105                        (mapcar
8106                         (lambda (x)
8107                           (string-match "^#\\+\\(\\([A-Z_]+:?\\).*\\)" x)
8108                           (cons (match-string 2 x) (match-string 1 x)))
8109                         (org-split-string (org-get-current-options) "\n"))
8110                        (mapcar 'list org-additional-option-like-keywords)))
8111     (anything-attrset 'keywords (mapcar 'car (anything-attr 'keywords-examples)))))
8112
8113 (defun anything-c-org-keywords-candidates ()
8114   (and (or (eq (buffer-local-value 'major-mode anything-current-buffer) 'org-mode)
8115            (eq (buffer-local-value 'major-mode anything-current-buffer) 'message-mode))
8116        (anything-attr 'keywords)))
8117
8118 (defun anything-c-org-keywords-insert (keyword)
8119   (cond ((and (string-match "BEGIN" keyword)
8120               (anything-region-active-p))
8121          (let ((beg (region-beginning))
8122                (end (region-end)))
8123            (goto-char end)
8124            (insert "\n#+" (replace-regexp-in-string
8125                            "BEGIN" "END" keyword) "\n")
8126            (goto-char beg)
8127            (insert "#+" keyword " ")
8128            (save-excursion (insert "\n"))))
8129         ((string-match "BEGIN" keyword)
8130          (insert "#+" keyword " ")
8131          (save-excursion
8132            (insert "\n#+" (replace-regexp-in-string
8133                            "BEGIN" "END" keyword) "\n")))
8134         (t (insert "#+" keyword " "))))
8135
8136 (defun anything-c-org-keywords-show-help (keyword)
8137   (info (or (assoc-default (concat "#+" keyword) anything-c-org-keywords-info-location)
8138             "(org)In-buffer settings"))
8139   (search-forward (concat "#+" keyword) nil t)
8140   (anything-persistent-highlight-point)
8141   (message "%s" (or (cdr (assoc keyword (anything-attr 'keywords-examples))) "")))
8142
8143
8144 \f
8145 ;;; bbdb
8146 ;;
8147 ;;
8148 (defvar bbdb-records)
8149 (defvar bbdb-buffer-name)
8150
8151 (defun anything-c-bbdb-candidates ()
8152   "Return a list of all names in the bbdb database.  The format
8153 is \"Firstname Lastname\"."
8154   (mapcar (lambda (bbdb-record)
8155             (replace-regexp-in-string
8156              "\\s-+$" ""
8157              (concat (aref bbdb-record 0) " " (aref bbdb-record 1))))
8158           (bbdb-records)))
8159
8160 (defun anything-c-bbdb-create-contact (actions candidate)
8161   "Action transformer that returns only an entry to add the
8162 current `anything-pattern' as new contact.  All other actions are
8163 removed."
8164   (if (string= candidate "*Add to contacts*")
8165       '(("Add to contacts" . (lambda (actions)
8166                                (bbdb-create-internal
8167                                 (read-from-minibuffer "Name: " anything-c-bbdb-name)
8168                                 (read-from-minibuffer "Company: ")
8169                                 (read-from-minibuffer "Email: ")
8170                                 nil
8171                                 nil
8172                                 (read-from-minibuffer "Note: ")))))
8173       actions))
8174
8175 (defun anything-c-bbdb-get-record (candidate)
8176   "Return record that match CANDIDATE."
8177   (bbdb candidate nil)
8178   (set-buffer "*BBDB*")
8179   (bbdb-current-record))
8180
8181 (defvar anything-c-bbdb-name nil
8182   "Only for internal use.")
8183
8184 (defvar anything-c-source-bbdb
8185   '((name . "BBDB")
8186     (candidates . anything-c-bbdb-candidates)
8187     (action ("Send a mail" . anything-c-bbdb-compose-mail)
8188      ("View person's data" . anything-c-bbdb-view-person-action))
8189     (filtered-candidate-transformer . (lambda (candidates source)
8190                                         (setq anything-c-bbdb-name anything-pattern)
8191                                         (if (not candidates)
8192                                             (list "*Add to contacts*")
8193                                             candidates)))
8194     (action-transformer . (lambda (actions candidate)
8195                             (anything-c-bbdb-create-contact actions candidate))))
8196   "Needs BBDB.
8197
8198 http://bbdb.sourceforge.net/")
8199
8200 (defun anything-c-bbdb-view-person-action (candidate)
8201   "View BBDB data of single CANDIDATE or marked candidates."
8202   (anything-aif (anything-marked-candidates)
8203       (let ((bbdb-append-records (length it)))
8204         (dolist (i it)
8205           (bbdb-redisplay-one-record (anything-c-bbdb-get-record i))))
8206     (bbdb-redisplay-one-record (anything-c-bbdb-get-record candidate))))
8207
8208 (defun anything-c-bbdb-collect-mail-addresses ()
8209   "Return a list of all mail addresses of records in bbdb buffer."
8210   (with-current-buffer bbdb-buffer-name
8211     (loop for i in bbdb-records
8212           if (bbdb-record-net (car i))
8213           collect (bbdb-dwim-net-address (car i)))))
8214
8215 (defun anything-c-bbdb-compose-mail (candidate)
8216   "Compose a mail with all records of bbdb buffer."
8217   (anything-c-bbdb-view-person-action candidate)
8218   (let* ((address-list (anything-c-bbdb-collect-mail-addresses))
8219          (address-str  (mapconcat 'identity address-list ",\n    ")))
8220     (compose-mail address-str)))
8221
8222 \f
8223 ;;; Evaluation Result
8224 ;;
8225 ;;
8226 ;; Internal
8227 (defvar anything-eldoc-active-minibuffers-list nil)
8228 (defvar anything-eval-expression-input-history nil)
8229
8230 (defvar anything-c-source-evaluation-result
8231   '((name . "Evaluation Result")
8232     (disable-shortcuts)
8233     (dummy)
8234     (multiline)
8235     (mode-line . "C-RET: nl-and-indent, tab: reindent, C-tab:complete, C-p/n: next/prec-line.")
8236     (filtered-candidate-transformer . (lambda (candidates source)
8237                                         (list
8238                                          (condition-case nil
8239                                              (with-anything-current-buffer
8240                                                (pp-to-string
8241                                                 (eval (read anything-pattern))))
8242                                            (error "Error")))))
8243     (action . (("Copy result to kill-ring" . (lambda (candidate)
8244                                                (with-current-buffer anything-buffer
8245                                                  (let ((end (save-excursion
8246                                                               (goto-char (point-max))
8247                                                               (search-backward "\n")
8248                                                               (point))))
8249                                                    (kill-region (point) end)))))
8250                ("copy sexp to kill-ring" . (lambda (candidate)
8251                                              (kill-new anything-input)))))))
8252
8253 (defun anything-eval-new-line-and-indent ()
8254   (interactive)
8255   (newline) (lisp-indent-line))
8256
8257 (defun anything-eldoc-store-minibuffer ()
8258   "Store minibuffer buffer name in `anything-eldoc-active-minibuffers-list'."
8259   (with-selected-window (minibuffer-window)
8260     (push (buffer-name) anything-eldoc-active-minibuffers-list)))
8261
8262 (defun anything-eldoc-show-in-eval ()
8263   "Return eldoc in mode-line for current minibuffer input."
8264   (let ((buf (with-selected-window (minibuffer-window)
8265                (buffer-name))))
8266     (when (member buf anything-eldoc-active-minibuffers-list)
8267       (let* ((str-all (with-current-buffer buf
8268                         (minibuffer-completion-contents)))
8269              (sym     (when str-all
8270                         (with-temp-buffer
8271                           (insert str-all)
8272                           (goto-char (point-max))
8273                           (unless (looking-back ")\\|\"") (forward-char -1))
8274                           (eldoc-current-symbol))))
8275              (info-fn (eldoc-fnsym-in-current-sexp))
8276              (doc     (or (eldoc-get-var-docstring sym)
8277                           (eldoc-get-fnsym-args-string
8278                            (car info-fn) (cadr info-fn)))))
8279         (when doc (funcall anything-c-eldoc-in-minibuffer-show-fn doc))))))
8280
8281 (defun anything-c-show-info-in-mode-line (str)
8282   "Display string STR in mode-line."
8283   (save-selected-window
8284     (with-current-buffer anything-buffer
8285       (let ((mode-line-format (concat " " str)))
8286         (force-mode-line-update)
8287         (sit-for anything-c-show-info-in-mode-line-delay))
8288       (force-mode-line-update))))
8289
8290 ;;; Calculation Result
8291 ;;
8292 ;;
8293 (defvar anything-c-source-calculation-result
8294   '((name . "Calculation Result")
8295     (dummy)
8296     (filtered-candidate-transformer . (lambda (candidates source)
8297                                         (list
8298                                          (condition-case nil
8299                                              (calc-eval anything-pattern)
8300                                            (error "error")))))
8301     (action ("Copy result to kill-ring" . kill-new))))
8302
8303 \f
8304 ;;; Google Suggestions
8305 ;;
8306 ;;
8307 ;; Internal
8308 (defvar anything-ggs-max-length-real-flag 0)
8309 (defvar anything-ggs-max-length-num-flag 0)
8310
8311 (defun anything-c-google-suggest-fetch (input)
8312   "Fetch suggestions for INPUT from XML buffer.
8313 Return an alist with elements like (data . number_results)."
8314   (setq anything-ggs-max-length-real-flag 0
8315         anything-ggs-max-length-num-flag 0)
8316   (let ((request (concat anything-c-google-suggest-url
8317                          (url-hexify-string input))))
8318     (flet ((fetch ()
8319              (loop
8320                    with result-alist = (xml-get-children
8321                                         (car (xml-parse-region
8322                                               (point-min) (point-max)))
8323                                         'CompleteSuggestion)
8324                    for i in result-alist
8325                    for data = (cdr (caadr (assoc 'suggestion i)))
8326                    for nqueries = (cdr (caadr (assoc 'num_queries i)))
8327                    for lqueries = (length (anything-c-ggs-set-number-result
8328                                            nqueries))
8329                    for ldata = (length data)
8330                    do
8331                    (progn
8332                      (when (> ldata anything-ggs-max-length-real-flag)
8333                        (setq anything-ggs-max-length-real-flag ldata))
8334                      (when (> lqueries anything-ggs-max-length-num-flag)
8335                        (setq anything-ggs-max-length-num-flag lqueries)))
8336                    collect (cons data nqueries) into cont
8337                    finally return cont)))
8338       (if anything-google-suggest-use-curl-p
8339           (with-temp-buffer
8340             (call-process "curl" nil t nil request)
8341             (fetch))
8342           (with-current-buffer
8343               (url-retrieve-synchronously request)
8344             (fetch))))))
8345
8346 (defun anything-c-google-suggest-set-candidates (&optional request-prefix)
8347   "Set candidates with result and number of google results found."
8348   (let ((suggestions
8349          (loop with suggested-results = (anything-c-google-suggest-fetch
8350                                          (or (and request-prefix
8351                                                   (concat request-prefix
8352                                                           " " anything-pattern))
8353                                              anything-pattern))
8354                for (real . numresult) in suggested-results
8355                ;; Prepare number of results with ","
8356                for fnumresult = (anything-c-ggs-set-number-result numresult)
8357                ;; Calculate number of spaces to add before fnumresult
8358                ;; if it is smaller than longest result
8359                ;; `anything-ggs-max-length-num-flag'.
8360                ;; e.g 1,234,567
8361                ;;       345,678
8362                ;; To be sure it is aligned properly.
8363                for nspaces = (if (< (length fnumresult)
8364                                     anything-ggs-max-length-num-flag)
8365                                  (- anything-ggs-max-length-num-flag
8366                                     (length fnumresult))
8367                                  0)
8368                ;; Add now the spaces before fnumresult.
8369                for align-fnumresult = (concat (make-string nspaces ? )
8370                                               fnumresult)
8371                for interval = (- anything-ggs-max-length-real-flag
8372                                  (length real))
8373                for spaces   = (make-string (+ 2 interval) ? )
8374                for display = (format "%s%s(%s results)"
8375                                      real spaces align-fnumresult)
8376                collect (cons display real))))
8377     (if (loop for (disp . dat) in suggestions
8378               thereis (equal dat anything-pattern))
8379         suggestions
8380         ;; if there is no suggestion exactly matching the input then
8381         ;; prepend a Search on Google item to the list
8382         (append
8383          suggestions
8384          (list (cons (concat "Search for " "'" anything-input "'" " on Google")
8385                      anything-input))))))
8386
8387 (defun anything-c-ggs-set-number-result (num)
8388   (if num
8389       (progn
8390         (and (numberp num) (setq num (number-to-string num)))
8391         (loop for i in (reverse (split-string num "" t))
8392               for count from 1
8393               append (list i) into C
8394               when (= count 3)
8395               append (list ",") into C
8396               and do (setq count 0)
8397               finally return
8398               (replace-regexp-in-string
8399                "^," "" (mapconcat 'identity (reverse C) ""))))
8400       "?"))
8401
8402 (defvar anything-c-google-suggest-default-browser-function nil
8403   "*The browse url function you prefer to use with google suggest.
8404 When nil, use the first browser function available
8405 See `anything-browse-url-default-browser-alist'.")
8406
8407 (defun anything-c-google-suggest-action (candidate)
8408   "Default action to jump to a google suggested candidate."
8409   (let ((arg (concat anything-c-google-suggest-search-url
8410                      (url-hexify-string candidate))))
8411     (anything-aif anything-c-google-suggest-default-browser-function
8412         (funcall it arg)
8413       (anything-c-browse-url arg))))
8414
8415 (defvar anything-c-google-suggest-default-function
8416   'anything-c-google-suggest-set-candidates
8417   "Default function to use in anything google suggest.")
8418
8419 (defvar anything-c-source-google-suggest
8420   '((name . "Google Suggest")
8421     (candidates . (lambda ()
8422                     (funcall anything-c-google-suggest-default-function)))
8423     (action . (("Google Search" . anything-c-google-suggest-action)))
8424     (volatile)
8425     (requires-pattern . 3)
8426     (delayed)))
8427
8428 (defun anything-c-google-suggest-emacs-lisp ()
8429   "Try to emacs lisp complete with google suggestions."
8430   (anything-c-google-suggest-set-candidates "emacs lisp"))
8431
8432
8433 ;;; Yahoo suggestions
8434 ;;
8435 ;;
8436 (defun anything-c-yahoo-suggest-fetch (input)
8437   "Fetch Yahoo suggestions for INPUT from XML buffer.
8438 Return an alist with elements like (data . number_results)."
8439   (let ((request (concat anything-c-yahoo-suggest-url
8440                          (url-hexify-string input))))
8441     (flet ((fetch ()
8442              (loop
8443                    with result-alist = (xml-get-children
8444                                         (car (xml-parse-region
8445                                               (point-min) (point-max)))
8446                                         'Result)
8447                    for i in result-alist
8448                    collect (caddr i))))
8449       (with-current-buffer
8450           (url-retrieve-synchronously request)
8451         (fetch)))))
8452
8453 (defun anything-c-yahoo-suggest-set-candidates ()
8454   "Set candidates with Yahoo results found."
8455   (let ((suggestions (anything-c-yahoo-suggest-fetch anything-input)))
8456     (or suggestions
8457         (append
8458          suggestions
8459          (list (cons (concat "Search for " "'" anything-input "'" " on Yahoo")
8460                      anything-input))))))
8461
8462 (defun anything-c-yahoo-suggest-action (candidate)
8463   "Default action to jump to a Yahoo suggested candidate."
8464   (anything-c-browse-url (concat anything-c-yahoo-suggest-search-url
8465                                  (url-hexify-string candidate))))
8466
8467 (defvar anything-c-source-yahoo-suggest
8468   '((name . "Yahoo Suggest")
8469     (candidates . anything-c-yahoo-suggest-set-candidates)
8470     (action . (("Yahoo Search" . anything-c-yahoo-suggest-action)))
8471     (volatile)
8472     (requires-pattern . 3)
8473     (delayed)))
8474
8475
8476 \f
8477 ;;; Web browser functions.
8478 ;;
8479 ;;
8480 (require 'browse-url)
8481 ;; If default setting of `w3m-command' is not
8482 ;; what you want you and you modify it, you will have to reeval
8483 ;; also `anything-browse-url-default-browser-alist'.
8484 (defvar w3m-command "/usr/bin/w3m")
8485 (defvar anything-c-home-url "http://www.google.fr"
8486   "*Default url to use as home url.")
8487
8488 (defvar ac-browse-url-chromium-program "chromium-browser")
8489 (defvar ac-browse-url-uzbl-program "uzbl-browser")
8490 (defvar anything-browse-url-default-browser-alist
8491   `((,w3m-command . w3m-browse-url)
8492     (,browse-url-firefox-program . browse-url-firefox)
8493     (,ac-browse-url-chromium-program . ac-browse-url-chromium)
8494     (,ac-browse-url-uzbl-program . ac-browse-url-uzbl)
8495     (,browse-url-kde-program . browse-url-kde)
8496     (,browse-url-gnome-moz-program . browse-url-gnome-moz)
8497     (,browse-url-mozilla-program . browse-url-mozilla)
8498     (,browse-url-galeon-program . browse-url-galeon)
8499     (,browse-url-netscape-program . browse-url-netscape)
8500     (,browse-url-mosaic-program . browse-url-mosaic)
8501     (,browse-url-xterm-program . browse-url-text-xterm))
8502   "*Alist of \(executable . function\) to try to find a suitable url browser.")
8503
8504 (defun* anything-c-generic-browser (url name &rest args)
8505   "Browse URL with NAME browser."
8506   (let ((proc (concat name " " url)))
8507     (message "Starting %s..." name)
8508     (apply 'start-process proc nil name
8509            (append args (list url)))
8510     (set-process-sentinel
8511      (get-process proc)
8512      #'(lambda (process event)
8513          (when (string= event "finished\n")
8514            (message "%s process %s" process event))))))
8515
8516 (defun ac-browse-url-chromium (url)
8517   "Browse URL with google chrome browser."
8518   (interactive "sURL: ")
8519   (anything-c-generic-browser
8520    url ac-browse-url-chromium-program))
8521
8522 (defun ac-browse-url-uzbl (url &optional ignore)
8523   "Browse URL with uzbl browser."
8524   (interactive "sURL: ")
8525   (anything-c-generic-browser url ac-browse-url-uzbl-program "-u"))
8526
8527 (defun anything-browse-url-default-browser (url &rest args)
8528   "Find the first available browser and ask it to load URL."
8529   (let ((default-browser-fn
8530          (loop for (exe . fn) in anything-browse-url-default-browser-alist
8531                thereis (and exe (executable-find exe) fn))))
8532     (if default-browser-fn
8533         (apply default-browser-fn url args)
8534         (error "No usable browser found"))))
8535
8536 (defun anything-c-browse-url (url &rest args)
8537   "Default command to browse URL."
8538   (if browse-url-browser-function
8539       (browse-url url args)
8540       (anything-browse-url-default-browser url args)))
8541
8542 \f
8543 ;;; Surfraw
8544 ;;
8545 ;; Need external program surfraw.
8546 ;; <http://surfraw.alioth.debian.org/>
8547
8548 (defvar anything-surfraw-default-browser-function nil
8549   "*The browse url function you prefer to use with surfraw.
8550 When nil, fallback to `browse-url-browser-function'.")
8551
8552 ;; Internal
8553 (defvar anything-surfraw-engines-history nil)
8554 (defvar anything-surfraw-input-history nil)
8555
8556 (defun anything-c-build-elvi-list ()
8557   "Return list of all engines and descriptions handled by surfraw."
8558   (cdr
8559    (with-temp-buffer
8560      (call-process "surfraw" nil t nil
8561                    "-elvi")
8562      (split-string (buffer-string) "\n"))))
8563
8564 \f
8565 ;;; Emms
8566 ;;
8567 ;;
8568 (defun anything-emms-stream-edit-bookmark (elm)
8569   "Change the information of current emms-stream bookmark from anything."
8570   (declare (special emms-stream-list))
8571   (let* ((cur-buf anything-current-buffer)
8572          (bookmark (assoc elm emms-stream-list))
8573          (name     (read-from-minibuffer "Description: "
8574                                          (nth 0 bookmark)))
8575          (url      (read-from-minibuffer "URL: "
8576                                          (nth 1 bookmark)))
8577          (fd       (read-from-minibuffer "Feed Descriptor: "
8578                                          (int-to-string (nth 2 bookmark))))
8579          (type     (read-from-minibuffer "Type (url, streamlist, or lastfm): "
8580                                          (format "%s" (car (last bookmark))))))
8581     (save-window-excursion
8582       (emms-streams)
8583       (when (re-search-forward (concat "^" name) nil t)
8584         (beginning-of-line)
8585         (emms-stream-delete-bookmark)
8586         (emms-stream-add-bookmark name url (string-to-number fd) type)
8587         (emms-stream-save-bookmarks-file)
8588         (emms-stream-quit)
8589         (anything-c-switch-to-buffer cur-buf)))))
8590
8591 (defun anything-emms-stream-delete-bookmark (candidate)
8592   "Delete emms-streams bookmarks from anything."
8593   (let* ((cands   (anything-marked-candidates))
8594          (bmks    (loop for bm in cands collect
8595                         (car (assoc bm emms-stream-list))))
8596          (bmk-reg (mapconcat 'regexp-quote bmks "\\|^")))
8597     (when (y-or-n-p (format "Really delete radios\n -%s: ? "
8598                             (mapconcat 'identity bmks "\n -")))
8599       (save-window-excursion
8600         (emms-streams)
8601         (goto-char (point-min))
8602         (loop while (re-search-forward bmk-reg nil t)
8603               do (progn (beginning-of-line)
8604                         (emms-stream-delete-bookmark))
8605               finally do (progn
8606                            (emms-stream-save-bookmarks-file)
8607                            (emms-stream-quit)))))))
8608
8609 (defvar anything-c-source-emms-streams
8610   '((name . "Emms Streams")
8611     (init . (lambda ()
8612               (emms-stream-init)))
8613     (candidates . (lambda ()
8614                     (declare (special emms-stream-list))
8615                     (mapcar 'car emms-stream-list)))
8616     (action . (("Play" . (lambda (elm)
8617                            (declare (special emms-stream-list))
8618                            (let* ((stream (assoc elm emms-stream-list))
8619                                   (fn (intern (concat "emms-play-" (symbol-name (car (last stream))))))
8620                                   (url (second stream)))
8621                              (funcall fn url))))
8622                ("Delete" . anything-emms-stream-delete-bookmark)
8623                ("Edit" . anything-emms-stream-edit-bookmark)))
8624     (filtered-candidate-transformer . anything-c-adaptive-sort)))
8625
8626 ;; Don't forget to set `emms-source-file-default-directory'
8627 (defvar anything-c-source-emms-dired
8628   '((name . "Music Directory")
8629     (candidates . (lambda ()
8630                     (cddr (directory-files emms-source-file-default-directory))))
8631     (action .
8632      (("Play Directory" . (lambda (item)
8633                             (emms-play-directory
8634                              (expand-file-name
8635                               item
8636                               emms-source-file-default-directory))))
8637       ("Open dired in file's directory" . (lambda (item)
8638                                             (anything-c-open-dired
8639                                              (expand-file-name
8640                                               item
8641                                               emms-source-file-default-directory))))))
8642     (filtered-candidate-transformer . anything-c-adaptive-sort)))
8643
8644
8645 (defun anything-c-emms-files-modifier (candidates source)
8646   (let ((current-playlist (with-current-emms-playlist
8647                               (loop with cur-list = (emms-playlist-tracks-in-region
8648                                                      (point-min) (point-max))
8649                                     for i in cur-list
8650                                     for name = (assoc-default 'name i)
8651                                     when name
8652                                     collect name))))
8653     (loop for i in candidates
8654           if (member (cdr i) current-playlist)
8655           collect (cons (propertize (car i)
8656                                     'face 'anything-emms-playlist)
8657                         (cdr i)) into lis
8658           else collect i into lis
8659           finally return (reverse lis))))
8660
8661 (defun anything-c-emms-play-current-playlist ()
8662   "Play current playlist."
8663   (with-current-emms-playlist
8664       (emms-playlist-first)
8665     (emms-playlist-mode-play-smart)))
8666
8667 (defvar anything-c-source-emms-files
8668   '((name . "Emms files")
8669     (candidates . (lambda ()
8670                     (loop for v being the hash-values in emms-cache-db
8671                           for name      = (assoc-default 'name v)
8672                           for artist    = (or (assoc-default 'info-artist v) "unknown")
8673                           for genre     = (or (assoc-default 'info-genre v) "unknown")
8674                           for tracknum  = (or (assoc-default 'info-tracknumber v) "unknown")
8675                           for song      = (or (assoc-default 'info-title v) "unknown")
8676                           for info      = (concat artist " - " genre " - " tracknum ": " song)
8677                           unless (string-match "^\\(http\\|mms\\):" name)
8678                           collect (cons info name))))
8679     (filtered-candidate-transformer . anything-c-emms-files-modifier)
8680     (candidate-number-limit . 9999)
8681     (action . (("Play file" . emms-play-file)
8682                ("Add to Playlist and play (C-u clear current)"
8683                 . (lambda (candidate)
8684                     (when anything-current-prefix-arg
8685                       (emms-playlist-current-clear))
8686                     (emms-playlist-new)
8687                     (mapc 'emms-add-playlist-file (anything-marked-candidates))
8688                     (unless emms-player-playing-p
8689                       (anything-c-emms-play-current-playlist))))))))
8690
8691
8692 \f
8693 ;;; Jabber Contacts (jabber.el)
8694 (defun anything-c-jabber-online-contacts ()
8695   "List online Jabber contacts."
8696   (with-no-warnings
8697     (let (jids)
8698       (dolist (item (jabber-concat-rosters) jids)
8699         (when (get item 'connected)
8700           (push (if (get item 'name)
8701                     (cons (get item 'name) item)
8702                     (cons (symbol-name item) item)) jids))))))
8703
8704 (defvar anything-c-source-jabber-contacts
8705   '((name . "Jabber Contacts")
8706     (init . (lambda () (require 'jabber)))
8707     (candidates . (lambda () (mapcar 'car (anything-c-jabber-online-contacts))))
8708     (action . (lambda (x)
8709                 (jabber-chat-with
8710                  (jabber-read-account)
8711                  (symbol-name
8712                   (cdr (assoc x (anything-c-jabber-online-contacts)))))))))
8713
8714
8715 \f
8716 ;;; Call source.
8717 (defvar anything-source-select-buffer "*anything source select*")
8718 (defvar anything-c-source-call-source
8719   `((name . "Call anything source")
8720     (candidate-number-limit)
8721     (candidates
8722      . (lambda ()
8723          (loop for vname in (all-completions "anything-c-source-" obarray)
8724                for var = (intern vname)
8725                for name = (ignore-errors (assoc-default 'name (symbol-value var)))
8726                if name collect
8727                (cons (format "%s `%s'"
8728                              name (propertize vname 'face 'font-lock-variable-name-face))
8729                      var))))
8730     (action
8731      . (("Invoke anything with selected source"
8732          .
8733          (lambda (candidate)
8734            (setq anything-candidate-number-limit 9999)
8735            (anything candidate nil nil nil nil
8736                      anything-source-select-buffer)))
8737         ("Describe variable" . describe-variable)
8738         ("Find variable" . find-variable)))
8739     (persistent-action . describe-variable)
8740     (persistent-help . "Show description of this source")))
8741
8742 (defun anything-call-source-from-anything ()
8743   "Call anything source within `anything' session."
8744   (interactive)
8745   (setq anything-input-idle-delay 0)
8746   (anything-set-sources '(anything-c-source-call-source)))
8747
8748 ;;; Execute Preconfigured anything.
8749 (defvar anything-c-source-anything-commands
8750   '((name . "Preconfigured Anything")
8751     (candidates . anything-c-anything-commands-candidates)
8752     (type . command)
8753     (candidate-number-limit)))
8754
8755 (defun anything-c-anything-commands-candidates ()
8756   (loop for (cmd . desc) in (anything-c-list-preconfigured-anything)
8757         collect (cons (if (where-is-internal cmd nil t)
8758                           (substitute-command-keys (format "M-x %s (\\[%s]) : %s" cmd cmd desc))
8759                           (substitute-command-keys (format "\\[%s] : %s" cmd desc)))
8760                       cmd)))
8761
8762 \f
8763 ;;; Occur
8764 ;;
8765 ;;
8766 (defun anything-c-occur-init ()
8767   "Create the initial anything occur buffer.
8768 If region is active use region as buffer contents
8769 instead of whole buffer."
8770   (with-current-buffer (anything-candidate-buffer 'global)
8771     (erase-buffer)
8772     (let ((buf-contents
8773            (with-anything-current-buffer
8774              (if (anything-region-active-p)
8775                  (buffer-substring (region-beginning) (region-end))
8776                  (buffer-substring (point-min) (point-max))))))
8777       (insert buf-contents))))
8778
8779 (defun anything-c-occur-get-line (s e)
8780   (format "%7d:%s" (line-number-at-pos (1- s)) (buffer-substring s e)))
8781
8782 (defun anything-c-occur-query-replace-regexp (candidate)
8783   "Query replace regexp starting from CANDIDATE.
8784 If region is active ignore CANDIDATE and replace only in region.
8785 With a prefix arg replace only matches surrounded by word boundaries,
8786 i.e Don't replace inside a word, regexp is surrounded with \\bregexp\\b."
8787   (let ((regexp anything-input))
8788     (unless (anything-region-active-p)
8789       (anything-c-action-line-goto candidate))
8790     (apply 'query-replace-regexp
8791            (anything-c-query-replace-args regexp))))
8792
8793 (defun anything-occur-run-query-replace-regexp ()
8794   "Run `query-replace-regexp' in anything occur from keymap."
8795   (interactive)
8796   (anything-c-quit-and-execute-action
8797    'anything-c-occur-query-replace-regexp))
8798
8799 (defvar anything-c-source-occur
8800   `((name . "Occur")
8801     (init . anything-c-occur-init)
8802     (candidates-in-buffer)
8803     (migemo)
8804     (get-line . anything-c-occur-get-line)
8805     (display-to-real . anything-c-display-to-real-line)
8806     (action . (("Go to Line" . anything-c-action-line-goto)
8807                ("Query replace regexp (C-u Not inside word.)"
8808                 . anything-c-occur-query-replace-regexp)))
8809     (recenter)
8810     (mode-line . anything-occur-mode-line)
8811     (keymap . ,anything-occur-map)
8812     (requires-pattern . 1)
8813     (delayed)))
8814
8815 \f
8816 ;;; Anything browse code.
8817 (defun anything-c-browse-code-get-line (beg end)
8818   "Select line if it match the regexp corresponding to current `major-mode'.
8819 Line is parsed for BEG position to END position."
8820   (let ((str-line (buffer-substring beg end))
8821         (regexp   (assoc-default major-mode
8822                                  anything-c-browse-code-regexp-alist))
8823         (num-line (if (string= anything-pattern "") beg (1- beg))))
8824     (when (and regexp (string-match regexp str-line))
8825       (format "%4d:%s" (line-number-at-pos num-line) str-line))))
8826
8827
8828 (defvar anything-c-source-browse-code
8829   '((name . "Browse code")
8830     (init . (lambda ()
8831               (anything-candidate-buffer anything-current-buffer)
8832               (with-anything-current-buffer
8833                 (jit-lock-fontify-now))))
8834     (candidate-number-limit . 9999)
8835     (candidates-in-buffer)
8836     (get-line . anything-c-browse-code-get-line)
8837     (type . line)
8838     (recenter)))
8839
8840 \f
8841 ;; Do many actions for input
8842 (defvar anything-c-source-create
8843   '((name . "Create")
8844     (dummy)
8845     (action)
8846     (action-transformer . anything-create--actions))
8847   "Do many create actions from `anything-pattern'.
8848 See also `anything-create--actions'.")
8849
8850 (defun anything-create-from-anything ()
8851   "Run `anything-create' from `anything' as a fallback."
8852   (interactive)
8853   (anything-run-after-quit 'anything-create nil anything-pattern))
8854
8855 (defun anything-create--actions (&rest ignored)
8856   "Default actions for `anything-create' / `anything-c-source-create'."
8857   (remove-if-not
8858    (lambda (pair) (and (consp pair) (functionp (cdr pair))))
8859    (append anything-create--actions-private
8860            '(("find-file" . find-file)
8861              ("find-file other window" . find-file-other-window)
8862              ("New buffer" . anything-c-switch-to-buffer)
8863              ("New buffer other window" . switch-to-buffer-other-window)
8864              ("Bookmark Set" . bookmark-set)
8865              ("Set Register" .
8866               (lambda (x) (set-register (read-char "Register: ") x)))
8867              ("Insert Linkd star" . linkd-insert-star)
8868              ("Insert Linkd Tag" . linkd-insert-tag)
8869              ("Insert Linkd Link" . linkd-insert-link)
8870              ("Insert Linkd Lisp" . linkd-insert-lisp)
8871              ("Insert Linkd Wiki" . linkd-insert-wiki)
8872              ("Google Search" . google)))))
8873
8874 \f
8875 ;; Minibuffer History
8876 ;;
8877 ;;
8878 (defvar anything-c-source-minibuffer-history
8879   '((name . "Minibuffer History")
8880     (header-name . (lambda (name)
8881                      (format "%s (%s)" name minibuffer-history-variable)))
8882     (candidates
8883      . (lambda ()
8884          (let ((history (loop for i in
8885                               (symbol-value minibuffer-history-variable)
8886                               unless (string= "" i) collect i)))
8887            (if (consp (car history))
8888                (mapcar 'prin1-to-string history)
8889                history))))
8890     (migemo)
8891     (action . (lambda (candidate)
8892                 (delete-minibuffer-contents)
8893                 (insert candidate)))))
8894
8895 \f
8896 ;;; Elscreen
8897 ;;
8898 ;;
8899 (defvar anything-c-source-elscreen
8900   '((name . "Elscreen")
8901     (candidates
8902      . (lambda ()
8903          (if (cdr (elscreen-get-screen-to-name-alist))
8904              (sort
8905               (loop for sname in (elscreen-get-screen-to-name-alist)
8906                     append (list (format "[%d] %s" (car sname) (cdr sname))))
8907               #'(lambda (a b) (compare-strings a nil nil b nil nil))))))
8908     (action
8909      . (("Change Screen" .
8910                          (lambda (candidate)
8911                            (elscreen-goto (- (aref candidate 1) (aref "0" 0)))))
8912         ("Kill Screen(s)" .
8913                           (lambda (candidate)
8914                             (dolist (i (anything-marked-candidates))
8915                               (elscreen-goto (- (aref i 1) (aref "0" 0)))
8916                               (elscreen-kill))))
8917         ("Only Screen" .
8918                        (lambda (candidate)
8919                          (elscreen-goto (- (aref candidate 1) (aref "0" 0)))
8920                          (elscreen-kill-others)))))))
8921
8922 \f
8923 ;;;; <System>
8924
8925 ;;; Top (process)
8926 (defvar anything-c-top-command "COLUMNS=%s top -b -n 1"
8927   "Top command (batch mode). %s is replaced with `frame-width'.")
8928 (defvar anything-c-source-top
8929   '((name . "Top (Press C-c C-u to refresh)")
8930     (init . anything-c-top-init)
8931     (candidates-in-buffer)
8932     (display-to-real . anything-c-top-display-to-real)
8933     (persistent-action . anything-c-top-sh-persistent-action)
8934     (persistent-help . "SIGTERM")
8935     (action
8936      ("kill (TERM)" . (lambda (pid)
8937                         (anything-c-top-sh (format "kill -TERM %s" pid))))
8938      ("kill (KILL)" . (lambda (pid)
8939                         (anything-c-top-sh (format "kill -KILL %s" pid))))
8940      ("Copy PID" . (lambda (pid) (kill-new pid))))))
8941
8942 (defun anything-c-top-sh (cmd)
8943   (message "Executed %s\n%s" cmd (shell-command-to-string cmd)))
8944
8945 (defun anything-c-top-sh-persistent-action (pid)
8946   (delete-other-windows)
8947   (anything-c-top-sh (format "kill -TERM %s" pid))
8948   (anything-force-update))
8949
8950 (defun anything-c-top-init ()
8951   (with-current-buffer (anything-candidate-buffer 'global)
8952     (call-process-shell-command
8953      (format anything-c-top-command
8954              (- (frame-width) (if anything-enable-digit-shortcuts 4 0)))
8955      nil (current-buffer))))
8956
8957 (defun anything-c-top-display-to-real (line)
8958   (car (split-string line)))
8959
8960 ;;; Timers
8961 (defvar anything-c-source-absolute-time-timers
8962   '((name . "Absolute Time Timers")
8963     (candidates . timer-list)
8964     (type . timer)))
8965
8966 (defvar anything-c-source-idle-time-timers
8967   '((name . "Idle Time Timers")
8968     (candidates . timer-idle-list)
8969     (type . timer)))
8970
8971 (defun anything-c-timer-real-to-display (timer)
8972   (destructuring-bind (triggered t1 t2 t3 repeat-delay func args idle-delay)
8973       (append timer nil)                ;use `append' to convert vector->list
8974     (format "%s repeat=%5S %s(%s)"
8975             (let ((time (list t1 t2 t3)))
8976               (if idle-delay
8977                   (format-time-string "idle-for=%5s" time)
8978                   (format-time-string "%m/%d %T" time)))
8979             repeat-delay
8980             func
8981             (mapconcat 'prin1-to-string args " "))))
8982
8983 ;;; X RandR resolution change
8984 ;;
8985 ;;
8986 ;;; FIXME I do not care multi-display.
8987
8988 (defun anything-c-xrandr-info ()
8989   "Return a pair with current X screen number and current X display name."
8990   (with-temp-buffer
8991     (call-process "xrandr" nil (current-buffer) nil
8992                   "--current")
8993     (let (screen output)
8994       (goto-char (point-min))
8995       (save-excursion
8996         (when (re-search-forward "\\(^Screen \\)\\([0-9]\\):" nil t)
8997           (setq screen (match-string 2))))
8998       (when (re-search-forward "^\\(.*\\) connected" nil t)
8999         (setq output (match-string 1)))
9000       (list screen output))))
9001
9002 (defun anything-c-xrandr-screen ()
9003   "Return current X screen number."
9004   (car (anything-c-xrandr-info)))
9005
9006 (defun anything-c-xrandr-output ()
9007   "Return current X display name."
9008   (cadr (anything-c-xrandr-info)))
9009
9010 (defvar anything-c-source-xrandr-change-resolution
9011   '((name . "Change Resolution")
9012     (candidates
9013      . (lambda ()
9014          (with-temp-buffer
9015            (call-process "xrandr" nil (current-buffer) nil
9016                          "--screen" (anything-c-xrandr-screen) "-q")
9017            (goto-char 1)
9018            (loop with modes = nil
9019                  while (re-search-forward "   \\([0-9]+x[0-9]+\\)" nil t)
9020                  for mode = (match-string 1)
9021                  unless (member mode modes)
9022                  collect mode into modes
9023                  finally return modes))))
9024     (action
9025      ("Change Resolution"
9026       . (lambda (mode)
9027           (call-process "xrandr" nil nil nil
9028                         "--screen" (anything-c-xrandr-screen)
9029                         "--output" (anything-c-xrandr-output)
9030                         "--mode" mode))))))
9031
9032 ;;; Xfont selection
9033 ;;
9034 ;;
9035 (defun anything-c-persistent-xfont-action (elm)
9036   "Show current font temporarily"
9037   (let ((current-font (cdr (assoc 'font (frame-parameters))))
9038         (default-font elm))
9039     (unwind-protect
9040          (progn (set-frame-font default-font 'keep-size) (sit-for 2))
9041       (set-frame-font current-font))))
9042
9043 (defvar anything-c-xfonts-cache nil)
9044 (defvar anything-c-source-xfonts
9045   '((name . "X Fonts")
9046     (init . (lambda ()
9047               (unless anything-c-xfonts-cache
9048                 (setq anything-c-xfonts-cache
9049                       (x-list-fonts "*")))))
9050     (candidates . anything-c-xfonts-cache)
9051     (action . (("Copy to kill ring" . (lambda (elm)
9052                                         (kill-new elm)))
9053                ("Set Font" . (lambda (elm)
9054                                (kill-new elm)
9055                                (set-frame-font elm 'keep-size)
9056                                (message "New font have been copied to kill ring")))))
9057     (persistent-action . anything-c-persistent-xfont-action)
9058     (persistent-help . "Switch to this font temporarily")))
9059
9060 ;;; 𝕌𝕔𝕤 𝕊𝕪𝕞𝕓𝕠𝕝 𝕔𝕠𝕞𝕡𝕝𝕖𝕥𝕚𝕠𝕟
9061 ;;
9062 ;;
9063 (defvar anything-c-ucs-max-len 0)
9064 (defun anything-c-calculate-ucs-max-len ()
9065   "Calculate the length of longest `ucs-names' candidate."
9066   (loop with count = 0
9067         for (n . v) in (ucs-names)
9068         for len = (length n)
9069         if (> len count)
9070         do (setq count len)
9071         finally return count))
9072
9073 (defun anything-c-ucs-init ()
9074   "Initialize an anything buffer with ucs symbols.
9075 Only math* symbols are collected."
9076   (unless (> anything-c-ucs-max-len 0)
9077     (setq anything-c-ucs-max-len
9078           (anything-c-calculate-ucs-max-len)))
9079   (with-current-buffer (anything-candidate-buffer
9080                         (get-buffer-create "*anything ucs*"))
9081     ;; `ucs-names' fn will not run again, data is cached in
9082     ;; var `ucs-names'.
9083     (loop for (n . v) in (ucs-names)
9084           for len = (length n)
9085           for diff = (+ (- anything-c-ucs-max-len len) 2)
9086           unless (string= "" n)
9087           do (progn (insert (concat
9088                              n ":"
9089                              (make-string
9090                               diff ? )))
9091                     (ucs-insert v)
9092                     (insert "\n")))))
9093
9094 (defun anything-c-ucs-forward-char (candidate)
9095   (with-anything-current-buffer
9096     (forward-char 1)))
9097
9098 (defun anything-c-ucs-backward-char (candidate)
9099   (with-anything-current-buffer
9100     (forward-char -1)))
9101
9102 (defun anything-c-ucs-delete-backward (candidate)
9103   (with-anything-current-buffer
9104     (delete-char -1)))
9105
9106 (defun anything-c-ucs-insert-char (candidate)
9107   (with-anything-current-buffer
9108     (insert
9109      (replace-regexp-in-string
9110       " " ""
9111       (cadr (split-string candidate ":"))))))
9112
9113 (defun anything-c-ucs-persistent-insert ()
9114   (interactive)
9115   (anything-attrset 'action-insert 'anything-c-ucs-insert-char)
9116   (anything-execute-persistent-action 'action-insert))
9117
9118 (defun anything-c-ucs-persistent-forward ()
9119   (interactive)
9120   (anything-attrset 'action-forward 'anything-c-ucs-forward-char)
9121   (anything-execute-persistent-action 'action-forward))
9122
9123 (defun anything-c-ucs-persistent-backward ()
9124   (interactive)
9125   (anything-attrset 'action-back 'anything-c-ucs-backward-char)
9126   (anything-execute-persistent-action 'action-back))
9127
9128 (defun anything-c-ucs-persistent-delete ()
9129   (interactive)
9130   (anything-attrset 'action-delete 'anything-c-ucs-delete-backward)
9131   (anything-execute-persistent-action 'action-delete))
9132
9133 (defvar anything-c-source-ucs
9134   '((name . "Ucs names")
9135     (init . anything-c-ucs-init)
9136     (candidate-number-limit . 9999)
9137     (candidates-in-buffer)
9138     (mode-line . anything-c-ucs-mode-line-string)
9139     (action . (("Insert" . anything-c-ucs-insert-char)
9140                ("Forward char" . anything-c-ucs-forward-char)
9141                ("Backward char" . anything-c-ucs-backward-char)
9142                ("Delete char backward" . anything-c-ucs-delete-backward))))
9143   "Source for collecting `ucs-names' math symbols.")
9144
9145
9146 ;;; Emacs process
9147 ;;
9148 ;;
9149 (defvar anything-c-source-emacs-process
9150   '((name . "Emacs Process")
9151     (candidates . (lambda () (mapcar #'process-name (process-list))))
9152     (persistent-action . (lambda (elm)
9153                            (delete-process (get-process elm))
9154                            (anything-delete-current-selection)))
9155     (persistent-help . "Kill Process")
9156     (action ("Kill Process" . (lambda (elm)
9157                                 (delete-process (get-process elm)))))))
9158
9159 ;;; World time
9160 ;;
9161 ;;
9162 (defvar anything-c-source-time-world
9163   '((name . "Time World List")
9164     (init . (lambda ()
9165               (let ((anything-buffer (anything-candidate-buffer 'global)))
9166                 (with-current-buffer anything-buffer
9167                   (display-time-world-display display-time-world-list)))))
9168     (candidates-in-buffer)))
9169
9170
9171 \f
9172 ;;; Anything interface for Debian/Ubuntu packages (apt-*)
9173 ;;
9174 ;;
9175 (defvar anything-c-source-apt
9176   '((name . "APT")
9177     (init . anything-c-apt-init)
9178     (candidates-in-buffer)
9179     (candidate-transformer anything-c-apt-candidate-transformer)
9180     (display-to-real . anything-c-apt-display-to-real)
9181     (requires-pattern . 2)
9182     (update . anything-c-apt-refresh)
9183     (action
9184      ("Show package description" . anything-c-apt-cache-show)
9185      ("Install package" . anything-c-apt-install)
9186      ("Reinstall package" . anything-c-apt-reinstall)
9187      ("Remove package" . anything-c-apt-uninstall)
9188      ("Purge package" . anything-c-apt-purge))
9189     (persistent-action . anything-c-apt-persistent-action)
9190     (persistent-help . "Show package description")))
9191
9192 (defvar anything-c-apt-query "emacs")
9193 (defvar anything-c-apt-search-command "apt-cache search '%s'")
9194 (defvar anything-c-apt-show-command "apt-cache show '%s'")
9195 (defvar anything-c-apt-installed-packages nil)
9196 (defvar anything-c-apt-all-packages nil)
9197 (defvar anything-c-apt-input-history nil)
9198
9199 (defun anything-c-apt-refresh ()
9200   "Refresh installed candidates list."
9201   (setq anything-c-apt-installed-packages nil)
9202   (setq anything-c-apt-all-packages nil))
9203
9204 (defun anything-c-apt-persistent-action (candidate)
9205   "Persistent action for APT source."
9206   (anything-c-apt-cache-show candidate))
9207
9208 (defun anything-c-apt-candidate-transformer (candidates)
9209   "Show installed CANDIDATES and the ones to deinstall in a different color."
9210   (loop for cand in candidates
9211         for name = (anything-c-apt-display-to-real cand)
9212         collect (cond ((string= (assoc-default
9213                                  name anything-c-apt-installed-packages)
9214                                 "deinstall")
9215                        (propertize cand 'face 'anything-apt-deinstalled))
9216                       ((string= (assoc-default
9217                                  name anything-c-apt-installed-packages)
9218                                 "install")
9219                        (propertize cand 'face 'anything-apt-installed))
9220                       (t cand))))
9221
9222 (defun anything-c-apt-init ()
9223   "Initialize list of debian packages."
9224   (let ((query ""))
9225     (unless (and anything-c-apt-installed-packages
9226                  anything-c-apt-all-packages)
9227       (message "Loading package list...")
9228       (setq anything-c-apt-installed-packages
9229             (with-temp-buffer
9230               (call-process-shell-command "dpkg --get-selections"
9231                                           nil (current-buffer))
9232               (loop for i in (split-string (buffer-string) "\n" t)
9233                     for p = (split-string i)
9234                     collect (cons (car p) (cadr p)))))
9235       (setq anything-c-apt-all-packages
9236             (with-current-buffer
9237                 (anything-candidate-buffer
9238                  (get-buffer-create (format "*anything-apt*")))
9239               (erase-buffer)
9240               (call-process-shell-command
9241                (format anything-c-apt-search-command query)
9242                nil (current-buffer))))
9243       (message "Loading package list done")
9244       (sit-for 0.5))))
9245
9246 (defun anything-c-apt-display-to-real (line)
9247   "Return only name of a debian package.
9248 LINE is displayed like:
9249 package name - description."
9250   (car (split-string line " - ")))
9251
9252 (defun anything-c-shell-command-if-needed (command)
9253   "Run shell command COMMAND to describe package.
9254 If a buffer named COMMAND already exists, just switch to it."
9255   (let ((buf (get-buffer command)))
9256     (anything-c-switch-to-buffer (get-buffer-create command))
9257     (unless buf (insert (shell-command-to-string command)))))
9258
9259 (defun anything-c-apt-cache-show (package)
9260   "Show information on apt package PACKAGE."
9261   (anything-c-shell-command-if-needed
9262    (format anything-c-apt-show-command package)))
9263
9264 (defun anything-c-apt-install (package)
9265   "Run 'apt-get install' shell command on PACKAGE."
9266   (anything-c-apt-generic-action :action 'install))
9267
9268 (defun anything-c-apt-reinstall (package)
9269   "Run 'apt-get install --reinstall' shell command on PACKAGE."
9270   (anything-c-apt-generic-action :action 'reinstall))
9271
9272 (defun anything-c-apt-uninstall (package)
9273   "Run 'apt-get remove' shell command on PACKAGE."
9274   (anything-c-apt-generic-action :action 'uninstall))
9275
9276 (defun anything-c-apt-purge (package)
9277   "Run 'apt-get purge' shell command on PACKAGE."
9278   (anything-c-apt-generic-action :action 'purge))
9279
9280 (defun* anything-c-apt-generic-action (&key action)
9281   "Run 'apt-get ACTION'.
9282 Support install, remove and purge actions."
9283   (ansi-term (getenv "SHELL") "anything apt")
9284   (term-line-mode)
9285   (let ((command   (case action
9286                      ('install   "sudo apt-get install ")
9287                      ('reinstall "sudo apt-get install --reinstall ")
9288                      ('uninstall "sudo apt-get remove ")
9289                      ('purge     "sudo apt-get purge ")
9290                      (t          (error "Unknow action"))))
9291         (beg       (point))
9292         end
9293         (cand-list (mapconcat #'(lambda (x) (format "'%s'" x))
9294                               (anything-marked-candidates) " ")))
9295     (goto-char (point-max))
9296     (insert (concat command cand-list))
9297     (setq end (point))
9298     (if (y-or-n-p (format "%s package" (symbol-name action)))
9299         (progn
9300           (setq anything-c-external-commands-list nil)
9301           (setq anything-c-apt-installed-packages nil)
9302           (term-char-mode) (term-send-input))
9303         (delete-region beg end) (term-send-eof) (kill-buffer))))
9304
9305 ;; (anything-c-apt-install "jed")
9306
9307 \f
9308 ;;; Anything UI for gentoo portage.
9309 ;;
9310 ;;
9311 (defvar anything-c-gentoo-use-flags nil)
9312 (defvar anything-c-gentoo-buffer "*anything-gentoo-output*")
9313 (defvar anything-c-cache-gentoo nil)
9314 (defvar anything-c-cache-world nil)
9315 (defvar anything-c-source-gentoo
9316   '((name . "Portage sources")
9317     (init . (lambda ()
9318               (get-buffer-create anything-c-gentoo-buffer)
9319               (unless anything-c-cache-gentoo
9320                 (anything-c-gentoo-setup-cache))
9321               (unless anything-c-cache-world
9322                 (setq anything-c-cache-world (anything-c-gentoo-get-world)))
9323               (anything-c-gentoo-init-list)))
9324     (candidates-in-buffer)
9325     (match . identity)
9326     (candidate-transformer anything-c-highlight-world)
9327     (action . (("Show package" . (lambda (elm)
9328                                    (anything-c-gentoo-eshell-action elm "eix")))
9329                ("Show history" . (lambda (elm)
9330                                    (if (member elm anything-c-cache-world)
9331                                        (anything-c-gentoo-eshell-action elm "genlop -qe")
9332                                        (message "No infos on packages not yet installed"))))
9333                ("Copy in kill-ring" . kill-new)
9334                ("insert at point" . insert)
9335                ("Browse HomePage" . (lambda (elm)
9336                                       (let ((urls (anything-c-gentoo-get-url elm)))
9337                                         (browse-url (anything-comp-read "Url: " urls :must-match t)))))
9338                ("Show extra infos" . (lambda (elm)
9339                                        (if (member elm anything-c-cache-world)
9340                                            (anything-c-gentoo-eshell-action elm "genlop -qi")
9341                                            (message "No infos on packages not yet installed"))))
9342                ("Show use flags" . (lambda (elm)
9343                                      (anything-c-gentoo-default-action elm "equery" "-C" "u")
9344                                      (font-lock-add-keywords nil '(("^\+.*" . font-lock-variable-name-face)))
9345                                      (font-lock-mode 1)))
9346                ("Run emerge pretend" . (lambda (elm)
9347                                          (anything-c-gentoo-eshell-action elm "emerge -p")))
9348                ("Emerge" . (lambda (elm)
9349                              (anything-gentoo-install elm :action 'install)))
9350                ("Unmerge" . (lambda (elm)
9351                               (anything-gentoo-install elm :action 'uninstall)))
9352                ("Show dependencies" . (lambda (elm)
9353                                         (anything-c-gentoo-default-action elm "equery" "-C" "d")))
9354                ("Show related files" . (lambda (elm)
9355                                          (anything-c-gentoo-default-action elm "equery" "files")))
9356                ("Refresh" . (lambda (elm)
9357                               (anything-c-gentoo-setup-cache)
9358                               (setq anything-c-cache-world (anything-c-gentoo-get-world))))))))
9359
9360
9361 (defun* anything-gentoo-install (candidate &key action)
9362   (setq anything-c-external-commands-list nil)
9363   (ansi-term (getenv "SHELL") "Gentoo emerge")
9364   (term-line-mode)
9365   (let ((command (case action
9366                    ('install "sudo emerge -av ")
9367                    ('uninstall "sudo emerge -avC ")
9368                    (t (error "Unknow action"))))
9369         (elms (mapconcat 'identity (anything-marked-candidates) " "))
9370         (beg (point)) end)
9371     (goto-char (point-max))
9372     (insert (concat command elms))
9373     (setq end (point))
9374     (term-char-mode) (term-send-input)))
9375
9376 (defun anything-c-gentoo-default-action (elm command &rest args)
9377   "Gentoo default action that use `anything-c-gentoo-buffer'."
9378   (if (member elm anything-c-cache-world)
9379       (progn
9380         (anything-c-switch-to-buffer anything-c-gentoo-buffer)
9381         (erase-buffer)
9382         (let ((com-list (append args (list elm))))
9383           (apply #'call-process command nil t nil
9384                  com-list)))
9385       (message "No infos on packages not yet installed")))
9386
9387 (defvar anything-c-source-use-flags
9388   '((name . "Use Flags")
9389     (init . (lambda ()
9390               (unless anything-c-gentoo-use-flags
9391                 (anything-c-gentoo-setup-use-flags-cache))
9392               (anything-c-gentoo-get-use)))
9393     (candidates-in-buffer)
9394     (match . identity)
9395     (candidate-transformer anything-c-highlight-local-use)
9396     (action . (("Description"
9397                 . (lambda (elm)
9398                     (anything-c-switch-to-buffer anything-c-gentoo-buffer)
9399                     (erase-buffer)
9400                     (apply #'call-process "euse" nil t nil
9401                            `("-i"
9402                              ,elm))
9403                     (font-lock-add-keywords nil `((,elm . font-lock-variable-name-face)))
9404                     (font-lock-mode 1)))
9405                ("Enable"
9406                 . (lambda (elm)
9407                     (anything-c-gentoo-eshell-action elm "*sudo -p Password: euse -E")))
9408                ("Disable"
9409                 . (lambda (elm)
9410                     (anything-c-gentoo-eshell-action elm "*sudo -p Password: euse -D")))
9411                ("Remove"
9412                 . (lambda (elm)
9413                     (anything-c-gentoo-eshell-action elm "*sudo -p Password: euse -P")))
9414                ("Show which dep use this flag"
9415                 . (lambda (elm)
9416                     (anything-c-switch-to-buffer anything-c-gentoo-buffer)
9417                     (erase-buffer)
9418                     (apply #'call-process "equery" nil t nil
9419                            `("-C"
9420                              "h"
9421                              ,elm))))))))
9422
9423
9424
9425 (defun anything-c-gentoo-init-list ()
9426   "Initialize buffer with all packages in Portage."
9427   (let* ((portage-buf (get-buffer-create "*anything-gentoo*"))
9428          (buf (anything-candidate-buffer 'portage-buf)))
9429     (with-current-buffer buf
9430       (dolist (i anything-c-cache-gentoo)
9431         (insert (concat i "\n"))))))
9432
9433 (defun anything-c-gentoo-setup-cache ()
9434   "Set up `anything-c-cache-gentoo'"
9435   (setq anything-c-cache-gentoo
9436         (split-string (with-temp-buffer
9437                         (call-process "eix" nil t nil
9438                                       "--only-names")
9439                         (buffer-string)))))
9440
9441 (defun anything-c-gentoo-eshell-action (elm command)
9442   (when (get-buffer "*EShell Command Output*")
9443     (kill-buffer "*EShell Command Output*"))
9444   (message "Wait searching...")
9445   (let ((buf-fname (buffer-file-name anything-current-buffer)))
9446     (if (and buf-fname (string-match tramp-file-name-regexp buf-fname))
9447         (progn
9448           (save-window-excursion
9449             (pop-to-buffer "*scratch*")
9450             (eshell-command (format "%s %s" command elm)))
9451           (pop-to-buffer "*EShell Command Output*"))
9452         (eshell-command (format "%s %s" command elm)))))
9453
9454 (defun anything-c-gentoo-get-use ()
9455   "Initialize buffer with all use flags."
9456   (let* ((use-buf (get-buffer-create "*anything-gentoo-use*"))
9457          (buf (anything-candidate-buffer 'use-buf)))
9458     (with-current-buffer buf
9459       (dolist (i anything-c-gentoo-use-flags)
9460         (insert (concat i "\n"))))))
9461
9462
9463 (defun anything-c-gentoo-setup-use-flags-cache ()
9464   "Setup `anything-c-gentoo-use-flags'"
9465   (setq anything-c-gentoo-use-flags
9466         (split-string (with-temp-buffer
9467                         (call-process "eix" nil t nil
9468                                       "--print-all-useflags")
9469                         (buffer-string)))))
9470
9471 (defun anything-c-gentoo-get-url (elm)
9472   "Return a list of urls from eix output."
9473   (loop
9474         with url-list = (split-string
9475                          (with-temp-buffer
9476                            (call-process "eix" nil t nil
9477                                          elm "--format" "<homepage>\n")
9478                            (buffer-string)))
9479         with all
9480         for i in url-list
9481         when (and (string-match "^http://.*" i)
9482                   (not (member i all)))
9483         collect i into all
9484         finally return all))
9485
9486 (defun anything-c-gentoo-get-world ()
9487   "Return list of all installed package on your system."
9488   (split-string (with-temp-buffer
9489                   (call-process "qlist" nil t nil
9490                                 "-I")
9491                   (buffer-string))))
9492
9493 (defun anything-c-gentoo-get-local-use ()
9494   (split-string (with-temp-buffer
9495                   (call-process "portageq" nil t nil
9496                                 "envvar"
9497                                 "USE")
9498                   (buffer-string))))
9499
9500
9501 (defun anything-c-highlight-world (eix)
9502   "Highlight all installed package."
9503   (loop for i in eix
9504         if (member i anything-c-cache-world)
9505         collect (propertize i 'face 'anything-gentoo-match-face)
9506         else
9507         collect i))
9508
9509 (defun anything-c-highlight-local-use (use-flags)
9510   (let ((local-uses (anything-c-gentoo-get-local-use)))
9511     (loop for i in use-flags
9512           if (member i local-uses)
9513           collect (propertize i 'face 'anything-gentoo-match-face)
9514           else
9515           collect i)))
9516
9517
9518 \f
9519 ;;; Anything ratpoison UI
9520 ;;
9521 ;;
9522 (defvar anything-c-source-ratpoison-commands
9523   '((name . "Ratpoison Commands")
9524     (init . anything-c-ratpoison-commands-init)
9525     (candidates-in-buffer)
9526     (action ("Execute the command" . anything-c-ratpoison-commands-execute))
9527     (display-to-real . anything-c-ratpoison-commands-display-to-real)
9528     (candidate-number-limit)))
9529
9530 (defun anything-c-ratpoison-commands-init ()
9531   (unless (anything-candidate-buffer)
9532     (with-current-buffer (anything-candidate-buffer 'global)
9533       ;; with ratpoison prefix key
9534       (save-excursion
9535         (call-process "ratpoison" nil (current-buffer) nil "-c" "help"))
9536       (while (re-search-forward "^\\([^ ]+\\) \\(.+\\)$" nil t)
9537         (replace-match "<ratpoison> \\1: \\2"))
9538       (goto-char (point-max))
9539       ;; direct binding
9540       (save-excursion
9541         (call-process "ratpoison" nil (current-buffer) nil "-c" "help top"))
9542       (while (re-search-forward "^\\([^ ]+\\) \\(.+\\)$" nil t)
9543         (replace-match "\\1: \\2")))))
9544
9545 (defun anything-c-ratpoison-commands-display-to-real (display)
9546   (and (string-match ": " display)
9547        (substring display (match-end 0))))
9548
9549 (defun anything-c-ratpoison-commands-execute (candidate)
9550   (call-process "ratpoison" nil nil nil "-ic" candidate))
9551
9552
9553 \f
9554 ;;; Anything `completing-read' replacement
9555 ;;
9556 ;;
9557 (defun anything-comp-read-get-candidates (collection &optional test sort-fn alistp)
9558   "Convert COLLECTION to list removing elements that don't match TEST.
9559 See `anything-comp-read' about supported COLLECTION arguments.
9560
9561 SORT-FN is a predicate to sort COLLECTION.
9562
9563 ALISTP when non--nil will not use `all-completions' to collect
9564 candidates because it doesn't handle alists correctly for anything.
9565 i.e In `all-completions' the keys \(cars of elements\)
9566 are the possible completions. In anything we want to use the cdr instead
9567 like \(display . real\).
9568
9569 e.g
9570
9571 \(setq A '((a . 1) (b . 2) (c . 3)))
9572 ==>((a . 1) (b . 2) (c . 3))
9573 \(anything-comp-read \"test: \" A :alistp nil
9574                                   :exec-when-only-one t
9575                                   :initial-input \"a\")
9576 ==>\"a\"
9577 \(anything-comp-read \"test: \" A :alistp t
9578                                   :exec-when-only-one t
9579                                   :initial-input \"1\")
9580 ==>\"1\"
9581
9582 See docstring of `all-completions' for more info.
9583
9584 If COLLECTION is an `obarray', a TEST should be needed. See `obarray'."
9585   (let ((cands
9586          (cond ((and (eq collection obarray) test)
9587                 (all-completions "" collection test))
9588                ((and (vectorp collection) test)
9589                 (loop for i across collection when (funcall test i) collect i))
9590                ((vectorp collection)
9591                 (loop for i across collection collect i))
9592                ((and alistp test)
9593                 (loop for i in collection when (funcall test i) collect i))
9594                ((and (symbolp collection) (boundp collection))
9595                 (symbol-value collection))
9596                (alistp collection)
9597                ((and collection test)
9598                 (all-completions "" collection test))
9599                (t (all-completions "" collection)))))
9600     (if sort-fn (sort cands sort-fn) cands)))
9601
9602 (defun anything-cr-default-transformer (candidates source)
9603   "Default filter candidate function for `anything-comp-read'.
9604 Do nothing, just return candidate list unmodified."
9605   candidates)
9606
9607 (defun* anything-comp-read (prompt collection
9608                                    &key
9609                                    test
9610                                    initial-input
9611                                    default
9612                                    preselect
9613                                    (buffer "*Anything Completions*")
9614                                    must-match
9615                                    (requires-pattern 0)
9616                                    (history nil)
9617                                    input-history
9618                                    (persistent-action nil)
9619                                    (persistent-help "DoNothing")
9620                                    (mode-line anything-mode-line-string)
9621                                    (keymap anything-map)
9622                                    (name "Anything Completions")
9623                                    candidates-in-buffer
9624                                    exec-when-only-one
9625                                    (volatile t)
9626                                    sort
9627                                    (fc-transformer 'anything-cr-default-transformer)
9628                                    (marked-candidates nil)
9629                                    (alistp t))
9630   "Read a string in the minibuffer, with anything completion.
9631
9632 It is anything `completing-read' equivalent.
9633
9634 - PROMPT is the prompt name to use.
9635
9636 - COLLECTION can be a list, vector, obarray or hash-table.
9637   It can be also a function that receives three arguments:
9638   the values string, predicate and t. See `all-completions' for more details.
9639
9640 Keys description:
9641
9642 - TEST: A predicate called with one arg i.e candidate.
9643
9644 - INITIAL-INPUT: Same as input arg in `anything'.
9645
9646 - PRESELECT: See preselect arg of `anything'.
9647
9648 - DEFAULT: This option is used only for compatibility with regular
9649   Emacs `completing-read'.
9650
9651 - BUFFER: Name of anything-buffer.
9652
9653 - MUST-MATCH: Candidate selected must be one of COLLECTION.
9654
9655 - REQUIRES-PATTERN: Same as anything attribute, default is 0.
9656
9657 - HISTORY: A list containing specific history, default is nil.
9658   When it is non--nil, all elements of HISTORY are displayed in
9659   a special source before COLLECTION.
9660
9661 - INPUT-HISTORY: A symbol. the minibuffer input history will be
9662   stored there, if nil or not provided, `minibuffer-history'
9663   will be used instead.
9664
9665 - PERSISTENT-ACTION: A function called with one arg i.e candidate.
9666
9667 - PERSISTENT-HELP: A string to document PERSISTENT-ACTION.
9668
9669 - MODE-LINE: A string or list to display in mode line.
9670   (See `anything-mode-line-string')
9671
9672 - KEYMAP: A keymap to use in this `anything-comp-read'.
9673   (The keymap will be shared with history source)
9674
9675 - NAME: The name related to this local source.
9676
9677 - EXEC-WHEN-ONLY-ONE: Bound `anything-execute-action-at-once-if-one'
9678   to non--nil. (possibles values are t or nil).
9679
9680 - VOLATILE: Use volatile attribute \(enabled by default\).
9681
9682 - SORT: A predicate to give to `sort' e.g `string-lessp'.
9683
9684 - FC-TRANSFORMER: A `filtered-candidate-transformer' function.
9685
9686 - MARKED-CANDIDATES: If non--nil return candidate or marked candidates as a list.
9687
9688 - ALISTP: \(default is non--nil\) See `anything-comp-read-get-candidates'.
9689
9690 - CANDIDATES-IN-BUFFER: when non--nil use a source build with
9691   `anything-candidates-in-buffer' which is much faster.
9692   Argument VOLATILE have no effect when CANDIDATES-IN-BUFFER is non--nil.
9693
9694 Any prefix args passed during `anything-comp-read' invocation will be recorded
9695 in `anything-current-prefix-arg', otherwise if prefix args were given before
9696 `anything-comp-read' invocation, the value of `current-prefix-arg' will be used.
9697 That's mean you can pass prefix args before or after calling a command
9698 that use `anything-comp-read' See `anything-M-x' for example."
9699   (when (get-buffer anything-action-buffer)
9700     (kill-buffer anything-action-buffer))
9701   (flet ((action-fn (candidate)
9702            (if marked-candidates
9703                (anything-marked-candidates)
9704                (identity candidate))))
9705     ;; Assume completion have been already required,
9706     ;; so always use 'confirm.
9707     (when (eq must-match 'confirm-after-completion)
9708       (setq must-match 'confirm))
9709     (let* ((minibuffer-completion-confirm must-match)
9710            (must-match-map (when must-match
9711                              (let ((map (make-sparse-keymap)))
9712                                (define-key map (kbd "RET")
9713                                  'anything-confirm-and-exit-minibuffer)
9714                                map)))
9715            (anything-map (if must-match-map
9716                              (make-composed-keymap
9717                               must-match-map (or keymap anything-map))
9718                              (or keymap anything-map)))
9719            (src-hist `((name . ,(format "%s History" name))
9720                        (candidates
9721                         . (lambda ()
9722                             (let ((all (anything-comp-read-get-candidates
9723                                         history nil nil ,alistp)))
9724                               (delete
9725                                ""
9726                                (anything-fast-remove-dups
9727                                 (if (and default (not (string= default "")))
9728                                     (delq nil (cons default
9729                                                     (delete default all)))
9730                                     all)
9731                                 :test 'equal)))))
9732                        (filtered-candidate-transformer
9733                         . (lambda (candidates sources)
9734                             (loop for i in candidates
9735                                   do (set-text-properties 0 (length i) nil i)
9736                                   collect i)))
9737                        (persistent-action . ,persistent-action)
9738                        (persistent-help . ,persistent-help)
9739                        (mode-line . ,mode-line)
9740                        (action . ,'action-fn)))
9741            (src `((name . ,name)
9742                   (candidates
9743                    . (lambda ()
9744                        (let ((cands (anything-comp-read-get-candidates
9745                                      collection test sort alistp)))
9746                          (unless (or must-match (string= anything-pattern ""))
9747                            (setq cands (append (list anything-pattern) cands)))
9748                          (if (and default (not (string= default "")))
9749                              (delq nil (cons default (delete default cands)))
9750                              cands))))
9751                   (filtered-candidate-transformer ,fc-transformer)
9752                   (requires-pattern . ,requires-pattern)
9753                   (persistent-action . ,persistent-action)
9754                   (persistent-help . ,persistent-help)
9755                   (mode-line . ,mode-line)
9756                   (action . ,'action-fn)))
9757            (src-1 `((name . ,name)
9758                     (init
9759                      . (lambda ()
9760                          (let ((cands (anything-comp-read-get-candidates
9761                                        collection test sort alistp)))
9762                            (unless (or must-match (string= anything-pattern ""))
9763                              (setq cands (append (list anything-pattern) cands)))
9764                            (with-current-buffer (anything-candidate-buffer 'global)
9765                              (loop for i in
9766                                    (if (and default (not (string= default "")))
9767                                        (delq nil (cons default (delete default cands)))
9768                                        cands)
9769                                    do (insert (concat i "\n")))))))
9770                     (candidates-in-buffer)
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-list (list src-hist
9778                            (if candidates-in-buffer
9779                                src-1
9780                                (if volatile
9781                                    (append src '((volatile)))
9782                                    src))))
9783            (anything-execute-action-at-once-if-one exec-when-only-one))
9784       (or
9785        (anything
9786         :sources src-list
9787         :input initial-input
9788         :default default
9789         :preselect preselect
9790         :prompt prompt
9791         :resume 'noresume
9792         :keymap anything-map
9793         :history (and (symbolp input-history) input-history)
9794         :buffer buffer)
9795        (when (and (eq anything-exit-status 0)
9796                   (eq must-match 'confirm))
9797          ;; Return empty string only if it is the DEFAULT
9798          ;; value and anything-pattern is empty.
9799          ;; otherwise return anything-pattern
9800          (if (and (string= anything-pattern "") default)
9801              default (identity anything-pattern)))
9802        (unless (or (eq anything-exit-status 1)
9803                    must-match) ; FIXME this should not be needed now.
9804          default)
9805        (keyboard-quit)))))
9806
9807 ;; Generic completing-read
9808 ;;
9809 ;; Support also function as collection.
9810 ;; e.g M-x man is supported.
9811 ;; Support hash-table and vectors as collection.
9812 ;; NOTE:
9813 ;; Some crap emacs functions may not be supported
9814 ;; like ffap-alternate-file (bad use of completing-read)
9815 ;; and maybe others.
9816 ;; Provide a mode `anything-completion-mode' which turn on
9817 ;; anything in all `completing-read' and `read-file-name' in Emacs.
9818 ;;
9819 (defvar anything-completion-mode-string " AC")
9820
9821 (defvar anything-completion-mode-quit-message
9822   "Anything completion disabled")
9823
9824 (defvar anything-completion-mode-start-message
9825   "Anything completion enabled")
9826
9827 ;;; Specialized handlers
9828 ;;
9829 ;;
9830 (defun anything-completing-read-symbols
9831     (prompt collection test require-match init
9832      hist default inherit-input-method name buffer)
9833   "Specialized function for fast symbols completion in `ac-mode'."
9834   (or
9835    (anything
9836     :sources `((name . ,name)
9837                (init . (lambda ()
9838                          (with-current-buffer (anything-candidate-buffer 'global)
9839                            (goto-char (point-min))
9840                            (when (and default (stringp default)
9841                                       ;; Some defaults args result as
9842                                       ;; (symbol-name nil) == "nil".
9843                                       ;; e.g debug-on-entry.
9844                                       (not (string= default "nil"))
9845                                       (not (string= default "")))
9846                              (insert (concat default "\n")))
9847                            (loop with all = (all-completions "" collection test)
9848                                  for sym in all
9849                                  unless (and default (eq sym default))
9850                                  do (insert (concat sym "\n"))))))
9851                (persistent-action . anything-lisp-completion-persistent-action)
9852                (persistent-help . "Show brief doc in mode-line")
9853                (candidates-in-buffer)
9854                (action . identity))
9855     :prompt prompt
9856     :buffer buffer
9857     :input init
9858     :history hist
9859     :resume 'noresume
9860     :default (or default ""))
9861    (keyboard-quit)))
9862
9863
9864 ;;; Generic completing read
9865 ;;
9866 ;;
9867 (defun anything-completing-read-default-1
9868     (prompt collection test require-match
9869      init hist default inherit-input-method
9870      name buffer &optional cands-in-buffer exec-when-only-one)
9871   "Call `anything-comp-read' with same args as `completing-read'.
9872 Extra optional arg CANDS-IN-BUFFER mean use `candidates-in-buffer'
9873 method which is faster.
9874 It should be used when candidate list don't need to rebuild dynamically."
9875   (let ((history (or (car-safe hist) hist)))
9876     (anything-comp-read
9877      prompt collection
9878      :test test
9879      :history history
9880      :input-history history
9881      :must-match require-match
9882      :alistp nil ; Be sure `all-completions' is used.
9883      :name name
9884      :requires-pattern (if (and (string= default "")
9885                                 (or (eq require-match 'confirm)
9886                                     (eq require-match
9887                                         'confirm-after-completion)))
9888                            1 0)
9889      :candidates-in-buffer cands-in-buffer
9890      :exec-when-only-one exec-when-only-one
9891      :buffer buffer
9892      ;; If DEF is not provided, fallback to empty string
9893      ;; to avoid `thing-at-point' to be appended on top of list
9894      :default (or default "")
9895      ;; Use `regexp-quote' to fix initial input
9896      ;; with special characters (e.g nnimap+gmail:)
9897      :initial-input (and (stringp init) (regexp-quote init)))))
9898
9899 (defun anything-completing-read-with-cands-in-buffer
9900     (prompt collection test require-match
9901      init hist default inherit-input-method
9902      name buffer)
9903   "Same as `anything-completing-read-default-1' but use candidates-in-buffer."
9904   ;; Some commands like find-tag may use `read-file-name' from inside
9905   ;; the calculation of collection. in this case it clash with
9906   ;; candidates-in-buffer that reuse precedent data (files) which is wrong.
9907   ;; So (re)calculate collection outside of main anything-session.
9908   (let ((cands (all-completions "" collection)))
9909     (anything-completing-read-default-1 prompt cands test require-match
9910                                         init hist default inherit-input-method
9911                                         name buffer t)))
9912
9913 (defun* anything-completing-read-default
9914     (prompt collection &optional
9915             predicate require-match
9916             initial-input hist def
9917             inherit-input-method)
9918   "An anything replacement of `completing-read'.
9919 This function should be used only as a `completing-read-function'.
9920
9921 Don't use it directly, use instead `anything-comp-read' in your programs.
9922
9923 See documentation of `completing-read' and `all-completions' for details."
9924   (declare (special anything-completion-mode))
9925   (let* ((current-command this-command)
9926          (str-command     (symbol-name current-command))
9927          (buf-name        (format "*ac-mode-%s*" str-command))
9928          (entry           (assq current-command
9929                                 anything-completing-read-handlers-alist))
9930          (def-com         (cdr-safe entry))
9931          (str-defcom      (and def-com (symbol-name def-com)))
9932          (def-args        (list prompt collection predicate require-match
9933                                 initial-input hist def inherit-input-method))
9934          ;; Append the two extra args needed to set the buffer and source name
9935          ;; in anything specialized functions.
9936          (any-args        (append def-args (list str-command buf-name)))
9937          anything-completion-mode-start-message ; Be quiet
9938          anything-completion-mode-quit-message
9939          (minibuffer-completion-table collection)
9940          (minibuffer-completion-predicate predicate)
9941          ;; Be sure this pesty *completion* buffer doesn't popup.
9942          (minibuffer-setup-hook (remove 'minibuffer-completion-help
9943                                         minibuffer-setup-hook)))
9944     (when (eq def-com 'ido) (setq def-com 'ido-completing-read))
9945     (unless (or (not entry) def-com)
9946       ;; An entry in *read-handlers-alist exists but have
9947       ;; a nil value, so we exit from here, disable `ac-mode'
9948       ;; and run the command again with it original behavior.
9949       ;; `ac-mode' will be restored on exit.
9950       (return-from anything-completing-read-default
9951         (unwind-protect
9952              (progn
9953                (ac-mode -1)
9954                (apply completing-read-function def-args))
9955           (ac-mode 1))))
9956     ;; If we use now `completing-read' we MUST turn off `ac-mode'
9957     ;; to avoid infinite recursion and CRASH. It will be reenabled on exit.
9958     (when (or (eq def-com 'completing-read)
9959               ;; All specialized functions are prefixed by "anything"
9960               (and (stringp str-defcom)
9961                    (not (string-match "^anything" str-defcom))))
9962       (ac-mode -1))
9963     (unwind-protect
9964          (cond (;; An anything specialized function exists, run it.
9965                 (and def-com anything-completion-mode)
9966                 (apply def-com any-args))
9967                (;; Try to handle `ido-completing-read' everywhere.
9968                 (and def-com (eq def-com 'ido-completing-read))
9969                 (setcar (memq collection def-args)
9970                         (all-completions "" collection predicate))
9971                 (apply def-com def-args))
9972                (;; User set explicitely `completing-read' or something similar
9973                 ;; in *read-handlers-alist, use this with exactly the same
9974                 ;; args as in `completing-read'.
9975                 ;; If we are here `anything-completion-mode' is now disabled.
9976                 def-com
9977                 (apply def-com def-args))
9978                (t ; Fall back to classic `anything-comp-read'.
9979                 (anything-completing-read-default-1
9980                  prompt collection predicate require-match
9981                  initial-input hist def inherit-input-method
9982                  str-command buf-name)))
9983       (ac-mode 1)
9984       ;; When exiting minibuffer, `this-command' is set to
9985       ;; `anything-exit-minibuffer', which is unwanted when starting
9986       ;; on another `completing-read', so restore `this-command' to
9987       ;; initial value when exiting.
9988       (setq this-command current-command))))
9989
9990 (defun* anything-generic-read-file-name
9991     (prompt &optional dir default-filename mustmatch initial predicate)
9992   "An anything replacement of `read-file-name'."
9993   (declare (special anything-completion-mode))
9994   (let* ((default (and default-filename
9995                        (if (listp default-filename)
9996                            (car default-filename)
9997                            default-filename)))
9998          (init (or default initial dir default-directory))
9999          (ini-input (and init (expand-file-name init)))
10000          (current-command this-command)
10001          (str-command (symbol-name current-command))
10002          (anything-file-completion-sources
10003           (cons str-command
10004                 (remove str-command anything-file-completion-sources)))
10005          (buf-name (format "*ac-mode-%s*" str-command))
10006          (entry (assq current-command
10007                       anything-completing-read-handlers-alist))
10008          (def-com  (cdr-safe entry))
10009          (str-defcom (symbol-name def-com))
10010          (def-args (list prompt dir default-filename mustmatch initial predicate))
10011          ;; Append the two extra args needed to set the buffer and source name
10012          ;; in anything specialized functions.
10013          (any-args (append def-args (list str-command buf-name)))
10014          (ido-state ido-mode)
10015          anything-completion-mode-start-message ; Be quiet
10016          anything-completion-mode-quit-message  ; Same here
10017          fname)
10018     ;; Some functions that normally call `completing-read' can switch
10019     ;; brutally to `read-file-name' (e.g find-tag), in this case
10020     ;; the anything specialized function will fail because it is build
10021     ;; for `completing-read', so set it to 'incompatible to be sure
10022     ;; we switch to `anything-c-read-file-name' and don't try to call it
10023     ;; with wrong number of args.
10024     (when (and def-com (> (length (help-function-arglist def-com)) 8))
10025       (setq def-com 'incompatible))
10026     (when (eq def-com 'ido) (setq def-com 'ido-read-file-name))
10027     (unless (or (not entry) def-com)
10028       (return-from anything-generic-read-file-name
10029         (unwind-protect
10030              (progn
10031                (ac-mode -1)
10032                (apply read-file-name-function def-args))
10033           (ac-mode 1))))
10034     ;; If we use now `read-file-name' we MUST turn off `ac-mode'
10035     ;; to avoid infinite recursion and CRASH. It will be reenabled on exit.
10036     (when (or (eq def-com 'read-file-name)
10037               (eq def-com 'ido-read-file-name)
10038               (and (stringp str-defcom)
10039                    (not (string-match "^anything" str-defcom))))
10040       (ac-mode -1))
10041     (unwind-protect
10042          (setq fname
10043                (cond (;; A specialized function exists, run it
10044                       ;; with the two extra args specific to anything..
10045                       (and def-com anything-completion-mode
10046                            (not (eq def-com 'ido-read-file-name))
10047                            (not (eq def-com 'incompatible)))
10048                       (apply def-com any-args))
10049                      (;; Def-com value is `ido-read-file-name'
10050                       ;; run it with default args.
10051                       (and def-com (eq def-com 'ido-read-file-name))
10052                       (ido-mode 1)
10053                       (apply def-com def-args))
10054                      (;; Def-com value is `read-file-name'
10055                       ;; run it with default args.
10056                       (eq def-com 'read-file-name)
10057                       (apply def-com def-args))
10058                      (t ; Fall back to classic `anything-c-read-file-name'.
10059                       (anything-c-read-file-name
10060                        prompt
10061                        :name str-command
10062                        :buffer buf-name
10063                        :initial-input (expand-file-name init dir)
10064                        :alistp nil
10065                        :must-match mustmatch
10066                        :test predicate))))
10067       (ac-mode 1)
10068       (ido-mode (if ido-state 1 -1))
10069       ;; Same comment as in `anything-completing-read-default'.
10070       (setq this-command current-command))
10071     fname))
10072
10073 ;;;###autoload
10074 (define-minor-mode anything-completion-mode
10075     "Toggle generic anything completion.
10076
10077 All functions in Emacs that use `completing-read'
10078 or `read-file-name' and friends will use anything interface
10079 when this mode is turned on.
10080 However you can modify this behavior for functions of your choice
10081 with `anything-completing-read-handlers-alist'.
10082
10083 Called with a positive arg, turn on unconditionally, with a
10084 negative arg turn off.
10085 You can turn it on with `ac-mode'.
10086
10087 Some crap emacs functions may not be supported,
10088 e.g `ffap-alternate-file' and maybe others
10089 You can add such functions to `anything-completing-read-handlers-alist'
10090 with a nil value.
10091
10092 Note: This mode will work only partially on Emacs23."
10093   :group 'anything
10094   :global t
10095   :lighter anything-completion-mode-string
10096   (declare (special completing-read-function))
10097   (if anything-completion-mode
10098       (progn
10099         (setq completing-read-function 'anything-completing-read-default
10100               read-file-name-function  'anything-generic-read-file-name)
10101         (message anything-completion-mode-start-message))
10102       (setq completing-read-function (and (fboundp 'completing-read-default)
10103                                           'completing-read-default)
10104             read-file-name-function  (and (fboundp 'read-file-name-default)
10105                                           'read-file-name-default))
10106       (message anything-completion-mode-quit-message)))
10107
10108 (defalias 'ac-mode 'anything-completion-mode)
10109
10110
10111 \f
10112 ;;; Eshell completion.
10113 ;;
10114 ;; Enable like this in .emacs:
10115 ;;
10116 ;; (add-hook 'eshell-mode-hook
10117 ;;           #'(lambda ()
10118 ;;               (define-key eshell-mode-map [remap pcomplete] 'anything-esh-pcomplete)))
10119 ;;
10120 (defvar anything-c-source-esh
10121   '((name . "Eshell completions")
10122     (init . (lambda ()
10123               (setq pcomplete-current-completions nil
10124                     pcomplete-last-completion-raw nil)
10125               ;; Eshell-command add this hook in all minibuffers
10126               ;; Remove it for the anything one. (Fixed in Emacs24)
10127               (remove-hook 'minibuffer-setup-hook 'eshell-mode)))
10128     (candidates . anything-esh-get-candidates)
10129     (action . anything-ec-insert))
10130   "Anything source for Eshell completion.")
10131
10132 ;; Internal.
10133 (defvar anything-ec-target "")
10134 (defun anything-ec-insert (candidate)
10135   "Replace text at point with CANDIDATE.
10136 The function that call this should set `anything-ec-target' to thing at point.
10137 This is the same as `ac-insert', just inlined here for compatibility."
10138   (let ((pt (point)))
10139     (when (and anything-ec-target
10140                (search-backward anything-ec-target nil t)
10141                (string= (buffer-substring (point) pt) anything-ec-target))
10142       (delete-region (point) pt)))
10143   (insert (anything-quote-whitespace candidate)))
10144
10145 (defun anything-esh-get-candidates ()
10146   "Get candidates for eshell completion using `pcomplete'."
10147   (catch 'pcompleted
10148     (let* ((pcomplete-stub)
10149            pcomplete-seen pcomplete-norm-func
10150            pcomplete-args pcomplete-last pcomplete-index
10151            (pcomplete-autolist pcomplete-autolist)
10152            (pcomplete-suffix-list pcomplete-suffix-list))
10153       (with-anything-current-buffer
10154         (loop with table  = (pcomplete-completions)
10155               with entry  = (condition-case nil
10156                                 ;; On Emacs24 `try-completion' return
10157                                 ;; pattern when more than one result.
10158                                 ;; Otherwise Emacs23 return nil, which
10159                                 ;; is wrong, in this case use pattern
10160                                 ;; to behave like Emacs24.
10161                                 (or (try-completion anything-pattern
10162                                                     (pcomplete-entries))
10163                                     anything-pattern)
10164                               ;; In Emacs23 `pcomplete-entries' may fail
10165                               ;; with error, so try this instead.
10166                               (error
10167                                nil
10168                                (let ((fc (car (last
10169                                                (pcomplete-parse-arguments)))))
10170                                  ;; Check if last arg require fname completion.
10171                                  (and (file-name-directory fc) fc))))
10172               for i in (all-completions pcomplete-stub table)
10173               for file-cand = (and entry
10174                                    (if (file-remote-p i) i
10175                                        (expand-file-name
10176                                         i (file-name-directory entry))))
10177               if (and file-cand (or (file-remote-p file-cand)
10178                                     (file-exists-p file-cand)))
10179               collect file-cand into ls
10180               else collect i into ls
10181               finally return
10182               (if (and entry (not (string= entry "")) (file-exists-p entry))
10183                   (append (list (expand-file-name entry default-directory)) ls)
10184                   ls))))))
10185
10186 ;;; Eshell history.
10187 ;;
10188 ;;
10189 (defvar anything-c-source-eshell-history
10190   `((name . "Eshell history")
10191     (init . (lambda ()
10192               (let (eshell-hist-ignoredups)
10193                 ;; Write the content's of ring to file.
10194                 (eshell-write-history eshell-history-file-name t)
10195                 (with-current-buffer (anything-candidate-buffer 'global)
10196                   (insert-file-contents eshell-history-file-name)))
10197               ;; Same comment as in `anything-c-source-esh'
10198               (remove-hook 'minibuffer-setup-hook 'eshell-mode)))
10199     (candidates-in-buffer)
10200     (keymap . ,anything-eshell-history-map)
10201     (filtered-candidate-transformer . (lambda (candidates sources)
10202                                         (reverse candidates)))
10203     (candidate-number-limit . 9999)
10204     (action . (lambda (candidate)
10205                 (eshell-kill-input)
10206                 (insert candidate))))
10207   "Anything source for Eshell history.")
10208
10209 \f
10210 ;;; Show completion - an alternative of anything-show-completion.el.
10211 ;;
10212 ;; Provide show completion with macro `with-anything-show-completion'.
10213
10214
10215 ;; Called each time cursor move in anything-buffer.
10216 (defun anything-c-show-completion ()
10217   (with-anything-current-buffer
10218     (overlay-put anything-c-show-completion-overlay
10219                  'display (anything-get-selection))))
10220
10221 (defun anything-c-show-completion-init-overlay (beg end)
10222   (and anything-c-turn-on-show-completion
10223        (setq anything-c-show-completion-overlay (make-overlay beg end))
10224        (overlay-put anything-c-show-completion-overlay
10225                     'face 'anything-lisp-show-completion)))
10226
10227 (defun anything-c-show-completion-display-function (buffer)
10228   "A special resized anything window is used depending on position in BUFFER."
10229   (with-selected-window (selected-window)
10230     (let* ((screen-size  (+ (count-screen-lines (window-start) (point) t)
10231                             1                             ; mode-line
10232                             (if header-line-format 1 0))) ; header-line
10233            (def-size     (- (window-height)
10234                             anything-c-show-completion-min-window-height))
10235            (upper-height (max window-min-height (min screen-size def-size)))
10236            split-window-keep-point)
10237       (recenter -1)
10238       (set-window-buffer (if (active-minibuffer-window)
10239                              (minibuffer-selected-window)
10240                              (split-window nil upper-height))
10241                          buffer))))
10242
10243 (defmacro with-anything-show-completion (beg end &rest body)
10244   "Show anything candidate in an overlay at point.
10245 BEG and END are the beginning and end position of the current completion
10246 in `anything-current-buffer'.
10247 BODY is an anything call where we want to enable show completion.
10248 If `anything-c-turn-on-show-completion' is nil just do nothing."
10249   (declare (indent 2) (debug t))
10250   `(let ((anything-move-selection-after-hook
10251           (and anything-c-turn-on-show-completion
10252                (append (list 'anything-c-show-completion)
10253                        anything-move-selection-after-hook))))
10254      (unwind-protect
10255           (progn
10256             (anything-c-show-completion-init-overlay ,beg ,end)
10257             (let ((anything-display-function
10258                    (if anything-c-show-completion-use-special-display
10259                        'anything-c-show-completion-display-function
10260                        'anything-default-display-buffer)))
10261               ,@body))
10262        (and anything-c-turn-on-show-completion
10263             (delete-overlay anything-c-show-completion-overlay)))))
10264
10265 \f
10266 ;;; Lisp symbol completion.
10267 ;;
10268 ;;
10269 ;;;###autoload
10270 (defun anything-lisp-completion-at-point ()
10271   "Anything lisp symbol completion at point."
10272   (interactive)
10273   (let* ((data       (lisp-completion-at-point))
10274          (beg        (car data))
10275          (end        (point)) ; 'cadr data' is wrong when no space after point.
10276          (plist      (nthcdr 3 data))
10277          (pred       (plist-get plist :predicate))
10278          (lgst-len   0)
10279          (target     (and beg end (buffer-substring-no-properties beg end)))
10280          (candidates (all-completions target (nth 2 data) pred))
10281          (anything-quit-if-no-candidate t)
10282
10283          (anything-execute-action-at-once-if-one t)
10284          (anything-match-plugin-enabled
10285           (member 'anything-compile-source--match-plugin
10286                   anything-compile-source-functions)))
10287     (if candidates
10288         (with-anything-show-completion beg end
10289           ;; Overlay is initialized now in anything-current-buffer.
10290           (anything
10291            :sources
10292            '((name . "Lisp completion")
10293              (init . (lambda ()
10294                        (with-current-buffer (anything-candidate-buffer 'global)
10295                          (loop for sym in candidates
10296                                for len = (length sym)
10297                                when (> len lgst-len) do (setq lgst-len len)
10298                                do (insert (concat sym "\n"))))))
10299              (candidates-in-buffer)
10300              (persistent-action . anything-lisp-completion-persistent-action)
10301              (persistent-help . "Show brief doc in mode-line")
10302              (filtered-candidate-transformer anything-lisp-completion-transformer)
10303              (action . (lambda (candidate)
10304                          (delete-region beg end)
10305                          (insert candidate))))
10306            :input (if anything-match-plugin-enabled (concat target " ") target)))
10307         (message "[No Match]"))))
10308
10309 (defun anything-lisp-completion-persistent-action (candidate)
10310   (let ((cursor-in-echo-area t)
10311         mode-line-in-non-selected-windows)
10312     (anything-c-show-info-in-mode-line
10313      (propertize
10314       (anything-c-get-first-line-documentation
10315        (intern candidate))
10316       'face 'anything-lisp-completion-info))))
10317
10318 (defun anything-lisp-completion-transformer (candidates source)
10319   "Anything candidates transformer for lisp completion."
10320   (declare (special lgst-len))
10321   (loop for c in candidates
10322         for sym = (intern c)
10323         for annot = (cond ((commandp sym) " (Com)")
10324                           ((fboundp sym)  " (Fun)")
10325                           ((boundp sym)   " (Var)")
10326                           ((facep sym)    " (Face)"))
10327         for spaces = (make-string (- lgst-len (length c)) ? )
10328         collect (cons (concat c spaces annot) c)))
10329
10330 (defun anything-c-get-first-line-documentation (sym)
10331   "Return first line documentation of symbol SYM.
10332 If SYM is not documented, return \"Not documented\"."
10333   (let ((doc (cond ((fboundp sym)
10334                     (documentation sym t))
10335                    ((boundp sym)
10336                     (documentation-property sym 'variable-documentation t))
10337                    ((facep sym)
10338                     (face-documentation sym))
10339                    (t nil))))
10340     (if (and doc (not (string= doc ""))
10341              ;; `documentation' return "\n\n(args...)"
10342              ;; for CL-style functions.
10343              (not (string-match-p "^\n\n" doc)))
10344         (car (split-string doc "\n"))
10345         "Not documented")))
10346
10347 ;;; File completion.
10348 ;;
10349 ;; Complete file name at point.
10350 (defun anything-c-thing-before-point ()
10351   "Get symbol name before point.
10352 Borrowed from anything-complete.el, inlined here for compatibility."
10353   (save-excursion
10354     (let ((beg (point)))
10355       ;; older regexp "\(\\|\\s-\\|^\\|\\_<\\|\r\\|'\\|#'"
10356       (when (re-search-backward
10357              "\\_<" (field-beginning nil nil (point-at-bol)) t)
10358         (buffer-substring-no-properties beg (match-end 0))))))
10359
10360 ;;;###autoload
10361 (defun anything-c-complete-file-name-at-point ()
10362   "Complete file name at point."
10363   (interactive)
10364   (let* ((init (substring-no-properties (thing-at-point 'filename)))
10365          (end  (point))
10366          (beg  (- (point) (length init)))
10367          (anything-quit-if-no-candidate t)
10368          (anything-execute-action-at-once-if-one t)
10369          completion)
10370     (with-anything-show-completion beg end
10371       (setq completion (anything-c-read-file-name "FileName: "
10372                                                   :initial-input init)))
10373     (anything-c-insert-file-name-completion-at-point completion)))
10374
10375 ;; Internal
10376 (defvar anything-lisp-completion-counter 0)
10377 ;;;###autoload
10378 (defun anything-lisp-completion-at-point-or-indent (arg)
10379   "First call indent and second call complete lisp symbol.
10380 The second call should happen before `anything-lisp-completion-or-indent-delay',
10381 after this delay, next call will indent again.
10382 After completion, next call is always indent.
10383 See that like click and double mouse click.
10384 One hit indent, two quick hits maybe indent and complete."
10385   (interactive "P")
10386   ;; Be sure `indent-for-tab-command' will not try
10387   ;; to use `completion-at-point'.
10388   (let ((tab-always-indent (if (eq tab-always-indent 'complete)
10389                                t tab-always-indent)))
10390     (incf anything-lisp-completion-counter)
10391     (unwind-protect
10392          (if (> anything-lisp-completion-counter 1)
10393              (anything-lisp-completion-or-file-name-at-point)
10394              (indent-for-tab-command arg))
10395       ;; After `anything-lisp-completion-or-indent-delay' seconds
10396       ;; reset to 0.
10397       (run-with-timer anything-lisp-completion-or-indent-delay nil
10398                       #'(lambda ()
10399                           (setq anything-lisp-completion-counter 0)))
10400       ;; Always reset to 0 at second hit.
10401       (when (eq anything-lisp-completion-counter 2)
10402         (setq anything-lisp-completion-counter 0)))))
10403
10404 ;;;###autoload
10405 (defun anything-lisp-completion-or-file-name-at-point ()
10406   "Complete lisp symbol or filename at point.
10407 Filename completion happen if filename is started in
10408 or between double quotes."
10409   (interactive)
10410   (let ((tap (substring-no-properties (thing-at-point 'filename))))
10411     (if (and tap (string-match "^\\(~/\\|/\\|[a-zA-Z]\:/\\).*" tap)
10412              (save-excursion (search-backward "\"" (point-at-bol) t)))
10413         (anything-c-complete-file-name-at-point)
10414         (anything-lisp-completion-at-point))))
10415
10416 (defun anything-c-apropos-init (test default)
10417   "Init candidates buffer for `anything-c-apropos' sources."
10418   (with-current-buffer (anything-candidate-buffer 'global)
10419     (goto-char (point-min))
10420     (when (and default (stringp default)
10421                ;; Some defaults args result as
10422                ;; (symbol-name nil) == "nil".
10423                ;; e.g debug-on-entry.
10424                (not (string= default "nil"))
10425                (funcall test (intern default)))
10426       (insert (concat default "\n")))
10427     (loop with all = (all-completions "" obarray test)
10428           for sym in all
10429           unless (and default (eq sym default))
10430           do (insert (concat sym "\n")))))
10431
10432 \f
10433 ;;; Run Externals commands within Emacs with anything completion
10434 ;;
10435 ;;
10436 (defvar anything-external-command-history nil)
10437
10438 (defun anything-c-external-commands-list-1 (&optional sort)
10439   "Returns a list of all external commands the user can execute.
10440 If `anything-c-external-commands-list' is non-nil it will
10441 return its contents.  Else it calculates all external commands
10442 and sets `anything-c-external-commands-list'."
10443   (if anything-c-external-commands-list
10444       anything-c-external-commands-list
10445       (setq anything-c-external-commands-list
10446             (loop
10447                   with paths = (split-string (getenv "PATH") path-separator)
10448                   with completions = ()
10449                   for dir in paths
10450                   when (and (file-exists-p dir) (file-accessible-directory-p dir))
10451                   for lsdir = (loop for i in (directory-files dir t)
10452                                     for bn = (file-name-nondirectory i)
10453                                     when (and (not (member bn completions))
10454                                               (not (file-directory-p i))
10455                                               (file-executable-p i))
10456                                     collect bn)
10457                   append lsdir into completions
10458                   finally return (if sort (sort completions 'string-lessp) completions)))))
10459
10460 (defun anything-run-or-raise (exe &optional file)
10461   "Generic command that run asynchronously EXE.
10462 If EXE is already running just jump to his window if `anything-raise-command'
10463 is non--nil.
10464 When FILE argument is provided run EXE with FILE.
10465 In this case EXE must be provided as \"EXE %s\"."
10466   (lexical-let* ((real-com (car (split-string (replace-regexp-in-string
10467                                                "%s" "" exe))))
10468                  (proc     (if file (concat real-com " " file) real-com)))
10469     (if (get-process proc)
10470         (if anything-raise-command
10471             (shell-command  (format anything-raise-command real-com))
10472             (error "Error: %s is already running" real-com))
10473         (when (loop for i in anything-c-external-commands-list thereis real-com)
10474           (message "Starting %s..." real-com)
10475           (if file
10476               (start-process-shell-command
10477                proc nil (format exe (shell-quote-argument
10478                                      (if (eq system-type 'windows-nt)
10479                                          (anything-w32-prepare-filename file)
10480                                          file))))
10481               (start-process-shell-command proc nil real-com))
10482           (set-process-sentinel
10483            (get-process proc)
10484            #'(lambda (process event)
10485                (when (and (string= event "finished\n")
10486                           anything-raise-command
10487                           (not (anything-c-get-pid-from-process-name real-com)))
10488                  (shell-command  (format anything-raise-command "emacs")))
10489                (message "%s process...Finished." process))))
10490         (setq anything-c-external-commands-list
10491               (cons real-com
10492                     (delete real-com anything-c-external-commands-list))))))
10493
10494
10495 \f
10496 ;;; Generic action functions
10497 ;;
10498 ;;
10499 (defun anything-c-file-buffers (filename)
10500   "Returns a list of buffer names corresponding to FILENAME."
10501   (let ((name     (expand-file-name filename))
10502         (buf-list ()))
10503     (dolist (buf (buffer-list) buf-list)
10504       (let ((bfn (buffer-file-name buf)))
10505         (when (and bfn (string= name bfn))
10506           (push (buffer-name buf) buf-list))))))
10507
10508 (defun anything-revert-buffer (candidate)
10509   (with-current-buffer candidate
10510     (when (or (buffer-modified-p)
10511               (not (verify-visited-file-modtime
10512                     (get-buffer candidate))))
10513       (revert-buffer t t))))
10514
10515 (defun anything-revert-marked-buffers (ignore)
10516   (mapc 'anything-revert-buffer (anything-marked-candidates)))
10517
10518 (defun anything-kill-marked-buffers (ignore)
10519   (mapc 'kill-buffer (anything-marked-candidates)))
10520
10521 (defun anything-c-delete-file (file &optional error-if-dot-file-p)
10522   "Delete the given file after querying the user.
10523 Ask to kill buffers associated with that file, too."
10524   (when (and error-if-dot-file-p
10525              (anything-ff-dot-file-p file))
10526     (error "Error: Cannot operate on `.' or `..'"))
10527   (let ((buffers (anything-c-file-buffers file)))
10528     (if (< emacs-major-version 24)
10529         ;; `dired-delete-file' in Emacs versions < 24
10530         ;; doesn't support delete-by-moving-to-trash
10531         ;; so use `delete-directory' and `delete-file'
10532         ;; that handle it.
10533         (cond ((and (not (file-symlink-p file))
10534                     (file-directory-p file)
10535                     (directory-files file t dired-re-no-dot))
10536                (when (y-or-n-p (format "Recursive delete of `%s'? " file))
10537                  (delete-directory file 'recursive)))
10538               ((and (not (file-symlink-p file))
10539                     (file-directory-p file))
10540                (delete-directory file))
10541               (t (delete-file file)))
10542         (dired-delete-file
10543          file 'dired-recursive-deletes delete-by-moving-to-trash))
10544     (when buffers
10545       (dolist (buf buffers)
10546         (when (y-or-n-p (format "Kill buffer %s, too? " buf))
10547           (kill-buffer buf))))))
10548
10549 (defun anything-get-mailcap-for-file (filename)
10550   "Get the command to use for FILENAME from mailcap files.
10551 The command is like <command %s> and is meant to use with `format'."
10552   (mailcap-parse-mailcaps)
10553   (let* ((ext  (file-name-extension filename))
10554          (mime (when ext (mailcap-extension-to-mime ext)))
10555          (result (when mime (mailcap-mime-info mime))))
10556     ;; If elisp file have no associations in .mailcap
10557     ;; `mailcap-maybe-eval' is returned, in this case just return nil.
10558     (when (stringp result) result)))
10559
10560 (defun anything-get-default-program-for-file (filename)
10561   "Try to find a default program to open FILENAME.
10562 Try first in `anything-c-external-programs-associations' and then in mailcap file
10563 if nothing found return nil."
10564   (let* ((ext      (file-name-extension filename))
10565          (def-prog (assoc-default ext anything-c-external-programs-associations)))
10566     (cond ((and def-prog (not (string= def-prog "")))
10567            (concat def-prog " %s"))
10568           ((and anything-c-default-external-file-browser
10569                 (file-directory-p filename))
10570            (concat anything-c-default-external-file-browser " %s"))
10571           (t (anything-get-mailcap-for-file filename)))))
10572
10573 (defun anything-c-open-file-externally (file)
10574   "Open FILE with an external program.
10575 Try to guess which program to use with `anything-get-default-program-for-file'.
10576 If not found or a prefix arg is given query the user which tool to use."
10577   (let* ((fname          (expand-file-name file))
10578          (collection     (anything-c-external-commands-list-1 'sort))
10579          (def-prog       (anything-get-default-program-for-file fname))
10580          (real-prog-name (if (or anything-current-prefix-arg (not def-prog))
10581                              ;; Prefix arg or no default program.
10582                              (prog1
10583                                  (anything-comp-read
10584                                   "Program: " collection
10585                                   :must-match t
10586                                   :name "Open file Externally"
10587                                   :history anything-external-command-history)
10588                                ;; Always prompt to set this program as default.
10589                                (setq def-prog nil))
10590                              ;; No prefix arg or default program exists.
10591                              (replace-regexp-in-string " %s\\| '%s'" "" def-prog)))
10592          (program        (concat real-prog-name " %s")))
10593     (unless (or def-prog ; Association exists, no need to record it.
10594                 ;; Don't try to record non--filenames associations (e.g urls).
10595                 (not (file-exists-p fname)))
10596       (when
10597           (y-or-n-p
10598            (format
10599             "Do you want to make `%s' the default program for this kind of files? "
10600             real-prog-name))
10601         (anything-aif (assoc (file-name-extension fname)
10602                              anything-c-external-programs-associations)
10603             (setq anything-c-external-programs-associations
10604                   (delete it anything-c-external-programs-associations)))
10605         (push (cons (file-name-extension fname)
10606                     (read-string
10607                      "Program (Add args maybe and confirm): " real-prog-name))
10608               anything-c-external-programs-associations)
10609         (customize-save-variable 'anything-c-external-programs-associations
10610                                  anything-c-external-programs-associations)))
10611     (anything-run-or-raise program file)
10612     (setq anything-external-command-history
10613           (cons real-prog-name
10614                 (delete real-prog-name
10615                         (loop for i in anything-external-command-history
10616                               when (executable-find i) collect i))))))
10617
10618 (defun anything-c-find-file-or-marked (candidate)
10619   "Open file CANDIDATE or open anything marked files in background."
10620   (let ((marked (anything-marked-candidates))
10621         (ffap-newfile-prompt anything-ff-newfile-prompt-p)
10622         (find-file-wildcards nil))
10623     (if (> (length marked) 1)
10624         ;; Open all marked files in background and display
10625         ;; the first one.
10626         (progn (mapc 'find-file-noselect (cdr marked))
10627                (find-file (car marked)))
10628         (if (and (not (file-exists-p candidate))
10629                  (and ffap-url-regexp
10630                       (not (string-match ffap-url-regexp candidate)))
10631                  (string-match "/$" candidate))
10632             ;; A a non--existing filename ending with /
10633             ;; Create a directory and jump to it.
10634             (when (y-or-n-p (format "Create directory `%s'? " candidate))
10635               (let ((dirfname (directory-file-name candidate)))
10636                 (if (file-exists-p dirfname)
10637                     (error "Mkdir: Unable to create directory `%s': file exists."
10638                            (anything-c-basename dirfname))
10639                     (make-directory candidate 'parent)))
10640               (anything-find-files-1 candidate))
10641             ;; A non--existing filename NOT ending with / or
10642             ;; an existing filename, create or jump to it.
10643             (find-file-at-point (car marked))))))
10644
10645 (defun anything-delete-marked-files (ignore)
10646   (let* ((files (anything-marked-candidates))
10647          (len (length files)))
10648     (if (not (y-or-n-p
10649               (format "Delete *%s File(s):\n%s"
10650                       len
10651                       (mapconcat (lambda (f) (format "- %s\n" f)) files ""))))
10652         (message "(No deletions performed)")
10653         (dolist (i files)
10654           (set-text-properties 0 (length i) nil i)
10655           (anything-c-delete-file i anything-ff-signal-error-on-dot-files))
10656         (message "%s File(s) deleted" len))))
10657
10658 (defun anything-ediff-marked-buffers (candidate &optional merge)
10659   "Ediff 2 marked buffers or CANDIDATE and `anything-current-buffer'.
10660 With optional arg MERGE call `ediff-merge-buffers'."
10661   (let ((lg-lst (length (anything-marked-candidates)))
10662         buf1 buf2)
10663     (case lg-lst
10664       (0
10665        (error "Error:You have to mark at least 1 buffer"))
10666       (1
10667        (setq buf1 anything-current-buffer
10668              buf2 (first (anything-marked-candidates))))
10669       (2
10670        (setq buf1 (first (anything-marked-candidates))
10671              buf2 (second (anything-marked-candidates))))
10672       (t
10673        (error "Error:To much buffers marked!")))
10674     (if merge
10675         (ediff-merge-buffers buf1 buf2)
10676         (ediff-buffers buf1 buf2))))
10677
10678 (defun anything-ediff-marked-buffers-merge (candidate)
10679   "Ediff merge `anything-current-buffer' with CANDIDATE.
10680 See `anything-ediff-marked-buffers'."
10681   (anything-ediff-marked-buffers candidate t))
10682
10683 (defun anything-bookmark-get-bookmark-from-name (bmk)
10684   "Return bookmark name even if it is a bookmark with annotation.
10685 e.g prepended with *.
10686 Return nil if bmk is not a valid bookmark."
10687   (let ((bookmark (replace-regexp-in-string "\*" "" bmk)))
10688     (if (assoc bookmark bookmark-alist)
10689         bookmark
10690         (when (assoc bmk bookmark-alist)
10691           bmk))))
10692
10693 (defun anything-delete-marked-bookmarks (ignore)
10694   "Delete this bookmark or all marked bookmarks."
10695   (dolist (i (anything-marked-candidates))
10696     (bookmark-delete (anything-bookmark-get-bookmark-from-name i)
10697                      'batch)))
10698
10699 (defun anything-require-or-error (feature function)
10700   (or (require feature nil t)
10701       (error "Need %s to use `%s'." feature function)))
10702
10703 (defun anything-find-buffer-on-elscreen (candidate)
10704   "Open buffer in new screen, if marked buffers open all in elscreens."
10705   (anything-require-or-error 'elscreen 'anything-find-buffer-on-elscreen)
10706   (anything-aif (anything-marked-candidates)
10707       (dolist (i it)
10708         (let ((target-screen (elscreen-find-screen-by-buffer
10709                               (get-buffer i) 'create)))
10710           (elscreen-goto target-screen)))
10711     (let ((target-screen (elscreen-find-screen-by-buffer
10712                           (get-buffer candidate) 'create)))
10713       (elscreen-goto target-screen))))
10714
10715 (defun anything-elscreen-find-file (file)
10716   (anything-require-or-error 'elscreen 'anything-elscreen-find-file)
10717   (elscreen-find-file file))
10718
10719 (defun anything-w32-prepare-filename (file)
10720   "Convert filename FILE to something usable by external w32 executables."
10721   (replace-regexp-in-string ; For UNC paths
10722    "/" "\\"
10723    (replace-regexp-in-string ; Strip cygdrive paths
10724     "/cygdrive/\\(.\\)" "\\1:"
10725     file nil nil) nil t))
10726
10727 ;;;###autoload
10728 (defun anything-w32-shell-execute-open-file (file)
10729   (interactive "fOpen file:")
10730   (with-no-warnings
10731     (w32-shell-execute "open" (anything-w32-prepare-filename file))))
10732
10733 (defun anything-c-open-file-with-default-tool (file)
10734   "Open FILE with the default tool on this platform."
10735   (if (eq system-type 'windows-nt)
10736       (anything-w32-shell-execute-open-file file)
10737       (start-process "anything-c-open-file-with-default-tool"
10738                      nil
10739                      (cond ((eq system-type 'gnu/linux)
10740                             "xdg-open")
10741                            ((or (eq system-type 'darwin) ;; Mac OS X
10742                                 (eq system-type 'macos)) ;; Mac OS 9
10743                             "open"))
10744                      file)))
10745
10746 (defun anything-c-open-dired (file)
10747   "Opens a dired buffer in FILE's directory.  If FILE is a
10748 directory, open this directory."
10749   (if (file-directory-p file)
10750       (dired file)
10751       (dired (file-name-directory file))
10752       (dired-goto-file file)))
10753
10754 (defun anything-c-display-to-real-line (candidate)
10755   (if (string-match "^ *\\([0-9]+\\):\\(.*\\)$" candidate)
10756       (list (string-to-number (match-string 1 candidate)) (match-string 2 candidate))
10757       (error "Line number not found")))
10758
10759 (defun anything-c-action-line-goto (lineno-and-content)
10760   (apply #'anything-goto-file-line (anything-interpret-value (anything-attr 'target-file))
10761          (append lineno-and-content
10762                  (list (if (and (anything-attr-defined 'target-file)
10763                                 (not anything-in-persistent-action))
10764                            'find-file-other-window
10765                            'find-file)))))
10766
10767 (defun* anything-c-action-file-line-goto (file-line-content &optional (find-file-function #'find-file))
10768   (apply #'anything-goto-file-line
10769          (if (stringp file-line-content)
10770              ;; Case: filtered-candidate-transformer is skipped
10771              (cdr (anything-c-filtered-candidate-transformer-file-line-1 file-line-content))
10772              file-line-content)))
10773
10774 (require 'compile)
10775 (defun anything-c-filtered-candidate-transformer-file-line (candidates source)
10776   (delq nil (mapcar 'anything-c-filtered-candidate-transformer-file-line-1 candidates)))
10777
10778 (defun anything-c-filtered-candidate-transformer-file-line-1 (candidate)
10779   (when (string-match "^\\(.+?\\):\\([0-9]+\\):\\(.*\\)$" candidate)
10780     (let ((filename (match-string 1 candidate))
10781           (lineno (match-string 2 candidate))
10782           (content (match-string 3 candidate)))
10783       (cons (format "%s:%s\n %s"
10784                     (propertize filename 'face compilation-info-face)
10785                     (propertize lineno 'face compilation-line-face)
10786                     content)
10787             (list (expand-file-name
10788                    filename
10789                    (or (anything-interpret-value (anything-attr 'default-directory))
10790                        (and (anything-candidate-buffer)
10791                             (buffer-local-value
10792                              'default-directory (anything-candidate-buffer)))))
10793                   (string-to-number lineno) content)))))
10794
10795 (defun* anything-goto-file-line (file lineno content &optional (find-file-function #'find-file))
10796   (anything-aif (anything-attr 'before-jump-hook)
10797       (funcall it))
10798   (when file (funcall find-file-function file))
10799   (if (anything-attr-defined 'adjust)
10800       (anything-c-goto-line-with-adjustment lineno content)
10801       (anything-goto-line lineno))
10802   (unless (anything-attr-defined 'recenter)
10803     (set-window-start (get-buffer-window anything-current-buffer) (point)))
10804   (anything-aif (anything-attr 'after-jump-hook)
10805       (funcall it))
10806   (when anything-in-persistent-action
10807     (anything-match-line-color-current-line)))
10808
10809 (defun anything-find-file-as-root (candidate)
10810   (find-file (concat "/" anything-su-or-sudo "::" (expand-file-name candidate))))
10811
10812 (defun anything-find-many-files (ignore)
10813   (mapc 'find-file (anything-marked-candidates)))
10814
10815 ;; borrowed from etags.el
10816 ;; (anything-c-goto-line-with-adjustment (line-number-at-pos) ";; borrowed from etags.el")
10817 (defun anything-c-goto-line-with-adjustment (line line-content)
10818   (let ((startpos)
10819         offset found pat)
10820     ;; This constant is 1/2 the initial search window.
10821     ;; There is no sense in making it too small,
10822     ;; since just going around the loop once probably
10823     ;; costs about as much as searching 2000 chars.
10824     (setq offset 1000
10825           found nil
10826           pat (concat (if (eq selective-display t)
10827                           "\\(^\\|\^m\\) *" "^ *") ;allow indent
10828                       (regexp-quote line-content)))
10829     ;; If no char pos was given, try the given line number.
10830     (setq startpos (progn (anything-goto-line line) (point)))
10831     (or startpos (setq startpos (point-min)))
10832     ;; First see if the tag is right at the specified location.
10833     (goto-char startpos)
10834     (setq found (looking-at pat))
10835     (while (and (not found)
10836                 (progn
10837                   (goto-char (- startpos offset))
10838                   (not (bobp))))
10839       (setq found
10840             (re-search-forward pat (+ startpos offset) t)
10841             offset (* 3 offset)))       ; expand search window
10842     (or found
10843         (re-search-forward pat nil t)
10844         (error "not found")))
10845   ;; Position point at the right place
10846   ;; if the search string matched an extra Ctrl-m at the beginning.
10847   (and (eq selective-display t)
10848        (looking-at "\^m")
10849        (forward-char 1))
10850   (beginning-of-line))
10851
10852 (anything-document-attribute 'default-directory "type . file-line"
10853                              "`default-directory' to interpret file.")
10854 (anything-document-attribute 'before-jump-hook "type . file-line / line"
10855                              "Function to call before jumping to the target location.")
10856 (anything-document-attribute 'after-jump-hook "type . file-line / line"
10857                              "Function to call after jumping to the target location.")
10858 (anything-document-attribute 'adjust "type . file-line"
10859                              "Search around line matching line contents.")
10860 (anything-document-attribute 'recenter "type . file-line / line"
10861                              "`recenter' after jumping.")
10862 (anything-document-attribute 'target-file "type . line"
10863                              "Goto line of target-file.")
10864
10865 ;;;###autoload
10866 (defun anything-c-call-interactively (cmd-or-name)
10867   "Execute CMD-OR-NAME as Emacs command.
10868 It is added to `extended-command-history'.
10869 `anything-current-prefix-arg' is used as the command's prefix argument."
10870   (setq extended-command-history
10871         (cons (anything-c-stringify cmd-or-name)
10872               (delete (anything-c-stringify cmd-or-name) extended-command-history)))
10873   (let ((current-prefix-arg anything-current-prefix-arg)
10874         (cmd (anything-c-symbolify cmd-or-name)))
10875     (if (stringp (symbol-function cmd))
10876         (execute-kbd-macro (symbol-function cmd))
10877         (setq this-command cmd)
10878         (call-interactively cmd))))
10879
10880 ;;;###autoload
10881 (defun anything-c-set-variable (var)
10882   "Set value to VAR interactively."
10883   (interactive)
10884   (let ((sym (anything-c-symbolify var)))
10885     (set sym (eval-minibuffer (format "Set %s: " var)
10886                               (prin1-to-string (symbol-value sym))))))
10887 ;; (setq hh 12)
10888 ;; (anything-c-set-variable 'hh)
10889
10890
10891 \f
10892 ;;; Persistent Action Helpers
10893 ;;
10894 ;;
10895 (defvar anything-match-line-overlay-face nil)
10896 (defvar anything-match-line-overlay nil)
10897
10898 (defun anything-match-line-color-current-line (&optional start end buf face rec)
10899   "Highlight and underline current position"
10900   (let ((args (list (or start (line-beginning-position))
10901                     (or end (1+ (line-end-position)))
10902                     buf)))
10903     (if (not anything-match-line-overlay)
10904         (setq anything-match-line-overlay (apply 'make-overlay args))
10905         (apply 'move-overlay anything-match-line-overlay args)))
10906   (overlay-put anything-match-line-overlay
10907                'face (or face anything-match-line-overlay-face))
10908   (when rec
10909     (goto-char start)
10910     (recenter)))
10911
10912 (defalias 'anything-persistent-highlight-point 'anything-match-line-color-current-line)
10913
10914
10915 (setq anything-match-line-overlay-face 'anything-overlay-line-face)
10916
10917 (defun anything-match-line-cleanup ()
10918   (when anything-match-line-overlay
10919     (delete-overlay anything-match-line-overlay)
10920     (setq anything-match-line-overlay nil)))
10921
10922 (defun anything-match-line-update ()
10923   (when anything-match-line-overlay
10924     (delete-overlay anything-match-line-overlay)
10925     (anything-match-line-color-current-line)))
10926
10927 (add-hook 'anything-cleanup-hook 'anything-match-line-cleanup)
10928 (add-hook 'anything-after-persistent-action-hook 'anything-match-line-update)
10929
10930 \f
10931 ;;; Actions Transformers
10932 ;;
10933 ;;
10934 ;;; Files
10935 (defun anything-c-transform-file-load-el (actions candidate)
10936   "Add action to load the file CANDIDATE if it is an emacs lisp
10937 file.  Else return ACTIONS unmodified."
10938   (if (member (file-name-extension candidate) '("el" "elc"))
10939       (append actions '(("Load Emacs Lisp File" . load-file)))
10940       actions))
10941
10942 (defun anything-c-transform-file-browse-url (actions candidate)
10943   "Add an action to browse the file CANDIDATE if it in a html
10944 file or URL.  Else return ACTIONS unmodified."
10945   (let ((browse-action '("Browse with Browser" . browse-url)))
10946     (cond ((string-match "^http\\|^ftp" candidate)
10947            (cons browse-action actions))
10948           ((string-match "\\.html?$" candidate)
10949            (append actions (list browse-action)))
10950           (t actions))))
10951
10952 ;;; Function
10953 (defun anything-c-transform-function-call-interactively (actions candidate)
10954   "Add an action to call the function CANDIDATE interactively if
10955 it is a command.  Else return ACTIONS unmodified."
10956   (if (commandp (intern-soft candidate))
10957       (append actions '(("Call Interactively"
10958                          .
10959                          anything-c-call-interactively)))
10960       actions))
10961
10962 ;;;; S-Expressions
10963 (defun anything-c-transform-sexp-eval-command-sexp (actions candidate)
10964   "If CANDIDATE's `car' is a command, then add an action to
10965 evaluate it and put it onto the `command-history'."
10966   (if (commandp (car (read candidate)))
10967       ;; Make it first entry
10968       (cons '("Eval and put onto command-history" .
10969               (lambda (sexp)
10970                 (let ((sym (read sexp)))
10971                   (eval sym)
10972                   (setq command-history
10973                         (cons sym command-history)))))
10974             actions)
10975       actions))
10976
10977 \f
10978 ;;; Candidate Transformers
10979 ;;
10980 ;;
10981 ;;; Buffers
10982 (defun anything-c-skip-boring-buffers (buffers)
10983   (anything-c-skip-entries buffers anything-c-boring-buffer-regexp))
10984
10985 (defun anything-c-skip-current-buffer (buffers)
10986   "[DEPRECATED] Skip current buffer in buffer lists.
10987 This transformer should not be used as this is now handled directly
10988 in `anything-c-buffer-list' and `anything-c-highlight-buffers'."
10989   (if anything-allow-skipping-current-buffer
10990       (remove (buffer-name anything-current-buffer) buffers)
10991       buffers))
10992
10993 (defun anything-c-shadow-boring-buffers (buffers)
10994   "Buffers matching `anything-c-boring-buffer-regexp' will be
10995 displayed with the `file-name-shadow' face if available."
10996   (anything-c-shadow-entries buffers anything-c-boring-buffer-regexp))
10997
10998 (defvar anything-c-buffer-display-string-functions
10999   '(anything-c-buffer-display-string--compilation
11000     anything-c-buffer-display-string--shell
11001     anything-c-buffer-display-string--eshell)
11002   "Functions to setup display string for buffer.
11003
11004 Function has one argument, buffer name.
11005 If it returns string, use it.
11006 If it returns nil, display buffer name.
11007 See `anything-c-buffer-display-string--compilation' for example.")
11008
11009 (defun anything-c-transform-buffer-display-string (buffers)
11010   "Setup display string for buffer candidates
11011 using `anything-c-buffer-display-string-functions'."
11012   (loop for buf in buffers
11013         if (consp buf)
11014         collect buf
11015         else
11016         for disp = (progn (set-buffer buf)
11017                           (run-hook-with-args-until-success
11018                            'anything-c-buffer-display-string-functions buf))
11019         collect (if disp (cons disp buf) buf)))
11020
11021 (defun anything-c-buffer-display-string--compilation (buf)
11022   (anything-aif (car compilation-arguments)
11023       (format "%s: %s [%s]" buf it default-directory)))
11024
11025 (defun anything-c-buffer-display-string--eshell (buf)
11026   (declare (special eshell-history-ring))
11027   (when (eq major-mode 'eshell-mode)
11028     (format "%s: %s [%s]" buf
11029             (ignore-errors (ring-ref eshell-history-ring 0))
11030             default-directory)))
11031
11032 (defun anything-c-buffer-display-string--shell (buf)
11033   (when (eq major-mode 'shell-mode)
11034     (format "%s: %s [%s]" buf
11035             (ignore-errors (ring-ref comint-input-ring 0))
11036             default-directory)))
11037
11038 ;;; Files
11039 (defun anything-c-shadow-boring-files (files)
11040   "Files matching `anything-c-boring-file-regexp' will be
11041 displayed with the `file-name-shadow' face if available."
11042   (anything-c-shadow-entries files anything-c-boring-file-regexp))
11043
11044 (defun anything-c-skip-boring-files (files)
11045   "Files matching `anything-c-boring-file-regexp' will be skipped."
11046   (anything-c-skip-entries files anything-c-boring-file-regexp))
11047 ;; (anything-c-skip-boring-files '("README" "/src/.svn/hoge"))
11048
11049 (defun anything-c-skip-current-file (files)
11050   "Current file will be skipped."
11051   (remove (buffer-file-name anything-current-buffer) files))
11052
11053 (defun anything-c-w32-pathname-transformer (args)
11054   "Change undesirable features of windows pathnames to ones more acceptable to
11055 other candidate transformers."
11056   (if (eq system-type 'windows-nt)
11057       (anything-transform-mapcar
11058        (lambda (x)
11059          (replace-regexp-in-string
11060           "/cygdrive/\\(.\\)" "\\1:"
11061           (replace-regexp-in-string "\\\\" "/" x)))
11062        args)
11063     args))
11064
11065 (defun anything-c-shorten-home-path (files)
11066   "Replaces /home/user with ~."
11067   (let ((home (replace-regexp-in-string "\\\\" "/" ; stupid Windows...
11068                                         (getenv "HOME"))))
11069     (anything-transform-mapcar
11070      (lambda (file)
11071        (if (and (stringp file) (string-match home file))
11072            (cons (replace-match "~" nil nil file) file)
11073          file))
11074      files)))
11075
11076 ;;; Functions
11077 (defun anything-c-mark-interactive-functions (functions)
11078   "Mark interactive functions (commands) with (i) after the function name."
11079   (let (list)
11080     (loop for function in functions
11081           do (push (cons (concat function
11082                                  (when (commandp (intern-soft function)) " (i)"))
11083                          function)
11084                    list)
11085           finally (return (nreverse list)))))
11086
11087 \f
11088 ;;; Adaptive Sorting of Candidates
11089 ;;
11090 ;;
11091 ;; Internal
11092 (defvar anything-c-adaptive-done nil
11093   "nil if history information is not yet stored for the current
11094 selection.")
11095
11096 (defvar anything-c-adaptive-history nil
11097   "Contains the stored history information.
11098 Format: ((SOURCE-NAME (SELECTED-CANDIDATE (PATTERN . NUMBER-OF-USE) ...) ...) ...)")
11099
11100 ;; Should run at beginning of `anything-initial-setup'.
11101 (add-hook 'anything-before-initialize-hook #'(lambda ()
11102                                                (when anything-c-use-adaptative-sorting
11103                                                  (setq anything-c-adaptive-done nil))))
11104
11105 ;; Should run at beginning of `anything-exit-minibuffer'.
11106 (add-hook 'anything-before-action-hook #'(lambda ()
11107                                           (when anything-c-use-adaptative-sorting
11108                                             (anything-c-adaptive-store-selection))))
11109
11110 ;; Should run at beginning of `anything-select-action'.
11111 (add-hook 'anything-select-action-hook #'(lambda ()
11112                                            (when anything-c-use-adaptative-sorting
11113                                              (anything-c-adaptive-store-selection))))
11114
11115 (defun anything-c-source-use-adaptative-p (&optional source-name)
11116   "Return current source only if it use adaptative history, nil otherwise."
11117   (when anything-c-use-adaptative-sorting
11118     (let* ((source (or source-name (anything-get-current-source)))
11119            (adapt-source (or (assoc-default 'filtered-candidate-transformer
11120                                             (assoc (assoc-default 'type source)
11121                                                    anything-type-attributes))
11122                              (assoc-default 'candidate-transformer
11123                                             (assoc (assoc-default 'type source)
11124                                                    anything-type-attributes))
11125                              (assoc-default 'filtered-candidate-transformer source)
11126                              (assoc-default 'candidate-transformer source))))
11127       (if (listp adapt-source)
11128           (when (member 'anything-c-adaptive-sort adapt-source) source)
11129           (when (eq adapt-source 'anything-c-adaptive-sort) source)))))
11130
11131 (defun anything-c-adaptive-store-selection ()
11132   "Store history information for the selected candidate."
11133   (unless anything-c-adaptive-done
11134     (setq anything-c-adaptive-done t)
11135     (let ((source (anything-c-source-use-adaptative-p)))
11136       (when source
11137         (let* ((source-name (or (assoc-default 'type source)
11138                                 (assoc-default 'name source)))
11139                (source-info (or (assoc source-name anything-c-adaptive-history)
11140                                 (progn
11141                                   (push (list source-name) anything-c-adaptive-history)
11142                                   (car anything-c-adaptive-history))))
11143                (selection (anything-get-selection))
11144                (selection-info (progn
11145                                  (setcdr source-info
11146                                          (cons
11147                                           (let ((found (assoc selection (cdr source-info))))
11148                                             (if (not found)
11149                                                 ;; new entry
11150                                                 (list selection)
11151
11152                                                 ;; move entry to the beginning of the
11153                                                 ;; list, so that it doesn't get
11154                                                 ;; trimmed when the history is
11155                                                 ;; truncated
11156                                                 (setcdr source-info
11157                                                         (delete found (cdr source-info)))
11158                                                 found))
11159                                           (cdr source-info)))
11160                                  (cadr source-info)))
11161                (pattern-info (progn
11162                                (setcdr selection-info
11163                                        (cons
11164                                         (let ((found (assoc anything-pattern (cdr selection-info))))
11165                                           (if (not found)
11166                                               ;; new entry
11167                                               (cons anything-pattern 0)
11168
11169                                               ;; move entry to the beginning of the
11170                                               ;; list, so if two patterns used the
11171                                               ;; same number of times then the one
11172                                               ;; used last appears first in the list
11173                                               (setcdr selection-info
11174                                                       (delete found (cdr selection-info)))
11175                                               found))
11176                                         (cdr selection-info)))
11177                                (cadr selection-info))))
11178
11179           ;; increase usage count
11180           (setcdr pattern-info (1+ (cdr pattern-info)))
11181
11182           ;; truncate history if needed
11183           (if (> (length (cdr selection-info)) anything-c-adaptive-history-length)
11184               (setcdr selection-info
11185                       (subseq (cdr selection-info) 0 anything-c-adaptive-history-length))))))))
11186
11187 (defun anything-c-adaptative-maybe-load-history ()
11188   (when (and anything-c-use-adaptative-sorting
11189              (file-readable-p anything-c-adaptive-history-file))
11190     (load-file anything-c-adaptive-history-file)))
11191
11192 (add-hook 'emacs-startup-hook 'anything-c-adaptative-maybe-load-history)
11193 (add-hook 'kill-emacs-hook 'anything-c-adaptive-save-history)
11194
11195 (defun anything-c-adaptive-save-history (&optional arg)
11196   "Save history information to file given by `anything-c-adaptive-history-file'."
11197   (interactive "p")
11198   (when anything-c-use-adaptative-sorting
11199     (with-temp-buffer
11200       (insert
11201        ";; -*- mode: emacs-lisp -*-\n"
11202        ";; History entries used for anything adaptive display.\n")
11203       (prin1 `(setq anything-c-adaptive-history ',anything-c-adaptive-history)
11204              (current-buffer))
11205       (insert ?\n)
11206       (write-region (point-min) (point-max) anything-c-adaptive-history-file nil
11207                     (unless arg 'quiet)))))
11208
11209 (defun anything-c-adaptive-sort (candidates source)
11210   "Sort the CANDIDATES for SOURCE by usage frequency.
11211 This is a filtered candidate transformer you can use for the
11212 attribute `filtered-candidate-transformer' of a source in
11213 `anything-sources' or a type in `anything-type-attributes'."
11214   (let* ((source-name (or (assoc-default 'type source)
11215                           (assoc-default 'name source)))
11216          (source-info (assoc source-name anything-c-adaptive-history)))
11217     (if source-info
11218         (let ((usage
11219                ;; ... assemble a list containing the (CANIDATE . USAGE-COUNT)
11220                ;; pairs
11221                (mapcar (lambda (candidate-info)
11222                          (let ((count 0))
11223                            (dolist (pattern-info (cdr candidate-info))
11224                              (if (not (equal (car pattern-info)
11225                                              anything-pattern))
11226                                  (incf count (cdr pattern-info))
11227
11228                                  ;; if current pattern is equal to the previously
11229                                  ;; used one then this candidate has priority
11230                                  ;; (that's why its count is boosted by 10000) and
11231                                  ;; it only has to compete with other candidates
11232                                  ;; which were also selected with the same pattern
11233                                  (setq count (+ 10000 (cdr pattern-info)))
11234                                  (return)))
11235                            (cons (car candidate-info) count)))
11236                        (cdr source-info)))
11237               sorted)
11238           (if (and usage (consp usage))
11239               ;; sort the list in descending order, so candidates with highest
11240               ;; priorty come first
11241               (progn
11242                 (setq usage (sort usage (lambda (first second)
11243                                           (> (cdr first) (cdr second)))))
11244
11245                 ;; put those candidates first which have the highest usage count
11246                 (dolist (info usage)
11247                   (when (member* (car info) candidates
11248                                  :test 'anything-c-adaptive-compare)
11249                     (push (car info) sorted)
11250                     (setq candidates (remove* (car info) candidates
11251                                               :test 'anything-c-adaptive-compare))))
11252
11253                 ;; and append the rest
11254                 (append (reverse sorted) candidates nil))
11255               (message "Your `%s' is maybe corrupted or too old, \
11256 you should reinitialize it with `anything-c-reset-adaptative-history'"
11257                        anything-c-adaptive-history-file)
11258               (sit-for 1)
11259               candidates))
11260         ;; if there is no information stored for this source then do nothing
11261         candidates)))
11262
11263 ;;;###autoload
11264 (defun anything-c-reset-adaptative-history ()
11265   "Delete all `anything-c-adaptive-history' and his file.
11266 Useful when you have a old or corrupted `anything-c-adaptive-history-file'."
11267   (interactive)
11268   (when (y-or-n-p "Really delete all your `anything-c-adaptive-history'? ")
11269     (setq anything-c-adaptive-history nil)
11270     (delete-file anything-c-adaptive-history-file)))
11271
11272 (defun anything-c-adaptive-compare (x y)
11273   "Compare candidates X and Y taking into account that the
11274 candidate can be in (DISPLAY . REAL) format."
11275   (equal (if (listp x)
11276              (cdr x)
11277              x)
11278          (if (listp y)
11279              (cdr y)
11280              y)))
11281
11282
11283 \f
11284 ;;; Outliner
11285 ;;
11286 ;;
11287 (defvar anything-outline-goto-near-line-flag t)
11288 (defvar anything-outline-using nil)
11289 (defun anything-after-update-hook--outline ()
11290   (if (and (eq anything-outline-using t)
11291            (eq anything-outline-goto-near-line-flag t))
11292       (anything-outline-goto-near-line)))
11293 (add-hook 'anything-after-update-hook 'anything-after-update-hook--outline)
11294
11295 (defun anything-outline-goto-near-line ()
11296   (with-anything-window
11297     ;; TODO need consideration whether to update position by every input.
11298     (when t ; (equal anything-pattern "")
11299       (anything-goto-line 2)
11300       (let ((lineno (with-anything-current-buffer
11301                       (line-number-at-pos (car anything-current-position)))))
11302         (block exit
11303           (while (<= (progn (skip-chars-forward " ")
11304                             (or (number-at-point) lineno))
11305                      lineno)
11306             (forward-line 1)
11307             (when (eobp)
11308               (forward-line -1)
11309               (return-from exit))))
11310         (forward-line -1)
11311         (and (bobp) (forward-line 1))
11312         (and (anything-pos-header-line-p) (forward-line -2))
11313         (anything-mark-current-line)))))
11314
11315
11316 \f
11317 ;;; Plug-in
11318 ;;
11319 ;;
11320 ;; Plug-in: info-index
11321 (defun* anything-c-info-init (&optional (file (anything-attr 'info-file)))
11322   (let (result)
11323     (unless (anything-candidate-buffer)
11324       (save-window-excursion
11325         (info file)
11326         (let (Info-history
11327               (tobuf (anything-candidate-buffer 'global))
11328               (infobuf (current-buffer))
11329               s e)
11330           (dolist (node (or (anything-attr 'index-nodes) (Info-index-nodes)))
11331             (Info-goto-node node)
11332             (goto-char (point-min))
11333             (while (search-forward "\n* " nil t)
11334               (unless (search-forward "Menu:\n" (1+ (point-at-eol)) t)
11335                 '(save-current-buffer (buffer-substring-no-properties (point-at-bol) (point-at-eol)) result)
11336                 (setq s (point-at-bol)
11337                       e (point-at-eol))
11338                 (with-current-buffer tobuf
11339                   (insert-buffer-substring infobuf s e)
11340                   (insert "\n"))))))))))
11341
11342 (defun anything-c-info-goto (node-line)
11343   (Info-goto-node (car node-line))
11344   (anything-goto-line (cdr node-line)))
11345
11346 (defun anything-c-info-display-to-real (line)
11347   (and (string-match
11348         ;; This regexp is stolen from Info-apropos-matches
11349         "\\* +\\([^\n]*.+[^\n]*\\):[ \t]+\\([^\n]*\\)\\.\\(?:[ \t\n]*(line +\\([0-9]+\\))\\)?" line)
11350        (cons (format "(%s)%s" (anything-attr 'info-file) (match-string 2 line))
11351              (string-to-number (or (match-string 3 line) "1")))))
11352
11353 (defun anything-c-make-info-source (source file)
11354   `(,@source
11355     (name . ,(concat "Info Index: " file))
11356     (info-file . ,file)
11357     (init . anything-c-info-init)
11358     (display-to-real . anything-c-info-display-to-real)
11359     (get-line . buffer-substring)
11360     (candidates-in-buffer)
11361     (action ("Goto node" . anything-c-info-goto))))
11362
11363 (defun anything-compile-source--info-index (source)
11364   (anything-aif (anything-interpret-value (assoc-default 'info-index source))
11365       (anything-c-make-info-source source it)
11366     source))
11367 (add-to-list 'anything-compile-source-functions 'anything-compile-source--info-index)
11368
11369 (anything-document-attribute 'info-index "info-index plugin"
11370                              "Create a source of info index very easily.
11371
11372 ex. (defvar anything-c-source-info-wget '((info-index . \"wget\"))")
11373
11374 (anything-document-attribute 'index-nodes "info-index plugin (optional)"
11375                              "Index nodes of info file.
11376
11377 If it is omitted, `Info-index-nodes' is used to collect index nodes.
11378 Some info files are missing index specification.
11379
11380 ex. See `anything-c-source-info-screen'.")
11381
11382 ;; Plug-in: candidates-file
11383 (defun anything-compile-source--candidates-file (source)
11384   (if (assoc-default 'candidates-file source)
11385       `((init anything-p-candidats-file-init
11386               ,@(let ((orig-init (assoc-default 'init source)))
11387                      (cond ((null orig-init) nil)
11388                            ((functionp orig-init) (list orig-init))
11389                            (t orig-init))))
11390         (candidates-in-buffer)
11391         ,@source)
11392       source))
11393 (add-to-list 'anything-compile-source-functions 'anything-compile-source--candidates-file)
11394
11395 (defun anything-p-candidats-file-init ()
11396   (destructuring-bind (file &optional updating)
11397       (anything-mklist (anything-attr 'candidates-file))
11398     (setq file (anything-interpret-value file))
11399     (with-current-buffer (anything-candidate-buffer (find-file-noselect file))
11400       (when updating
11401         (buffer-disable-undo)
11402         (font-lock-mode -1)
11403         (auto-revert-mode 1)))))
11404
11405 (anything-document-attribute 'candidates-file "candidates-file plugin"
11406                              "Use a file as the candidates buffer.
11407
11408 1st argument is a filename, string or function name or variable name.
11409 If optional 2nd argument is non-nil, the file opened with `auto-revert-mode'.")
11410
11411 ;; Plug-in: headline
11412 (defun anything-compile-source--anything-headline (source)
11413   (if (assoc-default 'headline source)
11414       (append '((init . anything-headline-init)
11415                 (get-line . buffer-substring)
11416                 (type . line))
11417               source
11418               '((candidates-in-buffer)
11419                 (persistent-help . "Show this line")))
11420       source))
11421 (add-to-list 'anything-compile-source-functions 'anything-compile-source--anything-headline)
11422
11423 (defun anything-headline-init ()
11424   (when (and (anything-current-buffer-is-modified)
11425              (with-anything-current-buffer
11426                (eval (or (anything-attr 'condition) t))))
11427     (anything-headline-make-candidate-buffer
11428      (anything-interpret-value (anything-attr 'headline))
11429      (anything-interpret-value (anything-attr 'subexp)))))
11430
11431 (anything-document-attribute 'headline "Headline plug-in"
11432                              "Regexp string for anything-headline to scan.")
11433 (anything-document-attribute 'condition "Headline plug-in"
11434                              "A sexp representing the condition to use anything-headline.")
11435 (anything-document-attribute 'subexp "Headline plug-in"
11436                              "Display (match-string-no-properties subexp).")
11437
11438 ;; Le Wang: Note on how `anything-head-line-get-candidates' works with a list
11439 ;; of regexps.
11440 ;;
11441 ;;   1. Create list of ((title . start-of-match) . hiearchy)
11442 ;;   2. Sort this list by start-of-match.
11443 ;;   3. Go through sorted list and return titles that reflect full hiearchy.
11444 ;;
11445 ;; It's quite brilliantly written.
11446 ;;
11447
11448
11449 (defun anything-headline-get-candidates (regexp subexp)
11450   (with-anything-current-buffer
11451     (save-excursion
11452       (goto-char (point-min))
11453       (if (functionp regexp) (setq regexp (funcall regexp)))
11454       (let (hierarchy curhead)
11455         (flet ((matched ()
11456                  (if (numberp subexp)
11457                      (cons (match-string-no-properties subexp) (match-beginning subexp))
11458                      (cons (buffer-substring (point-at-bol) (point-at-eol))
11459                            (point-at-bol))))
11460                (hierarchies (headlines)
11461                  (1+ (loop for (_ . hierarchy) in headlines
11462                            maximize hierarchy)))
11463                (vector-0-n (v n)
11464                  (loop for i from 0 to hierarchy
11465                        collecting (aref curhead i)))
11466                (arrange (headlines)
11467                  (unless (null headlines) ; FIX headlines empty bug!
11468                    (loop with curhead = (make-vector (hierarchies headlines) "")
11469                          for ((str . pt) . hierarchy) in headlines
11470                          do (aset curhead hierarchy str)
11471                          collecting
11472                          (cons
11473                           (format "H%d:%s" (1+ hierarchy)
11474                                   (mapconcat 'identity (vector-0-n curhead hierarchy) " / "))
11475                           pt)))))
11476           (if (listp regexp)
11477               (arrange
11478                (sort
11479                 (loop for re in regexp
11480                       for hierarchy from 0
11481                       do (goto-char (point-min))
11482                       appending
11483                       (loop
11484                             while (re-search-forward re nil t)
11485                             collect (cons (matched) hierarchy)))
11486                 (lambda (a b) (> (cdar b) (cdar a)))))
11487               (loop while (re-search-forward regexp nil t)
11488                     collect (matched))))))))
11489
11490
11491 (defun anything-headline-make-candidate-buffer (regexp subexp)
11492   (with-current-buffer (anything-candidate-buffer 'local)
11493     (loop for (content . pos) in (anything-headline-get-candidates regexp subexp)
11494           do (insert
11495               (format "%5d:%s\n"
11496                       (with-anything-current-buffer
11497                         (line-number-at-pos pos))
11498                       content)))))
11499
11500 (defun anything-headline-goto-position (pos recenter)
11501   (goto-char pos)
11502   (unless recenter
11503     (set-window-start (get-buffer-window anything-current-buffer) (point))))
11504
11505
11506 ;; Plug-in: persistent-help
11507 (defun anything-compile-source--persistent-help (source)
11508   (append source '((header-line . anything-persistent-help-string))))
11509 (add-to-list 'anything-compile-source-functions 'anything-compile-source--persistent-help)
11510
11511 (defun anything-persistent-help-string ()
11512   (substitute-command-keys
11513    (concat "\\<anything-map>\\[anything-execute-persistent-action]: "
11514            (or (anything-interpret-value (anything-attr 'persistent-help))
11515                (anything-aif (or (assoc-default 'persistent-action
11516                                                 (anything-get-current-source))
11517                                  (assoc-default 'action
11518                                                 (anything-get-current-source)))
11519                    (cond ((symbolp it) (symbol-name it))
11520                          ((listp it) (or (ignore-errors (caar it))  ""))))
11521                "")
11522            " (keeping session)")))
11523
11524 (anything-document-attribute 'persistent-help "persistent-help plug-in"
11525                              "A string to explain persistent-action of this source.
11526 It also accepts a function or a variable name.")
11527
11528 ;;; (anything '(((name . "persistent-help test")(candidates "a")(persistent-help . "TEST"))))
11529
11530 ;; Plug-in: Type customize
11531 (defun anything-c-uniq-list (lst)
11532   "Like `remove-duplicates' in CL.
11533 But cut deeper duplicates and test by `equal'. "
11534   (reverse (remove-duplicates (reverse lst) :test 'equal)))
11535 (defvar anything-additional-type-attributes nil)
11536 (defun anything-c-arrange-type-attribute (type spec)
11537   "Override type attributes by `define-anything-type-attribute'.
11538
11539 The SPEC is like source. The symbol `REST' is replaced
11540 with original attribute value.
11541
11542  Example: Set `play-sound-file' as default action
11543    (anything-c-arrange-type-attribute 'file
11544       '((action (\"Play sound\" . play-sound-file)
11545          REST ;; Rest of actions (find-file, find-file-other-window, etc...)."
11546   (add-to-list 'anything-additional-type-attributes
11547                (cons type
11548                      (loop with typeattr = (assoc-default
11549                                             type anything-type-attributes)
11550                            for (attr . value) in spec
11551                            if (listp value)
11552                            collect (cons attr
11553                                          (anything-c-uniq-list
11554                                           (loop for v in value
11555                                                 if (eq v 'REST)
11556                                                 append
11557                                                 (assoc-default attr typeattr)
11558                                                 else
11559                                                 collect v)))
11560                            else
11561                            collect (cons attr value)))))
11562 (put 'anything-c-arrange-type-attribute 'lisp-indent-function 1)
11563
11564 (defun anything-compile-source--type-customize (source)
11565   (anything-aif (assoc-default (assoc-default 'type source)
11566                                anything-additional-type-attributes)
11567       (append it source)
11568     source))
11569 (add-to-list 'anything-compile-source-functions
11570              'anything-compile-source--type-customize t)
11571
11572 ;; Plug-in: default-action
11573 (defun anything-compile-source--default-action (source)
11574   (anything-aif (assoc-default 'default-action source)
11575       (append `((action ,it ,@(remove it (assoc-default 'action source))))
11576               source)
11577     source))
11578 (add-to-list 'anything-compile-source-functions
11579              'anything-compile-source--default-action t)
11580 (anything-document-attribute 'default-action "default-action plug-in"
11581                              "Default action.")
11582
11583 \f
11584 ;;; Type Attributes
11585 ;;
11586 ;;
11587 (define-anything-type-attribute 'buffer
11588     `((action
11589        ("Switch to buffer" . anything-c-switch-to-buffer)
11590        ,(and (locate-library "popwin") '("Switch to buffer in popup window" . popwin:popup-buffer))
11591        ("Switch to buffer other window" . switch-to-buffer-other-window)
11592        ("Switch to buffer other frame" . switch-to-buffer-other-frame)
11593        ,(and (locate-library "elscreen") '("Display buffer in Elscreen" . anything-find-buffer-on-elscreen))
11594        ("Query replace regexp" . anything-c-buffer-query-replace-regexp)
11595        ("Query replace" . anything-c-buffer-query-replace)
11596        ("View buffer" . view-buffer)
11597        ("Display buffer"   . display-buffer)
11598        ("Grep buffers (C-u grep all buffers)" . anything-c-zgrep-buffers)
11599        ("Revert buffer(s)" . anything-revert-marked-buffers)
11600        ("Insert buffer" . insert-buffer)
11601        ("Kill buffer(s)" . anything-kill-marked-buffers)
11602        ("Diff with file" . diff-buffer-with-file)
11603        ("Ediff Marked buffers" . anything-ediff-marked-buffers)
11604        ("Ediff Merge marked buffers" . (lambda (candidate)
11605                                          (anything-ediff-marked-buffers candidate t))))
11606       (persistent-help . "Show this buffer")
11607       (candidate-transformer anything-c-skip-boring-buffers
11608                              anything-c-transform-buffer-display-string))
11609   "Buffer or buffer name.")
11610
11611 (define-anything-type-attribute 'file
11612     `((action
11613        ("Find file" . anything-find-many-files)
11614        ,(and (locate-library "popwin") '("Find file in popup window" . popwin:find-file))
11615        ("Find file as root" . anything-find-file-as-root)
11616        ("Find file other window" . find-file-other-window)
11617        ("Find file other frame" . find-file-other-frame)
11618        ("Open dired in file's directory" . anything-c-open-dired)
11619        ("Grep File(s) `C-u recurse'" . anything-find-files-grep)
11620        ("Zgrep File(s) `C-u Recurse'" . anything-ff-zgrep)
11621        ("Pdfgrep File(s)" . anything-ff-pdfgrep)
11622        ("Checksum File" . anything-ff-checksum)
11623        ("Ediff File" . anything-find-files-ediff-files)
11624        ("Ediff Merge File" . anything-find-files-ediff-merge-files)
11625        ("View file" . view-file)
11626        ("Insert file" . insert-file)
11627        ("Delete file(s)" . anything-delete-marked-files)
11628        ("Open file externally (C-u to choose)" . anything-c-open-file-externally)
11629        ("Open file with default tool" . anything-c-open-file-with-default-tool)
11630        ("Find file in hex dump" . hexl-find-file))
11631       (persistent-help . "Show this file")
11632       (action-transformer anything-c-transform-file-load-el
11633                           anything-c-transform-file-browse-url)
11634       (candidate-transformer anything-c-w32-pathname-transformer
11635                              anything-c-skip-current-file
11636                              anything-c-skip-boring-files
11637                              anything-c-shorten-home-path))
11638   "File name.")
11639
11640 (let ((actions '(("Describe command" . describe-function)
11641                  ("Add command to kill ring" . anything-c-kill-new)
11642                  ("Go to command's definition" . find-function)
11643                  ("Debug on entry" . debug-on-entry)
11644                  ("Cancel debug on entry" . cancel-debug-on-entry)
11645                  ("Trace function" . trace-function)
11646                  ("Trace function (background)" . trace-function-background)
11647                  ("Untrace function" . untrace-function))))
11648   (define-anything-type-attribute 'command
11649       `((action ("Call interactively" . anything-c-call-interactively)
11650                 ,@actions)
11651         (coerce . anything-c-symbolify)
11652         (persistent-action . describe-function))
11653     "Command. (string or symbol)")
11654
11655   (define-anything-type-attribute 'function
11656       `((action . ,actions)
11657         (action-transformer anything-c-transform-function-call-interactively)
11658         (candidate-transformer anything-c-mark-interactive-functions)
11659         (coerce . anything-c-symbolify))
11660     "Function. (string or symbol)"))
11661
11662 (define-anything-type-attribute 'variable
11663     '((action ("Describe variable" . describe-variable)
11664        ("Add variable to kill ring" . anything-c-kill-new)
11665        ("Go to variable's definition" . find-variable)
11666        ("Set variable" . anything-c-set-variable))
11667       (coerce . anything-c-symbolify))
11668   "Variable.")
11669
11670 (define-anything-type-attribute 'sexp
11671     '((action ("Eval s-expression" . (lambda (c) (eval (read c))))
11672        ("Add s-expression to kill ring" . kill-new))
11673       (action-transformer anything-c-transform-sexp-eval-command-sexp))
11674   "String representing S-Expressions.")
11675
11676 (define-anything-type-attribute 'bookmark
11677     `((coerce . anything-bookmark-get-bookmark-from-name)
11678       (action
11679        ("Jump to bookmark" . anything-c-bookmark-jump)
11680        ("Jump to BM other window" . bookmark-jump-other-window)
11681        ("Bookmark edit annotation" . bookmark-edit-annotation)
11682        ("Bookmark show annotation" . bookmark-show-annotation)
11683        ("Delete bookmark(s)" . anything-delete-marked-bookmarks)
11684        ,@(and (locate-library "bookmark-extensions")
11685               `(("Edit Bookmark" . bmkext-edit-bookmark)))
11686        ("Rename bookmark" . bookmark-rename)
11687        ("Relocate bookmark" . bookmark-relocate))
11688       (keymap . ,anything-c-bookmark-map)
11689       (mode-line . anything-bookmark-mode-line-string))
11690   "Bookmark name.")
11691
11692 (define-anything-type-attribute 'line
11693     '((display-to-real . anything-c-display-to-real-line)
11694       (action ("Go to Line" . anything-c-action-line-goto)))
11695   "LINENO:CONTENT string, eg. \"  16:foo\".
11696
11697 Optional `target-file' attribute is a name of target file.
11698
11699 Optional `before-jump-hook' attribute is a function with no
11700 arguments which is called before jumping to position.
11701
11702 Optional `after-jump-hook' attribute is a function with no
11703 arguments which is called after jumping to position.
11704
11705 If `adjust' attribute is specified, searches the line whose
11706 content is CONTENT near the LINENO.
11707
11708 If `recenter' attribute is specified, the line is displayed at
11709 the center of window, otherwise at the top of window.
11710 ")
11711
11712 (define-anything-type-attribute 'file-line
11713     `((filtered-candidate-transformer anything-c-filtered-candidate-transformer-file-line)
11714       (multiline)
11715       (action ("Go to" . anything-c-action-file-line-goto)))
11716   "FILENAME:LINENO:CONTENT string, eg. \"~/.emacs:16:;; comment\".
11717
11718 Optional `default-directory' attribute is a default-directory
11719 FILENAME is interpreted.
11720
11721 Optional `before-jump-hook' attribute is a function with no
11722 arguments which is called before jumping to position.
11723
11724 Optional `after-jump-hook' attribute is a function with no
11725 arguments which is called after jumping to position.
11726
11727 If `adjust' attribute is specified, searches the line whose
11728 content is CONTENT near the LINENO.
11729
11730 If `recenter' attribute is specified, the line is displayed at
11731 the center of window, otherwise at the top of window.
11732 ")
11733
11734 (define-anything-type-attribute 'timer
11735     '((real-to-display . anything-c-timer-real-to-display)
11736       (action ("Cancel Timer" . cancel-timer)
11737        ("Describe Function" . (lambda (tm) (describe-function (timer--function tm))))
11738        ("Find Function" . (lambda (tm) (find-function (timer--function tm)))))
11739       (persistent-action . (lambda (tm) (describe-function (timer--function tm))))
11740       (persistent-help . "Describe Function"))
11741   "Timer.")
11742
11743 \f
11744 ;;; Default `anything-sources'
11745 ;; Setting `anything-sources' is DEPRECATED, but it seems that newbies
11746 ;; tend to invoke M-x anything directly. So I offer default setting.
11747 (setq anything-sources
11748       '(anything-c-source-buffers-list
11749         anything-c-source-recentf
11750         anything-c-source-files-in-current-dir+))
11751
11752 \f
11753 ;;; Preconfigured Anything
11754 ;;
11755 ;;
11756 ;;;###autoload
11757 (defun anything-mini ()
11758   "Preconfigured `anything' lightweight version \(buffer -> recentf\)."
11759   (interactive)
11760   (anything-other-buffer '(anything-c-source-buffers-list
11761                            anything-c-source-recentf
11762                            anything-c-source-buffer-not-found)
11763                          "*anything mini*"))
11764 ;;;###autoload
11765 (defun anything-for-files ()
11766   "Preconfigured `anything' for opening files.
11767 ffap -> recentf -> buffer -> bookmark -> file-cache -> files-in-current-dir -> locate."
11768   (interactive)
11769   (anything-other-buffer anything-for-files-prefered-list "*anything for files*"))
11770
11771 ;;;###autoload
11772 (defun anything-recentf ()
11773   "Preconfigured `anything' for `recentf'."
11774   (interactive)
11775   (anything-other-buffer 'anything-c-source-recentf "*anything recentf*"))
11776
11777 ;;;###autoload
11778 (defun anything-info-at-point (arg)
11779   "Preconfigured `anything' for searching info at point.
11780 With a prefix-arg insert symbol at point."
11781   (interactive "P")
11782   (let ((anything-c-google-suggest-default-function
11783          'anything-c-google-suggest-emacs-lisp))
11784     (anything :sources '(anything-c-source-info-elisp
11785                          anything-c-source-info-cl
11786                          anything-c-source-info-pages
11787                          anything-c-source-google-suggest)
11788               :input (and arg (thing-at-point 'symbol))
11789               :buffer "*anything info*")))
11790
11791 ;;;###autoload
11792 (defun anything-show-kill-ring ()
11793   "Preconfigured `anything' for `kill-ring'.
11794 It is drop-in replacement of `yank-pop'.
11795 You may bind this command to M-y.
11796 First call open the kill-ring browser, next calls move to next line."
11797   (interactive)
11798   (anything :sources 'anything-c-source-kill-ring
11799             :buffer "*anything kill-ring*"))
11800
11801 ;;;###autoload
11802 (defun anything-minibuffer-history ()
11803   "Preconfigured `anything' for `minibuffer-history'."
11804   (interactive)
11805   (let ((enable-recursive-minibuffers t))
11806     (anything-other-buffer 'anything-c-source-minibuffer-history
11807                            "*anything minibuffer-history*")))
11808
11809 ;;;###autoload
11810 (defun anything-gentoo ()
11811   "Preconfigured `anything' for gentoo linux."
11812   (interactive)
11813   (anything-other-buffer '(anything-c-source-gentoo
11814                            anything-c-source-use-flags)
11815                          "*anything gentoo*"))
11816
11817 ;;;###autoload
11818 (defun anything-imenu ()
11819   "Preconfigured `anything' for `imenu'."
11820   (interactive)
11821   (anything :sources 'anything-c-source-imenu
11822             :buffer "*anything imenu*"))
11823
11824 ;;;###autoload
11825 (defun anything-google-suggest ()
11826   "Preconfigured `anything' for google search with google suggest."
11827   (interactive)
11828   (anything-other-buffer 'anything-c-source-google-suggest "*anything google*"))
11829
11830 ;;;###autoload
11831 (defun anything-yahoo-suggest ()
11832   "Preconfigured `anything' for Yahoo searching with Yahoo suggest."
11833   (interactive)
11834   (anything-other-buffer 'anything-c-source-yahoo-suggest "*anything yahoo*"))
11835
11836 ;;; Converted from anything-show-*-only
11837 ;;;###autoload
11838 (defun anything-for-buffers ()
11839   "Preconfigured `anything' for buffers."
11840   (interactive)
11841   (anything-other-buffer 'anything-c-source-buffers "*anything for buffers*"))
11842
11843 ;;;###autoload
11844 (defun anything-buffers-list ()
11845   "Preconfigured `anything' to list buffers.
11846 It is an enhanced version of `anything-for-buffers'."
11847   (interactive)
11848   (anything :sources '(anything-c-source-buffers-list
11849                        anything-c-source-buffer-not-found)
11850             :buffer "*anything buffers*" :keymap anything-c-buffer-map))
11851
11852 (defalias 'anything-buffers+ 'anything-buffers-list
11853   "Preconfigured `anything' to list buffers.
11854 It is an alias of `anything-buffers-list'.")
11855
11856 ;;;###autoload
11857 (defun anything-bbdb ()
11858   "Preconfigured `anything' for BBDB.
11859
11860 Needs BBDB.
11861
11862 http://bbdb.sourceforge.net/"
11863   (interactive)
11864   (anything-other-buffer 'anything-c-source-bbdb "*anything bbdb*"))
11865
11866 ;;;###autoload
11867 (defun anything-locate (arg)
11868   "Preconfigured `anything' for Locate.
11869 Note: you can add locate options after entering pattern.
11870 See 'man locate' for valid options.
11871
11872 You can specify a specific database with prefix argument ARG \(C-u\).
11873 Many databases can be used: navigate and mark them.
11874 See also `anything-locate-with-db'.
11875
11876 To create a user specific db, use
11877 \"updatedb -l 0 -o db_path -U directory\".
11878 Where db_path is a filename matched by
11879 `anything-locate-db-file-regexp'."
11880   (interactive "P")
11881   (setq anything-ff-default-directory default-directory)
11882   (anything-locate-1 arg))
11883
11884 ;;;###autoload
11885 (defun anything-w3m-bookmarks ()
11886   "Preconfigured `anything' for w3m bookmark.
11887
11888 Needs w3m and emacs-w3m.
11889
11890 http://w3m.sourceforge.net/
11891 http://emacs-w3m.namazu.org/"
11892   (interactive)
11893   (anything-other-buffer 'anything-c-source-w3m-bookmarks
11894                          "*anything w3m bookmarks*"))
11895
11896 ;;;###autoload
11897 (defun anything-firefox-bookmarks ()
11898   "Preconfigured `anything' for firefox bookmark.
11899 You will have to enable html bookmarks in firefox:
11900 open about:config in firefox and double click on this line to enable value \
11901 to true:
11902
11903 user_pref(\"browser.bookmarks.autoExportHTML\", false);
11904
11905 You should have now:
11906
11907 user_pref(\"browser.bookmarks.autoExportHTML\", true);
11908
11909 After closing firefox, you will be able to browse you bookmarks.
11910 "
11911   (interactive)
11912   (anything-other-buffer 'anything-c-source-firefox-bookmarks
11913                          "*Anything Firefox*"))
11914
11915 ;;;###autoload
11916 (defun anything-colors ()
11917   "Preconfigured `anything' for color."
11918   (interactive)
11919   (anything-other-buffer
11920    '(anything-c-source-colors anything-c-source-customize-face)
11921    "*anything colors*"))
11922
11923 ;;;###autoload
11924 (defun anything-bookmarks ()
11925   "Preconfigured `anything' for bookmarks."
11926   (interactive)
11927   (anything-other-buffer 'anything-c-source-bookmarks "*anything bookmarks*"))
11928
11929 ;;;###autoload
11930 (defun anything-c-pp-bookmarks ()
11931   "Preconfigured `anything' for bookmarks (pretty-printed)."
11932   (interactive)
11933   (anything-other-buffer '(anything-c-source-bookmarks-local
11934                            anything-c-source-bookmarks-su
11935                            anything-c-source-bookmarks-ssh)
11936                          "*anything pp bookmarks*"))
11937
11938 ;;;###autoload
11939 (defun anything-c-insert-latex-math ()
11940   "Preconfigured anything for latex math symbols completion."
11941   (interactive)
11942   (anything-other-buffer 'anything-c-source-latex-math "*anything latex*"))
11943
11944 ;;;###autoload
11945 (defun anything-register ()
11946   "Preconfigured `anything' for Emacs registers."
11947   (interactive)
11948   (anything-other-buffer 'anything-c-source-register "*anything register*"))
11949
11950 ;;;###autoload
11951 (defun anything-man-woman ()
11952   "Preconfigured `anything' for Man and Woman pages."
11953   (interactive)
11954   (anything-other-buffer 'anything-c-source-man-pages "*Anything man woman*"))
11955
11956 ;;;###autoload
11957 (defun anything-org-keywords ()
11958   "Preconfigured `anything' for org keywords."
11959   (interactive)
11960   (anything-other-buffer 'anything-c-source-org-keywords "*org keywords*"))
11961
11962 ;;;###autoload
11963 (defun anything-emms ()
11964   "Preconfigured `anything' for emms sources."
11965   (interactive)
11966   (anything :sources '(anything-c-source-emms-streams
11967                        anything-c-source-emms-files
11968                        anything-c-source-emms-dired)
11969             :buffer "*Anything Emms*"))
11970
11971 ;;;###autoload
11972 (defun anything-eev-anchors ()
11973   "Preconfigured `anything' for eev anchors."
11974   (interactive)
11975   (anything-other-buffer 'anything-c-source-eev-anchor "*Anything eev anchors*"))
11976
11977 ;;;###autoload
11978 (defun anything-bm-list ()
11979   "Preconfigured `anything' for visible bookmarks.
11980
11981 Needs bm.el
11982
11983 http://cvs.savannah.gnu.org/viewvc/*checkout*/bm/bm/bm.el"
11984   (interactive)
11985   (let ((anything-outline-using t))
11986     (anything-other-buffer 'anything-c-source-bm "*anything bm list*")))
11987
11988 ;;;###autoload
11989 (defun anything-timers ()
11990   "Preconfigured `anything' for timers."
11991   (interactive)
11992   (anything-other-buffer '(anything-c-source-absolute-time-timers
11993                            anything-c-source-idle-time-timers)
11994                          "*anything timers*"))
11995
11996 ;;;###autoload
11997 (defun anything-list-emacs-process ()
11998   "Preconfigured `anything' for emacs process."
11999   (interactive)
12000   (anything-other-buffer 'anything-c-source-emacs-process "*anything process*"))
12001
12002 ;;;###autoload
12003 (defun anything-occur ()
12004   "Preconfigured Anything for Occur source.
12005 If region is active, search only in region,
12006 otherwise search in whole buffer."
12007   (interactive)
12008   (let ((anything-compile-source-functions
12009          ;; rule out anything-match-plugin because the input is one regexp.
12010          (delq 'anything-compile-source--match-plugin
12011                (copy-sequence anything-compile-source-functions))))
12012     (anything :sources 'anything-c-source-occur
12013               :buffer "*Anything Occur*"
12014               :history 'anything-c-grep-history)))
12015
12016 ;;;###autoload
12017 (defun anything-browse-code ()
12018   "Preconfigured anything to browse code."
12019   (interactive)
12020   (anything :sources 'anything-c-source-browse-code
12021             :buffer "*anything browse code*"
12022             :default (thing-at-point 'symbol)))
12023
12024 ;;;###autoload
12025 (defun anything-org-headlines ()
12026   "Preconfigured anything to show org headlines."
12027   (interactive)
12028   (anything-other-buffer 'anything-c-source-org-headline "*org headlines*"))
12029
12030 ;;;###autoload
12031 (defun anything-regexp ()
12032   "Preconfigured anything to build regexps.
12033 `query-replace-regexp' can be run from there against found regexp."
12034   (interactive)
12035   (save-restriction
12036     (let ((anything-compile-source-functions
12037            ;; rule out anything-match-plugin because the input is one regexp.
12038            (delq 'anything-compile-source--match-plugin
12039                  (copy-sequence anything-compile-source-functions))))
12040       (when (and (anything-region-active-p)
12041                  ;; Don't narrow to region if buffer is already narrowed.
12042                  (not (anything-current-buffer-narrowed-p)))
12043         (narrow-to-region (region-beginning) (region-end)))
12044       (anything :sources anything-c-source-regexp
12045                 :buffer "*anything regexp*"
12046                 :prompt "Regexp: "
12047                 :history 'anything-build-regexp-history))))
12048
12049 ;;;###autoload
12050 (defun anything-c-copy-files-async ()
12051   "Preconfigured anything to copy file list FLIST to DEST asynchronously."
12052   (interactive)
12053   (let* ((flist (anything-c-read-file-name
12054                  "Copy File async: "
12055                  :marked-candidates t))
12056          (dest  (anything-c-read-file-name
12057                  "Copy File async To: "
12058                  :preselect (car flist)
12059                  :initial-input (car anything-ff-history)
12060                  :history (anything-find-files-history :comp-read nil))))
12061     (anything-c-copy-async-with-log flist dest)))
12062
12063 ;;;###autoload
12064 (defun anything-find-files (arg)
12065   "Preconfigured `anything' for anything implementation of `find-file'.
12066 Called with a prefix arg show history if some.
12067 Don't call it from programs, use `anything-find-files-1' instead.
12068 This is the starting point for nearly all actions you can do on files."
12069   (interactive "P")
12070   (let ((any-input (if (and arg anything-ff-history)
12071                        (anything-find-files-history)
12072                        (anything-find-files-initial-input)))
12073         (presel    (buffer-file-name (current-buffer))))
12074     (when (and (eq major-mode 'org-agenda-mode)
12075                org-directory
12076                (not any-input))
12077       (setq any-input (expand-file-name org-directory)))
12078     (set-text-properties 0 (length any-input) nil any-input)
12079     (if any-input
12080         (anything-find-files-1 any-input)
12081         (setq any-input (expand-file-name (anything-c-current-directory)))
12082         (anything-find-files-1
12083          any-input (if anything-ff-transformer-show-only-basename
12084                        (and presel (anything-c-basename presel))
12085                        presel)))))
12086
12087 ;;;###autoload
12088 (defun anything-write-file ()
12089   "Preconfigured `anything' providing completion for `write-file'."
12090   (interactive)
12091   (let ((anything-mp-highlight-delay nil))
12092     (anything :sources 'anything-c-source-write-file
12093               :input (expand-file-name default-directory)
12094               :prompt "Write buffer to file: "
12095               :buffer "*Anything write file*")))
12096
12097 ;;;###autoload
12098 (defun anything-insert-file ()
12099   "Preconfigured `anything' providing completion for `insert-file'."
12100   (interactive)
12101   (let ((anything-mp-highlight-delay nil))
12102     (anything :sources 'anything-c-source-insert-file
12103               :input (expand-file-name default-directory)
12104               :prompt "Insert file: "
12105               :buffer "*Anything insert file*")))
12106
12107 ;;;###autoload
12108 (defun anything-dired-rename-file ()
12109   "Preconfigured `anything' to rename files from dired."
12110   (interactive)
12111   (anything-dired-do-action-on-file :action 'rename))
12112
12113 ;;;###autoload
12114 (defun anything-dired-copy-file ()
12115   "Preconfigured `anything' to copy files from dired."
12116   (interactive)
12117   (anything-dired-do-action-on-file :action 'copy))
12118
12119 ;;;###autoload
12120 (defun anything-dired-symlink-file ()
12121   "Preconfigured `anything' to symlink files from dired."
12122   (interactive)
12123   (anything-dired-do-action-on-file :action 'symlink))
12124
12125 ;;;###autoload
12126 (defun anything-dired-hardlink-file ()
12127   "Preconfigured `anything' to hardlink files from dired."
12128   (interactive)
12129   (anything-dired-do-action-on-file :action 'hardlink))
12130
12131 ;;;###autoload
12132 (defun anything-do-grep ()
12133   "Preconfigured anything for grep.
12134 Contrarily to Emacs `grep' no default directory is given, but
12135 the full path of candidates in ONLY.
12136 That allow to grep different files not only in `default-directory' but anywhere
12137 by marking them (C-<SPACE>). If one or more directory is selected
12138 grep will search in all files of these directories.
12139 You can use also wildcard in the base name of candidate.
12140 If a prefix arg is given use the -r option of grep.
12141 The prefix arg can be passed before or after start.
12142 See also `anything-do-grep-1'."
12143   (interactive)
12144   (let ((only    (anything-c-read-file-name
12145                   "Search in file(s): "
12146                   :marked-candidates t
12147                   :preselect (or (dired-get-filename nil t)
12148                                  (buffer-file-name (current-buffer)))))
12149         (prefarg (or current-prefix-arg anything-current-prefix-arg)))
12150     (anything-do-grep-1 only prefarg)))
12151
12152 ;;;###autoload
12153 (defun anything-do-zgrep ()
12154   "Preconfigured anything for zgrep."
12155   (interactive)
12156   (let ((prefarg (or current-prefix-arg anything-current-prefix-arg))
12157         (ls (anything-c-read-file-name
12158              "Search in file(s): "
12159              :marked-candidates t
12160              :preselect (or (dired-get-filename nil t)
12161                             (buffer-file-name (current-buffer))))))
12162     (anything-ff-zgrep-1 ls prefarg)))
12163
12164 ;;;###autoload
12165 (defun anything-do-pdfgrep ()
12166   "Preconfigured anything for pdfgrep."
12167   (interactive)
12168   (let ((only (anything-c-read-file-name
12169                "Search in file(s): "
12170                :marked-candidates t
12171                :test #'(lambda (file)
12172                          (or (string= (file-name-extension file) "pdf")
12173                              (string= (file-name-extension file) "PDF")
12174                              (file-directory-p file)))
12175                :preselect (or (dired-get-filename nil t)
12176                               (buffer-file-name (current-buffer)))))
12177         (anything-c-grep-default-function 'anything-c-pdfgrep-init))
12178     (anything-do-pdfgrep-1 only)))
12179
12180 ;;;###autoload
12181 (defun anything-c-etags-select (arg)
12182   "Preconfigured anything for etags.
12183 Called with one prefix arg use symbol at point as initial input.
12184 Called with two prefix arg reinitialize cache.
12185 If tag file have been modified reinitialize cache."
12186   (interactive "P")
12187   (let ((tag  (anything-c-etags-get-tag-file))
12188         (init (and (equal arg '(4)) (thing-at-point 'symbol)))
12189         (anything-quit-if-no-candidate t)
12190         (anything-execute-action-at-once-if-one t)
12191         (anything-compile-source-functions
12192          (if anything-c-etags-use-regexp-search
12193              ;; rule out anything-match-plugin because the input is one regexp.
12194              (delq 'anything-compile-source--match-plugin
12195                    (copy-sequence anything-compile-source-functions))
12196              anything-compile-source-functions)))
12197     (when (or (equal arg '(16))
12198               (and anything-c-etags-mtime-alist
12199                    (anything-c-etags-file-modified-p tag)))
12200       (remhash tag anything-c-etags-cache))
12201     (if (and tag (file-exists-p tag))
12202         (anything :sources 'anything-c-source-etags-select
12203                   :keymap anything-c-etags-map
12204                   :input init
12205                   :buffer "*anything etags*")
12206         (message "Error: No tag file found, please create one with etags shell command."))))
12207
12208 ;;;###autoload
12209 (defun anything-filelist ()
12210   "Preconfigured `anything' to open files instantly.
12211
12212 See `anything-c-filelist-file-name' docstring for usage."
12213   (interactive)
12214   (anything-other-buffer 'anything-c-source-filelist "*anything file list*"))
12215
12216 ;;;###autoload
12217 (defun anything-filelist+ ()
12218   "Preconfigured `anything' to open files/buffers/bookmarks instantly.
12219
12220 This is a replacement for `anything-for-files'.
12221 See `anything-c-filelist-file-name' docstring for usage."
12222   (interactive)
12223   (anything-other-buffer
12224    '(anything-c-source-ffap-line
12225      anything-c-source-ffap-guesser
12226      anything-c-source-buffers-list
12227      anything-c-source-recentf
12228      anything-c-source-bookmarks
12229      anything-c-source-file-cache
12230      anything-c-source-filelist)
12231    "*anything file list*"))
12232
12233 ;;;###autoload
12234 (defun anything-M-x ()
12235   "Preconfigured `anything' for Emacs commands.
12236 It is `anything' replacement of regular `M-x' `execute-extended-command'."
12237   (interactive)
12238   (let* (in-help
12239          help-cand
12240          special-display-buffer-names
12241          special-display-regexps
12242          anything-persistent-action-use-special-display
12243          (history (loop with hist
12244                         for i in extended-command-history
12245                         for com = (intern i)
12246                         when (fboundp com)
12247                         collect i into hist finally return hist)))
12248     (flet ((pers-help (candidate)
12249              (let ((hbuf (get-buffer (help-buffer))))
12250                (if (and in-help (string= candidate help-cand))
12251                    (progn
12252                      ;; When M-x is started from a help buffer,
12253                      ;; Don't kill it as it is anything-current-buffer.
12254                      (unless (equal hbuf anything-current-buffer)
12255                        (kill-buffer hbuf))
12256                      (setq in-help nil))
12257                    ;; Be sure anything-current-buffer
12258                    ;; have not a dedicated window.
12259                    (set-window-dedicated-p
12260                     (get-buffer-window anything-current-buffer) nil)
12261                    (describe-function (intern candidate))
12262                    (message nil) ; Erase the new stupid message Type "q"[...]
12263                    (setq in-help t))
12264                (setq help-cand candidate))))
12265       (let* ((command (anything-comp-read
12266                        "M-x " obarray
12267                        :test 'commandp
12268                        :requires-pattern anything-M-x-requires-pattern
12269                        :name "Emacs Commands"
12270                        :buffer "*anything M-x*"
12271                        :persistent-action 'pers-help
12272                        :persistent-help "Describe this command"
12273                        :history history
12274                        :must-match t
12275                        :candidates-in-buffer t
12276                        :fc-transformer 'anything-M-x-transformer))
12277              (sym-com (intern command)))
12278         (unless current-prefix-arg
12279           (setq current-prefix-arg anything-current-prefix-arg))
12280         ;; Avoid having `this-command' set to *exit-minibuffer.
12281         (setq this-command sym-com)
12282         (call-interactively sym-com)
12283         (setq extended-command-history
12284               (cons command (delete command history)))))))
12285
12286 ;;;###autoload
12287 (defun anything-manage-advice ()
12288   "Preconfigured `anything' to disable/enable function advices."
12289   (interactive)
12290   (anything-other-buffer 'anything-c-source-advice "*anything advice*"))
12291
12292 ;;;###autoload
12293 (defun anything-bookmark-ext ()
12294   "Preconfigured `anything' for bookmark-extensions sources.
12295 Needs bookmark-ext.el:
12296 <http://mercurial.intuxication.org/hg/emacs-bookmark-extension>.
12297 Contain also `anything-c-source-google-suggest'."
12298   (interactive)
12299   (anything
12300    :sources
12301    '(anything-c-source-bookmark-files&dirs
12302      anything-c-source-bookmark-w3m
12303      anything-c-source-google-suggest
12304      anything-c-source-bmkext-addressbook
12305      anything-c-source-bookmark-gnus
12306      anything-c-source-bookmark-info
12307      anything-c-source-bookmark-man
12308      anything-c-source-bookmark-images
12309      anything-c-source-bookmark-su-files&dirs
12310      anything-c-source-bookmark-ssh-files&dirs)
12311    :prompt "SearchBookmark: "
12312    :buffer "*anything bmkext*"))
12313
12314 ;;;###autoload
12315 (defun anything-simple-call-tree ()
12316   "Preconfigured `anything' for simple-call-tree. List function relationships.
12317
12318 Needs simple-call-tree.el.
12319 http://www.emacswiki.org/cgi-bin/wiki/download/simple-call-tree.el"
12320   (interactive)
12321   (anything-other-buffer
12322    '(anything-c-source-simple-call-tree-functions-callers
12323      anything-c-source-simple-call-tree-callers-functions)
12324    "*anything simple-call-tree*"))
12325
12326 ;;;###autoload
12327 (defun anything-mark-ring ()
12328   "Preconfigured `anything' for `anything-c-source-mark-ring'."
12329   (interactive)
12330   (anything :sources 'anything-c-source-mark-ring))
12331
12332 ;;;###autoload
12333 (defun anything-global-mark-ring ()
12334   "Preconfigured `anything' for `anything-c-source-global-mark-ring'."
12335   (interactive)
12336   (anything :sources 'anything-c-source-global-mark-ring))
12337
12338 ;;;###autoload
12339 (defun anything-all-mark-rings ()
12340   "Preconfigured `anything' for `anything-c-source-global-mark-ring' and \
12341 `anything-c-source-mark-ring'."
12342   (interactive)
12343   (anything :sources '(anything-c-source-mark-ring
12344                        anything-c-source-global-mark-ring)))
12345
12346 ;;;###autoload
12347 (defun anything-yaoddmuse-emacswiki-edit-or-view ()
12348   "Preconfigured `anything' to edit or view EmacsWiki page.
12349
12350 Needs yaoddmuse.el.
12351
12352 http://www.emacswiki.org/emacs/download/yaoddmuse.el"
12353   (interactive)
12354   (anything :sources 'anything-c-source-yaoddmuse-emacswiki-edit-or-view))
12355
12356 ;;;###autoload
12357 (defun anything-yaoddmuse-emacswiki-post-library ()
12358   "Preconfigured `anything' to post library to EmacsWiki.
12359
12360 Needs yaoddmuse.el.
12361
12362 http://www.emacswiki.org/emacs/download/yaoddmuse.el"
12363   (interactive)
12364   (anything :sources 'anything-c-source-yaoddmuse-emacswiki-post-library))
12365
12366 ;;;###autoload
12367 (defun anything-eval-expression (arg)
12368   "Preconfigured anything for `anything-c-source-evaluation-result'."
12369   (interactive "P")
12370   (anything :sources 'anything-c-source-evaluation-result
12371             :input (when arg (thing-at-point 'sexp))
12372             :buffer "*anything eval*"
12373             :history 'anything-eval-expression-input-history
12374             :keymap anything-eval-expression-map))
12375
12376 ;;;###autoload
12377 (defun anything-eval-expression-with-eldoc ()
12378   "Preconfigured anything for `anything-c-source-evaluation-result' with `eldoc' support. "
12379   (interactive)
12380   (declare (special eldoc-idle-delay))
12381   (let ((timer (run-with-idle-timer eldoc-idle-delay
12382                                     'repeat 'anything-eldoc-show-in-eval))
12383         (minibuffer-completing-symbol t) ; Enable lisp completion.
12384         (completion-cycle-threshold t))  ; Always cycle, no pesty completion buffer (emacs24 only).
12385     (unwind-protect
12386          (minibuffer-with-setup-hook
12387              'anything-eldoc-store-minibuffer
12388            (call-interactively 'anything-eval-expression))
12389       (and timer (cancel-timer timer))
12390       (setq anything-eldoc-active-minibuffers-list
12391             (cdr anything-eldoc-active-minibuffers-list)))))
12392
12393 ;;;###autoload
12394 (defun anything-calcul-expression ()
12395   "Preconfigured anything for `anything-c-source-calculation-result'."
12396   (interactive)
12397   (anything-other-buffer 'anything-c-source-calculation-result "*anything calcul*"))
12398
12399 ;;;###autoload
12400 (defun anything-surfraw (pattern engine)
12401   "Preconfigured `anything' to search PATTERN with search ENGINE."
12402   (interactive (list (read-string "SearchFor: "
12403                                   nil 'anything-surfraw-input-history)
12404                      (anything-comp-read
12405                       "Engine: "
12406                       (anything-c-build-elvi-list)
12407                       :must-match t
12408                       :name "Surfraw Search Engines"
12409                       :history anything-surfraw-engines-history)))
12410   (let* ((engine-nodesc (car (split-string engine)))
12411          (url (with-temp-buffer
12412                 (apply 'call-process "surfraw" nil t nil
12413                        ;;JAVE
12414                        (append  (list engine-nodesc "-p") (split-string pattern)))
12415                 (replace-regexp-in-string
12416                  "\n" "" (buffer-string))))
12417          (browse-url-browser-function (or anything-surfraw-default-browser-function
12418                                           browse-url-browser-function)))
12419     (if (string= engine-nodesc "W")
12420         (anything-c-browse-url anything-c-home-url)
12421         (anything-c-browse-url url)
12422         (setq anything-surfraw-engines-history
12423               (cons engine (delete engine anything-surfraw-engines-history))))))
12424
12425 ;;;###autoload
12426 (defun anything-call-source ()
12427   "Preconfigured `anything' to call anything source."
12428   (interactive)
12429   (anything :sources 'anything-c-source-call-source
12430             :buffer anything-source-select-buffer))
12431
12432 ;;;###autoload
12433 (defun anything-execute-anything-command ()
12434   "Preconfigured `anything' to execute preconfigured `anything'."
12435   (interactive)
12436   (anything-other-buffer 'anything-c-source-anything-commands
12437                          "*anything commands*"))
12438
12439 ;;;###autoload
12440 (defun anything-create (&optional string initial-input)
12441   "Preconfigured `anything' to do many create actions from STRING.
12442 See also `anything-create--actions'."
12443   (interactive)
12444   (setq string (or string (read-string "Create Anything: " initial-input)))
12445   (anything :sources '(((name . "Anything Create")
12446                         (header-name . (lambda (_) (format "Action for \"%s\"" string)))
12447                         (candidates . anything-create--actions)
12448                         (candidate-number-limit)
12449                         (action . (lambda (func) (funcall func string)))))))
12450
12451 ;;;###autoload
12452 (defun anything-top ()
12453   "Preconfigured `anything' for top command."
12454   (interactive)
12455   (let ((anything-samewindow t)
12456         (anything-enable-shortcuts)
12457         (anything-display-function 'anything-default-display-buffer)
12458         (anything-candidate-number-limit 9999))
12459     (save-window-excursion
12460       (delete-other-windows)
12461       (anything-other-buffer 'anything-c-source-top "*anything top*"))))
12462
12463 ;;;###autoload
12464 (defun anything-select-xfont ()
12465   "Preconfigured `anything' to select Xfont."
12466   (interactive)
12467   (anything-other-buffer 'anything-c-source-xfonts "*anything select* xfont"))
12468
12469 ;;;###autoload
12470 (defun anything-world-time ()
12471   "Preconfigured `anything' to show world time."
12472   (interactive)
12473   (anything-other-buffer 'anything-c-source-time-world "*anything world time*"))
12474
12475 ;;;###autoload
12476 (defun anything-apt (arg)
12477   "Preconfigured `anything' : frontend of APT package manager.
12478 With a prefix arg reload cache."
12479   (interactive "P")
12480   (let ((query (read-string "Search Package: " nil 'anything-c-apt-input-history)))
12481     (when arg (anything-c-apt-refresh))
12482     (anything :sources 'anything-c-source-apt
12483               :prompt "Search Package: "
12484               :input query
12485               :history 'anything-c-apt-input-history)))
12486
12487 ;;;###autoload
12488 (defun anything-esh-pcomplete ()
12489   "Preconfigured anything to provide anything completion in eshell."
12490   (interactive)
12491   (let* ((anything-quit-if-no-candidate t)
12492          (anything-execute-action-at-once-if-one t)
12493          (target (thing-at-point 'symbol))
12494          (end (point))
12495          (beg (or (and target (- end (length target)))
12496                   ;; Nothing at point.
12497                   (progn (insert " ") (point)))))
12498     (setq anything-ec-target (or target " "))
12499     (with-anything-show-completion beg end
12500       (anything :sources 'anything-c-source-esh
12501                 :buffer "*anything pcomplete*"
12502                 :input (anything-ff-set-pattern ; Handle tramp filenames.
12503                         (car (last (ignore-errors ; Needed in lisp symbols completion.
12504                                      (pcomplete-parse-arguments)))))))))
12505
12506 ;;;###autoload
12507 (defun anything-eshell-history ()
12508   "Preconfigured anything for eshell history."
12509   (interactive)
12510   (let* ((end (point))
12511          (beg (save-excursion (eshell-bol) (point)))
12512          (input (buffer-substring beg end))
12513          flag-empty)
12514     (when (eq beg end)
12515       (insert " ")
12516       (setq flag-empty t)
12517       (setq end (point)))
12518     (unwind-protect
12519          (with-anything-show-completion beg end
12520            (anything :sources 'anything-c-source-eshell-history
12521                      :buffer "*Eshell history*"
12522                      :input input))
12523       (when (and flag-empty
12524                  (looking-back " "))
12525         (delete-char -1)))))
12526
12527 ;;;###autoload
12528 (defun anything-c-run-external-command (program)
12529   "Preconfigured `anything' to run External PROGRAM asyncronously from Emacs.
12530 If program is already running exit with error.
12531 You can set your own list of commands with
12532 `anything-c-external-commands-list'."
12533   (interactive (list
12534                 (anything-comp-read
12535                  "RunProgram: "
12536                  (anything-c-external-commands-list-1 'sort)
12537                  :must-match t
12538                  :name "External Commands"
12539                  :history anything-external-command-history)))
12540   (anything-run-or-raise program)
12541   (setq anything-external-command-history
12542         (cons program (delete program
12543                               (loop for i in anything-external-command-history
12544                                     when (executable-find i) collect i)))))
12545
12546 ;;;###autoload
12547 (defun anything-ratpoison-commands ()
12548   "Preconfigured `anything' to execute ratpoison commands."
12549   (interactive)
12550   (anything-other-buffer 'anything-c-source-ratpoison-commands
12551                          "*anything ratpoison commands*"))
12552
12553 ;;;###autoload
12554 (defun anything-ucs ()
12555   "Preconfigured anything for `ucs-names' math symbols."
12556   (interactive)
12557   (anything :sources 'anything-c-source-ucs
12558             :keymap  anything-c-ucs-map))
12559
12560 ;;;###autoload
12561 (defun anything-c-apropos ()
12562   "Preconfigured anything to describe commands, functions, variables and faces."
12563   (interactive)
12564   (let ((default (thing-at-point 'symbol)))
12565     (anything :sources
12566               `(((name . "Commands")
12567                  (init . (lambda ()
12568                            (anything-c-apropos-init 'commandp ,default)))
12569                  (persistent-action . anything-lisp-completion-persistent-action)
12570                  (persistent-help . "Show brief doc in mode-line")
12571                  (candidates-in-buffer)
12572                  (action . (lambda (candidate)
12573                              (describe-function (intern candidate)))))
12574                 ((name . "Functions")
12575                  (init . (lambda ()
12576                            (anything-c-apropos-init #'(lambda (x) (and (fboundp x)
12577                                                                        (not (commandp x))))
12578                                                     ,default)))
12579                  (persistent-action . anything-lisp-completion-persistent-action)
12580                  (persistent-help . "Show brief doc in mode-line")
12581                  (candidates-in-buffer)
12582                  (action . (lambda (candidate)
12583                              (describe-function (intern candidate)))))
12584                 ((name . "Variables")
12585                  (init . (lambda ()
12586                            (anything-c-apropos-init 'boundp ,default)))
12587                  (persistent-action . anything-lisp-completion-persistent-action)
12588                  (persistent-help . "Show brief doc in mode-line")
12589                  (candidates-in-buffer)
12590                  (action . (lambda (candidate)
12591                              (describe-variable (intern candidate)))))
12592                 ((name . "Faces")
12593                  (init . (lambda ()
12594                            (anything-c-apropos-init 'facep ,default)))
12595                  (persistent-action . anything-lisp-completion-persistent-action)
12596                  (persistent-help . "Show brief doc in mode-line")
12597                  (candidates-in-buffer)
12598                  (filtered-candidate-transformer . (lambda (candidates source)
12599                                                      (loop for c in candidates
12600                                                            collect (propertize c 'face (intern c)))))
12601                  (action . (lambda (candidate)
12602                              (describe-face (intern candidate)))))
12603                 ((name . "Anything attributes")
12604                  (candidates . (lambda ()
12605                                  (mapcar 'symbol-name anything-additional-attributes)))
12606                  (action . (lambda (candidate)
12607                              (with-output-to-temp-buffer "*Help*"
12608                                (princ (get (intern candidate) 'anything-attrdoc))))))))))
12609
12610 ;;;###autoload
12611 (defun anything-xrandr-set ()
12612   (interactive)
12613   (anything :sources 'anything-c-source-xrandr-change-resolution
12614             :buffer "*anything xrandr*"))
12615
12616 \f
12617 ;;; Unit tests are now in ../developer-tools/unit-test-anything-config.el.
12618
12619 (provide 'anything-config)
12620
12621 ;; Local Variables:
12622 ;; coding: utf-8
12623 ;; End:
12624
12625 ;;; anything-config.el ends here