anything-config.el

   1 ;;; anything-config.el --- Predefined configurations for `anything.el'
   2
   3 ;; Filename: anything-config.el
   4
   5 ;; Description: Predefined configurations for `anything.el'
   6 ;; Author: Tassilo Horn <tassilo@member.fsf.org>
   7 ;; Maintainer: Tassilo Horn <tassilo@member.fsf.org>
   8 ;;             rubikitch    <rubikitch@ruby-lang.org>
   9 ;;             Thierry Volpiatto <thierry.volpiatto@gmail.com>
  10 ;; Copyright (C) 2007 ~ 2011, Tassilo Horn, all rights reserved.
  11 ;; Copyright (C) 2009, Andy Stewart, all rights reserved.
  12 ;; Copyright (C) 2009 ~ 2011, rubikitch, all rights reserved.
  13 ;; Copyright (C) 2009 ~ 2011, Thierry Volpiatto, all rights reserved.
  14 ;; Created: 2009-02-16 21:38:23
  15 ;; Version: 0.4.1
  16 ;; URL: http://www.emacswiki.org/emacs/download/anything-config.el
  17 ;; Keywords: anything, anything-config
  18 ;; Compatibility: GNU Emacs 22 ~ 23
  19 ;;
  20 ;; Features that might be required by this library:
  21 ;;
  22 ;; `anything'
  23 ;;
  24
  25 ;;; This file is NOT part of GNU Emacs
  26
  27 ;;; License
  28 ;;
  29 ;; This program is free software; you can redistribute it and/or modify
  30 ;; it under the terms of the GNU General Public License as published by
  31 ;; the Free Software Foundation; either version 3, or (at your option)
  32 ;; any later version.
  33
  34 ;; This program is distributed in the hope that it will be useful,
  35 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  36 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  37 ;; GNU General Public License for more details.
  38
  39 ;; You should have received a copy of the GNU General Public License
  40 ;; along with this program; see the file COPYING.  If not, write to
  41 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
  42 ;; Floor, Boston, MA 02110-1301, USA.
  43
  44 ;;; !NOTICE!
  45 ;;
  46 ;; If this file does not work, upgrade anything.el!
  47 ;; http://www.emacswiki.org/cgi-bin/wiki/download/anything.el
  48
  49 ;;; Commentary:
  50 ;;
  51 ;; Predefined configurations for `anything.el'
  52 ;;
  53 ;; For quick start, try `anything-for-files' to open files.
  54 ;;
  55 ;; To configure anything you should define anything command
  56 ;; with your favorite sources, like below:
  57 ;;
  58 ;; (defun my-anything ()
  59 ;;   (interactive)
  60 ;;   (anything-other-buffer
  61 ;;    '(anything-c-source-buffers
  62 ;;      anything-c-source-file-name-history
  63 ;;      anything-c-source-info-pages
  64 ;;      anything-c-source-info-elisp
  65 ;;      anything-c-source-man-pages
  66 ;;      anything-c-source-locate
  67 ;;      anything-c-source-emacs-commands)
  68 ;;    " *my-anything*"))
  69 ;;
  70 ;; Then type M-x my-anything to use sources.
  71 ;;
  72 ;; Defining own command is better than setup `anything-sources'
  73 ;; directly, because you can define multiple anything commands with
  74 ;; different sources. Each anything command should have own anything
  75 ;; buffer, because M-x anything-resume revives anything command.
  76
  77 ;;; Autodoc documentation:
  78 ;;  ---------------------
  79
  80 ;;  * Commands defined here are:
  81 ;; [EVAL] (autodoc-document-lisp-buffer :type 'command :prefix "anything-" :docstring t)
  82 ;; `anything-configuration'
  83 ;; Customize `anything'.
  84 ;; `anything-c-describe-anything-bindings'
  85 ;; [OBSOLETE] Describe `anything' bindings.
  86 ;; `anything-mini'
  87 ;; Preconfigured `anything' lightweight version         (buffer -> recentf).
  88 ;; `anything-for-files'
  89 ;; Preconfigured `anything' for opening files.
  90 ;; `anything-recentf'
  91 ;; Preconfigured `anything' for `recentf'.
  92 ;; `anything-info-at-point'
  93 ;; Preconfigured `anything' for searching info at point.
  94 ;; `anything-info-emacs'
  95 ;; Preconfigured anything for Emacs manual index.
  96 ;; `anything-show-kill-ring'
  97 ;; Preconfigured `anything' for `kill-ring'. It is drop-in replacement of `yank-pop'.
  98 ;; `anything-minibuffer-history'
  99 ;; Preconfigured `anything' for `minibuffer-history'.
 100 ;; `anything-gentoo'
 101 ;; Preconfigured `anything' for gentoo linux.
 102 ;; `anything-imenu'
 103 ;; Preconfigured `anything' for `imenu'.
 104 ;; `anything-google-suggest'
 105 ;; Preconfigured `anything' for google search with google suggest.
 106 ;; `anything-yahoo-suggest'
 107 ;; Preconfigured `anything' for Yahoo searching with Yahoo suggest.
 108 ;; `anything-for-buffers'
 109 ;; Preconfigured `anything' for buffer.
 110 ;; `anything-buffers+'
 111 ;; Enhanced preconfigured `anything' for buffer.
 112 ;; `anything-bbdb'
 113 ;; Preconfigured `anything' for BBDB.
 114 ;; `anything-locate'
 115 ;; Preconfigured `anything' for Locate.
 116 ;; `anything-w3m-bookmarks'
 117 ;; Preconfigured `anything' for w3m bookmark.
 118 ;; `anything-firefox-bookmarks'
 119 ;; Preconfigured `anything' for firefox bookmark.
 120 ;; `anything-colors'
 121 ;; Preconfigured `anything' for color.
 122 ;; `anything-bookmarks'
 123 ;; Preconfigured `anything' for bookmarks.
 124 ;; `anything-c-pp-bookmarks'
 125 ;; Preconfigured `anything' for bookmarks               (pretty-printed).
 126 ;; `anything-c-insert-latex-math'
 127 ;; Preconfigured anything for latex math symbols completion.
 128 ;; `anything-register'
 129 ;; Preconfigured `anything' for Emacs registers.
 130 ;; `anything-man-woman'
 131 ;; Preconfigured `anything' for Man and Woman pages.
 132 ;; `anything-org-keywords'
 133 ;; Preconfigured `anything' for org keywords.
 134 ;; `anything-emms'
 135 ;; Preconfigured `anything' for emms sources.
 136 ;; `anything-eev-anchors'
 137 ;; Preconfigured `anything' for eev anchors.
 138 ;; `anything-bm-list'
 139 ;; Preconfigured `anything' for visible bookmarks.
 140 ;; `anything-timers'
 141 ;; Preconfigured `anything' for timers.
 142 ;; `anything-list-emacs-process'
 143 ;; Preconfigured `anything' for emacs process.
 144 ;; `anything-occur'
 145 ;; Preconfigured Anything for Occur source.
 146 ;; `anything-browse-code'
 147 ;; Preconfigured anything to browse code.
 148 ;; `anything-org-headlines'
 149 ;; Preconfigured anything to show org headlines.
 150 ;; `anything-kill-buffers'
 151 ;; Preconfigured `anything' to kill buffer you selected.
 152 ;; `anything-regexp'
 153 ;; Preconfigured anything to build regexps and run query-replace-regexp against.
 154 ;; `anything-insert-buffer-name'
 155 ;; Insert buffer name.
 156 ;; `anything-insert-symbol'
 157 ;; Insert current symbol.
 158 ;; `anything-insert-selection'
 159 ;; Insert current selection.
 160 ;; `anything-show-buffer-only'
 161 ;; [OBSOLETE] Only show sources about buffer.
 162 ;; `anything-show-bbdb-only'
 163 ;; [OBSOLETE] Only show sources about BBDB.
 164 ;; `anything-show-locate-only'
 165 ;; [OBSOLETE] Only show sources about Locate.
 166 ;; `anything-show-info-only'
 167 ;; [OBSOLETE] Only show sources about Info.
 168 ;; `anything-show-imenu-only'
 169 ;; [OBSOLETE] Only show sources about Imenu.
 170 ;; `anything-show-files-only'
 171 ;; [OBSOLETE] Only show sources about File.
 172 ;; `anything-show-w3m-bookmarks-only'
 173 ;; [OBSOLETE] Only show source about w3m bookmark.
 174 ;; `anything-show-colors-only'
 175 ;; [OBSOLETE] Only show source about color.
 176 ;; `anything-show-kill-ring-only'
 177 ;; [OBSOLETE] Only show source about kill ring.
 178 ;; `anything-show-this-source-only'
 179 ;; Only show this source.
 180 ;; `anything-test-sources'
 181 ;; List all anything sources for test.
 182 ;; `anything-select-source'
 183 ;; Select source.
 184 ;; `anything-mark-all'
 185 ;; Mark all visible unmarked candidates in current source.
 186 ;; `anything-unmark-all'
 187 ;; Unmark all candidates in all sources of current anything session.
 188 ;; `anything-toggle-all-marks'
 189 ;; Toggle all marks.
 190 ;; `anything-c-buffer-help'
 191 ;; Not documented.
 192 ;; `anything-buffer-diff-persistent'
 193 ;; Toggle diff buffer without quitting anything.
 194 ;; `anything-buffer-revert-persistent'
 195 ;; Revert buffer without quitting anything.
 196 ;; `anything-buffer-save-persistent'
 197 ;; Save buffer without quitting anything.
 198 ;; `anything-buffer-run-kill-buffers'
 199 ;; Run kill buffer action from `anything-c-source-buffer+'.
 200 ;; `anything-buffer-run-grep'
 201 ;; Run Grep action from `anything-c-source-buffer+'.
 202 ;; `anything-buffer-run-query-replace-regexp'
 203 ;; Run Query replace regexp action from `anything-c-source-buffer+'.
 204 ;; `anything-buffer-run-query-replace'
 205 ;; Run Query replace action from `anything-c-source-buffer+'.
 206 ;; `anything-buffer-switch-other-window'
 207 ;; Run switch to other window action from `anything-c-source-buffer+'.
 208 ;; `anything-buffer-switch-other-frame'
 209 ;; Run switch to other frame action from `anything-c-source-buffer+'.
 210 ;; `anything-buffer-switch-to-elscreen'
 211 ;; Run switch to elscreen  action from `anything-c-source-buffer+'.
 212 ;; `anything-ff-help'
 213 ;; Not documented.
 214 ;; `anything-ff-run-switch-to-history'
 215 ;; Run Switch to history action from `anything-c-source-find-files'.
 216 ;; `anything-ff-run-grep'
 217 ;; Run Grep action from `anything-c-source-find-files'.
 218 ;; `anything-ff-run-pdfgrep'
 219 ;; Run Pdfgrep action from `anything-c-source-find-files'.
 220 ;; `anything-ff-run-copy-file'
 221 ;; Run Copy file action from `anything-c-source-find-files'.
 222 ;; `anything-ff-run-rename-file'
 223 ;; Run Rename file action from `anything-c-source-find-files'.
 224 ;; `anything-ff-run-byte-compile-file'
 225 ;; Run Byte compile file action from `anything-c-source-find-files'.
 226 ;; `anything-ff-run-load-file'
 227 ;; Run Load file action from `anything-c-source-find-files'.
 228 ;; `anything-ff-run-eshell-command-on-file'
 229 ;; Run eshell command on file action from `anything-c-source-find-files'.
 230 ;; `anything-ff-run-ediff-file'
 231 ;; Run Ediff file action from `anything-c-source-find-files'.
 232 ;; `anything-ff-run-ediff-merge-file'
 233 ;; Run Ediff merge file action from `anything-c-source-find-files'.
 234 ;; `anything-ff-run-symlink-file'
 235 ;; Run Symlink file action from `anything-c-source-find-files'.
 236 ;; `anything-ff-run-delete-file'
 237 ;; Run Delete file action from `anything-c-source-find-files'.
 238 ;; `anything-ff-run-complete-fn-at-point'
 239 ;; Run complete file name action from `anything-c-source-find-files'.
 240 ;; `anything-ff-run-switch-to-eshell'
 241 ;; Run switch to eshell action from `anything-c-source-find-files'.
 242 ;; `anything-ff-run-switch-other-window'
 243 ;; Run switch to other window action from `anything-c-source-find-files'.
 244 ;; `anything-ff-run-switch-other-frame'
 245 ;; Run switch to other frame action from `anything-c-source-find-files'.
 246 ;; `anything-ff-run-open-file-externally'
 247 ;; Run open file externally command action from `anything-c-source-find-files'.
 248 ;; `anything-ff-run-gnus-attach-files'
 249 ;; Run gnus attach files command action from `anything-c-source-find-files'.
 250 ;; `anything-ff-run-print-file'
 251 ;; Run Print file action from `anything-c-source-find-files'.
 252 ;; `anything-find-files-down-one-level'
 253 ;; Go down one level like unix command `cd ..'.
 254 ;; `anything-ff-properties-persistent'
 255 ;; Show properties without quitting anything.
 256 ;; `anything-ff-rotate-left-persistent'
 257 ;; Rotate image left without quitting anything.
 258 ;; `anything-ff-rotate-right-persistent'
 259 ;; Rotate image right without quitting anything.
 260 ;; `anything-find-files'
 261 ;; Preconfigured `anything' for anything implementation of `find-file'.
 262 ;; `anything-write-file'
 263 ;; Preconfigured `anything' providing completion for `write-file'.
 264 ;; `anything-insert-file'
 265 ;; Preconfigured `anything' providing completion for `insert-file'.
 266 ;; `anything-dired-rename-file'
 267 ;; Preconfigured `anything' to rename files from dired.
 268 ;; `anything-dired-copy-file'
 269 ;; Preconfigured `anything' to copy files from dired.
 270 ;; `anything-dired-symlink-file'
 271 ;; Preconfigured `anything' to symlink files from dired.
 272 ;; `anything-dired-hardlink-file'
 273 ;; Preconfigured `anything' to hardlink files from dired.
 274 ;; `anything-dired-bindings'
 275 ;; Replace usual dired commands `C' and `R' by anything ones.
 276 ;; `anything-generic-file-help'
 277 ;; Not documented.
 278 ;; `anything-do-grep'
 279 ;; Preconfigured anything for grep.
 280 ;; `anything-c-goto-precedent-file'
 281 ;; Go to precedent file in anything grep/etags buffers.
 282 ;; `anything-c-goto-next-file'
 283 ;; Go to precedent file in anything grep/etags buffers.
 284 ;; `anything-grep-help'
 285 ;; Not documented.
 286 ;; `anything-c-grep-run-persistent-action'
 287 ;; Run grep persistent action from `anything-do-grep1'.
 288 ;; `anything-c-grep-run-default-action'
 289 ;; Run grep default action from `anything-do-grep1'.
 290 ;; `anything-c-grep-run-other-window-action'
 291 ;; Run grep goto other window action from `anything-do-grep1'.
 292 ;; `anything-c-grep-run-save-buffer'
 293 ;; Run grep save results action from `anything-do-grep1'.
 294 ;; `anything-pdfgrep-help'
 295 ;; Not documented.
 296 ;; `anything-do-pdfgrep'
 297 ;; Not documented.
 298 ;; `anything-yank-text-at-point'
 299 ;; Yank text at point in minibuffer.
 300 ;; `anything-etags-help'
 301 ;; Not documented.
 302 ;; `anything-c-etags-select'
 303 ;; Preconfigured anything for etags.
 304 ;; `anything-filelist'
 305 ;; Preconfigured `anything' to open files instantly.
 306 ;; `anything-filelist+'
 307 ;; Preconfigured `anything' to open files/buffers/bookmarks instantly.
 308 ;; `anything-c-describe-attributes'
 309 ;; Display the full documentation of ANYTHING-ATTRIBUTE (a symbol).
 310 ;; `anything-M-x'
 311 ;; Preconfigured `anything' for Emacs commands.
 312 ;; `anything-manage-advice'
 313 ;; Preconfigured `anything' to disable/enable function advices.
 314 ;; `anything-bookmark-ext'
 315 ;; Preconfigured `anything' for bookmark-extensions sources.
 316 ;; `anything-simple-call-tree'
 317 ;; Preconfigured `anything' for simple-call-tree. List function relationships.
 318 ;; `anything-mark-ring'
 319 ;; Preconfigured `anything' for `anything-c-source-mark-ring'.
 320 ;; `anything-global-mark-ring'
 321 ;; Preconfigured `anything' for `anything-c-source-global-mark-ring'.
 322 ;; `anything-all-mark-rings'
 323 ;; Preconfigured `anything' for `anything-c-source-global-mark-ring' and `anything-c-source-mark-ring'.
 324 ;; `anything-yaoddmuse-cache-pages'
 325 ;; Fetch the list of files on emacswiki and create cache file.
 326 ;; `anything-yaoddmuse-emacswiki-edit-or-view'
 327 ;; Preconfigured `anything' to edit or view EmacsWiki page.
 328 ;; `anything-yaoddmuse-emacswiki-post-library'
 329 ;; Preconfigured `anything' to post library to EmacsWiki.
 330 ;; `anything-eval-expression'
 331 ;; Preconfigured anything for `anything-c-source-evaluation-result'.
 332 ;; `anything-eval-expression-with-eldoc'
 333 ;; Preconfigured anything for `anything-c-source-evaluation-result' with `eldoc' support.
 334 ;; `anything-calcul-expression'
 335 ;; Preconfigured anything for `anything-c-source-calculation-result'.
 336 ;; `anything-surfraw'
 337 ;; Preconfigured `anything' to search PATTERN with search ENGINE.
 338 ;; `anything-call-source'
 339 ;; Preconfigured `anything' to call anything source.
 340 ;; `anything-call-source-from-anything'
 341 ;; Call anything source within `anything' session.
 342 ;; `anything-execute-anything-command'
 343 ;; Preconfigured `anything' to execute preconfigured `anything'.
 344 ;; `anything-create-from-anything'
 345 ;; Run `anything-create' from `anything' as a fallback.
 346 ;; `anything-create'
 347 ;; Preconfigured `anything' to do many create actions from STRING.
 348 ;; `anything-top'
 349 ;; Preconfigured `anything' for top command.
 350 ;; `anything-select-xfont'
 351 ;; Preconfigured `anything' to select Xfont.
 352 ;; `anything-world-time'
 353 ;; Preconfigured `anything' to show world time.
 354 ;; `anything-apt'
 355 ;; Preconfigured `anything' : frontend of APT package manager.
 356 ;; `anything-c-shell-command-if-needed'
 357 ;; Not documented.
 358 ;; `anything-c-run-external-command'
 359 ;; Preconfigured `anything' to run External PROGRAM asyncronously from Emacs.
 360 ;; `anything-ratpoison-commands'
 361 ;; Preconfigured `anything' to execute ratpoison commands.
 362 ;; `anything-c-set-variable'
 363 ;; Set value to VAR interactively.
 364 ;; `anything-c-adaptive-save-history'
 365 ;; Save history information to file given by `anything-c-adaptive-history-file'.
 366 ;; `anything-c-reset-adaptative-history'
 367 ;; Delete all `anything-c-adaptive-history' and his file.
 368 ;; `anything-c-toggle-match-plugin'
 369 ;; Toggle anything-match-plugin.
 370
 371 ;;  * User variables defined here:
 372 ;; [EVAL] (autodoc-document-lisp-buffer :type 'user-variable :prefix "anything-" :var-value t)
 373 ;; `anything-c-use-standard-keys'
 374 ;; Default Value: nil
 375 ;; `anything-c-adaptive-history-file'
 376 ;; Default Value: "~/.emacs.d/anything-c-adaptive-history"
 377 ;; `anything-c-adaptive-history-length'
 378 ;; Default Value: 50
 379 ;; `anything-c-google-suggest-url'
 380 ;; Default Value: "http://google.com/complete/search?output=toolbar&q="
 381 ;; `anything-c-google-suggest-search-url'
 382 ;; Default Value: "http://www.google.com/search?ie=utf-8&oe=utf-8&q="
 383 ;; `anything-google-suggest-use-curl-p'
 384 ;; Default Value: nil
 385 ;; `anything-c-yahoo-suggest-url'
 386 ;; Default Value: "http://search.yahooapis.com/WebSearchService/V1/relatedSuggestion?appid=G [...]
 387 ;; `anything-c-yahoo-suggest-search-url'
 388 ;; Default Value: "http://search.yahoo.com/search?&ei=UTF-8&fr&h=c&p="
 389 ;; `anything-c-boring-buffer-regexp'
 390 ;; Default Value: "\\   (\\` \\)\\|\\*anything\\| \\*Echo Area\\| \\*Minibuf"
 391 ;; `anything-c-boring-file-regexp'
 392 ;; Default Value: "/\\  (?:\\(?:\\.\\(?:git\\|hg\\|svn\\)\\|CVS\\|_darcs\\)\\)\\(?:/\\|$\\)\\| [...]
 393 ;; `anything-kill-ring-threshold'
 394 ;; Default Value: 10
 395 ;; `anything-su-or-sudo'
 396 ;; Default Value: "su"
 397 ;; `anything-for-files-prefered-list'
 398 ;; Default Value:       (anything-c-source-ffap-line anything-c-source-ffap-guesser anything-c-sou [...]
 399 ;; `anything-create--actions-private'
 400 ;; Default Value: nil
 401 ;; `anything-allow-skipping-current-buffer'
 402 ;; Default Value: t
 403 ;; `anything-c-enable-eval-defun-hack'
 404 ;; Default Value: t
 405 ;; `anything-tramp-verbose'
 406 ;; Default Value: 0
 407 ;; `anything-raise-command'
 408 ;; Default Value: nil
 409 ;; `anything-command-map-prefix-key'
 410 ;; Default Value: "<f5> a"
 411 ;; `anything-c-find-files-show-icons'
 412 ;; Default Value: nil
 413 ;; `anything-c-find-files-icons-directory'
 414 ;; Default Value: "/usr/local/share/emacs/24.0.50/etc/images/tree-widget/default"
 415 ;; `anything-c-browse-code-regexp-lisp'
 416 ;; Default Value: "^ *  (def\\(un\\|subst\\|macro\\|face\\|alias\\|advice\\|struct\\|type\\|th [...]
 417 ;; `anything-c-browse-code-regexp-python'
 418 ;; Default Value: "\\<def\\>\\|\\<class\\>"
 419 ;; `anything-c-browse-code-regexp-alist'
 420 ;; Default Value:       ((lisp-interaction-mode . "^ *(def\\(un\\|subst\\|macro\\|face\\|alias\\|a [...]
 421 ;; `anything-c-external-programs-associations'
 422 ;; Default Value: nil
 423 ;; `anything-ff-lynx-style-map'
 424 ;; Default Value: t
 425 ;; `anything-ff-history-max-length'
 426 ;; Default Value: 100
 427 ;; `anything-ff-default-kbsize'
 428 ;; Default Value: 1024.0
 429 ;; `anything-ff-exif-data-program'
 430 ;; Default Value: "exiftran"
 431 ;; `anything-ff-exif-data-program-args'
 432 ;; Default Value: "-d"
 433 ;; `anything-c-grep-use-ioccur-style-keys'
 434 ;; Default Value: t
 435 ;; `anything-c-pdfgrep-default-read-command'
 436 ;; Default Value: "xpdf '%f' %p"
 437 ;; `anything-c-etags-tag-file-name'
 438 ;; Default Value: "TAGS"
 439 ;; `anything-c-etags-tag-file-search-limit'
 440 ;; Default Value: 10
 441 ;; `anything-c-filelist-file-name'
 442 ;; Default Value: nil
 443 ;; `anything-c-eldoc-in-minibuffer-show-fn'
 444 ;; Default Value: anything-c-eldoc-show-in-mode-line
 445 ;; `anything-c-default-external-file-browser'
 446 ;; Default Value: "nautilus"
 447 ;; `anything-c-use-adaptative-sorting'
 448 ;; Default Value: nil
 449
 450 ;;  * Anything sources defined here:
 451 ;; [EVAL] (autodoc-document-lisp-buffer :type 'anything-source :prefix "anything-" :any-sname t)
 452 ;; `anything-c-source-regexp'                                   (Regexp Builder)
 453 ;; `anything-c-source-buffers'                                  (Buffers)
 454 ;; `anything-c-source-buffer-not-found'                         (Create buffer)
 455 ;; `anything-c-source-buffers+'                                 (Buffers)
 456 ;; `anything-c-source-file-name-history'                        (File Name History)
 457 ;; `anything-c-source-files-in-current-dir'                     (Files from Current Directory)
 458 ;; `anything-c-source-files-in-current-dir+'                    (Files from Current Directory)
 459 ;; `anything-c-source-find-files'                               (Find Files (`C-.':Go to precedent level))
 460 ;; `anything-c-source-write-file'                               (Write File (`C-.':Go to precedent level))
 461 ;; `anything-c-source-insert-file'                              (Insert File (`C-.':Go to precedent level))
 462 ;; `anything-c-source-copy-files'                               (Copy Files (`C-.':Go to precedent level))
 463 ;; `anything-c-source-symlink-files'                            (Symlink Files (`C-.':Go to precedent level))
 464 ;; `anything-c-source-hardlink-files'                           (Hardlink Files (`C-.':Go to precedent level))
 465 ;; `anything-c-source-file-cache-initialized'                   ()
 466 ;; `anything-c-source-file-cache'                               (File Cache)
 467 ;; `anything-c-source-locate'                                   (Locate)
 468 ;; `anything-c-source-etags-select'                             (Etags)
 469 ;; `anything-c-source-recentf'                                  (Recentf)
 470 ;; `anything-c-source-ffap-guesser'                             (File at point)
 471 ;; `anything-c-source-ffap-line'                                (File/Lineno at point)
 472 ;; `anything-c-source-files-in-all-dired'                       (Files in all dired buffer.)
 473 ;; `anything-c-source-filelist'                                 (FileList)
 474 ;; `anything-c-source-info-pages'                               (Info Pages)
 475 ;; `anything-c-source-info-elisp'                               (Info index: elisp)
 476 ;; `anything-c-source-info-cl'                                  (Info index: cl)
 477 ;; `anything-c-source-info-org'                                 (Info index: org)
 478 ;; `anything-c-source-info-ratpoison'                           (Info index: ratpoison)
 479 ;; `anything-c-source-info-zsh'                                 (Info index: zsh)
 480 ;; `anything-c-source-info-bash'                                (Info index: bash)
 481 ;; `anything-c-source-info-coreutils'                           (Info index: coreutils)
 482 ;; `anything-c-source-info-fileutils'                           (Info index: fileutils)
 483 ;; `anything-c-source-info-find'                                (Info index: find)
 484 ;; `anything-c-source-info-sh-utils'                            (Info index: sh-utils)
 485 ;; `anything-c-source-info-textutils'                           (Info index: textutils)
 486 ;; `anything-c-source-info-libc'                                (Info index: libc)
 487 ;; `anything-c-source-info-make'                                (Info index: make)
 488 ;; `anything-c-source-info-automake'                            (Info index: automake)
 489 ;; `anything-c-source-info-autoconf'                            (Info index: autoconf)
 490 ;; `anything-c-source-info-emacs-lisp-intro'                    (Info index: emacs-lisp-intro)
 491 ;; `anything-c-source-info-emacs'                               (Info index: emacs)
 492 ;; `anything-c-source-info-elib'                                (Info index: elib)
 493 ;; `anything-c-source-info-eieio'                               (Info index: eieio)
 494 ;; `anything-c-source-info-gauche-refe'                         (Info index: gauche)
 495 ;; `anything-c-source-info-guile'                               (Info index: guile)
 496 ;; `anything-c-source-info-guile-tut'                           (Info index: guile-tut)
 497 ;; `anything-c-source-info-goops'                               (Info index: goops)
 498 ;; `anything-c-source-info-screen'                              (Info index: screen)
 499 ;; `anything-c-source-info-latex'                               (Info index: latex)
 500 ;; `anything-c-source-info-gawk'                                (Info index: gawk)
 501 ;; `anything-c-source-info-sed'                                 (Info index: sed)
 502 ;; `anything-c-source-info-m4'                                  (Info index: m4)
 503 ;; `anything-c-source-info-wget'                                (Info index: wget)
 504 ;; `anything-c-source-info-binutils'                            (Info index: binutils)
 505 ;; `anything-c-source-info-as'                                  (Info index: as)
 506 ;; `anything-c-source-info-bfd'                                 (Info index: bfd)
 507 ;; `anything-c-source-info-gprof'                               (Info index: gprof)
 508 ;; `anything-c-source-info-ld'                                  (Info index: ld)
 509 ;; `anything-c-source-info-diff'                                (Info index: diff)
 510 ;; `anything-c-source-info-flex'                                (Info index: flex)
 511 ;; `anything-c-source-info-grep'                                (Info index: grep)
 512 ;; `anything-c-source-info-gzip'                                (Info index: gzip)
 513 ;; `anything-c-source-info-libtool'                             (Info index: libtool)
 514 ;; `anything-c-source-info-texinfo'                             (Info index: texinfo)
 515 ;; `anything-c-source-info-info'                                (Info index: info)
 516 ;; `anything-c-source-info-gdb'                                 (Info index: gdb)
 517 ;; `anything-c-source-info-stabs'                               (Info index: stabs)
 518 ;; `anything-c-source-info-cvsbook'                             (Info index: cvsbook)
 519 ;; `anything-c-source-info-cvs'                                 (Info index: cvs)
 520 ;; `anything-c-source-info-bison'                               (Info index: bison)
 521 ;; `anything-c-source-info-id-utils'                            (Info index: id-utils)
 522 ;; `anything-c-source-info-global'                              (Info index: global)
 523 ;; `anything-c-source-man-pages'                                (Manual Pages)
 524 ;; `anything-c-source-complex-command-history'                  (Complex Command History)
 525 ;; `anything-c-source-extended-command-history'                 (Emacs Commands History)
 526 ;; `anything-c-source-emacs-commands'                           (Emacs Commands)
 527 ;; `anything-c-source-lacarte'                                  (Lacarte)
 528 ;; `anything-c-source-emacs-functions'                          (Emacs Functions)
 529 ;; `anything-c-source-emacs-functions-with-abbrevs'             (Emacs Functions)
 530 ;; `anything-c-source-advice'                                   (Function Advice)
 531 ;; `anything-c-source-emacs-variables'                          (Emacs Variables)
 532 ;; `anything-c-source-bookmarks'                                (Bookmarks)
 533 ;; `anything-c-source-bookmark-set'                             (Set Bookmark)
 534 ;; `anything-c-source-bm'                                       (Visible Bookmarks)
 535 ;; `anything-c-source-bookmarks-ssh'                            (Bookmarks-ssh)
 536 ;; `anything-c-source-bookmarks-su'                             (Bookmarks-root)
 537 ;; `anything-c-source-bookmarks-local'                          (Bookmarks-Local)
 538 ;; `anything-c-source-bmkext-addressbook'                       (Bookmark Addressbook)
 539 ;; `anything-c-source-bookmark-w3m'                             (Bookmark W3m)
 540 ;; `anything-c-source-bookmark-images'                          (Bookmark Images)
 541 ;; `anything-c-source-bookmark-man'                             (Bookmark Woman&Man)
 542 ;; `anything-c-source-bookmark-gnus'                            (Bookmark Gnus)
 543 ;; `anything-c-source-bookmark-info'                            (Bookmark Info)
 544 ;; `anything-c-source-bookmark-files&dirs'                      (Bookmark Files&Directories)
 545 ;; `anything-c-source-bookmark-su-files&dirs'                   (Bookmark Root-Files&Directories)
 546 ;; `anything-c-source-bookmark-ssh-files&dirs'                  (Bookmark Ssh-Files&Directories)
 547 ;; `anything-c-source-firefox-bookmarks'                        (Firefox Bookmarks)
 548 ;; `anything-c-source-w3m-bookmarks'                            (W3m Bookmarks)
 549 ;; `anything-c-source-elisp-library-scan'                       (Elisp libraries (Scan))
 550 ;; `anything-c-source-imenu'                                    (Imenu)
 551 ;; `anything-c-source-ctags'                                    (Exuberant ctags)
 552 ;; `anything-c-source-semantic'                                 (Semantic Tags)
 553 ;; `anything-c-source-simple-call-tree-functions-callers'       (Function is called by)
 554 ;; `anything-c-source-simple-call-tree-callers-functions'       (Function calls)
 555 ;; `anything-c-source-commands-and-options-in-file'             (Commands/Options in file)
 556 ;; `anything-c-source-customize-face'                           (Customize Face)
 557 ;; `anything-c-source-colors'                                   (Colors)
 558 ;; `anything-c-source-tracker-search'                           (Tracker Search)
 559 ;; `anything-c-source-mac-spotlight'                            (mdfind)
 560 ;; `anything-c-source-kill-ring'                                (Kill Ring)
 561 ;; `anything-c-source-mark-ring'                                (mark-ring)
 562 ;; `anything-c-source-global-mark-ring'                         (global-mark-ring)
 563 ;; `anything-c-source-register'                                 (Registers)
 564 ;; `anything-c-source-latex-math'                               (Latex Math Menu)
 565 ;; `anything-c-source-fixme'                                    (TODO/FIXME/DRY comments)
 566 ;; `anything-c-source-rd-headline'                              (RD HeadLine)
 567 ;; `anything-c-source-oddmuse-headline'                         (Oddmuse HeadLine)
 568 ;; `anything-c-source-emacs-source-defun'                       (Emacs Source DEFUN)
 569 ;; `anything-c-source-emacs-lisp-expectations'                  (Emacs Lisp Expectations)
 570 ;; `anything-c-source-emacs-lisp-toplevels'                     (Emacs Lisp Toplevel / Level 4 Comment / Linkd Star)
 571 ;; `anything-c-source-org-headline'                             (Org HeadLine)
 572 ;; `anything-c-source-yaoddmuse-emacswiki-edit-or-view'         (Yaoddmuse Edit or View (EmacsWiki))
 573 ;; `anything-c-source-yaoddmuse-emacswiki-post-library'         (Yaoddmuse Post library (EmacsWiki))
 574 ;; `anything-c-source-eev-anchor'                               (Anchors)
 575 ;; `anything-c-source-org-keywords'                             (Org Keywords)
 576 ;; `anything-c-source-picklist'                                 (Picklist)
 577 ;; `anything-c-source-bbdb'                                     (BBDB)
 578 ;; `anything-c-source-evaluation-result'                        (Evaluation Result)
 579 ;; `anything-c-source-calculation-result'                       (Calculation Result)
 580 ;; `anything-c-source-google-suggest'                           (Google Suggest)
 581 ;; `anything-c-source-yahoo-suggest'                            (Yahoo Suggest)
 582 ;; `anything-c-source-emms-streams'                             (Emms Streams)
 583 ;; `anything-c-source-emms-dired'                               (Music Directory)
 584 ;; `anything-c-source-emms-files'                               (Emms files)
 585 ;; `anything-c-source-jabber-contacts'                          (Jabber Contacts)
 586 ;; `anything-c-source-call-source'                              (Call anything source)
 587 ;; `anything-c-source-anything-commands'                        (Preconfigured Anything)
 588 ;; `anything-c-source-occur'                                    (Occur)
 589 ;; `anything-c-source-browse-code'                              (Browse code)
 590 ;; `anything-c-source-create'                                   (Create)
 591 ;; `anything-c-source-minibuffer-history'                       (Minibuffer History)
 592 ;; `anything-c-source-elscreen'                                 (Elscreen)
 593 ;; `anything-c-source-top'                                      (Top (Press C-c C-u to refresh))
 594 ;; `anything-c-source-absolute-time-timers'                     (Absolute Time Timers)
 595 ;; `anything-c-source-idle-time-timers'                         (Idle Time Timers)
 596 ;; `anything-c-source-xrandr-change-resolution'                 (Change Resolution)
 597 ;; `anything-c-source-xfonts'                                   (X Fonts)
 598 ;; `anything-c-source-time-world'                               (Time World List)
 599 ;; `anything-c-source-apt'                                      (APT)
 600 ;; `anything-c-source-gentoo'                                   (Portage sources)
 601 ;; `anything-c-source-use-flags'                                (Use Flags)
 602 ;; `anything-c-source-emacs-process'                            (Emacs Process)
 603 ;; `anything-c-source-ratpoison-commands'                       (Ratpoison Commands)
 604
 605 ;;  *** END auto-documentation
 606
 607
 608 ;;; Change log:
 609 ;;
 610 ;;  Change log of this file is found at
 611 ;;  http://repo.or.cz/w/anything-config.git/history/master:/anything-config.el
 612 ;;
 613 ;;  Change log of this project is found at
 614 ;;  http://repo.or.cz/w/anything-config.git?a=shortlog
 615
 616 ;;; Contributors:
 617 ;;
 618 ;;     Tamas Patrovics
 619 ;;     Tassilo Horn <tassilo@member.fsf.org>
 620 ;;     Vagn Johansen <gonz808@hotmail.com>
 621 ;;     Mathias Dahl <mathias.dahl@gmail.com>
 622 ;;     Bill Clementson <billclem@gmail.com>
 623 ;;     Stefan Kamphausen (see http://www.skamphausen.de for more informations)
 624 ;;     Drew Adams <drew.adams@oracle.com>
 625 ;;     Jason McBrayer <jmcbray@carcosa.net>
 626 ;;     Andy Stewart <lazycat.manatee@gmail.com>
 627 ;;     Thierry Volpiatto <thierry.volpiatto@gmail.com>
 628 ;;     rubikitch <rubikitch@ruby-lang.org>
 629 ;;     Scott Vokes <vokes.s@gmail.com>
 630 ;;     Kenichirou Oyama <k1lowxb@gmail.com>
 631
 632 ;;; For Maintainers:
 633 ;;
 634 ;; Evaluate (autodoc-update-all) before commit. This function
 635 ;; generates anything-c-source-* / functions / options list.
 636 ;;
 637 ;; Install also developer-tools/autodoc.el
 638 ;; And eval it or run interactively.
 639 ;;
 640 ;; [EVAL IT] (autodoc-update-all)
 641 ;;
 642 ;; Please write details documentation about function, then others will
 643 ;; read code more easier.   -- Andy Stewart
 644 ;;
 645
 646
 647 ;;; TODO
 648 ;;
 649 ;; - Fix documentation, now many functions haven't documentations.
 650 ;;
 651
 652 ;;; Require
 653 (require 'anything)
 654 (require 'thingatpt)
 655 (require 'ffap)
 656 (require 'cl)
 657 (require 'dired-aux)
 658 (require 'tramp)
 659 (require 'grep)
 660 (require 'url)
 661 (require 'xml)
 662
 663 ;;; Code:
 664
 665 ;; version check
 666 (let ((version "1.263"))
 667   (when (and (string= "1." (substring version 0 2))
 668              (string-match "1\.\\([0-9]+\\)" anything-version)
 669              (< (string-to-number (match-string 1 anything-version))
 670                 (string-to-number (substring version 2))))
 671     (error "Please update anything.el!!
 672
 673 http://www.emacswiki.org/cgi-bin/wiki/download/anything.el
 674
 675 or  M-x install-elisp-from-emacswiki anything.el")))
 676
 677 ;; compatibility
 678 (unless (fboundp 'window-system)
 679   (defun window-system (&optional arg)
 680     window-system))
 681
 682 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Customize ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 683 (defgroup anything-config nil
 684   "Predefined configurations for `anything.el'."
 685   :group 'anything)
 686
 687 (defcustom anything-c-use-standard-keys nil
 688   "Whether use standard keybindings. (no effect)
 689
 690 Key definitions in anything-config.el are removed because
 691 anything.el uses Emacs-standard keys by default. e.g. M-p/M-n for
 692 minibuffer history, C-s for isearch, etc.
 693
 694 If you use `iswitchb' with `anything',
 695 evaluate (anything-iswitchb-setup) .  Then some bindings that
 696 conflict with `iswitchb', e.g. C-p/C-n for the minibuffer
 697 history, are removed from `anything-map'. "
 698   :type 'boolean
 699   :group 'anything-config)
 700
 701 (defcustom anything-c-adaptive-history-file "~/.emacs.d/anything-c-adaptive-history"
 702   "Path of file where history information is stored."
 703   :type 'string
 704   :group 'anything-config)
 705
 706 (defcustom anything-c-adaptive-history-length 50
 707   "Maximum number of candidates stored for a source."
 708   :type 'number
 709   :group 'anything-config)
 710
 711 (defcustom anything-c-google-suggest-url
 712   "http://google.com/complete/search?output=toolbar&q="
 713   "URL used for looking up Google suggestions."
 714   :type 'string
 715   :group 'anything-config)
 716
 717 (defcustom anything-c-google-suggest-search-url
 718   "http://www.google.com/search?ie=utf-8&oe=utf-8&q="
 719   "URL used for Google searching."
 720   :type 'string
 721   :group 'anything-config)
 722
 723 (defcustom anything-google-suggest-use-curl-p nil
 724   "*When non--nil use CURL to get info from `anything-c-google-suggest-url'.
 725 Otherwise `url-retrieve-synchronously' is used."
 726   :type 'boolean
 727   :group 'anything-config)
 728
 729 (defcustom anything-c-yahoo-suggest-url
 730   "http://search.yahooapis.com/WebSearchService/V1/relatedSuggestion?appid=Generic&query="
 731   "Url used for looking up Yahoo suggestions."
 732   :type 'string
 733   :group 'anything-config)
 734
 735 (defcustom anything-c-yahoo-suggest-search-url
 736   "http://search.yahoo.com/search?&ei=UTF-8&fr&h=c&p="
 737   "Url used for Yahoo searching."
 738   :type 'string
 739   :group 'anything-config)
 740
 741 (defcustom anything-c-boring-buffer-regexp
 742   (rx (or
 743        (group bos  " ")
 744        ;; anything-buffer
 745        "*anything"
 746        ;; echo area
 747        " *Echo Area" " *Minibuf"))
 748   "The regexp that match boring buffers.
 749 Buffer candidates matching this regular expression will be
 750 filtered from the list of candidates if the
 751 `anything-c-skip-boring-buffers' candidate transformer is used, or
 752 they will be displayed with face `file-name-shadow' if
 753 `anything-c-shadow-boring-buffers' is used."
 754   :type 'string
 755   :group 'anything-config)
 756 ;; (string-match anything-c-boring-buffer-regexp "buf")
 757 ;; (string-match anything-c-boring-buffer-regexp " hidden")
 758 ;; (string-match anything-c-boring-buffer-regexp " *Minibuf-1*")
 759
 760 (defcustom anything-c-boring-file-regexp
 761   (rx (or
 762        ;; Boring directories
 763        (and "/" (or ".svn" "CVS" "_darcs" ".git" ".hg") (or "/" eol))
 764        ;; Boring files
 765        (and line-start  ".#")
 766        (and (or ".class" ".la" ".o" "~") eol)))
 767   "The regexp that match boring files.
 768 File candidates matching this regular expression will be
 769 filtered from the list of candidates if the
 770 `anything-c-skip-boring-files' candidate transformer is used, or
 771 they will be displayed with face `file-name-shadow' if
 772 `anything-c-shadow-boring-files' is used."
 773   :type 'string
 774   :group 'anything-config)
 775
 776 (defcustom anything-kill-ring-threshold 10
 777   "*Minimum length to be listed by `anything-c-source-kill-ring'."
 778   :type 'integer
 779   :group 'anything-config)
 780
 781 (defcustom anything-su-or-sudo "su"
 782   "What command to use for root access."
 783   :type 'string
 784   :group 'anything-config)
 785
 786 (defcustom anything-for-files-prefered-list
 787   '(anything-c-source-ffap-line
 788     anything-c-source-ffap-guesser
 789     anything-c-source-buffers+
 790     anything-c-source-recentf
 791     anything-c-source-bookmarks
 792     anything-c-source-file-cache
 793     anything-c-source-files-in-current-dir+
 794     anything-c-source-locate)
 795   "Your prefered sources to find files."
 796   :type 'list
 797   :group 'anything-config)
 798
 799 (defcustom anything-create--actions-private nil
 800   "User defined actions for `anything-create' / `anything-c-source-create'.
 801 It is a list of (DISPLAY . FUNCTION) pairs like `action'
 802 attribute of `anything-sources'.
 803
 804 It is prepended to predefined pairs."
 805   :type 'list
 806   :group 'anything-config)
 807
 808 (defcustom anything-allow-skipping-current-buffer t
 809   "Show current buffer or not in anything buffer"
 810   :type 'boolean
 811   :group 'anything-config)
 812
 813 (defcustom anything-c-enable-eval-defun-hack t
 814   "*If non-nil, execute `anything' using the source at point when C-M-x is pressed.
 815 This hack is invoked when pressing C-M-x in the form \
 816  (defvar anything-c-source-XXX ...) or (setq anything-c-source-XXX ...)."
 817   :type 'boolean
 818   :group 'anything-config)
 819
 820 (defcustom anything-tramp-verbose 0
 821   "*Just like `tramp-verbose' but specific to anything.
 822 When set to 0 don't show tramp messages in anything.
 823 If you want to have the default tramp messages set it to 3."
 824   :type 'integer
 825   :group 'anything-config)
 826
 827 (defcustom anything-raise-command nil
 828   "*A shell command to jump to a window running specific program.
 829 Need external program wmctrl.
 830 This will be use with `format', so use something like \"wmctrl -xa %s\"."
 831   :type 'string
 832   :group 'anything-config)
 833
 834 (defun anything-set-anything-command-map-prefix-key (var key)
 835   (when (boundp 'anything-command-map-prefix-key)
 836     (global-unset-key (read-kbd-macro anything-command-map-prefix-key)))
 837   (setq anything-command-map-prefix-key key)
 838   (global-set-key (read-kbd-macro anything-command-map-prefix-key)
 839                   'anything-command-map))
 840
 841 (defcustom anything-command-map-prefix-key "<f5> a"
 842   "*The prefix key for all `anything-command-map' commands.
 843
 844 !!WARNING!!
 845 This default value is very likely to be changed,
 846 because it is under discussion."
 847   :type 'string
 848   :set 'anything-set-anything-command-map-prefix-key
 849   :group 'anything-config)
 850
 851 (defcustom anything-c-find-files-show-icons nil
 852   "*Whether show or hide icons in `anything-find-files'."
 853   :type 'boolean
 854   :group 'anything-config)
 855
 856 (defcustom anything-c-find-files-icons-directory
 857   (and (window-system)
 858        (dolist (i image-load-path)
 859          (if (file-directory-p (expand-file-name "tree-widget/default" (eval i)))
 860              (return (expand-file-name "tree-widget/default" (eval i))))))
 861   "*Default path where to find files and directory icons."
 862   :type 'string
 863   :group 'anything-config)
 864
 865 (defcustom anything-c-browse-code-regexp-lisp
 866   "^ *\(def\\(un\\|subst\\|macro\\|face\\|alias\\|advice\\|struct\\|\
 867 type\\|theme\\|var\\|group\\|custom\\|const\\|method\\|class\\)"
 868   "*Regexp used to parse lisp buffer when browsing code."
 869   :type 'string
 870   :group 'anything-config)
 871
 872 (defcustom anything-c-browse-code-regexp-python
 873   "\\<def\\>\\|\\<class\\>"
 874   "*Regexp used to parse python buffer when browsing code."
 875   :type 'string
 876   :group 'anything-config)
 877
 878 (defcustom anything-c-browse-code-regexp-alist
 879   `((lisp-interaction-mode . ,anything-c-browse-code-regexp-lisp)
 880     (emacs-lisp-mode . ,anything-c-browse-code-regexp-lisp)
 881     (lisp-mode . ,anything-c-browse-code-regexp-lisp)
 882     (python-mode . ,anything-c-browse-code-regexp-python))
 883   "*Alist to store regexps for browsing code corresponding \
 884 to a specific `major-mode'."
 885   :type 'list
 886   :group 'anything-config)
 887
 888 (defcustom anything-c-external-programs-associations nil
 889   "*Alist to store externals programs associated with file extension.
 890 This variable overhide setting in .mailcap file.
 891 e.g : '\(\(\"jpg\" . \"gqview\"\) (\"pdf\" . \"xpdf\"\)\) "
 892   :type 'list
 893   :group 'anything-config)
 894
 895 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Prefix argument in action ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 896 ;; TODO: This should be integrated in anything.el instead of having
 897 ;; a defadvice here.
 898
 899 (defvar anything-current-prefix-arg nil
 900   "Record `current-prefix-arg' when exiting minibuffer.
 901 It will be cleared at start of next `anything' call when \
 902 `anything-before-initialize-hook' is called.")
 903
 904 (defadvice anything-exit-minibuffer (before anything-current-prefix-arg activate)
 905   (unless anything-current-prefix-arg
 906     (setq anything-current-prefix-arg current-prefix-arg)))
 907
 908 ;; using this hook instead of `anything-after-action-hook'
 909 ;; allow to record the prefix args and keep their values
 910 ;; when using `anything-comp-read'.
 911 ;; i.e when quitting `anything-comp-read' prefix args are preserved
 912 ;; for the following action.
 913 (add-hook 'anything-before-initialize-hook
 914           (lambda () (setq anything-current-prefix-arg nil)))
 915
 916 ;;;###autoload
 917 (defun anything-configuration ()
 918   "Customize `anything'."
 919   (interactive)
 920   (customize-group "anything-config"))
 921
 922 ;;; Anything-command-map
 923 ;;;###autoload
 924 (defvar anything-command-map)
 925 (define-prefix-command 'anything-command-map)
 926
 927 ;; rubikitch: Please change it freely because it is in discussion. I'll track from git.
 928 (define-key anything-command-map (kbd "<SPC>")     'anything-execute-anything-command)
 929 (define-key anything-command-map (kbd "e")         'anything-c-etags-select)
 930 (define-key anything-command-map (kbd "l")         'anything-locate)
 931 (define-key anything-command-map (kbd "s")         'anything-surfraw)
 932 (define-key anything-command-map (kbd "r")         'anything-regexp)
 933 (define-key anything-command-map (kbd "w")         'anything-w3m-bookmarks)
 934 (define-key anything-command-map (kbd "x")         'anything-firefox-bookmarks)
 935 (define-key anything-command-map (kbd "#")         'anything-emms)
 936 (define-key anything-command-map (kbd "m")         'anything-man-woman)
 937 (define-key anything-command-map (kbd "t")         'anything-top)
 938 (define-key anything-command-map (kbd "i")         'anything-imenu)
 939 (define-key anything-command-map (kbd "<tab>")     'anything-lisp-completion-at-point)
 940 (define-key anything-command-map (kbd "p")         'anything-list-emacs-process)
 941 (define-key anything-command-map (kbd "C-x r b")   'anything-c-pp-bookmarks)
 942 (define-key anything-command-map (kbd "M-y")       'anything-show-kill-ring)
 943 (define-key anything-command-map (kbd "C-c <SPC>") 'anything-all-mark-rings)
 944 (define-key anything-command-map (kbd "C-x C-f")   'anything-find-files)
 945 (define-key anything-command-map (kbd "f")         'anything-for-files)
 946 (define-key anything-command-map (kbd "C-:")       'anything-eval-expression-with-eldoc)
 947 (define-key anything-command-map (kbd "C-,")       'anything-calcul-expression)
 948 (define-key anything-command-map (kbd "M-x")       'anything-M-x)
 949 (define-key anything-command-map (kbd "C-x C-w")   'anything-write-file)
 950 (define-key anything-command-map (kbd "C-x i")     'anything-insert-file)
 951 (define-key anything-command-map (kbd "M-s o")     'anything-occur)
 952 (define-key anything-command-map (kbd "M-g s")     'anything-do-grep)
 953 (define-key anything-command-map (kbd "c")         'anything-colors)
 954 (define-key anything-command-map (kbd "F")         'anything-select-xfont)
 955 (define-key anything-command-map (kbd "C-c f")     'anything-recentf)
 956 (define-key anything-command-map (kbd "C-c g")     'anything-google-suggest)
 957 (define-key anything-command-map (kbd "h i")       'anything-info-at-point)
 958 (define-key anything-command-map (kbd "h r")       'anything-info-emacs)
 959 (define-key anything-command-map (kbd "h g")       'anything-info-gnus)
 960 (define-key anything-command-map (kbd "C-x C-b")   'anything-buffers+)
 961 (define-key anything-command-map (kbd "C-c C-b")   'anything-browse-code)
 962 (define-key anything-command-map (kbd "C-x r i")   'anything-register)
 963 (define-key anything-command-map (kbd "C-c C-x")   'anything-c-run-external-command)
 964
 965 ;; In Emacs 23.1.50, minibuffer-local-must-match-filename-map was renamed to
 966 ;; minibuffer-local-filename-must-match-map.
 967 (defvar minibuffer-local-filename-must-match-map (make-sparse-keymap)) ;; Emacs 23.1.+
 968 (defvar minibuffer-local-must-match-filename-map (make-sparse-keymap)) ;; Older Emacsen
 969 (dolist (map (list minibuffer-local-filename-completion-map
 970                    minibuffer-local-completion-map
 971                    minibuffer-local-must-match-filename-map
 972                    minibuffer-local-filename-must-match-map
 973                    minibuffer-local-map
 974                    minibuffer-local-isearch-map
 975                    minibuffer-local-must-match-map
 976                    minibuffer-local-ns-map))
 977   (define-key map "\C-r" 'anything-minibuffer-history))
 978
 979 ;;; Menu
 980 (easy-menu-define nil global-map
 981   "`anything' menu"
 982   '("Anything"
 983     ["All anything commands" anything-execute-anything-command t]
 984     ["Find any Files/Buffers" anything-for-files t]
 985     "----"
 986     ("Files:"
 987      ["Find files" anything-find-files t]
 988      ["Recent Files" anything-recentf t]
 989      ["Locate" anything-locate t]
 990      ["Bookmarks" anything-c-pp-bookmarks t])
 991     ("Buffers:"
 992      ["Find buffers" anything-buffers+ t])
 993     ("Commands:"
 994      ["Emacs Commands" anything-M-x t]
 995      ["Externals Commands" anything-c-run-external-command t])
 996     ("Info:"
 997      ["Info at point" anything-info-at-point t]
 998      ["Emacs Manual index" anything-info-emacs t]
 999      ["Gnus Manual index" anything-info-gnus t])
1000     ("Org:"
1001      ["Org keywords" anything-org-keywords t]
1002      ["Org headlines" anything-org-headlines t])
1003     ("Tools:"
1004      ["Occur" anything-occur t]
1005      ["Grep" anything-do-grep t]
1006      ["Etags" anything-c-etags-select t]
1007      ["Lisp complete at point" anything-lisp-completion-at-point t]
1008      ["Browse Kill ring" anything-show-kill-ring t]
1009      ["Browse register" anything-register t]
1010      ["Browse code" anything-browse-code t]
1011      ["Mark Ring" anything-all-mark-rings t]
1012      ["Regexp handler" anything-regexp t]
1013      ["Colors & Faces" anything-colors t]
1014      ["Show xfonts" anything-select-xfont t]
1015      ["Imenu" anything-imenu t]
1016      ["Google Suggest" anything-google-suggest t]
1017      ["Eval expression" anything-eval-expression-with-eldoc t]
1018      ["Calcul expression" anything-calcul-expression t]
1019      ["Man pages" anything-man-woman t]
1020      ["Top externals process" anything-top t]
1021      ["Emacs internals process" anything-list-emacs-process t])
1022     "----"
1023     ["Prefered Options" anything-configuration t]))
1024
1025
1026 ;;; Documentation
1027 ;; It is replaced by `anything-help'
1028 (defun anything-c-describe-anything-bindings ()
1029   "[OBSOLETE] Describe `anything' bindings."
1030   (interactive)
1031   (anything-run-after-quit
1032    #'(lambda ()
1033        (with-current-buffer (get-buffer-create "*Anything Help*")
1034          (erase-buffer)
1035          (insert
1036           (substitute-command-keys
1037            "The keys that are defined for `anything' are:
1038        \\{anything-map}")))
1039        (pop-to-buffer "*Anything Help*")
1040        (goto-char (point-min)))))
1041
1042 ;; Use `describe-mode' key in `global-map'
1043 ;; (dolist (k (where-is-internal 'describe-mode global-map))
1044 ;;   (define-key anything-map k 'anything-c-describe-anything-bindings))
1045
1046 ;;; Help message
1047 (defun anything-c-list-preconfigured-anything ()
1048   (loop with doc
1049         with sym
1050         for entry in (cdr (assoc
1051                            (file-truename (locate-library "anything-config"))
1052                            load-history))
1053         if (and (consp entry)
1054                 (eq (car entry) 'defun)
1055                 (string-match "^Preconfigured.+$"
1056                               (setq doc (or (documentation (setq sym (cdr entry)))
1057                                             ""))))
1058         collect (cons sym (match-string 0 doc))))
1059
1060 (defun anything-c-format-preconfigured-anything ()
1061   (mapcar (lambda (x) (format "\\[%s] : %s\n" (car x) (cdr x)))
1062           (anything-c-list-preconfigured-anything)))
1063
1064 (setq anything-help-message
1065       (lambda ()
1066         (concat
1067          "\\<anything-map>"
1068          "`anything' is QuickSilver-like candidate-selection framework.
1069
1070 Narrow the list by typing some pattern,
1071 Multiple patterns are allowed by splitting by space.
1072 Select with natural Emacs operations, choose with RET.
1073
1074 If you have any problems, press C-c C-x C-b!!
1075 Feel free to send bug reports. I'll fix them.
1076 The steps are described in the beginning of anything.el file.
1077
1078 == Basic Operations ==
1079 C-p, Up: Previous Line
1080 C-n, Down : Next Line
1081 M-v, PageUp : Previous Page
1082 C-v, PageDown : Next Page
1083 Enter : Execute first (default) action / Select
1084 M-< : First Line
1085 M-> : Last Line
1086 M-PageUp, C-M-S-v, C-M-y : Previous Page (other-window)
1087 M-PageDown, C-M-v : Next Page (other-window)
1088
1089 Tab, C-i : Show action list
1090 Left : Previous Source
1091 Right, C-o : Next Source
1092 C-k : Delete pattern
1093 C-z : Persistent Action (Execute action with anything session kept)
1094 C-c C-x C-b: Send a bug report
1095
1096 == Shortcuts For 2nd/3rd Action ==
1097 \\[anything-select-2nd-action-or-end-of-line] : Execute 2nd Action (if the minibuffer cursor is at end of line)
1098 \\[anything-select-3rd-action] : Execute 3rd Action
1099
1100 == Visible Marks ==
1101 Visible marks store candidate. Some actions uses marked candidates.
1102
1103 \\[anything-toggle-visible-mark] : Toggle Visible Mark
1104 \\[anything-prev-visible-mark] : Previous Mark
1105 \\[anything-next-visible-mark] : Next Mark
1106
1107 == Miscellaneous Commands ==
1108 \\[anything-toggle-resplit-window] : Toggle vertical/horizontal split anything window
1109 \\[anything-quit-and-find-file] : Drop into `find-file'
1110 \\[anything-delete-current-selection] : Delete Selected Item (visually)
1111 \\[anything-kill-selection-and-quit] : Set Item Into the kill-ring And Quit
1112 \\[anything-yank-selection] : Yank Selected Item Into Pattern
1113 \\[anything-follow-mode] : Toggle Automatical Execution Of Persistent Action
1114 \\[anything-force-update] : Recalculate And Redisplay Candidates
1115
1116 == Global Commands ==
1117 \\<global-map>\\[anything-resume] revives last `anything' session.
1118 It is very useful, so you should bind any key.
1119
1120 Single source is executed by \\[anything-call-source].
1121
1122 == Preconfigured `anything' ==
1123 Preconfigured `anything' is commands that uses `anything' interface.
1124 You can use them without configuration.
1125
1126 "
1127          (apply 'concat (anything-c-format-preconfigured-anything))
1128          "
1129 Enjoy!")))
1130
1131 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Preconfigured Anything ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1132 ;;;###autoload
1133 (defun anything-mini ()
1134   "Preconfigured `anything' lightweight version (buffer -> recentf)."
1135   (interactive)
1136   (anything-other-buffer '(anything-c-source-buffers+ anything-c-source-recentf)
1137                          "*anything mini*"))
1138 ;;;###autoload
1139 (defun anything-for-files ()
1140   "Preconfigured `anything' for opening files.
1141 ffap -> recentf -> buffer -> bookmark -> file-cache -> files-in-current-dir -> locate"
1142   (interactive)
1143   (anything-other-buffer anything-for-files-prefered-list "*anything for files*"))
1144
1145 ;;;###autoload
1146 (defun anything-recentf ()
1147   "Preconfigured `anything' for `recentf'."
1148   (interactive)
1149   (anything-other-buffer 'anything-c-source-recentf "*anything recentf*"))
1150
1151 ;;;###autoload
1152 (defun anything-info-at-point (arg)
1153   "Preconfigured `anything' for searching info at point.
1154 With a prefix-arg insert symbol at point."
1155   (interactive "P")
1156   (let ((anything-c-google-suggest-default-function
1157          'anything-c-google-suggest-emacs-lisp))
1158     (anything :sources'(anything-c-source-info-elisp
1159                         anything-c-source-info-cl
1160                         anything-c-source-info-pages
1161                         anything-c-source-google-suggest)
1162               :input (and arg (thing-at-point 'symbol))
1163               :buffer "*anything info*")))
1164
1165 ;;;###autoload
1166 (defun anything-info-emacs ()
1167   "Preconfigured anything for Emacs manual index."
1168   (interactive)
1169   (anything-other-buffer 'anything-c-source-info-emacs "*info emacs*"))
1170
1171 ;;;###autoload
1172 (defun anything-show-kill-ring ()
1173   "Preconfigured `anything' for `kill-ring'.
1174 It is drop-in replacement of `yank-pop'.
1175 You may bind this command to M-y.
1176 First call open the kill-ring browser, next calls move to next line."
1177   (interactive)
1178   (let ((buf "*anything kill-ring*"))
1179     (if (get-buffer-window buf)
1180         (with-anything-window
1181           (if (eq (point) (save-excursion
1182                             (anything-end-of-buffer) (point)))
1183               (anything-beginning-of-buffer)
1184               (anything-next-line)))
1185         (anything-other-buffer 'anything-c-source-kill-ring buf))))
1186
1187 ;;;###autoload
1188 (defun anything-minibuffer-history ()
1189   "Preconfigured `anything' for `minibuffer-history'."
1190   (interactive)
1191   (let ((enable-recursive-minibuffers t))
1192     (anything-other-buffer 'anything-c-source-minibuffer-history
1193                            "*anything minibuffer-history*")))
1194
1195 ;;;###autoload
1196 (defun anything-gentoo ()
1197   "Preconfigured `anything' for gentoo linux."
1198   (interactive)
1199   (anything-other-buffer '(anything-c-source-gentoo
1200                            anything-c-source-use-flags)
1201                          "*anything gentoo*"))
1202
1203 ;;;###autoload
1204 (defun anything-imenu ()
1205   "Preconfigured `anything' for `imenu'."
1206   (interactive)
1207   (anything 'anything-c-source-imenu nil nil nil nil "*anything imenu*"))
1208
1209 ;;;###autoload
1210 (defun anything-google-suggest ()
1211   "Preconfigured `anything' for google search with google suggest."
1212   (interactive)
1213   (anything-other-buffer 'anything-c-source-google-suggest "*anything google*"))
1214
1215 ;;;###autoload
1216 (defun anything-yahoo-suggest ()
1217   "Preconfigured `anything' for Yahoo searching with Yahoo suggest."
1218   (interactive)
1219   (anything-other-buffer 'anything-c-source-yahoo-suggest "*anything yahoo*"))
1220
1221 ;;; Converted from anything-show-*-only
1222 ;;;###autoload
1223 (defun anything-for-buffers ()
1224   "Preconfigured `anything' for buffer."
1225   (interactive)
1226   (anything-other-buffer 'anything-c-source-buffers "*anything for buffers*"))
1227
1228 ;;;###autoload
1229 (defun anything-buffers+ ()
1230   "Enhanced preconfigured `anything' for buffer."
1231   (interactive)
1232   (anything :sources '(anything-c-source-buffers+
1233                        anything-c-source-buffer-not-found)
1234             :buffer "*anything buffers*" :keymap anything-c-buffer-map))
1235
1236 ;;;###autoload
1237 (defun anything-bbdb ()
1238   "Preconfigured `anything' for BBDB.
1239
1240 Needs BBDB.
1241
1242 http://bbdb.sourceforge.net/"
1243   (interactive)
1244   (anything-other-buffer 'anything-c-source-bbdb "*anything bbdb*"))
1245
1246 ;;;###autoload
1247 (defun anything-locate (arg)
1248   "Preconfigured `anything' for Locate.
1249 Note: you can add locate options after entering pattern.
1250 See 'man locate' for valid options.
1251
1252 You can specify a specific database with prefix argument ARG \(C-u\).
1253 Many databases can be used: navigate and mark them.
1254 See also `anything-locate-with-db'.
1255
1256 To create a user specific db, use
1257 \"updatedb -l 0 -o db_path -U directory\".
1258 Where db_path is a filename matched by
1259 `anything-locate-db-file-regexp'."
1260   (interactive "P")
1261   (let* ((db (and arg
1262                   (anything-c-read-file-name
1263                    "LocateDBFiles: "
1264                    :marked-candidates t
1265                    :preselect anything-locate-db-file-regexp
1266                    :test #'(lambda (x)
1267                              (if anything-locate-db-file-regexp
1268                                  ;; Select only locate db files and directories
1269                                  ;; to allow navigation.
1270                                  (or (string-match
1271                                       anything-locate-db-file-regexp x)
1272                                      (file-directory-p x))
1273                                  x))))))
1274     (anything-locate-with-db db)))
1275
1276 (defun anything-locate-with-db (&optional db)
1277   "Run locate -d DB.
1278 If DB is not given or nil use locate without -d option.
1279 DB can be given as a string or list of db files.
1280 See also `anything-locate'."
1281   (when (and db (stringp db)) (setq db (list db)))
1282   (let ((anything-c-locate-command
1283           (if db
1284               (replace-regexp-in-string
1285                "locate"
1286                (format "locate -d %s"
1287                        (mapconcat 'identity
1288                                   ;; Remove eventually marked directories by error.
1289                                   (loop for i in db unless
1290                                        (file-directory-p i) collect i) ":"))
1291                anything-c-locate-command)
1292               anything-c-locate-command)))
1293     (anything :sources 'anything-c-source-locate
1294               :buffer "*anything locate*"
1295               :keymap anything-generic-files-map)))
1296 ;; (anything-locate-with-db "~/locate.db")
1297
1298 ;;;###autoload
1299 (defun anything-w3m-bookmarks ()
1300   "Preconfigured `anything' for w3m bookmark.
1301
1302 Needs w3m and emacs-w3m.
1303
1304 http://w3m.sourceforge.net/
1305 http://emacs-w3m.namazu.org/"
1306   (interactive)
1307   (anything-other-buffer 'anything-c-source-w3m-bookmarks
1308                          "*anything w3m bookmarks*"))
1309
1310 ;;;###autoload
1311 (defun anything-firefox-bookmarks ()
1312   "Preconfigured `anything' for firefox bookmark.
1313 You will have to enable html bookmarks in firefox:
1314 open about:config in firefox and double click on this line to enable value \
1315 to true:
1316
1317 user_pref(\"browser.bookmarks.autoExportHTML\", false);
1318
1319 You should have now:
1320
1321 user_pref(\"browser.bookmarks.autoExportHTML\", true);
1322
1323 After closing firefox, you will be able to browse you bookmarks.
1324 "
1325   (interactive)
1326   (anything-other-buffer 'anything-c-source-firefox-bookmarks
1327                          "*Anything Firefox*"))
1328
1329 ;;;###autoload
1330 (defun anything-colors ()
1331   "Preconfigured `anything' for color."
1332   (interactive)
1333   (anything-other-buffer
1334    '(anything-c-source-colors anything-c-source-customize-face)
1335    "*anything colors*"))
1336
1337 ;;;###autoload
1338 (defun anything-bookmarks ()
1339   "Preconfigured `anything' for bookmarks."
1340   (interactive)
1341   (anything-other-buffer 'anything-c-source-bookmarks "*anything bookmarks*"))
1342
1343 ;;;###autoload
1344 (defun anything-c-pp-bookmarks ()
1345   "Preconfigured `anything' for bookmarks (pretty-printed)."
1346   (interactive)
1347   (anything-other-buffer '(anything-c-source-bookmarks-local
1348                            anything-c-source-bookmarks-su
1349                            anything-c-source-bookmarks-ssh)
1350                          "*anything pp bookmarks*"))
1351
1352 ;;;###autoload
1353 (defun anything-c-insert-latex-math ()
1354   "Preconfigured anything for latex math symbols completion."
1355   (interactive)
1356   (anything-other-buffer 'anything-c-source-latex-math "*anything latex*"))
1357
1358 ;;;###autoload
1359 (defun anything-register ()
1360   "Preconfigured `anything' for Emacs registers."
1361   (interactive)
1362   (anything-other-buffer 'anything-c-source-register "*anything register*"))
1363
1364 ;;;###autoload
1365 (defun anything-man-woman ()
1366   "Preconfigured `anything' for Man and Woman pages."
1367   (interactive)
1368   (anything-other-buffer 'anything-c-source-man-pages "*Anything man woman*"))
1369
1370 ;;;###autoload
1371 (defun anything-org-keywords ()
1372   "Preconfigured `anything' for org keywords."
1373   (interactive)
1374   (anything-other-buffer 'anything-c-source-org-keywords "*org keywords*"))
1375
1376 ;;;###autoload
1377 (defun anything-emms ()
1378   "Preconfigured `anything' for emms sources."
1379   (interactive)
1380   (anything '(anything-c-source-emms-streams
1381               anything-c-source-emms-files
1382               anything-c-source-emms-dired)
1383             nil nil nil nil
1384             "*Anything Emms*"))
1385
1386 ;;;###autoload
1387 (defun anything-eev-anchors ()
1388   "Preconfigured `anything' for eev anchors."
1389   (interactive)
1390   (anything-other-buffer 'anything-c-source-eev-anchor "*Anything eev anchors*"))
1391
1392 ;;;###autoload
1393 (defun anything-bm-list ()
1394   "Preconfigured `anything' for visible bookmarks.
1395
1396 Needs bm.el
1397
1398 http://cvs.savannah.gnu.org/viewvc/*checkout*/bm/bm/bm.el"
1399   (interactive)
1400   (let ((anything-outline-using t))
1401     (anything-other-buffer 'anything-c-source-bm "*anything bm list*")))
1402
1403 ;;;###autoload
1404 (defun anything-timers ()
1405   "Preconfigured `anything' for timers."
1406   (interactive)
1407   (anything-other-buffer '(anything-c-source-absolute-time-timers
1408                            anything-c-source-idle-time-timers)
1409                          "*anything timers*"))
1410
1411 ;;;###autoload
1412 (defun anything-list-emacs-process ()
1413   "Preconfigured `anything' for emacs process."
1414   (interactive)
1415   (anything-other-buffer 'anything-c-source-emacs-process "*anything process*"))
1416
1417 ;;;###autoload
1418 (defun anything-occur ()
1419   "Preconfigured Anything for Occur source."
1420   (interactive)
1421   (let ((anything-compile-source-functions
1422          ;; rule out anything-match-plugin because the input is one regexp.
1423          (delq 'anything-compile-source--match-plugin
1424                (copy-sequence anything-compile-source-functions))))
1425     (anything-other-buffer 'anything-c-source-occur "*Anything Occur*")))
1426
1427 ;;;###autoload
1428 (defun anything-browse-code ()
1429   "Preconfigured anything to browse code."
1430   (interactive)
1431   (anything-other-buffer 'anything-c-source-browse-code "*Browse code*"))
1432
1433 ;;;###autoload
1434 (defun anything-org-headlines ()
1435   "Preconfigured anything to show org headlines."
1436   (interactive)
1437   (anything-other-buffer 'anything-c-source-org-headline "*org headlines*"))
1438
1439 ;;;###autoload
1440 (defun anything-info-gnus ()
1441   "Preconfigured anything to browse Gnus Manual."
1442   (interactive)
1443   (anything-other-buffer 'anything-c-source-info-gnus "*info Gnus*"))
1444
1445 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Anything Applications ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1446 ;;; kill buffers
1447 ;;;###autoload
1448 (defun anything-kill-buffers ()
1449   "Preconfigured `anything' to kill buffer you selected."
1450   (interactive)
1451   (anything
1452    '(((name . "Kill Buffers")
1453       (candidates . anything-c-buffer-list)
1454       (action
1455        ("Kill Buffer" . (lambda (candidate)
1456                           (kill-buffer candidate)
1457                           (anything-kill-buffers)
1458                           )))))
1459    nil nil))
1460
1461 ;;; Regexp
1462 (defun anything-c-query-replace-regexp (candidate)
1463   (let ((regexp (funcall (anything-attr 'regexp))))
1464     (apply 'query-replace-regexp
1465            (anything-c-query-replace-args regexp))))
1466
1467 (defun anything-c-kill-regexp-as-sexp (candidate)
1468   (anything-c-regexp-kill-new
1469    (prin1-to-string (funcall (anything-attr 'regexp)))))
1470
1471 (defun anything-c-kill-regexp (candidate)
1472   (anything-c-regexp-kill-new (funcall (anything-attr 'regexp))))
1473
1474 (defun anything-c-query-replace-args (regexp)
1475   "create arguments of `query-replace-regexp' action in `anything-regexp'."
1476   (let ((region-only (anything-region-active-p)))
1477     (list
1478      regexp
1479      (query-replace-read-to regexp
1480                             (format "Query replace %s regexp %s"
1481                                     (if anything-current-prefix-arg "word " "")
1482                                     (if region-only "in region " ""))
1483                             t)
1484      anything-current-prefix-arg
1485      (when region-only (region-beginning))
1486      (when region-only (region-end)))))
1487
1488 (defvar anything-c-source-regexp
1489   '((name . "Regexp Builder")
1490     (init . (lambda ()
1491               (anything-candidate-buffer anything-current-buffer)))
1492     (candidates-in-buffer)
1493     (get-line . anything-c-regexp-get-line)
1494     (persistent-action . anything-c-regexp-persistent-action)
1495     (persistent-help . "Show this line")
1496     (multiline)
1497     (delayed)
1498     (requires-pattern . 2)
1499     (mode-line . "Press TAB to select action.")
1500     ;; RUBIKITCH:
1501     ;; I use here `anything-input' because `anything-pattern' is lost when
1502     ;; using actions from action buffer (otherwise no e.g from RET, C-e or C-j).
1503     ;; It seem `anything-select-action' reset `anything-pattern' to empty too early.
1504     ;; Though the regexp attribute stay defined (tested with *-attr-defined).
1505     ;; Can you fix it?
1506     (regexp . (lambda () anything-input))
1507     (action . (("Kill Regexp as sexp" . anything-c-kill-regexp-as-sexp)
1508                ("Query Replace Regexp" . anything-c-query-replace-regexp)
1509                ("Kill Regexp" . anything-c-kill-regexp)))))
1510
1511 (defun anything-c-regexp-get-line (s e)
1512   (propertize
1513    (apply 'concat
1514           ;; Line contents
1515           (format "%5d: %s" (line-number-at-pos (1- s)) (buffer-substring s e))
1516           ;; subexps
1517           (loop for i from 0 to (1- (/ (length (match-data)) 2))
1518              collect (format "\n         %s'%s'"
1519                              (if (zerop i) "Group 0: " (format "Group %d: " i))
1520                              (match-string i))))
1521    ;; match beginning
1522    ;; KLUDGE: point of anything-candidate-buffer is +1 than that of anything-current-buffer.
1523    ;; It is implementation problem of candidates-in-buffer.
1524    'anything-realvalue
1525    (1- s)))
1526
1527 (defun anything-goto-line (lineno)
1528   "Goto LINENO opening only outline headline if needed."
1529   (goto-char (point-min)) (forward-line (1- lineno))
1530   (when (or (eq major-mode 'org-mode) outline-minor-mode)
1531     (org-reveal))
1532   (anything-match-line-color-current-line) (sit-for 0.3)
1533   (anything-match-line-cleanup))
1534
1535 (defun anything-c-regexp-persistent-action (pt)
1536   (goto-char pt)
1537   (anything-persistent-highlight-point))
1538
1539 (defun anything-c-regexp-kill-new (input)
1540   (kill-new input)
1541   (message "Killed: %s" input))
1542
1543 (defun anything-region-active-p ()
1544   (and transient-mark-mode mark-active (/= (mark) (point))))
1545
1546 (defun* anything-current-buffer-narrowed-p (&optional
1547                                             (buffer anything-current-buffer))
1548   "Check if BUFFER is narrowed.
1549 Default is `anything-current-buffer'."
1550   (with-current-buffer buffer
1551     (let ((beg (point-min))
1552           (end (point-max))
1553           (total (buffer-size)))
1554       (or (/= beg 1) (/= end (1+ total))))))
1555
1556 ;;;###autoload
1557 (defun anything-regexp ()
1558   "Preconfigured anything to build regexps and run query-replace-regexp \
1559 against."
1560   (interactive)
1561   (save-restriction
1562     (let ((anything-compile-source-functions
1563            ;; rule out anything-match-plugin because the input is one regexp.
1564            (delq 'anything-compile-source--match-plugin
1565                  (copy-sequence anything-compile-source-functions))))
1566       (when (and (anything-region-active-p)
1567                  ;; Don't narrow to region if buffer is already narrowed.
1568                  (not (anything-current-buffer-narrowed-p)))
1569         (narrow-to-region (region-beginning) (region-end)))
1570       (anything :sources
1571                 anything-c-source-regexp
1572                 :buffer "*anything regexp*"
1573                 :prompt "Regexp: "))))
1574
1575
1576 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Interactive Functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1577
1578 (defun anything-insert-buffer-name ()
1579   "Insert buffer name."
1580   (interactive)
1581   (anything-insert-string
1582    (with-current-buffer anything-current-buffer
1583      (if buffer-file-name (file-name-nondirectory buffer-file-name)
1584        (buffer-name)))))
1585
1586 (defun anything-insert-symbol ()
1587   "Insert current symbol."
1588   (interactive)
1589   (anything-insert-string
1590    (with-current-buffer anything-current-buffer
1591      (save-excursion
1592        (buffer-substring (beginning-of-thing 'symbol)
1593                          (end-of-thing 'symbol))))))
1594
1595 (defun anything-insert-selection ()
1596   "Insert current selection."
1597   (interactive)
1598   (anything-insert-string
1599    (with-current-buffer anything-current-buffer
1600      (anything-get-selection))))
1601
1602 (defun anything-show-buffer-only ()
1603   "[OBSOLETE] Only show sources about buffer.
1604 Use `anything-for-buffers' instead."
1605   (interactive)
1606   (anything-set-source-filter '("Buffers")))
1607
1608 (defun anything-show-bbdb-only ()
1609   "[OBSOLETE] Only show sources about BBDB.
1610 Use `anything-bbdb' instead."
1611   (interactive)
1612   (anything-set-source-filter '("BBDB")))
1613
1614 (defun anything-show-locate-only ()
1615   "[OBSOLETE] Only show sources about Locate.
1616 Use `anything-locate' instead."
1617   (interactive)
1618   (anything-set-source-filter '("Locate")))
1619
1620 (defun anything-show-info-only ()
1621   "[OBSOLETE] Only show sources about Info.
1622 Use `anything-info-at-point' instead."
1623   (interactive)
1624   (anything-set-source-filter '("Info Pages"
1625                                 "Info Elisp"
1626                                 "Info Common-Lisp")))
1627
1628 (defun anything-show-imenu-only ()
1629   "[OBSOLETE] Only show sources about Imenu.
1630 Use `anything-imenu' instead."
1631   (interactive)
1632   (anything-set-source-filter '("Imenu")))
1633
1634 (defun anything-show-files-only ()
1635   "[OBSOLETE] Only show sources about File.
1636 Use `anything-for-files' instead."
1637   (interactive)
1638   (anything-set-source-filter '("File Name History"
1639                                 "Files from Current Directory"
1640                                 "Recentf")))
1641
1642 (defun anything-show-w3m-bookmarks-only ()
1643   "[OBSOLETE] Only show source about w3m bookmark.
1644 Use `anything-w3m-bookmarks' instead."
1645   (interactive)
1646   (anything-set-source-filter '("W3m Bookmarks")))
1647
1648 (defun anything-show-colors-only ()
1649   "[OBSOLETE] Only show source about color.
1650 Use `anything-colors' instead."
1651   (interactive)
1652   (anything-set-source-filter '("Colors"
1653                                 "Customize Faces")))
1654
1655 (defun anything-show-kill-ring-only ()
1656   "[OBSOLETE] Only show source about kill ring.
1657 Use `anything-show-kill-ring' instead."
1658   (interactive)
1659   (anything-set-source-filter '("Kill Ring")))
1660
1661 (defun anything-show-this-source-only ()
1662   "Only show this source."
1663   (interactive)
1664   (setq anything-candidate-number-limit 9999)
1665   (anything-set-source-filter
1666    (list (assoc-default 'name (anything-get-current-source)))))
1667
1668 (defun anything-test-sources ()
1669   "List all anything sources for test.
1670 The output is sexps which are evaluated by \\[eval-last-sexp]."
1671   (interactive)
1672   (with-output-to-temp-buffer "*Anything Test Sources*"
1673     (mapc (lambda (s) (princ (format ";; (anything '%s)\n" s)))
1674           (apropos-internal "^anything-c-source" #'boundp))
1675     (pop-to-buffer standard-output)))
1676
1677 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Utilities Functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1678 ;;; For compatibility
1679 (unless (fboundp 'region-active-p)
1680   (defun region-active-p ()
1681     "Return t if Transient Mark mode is enabled and the mark is active.
1682
1683 Most commands that act on the region if it is active and
1684 Transient Mark mode is enabled, and on the text near point
1685 otherwise, should use `use-region-p' instead.  That function
1686 checks the value of `use-empty-active-region' as well."
1687     (and transient-mark-mode mark-active)))
1688
1689 (defun anything-nest (&rest same-as-anything)
1690   "Nested `anything'. If you use `anything' within `anything', use it."
1691   (with-selected-window (anything-window)
1692     (let (anything-current-position
1693           anything-current-buffer
1694           (orig-anything-buffer anything-buffer)
1695           anything-pattern
1696           anything-buffer
1697           anything-sources
1698           anything-compiled-sources
1699           anything-buffer-chars-modified-tick
1700           (anything-samewindow t)
1701           (enable-recursive-minibuffers t))
1702       (unwind-protect
1703           (apply #'anything same-as-anything)
1704         (anything-initialize-overlays orig-anything-buffer)
1705         (add-hook 'post-command-hook 'anything-check-minibuffer-input)))))
1706
1707 (defun anything-displaying-source-names ()
1708   "Display sources name."
1709   (with-current-buffer anything-buffer
1710     (goto-char (point-min))
1711     (loop with pos
1712           while (setq pos (next-single-property-change (point) 'anything-header))
1713           do (goto-char pos)
1714           collect (buffer-substring-no-properties (point-at-bol)(point-at-eol))
1715           do (forward-line 1))))
1716
1717 (defun anything-select-source ()
1718   "Select source."
1719   (interactive)
1720   (let ((default (assoc-default 'name (anything-get-current-source)))
1721         (source-names (anything-displaying-source-names))
1722         (all-source-names (mapcar (lambda (s) (assoc-default 'name s))
1723                                   (anything-get-sources))))
1724     (setq anything-candidate-number-limit 9999)
1725     (anything-aif
1726         (let (anything-source-filter)
1727           (anything-nest '(((name . "Anything Source")
1728                             (candidates . source-names)
1729                             (action . identity))
1730                            ((name . "Anything Source (ALL)")
1731                             (candidates . all-source-names)
1732                             (action . identity)))
1733                          nil "Source: " nil
1734                          default "*anything select source*"))
1735         (anything-set-source-filter (list it))
1736       (anything-set-source-filter nil))))
1737
1738 (defun anything-insert-string (str)
1739   "Insert STR."
1740   (delete-minibuffer-contents)
1741   (insert str))
1742
1743 (defun anything-c-match-on-file-name (candidate)
1744   "Return non-nil if `anything-pattern' match the filename (without directory part) of CANDIDATE."
1745   (string-match anything-pattern (file-name-nondirectory candidate)))
1746
1747 (defun anything-c-match-on-directory-name (candidate)
1748   "Return non-nil if `anything-pattern' match the directory part of CANDIDATE (a file)."
1749   (anything-aif (file-name-directory candidate)
1750       (string-match anything-pattern it)))
1751
1752 (defun anything-c-string-match (candidate)
1753   "Return non-nil if `anything-pattern' match CANDIDATE.
1754 The match is done with `string-match'."
1755   (string-match anything-pattern candidate))
1756
1757 ;; `anything-c-compose' is no more needed, it is for compatibility.
1758 (defalias 'anything-c-compose 'anything-compose)
1759
1760 (defun anything-c-skip-entries (list regexp)
1761   "Remove entries which matches REGEXP from LIST."
1762   (remove-if (lambda (x) (and (stringp x) (string-match regexp x)))
1763              list))
1764
1765 (defun anything-c-shadow-entries (list regexp)
1766   "Elements of LIST matching REGEXP will be displayed with the `file-name-shadow' face if available."
1767   (mapcar (lambda (file)
1768             ;; Add shadow face property to boring files.
1769             (let ((face (if (facep 'file-name-shadow)
1770                             'file-name-shadow
1771                           ;; fall back to default on XEmacs
1772                           'default)))
1773               (if (string-match regexp file)
1774                   (setq file (propertize file 'face face))))
1775             file)
1776           list))
1777
1778 (defsubst anything-c-stringify (str-or-sym)
1779   "Get string of STR-OR-SYM."
1780   (if (stringp str-or-sym)
1781       str-or-sym
1782     (symbol-name str-or-sym)))
1783
1784 (defsubst anything-c-symbolify (str-or-sym)
1785   "Get symbol of STR-OR-SYM."
1786   (if (symbolp str-or-sym)
1787       str-or-sym
1788     (intern str-or-sym)))
1789
1790 (defun anything-c-describe-function (func)
1791   "FUNC is symbol or string."
1792   (describe-function (anything-c-symbolify func)))
1793
1794 (defun anything-c-describe-variable (var)
1795   "VAR is symbol or string."
1796   (describe-variable (anything-c-symbolify var)))
1797
1798 (defun anything-c-find-function (func)
1799   "FUNC is symbol or string."
1800   (find-function (anything-c-symbolify func)))
1801
1802 (defun anything-c-find-variable (var)
1803   "VAR is symbol or string."
1804   (find-variable (anything-c-symbolify var)))
1805
1806 (defun anything-c-kill-new (string &optional replace yank-handler)
1807   "STRING is symbol or string."
1808   (kill-new (anything-c-stringify string) replace yank-handler))
1809
1810 ;;; Toggle all marks.
1811
1812 ;;;###autoload
1813 (defun anything-mark-all ()
1814   "Mark all visible unmarked candidates in current source."
1815   (interactive)
1816   (with-anything-window
1817     (save-excursion
1818       (goto-char (anything-get-previous-header-pos))
1819       (anything-next-line)
1820       (let* ((next-head (anything-get-next-header-pos))
1821              (end       (and next-head
1822                              (save-excursion
1823                                (goto-char next-head)
1824                                (forward-line -2)
1825                                (point))))
1826              (maxpoint  (or end (point-max))))
1827         (while (< (point) maxpoint)
1828           (anything-mark-current-line)
1829           (let ((prefix (get-text-property (point-at-bol) 'display))
1830                 (bn     (anything-c-basename (anything-get-selection)))
1831                 (src    (assoc-default 'name (anything-get-current-source))))
1832             (when (and (not (anything-this-visible-mark))
1833                        (not (or (string= prefix "[?]")
1834                                 (string= prefix "[@]"))))
1835               ;; Don't mark possibles directories ending with . or ..
1836               ;; and also autosave files/links.
1837               (unless
1838                   (and (or (anything-file-completion-source-p)
1839                            (equal src "Files from Current Directory"))
1840                        (string-match "^\\.#.*\\|^#.*#$\\|\\.$" bn))
1841                 (anything-make-visible-mark))))
1842           (forward-line 1) (end-of-line))))
1843     (anything-mark-current-line)
1844     (message "%s candidates marked" (length anything-marked-candidates))))
1845
1846 ;;;###autoload
1847 (defun anything-unmark-all ()
1848   "Unmark all candidates in all sources of current anything session."
1849   (interactive)
1850   (with-anything-window
1851     (let ((len (length anything-marked-candidates)))
1852       (save-excursion
1853         (anything-clear-visible-mark))
1854       (setq anything-marked-candidates nil)
1855       (anything-mark-current-line)
1856       (message "%s candidates unmarked" len))))
1857
1858 ;;;###autoload
1859 (defun anything-toggle-all-marks ()
1860   "Toggle all marks.
1861 Mark all visible candidates of current source or unmark all candidates
1862 visible or invisible in all sources of current anything session"
1863   (interactive)
1864   (let ((marked (anything-marked-candidates)))
1865     (if (and (>= (length marked) 1)
1866              (with-anything-window anything-visible-mark-overlays))
1867         (anything-unmark-all)
1868         (anything-mark-all))))
1869
1870 (define-key anything-map (kbd "M-m") 'anything-toggle-all-marks)
1871
1872 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Hacks ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1873 (defadvice eval-defun (after anything-source-hack activate)
1874   "See `anything-c-enable-eval-defun-hack'."
1875   (when anything-c-enable-eval-defun-hack
1876     (let ((varsym (save-excursion
1877                     (beginning-of-defun)
1878                     (forward-char 1)
1879                     (when (memq (read (current-buffer)) '(defvar setq))
1880                       (read (current-buffer))))))
1881       (when (string-match "^anything-c-source-" (symbol-name varsym))
1882         (anything varsym)))))
1883 ;; (progn (ad-disable-advice 'eval-defun 'after 'anything-source-hack) (ad-update 'eval-defun))
1884
1885 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Document Generator ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1886 (defconst anything-c-create-summary-index-regexp
1887   "^;;;; <\\(.+?\\)>$\\|^;; (anything '\\(.+?\\))$\\|^ *;; (anything '\\(.+?\\))$")
1888 (defun anything-c-create-summary ()
1889   "Create `anything' summary."
1890   (save-excursion
1891     (goto-char (point-min))
1892     (loop with it
1893           while (re-search-forward anything-c-create-summary-index-regexp nil t)
1894           collect
1895           (cond ((setq it (match-string-no-properties 1))
1896                  (cons 'section it))
1897                 ((setq it (match-string-no-properties 2))
1898                  `(source ,it .
1899                           ,(assoc-default 'name (symbol-value (intern it)))))
1900                 ((setq it (match-string-no-properties 3))
1901                  `(source ,it .
1902                           ,(assoc-default 'name (symbol-value (intern it)))))))))
1903
1904 ;; (find-epp (anything-c-create-summary))
1905
1906 (defun anything-c-insert-summary ()
1907   "Insert `anything' summary."
1908   (save-excursion
1909     (goto-char (point-min))
1910     (search-forward ";; Below are complete source list you can setup in")
1911     (forward-line 1)
1912     (delete-region (point)
1913                    (progn (search-forward ";;; Change log:" nil t)
1914                           (forward-line -1) (point)))
1915     (insert ";;\n")
1916     (loop with beg
1917           for (kind . value) in (anything-c-create-summary)
1918           for i from 0
1919           do (cond ((eq kind 'section)
1920                     (unless (zerop i)
1921                       (align-regexp beg (point) "\\(\\s-*\\)(" 1 1 nil))
1922                     (insert ";;  " value ":\n")
1923                     (setq beg (point)))
1924                    (t
1925                     (insert ";;     `" (car value) "'    (" (cdr value) ")\n")))
1926           finally (align-regexp beg (point) "\\(\\s-*\\)(" 1 1 nil))))
1927 ;; (anything-c-insert-summary)
1928
1929 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Anything Sources ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1930 ;;;; <Buffer>
1931 (defun anything-c-buffer-list ()
1932   "Return the list of names of buffers with boring buffers filtered out.
1933 Boring buffers is specified by `anything-c-boring-buffer-regexp'.
1934 The first buffer in the list will be the last recently used
1935 buffer that is not the current buffer."
1936   (let ((buffers (mapcar 'buffer-name (buffer-list))))
1937     (append (cdr buffers) (list (car buffers)))))
1938
1939 (defvar anything-c-source-buffers
1940   '((name . "Buffers")
1941     (candidates . anything-c-buffer-list)
1942     (type . buffer)))
1943 ;; (anything 'anything-c-source-buffers)
1944
1945 (defvar anything-c-source-buffer-not-found
1946   '((name . "Create buffer")
1947     (dummy)
1948     (filtered-candidate-transformer (lambda (cands source)
1949                                       (list anything-pattern)))
1950     (action . (lambda (candidate)
1951                 (anything-c-switch-to-buffer (get-buffer-create candidate))))))
1952 ;; (anything 'anything-c-source-buffer-not-found)
1953
1954 ;;; Buffers+
1955
1956 (defface anything-buffer-saved-out
1957     '((t (:foreground "red")))
1958   "*Face used for buffer files modified outside of emacs."
1959   :group 'anything-config)
1960
1961 (defface anything-buffer-not-saved
1962     '((t (:foreground "Indianred2")))
1963   "*Face used for buffer files not already saved on disk."
1964   :group 'anything-config)
1965
1966 (eval-when-compile (require 'dired))
1967
1968 (defun anything-c-highlight-buffers (buffers)
1969   (loop for i in buffers
1970      for buf = (get-buffer i)
1971      for bfname = (buffer-file-name buf)
1972      collect
1973      (cond (;; A dired buffer.
1974             (rassoc buf dired-buffers)
1975             (propertize i 'face 'anything-ff-directory
1976                         'help-echo (car (rassoc buf dired-buffers))))
1977            ;; A buffer file modified somewhere outside of emacs.
1978            ((and bfname (not (file-remote-p bfname))
1979                  (file-exists-p bfname)
1980                  (not (verify-visited-file-modtime buf)))
1981             (propertize i 'face 'anything-buffer-saved-out
1982                         'help-echo bfname))
1983            ;; A new buffer file not already saved on disk.
1984            ((and bfname (not (file-remote-p bfname))
1985                  (not (verify-visited-file-modtime buf)))
1986             (propertize i 'face 'anything-buffer-not-saved
1987                         'help-echo bfname))
1988            ;; A Remote buffer file modified and not saved on disk.
1989            ((and bfname (file-remote-p bfname) (buffer-modified-p buf))
1990             (let ((prefix (propertize
1991                            " " 'display
1992                            (propertize "@ " 'face 'anything-ff-prefix))))
1993               (cons (concat prefix (propertize i 'face 'anything-ff-symlink
1994                                              'help-echo bfname)) i)))
1995            ;; A buffer file modified and not saved on disk.
1996            ((and bfname (buffer-modified-p buf))
1997             (propertize i 'face 'anything-ff-symlink
1998                         'help-echo bfname))
1999            ;; A remote buffer file not modified and saved on disk.
2000            ((and bfname (file-remote-p bfname))
2001             (let ((prefix (propertize
2002                            " " 'display
2003                            (propertize "@ " 'face 'anything-ff-prefix))))
2004               (cons (concat prefix (propertize i 'face 'font-lock-type-face
2005                                                'help-echo bfname)) i)))
2006            ;; A buffer file not modified and saved on disk.
2007            (bfname
2008             (propertize i 'face 'font-lock-type-face
2009                         'help-echo bfname))
2010            ;; Any non--file buffer.
2011            (t (propertize i 'face 'italic)))))
2012
2013 (defvar anything-buffer-mode-line-string
2014   '("Buffer(s)"
2015     "\\<anything-c-buffer-map>\
2016 \\[anything-c-buffer-help]:Help, \
2017 \\<anything-map>\
2018 \\[anything-select-action]:Acts,\
2019 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
2020 \\[anything-select-3rd-action]:NthAct,\
2021 \\[anything-send-bug-report-from-anything]:BugReport."
2022     "String displayed in mode-line in `anything-c-source-buffers+'"))
2023
2024 (defvar anything-c-buffers-cache nil)
2025 (defvar anything-c-source-buffers+
2026   '((name . "Buffers")
2027     (init . (lambda ()
2028               (setq anything-c-buffers-cache (anything-c-buffer-list))))
2029     (candidates . anything-c-buffers-cache)
2030     (type . buffer)
2031     (match anything-c-buffer-match-major-mode)
2032     (diff-action . anything-buffer-toggle-diff)
2033     (revert-action . anything-buffer-revert-and-update)
2034     (save-action . anything-buffer-save-and-update)
2035     (candidate-transformer anything-c-skip-current-buffer
2036                            anything-c-skip-boring-buffers
2037                            anything-c-highlight-buffers)
2038     (persistent-action . anything-c-buffers+-persistent-action)
2039     (mode-line . anything-buffer-mode-line-string)
2040     (persistent-help . "Show this buffer / C-u \\[anything-execute-persistent-action]: Kill this buffer")))
2041
2042 (defun anything-c-buffer-match-major-mode (candidate)
2043   "Match maybe buffer by major-mode.
2044 If you give a major-mode or partial major-mode,
2045 it will list all buffers of this major-mode and/or buffers with name
2046 matching this major-mode.
2047 If you add a space after major-mode and then a space,
2048 it will match all buffers of the major-mode
2049 before space matching pattern after space.
2050 If you give a pattern which doesn't match a major-mode, it will search buffer
2051 with name matching pattern."
2052   (let* ((cand (replace-regexp-in-string "^\\s-\\{1\\}" "" candidate))
2053          (buf  (get-buffer cand)))
2054     (when buf
2055       (with-current-buffer buf
2056         (let ((mjm   (symbol-name major-mode))
2057               (split (split-string anything-pattern)))
2058           (cond ((string-match "\\s-$" anything-pattern)
2059                  (string-match (car split) mjm))
2060                 ((string-match "\\s-" anything-pattern)
2061                  (and (string-match (car split) mjm)
2062                       (string-match (cadr split) cand)))
2063                 (t (or (string-match anything-pattern mjm)
2064                        (string-match anything-pattern cand)))))))))
2065
2066 (defun anything-c-buffer-query-replace-1 (&optional regexp-flag)
2067   "Query replace in marked buffers.
2068 If REGEXP-FLAG is given use `query-replace-regexp'."
2069   (let ((fn     (if regexp-flag 'query-replace-regexp 'query-replace))
2070         (prompt (if regexp-flag "Query replace regexp" "Query replace"))
2071         (bufs   (anything-marked-candidates)))
2072     (loop
2073        with replace = (query-replace-read-from prompt regexp-flag)
2074        with tostring = (unless (consp replace)
2075                          (query-replace-read-to
2076                           replace prompt regexp-flag))
2077        for buf in bufs
2078        do
2079        (save-window-excursion
2080          (anything-c-switch-to-buffer buf)
2081          (save-excursion
2082            (let ((case-fold-search t))
2083              (goto-char (point-min))
2084              (if (consp replace)
2085                  (apply fn (list (car replace) (cdr replace)))
2086                  (apply fn (list replace tostring)))))))))
2087
2088 (defun anything-c-buffer-query-replace-regexp (candidate)
2089   (anything-c-buffer-query-replace-1 'regexp))
2090
2091 (defun anything-c-buffer-query-replace (candidate)
2092   (anything-c-buffer-query-replace-1))
2093
2094 (defun anything-c-buffer-help ()
2095   "Help command for anything buffers."
2096   (interactive)
2097   (let ((anything-help-message "== Anything Buffer ==
2098 \nTips:
2099 You can enter a partial name of major-mode (e.g lisp, sh) to narrow down buffers.
2100 Enter then a space and a pattern to narrow down to buffers matching this pattern.
2101 \nSpecific commands for `anything-buffer+':
2102 \\<anything-c-buffer-map>
2103 \\[anything-buffer-run-grep]\t\t->Grep Buffer(s) (C-u grep all buffers linked to a file).
2104 \\[anything-buffer-run-zgrep]\t\t->Zgrep Buffer(s) (C-u grep all buffers linked to a file).
2105 \\[anything-buffer-switch-other-window]\t\t->Switch other window.
2106 \\[anything-buffer-switch-other-frame]\t\t->Switch other frame.
2107 \\[anything-buffer-run-query-replace-regexp]\t\t->Query replace regexp in marked buffers.
2108 \\[anything-buffer-run-query-replace]\t\t->Query replace in marked buffers.
2109 \\[anything-buffer-switch-to-elscreen]\t\t->Find buffer in Elscreen.
2110 \\[anything-buffer-diff-persistent]\t\t->Toggle Diff buffer without quitting.
2111 \\[anything-buffer-revert-persistent]\t\t->Revert buffer without quitting.
2112 \\[anything-buffer-save-persistent]\t\t->Save buffer without quitting.
2113 \\[anything-buffer-run-kill-buffers]\t\t->Delete marked buffers and quit.
2114 \\[anything-c-buffer-help]\t\t->Display this help.
2115 \n== Anything Map ==
2116 \\{anything-map}
2117 "))
2118     (anything-help)))
2119
2120 (defvar anything-c-buffer-map
2121   (let ((map (copy-keymap anything-map)))
2122     (define-key map (kbd "C-c ?")     'anything-c-buffer-help)
2123     (define-key map (kbd "M-g s")     'anything-buffer-run-grep)
2124     (define-key map (kbd "M-g z")     'anything-buffer-run-zgrep)
2125     (define-key map (kbd "C-o")       'anything-buffer-switch-other-window)
2126     (define-key map (kbd "C-c C-o")   'anything-buffer-switch-other-frame)
2127     (define-key map (kbd "C-=")       'anything-buffer-diff-persistent)
2128     (define-key map (kbd "M-U")       'anything-buffer-revert-persistent)
2129     (define-key map (kbd "M-D")       'anything-buffer-run-kill-buffers)
2130     (define-key map (kbd "C-x C-s")   'anything-buffer-save-persistent)
2131     (define-key map (kbd "C-M-%")     'anything-buffer-run-query-replace-regexp)
2132     (define-key map (kbd "M-%")       'anything-buffer-run-query-replace)
2133     (when (locate-library "elscreen")
2134       (define-key map (kbd "<C-tab>") 'anything-buffer-switch-to-elscreen))
2135     (delq nil map))
2136   "Keymap for buffer sources in anything.")
2137
2138 (defun anything-buffer-toggle-diff (candidate)
2139   "Toggle diff buffer CANDIDATE with it's file."
2140   (if (get-buffer-window "*Diff*")
2141       (kill-buffer "*Diff*")
2142       (diff-buffer-with-file (get-buffer candidate))))
2143
2144 ;;;###autoload
2145 (defun anything-buffer-diff-persistent ()
2146   "Toggle diff buffer without quitting anything."
2147   (interactive)
2148   (anything-execute-persistent-action 'diff-action))
2149
2150 (defun anything-buffer-revert-and-update (candidate)
2151   (let ((marked (anything-marked-candidates)))
2152     (loop for buf in marked do (anything-revert-buffer buf))
2153     (anything-force-update)
2154     (anything-c-recenter-window)))
2155
2156 ;;;###autoload
2157 (defun anything-buffer-revert-persistent ()
2158   "Revert buffer without quitting anything."
2159   (interactive)
2160   (anything-execute-persistent-action 'revert-action))
2161
2162 (defun anything-buffer-save-and-update (candidate)
2163   (let ((marked (anything-marked-candidates)))
2164     (loop for buf in marked do
2165          (with-current-buffer (get-buffer buf)
2166            (save-buffer)))
2167     (anything-force-update)
2168     (anything-c-recenter-window)))
2169
2170 ;;;###autoload
2171 (defun anything-buffer-save-persistent ()
2172   "Save buffer without quitting anything."
2173   (interactive)
2174   (anything-execute-persistent-action 'save-action))
2175
2176 ;;;###autoload
2177 (defun anything-buffer-run-kill-buffers ()
2178   "Run kill buffer action from `anything-c-source-buffer+'."
2179   (interactive)
2180   (anything-c-quit-and-execute-action 'anything-kill-marked-buffers))
2181
2182 ;;;###autoload
2183 (defun anything-buffer-run-grep ()
2184   "Run Grep action from `anything-c-source-buffer+'."
2185   (interactive)
2186   (anything-c-quit-and-execute-action 'anything-c-grep-buffers))
2187
2188 ;;;###autoload
2189 (defun anything-buffer-run-zgrep ()
2190   "Run Grep action from `anything-c-source-buffer+'."
2191   (interactive)
2192   (anything-c-quit-and-execute-action 'anything-c-zgrep-buffers))
2193
2194 ;;;###autoload
2195 (defun anything-buffer-run-query-replace-regexp ()
2196   "Run Query replace regexp action from `anything-c-source-buffer+'."
2197   (interactive)
2198   (anything-c-quit-and-execute-action 'anything-c-buffer-query-replace-regexp))
2199
2200 ;;;###autoload
2201 (defun anything-buffer-run-query-replace ()
2202   "Run Query replace action from `anything-c-source-buffer+'."
2203   (interactive)
2204   (anything-c-quit-and-execute-action 'anything-c-buffer-query-replace))
2205
2206 ;;;###autoload
2207 (defun anything-buffer-switch-other-window ()
2208   "Run switch to other window action from `anything-c-source-buffer+'."
2209   (interactive)
2210   (anything-c-quit-and-execute-action 'switch-to-buffer-other-window))
2211
2212 ;;;###autoload
2213 (defun anything-buffer-switch-other-frame ()
2214   "Run switch to other frame action from `anything-c-source-buffer+'."
2215   (interactive)
2216   (anything-c-quit-and-execute-action 'switch-to-buffer-other-frame))
2217
2218 ;;;###autoload
2219 (defun anything-buffer-switch-to-elscreen ()
2220   "Run switch to elscreen  action from `anything-c-source-buffer+'."
2221   (interactive)
2222   (anything-c-quit-and-execute-action 'anything-find-buffer-on-elscreen))
2223
2224 (defun anything-c-buffers-persistent-kill (buffer)
2225   "Persistent action to kill buffer."
2226   (with-current-buffer (get-buffer buffer)
2227     (if (and (buffer-modified-p)
2228              (buffer-file-name (current-buffer)))
2229         (progn
2230           (save-buffer)
2231           (kill-buffer buffer))
2232         (kill-buffer buffer)))
2233   (anything-delete-current-selection))
2234
2235 (defun anything-c-recenter-window ()
2236   "Make visible current selection by recentering anything window."
2237   (with-anything-window (recenter)))
2238
2239 (defun anything-c-buffers+-persistent-action (candidate)
2240     (if current-prefix-arg
2241         (anything-c-buffers-persistent-kill candidate)
2242         (anything-c-switch-to-buffer candidate)))
2243
2244 ;; (anything 'anything-c-source-buffers+)
2245
2246 (defadvice anything-quit-and-find-file (around use-anything-find-files activate)
2247   "Let `anything-quit-and-find-file' take advantage of `anything-find-files'."
2248   (interactive)
2249   (anything-run-after-quit
2250    (lambda (f)
2251      (anything-find-files1 f))
2252    (anything-aif (get-buffer (anything-get-selection))
2253        (or (buffer-file-name it)
2254            (car (rassoc it dired-buffers))
2255            (and (with-current-buffer it
2256                   (eq major-mode 'org-agenda-mode))
2257                 org-directory
2258                 (expand-file-name org-directory))
2259            default-directory)
2260      (let ((sel (anything-get-selection)))
2261        (if (file-exists-p sel)
2262            (expand-file-name sel)
2263            default-directory)))))
2264
2265 ;;;; <File>
2266 ;;; File name history
2267 (defvar anything-c-source-file-name-history
2268   '((name . "File Name History")
2269     (candidates . file-name-history)
2270     (match anything-c-match-on-file-name
2271            anything-c-match-on-directory-name)
2272     (type . file)))
2273 ;; (anything 'anything-c-source-file-name-history)
2274
2275 ;;; Files in current dir
2276 (defvar anything-c-source-files-in-current-dir
2277   '((name . "Files from Current Directory")
2278     (candidates . (lambda ()
2279                     (with-current-buffer anything-current-buffer
2280                       (directory-files (anything-c-current-directory)))))
2281     ;; volatile is not needed, I think.
2282     (type . file)))
2283 ;; (anything 'anything-c-source-files-in-current-dir)
2284
2285 (defun anything-c-highlight-files (files)
2286   (loop for i in files
2287         if (file-directory-p i)
2288         collect (propertize (file-name-nondirectory i)
2289                             'face 'anything-ff-directory
2290                             'help-echo (expand-file-name i))
2291         else
2292         collect (propertize (file-name-nondirectory i)
2293                             'face 'anything-ff-file
2294                             'help-echo (expand-file-name i))))
2295
2296 (defvar anything-c-source-files-in-current-dir+
2297   '((name . "Files from Current Directory")
2298     (candidates . (lambda ()
2299                     (with-current-buffer anything-current-buffer
2300                       (directory-files (anything-c-current-directory) t))))
2301     (candidate-transformer anything-c-highlight-files)
2302     ;; volatile is not needed, I think.
2303     (type . file)))
2304
2305 ;; (anything 'anything-c-source-files-in-current-dir+)
2306
2307 ;;;;;;;;;;;;;;;;;;;;;;;;
2308 ;;; Anything-find-files
2309 ;;;
2310 ;;; Anything replacement of file name completion for `find-file' and friends.
2311
2312 (defface anything-ff-prefix
2313   '((t (:background "yellow" :foreground "black")))
2314   "*Face used to prefix new file or url paths in `anything-find-files'."
2315   :group 'anything-config)
2316
2317 (defface anything-ff-executable
2318   '((t (:foreground "green")))
2319   "*Face used for executable files in `anything-find-files'."
2320   :group 'anything-config)
2321
2322 (defface anything-ff-directory
2323   '((t (:foreground "DarkRed" :background "LightGray")))
2324   "*Face used for directories in `anything-find-files'."
2325   :group 'anything-config)
2326
2327 (defface anything-ff-symlink
2328   '((t (:foreground "DarkOrange")))
2329   "*Face used for symlinks in `anything-find-files'."
2330   :group 'anything-config)
2331
2332
2333 (defface anything-ff-invalid-symlink
2334   '((t (:foreground "black" :background "red")))
2335   "*Face used for invalid symlinks in `anything-find-files'."
2336   :group 'anything-config)
2337
2338 (defface anything-ff-file
2339   '((t (:foreground "CadetBlue" :underline t)))
2340   "*Face used for file names in `anything-find-files'."
2341   :group 'anything-config)
2342
2343 (defvar anything-c-find-files-doc-header (format " (`%s':Go to precedent level)"
2344                                                  (if window-system "C-." "C-l"))
2345   "*The doc that is inserted in the Name header of a find-files or dired source.")
2346
2347 (defvar anything-ff-mode-line-string
2348   "\\<anything-find-files-map>\
2349 \\[anything-ff-help]:Help, \
2350 \\[anything-send-bug-report-from-anything]:BugReport, \
2351 \\<anything-map>\
2352 \\[anything-select-action]:Acts, \
2353 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
2354 \\[anything-select-3rd-action]:NthAct"
2355
2356   "String displayed in mode-line in `anything-c-source-find-files'")
2357
2358 (defcustom anything-ff-auto-update-initial-value t
2359   "Auto update when only one candidate directory is matched.
2360 This is the default value when starting `anything-find-files'."
2361   :group 'anything-config
2362   :type  'boolean)
2363
2364 (defvar anything-ff-auto-update-flag anything-ff-auto-update-initial-value
2365   "Internal, flag to turn on/off auto-update in `anything-find-files'.
2366 Don't set it directly, use instead `anything-ff-auto-update-initial-value'.")
2367
2368 (defvar anything-c-source-find-files
2369   `((name . ,(concat "Find Files" anything-c-find-files-doc-header))
2370     ;; It is needed for filenames with capital letters
2371     (disable-shortcuts)
2372     (init . (lambda ()
2373               (setq ffap-newfile-prompt t)
2374               (setq anything-ff-auto-update-flag anything-ff-auto-update-initial-value)))
2375     (candidates . anything-find-files-get-candidates)
2376     (filtered-candidate-transformer anything-c-find-files-transformer)
2377     (image-action1 . anything-ff-rotate-image-left)
2378     (image-action2 . anything-ff-rotate-image-right)
2379     (properties-action . anything-ff-properties)
2380     (toggle-auto-update . anything-ff-toggle-auto-update)
2381     (kill-buffer-fname . anything-ff-kill-buffer-fname)
2382     (persistent-action . anything-find-files-persistent-action)
2383     (persistent-help . "Hit1 Expand Candidate, Hit2 or (C-u) Find file")
2384     (mode-line . anything-ff-mode-line-string)
2385     (volatile)
2386     (candidate-number-limit . 9999)
2387     (action-transformer . anything-find-files-action-transformer)
2388     (action
2389      . ,(delq
2390          nil
2391          `(("Find File" . anything-c-find-file-or-marked)
2392            ("Find file in Dired" . anything-c-point-file-in-dired)
2393            ,(and (locate-library "elscreen")
2394                  '("Find file in Elscreen"  . anything-elscreen-find-file))
2395            ,(and (locate-library "popwin")
2396                  '("Find file in popup window" . popwin:find-file))
2397            ("Complete at point `M-tab'"
2398             . anything-c-insert-file-name-completion-at-point)
2399            ("Open file externally `C-c C-x, C-u to choose'"
2400             . anything-c-open-file-externally)
2401            ("Grep File(s) `M-g s, C-u Recurse'" . anything-find-files-grep)
2402            ("Zgrep File(s) `M-g z, C-u Recurse'" . anything-ff-zgrep)
2403            ("Switch to Eshell `M-e'" . anything-ff-switch-to-eshell)
2404            ("Eshell command on file(s) `M-!, C-u run on all marked at once.'"
2405             . anything-find-files-eshell-command-on-file)
2406            ("Find file as root" . anything-find-file-as-root)
2407            ("Find file in hex dump" . hexl-find-file)
2408            ("Ediff File `C-='" . anything-find-files-ediff-files)
2409            ("Ediff Merge File `C-c ='" . anything-find-files-ediff-merge-files)
2410            ("Delete File(s) `M-D'" . anything-delete-marked-files)
2411            ("Copy file(s) `M-C, C-u to follow'" . anything-find-files-copy)
2412            ("Copy file(s) Async" . anything-ff-copy-async)
2413            ("Rename file(s) `M-R, C-u to follow'" . anything-find-files-rename)
2414            ("Serial rename files" . anything-ff-serial-rename)
2415            ("Serial rename by symlinking files" . anything-ff-serial-rename-by-symlink)
2416            ("Serial rename by copying files" . anything-ff-serial-rename-by-copying)
2417            ("Symlink files(s) `M-S, C-u to follow'" . anything-find-files-symlink)
2418            ("Relsymlink file(s) `C-u to follow'" . anything-find-files-relsymlink)
2419            ("Hardlink file(s) `C-u to follow'" . anything-find-files-hardlink)
2420            ("Find file other window `C-o'" . find-file-other-window)
2421            ("Switch to history `M-p'" . anything-find-files-switch-to-hist)
2422            ("Find file other frame `C-c C-o'" . find-file-other-frame)
2423            ("Print File `C-c p'" . anything-ff-print))))))
2424 ;; (anything 'anything-c-source-find-files)
2425
2426 (defun anything-find-files-set-prompt-for-action (prompt files)
2427   "Set prompt for action in `anything-find-files'."
2428   (let ((len (length files)))
2429     (if (> len 1)
2430         (format "%s * %d Files to: " prompt len)
2431         (format "%s %s to: " prompt (car files)))))
2432
2433 (defun anything-find-files-do-action (action)
2434   "Generic function for creating action from `anything-c-source-find-files'.
2435 ACTION must be an action supported by `anything-dired-action'."
2436   (let* ((ifiles   (anything-marked-candidates))
2437          (cand     (anything-get-selection))
2438          (buf      anything-current-buffer)
2439          (prompt   (anything-find-files-set-prompt-for-action
2440                     (capitalize (symbol-name action)) ifiles))
2441          (parg     anything-current-prefix-arg)
2442          (dest     (anything-c-read-file-name
2443                     prompt
2444                     :preselect cand
2445                     :initial-input (car anything-ff-history)
2446                     :history (anything-find-files-history :comp-read nil)))
2447          (win-conf (current-window-configuration)))
2448     (unwind-protect
2449          ;; Create temporarily a dired buffer to call dired functions.
2450          (with-current-buffer (dired anything-ff-default-directory)
2451            (let ((dir-buf (current-buffer)))
2452              (anything-dired-action
2453               dest :files ifiles :action action :follow parg)
2454              ;; If we have started in a dired buffer, don't kill it.
2455              (unless (eq dir-buf (get-buffer buf))
2456                (kill-buffer dir-buf))))
2457       (unless parg (set-window-configuration win-conf)))))
2458
2459 (defun anything-find-files-copy (candidate)
2460   "Copy files from `anything-find-files'."
2461   (anything-find-files-do-action 'copy))
2462
2463 (defun anything-find-files-rename (candidate)
2464   "Rename files from `anything-find-files'."
2465   (anything-find-files-do-action 'rename))
2466
2467 (defun anything-find-files-symlink (candidate)
2468   "Symlink files from `anything-find-files'."
2469   (anything-find-files-do-action 'symlink))
2470
2471 (defun anything-find-files-relsymlink (candidate)
2472   "Relsymlink files from `anything-find-files'."
2473   (anything-find-files-do-action 'relsymlink))
2474
2475 (defun anything-find-files-hardlink (candidate)
2476   "Hardlink files from `anything-find-files'."
2477   (anything-find-files-do-action 'hardlink))
2478
2479 (defun anything-find-files-byte-compile (candidate)
2480   "Byte compile elisp files from `anything-find-files'."
2481   (let ((files    (anything-marked-candidates))
2482         (parg     anything-current-prefix-arg))
2483     (loop for fname in files
2484        do (byte-compile-file fname parg))))
2485
2486 (defun anything-find-files-load-files (candidate)
2487   "Load elisp files from `anything-find-files'."
2488   (let ((files    (anything-marked-candidates)))
2489     (loop for fname in files
2490        do (load fname))))
2491
2492 (defun anything-find-files-ediff-files (candidate)
2493   "Default action to ediff files in `anything-find-files'."
2494   (ediff-files
2495    candidate
2496    (anything-c-read-file-name
2497     (format "Ediff `%s' With File: " (file-name-nondirectory candidate)))))
2498
2499 (defun anything-find-files-ediff-merge-files (candidate)
2500   "Default action to ediff merge files in `anything-find-files'."
2501   (ediff-merge-files
2502    candidate
2503    (anything-c-read-file-name
2504     (format "Ediff Merge `%s' With File: "
2505             (file-name-nondirectory candidate)))))
2506
2507 (defun anything-find-files-grep (candidate)
2508   "Default action to grep files from `anything-find-files'."
2509   (anything-do-grep1 (anything-marked-candidates)
2510                      anything-current-prefix-arg))
2511
2512 (defun anything-ff-zgrep (candidate)
2513   "Default action to zgrep files from `anything-find-files'."
2514   (let ((prefarg anything-current-prefix-arg)
2515         (ls      (anything-marked-candidates)))
2516     (anything-ff-zgrep-1 ls prefarg)))
2517
2518 (defun anything-ff-pdfgrep (candidate)
2519   "Default action to pdfgrep files from `anything-find-files'."
2520   (let ((cands (loop for file in (anything-marked-candidates)
2521                   if (or (string= (file-name-extension file) "pdf")
2522                          (string= (file-name-extension file) "PDF"))
2523                   collect file))
2524         (anything-c-pdfgrep-default-function 'anything-c-pdfgrep-init))
2525     (when cands
2526       (anything-do-pdfgrep-1 cands))))
2527
2528 (defun anything-find-files-switch-to-hist (candidate)
2529   "Switch to anything-find-files history."
2530   (anything-find-files t))
2531
2532 ;;; Asynchronous copy of files.
2533 ;;
2534 (defcustom anything-c-copy-async-prefered-emacs "emacs"
2535   "Path to the emacs you want to use for copying async.
2536 Emacs versions < 24 fail to copy directory due to a bug not fixed
2537 in `copy-directory'."
2538   :group 'anything-config
2539   :type 'string)
2540 (defvar anything-c-copy-files-async-log-file "/tmp/dired.log")
2541 (defun anything-c-copy-files-async-1 (flist dest)
2542   "Copy a list of Files FLIST to DEST asynchronously.
2543 It use another emacs process to do the job.
2544 Communication with background emacs is done with temp file
2545 `anything-c-copy-files-async-log-file'."
2546   (start-file-process "emacs-batch" nil anything-c-copy-async-prefered-emacs
2547                       "-Q" "--batch" "--eval"
2548                       (format "(progn
2549   (require 'dired) (require 'cl)
2550   (let ((dired-recursive-copies 'always)
2551         failures success
2552         (ovw-count 0)
2553         (cpf-count 0))
2554     (dolist (f '%S)
2555        (condition-case err
2556              (let ((file-exists (file-exists-p
2557                                  (expand-file-name
2558                                   (file-name-nondirectory (directory-file-name f))
2559                                    (file-name-directory
2560                                      (file-name-as-directory \"%s\"))))))
2561                 (dired-copy-file f \"%s\" t)
2562                 (if file-exists
2563                     (progn (push (cons \"Overwriting\" f) success)
2564                            (incf ovw-count))
2565                     (push (cons \"Copying\" f) success)
2566                     (incf cpf-count)))
2567           (file-error
2568            (push (dired-make-relative
2569                    (expand-file-name
2570                      (file-name-nondirectory (directory-file-name f))
2571                      (file-name-directory \"%s\")))
2572                  failures))))
2573     (with-current-buffer (find-file-noselect \"%s\")
2574        (erase-buffer)
2575        (when failures
2576          (dolist (fail (reverse failures))
2577            (insert (concat \"Failed to copy \" fail \"\n\"))))
2578        (when success
2579          (loop for (a . s) in (reverse success) do
2580            (insert (concat a \" \" s  \" to %s done\n\"))))
2581        (and (/= cpf-count 0) (insert (concat (int-to-string cpf-count) \" File(s) Copied\n\")))
2582        (and (/= ovw-count 0) (insert (concat (int-to-string ovw-count) \" File(s) Overwrited\n\")))
2583        (and failures (insert (concat (int-to-string (length failures)) \" File(s) Failed to copy\n\")))
2584        (save-buffer))))"
2585                               flist dest dest dest anything-c-copy-files-async-log-file dest)))
2586
2587 (defun anything-c-copy-async-with-log (flist dest)
2588   "Copy file list FLIST to DEST showing log.
2589 Log is send to `anything-c-copy-files-async-log-file'.
2590 Copying is done asynchronously with `anything-c-copy-files-async-1'."
2591   (declare (special auto-revert-interval))
2592   (pop-to-buffer (find-file-noselect anything-c-copy-files-async-log-file))
2593   (set (make-local-variable 'auto-revert-interval) 1)
2594   (erase-buffer)
2595   (insert "Wait copying files...\n")
2596   (sit-for 0.5) (save-buffer)
2597   (goto-char (point-max))
2598   (auto-revert-mode 1)
2599   (anything-c-copy-files-async-1 flist dest))
2600
2601 (defun anything-ff-copy-async (candidate)
2602   "Anything find files action to copy files async.
2603 Copying is done asynchronously with `anything-c-copy-files-async-1'."
2604   (let ((flist (anything-marked-candidates))
2605         (dest  (anything-c-read-file-name
2606                 "Copy File(s) async To: "
2607                 :preselect candidate
2608                 :initial-input (car anything-ff-history)
2609                 :history (anything-find-files-history :comp-read nil))))
2610     (anything-c-copy-async-with-log flist dest)))
2611
2612 (defun anything-c-copy-files-async ()
2613   "Preconfigured anything to copy file list FLIST to DEST asynchronously."
2614   (interactive)
2615   (let* ((flist (anything-c-read-file-name
2616                  "Copy File async: "
2617                  :marked-candidates t))
2618          (dest  (anything-c-read-file-name
2619                  "Copy File async To: "
2620                  :preselect (car flist)
2621                  :initial-input (car anything-ff-history)
2622                  :history (anything-find-files-history :comp-read nil))))
2623     (anything-c-copy-async-with-log flist dest)))
2624
2625 (defvar eshell-command-aliases-list nil)
2626 (declare-function eshell-read-aliases-list "em-alias")
2627 (defun anything-find-files-eshell-command-on-file-1 (candidate &optional map)
2628   "Run `eshell-command' on CANDIDATE or marked candidates possibly with an eshell alias.
2629
2630 Basename of CANDIDATE can be a wild-card.
2631 If MAP is given run `eshell-command' on all marked files at once,
2632 Otherwise, run `eshell-command' on each marked files.
2633
2634 If `eshell' or `eshell-command' have not been run once, or if you have no eshell aliases
2635 `eshell-command-aliases-list' will not be loaded first time you use this."
2636   (when (or eshell-command-aliases-list
2637             (y-or-n-p "Eshell is not loaded, run eshell-command without alias anyway? "))
2638     (and eshell-command-aliases-list (eshell-read-aliases-list))
2639     (let* ((cand-list         (anything-marked-candidates))
2640            (default-directory (or anything-ff-default-directory
2641                                   ;; If candidate is an url *-ff-default-directory is nil
2642                                   ;; so keep value of default-directory.
2643                                   default-directory))
2644            (command           (anything-comp-read
2645                                "Command: "
2646                                (loop for (a . c) in eshell-command-aliases-list
2647                                   when (string-match "\\(\\$1\\|\\$\\*\\)$" (car c))
2648                                   collect (propertize a 'help-echo (car c)) into ls
2649                                   finally return (sort ls 'string<))))
2650            (com-value         (car (assoc-default command eshell-command-aliases-list))))
2651       (if (and (or map (and com-value (string-match "\\$\\*$" com-value)))
2652                (> (length cand-list) 1))
2653           ;; Run eshell-command with ALL marked files as arguments.
2654           (let ((mapfiles (mapconcat 'shell-quote-argument cand-list " ")))
2655             (eshell-command (format "%s %s" command mapfiles)))
2656           ;; Run eshell-command on EACH marked files.
2657           (loop
2658              for i in cand-list
2659              for bn = (anything-c-basename i)
2660              for files = (if (and bn (string-match "^\*" bn))
2661                              ;; Assume if fname is a wildcard
2662                              ;; cand-list have a length of 1.
2663                              (mapconcat
2664                               'shell-quote-argument
2665                               (file-expand-wildcards i t) " ")
2666                              (format "'%s'" i))
2667              for com = (if (string-match "'%s'\\|\"%s\"\\|%s" command)
2668                            ;; This allow to enter other args AFTER filename
2669                            ;; i.e <command %s some_more_args>
2670                            (format command files)
2671                            (format "%s %s" command files))
2672              do (eshell-command com))))))
2673
2674 (defun anything-find-files-eshell-command-on-file (candidate)
2675   "Run `eshell-command' on CANDIDATE or marked candidates.
2676 See `anything-find-files-eshell-command-on-file-1' for more info."
2677   (anything-find-files-eshell-command-on-file-1
2678    candidate anything-current-prefix-arg))
2679
2680 (declare-function eshell-send-input "esh-mode" (&optional use-region queue-p no-newline))
2681 (defun anything-ff-switch-to-eshell (candidate)
2682   "Switch to eshell and cd to `anything-ff-default-directory'."
2683   (flet ((cd-eshell ()
2684            (goto-char (point-max))
2685            (insert
2686             (format "cd '%s'" anything-ff-default-directory))
2687            (eshell-send-input)))
2688     (if (get-buffer "*eshell*")
2689         (progn
2690           (anything-c-switch-to-buffer "*eshell*")
2691           (cd-eshell))
2692         (call-interactively 'eshell)
2693         (cd-eshell))))
2694
2695 (defun anything-ff-serial-rename-action (method)
2696   "Rename all marked files to `anything-ff-default-directory' with METHOD.
2697 See `anything-ff-serial-rename-1'."
2698   (let ((cands (anything-marked-candidates))
2699         (name  (read-string "NewName: "))
2700         (start (read-number "StartAtNumber: "))
2701         (dir   (expand-file-name
2702                 (anything-c-read-file-name
2703                  "Serial Rename to directory: " :initial-input
2704                  (expand-file-name anything-ff-default-directory)))))
2705     (when (y-or-n-p (format "Serial Rename %s *files to `%s' with prefix `%s'? "
2706                             (length cands) dir name))
2707       (anything-ff-serial-rename-1 dir cands name start :method method)
2708       (anything-find-files1 dir))))
2709
2710 (defun anything-ff-member-directory-p (file directory)
2711   (let ((dir-file (expand-file-name (file-name-as-directory (file-name-directory file))))
2712         (cur-dir  (expand-file-name (file-name-as-directory directory))))
2713     (string= dir-file cur-dir)))
2714
2715 (defun* anything-ff-serial-rename-1
2716     (directory collection new-name start-at-num &key (method 'rename))
2717   "rename files in COLLECTION to DIRECTORY with the prefix name NEW-NAME.
2718 Rename start at number START-AT-NUM - ex: prefixname-01.jpg.
2719 METHOD can be one of rename, copy or symlink.
2720 Files will be renamed if they are files of current directory, otherwise they
2721 will be treated with METHOD.
2722 Default METHOD is rename."
2723   ;; Maybe remove directories selected by error in collection.
2724   (setq collection (remove-if 'file-directory-p collection))
2725   (flet ((symlink-file (file dest)
2726            (let ((flist (list file)))
2727              (anything-dired-action
2728               dest :action 'symlink :files flist))))
2729
2730     (let* ((tmp-dir  (file-name-as-directory
2731                       (concat (file-name-as-directory directory)
2732                               (symbol-name (gensym "tmp")))))
2733            (fn       (case method
2734                        (copy    'copy-file)
2735                        (symlink 'symlink-file)
2736                        (rename  'rename-file)
2737                        (t (error "Error: Unknow method %s" method)))))
2738       (make-directory tmp-dir)
2739       (loop for i in collection
2740          for count from start-at-num
2741          for fnum = (if (< count 10) "0%s" "%s")
2742          for nname = (concat tmp-dir new-name (format fnum count)
2743                              (file-name-extension i 'dot))
2744          do (if (anything-ff-member-directory-p i directory)
2745                 (rename-file i nname)
2746                 (funcall fn i nname)))
2747       (loop with dirlist = (directory-files
2748                             tmp-dir t directory-files-no-dot-files-regexp)
2749          for f in dirlist do
2750          (if (file-symlink-p f)
2751              (symlink-file (file-truename f)
2752                            (concat (file-name-as-directory directory)
2753                                    (anything-c-basename f)))
2754              (rename-file f directory)))
2755       (delete-directory tmp-dir t))))
2756
2757 (defun anything-ff-serial-rename (candidate)
2758   "Serial rename all marked files to `anything-ff-default-directory'.
2759 Rename only file of current directory, and symlink files coming from
2760 other directories.
2761 See `anything-ff-serial-rename-1'."
2762   (anything-ff-serial-rename-action 'rename))
2763
2764 (defun anything-ff-serial-rename-by-symlink (candidate)
2765   "Serial rename all marked files to `anything-ff-default-directory'.
2766 Rename only file of current directory, and symlink files coming from
2767 other directories.
2768 See `anything-ff-serial-rename-1'."
2769   (anything-ff-serial-rename-action 'symlink))
2770
2771 (defun anything-ff-serial-rename-by-copying (candidate)
2772   "Serial rename all marked files to `anything-ff-default-directory'.
2773 Rename only file of current directory, and copy files coming from
2774 other directories.
2775 See `anything-ff-serial-rename-1'."
2776   (anything-ff-serial-rename-action 'copy))
2777
2778 (defun anything-ff-help ()
2779   "Help command for `anything-find-files'."
2780   (interactive)
2781   (let ((anything-help-message "== Anything Find Files ==
2782 \nTips:
2783 \nEnter \"~/\" at anytime to reach home directory.
2784 Enter \"/\" at anytime to reach root of your file system.
2785 You can complete with partial basename \(e.g \"fb\" will complete \"foobar\"\).
2786 \nSpecific commands for `anything-find-files':
2787 \\<anything-find-files-map>
2788 \\[anything-ff-run-grep]\t\t->Run Grep (C-u Recursive).
2789 \\[anything-ff-run-pdfgrep]\t\t->Run Pdfgrep on marked files.
2790 \\[anything-ff-run-zgrep]\t\t->Run zgrep (C-u Recursive).
2791 \\[anything-ff-run-rename-file]\t\t->Rename File (C-u Follow).
2792 \\[anything-ff-run-copy-file]\t\t->Copy File (C-u Follow).
2793 \\[anything-ff-run-byte-compile-file]\t\t->Byte Compile File (C-u Load).
2794 \\[anything-ff-run-load-file]\t\t->Load File.
2795 \\[anything-ff-run-symlink-file]\t\t->Symlink File.
2796 \\[anything-ff-run-delete-file]\t\t->Delete File.
2797 \\[anything-ff-run-kill-buffer-persistent]\t\t->Kill buffer candidate without quitting.
2798 \\[anything-ff-run-switch-to-eshell]\t\t->Switch to Eshell.
2799 \\[anything-ff-run-eshell-command-on-file]\t\t->Eshell command on file (C-u Run on all marked files at once).
2800 \\[anything-ff-run-ediff-file]\t\t->Ediff file.
2801 \\[anything-ff-run-ediff-merge-file]\t\t->Ediff merge file.
2802 \\[anything-ff-run-complete-fn-at-point]\t\t->Complete file name at point.
2803 \\[anything-ff-run-switch-other-window]\t\t->Switch other window.
2804 \\[anything-ff-run-switch-other-frame]\t\t->Switch other frame.
2805 \\[anything-ff-run-open-file-externally]\t\t->Open file with external program (C-u to choose).
2806 \\[anything-ff-rotate-left-persistent]\t\t->Rotate Image Left.
2807 \\[anything-ff-rotate-right-persistent]\t\t->Rotate Image Right.
2808 \\[anything-find-files-down-one-level]\t\t->Go down precedent directory.
2809 \\[anything-ff-run-switch-to-history]\t\t->Switch to anything find-files history.
2810 \\[anything-ff-properties-persistent]\t\t->Show file properties in a tooltip.
2811 \\[anything-mark-all]\t\t->Mark all visibles candidates.
2812 \\[anything-ff-run-toggle-auto-update]\t->Toggle auto expansion of directories.
2813 \\[anything-unmark-all]\t\t->Unmark all candidates, visibles and invisibles.
2814 \\[anything-ff-run-gnus-attach-files]\t\t->Gnus attach files to message buffer.
2815 \\[anything-ff-run-print-file]\t\t->Print file with default printer.
2816 \\[anything-send-bug-report-from-anything]\t\t->Send Bug report.
2817 \\[anything-ff-help]\t\t->Display this help info.
2818 \n== Anything Map ==
2819 \\{anything-map}
2820 "))
2821     (anything-help)))
2822
2823 (defcustom anything-ff-lynx-style-map t
2824   "Use arrow keys to navigate with `anything-find-files'."
2825   :group 'anything-config
2826   :type 'boolean)
2827
2828 (defvar anything-find-files-map
2829   (let ((map (copy-keymap anything-map)))
2830     (define-key map (kbd "M-g s")         'anything-ff-run-grep)
2831     (define-key map (kbd "M-g p")         'anything-ff-run-pdfgrep)
2832     (define-key map (kbd "M-g z")         'anything-ff-run-zgrep)
2833     (define-key map (kbd "M-R")           'anything-ff-run-rename-file)
2834     (define-key map (kbd "M-C")           'anything-ff-run-copy-file)
2835     (define-key map (kbd "M-B")           'anything-ff-run-byte-compile-file)
2836     (define-key map (kbd "M-L")           'anything-ff-run-load-file)
2837     (define-key map (kbd "M-S")           'anything-ff-run-symlink-file)
2838     (define-key map (kbd "M-D")           'anything-ff-run-delete-file)
2839     (define-key map (kbd "M-K")           'anything-ff-run-kill-buffer-persistent)
2840     (define-key map (kbd "M-e")           'anything-ff-run-switch-to-eshell)
2841     (define-key map (kbd "<M-tab>")       'anything-ff-run-complete-fn-at-point)
2842     (define-key map (kbd "C-o")           'anything-ff-run-switch-other-window)
2843     (define-key map (kbd "C-c C-o")       'anything-ff-run-switch-other-frame)
2844     (define-key map (kbd "C-c C-x")       'anything-ff-run-open-file-externally)
2845     (define-key map (kbd "M-!")           'anything-ff-run-eshell-command-on-file)
2846     (define-key map (kbd "C-=")           'anything-ff-run-ediff-file)
2847     (define-key map (kbd "C-c =")         'anything-ff-run-ediff-merge-file)
2848     (define-key map (kbd "M-p")           'anything-ff-run-switch-to-history)
2849     (define-key map (kbd "M-i")           'anything-ff-properties-persistent)
2850     (define-key map (kbd "C-c ?")         'anything-ff-help)
2851     (define-key map (kbd "C-<backspace>") 'anything-ff-run-toggle-auto-update)
2852     (define-key map (kbd "M-a")           'anything-mark-all)
2853     (define-key map (kbd "M-u")           'anything-unmark-all)
2854     (define-key map (kbd "C-c C-a")       'anything-ff-run-gnus-attach-files)
2855     (define-key map (kbd "C-c p")         'anything-ff-run-print-file)
2856     ;; Next 2 have no effect if candidate is not an image file.
2857     (define-key map (kbd "M-l")           'anything-ff-rotate-left-persistent)
2858     (define-key map (kbd "M-r")           'anything-ff-rotate-right-persistent)
2859     (define-key map (kbd "C-.")           'anything-find-files-down-one-level)
2860     (define-key map (kbd "C-l")           'anything-find-files-down-one-level)
2861     (define-key map (kbd "C-h C-b")       'anything-send-bug-report-from-anything)
2862     (when anything-ff-lynx-style-map
2863       (define-key map (kbd "<left>")      'anything-find-files-down-one-level)
2864       (define-key map (kbd "<right>")     'anything-execute-persistent-action))
2865     (delq nil map))
2866   "Keymap for `anything-find-files'.")
2867
2868 (defun anything-c-quit-and-execute-action (action)
2869   "Quit current anything session and execute ACTION."
2870   (setq anything-saved-action action)
2871   (anything-exit-minibuffer))
2872
2873 (defun anything-ff-toggle-auto-update (candidate)
2874   (setq anything-ff-auto-update-flag (not anything-ff-auto-update-flag))
2875   (message "[Auto expansion %s]"
2876            (if anything-ff-auto-update-flag "enabled" "disabled")))
2877
2878 ;;;###autoload
2879 (defun anything-ff-run-toggle-auto-update ()
2880   (interactive)
2881   (anything-execute-persistent-action 'toggle-auto-update))
2882
2883 ;;;###autoload
2884 (defun anything-ff-run-switch-to-history ()
2885   "Run Switch to history action from `anything-c-source-find-files'."
2886   (interactive)
2887   (anything-c-quit-and-execute-action 'anything-find-files-switch-to-hist))
2888
2889 ;;;###autoload
2890 (defun anything-ff-run-grep ()
2891   "Run Grep action from `anything-c-source-find-files'."
2892   (interactive)
2893   (anything-c-quit-and-execute-action 'anything-find-files-grep))
2894
2895 ;;;###autoload
2896 (defun anything-ff-run-pdfgrep ()
2897   "Run Pdfgrep action from `anything-c-source-find-files'."
2898   (interactive)
2899   (anything-c-quit-and-execute-action 'anything-ff-pdfgrep))
2900
2901 ;;;###autoload
2902 (defun anything-ff-run-zgrep ()
2903   "Run Grep action from `anything-c-source-find-files'."
2904   (interactive)
2905   (anything-c-quit-and-execute-action 'anything-ff-zgrep))
2906
2907 ;;;###autoload
2908 (defun anything-ff-run-copy-file ()
2909   "Run Copy file action from `anything-c-source-find-files'."
2910   (interactive)
2911   (anything-c-quit-and-execute-action 'anything-find-files-copy))
2912
2913 ;;;###autoload
2914 (defun anything-ff-run-rename-file ()
2915   "Run Rename file action from `anything-c-source-find-files'."
2916   (interactive)
2917   (anything-c-quit-and-execute-action 'anything-find-files-rename))
2918
2919 ;;;###autoload
2920 (defun anything-ff-run-byte-compile-file ()
2921   "Run Byte compile file action from `anything-c-source-find-files'."
2922   (interactive)
2923   (anything-c-quit-and-execute-action 'anything-find-files-byte-compile))
2924
2925 ;;;###autoload
2926 (defun anything-ff-run-load-file ()
2927   "Run Load file action from `anything-c-source-find-files'."
2928   (interactive)
2929   (anything-c-quit-and-execute-action 'anything-find-files-load-files))
2930
2931 ;;;###autoload
2932 (defun anything-ff-run-eshell-command-on-file ()
2933   "Run eshell command on file action from `anything-c-source-find-files'."
2934   (interactive)
2935   (anything-c-quit-and-execute-action 'anything-find-files-eshell-command-on-file))
2936
2937 ;;;###autoload
2938 (defun anything-ff-run-ediff-file ()
2939   "Run Ediff file action from `anything-c-source-find-files'."
2940   (interactive)
2941   (anything-c-quit-and-execute-action 'anything-find-files-ediff-files))
2942
2943 ;;;###autoload
2944 (defun anything-ff-run-ediff-merge-file ()
2945   "Run Ediff merge file action from `anything-c-source-find-files'."
2946   (interactive)
2947   (anything-c-quit-and-execute-action 'anything-find-files-ediff-merge-files))
2948
2949 ;;;###autoload
2950 (defun anything-ff-run-symlink-file ()
2951   "Run Symlink file action from `anything-c-source-find-files'."
2952   (interactive)
2953   (anything-c-quit-and-execute-action 'anything-find-files-symlink))
2954
2955 ;;;###autoload
2956 (defun anything-ff-run-delete-file ()
2957   "Run Delete file action from `anything-c-source-find-files'."
2958   (interactive)
2959   (anything-c-quit-and-execute-action 'anything-delete-marked-files))
2960
2961 ;;;###autoload
2962 (defun anything-ff-run-complete-fn-at-point ()
2963   "Run complete file name action from `anything-c-source-find-files'."
2964   (interactive)
2965   (anything-c-quit-and-execute-action
2966    'anything-c-insert-file-name-completion-at-point))
2967
2968 ;;;###autoload
2969 (defun anything-ff-run-switch-to-eshell ()
2970   "Run switch to eshell action from `anything-c-source-find-files'."
2971   (interactive)
2972   (anything-c-quit-and-execute-action 'anything-ff-switch-to-eshell))
2973
2974 ;;;###autoload
2975 (defun anything-ff-run-switch-other-window ()
2976   "Run switch to other window action from `anything-c-source-find-files'."
2977   (interactive)
2978   (anything-c-quit-and-execute-action 'find-file-other-window))
2979
2980 ;;;###autoload
2981 (defun anything-ff-run-switch-other-frame ()
2982   "Run switch to other frame action from `anything-c-source-find-files'."
2983   (interactive)
2984   (anything-c-quit-and-execute-action 'find-file-other-frame))
2985
2986 ;;;###autoload
2987 (defun anything-ff-run-open-file-externally ()
2988   "Run open file externally command action from `anything-c-source-find-files'."
2989   (interactive)
2990   (anything-c-quit-and-execute-action 'anything-c-open-file-externally))
2991
2992 ;;;###autoload
2993 (defun anything-ff-run-gnus-attach-files ()
2994   "Run gnus attach files command action from `anything-c-source-find-files'."
2995   (interactive)
2996   (anything-c-quit-and-execute-action 'anything-ff-gnus-attach-files))
2997
2998 (defun anything-ff-print (candidate)
2999   "Print marked files.
3000 Uses the shell command coming from variables `lpr-command' and
3001 `lpr-switches' as default.
3002 Same as `dired-do-print' but for anything."
3003   (let* ((file-list (anything-marked-candidates))
3004          (command (read-string
3005                    "Print %s with: "
3006                    (mapconcat 'identity
3007                               (cons lpr-command
3008                                     (if (stringp lpr-switches)
3009                                         (list lpr-switches)
3010                                         lpr-switches))
3011                               " ")))
3012          (file-args (mapconcat #'(lambda (x)
3013                                    (format "'%s'" x))
3014                                file-list " "))
3015          (cmd-line (concat command " " file-args)))
3016     (start-process-shell-command "anything-print" nil cmd-line)))
3017
3018 ;;;###autoload
3019 (defun anything-ff-run-print-file ()
3020   "Run Print file action from `anything-c-source-find-files'."
3021   (interactive)
3022   (anything-c-quit-and-execute-action 'anything-ff-print))
3023
3024 (defun* anything-reduce-file-name (fname level &key unix-close expand)
3025     "Reduce FNAME by LEVEL from end or beginning depending LEVEL value.
3026 If LEVEL is positive reduce from end else from beginning.
3027 If UNIX-CLOSE is non--nil close filename with /.
3028 If EXPAND is non--nil expand-file-name."
3029   (let* ((exp-fname  (expand-file-name fname))
3030          (fname-list (split-string (if (or (string= fname "~/") expand)
3031                                        exp-fname fname) "/" t))
3032          (len        (length fname-list))
3033          (pop-list   (if (< level 0)
3034                          (subseq fname-list (* level -1))
3035                          (subseq fname-list 0 (- len level))))
3036          (result     (mapconcat 'identity pop-list "/"))
3037          (empty      (string= result "")))
3038     (when unix-close (setq result (concat result "/")))
3039     (if (string-match "^~" result)
3040         (if (string= result "~/") "~/" result)
3041         (if (< level 0)
3042             (if empty "../" (concat "../" result))
3043             (cond ((eq system-type 'windows-nt)
3044                    (if empty "c:/" result))
3045                   (empty "/")
3046                   (t
3047                    (concat "/" result)))))))
3048
3049 (defun anything-file-completion-source-p ()
3050   "Test if current source is a dired or find-files source."
3051   (let ((ff-sources '("Find Files" "Copy Files"
3052                       "Read File Name History"
3053                       "Rename Files" "Symlink Files"
3054                       "Hardlink Files" "Write File"
3055                       "Insert File" "Read file name"))
3056         (cur-source (cdr (assoc 'name (anything-get-current-source)))))
3057     (loop for i in ff-sources
3058        thereis (string= cur-source (concat i anything-c-find-files-doc-header)))))
3059
3060 ;; Internal.
3061 (defvar anything-ff-last-expanded nil
3062   "Store last expanded directory or file in `anything-find-files'.")
3063
3064 (defun anything-find-files-down-one-level (arg)
3065   "Go down one level like unix command `cd ..'.
3066 If prefix numeric arg is given go ARG level down."
3067   (interactive "p")
3068   (with-anything-window
3069     (setq anything-follow-mode nil))
3070   ;; When going to precedent level we want to be at the line
3071   ;; corresponding to actual directory, so store this info
3072   ;; in `anything-ff-last-expanded'.
3073   (if (and (not (file-directory-p anything-pattern))
3074            (file-exists-p anything-pattern))
3075       (setq anything-ff-last-expanded anything-pattern)
3076       (setq anything-ff-last-expanded anything-ff-default-directory))
3077   (when (anything-file-completion-source-p)
3078     (let ((new-pattern (anything-reduce-file-name anything-pattern arg
3079                                                   :unix-close t :expand t)))
3080       (with-selected-window (minibuffer-window)
3081         (delete-minibuffer-contents)
3082         (insert new-pattern)))))
3083
3084 (defun anything-ff-retrieve-last-expanded ()
3085   "Move overlay to last visited directory `anything-ff-last-expanded'.
3086 This happen after using `anything-find-files-down-one-level',
3087 or hitting C-z on \"..\"."
3088   (when (and anything-ff-last-expanded
3089              (anything-file-completion-source-p))
3090     (let ((dirname (directory-file-name anything-ff-last-expanded)))
3091       (with-anything-window
3092         (when (or (re-search-forward (concat dirname "$") nil t)
3093                   (re-search-forward
3094                    (concat anything-ff-last-expanded "$") nil t))
3095           (forward-line 0)
3096           (anything-mark-current-line)))
3097       (setq anything-ff-last-expanded nil))))
3098 (add-hook 'anything-after-update-hook 'anything-ff-retrieve-last-expanded)
3099
3100 ;; Auto-update: anything-find-files auto expansion of directories.
3101 ;; Internal
3102 (defun anything-ff-update-when-only-one-matched ()
3103   (with-anything-window
3104     (when (and (anything-file-completion-source-p)
3105                anything-ff-auto-update-flag
3106                (<= (anything-approximate-candidate-number) 2)
3107                (>= (length (anything-c-basename anything-pattern)) 2))
3108       (forward-line 1) (anything-mark-current-line)
3109       (let ((cur-cand (anything-get-selection)))
3110         (when (and (file-directory-p cur-cand)
3111                    (not (string-match "^.*[.]\\{1,2\\}$" cur-cand)))
3112           (anything-set-pattern (file-name-as-directory cur-cand))
3113           (anything-check-minibuffer-input-1))))))
3114 (add-hook 'anything-after-update-hook 'anything-ff-update-when-only-one-matched)
3115
3116 ;; Allow expanding to home directory or root
3117 ;; when entering respectively "~/" or "//" at end of pattern.
3118 ;; e.g /home/thierry/labo/anything-config-qp/~/
3119 ;; will expand to "~/"
3120 ;; and /home/thierry/labo/anything-config-qp//
3121 ;; will expand to "/"
3122 (defun anything-ff-auto-expand-to-home-or-root ()
3123   (when (and (anything-file-completion-source-p)
3124              (string-match ".*\\(/~/\\|/\\{2\\}\\)$" anything-pattern))
3125     (let ((match (match-string 1 anything-pattern)))
3126       (cond ((string= match "//")
3127              (if (eq system-type 'windows-nt)
3128                  (setq anything-pattern "c:/")
3129                  (setq anything-pattern "/")))
3130             ((string= match "/~/")
3131              (if (eq system-type 'windows-nt)
3132                  (setq anything-pattern (replace-regexp-in-string
3133                                          "\\\\" "/" (getenv "HOME")))
3134                  (setq anything-pattern "~/")))))
3135     (setq anything-ff-default-directory anything-pattern)
3136     (with-current-buffer (window-buffer (minibuffer-window))
3137       (delete-minibuffer-contents)
3138       (insert anything-pattern))))
3139 (add-hook 'anything-after-update-hook 'anything-ff-auto-expand-to-home-or-root)
3140
3141 (defun anything-c-point-file-in-dired (file)
3142   "Put point on filename FILE in dired buffer."
3143   (dired (file-name-directory file))
3144   (dired-goto-file file))
3145
3146 (defun anything-create-tramp-name (fname)
3147   "Build filename for `anything-pattern' like /su:: or /sudo::."
3148   (apply #'tramp-make-tramp-file-name
3149          (loop with v = (tramp-dissect-file-name fname)
3150             for i across v collect i)))
3151
3152 (defun anything-ff-set-pattern (pattern)
3153   "Handle tramp filenames in `anything-pattern'."
3154   (let ((methods (mapcar 'car tramp-methods))
3155         (reg "\\`/\\([^[/:]+\\|[^/]+]\\):.*:")
3156         cur-method tramp-name)
3157     (cond ((string= pattern "") "")
3158           ((string-match ".*\\(~//\\|//\\)$" pattern)
3159            (if (eq system-type 'windows-nt) "c:/" "/"))
3160           ((string-match "^~\\|.*/~/$" pattern)
3161            (let* ((home    (getenv "HOME"))
3162                   (replace (if (eq system-type 'windows-nt)
3163                                (replace-regexp-in-string
3164                                 "\\\\" "/" home)
3165                                home)))
3166              (replace-match replace nil t pattern)))
3167           ;; Match "/method:maybe_hostname:"
3168           ((and (string-match reg pattern)
3169                 (setq cur-method (match-string 1 pattern))
3170                 (member cur-method methods))
3171            (setq tramp-name (anything-create-tramp-name
3172                              (match-string 0 pattern)))
3173            (replace-match tramp-name nil t pattern))
3174           ;; Match "/hostname:"
3175           ((and (string-match  tramp-file-name-regexp pattern)
3176                 (setq cur-method (match-string 1 pattern))
3177                 (and cur-method (not (member cur-method methods))))
3178            (setq tramp-name (anything-create-tramp-name
3179                              (match-string 0 pattern)))
3180            (replace-match tramp-name nil t pattern))
3181           ;; Match "/method:" in this case don't try to connect.
3182           ((and (not (string-match reg pattern))
3183                 (string-match  tramp-file-name-regexp pattern)
3184                 (member (match-string 1 pattern) methods))
3185            "Invalid tramp file name")   ; Write in anything-buffer.
3186           ;; PATTERN is a directory, end it with "/".
3187           ;; This will make PATTERN not ending yet with "/"
3188           ;; candidate for `anything-ff-default-directory',
3189           ;; allowing `anything-ff-retrieve-last-expanded' to retrieve it
3190           ;; when descending level.
3191           ((file-directory-p pattern)
3192            (file-name-as-directory pattern))
3193           ;; Return PATTERN unchanged.
3194           (t pattern))))
3195
3196 ;; Internal.
3197 (defvar anything-ff-default-directory nil)
3198 (defvar anything-ff-history nil)
3199
3200 (defcustom anything-ff-history-max-length 100
3201   "*Number of elements shown in `anything-find-files' history."
3202   :group 'anything-config
3203   :type 'integer)
3204
3205 (defcustom anything-ff-smart-completion t
3206   "Try to complete filenames smarter when non--nil.
3207 See `anything-ff-transform-fname-for-completion' for more info."
3208   :group 'anything-config
3209   :type 'boolean)
3210
3211 (defun anything-find-files-get-candidates ()
3212   "Create candidate list for `anything-c-source-find-files'."
3213   (let* ((path          (anything-ff-set-pattern anything-pattern))
3214          (path-name-dir (file-name-directory path))
3215          (tramp-verbose anything-tramp-verbose)) ; No tramp message when 0.
3216     (set-text-properties 0 (length path) nil path)
3217     (setq anything-pattern (anything-ff-transform-fname-for-completion path))
3218     (setq anything-ff-default-directory
3219           (if (string= anything-pattern "")
3220               (if (eq system-type 'windows-nt) "c:/" "/")
3221               (unless (string-match ffap-url-regexp path)
3222                 path-name-dir)))
3223     (cond ((or (string= path "Invalid tramp file name")
3224                (file-regular-p path)
3225                (and (not (file-exists-p path)) (string-match "/$" path))
3226                (and ffap-url-regexp (string-match ffap-url-regexp path)))
3227            (list path))
3228           ((string= path "") (directory-files "/" t))
3229           ((and (file-directory-p path) (not (file-readable-p path)))
3230            (list (format "Opening directory: access denied, `%s'" path)))
3231           ((file-directory-p path) (directory-files path t))
3232           (t
3233            (append
3234             (list path)
3235             (directory-files (file-name-directory path) t))))))
3236
3237 (defun anything-ff-transform-fname-for-completion (fname)
3238   "Return FNAME with it's basename modified as a regexp.
3239 e.g foo => f.*o.*o .
3240 If basename contain one or more space or FNAME is a valid directory name
3241 return FNAME unchanged."
3242   (let ((bn (anything-c-basename fname)))
3243     (if (or (not anything-ff-smart-completion)
3244             (string-match "\\s-" bn)
3245             (string-match "/$" fname) ; Allow mkdir.
3246             (file-directory-p fname))
3247         fname ; Fall back to match-plugin.
3248         (setq bn (if (> (length bn) 2) ; Normal completion on first 2 char.
3249                      (mapconcat 'identity (split-string bn "" t) ".*") bn))
3250         (concat (file-name-directory fname) bn))))
3251
3252 (defun anything-ff-save-history ()
3253   "Store the last value of `anything-ff-default-directory' \
3254 in `anything-ff-history'."
3255   (when (and anything-ff-default-directory
3256              (anything-file-completion-source-p))
3257     (push anything-ff-default-directory anything-ff-history)))
3258 (add-hook 'anything-cleanup-hook 'anything-ff-save-history)
3259
3260 (defun anything-ff-valid-symlink-p (file)
3261   (file-exists-p (file-truename file)))
3262
3263 (defun anything-ff-properties (candidate)
3264   "Show file properties of CANDIDATE in a tooltip or message."
3265   (let ((type       (anything-ff-attributes candidate :type t))
3266         (dired-line (anything-ff-attributes candidate :dired t :human-size t)))
3267     (if (window-system)
3268         (tooltip-show
3269          (concat
3270           (anything-c-basename candidate) ": \n"
3271           "Type: " type "\n"
3272           (when (string= type "symlink")
3273             (format "True name: '%s'\n"
3274                     (cond ((string-match "^\.#" (anything-c-basename candidate))
3275                            "Autosave symlink")
3276                           ((anything-ff-valid-symlink-p candidate)
3277                            (file-truename candidate))
3278                           (t "Invalid Symlink"))))
3279           dired-line))
3280         (message dired-line) (sit-for 5))))
3281
3282 ;;;###autoload
3283 (defun anything-ff-properties-persistent ()
3284   "Show properties without quitting anything."
3285   (interactive)
3286   (anything-execute-persistent-action 'properties-action))
3287
3288 (defun anything-ff-kill-buffer-fname (candidate)
3289   (let* ((buf (get-file-buffer candidate))
3290          (buf-name (buffer-name buf)))
3291     (if buf
3292         (progn
3293           (kill-buffer buf) (message "Buffer `%s' killed" buf))
3294         (message "No buffer to kill"))))
3295
3296 (defun anything-ff-kill-or-find-buffer-fname (candidate)
3297   "Find file CANDIDATE or kill it's buffer if it is visible.
3298 Never kill `anything-current-buffer'.
3299 Never kill buffer modified.
3300 This is called normally on third hit of \
3301 \\<anything-map>\\[anything-execute-persistent-action]
3302 in `anything-find-files-persistent-action'."
3303   (let* ((buf      (get-file-buffer candidate))
3304          (buf-name (buffer-name buf)))
3305     (if (and buf (get-buffer-window buf)
3306              (not (eq buf (get-buffer anything-current-buffer)))
3307              (not (buffer-modified-p buf)))
3308         (progn
3309           (kill-buffer buf) (message "Buffer `%s' killed" buf-name))
3310         (find-file candidate))))
3311
3312 ;;;###autoload
3313 (defun anything-ff-run-kill-buffer-persistent ()
3314   "Execute `anything-ff-kill-buffer-fname' whitout quitting."
3315   (interactive)
3316   (anything-execute-persistent-action 'kill-buffer-fname))
3317
3318 (defcustom anything-ff-default-kbsize 1024.0
3319   "Default Kbsize to use for showing files size.
3320 It is a float, usually 1024.0 but could be 1000.0 on some systems."
3321   :group 'anything-config
3322   :type 'float)
3323
3324 (defun anything-ff-human-size (size)
3325   "Return a string showing SIZE of a file in human readable form.
3326 SIZE can be an integer or a float depending it's value.
3327 `file-attributes' will take care of that to avoid overflow error.
3328 KBSIZE if a floating point number, default value is 1024.0."
3329   (let ((M (cons "M" (/ size (expt anything-ff-default-kbsize 2))))
3330         (G (cons "G" (/ size (expt anything-ff-default-kbsize 3))))
3331         (K (cons "K" (/ size anything-ff-default-kbsize)))
3332         (B (cons "B" size)))
3333     (loop with result = B
3334        for (a . b) in
3335        (loop for (x . y) in (list M G K B)
3336           unless (< y 1) collect (cons x y))
3337        when (< b (cdr result)) do (setq result (cons a b))
3338        finally return (if (string= (car result) "B")
3339                           (format "%s" size)
3340                           (format "%.1f%s" (cdr result) (car result))))))
3341
3342 (defun* anything-ff-attributes
3343     (file &key type links uid gid access-time modif-time
3344           status size mode gid-change inode device-num dired human-size)
3345   "Easy interface for `file-attributes'."
3346   (let ((all (destructuring-bind
3347                    (type links uid gid access-time modif-time
3348                          status size mode gid-change inode device-num)
3349                  (file-attributes file 'string)
3350                (list :type        type
3351                      :links       links
3352                      :uid         uid
3353                      :gid         gid
3354                      :access-time access-time
3355                      :modif-time  modif-time
3356                      :status      status
3357                      :size        size
3358                      :mode        mode
3359                      :gid-change  gid-change
3360                      :inode       inode
3361                      :device-num  device-num))))
3362     (cond (type
3363            (let ((result (getf all :type)))
3364              (cond ((stringp result)
3365                     "symlink")
3366                    (result "directory")
3367                    (t "file"))))
3368           (links (getf all :links))
3369           (uid   (getf all :uid))
3370           (gid   (getf all :gid))
3371           (access-time
3372            (format-time-string "%Y-%m-%d %R" (getf all :access-time)))
3373           (modif-time
3374            (format-time-string "%Y-%m-%d %R" (getf all :modif-time)))
3375           (status
3376            (format-time-string "%Y-%m-%d %R" (getf all :status)))
3377           (size (if human-size (anything-ff-human-size (getf all :size))
3378                     (getf all :size)))
3379           (mode (getf all :mode))
3380           (gid-change (getf all :gid-change))
3381           (inode (getf all :inode))
3382           (device-num (getf all :device-num))
3383           (dired
3384            (concat
3385             (getf all :mode) " "
3386             (number-to-string (getf all :links)) " "
3387             (getf all :uid) ":"
3388             (getf all :gid) " "
3389             (if human-size (anything-ff-human-size (getf all :size))
3390                 (int-to-string (getf all :size))) " "
3391             (format-time-string "%Y-%m-%d %R" (getf all :modif-time))))
3392           (t all))))
3393
3394
3395 (defun anything-c-prefix-filename (fname &optional image file-or-symlinkp)
3396   "Return fname FNAME prefixed with icon IMAGE."
3397   (let* ((img-name   (and image (expand-file-name
3398                                  image anything-c-find-files-icons-directory)))
3399          (img        (and image (create-image img-name)))
3400          (prefix-img (and image (propertize " " 'display img)))
3401          (prefix-new (propertize
3402                       " " 'display
3403                       (propertize "[?]" 'face 'anything-ff-prefix)))
3404          (prefix-url (propertize
3405                       " " 'display
3406                       (propertize "[@]" 'face 'anything-ff-prefix))))
3407     (cond ((or file-or-symlinkp
3408                (file-exists-p fname)
3409                (file-symlink-p fname))
3410            (if image (concat prefix-img fname) fname))
3411           ((string-match ffap-url-regexp fname) (concat prefix-url " " fname))
3412           (t (concat prefix-new " " fname)))))
3413
3414 (defcustom anything-ff-tramp-not-fancy t
3415   "No colors when listing remote files when set to non--nil.
3416 This make listing much faster, specially on slow machines."
3417   :group 'anything-config
3418   :type  'boolean)
3419
3420 (defun anything-c-find-files-transformer (files sources)
3421   "Selector of transformer to use for `anything-c-source-find-files'."
3422   (if (and (string-match tramp-file-name-regexp anything-pattern)
3423            anything-ff-tramp-not-fancy)
3424       files
3425       (if (and (window-system) anything-c-find-files-show-icons)
3426           (anything-c-highlight-ffiles1 files sources)
3427           (anything-c-highlight-ffiles files sources))))
3428
3429 (defun anything-c-highlight-ffiles (files sources)
3430   "Candidate transformer for `anything-c-source-find-files' without icons."
3431   (loop for i in files collect
3432        (cond ((and (stringp (car (file-attributes i)))
3433                    (not (anything-ff-valid-symlink-p i))
3434                    (not (string-match "^\.#" (anything-c-basename i))))
3435               (cons (anything-c-prefix-filename
3436                      (propertize i 'face 'anything-ff-invalid-symlink) nil t)
3437                     i))
3438              ((stringp (car (file-attributes i)))
3439               (cons (anything-c-prefix-filename
3440                      (propertize i 'face 'anything-ff-symlink) nil t)
3441                     i))
3442              ((eq t (car (file-attributes i)))
3443               (cons (anything-c-prefix-filename
3444                      (propertize i 'face 'anything-ff-directory) nil t)
3445                     i))
3446              ((file-executable-p i)
3447               (cons (anything-c-prefix-filename
3448                      (propertize i 'face 'anything-ff-executable) nil t)
3449                     i))
3450              (t
3451               (cons (anything-c-prefix-filename
3452                      (propertize i 'face 'anything-ff-file))
3453                     i)))))
3454
3455 (defun anything-c-highlight-ffiles1 (files sources)
3456   "Candidate transformer for `anything-c-source-find-files' that show icons."
3457   (loop for i in files
3458      for af = (file-name-nondirectory i)
3459      collect (cond ( ;; Files.
3460                     (eq nil (car (file-attributes i)))
3461                     (let ((face (if (file-executable-p i)
3462                                     'anything-ff-executable
3463                                     'anything-ff-file)))
3464                       (cons (anything-c-prefix-filename
3465                              (propertize i 'face face) "leaf.xpm")
3466                             i)))
3467                    ( ;; Empty directories.
3468                     (and (eq t (car (file-attributes i)))
3469                          ;; Be sure to have permission to list content.
3470                          (file-readable-p i)
3471                          (eq 0 (length
3472                                 (directory-files
3473                                  i nil directory-files-no-dot-files-regexp t))))
3474                     (cons (anything-c-prefix-filename
3475                            (propertize
3476                             i 'face 'anything-ff-directory)
3477                            "empty.xpm")
3478                           i))
3479                    ( ;; Open directories.
3480                     (and (eq t (car (file-attributes i))) (get-buffer af))
3481                     (cons (anything-c-prefix-filename
3482                            (propertize
3483                             i 'face 'anything-ff-directory)
3484                            "open.xpm")
3485                           i))
3486                    ( ;; Closed directories.
3487                     (eq t (car (file-attributes i)))
3488                     (cons (anything-c-prefix-filename
3489                            (propertize
3490                             i 'face 'anything-ff-directory)
3491                            "close.xpm")
3492                           i))
3493                    ( ;; Open Symlinks directories.
3494                     (and (stringp (car (file-attributes i)))
3495                          (file-directory-p i) (get-buffer af))
3496                     (cons (anything-c-prefix-filename
3497                            (propertize i 'face 'anything-ff-symlink))
3498                           i))
3499                    ( ;; Closed Symlinks directories.
3500                     (and (stringp (car (file-attributes i)))
3501                          (file-directory-p i))
3502                     (cons (anything-c-prefix-filename
3503                            (propertize i 'face 'anything-ff-symlink))
3504                           i))
3505                    ( ;; Invalid Symlinks
3506                     (and (stringp (car (file-attributes i)))
3507                          (not (anything-ff-valid-symlink-p i))
3508                          (not (string-match "^\.#" (anything-c-basename i))))
3509                     (cons (anything-c-prefix-filename
3510                            (propertize i 'face 'anything-ff-invalid-symlink)
3511                            "leaf.xpm")
3512                           i))
3513                    ( ;; Files symlinks.
3514                     (stringp (car (file-attributes i)))
3515                     (cons (anything-c-prefix-filename
3516                            (propertize i 'face 'anything-ff-symlink)
3517                            "leaf.xpm")
3518                           i)))))
3519
3520 (defun anything-find-files-action-transformer (actions candidate)
3521   "Action transformer for `anything-c-source-find-files'."
3522   (cond ((with-current-buffer anything-current-buffer
3523            (eq major-mode 'message-mode))
3524          (append (subseq actions 0 4)
3525                  '(("Gnus attach file(s)" . anything-ff-gnus-attach-files))
3526                  (subseq actions 4)))
3527         ((string-match (image-file-name-regexp) candidate)
3528          (append (subseq actions 0 4)
3529                  '(("Rotate image right `M-r'" . anything-ff-rotate-image-right)
3530                    ("Rotate image left `M-l'" . anything-ff-rotate-image-left))
3531                  (subseq actions 4)))
3532         ((string-match "\.el$" (anything-aif (anything-marked-candidates)
3533                                    (car it) candidate))
3534          (append (subseq actions 0 4)
3535                  '(("Byte compile lisp file(s) `M-B, C-u to load'"
3536                     . anything-find-files-byte-compile)
3537                    ("Load File(s) `M-L'" . anything-find-files-load-files))
3538                  (subseq actions 4)))
3539         ((and (string-match "\.html?$" candidate)
3540               (file-exists-p candidate))
3541          (append (subseq actions 0 4)
3542                  '(("Browse url file" . browse-url-of-file))
3543                  (subseq actions 5)))
3544         ((or (string= (file-name-extension candidate) "pdf")
3545              (string= (file-name-extension candidate) "PDF"))
3546          (append (subseq actions 0 4)
3547                  '(("Pdfgrep File(s)" . anything-ff-pdfgrep))
3548                  (subseq actions 5)))
3549         (t actions)))
3550
3551 (defun anything-ff-gnus-attach-files (candidate)
3552   "Run `gnus-dired-attach' on `anything-marked-candidates' or CANDIDATE."
3553   (let ((flist (anything-marked-candidates)))
3554     (gnus-dired-attach flist)))
3555
3556 (defun anything-ff-rotate-current-image1 (file &optional num-arg)
3557   "Rotate current image at NUM-ARG degrees.
3558 This is a destructive operation on FILE made by external tool mogrify."
3559   (setq file (file-truename file)) ; For symlinked images.
3560   ;; When FILE is not an image-file, do nothing.
3561   (when (string-match (image-file-name-regexp) file)
3562     (if (executable-find "mogrify")
3563         (progn
3564           (shell-command (format "mogrify -rotate %s %s" (or num-arg 90) file))
3565           (when (buffer-live-p image-dired-display-image-buffer)
3566             (kill-buffer image-dired-display-image-buffer))
3567           (image-dired-display-image file)
3568           (message nil)
3569           (display-buffer (get-buffer image-dired-display-image-buffer)))
3570         (error "mogrify not found"))))
3571
3572 (defun anything-ff-rotate-image-left (candidate)
3573   "Rotate image file CANDIDATE left.
3574 This affect directly file CANDIDATE."
3575   (anything-ff-rotate-current-image1 candidate -90))
3576
3577 (defun anything-ff-rotate-image-right (candidate)
3578   "Rotate image file CANDIDATE right.
3579 This affect directly file CANDIDATE."
3580   (anything-ff-rotate-current-image1 candidate))
3581
3582 (defun anything-ff-rotate-left-persistent ()
3583   "Rotate image left without quitting anything."
3584   (interactive)
3585   (anything-execute-persistent-action 'image-action1))
3586
3587 (defun anything-ff-rotate-right-persistent ()
3588   "Rotate image right without quitting anything."
3589   (interactive)
3590   (anything-execute-persistent-action 'image-action2))
3591
3592 (defcustom anything-ff-exif-data-program "exiftran"
3593   "*Program used to extract exif data of an image file."
3594   :group 'anything-config
3595   :type 'string)
3596
3597 (defcustom anything-ff-exif-data-program-args "-d"
3598   "*Arguments used for `anything-ff-exif-data-program'."
3599   :group 'anything-config
3600   :type 'string)
3601
3602 (defun anything-ff-exif-data (candidate)
3603   "Extract exif data from file CANDIDATE using `anything-ff-exif-data-program'."
3604   (if (and anything-ff-exif-data-program
3605            (executable-find anything-ff-exif-data-program))
3606       (shell-command-to-string (format "%s %s %s"
3607                                        anything-ff-exif-data-program
3608                                        anything-ff-exif-data-program-args
3609                                        candidate))
3610       (format "No program %s found to extract exif"
3611               anything-ff-exif-data-program)))
3612
3613 (defun anything-find-files-persistent-action (candidate)
3614   "Open subtree CANDIDATE without quitting anything.
3615 If CANDIDATE is not a directory expand CANDIDATE filename.
3616 If CANDIDATE is alone, open file CANDIDATE filename.
3617 That's mean:
3618 First hit on C-z expand CANDIDATE second hit open file.
3619 If a prefix arg is given or `anything-follow-mode' is on open file."
3620   (let ((follow        (buffer-local-value
3621                         'anything-follow-mode
3622                         (get-buffer-create anything-buffer)))
3623         (new-pattern   (anything-get-selection))
3624         (num-lines-buf (with-current-buffer anything-buffer
3625                          (count-lines (point-min) (point-max)))))
3626     (flet ((insert-in-minibuffer (fname)
3627              (with-selected-window (minibuffer-window)
3628                (unless follow
3629                  (delete-minibuffer-contents)
3630                  (set-text-properties 0 (length fname) nil fname)
3631                  (insert fname)))))
3632       (cond (;; A symlink directory, expand it's truename.
3633              (and (file-directory-p candidate) (file-symlink-p candidate))
3634              (insert-in-minibuffer (file-name-as-directory
3635                                     (file-truename
3636                                      (expand-file-name candidate)))))
3637             ;; A directory, open it.
3638             ((file-directory-p candidate)
3639              (when (string= (anything-c-basename candidate) "..")
3640                (setq anything-ff-last-expanded anything-ff-default-directory))
3641              (insert-in-minibuffer (file-name-as-directory
3642                                     (expand-file-name candidate))))
3643             ;; A symlink file, expand to it's true name. (first hit)
3644             ((and (file-symlink-p candidate) (not current-prefix-arg) (not follow))
3645              (insert-in-minibuffer (file-truename candidate)))
3646             ;; A regular file, expand it, (first hit)
3647             ((and (>= num-lines-buf 3) (not current-prefix-arg) (not follow))
3648              (insert-in-minibuffer new-pattern))
3649             ;; An image file and it is the second hit on C-z,
3650             ;; show the file in `image-dired'.
3651             ((string-match (image-file-name-regexp) candidate)
3652              (when (buffer-live-p image-dired-display-image-buffer)
3653                (kill-buffer image-dired-display-image-buffer))
3654              (image-dired-display-image candidate)
3655              (message nil)
3656              (anything-c-switch-to-buffer image-dired-display-image-buffer)
3657              (with-current-buffer image-dired-display-image-buffer
3658                (let ((exif-data (anything-ff-exif-data candidate)))
3659                  (image-dired-update-property 'help-echo exif-data))))
3660             ;; Allow browsing archive on avfs fs.
3661             ;; Assume volume is already mounted with mountavfs.
3662             ((and anything-ff-avfs-directory
3663                   (string-match
3664                    (regexp-quote (expand-file-name anything-ff-avfs-directory))
3665                    (file-name-directory candidate))
3666                   (anything-ff-file-compressed-p candidate))
3667              (insert-in-minibuffer (concat candidate "#")))
3668             ;; On second hit we open file.
3669             ;; On Third hit we kill it's buffer maybe.
3670             (t
3671              (anything-ff-kill-or-find-buffer-fname candidate))))))
3672
3673 (defvar anything-ff-avfs-directory nil
3674   "*The default avfs directory, usually '.avfs'.
3675 When this is set you will be able to expand archive filenames with `C-z'
3676 inside an avfs directory mounted with mountavfs.
3677 See <http://sourceforge.net/projects/avf/>.")
3678 (defvar anything-ff-file-compressed-list '("gz" "bz2" "zip" "7z")
3679   "*Minimal list of compressed files extension.")
3680 (defun anything-ff-file-compressed-p (candidate)
3681   "Whether CANDIDATE is a compressed file or not."
3682   (member (file-name-extension candidate)
3683           anything-ff-file-compressed-list))
3684
3685 (defun anything-c-insert-file-name-completion-at-point (candidate)
3686   "Insert file name completion at point."
3687   (if buffer-read-only
3688       (error "Error: Buffer `%s' is read-only" (buffer-name))
3689       (let* ((end         (point))
3690              (guess       (substring-no-properties (thing-at-point 'filename)))
3691              (beg         (- (point) (length guess)))
3692              (full-path-p (or (string-match-p (concat "^" (getenv "HOME")) guess)
3693                               (string-match-p "^[^\~]" guess))))
3694         (set-text-properties 0 (length candidate) nil candidate)
3695         (if (and guess (not (string= guess "")) (string-match-p "^~\\|/.*" guess))
3696             (progn
3697               (delete-region beg end)
3698               (insert (if full-path-p
3699                           (expand-file-name candidate)
3700                           (abbreviate-file-name candidate))))
3701             (error "Aborting completion: No valid file name at point")))))
3702
3703 (defun* anything-find-files-history (&key (comp-read t))
3704   "The `anything-find-files' history.
3705 Show the first `anything-ff-history-max-length' elements of `anything-ff-history'
3706 in an `anything-comp-read'."
3707   (let ((history (when anything-ff-history
3708                    (loop with dup for i in anything-ff-history
3709                       ;; Remove duplicate and not existing files.
3710                       ;; Keep remote files.
3711                       unless (or (member i dup)
3712                                  (and (not (file-remote-p i))
3713                                       (not (file-exists-p i))))
3714                       collect i into dup
3715                       finally return dup)))) ; Remove dups.
3716     (when history
3717       (setq anything-ff-history
3718             (if (>= (length history) anything-ff-history-max-length)
3719                 (subseq history 0 anything-ff-history-max-length)
3720                 history))
3721       (if comp-read
3722           (anything-comp-read
3723            "Switch to Directory: "
3724            anything-ff-history
3725            :name "Anything Find Files History"
3726            :must-match t)
3727           anything-ff-history))))
3728
3729 ;;;###autoload
3730 (defun anything-find-files (arg)
3731   "Preconfigured `anything' for anything implementation of `find-file'.
3732 Called with a prefix arg show history if some.
3733 Don't call it from programs, use `anything-find-files1' instead.
3734 This is the starting point for nearly all actions you can do on files."
3735   (interactive "P")
3736   (let ((any-input (if (and arg anything-ff-history)
3737                        (anything-find-files-history)
3738                        (anything-find-files-initial-input))))
3739     (when (and (eq major-mode 'org-agenda-mode)
3740                org-directory
3741                (not any-input))
3742       (setq any-input (expand-file-name org-directory)))
3743     (set-text-properties 0 (length any-input) nil any-input)
3744     (if any-input
3745         ;; [Emacs-bug work around]
3746         ;; auto-expanding on a partial directory name as input
3747         ;; yield indefinitely this directory name in minibuffer
3748         ;; for unknow reasons, so disable auto-expansion for now
3749         ;; when any-input is an incomplete file/dir name.
3750         (let* ((anything-ff-auto-update-initial-value
3751                 (and anything-ff-auto-update-initial-value
3752                      (file-exists-p any-input)))
3753                (anything-ff-auto-update-flag
3754                 anything-ff-auto-update-initial-value))
3755           (anything-find-files1 any-input))
3756         (setq any-input (expand-file-name (anything-c-current-directory)))
3757         (anything-find-files1 any-input (buffer-file-name (current-buffer))))))
3758
3759
3760 (defun anything-find-files1 (fname &optional preselect)
3761   "Find FNAME with `anything' completion.
3762 Like `find-file' but with `anything' support.
3763 Use it for non--interactive calls of `anything-find-files'."
3764   (when (get-buffer anything-action-buffer)
3765     (kill-buffer anything-action-buffer))
3766   (let ((anything-mp-highlight-delay nil))
3767     (anything :sources 'anything-c-source-find-files
3768               :input fname
3769               :preselect preselect
3770               :keymap anything-find-files-map
3771               :prompt "Find Files or Url: "
3772               :buffer "*Anything Find Files*")))
3773
3774
3775 (defun anything-find-files-initial-input (&optional input)
3776   "Return INPUT if present, otherwise try to guess it."
3777   (or (and input (expand-file-name input))
3778       (anything-find-files-input
3779        (ffap-guesser)
3780        (thing-at-point 'filename))))
3781
3782 (defun anything-find-files-input (fap tap)
3783   "Default input of `anything-find-files'."
3784   (let* ((def-dir (anything-c-current-directory))
3785          (lib     (anything-find-library-at-point))
3786          (url     (anything-ff-find-url-at-point))
3787          (file-p  (and fap (not (string= fap ""))
3788                        (file-exists-p fap)
3789                        tap (not (string= tap ""))
3790                        (file-exists-p
3791                         (file-name-directory (expand-file-name tap def-dir))))))
3792     (cond (lib) ; e.g we are inside a require sexp.
3793           (url) ; String at point is an hyperlink.
3794           (file-p (expand-file-name tap def-dir))
3795           (t (and (not (string= fap "")) fap)))))
3796
3797 (defun anything-c-current-directory ()
3798   "Return current-directory name at point.
3799 Useful in dired buffers when there is inserted subdirs."
3800   (if (eq major-mode 'dired-mode)
3801       (dired-current-directory)
3802       default-directory))
3803
3804 (defun anything-ff-find-url-at-point ()
3805   "Try to find link to an url in text-property at point."
3806   (let* ((he      (get-text-property (point) 'help-echo))
3807          (ov      (overlays-at (point)))
3808          (ov-he   (and ov (overlay-get
3809                            (car (overlays-at (point))) 'help-echo)))
3810          (w3m-l   (get-text-property (point) 'w3m-href-anchor))
3811          (nt-prop (get-text-property (point) 'nt-link)))
3812     ;; Org link.
3813     (when (and (stringp he) (string-match "^LINK: " he))
3814       (setq he (replace-match "" t t he)))
3815     (loop for i in (list he ov-he w3m-l nt-prop)
3816        thereis (and (stringp i) (string-match ffap-url-regexp i) i))))
3817
3818 (defun anything-find-library-at-point ()
3819   "Try to find library path at point.
3820 Find inside `require' and `declare-function' sexp."
3821   (require 'find-func)
3822   (let* ((beg-sexp (save-excursion (search-backward "(" (point-at-bol) t)))
3823          (end-sexp (save-excursion (search-forward ")" (point-at-eol) t)))
3824          (sexp     (and beg-sexp end-sexp
3825                         (buffer-substring-no-properties
3826                          (1+ beg-sexp) (1- end-sexp)))))
3827     (ignore-errors
3828       (cond ((and sexp (string-match "require \'.+[^)]" sexp))
3829              (find-library-name
3830               (replace-regexp-in-string
3831                "'\\|\)\\|\(" ""
3832                ;; If require use third arg, ignore it,
3833                ;; always use library path found in `load-path'.
3834                (second (split-string (match-string 0 sexp))))))
3835             ((and sexp (string-match-p "^declare-function" sexp))
3836              (find-library-name
3837               (replace-regexp-in-string
3838                "\"\\|ext:" ""
3839                (third (split-string sexp)))))
3840             (t nil)))))
3841
3842 ;;; Anything completion for `write-file'.==> C-x C-w
3843 (defvar anything-c-source-write-file
3844   `((name . ,(concat "Write File" anything-c-find-files-doc-header))
3845     ;; It is needed for filenames with capital letters
3846     (disable-shortcuts)
3847     (candidates . anything-find-files-get-candidates)
3848     (filtered-candidate-transformer anything-c-find-files-transformer)
3849     (persistent-action . anything-find-files-persistent-action)
3850     (persistent-help . "Expand Candidate")
3851     (volatile)
3852     (action .
3853      (("Write File" . (lambda (candidate)
3854                         (write-file candidate 'confirm)))))))
3855
3856 ;;;###autoload
3857 (defun anything-write-file ()
3858   "Preconfigured `anything' providing completion for `write-file'."
3859   (interactive)
3860   (anything 'anything-c-source-write-file
3861             (expand-file-name default-directory)
3862             "Write buffer to file: " nil nil "*Anything write file*"))
3863
3864 ;;; Anything completion for `insert-file'.==> C-x i
3865 (defvar anything-c-source-insert-file
3866   `((name . ,(concat "Insert File" anything-c-find-files-doc-header))
3867     ;; It is needed for filenames with capital letters
3868     (disable-shortcuts)
3869     (candidates . anything-find-files-get-candidates)
3870     (filtered-candidate-transformer anything-c-find-files-transformer)
3871     (persistent-action . anything-find-files-persistent-action)
3872     (persistent-help . "Expand Candidate")
3873     (volatile)
3874     (action .
3875      (("Insert File" . (lambda (candidate)
3876                         (when (y-or-n-p (format "Really insert %s in %s "
3877                                                 candidate anything-current-buffer))
3878                           (insert-file-contents candidate))))))))
3879
3880 ;;;###autoload
3881 (defun anything-insert-file ()
3882   "Preconfigured `anything' providing completion for `insert-file'."
3883   (interactive)
3884   (anything 'anything-c-source-insert-file
3885             (expand-file-name default-directory)
3886             "Insert file: " nil nil "*Anything insert file*"))
3887
3888 ;;; Anything completion for copy, rename and (rel)sym/hard/link files from dired.
3889 (defvar anything-c-source-copy-files
3890   `((name . ,(concat "Copy Files" anything-c-find-files-doc-header))
3891     ;; It is needed for filenames with capital letters
3892     (disable-shortcuts)
3893     (candidates . anything-find-files-get-candidates)
3894     (filtered-candidate-transformer anything-c-find-files-transformer)
3895     (persistent-action . anything-find-files-persistent-action)
3896     (persistent-help . "Expand Candidate")
3897     (volatile)
3898     (action .
3899      (("Copy File"
3900        . (lambda (candidate)
3901            (anything-dired-action candidate :action 'copy)))
3902       ("Copy and Follow"
3903        . (lambda (candidate)
3904            (anything-dired-action candidate :action 'copy :follow t)))))))
3905
3906
3907 (defvar  anything-c-source-rename-files
3908   `((name . ,(concat "Rename Files" anything-c-find-files-doc-header))
3909     ;; It is needed for filenames with capital letters
3910     (disable-shortcuts)
3911     (candidates . anything-find-files-get-candidates)
3912     (filtered-candidate-transformer anything-c-find-files-transformer)
3913     (persistent-action . anything-find-files-persistent-action)
3914     (persistent-help . "Expand Candidate")
3915     (volatile)
3916     (action .
3917      (("Rename File"
3918        . (lambda (candidate)
3919            (anything-dired-action candidate :action 'rename)))
3920       ("Rename and Follow"
3921        . (lambda (candidate)
3922            (anything-dired-action candidate :action 'rename :follow t)))))))
3923
3924 (defvar anything-c-source-symlink-files
3925   `((name . ,(concat "Symlink Files" anything-c-find-files-doc-header))
3926     ;; It is needed for filenames with capital letters
3927     (disable-shortcuts)
3928     (candidates . anything-find-files-get-candidates)
3929     (filtered-candidate-transformer anything-c-find-files-transformer)
3930     (persistent-action . anything-find-files-persistent-action)
3931     (persistent-help . "Expand Candidate")
3932     (volatile)
3933     (action
3934      . (("Symlink File"
3935          . (lambda (candidate)
3936              (anything-dired-action candidate :action 'symlink)))
3937         ("RelSymlink File"
3938          . (lambda (candidate)
3939              (anything-dired-action candidate :action 'relsymlink)))))))
3940
3941
3942 (defvar anything-c-source-hardlink-files
3943   `((name . ,(concat "Hardlink Files" anything-c-find-files-doc-header))
3944     ;; It is needed for filenames with capital letters
3945     (disable-shortcuts)
3946     (candidates . anything-find-files-get-candidates)
3947     (filtered-candidate-transformer anything-c-find-files-transformer)
3948     (persistent-action . anything-find-files-persistent-action)
3949     (persistent-help . "Expand Candidate")
3950     (volatile)
3951     (action
3952      . (("Hardlink File"
3953          . (lambda (candidate)
3954              (anything-dired-action candidate :action 'hardlink)))))))
3955
3956 (defun* anything-dired-action (candidate &key action follow (files (dired-get-marked-files)))
3957   "Copy, rename or symlink file at point or marked files in dired to CANDIDATE.
3958 ACTION is a key that can be one of 'copy, 'rename, 'symlink, 'relsymlink."
3959   (when (get-buffer dired-log-buffer) (kill-buffer dired-log-buffer))
3960   (let ((fn     (case action
3961                   ('copy       'dired-copy-file)
3962                   ('rename     'dired-rename-file)
3963                   ('symlink    'make-symbolic-link)
3964                   ('relsymlink 'dired-make-relative-symlink)
3965                   ('hardlink   'dired-hardlink)))
3966         (marker (case action
3967                   ((copy rename)   dired-keep-marker-copy)
3968                   ('symlink        dired-keep-marker-symlink)
3969                   ('relsymlink     dired-keep-marker-relsymlink)
3970                   ('hardlink       dired-keep-marker-hardlink)))
3971         (dirflag (and (= (length files) 1)
3972                       (file-directory-p (car files))
3973                       (not (file-directory-p candidate)))))
3974     (dired-create-files
3975      fn (symbol-name action) files
3976      ;; CANDIDATE is the destination.
3977      (if (file-directory-p candidate)
3978          ;; When CANDIDATE is a directory, build file-name in this directory.
3979          ;; Else we use CANDIDATE.
3980          #'(lambda (from)
3981              (expand-file-name (file-name-nondirectory from) candidate))
3982          #'(lambda (from) candidate))
3983      marker)
3984     (when (and follow (not (get-buffer dired-log-buffer)))
3985       (let ((moved-flist (anything-get-dest-fnames-from-list files candidate dirflag))
3986             (target      (directory-file-name candidate)))
3987         (unwind-protect
3988              (progn
3989                (setq anything-ff-cand-to-mark moved-flist)
3990                (if (and dirflag (eq action 'rename))
3991                    (anything-find-files1 (file-name-directory target) target)
3992                    (anything-find-files1 (expand-file-name candidate))))
3993           (setq anything-ff-cand-to-mark nil))))))
3994
3995 ;; Internal
3996 (defvar anything-ff-cand-to-mark nil)
3997
3998 (defun anything-c-basename (fname)
3999   "Resolve basename of file or directory named FNAME."
4000   (file-name-nondirectory (directory-file-name fname)))
4001
4002 (defun anything-get-dest-fnames-from-list (flist dest-cand rename-dir-flag)
4003   "Transform filenames of FLIST to abs of DEST-CAND."
4004   ;; At this point files have been renamed/copied at destination.
4005   ;; That's mean DEST-CAND exists.
4006   (loop
4007      with dest = (expand-file-name dest-cand)
4008      for src in flist
4009      for basename-src = (anything-c-basename src)
4010      for fname = (cond (rename-dir-flag (directory-file-name dest))
4011                        ((file-directory-p dest)
4012                         (concat (file-name-as-directory dest) basename-src))
4013                        (t dest))
4014      when (file-exists-p fname)
4015      collect fname into tmp-list
4016      finally return (sort tmp-list 'string<)))
4017
4018 (defun anything-c-maybe-mark-candidates ()
4019   "Mark all candidates of list `anything-ff-cand-to-mark'."
4020   (when (and (string= (assoc-default 'name (anything-get-current-source))
4021                       (assoc-default 'name anything-c-source-find-files))
4022              anything-ff-cand-to-mark)
4023     (with-anything-window
4024       (while anything-ff-cand-to-mark
4025         (if (search-forward (car anything-ff-cand-to-mark) (point-at-eol) t)
4026             (progn
4027               (anything-mark-current-line)
4028               (anything-make-visible-mark)
4029               (forward-line 1)
4030               (setq anything-ff-cand-to-mark (cdr anything-ff-cand-to-mark)))
4031             (forward-line 1)))
4032       (unless (anything-this-visible-mark)
4033         (anything-prev-visible-mark)))))
4034
4035 (add-hook 'anything-after-update-hook #'anything-c-maybe-mark-candidates)
4036
4037 (defun* anything-dired-do-action-on-file (&key action)
4038   (let* ((files     (dired-get-marked-files))
4039          (len       (length files))
4040          (fname     (if (> len 1)
4041                         (format "* %d Files" len)
4042                         (car files)))
4043          (source    (case action
4044                       ('copy     'anything-c-source-copy-files)
4045                       ('rename   'anything-c-source-rename-files)
4046                       ('symlink  'anything-c-source-symlink-files)
4047                       ('hardlink 'anything-c-source-hardlink-files)))
4048          (prompt-fm (case action
4049                       ('copy     "Copy %s to: ")
4050                       ('rename   "Rename %s to: ")
4051                       ('symlink  "Symlink %s to: ")
4052                       ('hardlink "Hardlink %s to: ")))
4053          (buffer    (case action
4054                       ('copy     "*Anything Copy Files*")
4055                       ('rename   "*Anything Rename Files*")
4056                       ('symlink  "*Anything Symlink Files*")
4057                       ('hardlink "*Anything Hardlink Files*")))
4058          (anything-mp-highlight-delay     nil))
4059     (anything :sources source
4060               :input (or (dired-dwim-target-directory)
4061                          (expand-file-name (anything-c-current-directory)))
4062               :preselect (dired-get-filename)
4063               :prompt (format prompt-fm fname)
4064               :keymap anything-c-read-file-map
4065               :buffer buffer)))
4066
4067 ;;;###autoload
4068 (defun anything-dired-rename-file ()
4069   "Preconfigured `anything' to rename files from dired."
4070   (interactive)
4071   (anything-dired-do-action-on-file :action 'rename))
4072
4073 ;;;###autoload
4074 (defun anything-dired-copy-file ()
4075   "Preconfigured `anything' to copy files from dired."
4076   (interactive)
4077   (anything-dired-do-action-on-file :action 'copy))
4078
4079 ;;;###autoload
4080 (defun anything-dired-symlink-file ()
4081   "Preconfigured `anything' to symlink files from dired."
4082   (interactive)
4083   (anything-dired-do-action-on-file :action 'symlink))
4084
4085 ;;;###autoload
4086 (defun anything-dired-hardlink-file ()
4087   "Preconfigured `anything' to hardlink files from dired."
4088   (interactive)
4089   (anything-dired-do-action-on-file :action 'hardlink))
4090
4091 ;;;###autoload
4092 (define-minor-mode anything-dired-mode ()
4093   "Enable anything completion in Dired functions.
4094 Bindings affected are C, R, S, H."
4095   :group 'anything-config
4096   :global t
4097   (if anything-dired-mode
4098       (progn
4099         (substitute-key-definition
4100          'dired-do-copy 'anything-dired-copy-file dired-mode-map)
4101         (substitute-key-definition
4102          'dired-do-rename 'anything-dired-rename-file dired-mode-map)
4103         (substitute-key-definition
4104          'dired-do-symlink 'anything-dired-symlink-file dired-mode-map)
4105         (substitute-key-definition
4106          'dired-do-hardlink 'anything-dired-hardlink-file dired-mode-map))
4107       (substitute-key-definition
4108        'anything-dired-copy-file 'dired-do-copy dired-mode-map)
4109       (substitute-key-definition
4110        'anything-dired-rename-file 'dired-do-rename dired-mode-map)
4111       (substitute-key-definition
4112        'anything-dired-symlink-file 'dired-do-symlink dired-mode-map)
4113       (substitute-key-definition
4114        'anything-dired-hardlink-file 'dired-do-hardlink dired-mode-map)))
4115
4116 (defalias 'anything-dired-bindings 'anything-dired-mode)
4117
4118 (defvar anything-c-read-file-map
4119   (let ((map (copy-keymap anything-map)))
4120     (define-key map (kbd "C-.")         'anything-find-files-down-one-level)
4121     (define-key map (kbd "C-l")         'anything-find-files-down-one-level)
4122     (when anything-ff-lynx-style-map
4123       (define-key map (kbd "<left>")    'anything-find-files-down-one-level)
4124       (define-key map (kbd "<right>")   'anything-execute-persistent-action)
4125       (define-key map (kbd "<M-left>")  'anything-previous-source)
4126       (define-key map (kbd "<M-right>") 'anything-next-source))
4127     (delq nil map))
4128   "Keymap for `anything-c-read-file-name'.")
4129
4130 (defun* anything-c-read-file-name (prompt
4131                                    &key
4132                                    (initial-input (expand-file-name default-directory))
4133                                    (buffer "*Anything Completions*")
4134                                    test
4135                                    (preselect nil)
4136                                    must-match
4137                                    (history nil)
4138                                    (marked-candidates nil)
4139                                    (alistp t)
4140                                    (persistent-action 'anything-find-files-persistent-action)
4141                                    (persistent-help "Hit1 Expand Candidate, Hit2 or (C-u) Find file"))
4142   "Anything `read-file-name' emulation.
4143 INITIAL-INPUT is a valid path, TEST is a predicate that take one arg."
4144   (when (get-buffer anything-action-buffer)
4145     (kill-buffer anything-action-buffer))
4146   (let* ((anything-mp-highlight-delay nil)
4147          (anything-ff-auto-update-initial-value
4148           (and anything-ff-auto-update-initial-value
4149                (file-exists-p initial-input)))
4150          (anything-ff-auto-update-flag
4151           anything-ff-auto-update-initial-value))
4152     (flet ((action-fn (candidate)
4153              (if marked-candidates
4154                  (anything-marked-candidates)
4155                  (identity candidate))))
4156       (or (anything
4157            :sources
4158            `(((name . ,(concat "Read File Name History" anything-c-find-files-doc-header))
4159               (candidates . (lambda ()
4160                               (anything-comp-read-get-candidates history nil nil alistp)))
4161               (volatile)
4162               (persistent-action . ,persistent-action)
4163               (persistent-help . ,persistent-help)
4164               (action . ,'action-fn))
4165              ((name . ,(concat "Read file name" anything-c-find-files-doc-header))
4166               (init . (lambda ()
4167                         ;; For emacsclient (see `anything-c-source-find-files')
4168                         (unless window-system
4169                           (define-key anything-find-files-map (kbd "C-l")
4170                             'anything-find-files-down-one-level))))
4171               ;; It is needed for filenames with capital letters
4172               (disable-shortcuts)
4173               (candidates . (lambda ()
4174                               (if test
4175                                   (loop with seq = (anything-find-files-get-candidates)
4176                                      for fname in seq when (funcall test fname)
4177                                      collect fname into ls
4178                                      finally return (if must-match
4179                                                         ls
4180                                                         (append (list anything-pattern) ls)))
4181                                   (anything-find-files-get-candidates))))
4182               (filtered-candidate-transformer anything-c-find-files-transformer)
4183               (persistent-action . ,persistent-action)
4184               (candidate-number-limit . 9999)
4185               (persistent-help . ,persistent-help)
4186               (volatile)
4187               (action . ,'action-fn)))
4188            :input initial-input
4189            :prompt prompt
4190            :keymap anything-c-read-file-map
4191            :resume 'noresume
4192            :buffer buffer
4193            :preselect preselect)
4194           (keyboard-quit)))))
4195
4196 ;;; File Cache
4197 (defvar anything-c-source-file-cache-initialized nil)
4198
4199 (defvar anything-c-file-cache-files nil)
4200
4201 (defvar anything-c-source-file-cache
4202   '((name . "File Cache")
4203     (init
4204      . (lambda ()
4205          (require 'filecache nil t)
4206          (unless anything-c-source-file-cache-initialized
4207            (setq anything-c-file-cache-files
4208                  (loop for item in file-cache-alist append
4209                        (destructuring-bind (base &rest dirs) item
4210                          (loop for dir in dirs collect
4211                                (concat dir base)))))
4212            (defadvice file-cache-add-file (after file-cache-list activate)
4213              (add-to-list 'anything-c-file-cache-files (expand-file-name file)))
4214            (setq anything-c-source-file-cache-initialized t))))
4215     (candidates . anything-c-file-cache-files)
4216     (match anything-c-match-on-file-name
4217            anything-c-match-on-directory-name)
4218     (type . file)))
4219 ;; (anything 'anything-c-source-file-cache)
4220
4221 ;;; Locate
4222 ;; NOTE for WINDOZE users:
4223 ;; You have to install Everything with his command line interface here:
4224 ;; http://www.voidtools.com/download.php
4225
4226 (defvar anything-c-locate-command
4227   (case system-type
4228     ('gnu/linux "locate -i -r %s")
4229     ('berkeley-unix "locate -i %s")
4230     ('windows-nt "es -i -r %s")
4231     (t "locate %s"))
4232   "A list of arguments for locate program.
4233 The \"-r\" option must be the last option.")
4234
4235 (defvar anything-locate-db-file-regexp "m?locate\.db$"
4236   "Default regexp to match locate database.
4237 If nil Search in all files.")
4238
4239 (defun anything-c-locate-init ()
4240   "Initialize async locate process for `anything-c-source-locate'."
4241   (setq mode-line-format
4242         '(" " mode-line-buffer-identification " "
4243           (line-number-mode "%l") " "
4244           (:eval (propertize "(Locate Process Running) "
4245                   'face '((:foreground "red"))))))
4246   (prog1
4247       (start-process-shell-command "locate-process" nil
4248                                    (format anything-c-locate-command
4249                                            anything-pattern))
4250     (set-process-sentinel (get-process "locate-process")
4251                           #'(lambda (process event)
4252                               (when (string= event "finished\n")
4253                                 (with-anything-window
4254                                   (force-mode-line-update nil)
4255                                   (anything-update-move-first-line)))))))
4256
4257 (defvar anything-c-source-locate
4258   '((name . "Locate")
4259     (candidates . anything-c-locate-init)
4260     (type . file)
4261     (properties-action . anything-ff-properties)
4262     (requires-pattern . 3)
4263     (mode-line . anything-generic-file-mode-line-string)
4264     (delayed))
4265   "Find files matching the current input pattern with locate.")
4266 ;; (anything 'anything-c-source-locate)
4267
4268 (defvar anything-generic-file-mode-line-string
4269   "\\<anything-generic-files-map>\
4270 \\[anything-generic-file-help]:Help, \
4271 \\<anything-map>\
4272 \\[anything-select-action]:Acts,\
4273 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
4274 \\[anything-select-3rd-action]:NthAct,\
4275 \\[anything-send-bug-report-from-anything]:BugReport."
4276   "String displayed in mode-line in `anything-c-source-find-files'")
4277
4278 (defun anything-generic-file-help ()
4279   (interactive)
4280   (let ((anything-help-message "== Anything Generic files Map ==\
4281 \nSpecific commands for anything locate and others files sources:
4282 \\<anything-generic-files-map>
4283 \\[anything-ff-run-grep]\t\t->Run grep (C-u recurse).
4284 \\[anything-ff-run-pdfgrep]\t\t->Run Pdfgrep on marked files.
4285 \\[anything-ff-run-delete-file]\t\t->Delete file.
4286 \\[anything-ff-run-switch-other-window]\t\t->Switch other window.
4287 \\[anything-ff-properties-persistent]\t\t->Show file properties.
4288 \\[anything-yank-text-at-point]\t\t->Yank text at point.
4289 \\[anything-ff-run-open-file-externally]\t\t->Open file with external program (C-u to choose).
4290 \nLocate tips:
4291 You can add after writing search pattern any of the locate command line options.
4292 e.g -b, -e, -n <number>...etc.
4293 See Man locate for more infos.
4294 \n== Anything Map ==
4295 \\{anything-map}"))
4296     (anything-help)))
4297
4298 (defvar anything-generic-files-map
4299   (let ((map (copy-keymap anything-map)))
4300     (define-key map (kbd "M-g s")   'anything-ff-run-grep)
4301     (define-key map (kbd "M-g p")   'anything-ff-run-pdfgrep)
4302     (define-key map (kbd "M-D")     'anything-ff-run-delete-file)
4303     (define-key map (kbd "C-o")     'anything-ff-run-switch-other-window)
4304     (define-key map (kbd "M-i")     'anything-ff-properties-persistent)
4305     (define-key map (kbd "C-c C-x") 'anything-ff-run-open-file-externally)
4306     (define-key map (kbd "C-w")     'anything-yank-text-at-point)
4307     (define-key map (kbd "C-c ?")   'anything-generic-file-help)
4308     map)
4309   "Generic Keymap for files.")
4310
4311 ;;; Anything Incremental Grep.
4312 ;; This allow to grep incrementally with anything interface.
4313 ;; It allow also to Grep files recursively without using 'find' shell command.
4314 ;; On Windows you will need at least Grep version 2.5.4 of Gnuwin32.
4315 ;;
4316 ;;
4317 (defvar anything-c-grep-default-command
4318   "grep -d skip %e -niH -e %p %f"
4319   "Default grep format command for `anything-do-grep1'.
4320 Where:
4321 '%e' format spec is for --exclude or --include grep options.
4322 '%p' format spec is for pattern.
4323 '%f' format spec is for filenames.")
4324
4325 (defvar anything-c-grep-default-recurse-command
4326   "grep -d recurse %e -niH -e %p %f"
4327   "Default recursive grep format command for `anything-do-grep1'.
4328 See `anything-c-grep-default-command' for format specs.")
4329
4330 (defvar anything-c-default-zgrep-command "zgrep -niH -e %p %f")
4331
4332 (defvar anything-c-rzgrep-cache (make-hash-table :test 'equal))
4333
4334 (defvar anything-c-grep-default-function 'anything-c-grep-init)
4335
4336 (defvar anything-c-grep-debug-command-line nil
4337   "Turn on anything grep command-line debugging when non--nil.")
4338
4339 (defvar anything-c-zgrep-recurse-flag nil)
4340
4341 (defvar anything-grep-mode-line-string
4342   "\\<anything-c-grep-map>\
4343 \\[anything-grep-help]:Help,\
4344 \\<anything-map>\
4345 \\[anything-select-action]:Acts,\
4346 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
4347 \\[anything-select-3rd-action]:NthAct,\
4348 \\[anything-send-bug-report-from-anything]:BugReport."
4349   "String displayed in mode-line in `anything-do-grep'.")
4350 (defvar anything-c-grep-history nil)
4351
4352 (defvar anything-c-grep-max-length-history 100
4353   "*Max number of elements to save in `anything-c-grep-history'.")
4354
4355 (defface anything-grep-match
4356   '((t (:inherit match)))
4357   "Face used to highlight grep matches."
4358   :group 'anything-config)
4359
4360 (defface anything-grep-file
4361   '((t (:foreground "BlueViolet" :underline t)))
4362   "Face used to highlight grep results filenames."
4363   :group 'anything-config)
4364
4365 (defface anything-grep-lineno
4366   '((t (:foreground "Darkorange1")))
4367   "Face used to highlight grep number lines."
4368   :group 'anything-config)
4369
4370 (defface anything-grep-running
4371   '((t (:foreground "Red")))
4372   "Face used in mode line when grep is running."
4373   :group 'anything-config)
4374
4375 (defface anything-grep-finish
4376   '((t (:foreground "Green")))
4377   "Face used in mode line when grep is finish."
4378   :group 'anything-config)
4379
4380 (defun anything-c-grep-prepare-candidates (candidates)
4381   "Prepare filenames and directories CANDIDATES for grep command line."
4382   ;; If one or more candidate is a directory, search in all files
4383   ;; of this candidate (e.g /home/user/directory/*).
4384   ;; If r option is enabled search also in subdidrectories.
4385   ;; We need here to expand wildcards to support crap windows filenames
4386   ;; as grep don't accept quoted wildcards (e.g "dir/*.el").
4387   (if anything-c-zgrep-recurse-flag
4388       (mapconcat 'shell-quote-argument candidates " ")
4389       (loop for i in candidates append
4390            (cond ( ;; Candidate is a directory and we use recursion.
4391                   (and (file-directory-p i)
4392                        (anything-c-grep-recurse-p))
4393                   (list (expand-file-name i)))
4394                  ;; Candidate is a directory, search in all files.
4395                  ((file-directory-p i)
4396                   (file-expand-wildcards
4397                    (concat (file-name-as-directory (expand-file-name i)) "*") t))
4398                  ;; Candidate is a file or wildcard and we use recursion, use the
4399                  ;; current directory instead of candidate.
4400                  ((and (or (file-exists-p i) (string-match "\*" i))
4401                        (anything-c-grep-recurse-p))
4402                   (list (directory-file-name ; Needed for windoze.
4403                          (file-name-directory (directory-file-name i)))))
4404                  ;; Candidate use wildcard.
4405                  ((string-match "^\*" (anything-c-basename i))
4406                   (file-expand-wildcards i t))
4407                  ;; Else should be one or more file.
4408                  (t (list i))) into all-files
4409            finally return
4410            (mapconcat 'shell-quote-argument all-files " "))))
4411
4412 (defun anything-c-grep-recurse-p ()
4413   "Check if `anything-do-grep1' have switched to recursive."
4414   (let ((args (replace-regexp-in-string
4415                "grep" "" anything-c-grep-default-command)))
4416     (string-match-p "r\\|recurse" args)))
4417
4418 (defun anything-c-grep-init (only-files &optional include zgrep)
4419   "Start an asynchronous grep process in ONLY-FILES list."
4420   (let* ((fnargs        (anything-c-grep-prepare-candidates
4421                          (if (file-remote-p anything-ff-default-directory)
4422                              (mapcar #'(lambda (x)
4423                                          (file-remote-p x 'localname))
4424                                      only-files)
4425                              only-files)))
4426          (ignored-files (mapconcat
4427                          #'(lambda (x)
4428                              (concat "--exclude=" (shell-quote-argument x)))
4429                          grep-find-ignored-files " "))
4430          (ignored-dirs  (mapconcat
4431                          ;; Need grep version 2.5.4 of Gnuwin32 on windoze.
4432                          #'(lambda (x)
4433                              (concat "--exclude-dir=" (shell-quote-argument x)))
4434                          grep-find-ignored-directories " "))
4435          (exclude       (if (anything-c-grep-recurse-p)
4436                             (concat (or include ignored-files) " " ignored-dirs)
4437                             ignored-files))
4438          (cmd-line      (format-spec
4439                          anything-c-grep-default-command
4440                          (delq nil
4441                                (list (unless zgrep (cons ?e exclude))
4442                                      (cons ?p (shell-quote-argument anything-pattern))
4443                                      (cons ?f fnargs))))))
4444     (when anything-c-grep-debug-command-line
4445       (with-current-buffer (get-buffer-create "*any grep debug*")
4446         (goto-char (point-max))
4447         (insert (concat ">>> " cmd-line "\n\n"))))
4448     (setq mode-line-format
4449           '(" " mode-line-buffer-identification " "
4450             (line-number-mode "%l") " "
4451             (:eval (when (get-process "grep-process")
4452                      (propertize "[Grep Process Running] "
4453                                  'face 'anything-grep-running)))))
4454     (force-mode-line-update nil)
4455     (prog1
4456         (let ((default-directory anything-ff-default-directory))
4457           (start-file-process-shell-command "grep-process" nil cmd-line))
4458       (message nil)
4459       (set-process-sentinel
4460        (get-process "grep-process")
4461        #'(lambda (process event)
4462            (when (string= event "finished\n")
4463              (with-anything-window
4464                (anything-update-move-first-line)
4465                (setq mode-line-format
4466                      '(" " mode-line-buffer-identification " "
4467                        (line-number-mode "%l") " "
4468                        (:eval (propertize
4469                                (format "[Grep Process Finished - (%s results)] "
4470                                        (let ((nlines (1- (count-lines
4471                                                           (point-min)
4472                                                           (point-max)))))
4473                                          (if (> nlines 0) nlines 0)))
4474                                'face 'anything-grep-finish))))
4475                (force-mode-line-update nil))))))))
4476
4477 (defun anything-c-grep-action (candidate &optional where mark)
4478   "Define a default action for `anything-do-grep' on CANDIDATE.
4479 WHERE can be one of other-window, elscreen, other-frame."
4480   (let* ((split        (anything-c-grep-split-line candidate))
4481          (lineno       (string-to-number (nth 1 split)))
4482          (loc-fname    (car split))
4483          (tramp-method (file-remote-p anything-ff-default-directory 'method))
4484          (tramp-host   (file-remote-p anything-ff-default-directory 'host))
4485          (tramp-prefix (concat "/" tramp-method ":" tramp-host ":"))
4486          (fname        (if tramp-host
4487                            (concat tramp-prefix loc-fname) loc-fname)))
4488     (case where
4489       (other-window (find-file-other-window fname))
4490       (elscreen     (anything-elscreen-find-file fname))
4491       (other-frame  (find-file-other-frame fname))
4492       (t (find-file fname)))
4493     (anything-goto-line lineno)
4494     (when mark
4495       (set-marker (mark-marker) (point))
4496       (push-mark (point) 'nomsg))
4497     ;; Save history
4498     (unless (or anything-in-persistent-action
4499                 (string= anything-pattern ""))
4500       (setq anything-c-grep-history
4501             (cons anything-pattern
4502                   (delete anything-pattern anything-c-grep-history)))
4503       (when (> (length anything-c-grep-history)
4504                anything-c-grep-max-length-history)
4505         (setq anything-c-grep-history
4506               (delete (car (last anything-c-grep-history))
4507                       anything-c-grep-history))))))
4508
4509 (defun anything-c-grep-other-window (candidate)
4510   "Jump to result in other window from anything grep."
4511   (anything-c-grep-action candidate 'other-window))
4512
4513 (defun anything-c-grep-other-frame (candidate)
4514   "Jump to result in other frame from anything grep."
4515   (anything-c-grep-action candidate 'other-frame))
4516
4517 (defun anything-c-grep-jump-elscreen (candidate)
4518   "Jump to result in elscreen from anything grep."
4519   (anything-c-grep-action candidate 'elscreen))
4520
4521 (defun anything-c-grep-save-results (candidate)
4522   "Save anything grep result in a `grep-mode' buffer."
4523   (let ((buf "*grep*")
4524         new-buf)
4525     (when (get-buffer buf)
4526       (setq new-buf (read-string "GrepBufferName: " buf))
4527       (loop for b in (anything-c-buffer-list)
4528          when (and (string= new-buf b)
4529                    (not (y-or-n-p
4530                          (format "Buffer `%s' already exists overwrite? "
4531                                  new-buf))))
4532          do (setq new-buf (read-string "GrepBufferName: " "*grep ")))
4533       (setq buf new-buf))
4534     (with-current-buffer (get-buffer-create buf)
4535       (let ((inhibit-read-only t))
4536         (erase-buffer)
4537         (insert "-*- mode: grep -*-\n\n"
4538                 (format "Grep Results for `%s':\n\n" anything-pattern))
4539         (save-excursion
4540           (insert (with-current-buffer anything-buffer
4541                     (forward-line 1)
4542                     (buffer-substring (point) (point-max))))
4543           (grep-mode))))
4544     (message "Anything Grep Results saved in `%s' buffer" buf)))
4545
4546 (defun anything-c-grep-persistent-action (candidate)
4547   "Persistent action for `anything-do-grep'.
4548 With a prefix arg record CANDIDATE in `mark-ring'."
4549   (if current-prefix-arg
4550       (anything-c-grep-action candidate nil 'mark)
4551       (anything-c-grep-action candidate))
4552   (anything-match-line-color-current-line))
4553
4554 (defun anything-c-grep-guess-extensions (files)
4555   "Try to guess file extensions in FILES list when using grep recurse.
4556 These extensions will be added to command line with --include arg of grep."
4557   (loop
4558      with glob-list = nil
4559      with lst = (if (file-directory-p (car files))
4560                     (directory-files
4561                      (car files) nil
4562                      directory-files-no-dot-files-regexp)
4563                     files)
4564      for i in lst
4565      for ext = (file-name-extension i t)
4566      for glob = (and ext (not (string= ext ""))
4567                      (concat "*" ext))
4568      unless (or (not glob)
4569                 (member glob glob-list)
4570                 (member glob grep-find-ignored-files))
4571      collect glob into glob-list
4572      finally return glob-list))
4573
4574 (defun anything-do-grep1 (only &optional recurse zgrep)
4575   "Launch grep with a list of ONLY files.
4576 When RECURSE is given use -r option of grep and prompt user
4577 to set the --include args of grep.
4578 You can give more than one arg separated by space.
4579 e.g *.el *.py *.tex.
4580 If it's empty --exclude `grep-find-ignored-files' is used instead."
4581   (let* ((anything-compile-source-functions
4582           ;; rule out anything-match-plugin because the input is one regexp.
4583           (delq 'anything-compile-source--match-plugin
4584                 (copy-sequence anything-compile-source-functions)))
4585          (exts (anything-c-grep-guess-extensions only))
4586          (globs (and (not zgrep) (mapconcat 'identity exts " ")))
4587          (include-files (and recurse (not zgrep)
4588                              (read-string "OnlyExt(*.[ext]): "
4589                                           globs)))
4590          ;; Set `minibuffer-history' AFTER includes-files
4591          ;; to avoid storing wild-cards here.
4592          (minibuffer-history anything-c-grep-history)
4593          (anything-c-grep-default-command (cond ((and recurse zgrep) anything-c-default-zgrep-command)
4594                                                 (recurse anything-c-grep-default-recurse-command)
4595                                                 (zgrep anything-c-default-zgrep-command)
4596                                                 (t anything-c-grep-default-command)))
4597          ;; Disable match-plugin and use here own highlighting.
4598          (anything-mp-highlight-delay     nil))
4599     (when include-files
4600       (setq include-files
4601             (and (not (string= include-files ""))
4602                  (mapconcat #'(lambda (x)
4603                                 (concat "--include=" (shell-quote-argument x)))
4604                             (split-string include-files) " "))))
4605     ;; When called as action from an other source e.g *-find-files
4606     ;; we have to kill action buffer.
4607     (when (get-buffer anything-action-buffer)
4608       (kill-buffer anything-action-buffer))
4609     ;; `anything-find-files' haven't already started,
4610     ;; give a default value to `anything-ff-default-directory'.
4611     (setq anything-ff-default-directory (or anything-ff-default-directory
4612                                             default-directory))
4613     (anything
4614      :sources
4615      `(((name . "Grep (C-c ? Help)")
4616         (candidates
4617          . (lambda ()
4618              (funcall anything-c-grep-default-function only include-files zgrep)))
4619         (filtered-candidate-transformer anything-c-grep-cand-transformer)
4620         (candidate-number-limit . 9999)
4621         (mode-line . anything-grep-mode-line-string)
4622         (jump-persistent . anything-c-grep-persistent-action)
4623         (action . ,(delq
4624                     nil
4625                     `(("Find File" . anything-c-grep-action)
4626                       ("Find file other frame" . anything-c-grep-other-frame)
4627                       ,(and (locate-library "elscreen")
4628                             '("Find file in Elscreen"
4629                               . anything-c-grep-jump-elscreen))
4630                       ("Save results in grep buffer" . anything-c-grep-save-results)
4631                       ("Find file other window" . anything-c-grep-other-window))))
4632         (persistent-action . anything-c-grep-persistent-action)
4633         (persistent-help . "Jump to line (`C-u' Record in mark ring)")
4634         (requires-pattern . 3)
4635         (delayed)))
4636      :keymap anything-c-grep-map
4637      :buffer "*anything grep*")))
4638
4639 ;;;###autoload
4640 (defun anything-do-grep ()
4641   "Preconfigured anything for grep.
4642 Contrarily to Emacs `grep' no default directory is given, but
4643 the full path of candidates in ONLY.
4644 That allow to grep different files not only in `default-directory' but anywhere
4645 by marking them (C-<SPACE>). If one or more directory is selected
4646 grep will search in all files of these directories.
4647 You can use also wildcard in the base name of candidate.
4648 If a prefix arg is given use the -r option of grep.
4649 The prefix arg can be passed before or after start.
4650 See also `anything-do-grep1'."
4651   (interactive)
4652   (let ((only    (anything-c-read-file-name
4653                   "Search in file(s): "
4654                   :marked-candidates t
4655                   :preselect (or (dired-get-filename nil t)
4656                                  (buffer-file-name (current-buffer)))))
4657         (prefarg (or current-prefix-arg anything-current-prefix-arg)))
4658     (anything-do-grep1 only prefarg)))
4659
4660 (defmacro* anything-c-walk-directory (directory &key (path 'basename) (directories t) match)
4661   "Walk through DIRECTORY tree.
4662 PATH can be one of basename, relative, or full.
4663 DIRECTORIES when non--nil (default) return also directories names, otherwise
4664 skip directories names.
4665 MATCH match only filenames matching regexp MATCH."
4666   `(let (result
4667          (fn (case ,path
4668                (basename 'file-name-nondirectory)
4669                (relative 'file-relative-name)
4670                (full     'identity)
4671                (t (error "Error: Invalid path spec `%s', must be one of basename, relative or full." ,path)))))
4672      (labels ((ls-R (dir)
4673                 (loop with ls = (directory-files dir t directory-files-no-dot-files-regexp)
4674                    for f in ls
4675                    if (file-directory-p f)
4676                    do (progn (when ,directories
4677                                (push (funcall fn f) result))
4678                              ;; Don't recurse in directory symlink.
4679                              (unless (file-symlink-p f)
4680                                (ls-R f)))
4681                    else do
4682                    (unless (and ,match (not (string-match ,match (file-name-nondirectory f))))
4683                      (push (funcall fn f) result)))))
4684        (ls-R ,directory)
4685        (nreverse result))))
4686
4687 (defun anything-ff-zgrep-1 (flist recursive)
4688   (unwind-protect
4689        (let* ((def-dir (or anything-ff-default-directory
4690                            default-directory))
4691               (only    (if recursive
4692                            (or (gethash def-dir anything-c-rzgrep-cache)
4693                                (puthash
4694                                 def-dir
4695                                 (anything-c-walk-directory
4696                                  def-dir
4697                                  :directories nil
4698                                  :path 'full
4699                                  :match ".*\\(\.gz\\|\.bz\\|\.xz\\|\.lzma\\)$")
4700                                 anything-c-rzgrep-cache))
4701                            flist)))
4702          (when recursive (setq anything-c-zgrep-recurse-flag t))
4703          (anything-do-grep1 only recursive 'zgrep))
4704     (setq anything-c-zgrep-recurse-flag nil)))
4705
4706 ;;;###autoload
4707 (defun anything-do-zgrep (candidate)
4708   "Preconfigured anything for zgrep."
4709   (let ((prefarg (or current-prefix-arg anything-current-prefix-arg))
4710         (ls (anything-c-read-file-name
4711              "Search in file(s): "
4712              :marked-candidates t
4713              :preselect (or (dired-get-filename nil t)
4714                             (buffer-file-name (current-buffer))))))
4715     (anything-ff-zgrep-1 ls prefarg)))
4716
4717 (defun anything-c-grep-split-line (line)
4718   "Split a grep output line."
4719     (let (beg fname lineno str)
4720       ;; Don't print until grep line is valid.
4721       (when (string-match "\\(.*\\)\\(:[0-9]+:\\)\\(.*\\)" line)
4722         (with-temp-buffer
4723           (insert line)
4724           (goto-char (point-min))
4725           (setq beg (point))
4726           (forward-char 2)
4727           (re-search-forward ":" nil t)
4728           (setq fname (buffer-substring-no-properties beg (1- (point))))
4729           (setq beg (point))
4730           (re-search-forward ":" nil t)
4731           (setq lineno (buffer-substring-no-properties beg (1- (point))))
4732           (setq str (buffer-substring-no-properties (point) (point-at-eol))))
4733         (list fname lineno str))))
4734
4735 (defun anything-c-grep-cand-transformer (candidates sources)
4736   "Filtered candidate transformer function for `anything-do-grep'."
4737   (loop for i in candidates
4738      for split  = (and i (anything-c-grep-split-line i))
4739      for fname  = (car split)
4740      for lineno = (nth 1 split)
4741      for str    = (nth 2 split)
4742      when (and fname lineno str)
4743      collect
4744        (cons (concat (propertize (file-name-nondirectory fname)
4745                                  'face 'anything-grep-file
4746                                  'help-echo fname) ":"
4747                      (propertize lineno 'face 'anything-grep-lineno) ":"
4748                      (anything-c-grep-highlight-match str))
4749              i)))
4750
4751 (defun anything-c-grep-highlight-match (str)
4752   "Highlight in string STR all occurences matching `anything-pattern'."
4753   (condition-case nil
4754       (with-temp-buffer
4755         (insert str)
4756         (goto-char (point-min))
4757         (while (and (re-search-forward anything-pattern nil t)
4758                     (> (- (match-end 0) (match-beginning 0)) 0))
4759           (add-text-properties
4760            (match-beginning 0) (match-end 0)
4761            '(face anything-grep-match)))
4762         (buffer-string))
4763     (error nil)))
4764
4765 ;; Go to next or precedent file (common to etags and grep).
4766 (defun anything-c-goto-next-or-prec-file (n)
4767   "Go to next or precedent candidate file in anything grep/etags buffers.
4768 If N is positive go forward otherwise go backward."
4769   (with-anything-window
4770     (let* ((current-line-list  (split-string
4771                                 (buffer-substring
4772                                  (point-at-bol)
4773                                  (point-at-eol)) ":"))
4774            (current-fname      (nth 0 current-line-list))
4775            (fn-b-o-f           (if (eq n 1) 'eobp 'bobp)))
4776       (catch 'break
4777         (while (not (funcall fn-b-o-f))
4778           (forward-line n) ; Go forward or backward depending of n value.
4779           (unless (search-forward current-fname (point-at-eol) t)
4780             (anything-mark-current-line)
4781             (throw 'break nil))))
4782       (cond ((and (eq n 1) (eobp))
4783              (re-search-backward ".")
4784              (forward-line 0)
4785              (anything-mark-current-line))
4786             ((and (< n 1) (bobp))
4787              (forward-line 1)
4788              (anything-mark-current-line))))))
4789
4790 ;;;###autoload
4791 (defun anything-c-goto-precedent-file ()
4792   "Go to precedent file in anything grep/etags buffers."
4793   (interactive)
4794   (anything-c-goto-next-or-prec-file -1))
4795
4796 ;;;###autoload
4797 (defun anything-c-goto-next-file ()
4798   "Go to precedent file in anything grep/etags buffers."
4799   (interactive)
4800   (anything-c-goto-next-or-prec-file 1))
4801
4802 ;;;###autoload
4803 (defun anything-grep-help ()
4804   (interactive)
4805   (let ((anything-help-message "== Anything Grep Map ==\
4806 \nSpecific commands for Grep and Etags:
4807 \\<anything-c-grep-map>
4808 \\[anything-c-goto-next-file]\t->Next File.
4809 \\[anything-c-goto-precedent-file]\t\t->Precedent File.
4810 \\[anything-yank-text-at-point]\t\t->Yank Text at point in minibuffer.
4811 \\[anything-c-grep-run-other-window-action]\t\t->Jump other window.
4812 \\[anything-c-grep-run-persistent-action]\t\t->Run persistent action (Same as `C-z').
4813 \\[anything-c-grep-run-default-action]\t\t->Run default action (Same as RET).
4814 \\[anything-grep-help]\t\t->Show this help.
4815 \n== Anything Map ==
4816 \\{anything-map}"))
4817     (anything-help)))
4818
4819 (defcustom anything-c-grep-use-ioccur-style-keys t
4820   "Use Arrow keys to jump to occurences."
4821   :group 'anything-config
4822   :type 'boolean)
4823
4824 (defvar anything-c-grep-map
4825   (let ((map (copy-keymap anything-map)))
4826     (define-key map (kbd "M-<down>") 'anything-c-goto-next-file)
4827     (define-key map (kbd "M-<up>")   'anything-c-goto-precedent-file)
4828     (define-key map (kbd "C-o")      'anything-c-grep-run-other-window-action)
4829     (define-key map (kbd "C-w")      'anything-yank-text-at-point)
4830     (define-key map (kbd "C-x C-s")  'anything-c-grep-run-save-buffer)
4831     (when anything-c-grep-use-ioccur-style-keys
4832       (define-key map (kbd "<right>")  'anything-c-grep-run-persistent-action)
4833       (define-key map (kbd "<left>")  'anything-c-grep-run-default-action))
4834     (define-key map (kbd "C-c ?")    'anything-grep-help)
4835     (delq nil map))
4836   "Keymap used in Grep sources.")
4837
4838 (defun anything-c-grep-run-persistent-action ()
4839   "Run grep persistent action from `anything-do-grep1'."
4840   (interactive)
4841   (anything-execute-persistent-action 'jump-persistent))
4842
4843 (defun anything-c-grep-run-default-action ()
4844   "Run grep default action from `anything-do-grep1'."
4845   (interactive)
4846   (anything-c-quit-and-execute-action 'anything-c-grep-action))
4847
4848 (defun anything-c-grep-run-other-window-action ()
4849   "Run grep goto other window action from `anything-do-grep1'."
4850   (interactive)
4851   (anything-c-quit-and-execute-action 'anything-c-grep-other-window))
4852
4853 (defun anything-c-grep-run-save-buffer ()
4854   "Run grep save results action from `anything-do-grep1'."
4855   (interactive)
4856   (anything-c-quit-and-execute-action 'anything-c-grep-save-results))
4857
4858 ;; Grep buffers
4859 (defun anything-c-grep-buffers-1 (candidate &optional zgrep)
4860   "Run grep on all file--buffers or CANDIDATE if it is a file--buffer.
4861 If one of selected buffers is not a file--buffer,
4862 it is ignored and grep will run on all others file--buffers.
4863 If only one candidate is selected and it is not a file--buffer,
4864 switch to this buffer and run `anything-occur'.
4865 If a prefix arg is given run grep on all buffers ignoring non--file-buffers."
4866   (let* ((prefarg (or current-prefix-arg anything-current-prefix-arg))
4867          (cands (if prefarg
4868                     (buffer-list)
4869                     (anything-marked-candidates)))
4870          (bufs (loop for buf in cands
4871                   for fname = (buffer-file-name (get-buffer buf))
4872                   when fname
4873                   collect (expand-file-name fname))))
4874     (if bufs
4875         (if zgrep
4876             (anything-do-grep1 bufs nil 'zgrep)
4877             (anything-do-grep1 bufs))
4878         ;; bufs is empty, thats mean we have only CANDIDATE
4879         ;; and it is not a buffer-filename, fallback to occur.
4880         (anything-c-switch-to-buffer candidate)
4881         (when (get-buffer anything-action-buffer)
4882           (kill-buffer anything-action-buffer))
4883         (anything-occur))))
4884
4885 (defun anything-c-grep-buffers (candidate)
4886   "Action to grep buffers."
4887   (anything-c-grep-buffers-1 candidate))
4888
4889 (defun anything-c-zgrep-buffers (candidate)
4890   "Action to zgrep buffers."
4891   (anything-c-grep-buffers-1 candidate 'zgrep))
4892
4893 ;;; Anything interface for pdfgrep
4894 ;;  pdfgrep program <http://pdfgrep.sourceforge.net/>
4895 ;;  and a pdf-reader (e.g xpdf) are needed.
4896 ;;
4897 (defvar anything-c-pdfgrep-default-command "pdfgrep --color never -niH %s %s")
4898 (defvar anything-c-pdfgrep-default-function 'anything-c-pdfgrep-init)
4899 (defvar anything-c-pdfgrep-debug-command-line nil)
4900 (defcustom anything-c-pdfgrep-default-read-command "xpdf '%f' %p"
4901   "Default command to read pdf files from pdfgrep.
4902 Where '%f' format spec is filename and '%p' is page number"
4903   :group 'anything-config
4904   :type 'string)
4905
4906 (defun anything-c-pdfgrep-init (only-files)
4907   "Start an asynchronous pdfgrep process in ONLY-FILES list."
4908   (let* ((fnargs   (anything-c-grep-prepare-candidates
4909                     (if (file-remote-p anything-ff-default-directory)
4910                         (mapcar #'(lambda (x)
4911                                     (file-remote-p x 'localname))
4912                                 only-files)
4913                         only-files)))
4914          (cmd-line (format anything-c-pdfgrep-default-command
4915                            anything-pattern
4916                            fnargs)))
4917     (when anything-c-pdfgrep-debug-command-line
4918       (with-current-buffer (get-buffer-create "*any pdfgrep debug*")
4919         (goto-char (point-max))
4920         (insert (concat ">>> " cmd-line "\n\n"))))
4921     (setq mode-line-format
4922           '(" " mode-line-buffer-identification " "
4923             (line-number-mode "%l") " "
4924             (:eval (propertize "(Pdfgrep Process Running) "
4925                     'face '((:foreground "red"))))))
4926     (prog1
4927         (let ((default-directory anything-ff-default-directory))
4928           (start-file-process-shell-command "pdfgrep-process" nil cmd-line))
4929       (message nil)
4930       (set-process-sentinel
4931        (get-process "pdfgrep-process")
4932        #'(lambda (process event)
4933            (when (string= event "finished\n")
4934              (with-anything-window
4935                (anything-update-move-first-line))
4936              (force-mode-line-update nil)))))))
4937
4938
4939 (defun anything-do-pdfgrep-1 (only)
4940   "Launch pdfgrep with a list of ONLY files."
4941   (unless (executable-find "pdfgrep")
4942     (error "Error: No such program `pdfgrep'."))
4943   (let* ((anything-compile-source-functions
4944           ;; rule out anything-match-plugin because the input is one regexp.
4945           (delq 'anything-compile-source--match-plugin
4946                 (copy-sequence anything-compile-source-functions)))
4947          ;; Disable match-plugin and use here own highlighting.
4948          (anything-mp-highlight-delay nil))
4949     ;; When called as action from an other source e.g *-find-files
4950     ;; we have to kill action buffer.
4951     (when (get-buffer anything-action-buffer)
4952       (kill-buffer anything-action-buffer))
4953     ;; If `anything-find-files' haven't already started,
4954     ;; give a default value to `anything-ff-default-directory'.
4955     (setq anything-ff-default-directory (or anything-ff-default-directory
4956                                             default-directory))
4957     (anything
4958      :sources
4959      `(((name . "PdfGrep")
4960         (candidates
4961          . (lambda ()
4962              (funcall anything-c-pdfgrep-default-function only)))
4963         (filtered-candidate-transformer anything-c-grep-cand-transformer)
4964         (candidate-number-limit . 9999)
4965         (mode-line . anything-pdfgrep-mode-line-string)
4966         (action . anything-c-pdfgrep-action)
4967         (persistent-help . "Jump to PDF Page")
4968         (requires-pattern . 3)
4969         (delayed)))
4970      :keymap anything-c-pdfgrep-map
4971      :buffer "*anything grep*")))
4972
4973 (defvar anything-pdfgrep-mode-line-string
4974   "\\<anything-c-pdfgrep-map>\
4975 \\[anything-pdfgrep-help]:Help,\
4976 \\<anything-map>\
4977 \\[anything-select-action]:Acts,\
4978 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
4979 \\[anything-select-3rd-action]:NthAct,\
4980 \\[anything-send-bug-report-from-anything]:BugReport."
4981   "String displayed in mode-line in `anything-do-pdfgrep'.")
4982
4983 ;;;###autoload
4984 (defun anything-pdfgrep-help ()
4985   (interactive)
4986   (let ((anything-help-message "== Anything PdfGrep Map ==\
4987 \nSpecific commands for Pdf Grep:
4988 \\<anything-c-pdfgrep-map>
4989 \\[anything-c-goto-next-file]\t->Next File.
4990 \\[anything-c-goto-precedent-file]\t\t->Precedent File.
4991 \\[anything-yank-text-at-point]\t\t->Yank Text at point in minibuffer.
4992 \\[anything-pdfgrep-help]\t\t->Show this help.
4993 \n== Anything Map ==
4994 \\{anything-map}"))
4995     (anything-help)))
4996
4997 (defvar anything-c-pdfgrep-map
4998   (let ((map (copy-keymap anything-map)))
4999     (define-key map (kbd "M-<down>") 'anything-c-goto-next-file)
5000     (define-key map (kbd "M-<up>")   'anything-c-goto-precedent-file)
5001     (define-key map (kbd "C-w")      'anything-yank-text-at-point)
5002     (define-key map (kbd "C-c ?")    'anything-pdfgrep-help)
5003     map)
5004   "Keymap used in pdfgrep.")
5005
5006 (defun anything-c-pdfgrep-action (candidate)
5007   (let* ((split  (anything-c-grep-split-line candidate))
5008          (pageno (nth 1 split))
5009          (fname  (car split)))
5010     (start-file-process-shell-command
5011      "pdf-reader" nil
5012      (format-spec anything-c-pdfgrep-default-read-command
5013                   (list (cons ?f fname) (cons ?p pageno))))))
5014
5015 (defun anything-do-pdfgrep ()
5016   (interactive)
5017   (let ((only (anything-c-read-file-name
5018                "Search in file(s): "
5019                :marked-candidates t
5020                :test #'(lambda (file)
5021                          (or (string= (file-name-extension file) "pdf")
5022                              (string= (file-name-extension file) "PDF")
5023                              (file-directory-p file)))
5024                :preselect (or (dired-get-filename nil t)
5025                               (buffer-file-name (current-buffer)))))
5026         (anything-c-grep-default-function 'anything-c-pdfgrep-init))
5027     (anything-do-pdfgrep-1 only)))
5028
5029
5030 ;; Yank text at point.
5031 ;;
5032 (defvar anything-yank-point nil)
5033 ;;;###autoload
5034 (defun anything-yank-text-at-point ()
5035   "Yank text at point in minibuffer."
5036   (interactive)
5037   (let (input)
5038     (flet ((insert-in-minibuffer (word)
5039              (with-selected-window (minibuffer-window)
5040                (let ((str anything-pattern))
5041                  (delete-minibuffer-contents)
5042                  (set-text-properties 0 (length word) nil word)
5043                  (insert (concat str word))))))
5044       (with-current-buffer anything-current-buffer
5045         ;; Start to initial point if C-w have never been hit.
5046         (unless anything-yank-point (setq anything-yank-point (point)))
5047         (and anything-yank-point (goto-char anything-yank-point))
5048         (forward-word 1)
5049         (setq input (buffer-substring-no-properties anything-yank-point (point)))
5050         (setq anything-yank-point (point))) ; End of last forward-word
5051       (insert-in-minibuffer input))))
5052
5053 (defun anything-reset-yank-point ()
5054   (setq anything-yank-point nil))
5055
5056 (add-hook 'anything-after-persistent-action-hook 'anything-reset-yank-point)
5057 (add-hook 'anything-cleanup-hook 'anything-reset-yank-point)
5058 (define-key anything-map (kbd "C-w") 'anything-yank-text-at-point)
5059
5060 ;;; Etags
5061 ;;
5062 (eval-when-compile
5063   (when (locate-library "anything-etags.el")
5064     (display-warning
5065      '(anything-config)
5066      "You are using obsolete library `anything-etags.el' and should remove it."
5067      :warning)))
5068
5069 ;;;###autoload
5070 (defun anything-etags-help ()
5071   (interactive)
5072   (let ((anything-help-message "== Anything Etags Map ==\
5073 \nSpecific commands for Etags:
5074 \\<anything-c-etags-map>
5075 \\[anything-c-goto-next-file]\t->Next File.
5076 \\[anything-c-goto-precedent-file]\t\t->Precedent File.
5077 \\[anything-yank-text-at-point]\t\t->Yank Text at point in minibuffer.
5078 \\[anything-etags-help]\t\t->Show this help.
5079 \n== Anything Map ==
5080 \\{anything-map}"))
5081     (anything-help)))
5082
5083 (defvar anything-c-etags-map
5084   (let ((map (copy-keymap anything-map)))
5085     (define-key map (kbd "M-<down>") 'anything-c-goto-next-file)
5086     (define-key map (kbd "M-<up>")   'anything-c-goto-precedent-file)
5087     (define-key map (kbd "C-w")      'anything-yank-text-at-point)
5088     (define-key map (kbd "C-c ?")    'anything-etags-help)
5089     map)
5090   "Keymap used in Etags.")
5091
5092 (defcustom anything-c-etags-tag-file-name "TAGS"
5093   "Etags tag file name."
5094   :type 'string
5095   :group 'anything-config)
5096
5097 (defcustom anything-c-etags-tag-file-search-limit 10
5098   "The limit level of directory to search tag file.
5099 Don't search tag file deeply if outside this value."
5100   :type 'number
5101   :group 'anything-config)
5102
5103 (defvar anything-c-etags-tag-file-dir nil
5104   "Etags file directory.")
5105 (defvar anything-c-etags-mtime-alist nil)
5106 (defvar anything-c-etags-cache (make-hash-table :test 'equal))
5107
5108 (defun anything-c-etags-get-tag-file ()
5109   "Get Etags tag file."
5110   ;; Get tag file from `default-directory' or upper directory.
5111   (let ((current-dir (anything-c-etags-find-tag-file default-directory)))
5112     ;; Return nil if not find tag file.
5113     (when current-dir
5114       (setq anything-c-etags-tag-file-dir current-dir) ;set tag file directory
5115       (expand-file-name anything-c-etags-tag-file-name current-dir))))
5116
5117 (defun anything-c-etags-find-tag-file (current-dir)
5118   "Find tag file.
5119 Try to find tag file in upper directory if haven't found in CURRENT-DIR."
5120   (flet ((file-exists? (dir)
5121            (let ((tag-path (expand-file-name anything-c-etags-tag-file-name dir)))
5122              (and (stringp tag-path)
5123                   (file-exists-p tag-path)
5124                   (file-readable-p tag-path)))))
5125     (loop with count = 0
5126        until (file-exists? current-dir)
5127        ;; Return nil if outside the value of
5128        ;; `anything-c-etags-tag-file-search-limit'.
5129        if (= count anything-c-etags-tag-file-search-limit)
5130        do (return nil)
5131        ;; Or search upper directories.
5132        else
5133        do (incf count)
5134          (setq current-dir (expand-file-name (concat current-dir "../")))
5135        finally return current-dir)))
5136
5137 (defun anything-c-source-etags-header-name (x)
5138   (concat "Etags in "
5139           (with-current-buffer anything-current-buffer
5140             (anything-c-etags-get-tag-file))
5141           " (C-c ? Help)"))
5142
5143 (defmacro anything-c-etags-create-buffer (file)
5144   `(let* ((tag-fname ,file)
5145           max
5146           (split (with-current-buffer (find-file-noselect tag-fname)
5147                    (prog1
5148                        (split-string (buffer-string) "\n" 'omit-nulls)
5149                      (setq max (line-number-at-pos (point-max)))
5150                      (kill-buffer))))
5151           (progress-reporter (make-progress-reporter "Loading tag file..." 0 max)))
5152      (loop
5153         with fname
5154         with cand
5155         for i in split for count from 0
5156         for elm = (unless (string-match "^\x0c" i)
5157                     (anything-aif (string-match "\177" i)
5158                         (substring i 0 it)
5159                       i))
5160         do (cond ((and elm (string-match "^\\(.+\\),[0-9]+" elm))
5161                   (setq fname (match-string 1 elm)))
5162                  (elm (setq cand (concat fname ": " elm)))
5163                  (t (setq cand nil)))
5164         when cand do (progn
5165                        (insert (concat cand "\n"))
5166                        (progress-reporter-update progress-reporter count)))))
5167
5168 (defun anything-c-etags-init ()
5169   (let ((tagfile (anything-c-etags-get-tag-file)))
5170     (when tagfile
5171       (with-current-buffer (anything-candidate-buffer 'global)
5172        (anything-aif (gethash tagfile anything-c-etags-cache)
5173            (insert it)
5174          (anything-c-etags-create-buffer tagfile)
5175          (puthash tagfile (buffer-string) anything-c-etags-cache)
5176          (anything-aif (assoc tagfile anything-c-etags-mtime-alist)
5177              ;; If an entry exists modify it.
5178              (setcdr it (anything-c-etags-mtime tagfile))
5179            ;; No entry create a new one.
5180            (add-to-list 'anything-c-etags-mtime-alist
5181                         (cons tagfile (anything-c-etags-mtime tagfile)))))))))
5182
5183 (defvar anything-c-source-etags-select
5184   '((name . "Etags")
5185     (header-name . anything-c-source-etags-header-name)
5186     (init . anything-c-etags-init)
5187     (candidates-in-buffer)
5188     (mode-line . anything-ff-mode-line-string)
5189     (action . anything-c-etags-default-action)
5190     (persistent-action . (lambda (candidate)
5191                            (anything-c-etags-default-action candidate)
5192                            (anything-match-line-color-current-line)))))
5193
5194 (defun anything-c-etags-default-action (candidate)
5195   (let* ((split (split-string candidate ": "))
5196          (fname (expand-file-name
5197                  (car split) anything-c-etags-tag-file-dir))
5198          (elm   (cadr split)))
5199     (find-file fname)
5200     (goto-char (point-min))
5201     (search-forward elm nil t)
5202     (goto-char (match-beginning 0))))
5203
5204 (defun anything-c-etags-select (arg)
5205   "Preconfigured anything for etags.
5206 Called with one prefix arg use symbol at point as initial input.
5207 Called with two prefix arg reinitialize cache.
5208 If tag file have been modified reinitialize cache."
5209   (interactive "P")
5210   (let ((tag  (anything-c-etags-get-tag-file))
5211         (init (and (equal arg '(4)) (thing-at-point 'symbol)))
5212         (anything-quit-if-no-candidate t)
5213         (anything-execute-action-at-once-if-one t))
5214     (when (or (equal arg '(16))
5215               (and anything-c-etags-mtime-alist
5216                    (anything-c-etags-file-modified-p tag)))
5217       (remhash tag anything-c-etags-cache))
5218     (if (and tag (file-exists-p tag))
5219         (anything :sources 'anything-c-source-etags-select
5220                   :keymap anything-c-etags-map
5221                   :input init
5222                   :buffer "*anything etags*")
5223         (message "Error: No tag file found, please create one with etags shell command."))))
5224
5225 (defun anything-c-etags-mtime (file)
5226   "Last modification time of FILE."
5227   (cadr (nth 5 (file-attributes file))))
5228
5229 (defun anything-c-etags-file-modified-p (file)
5230   "Check if tag FILE have been modified in this session.
5231 If FILE is nil return nil."
5232   (let ((last-modif (and file
5233                          (assoc-default file anything-c-etags-mtime-alist))))
5234     (and last-modif
5235          (/= last-modif (anything-c-etags-mtime file)))))
5236
5237 ;;; Recentf files
5238 (defvar anything-c-source-recentf
5239   '((name . "Recentf")
5240     (init . (lambda ()
5241               (require 'recentf)
5242               (or recentf-mode (recentf-mode 1))
5243               ;; Big value empowers anything/recentf
5244               (when (and (numberp recentf-max-saved-items)
5245                          (<= recentf-max-saved-items 20))
5246                 (setq recentf-max-saved-items 500))))
5247     (candidates . recentf-list)
5248     (match anything-c-match-on-file-name
5249      anything-c-match-on-directory-name)
5250     (type . file))
5251   "See (info \"(emacs)File Conveniences\").
5252 if `recentf-max-saved-items' is too small, set it to 500.")
5253 ;; (anything 'anything-c-source-recentf)
5254
5255 ;;; ffap
5256 (eval-when-compile (require 'ffap))
5257 (defvar anything-c-source-ffap-guesser
5258   '((name . "File at point")
5259     (init . (lambda () (require 'ffap)))
5260     (candidates . (lambda ()
5261                     (anything-aif
5262                         (with-current-buffer anything-current-buffer
5263                           (ffap-guesser))
5264                         (list it))))
5265     (type . file)))
5266 ;; (anything 'anything-c-source-ffap-guesser)
5267
5268 ;;; ffap with line number
5269 (defun anything-c-ffap-file-line-at-point ()
5270   "Get (FILENAME . LINENO) at point."
5271   (anything-aif (let (ffap-alist) (ffap-file-at-point))
5272       (save-excursion
5273         (beginning-of-line)
5274         (when (and (search-forward it nil t)
5275                    (looking-at ":\\([0-9]+\\)"))
5276           (cons it (string-to-number (match-string 1)))))))
5277
5278 (defvar anything-c-ffap-line-location nil
5279   "(FILENAME . LINENO) used by `anything-c-source-ffap-line'.
5280 It is cleared after jumping line.")
5281
5282 (defun anything-c-ffap-line-candidates ()
5283   (with-current-buffer anything-current-buffer
5284     (setq anything-c-ffap-line-location (anything-c-ffap-file-line-at-point)))
5285   (when anything-c-ffap-line-location
5286     (destructuring-bind (file . line) anything-c-ffap-line-location
5287       (list (cons (format "%s (line %d)" file line) file)))))
5288
5289 ;;; Goto line after opening file by `anything-c-source-ffap-line'.
5290 (defun anything-c-ffap-line-goto-line ()
5291   (when (car anything-c-ffap-line-location)
5292     (unwind-protect
5293          (ignore-errors
5294            (with-selected-window
5295                (get-buffer-window
5296                 (get-file-buffer (car anything-c-ffap-line-location)))
5297              (anything-goto-line (cdr anything-c-ffap-line-location)))))))
5298 (add-hook 'anything-after-action-hook 'anything-c-ffap-line-goto-line)
5299 (add-hook 'anything-after-persistent-action-hook 'anything-c-ffap-line-goto-line)
5300
5301 (defvar anything-c-source-ffap-line
5302   '((name . "File/Lineno at point")
5303     (init . (lambda () (require 'ffap)))
5304     (candidates . anything-c-ffap-line-candidates)
5305     (type . file)))
5306 ;; (anything 'anything-c-source-ffap-line)
5307
5308 ;;; list of files gleaned from every dired buffer
5309 (defun anything-c-files-in-all-dired-candidates ()
5310   (save-excursion
5311     (mapcan
5312      (lambda (dir)
5313        (cond ((listp dir)               ;filelist
5314               dir)
5315              ((equal "" (file-name-nondirectory dir)) ;dir
5316               (directory-files dir t))
5317              (t                         ;wildcard
5318               (file-expand-wildcards dir t))))
5319      (delq nil
5320            (mapcar (lambda (buf)
5321                      (set-buffer buf)
5322                      (when (eq major-mode 'dired-mode)
5323                        (if (consp dired-directory)
5324                            (cdr dired-directory) ;filelist
5325                            dired-directory))) ;dir or wildcard
5326                    (buffer-list))))))
5327 ;; (dired '("~/" "~/.emacs-custom.el" "~/.emacs.bmk"))
5328
5329 (defvar anything-c-source-files-in-all-dired
5330   '((name . "Files in all dired buffer.")
5331     (candidates . anything-c-files-in-all-dired-candidates)
5332     (type . file)))
5333 ;; (anything 'anything-c-source-files-in-all-dired)
5334
5335 (defcustom anything-c-filelist-file-name nil
5336   "*Filename of file list.
5337 Accept a list of string for multiple files.
5338
5339 This file tend to be very large (> 100MB) and recommend to be in ramdisk for speed.
5340 File list is created by make-filelist.rb script.
5341
5342 Usage:
5343   ruby make-filelist.rb > /tmp/all.filelist
5344
5345 Then
5346  ;; Assume that /tmp is ramdisk or tmpfs
5347  (setq anything-grep-candidates-fast-directory-regexp \"^/tmp/\")
5348  (setq anything-c-filelist-file-name \"/tmp/all.filelist\")
5349 "
5350   :type 'string
5351   :group 'anything-config)
5352 (defvar anything-c-source-filelist
5353   '((name . "FileList")
5354     (grep-candidates . anything-c-filelist-file-name)
5355     (candidate-number-limit . 200)
5356     (requires-pattern . 4)
5357     (type . file))
5358   "Source to find files instantly.
5359 See `anything-c-filelist-file-name' docstring for usage.")
5360
5361 ;;;###autoload
5362 (defun anything-filelist ()
5363   "Preconfigured `anything' to open files instantly.
5364
5365 See `anything-c-filelist-file-name' docstring for usage."
5366   (interactive)
5367   (anything-other-buffer 'anything-c-source-filelist "*anything file list*"))
5368
5369 ;;;###autoload
5370 (defun anything-filelist+ ()
5371   "Preconfigured `anything' to open files/buffers/bookmarks instantly.
5372
5373 This is a replacement for `anything-for-files'.
5374 See `anything-c-filelist-file-name' docstring for usage."
5375   (interactive)
5376   (anything-other-buffer
5377    '(anything-c-source-ffap-line
5378      anything-c-source-ffap-guesser
5379      anything-c-source-buffers+
5380      anything-c-source-recentf
5381      anything-c-source-bookmarks
5382      anything-c-source-file-cache
5383      anything-c-source-filelist)
5384    "*anything file list*"))
5385
5386
5387 ;;;; <info>
5388 ;;; Info pages
5389 (defvar anything-c-info-pages nil
5390   "All info pages on system.
5391 Will be calculated the first time you invoke anything with this
5392 source.")
5393
5394 (defvar anything-c-source-info-pages
5395   `((name . "Info Pages")
5396     (candidates
5397      . (lambda ()
5398          (if anything-c-info-pages
5399              anything-c-info-pages
5400              (setq anything-c-info-pages
5401                    (save-window-excursion
5402                      (save-excursion
5403                        (require 'info)
5404                        (Info-find-node "dir" "top")
5405                        (goto-char (point-min))
5406                        (let ((info-topic-regexp "\\* +\\([^:]+: ([^)]+)[^.]*\\)\\.")
5407                              topics)
5408                          (while (re-search-forward info-topic-regexp nil t)
5409                            (add-to-list 'topics (match-string-no-properties 1)))
5410                          (goto-char (point-min))
5411                          (Info-exit)
5412                          topics)))))))
5413     (action . (("Show with Info" .(lambda (node-str)
5414                                     (info (replace-regexp-in-string
5415                                            "^[^:]+: " "" node-str))))))
5416     (requires-pattern . 2)))
5417 ;; (anything 'anything-c-source-info-pages)
5418
5419
5420 ;; FIXME should be merged in anything.el with `anything-describe-anything-attribute'.
5421 (defun anything-c-describe-attributes (anything-attribute)
5422   "Display the full documentation of ANYTHING-ATTRIBUTE (a symbol).
5423 Same as `anything-describe-anything-attribute' but with anything completion."
5424   (interactive (list (intern
5425                       (anything-comp-read
5426                        "Describe anything attribute: "
5427                        (mapcar 'symbol-name anything-additional-attributes)
5428                        :must-match t
5429                        :persistent-action
5430                        #'(lambda (candidate)
5431                            (with-output-to-temp-buffer "*Help*"
5432                              (princ (get (intern candidate) 'anything-attrdoc))))))))
5433   (with-output-to-temp-buffer "*Help*"
5434     (princ (get anything-attribute 'anything-attrdoc))))
5435
5436 ;;; Use info-index plug-in. Note that `name' attribute is
5437 ;;; not needed but `anything-c-insert-summary' uses it.
5438 ;; Info Elisp
5439 (defvar anything-c-source-info-elisp
5440   '((name . "Info index: elisp")
5441     (info-index . "elisp")))
5442 ;; (anything 'anything-c-source-info-elisp)
5443
5444 ;; Info-Common-Lisp
5445 (defvar anything-c-source-info-cl
5446   '((name . "Info index: cl")
5447     (info-index . "cl")))
5448 ;; (anything 'anything-c-source-info-cl)
5449
5450 ;; Info Index org
5451 (defvar anything-c-source-info-org
5452   '((name . "Info index: org")
5453     (info-index . "org")))
5454 ;; (anything 'anything-c-source-info-org)
5455
5456 ;; Info Index ratpoison
5457 (defvar anything-c-source-info-ratpoison
5458   '((name . "Info index: ratpoison")
5459     (info-index . "ratpoison")))
5460 ;; (anything 'anything-c-source-info-ratpoison)
5461
5462 ;; Info Index zsh
5463 (defvar anything-c-source-info-zsh
5464   '((name . "Info index: zsh")
5465     (info-index . "zsh")))
5466 ;; (anything 'anything-c-source-info-zsh)
5467
5468 ;; Info Index bash
5469 (defvar anything-c-source-info-bash
5470   '((name . "Info index: bash")
5471     (info-index . "bash")))
5472 ;; (anything 'anything-c-source-info-bash)
5473
5474 ;; Info Index coreutils
5475 (defvar anything-c-source-info-coreutils
5476   '((name . "Info index: coreutils")
5477     (info-index . "coreutils")))
5478 ;; (anything 'anything-c-source-info-coreutils)
5479
5480 ;; Info Index fileutils
5481 (defvar anything-c-source-info-fileutils
5482   '((name . "Info index: fileutils")
5483     (info-index . "fileutils")))
5484 ;; (anything 'anything-c-source-info-fileutils)
5485
5486 ;; Info Index find
5487 (defvar anything-c-source-info-find
5488   '((name . "Info index: find")
5489     (info-index . "find")))
5490 ;; (anything 'anything-c-source-info-find)
5491
5492 ;; Info Index sh-utils
5493 (defvar anything-c-source-info-sh-utils
5494   '((name . "Info index: sh-utils")
5495     (info-index . "sh-utils")))
5496 ;; (anything 'anything-c-source-info-sh-utils)
5497
5498 ;; Info Index textutils
5499 (defvar anything-c-source-info-textutils
5500   '((name . "Info index: textutils")
5501     (info-index . "textutils")))
5502 ;; (anything 'anything-c-source-info-textutils)
5503
5504 ;; Info Index libc
5505 (defvar anything-c-source-info-libc
5506   '((name . "Info index: libc")
5507     (info-index . "libc")))
5508 ;; (anything 'anything-c-source-info-libc)
5509
5510 ;; Info Index make
5511 (defvar anything-c-source-info-make
5512   '((name . "Info index: make")
5513     (info-index . "make")))
5514 ;; (anything 'anything-c-source-info-make)
5515
5516 ;; Info Index automake
5517 (defvar anything-c-source-info-automake
5518   '((name . "Info index: automake")
5519     (info-index . "automake")))
5520 ;; (anything 'anything-c-source-info-automake)
5521
5522 ;; Info Index autoconf
5523 (defvar anything-c-source-info-autoconf
5524   '((name . "Info index: autoconf")
5525     (info-index . "autoconf")))
5526 ;; (anything 'anything-c-source-info-autoconf)
5527
5528 ;; Info Index emacs-lisp-intro
5529 (defvar anything-c-source-info-emacs-lisp-intro
5530   '((name . "Info index: emacs-lisp-intro")
5531     (info-index . "emacs-lisp-intro")))
5532 ;; (anything 'anything-c-source-info-emacs-lisp-intro)
5533
5534 ;; Info Index emacs
5535 (defvar anything-c-source-info-emacs
5536   '((name . "Info index: emacs")
5537     (info-index . "emacs")))
5538 ;; (anything 'anything-c-source-info-emacs)
5539
5540 ;; Info Index elib
5541 (defvar anything-c-source-info-elib
5542   '((name . "Info index: elib")
5543     (info-index . "elib")))
5544 ;; (anything 'anything-c-source-info-elib)
5545
5546 ;; Info Index eieio
5547 (defvar anything-c-source-info-eieio
5548   '((name . "Info index: eieio")
5549     (info-index . "eieio")))
5550 ;; (anything 'anything-c-source-info-eieio)
5551
5552 ;; Info Index gauche-refe
5553 (defvar anything-c-source-info-gauche-refe
5554   '((name . "Info index: gauche")
5555     (info-index . "gauche-refe")))
5556 ;; (anything 'anything-c-source-info-gauche-refe)
5557
5558 ;; Info Index guile
5559 (defvar anything-c-source-info-guile
5560   '((name . "Info index: guile")
5561     (info-index . "guile")))
5562 ;; (anything 'anything-c-source-info-guile)
5563
5564 ;; Info Index guile-tut
5565 (defvar anything-c-source-info-guile-tut
5566   '((name . "Info index: guile-tut")
5567     (info-index . "guile-tut")))
5568 ;; (anything 'anything-c-source-info-guile-tut)
5569
5570 ;; Info Index goops
5571 (defvar anything-c-source-info-goops
5572   '((name . "Info index: goops")
5573     (info-index . "goops")))
5574 ;; (anything 'anything-c-source-info-goops)
5575
5576 ;; Info Index screen
5577 (defvar anything-c-source-info-screen
5578   '((name . "Info index: screen")
5579     (info-index . "screen")
5580     (index-nodes "Concept Index" "Command Index" "Keystroke Index")))
5581 ;; (anything 'anything-c-source-info-screen)
5582
5583 ;; Info Index latex
5584 (defvar anything-c-source-info-latex
5585   '((name . "Info index: latex")
5586     (info-index . "latex")))
5587 ;; (anything 'anything-c-source-info-latex)
5588
5589 ;; Info Index gawk
5590 (defvar anything-c-source-info-gawk
5591   '((name . "Info index: gawk")
5592     (info-index . "gawk")))
5593 ;; (anything 'anything-c-source-info-gawk)
5594
5595 ;; Info Index sed
5596 (defvar anything-c-source-info-sed
5597   '((name . "Info index: sed")
5598     (info-index . "sed")))
5599 ;; (anything 'anything-c-source-info-sed)
5600
5601 ;; Info Index m4
5602 (defvar anything-c-source-info-m4
5603   '((name . "Info index: m4")
5604     (info-index . "m4")))
5605 ;; (anything 'anything-c-source-info-m4)
5606
5607 ;; Info Index wget
5608 (defvar anything-c-source-info-wget
5609   '((name . "Info index: wget")
5610     (info-index . "wget")))
5611 ;; (anything 'anything-c-source-info-wget)
5612
5613 ;; Info Index binutils
5614 (defvar anything-c-source-info-binutils
5615   '((name . "Info index: binutils")
5616     (info-index . "binutils")))
5617 ;; (anything 'anything-c-source-info-binutils)
5618
5619 ;; Info Index as
5620 (defvar anything-c-source-info-as
5621   '((name . "Info index: as")
5622     (info-index . "as")))
5623 ;; (anything 'anything-c-source-info-as)
5624
5625 ;; Info Index bfd
5626 (defvar anything-c-source-info-bfd
5627   '((name . "Info index: bfd")
5628     (info-index . "bfd")))
5629 ;; (anything 'anything-c-source-info-bfd)
5630
5631 ;; Info Index gprof
5632 (defvar anything-c-source-info-gprof
5633   '((name . "Info index: gprof")
5634     (info-index . "gprof")))
5635 ;; (anything 'anything-c-source-info-gprof)
5636
5637 ;; Info Index ld
5638 (defvar anything-c-source-info-ld
5639   '((name . "Info index: ld")
5640     (info-index . "ld")))
5641 ;; (anything 'anything-c-source-info-ld)
5642
5643 ;; Info Index diff
5644 (defvar anything-c-source-info-diff
5645   '((name . "Info index: diff")
5646     (info-index . "diff")))
5647 ;; (anything 'anything-c-source-info-diff)
5648
5649 ;; Info Index flex
5650 (defvar anything-c-source-info-flex
5651   '((name . "Info index: flex")
5652     (info-index . "flex")))
5653 ;; (anything 'anything-c-source-info-flex)
5654
5655 ;; Info Index grep
5656 (defvar anything-c-source-info-grep
5657   '((name . "Info index: grep")
5658     (info-index . "grep")))
5659 ;; (anything 'anything-c-source-info-grep)
5660
5661 ;; Info Index gzip
5662 (defvar anything-c-source-info-gzip
5663   '((name . "Info index: gzip")
5664     (info-index . "gzip")))
5665 ;; (anything 'anything-c-source-info-gzip)
5666
5667 ;; Info Index libtool
5668 (defvar anything-c-source-info-libtool
5669   '((name . "Info index: libtool")
5670     (info-index . "libtool")))
5671 ;; (anything 'anything-c-source-info-libtool)
5672
5673 ;; Info Index texinfo
5674 (defvar anything-c-source-info-texinfo
5675   '((name . "Info index: texinfo")
5676     (info-index . "texinfo")))
5677 ;; (anything 'anything-c-source-info-texinfo)
5678
5679 ;; Info Index info
5680 (defvar anything-c-source-info-info
5681   '((name . "Info index: info")
5682     (info-index . "info")))
5683 ;; (anything 'anything-c-source-info-info)
5684
5685 ;; Info Index gdb
5686 (defvar anything-c-source-info-gdb
5687   '((name . "Info index: gdb")
5688     (info-index . "gdb")))
5689 ;; (anything 'anything-c-source-info-gdb)
5690
5691 ;; Info Index stabs
5692 (defvar anything-c-source-info-stabs
5693   '((name . "Info index: stabs")
5694     (info-index . "stabs")))
5695 ;; (anything 'anything-c-source-info-stabs)
5696
5697 ;; Info Index cvsbook
5698 (defvar anything-c-source-info-cvsbook
5699   '((name . "Info index: cvsbook")
5700     (info-index . "cvsbook")))
5701 ;; (anything 'anything-c-source-info-cvsbook)
5702
5703 ;; Info Index cvs
5704 (defvar anything-c-source-info-cvs
5705   '((name . "Info index: cvs")
5706     (info-index . "cvs")))
5707 ;; (anything 'anything-c-source-info-cvs)
5708
5709 ;; Info Index bison
5710 (defvar anything-c-source-info-bison
5711   '((name . "Info index: bison")
5712     (info-index . "bison")))
5713 ;; (anything 'anything-c-source-info-bison)
5714
5715 ;; Info Index id-utils
5716 (defvar anything-c-source-info-id-utils
5717   '((name . "Info index: id-utils")
5718     (info-index . "id-utils")))
5719 ;; (anything 'anything-c-source-info-id-utils)
5720
5721 ;; Info Index global
5722 (defvar anything-c-source-info-global
5723   '((name . "Info index: global")
5724     (info-index . "global")))
5725 ;; (anything 'anything-c-source-info-global)
5726
5727 ;;;; <Help>
5728 ;;; Man Pages
5729 (defvar anything-c-man-pages nil
5730   "All man pages on system.
5731 Will be calculated the first time you invoke anything with this
5732 source.")
5733
5734 (defun anything-c-man-default-action (candidate)
5735   "Default action for jumping to a woman or man page from anything."
5736   (let ((wfiles (woman-file-name-all-completions candidate)))
5737     (condition-case err
5738         (if (> (length wfiles) 1)
5739             (woman-find-file
5740              (anything-comp-read
5741               "ManFile: " wfiles :must-match t))
5742             (woman candidate))
5743             ;; If woman is unable to format correctly
5744             ;; use man instead.
5745       (error (kill-buffer) ; Kill woman buffer.
5746              (let ((Man-notify-method 'meek))
5747                (Man-getpage-in-background candidate))))))
5748
5749 (defvar anything-c-source-man-pages
5750   `((name . "Manual Pages")
5751     (candidates . (lambda ()
5752                     (if anything-c-man-pages
5753                         anything-c-man-pages
5754                         ;; XEmacs doesn't have a woman :)
5755                         (setq anything-c-man-pages
5756                               (ignore-errors
5757                                 (require 'woman)
5758                                 (woman-file-name "")
5759                                 (sort (mapcar 'car woman-topic-all-completions)
5760                                       'string-lessp))))))
5761     (action  ("Show with Woman" . anything-c-man-default-action))
5762     ;; Woman does not work OS X
5763     ;; http://xahlee.org/emacs/modernization_man_page.html
5764     (action-transformer . (lambda (actions candidate)
5765                             (if (eq system-type 'darwin)
5766                                 '(("Show with Man" . man))
5767                                 actions)))
5768     (requires-pattern . 2)))
5769 ;; (anything 'anything-c-source-man-pages)
5770
5771 ;;;; <Command>
5772 ;;; Complex command history
5773 (defvar anything-c-source-complex-command-history
5774   '((name . "Complex Command History")
5775     (candidates . (lambda () (mapcar 'prin1-to-string command-history)))
5776     (type . sexp)))
5777 ;; (anything 'anything-c-source-complex-command-history)
5778
5779 ;;; M-x history
5780 (defvar anything-c-source-extended-command-history
5781   '((name . "Emacs Commands History")
5782     (candidates . extended-command-history)
5783     (type . command)))
5784 ;; (anything 'anything-c-source-extended-command-history)
5785
5786 ;;; Emacs commands
5787 (defvar anything-c-source-emacs-commands
5788   '((name . "Emacs Commands")
5789     (candidates . (lambda ()
5790                     (let (commands)
5791                       (mapatoms (lambda (a)
5792                                   (if (commandp a)
5793                                       (push (symbol-name a)
5794                                             commands))))
5795                       (sort commands 'string-lessp))))
5796     (type . command)
5797     (requires-pattern . 2))
5798   "Source for completing and invoking Emacs commands.
5799 A command is a function with interactive spec that can
5800 be invoked with `M-x'.
5801
5802 To get non-interactive functions listed, use
5803 `anything-c-source-emacs-functions'.")
5804 ;; (anything 'anything-c-source-emacs-commands)
5805
5806 ;;; Anything M-x
5807
5808 ;; Another replacement of `M-x' that act exactly like the
5809 ;; vanilla Emacs one, no problem of windows configuration, prefix args
5810 ;; can be passed before calling `M-x' (e.g C-u M-x..) but also during
5811 ;; anything invocation.
5812 ;;;###autoload
5813 (defun anything-M-x ()
5814   "Preconfigured `anything' for Emacs commands.
5815 It is `anything' replacement of regular `M-x' `execute-extended-command'."
5816   (interactive)
5817   (let* (in-help
5818          help-cand
5819          anything-persistent-action-use-special-display
5820          (history (loop with hist
5821                      for i in extended-command-history
5822                      for com = (intern i)
5823                      when (and (fboundp com) (not (member i hist)))
5824                      collect i into hist finally return hist))
5825          (command (anything-comp-read
5826                    "M-x " obarray
5827                    :test 'commandp
5828                    :must-match t
5829                    :requires-pattern 2
5830                    :name "Emacs Commands"
5831                    :persistent-action
5832                    #'(lambda (candidate)
5833                        (let ((hbuf (get-buffer (help-buffer))))
5834                          (if (and in-help (string= candidate help-cand))
5835                              (progn
5836                                ;; When M-x is started from a help buffer,
5837                                ;; Don't kill it as it is anything-current-buffer.
5838                                (unless (equal hbuf anything-current-buffer)
5839                                  (kill-buffer hbuf))
5840                                (setq in-help nil))
5841                              ;; Be sure anything-current-buffer have not a dedicated window.
5842                              (set-window-dedicated-p
5843                               (get-buffer-window anything-current-buffer) nil)
5844                              (describe-function (intern candidate))
5845                              (message nil) ; Erase the new stupid message Type "q"[...]
5846                              (setq in-help t))
5847                          (setq help-cand candidate)))
5848                    :persistent-help "Describe this command"
5849                    :history history
5850                    :sort 'string-lessp
5851                    :fc-transformer 'anything-M-x-transformer)))
5852     (unless current-prefix-arg (setq current-prefix-arg anything-current-prefix-arg))
5853     (call-interactively (intern command))
5854     (setq extended-command-history (cons command (delete command history)))))
5855
5856 (defun* anything-M-x-get-major-mode-command-alist (mode-map)
5857   "Return alist of MODE-MAP."
5858   (loop for key being the key-seqs of mode-map using (key-bindings com)
5859      for str-key  = (key-description key)
5860      for ismenu   = (string-match "<menu-bar>" str-key)
5861      unless ismenu collect (cons str-key com)))
5862
5863 (defun anything-get-mode-map-from-mode (mode)
5864   "Guess the mode-map name according to MODE.
5865 Some modes don't use conventional mode-map name
5866 so we need to guess mode-map name. e.g python-mode ==> py-mode-map.
5867 Return nil if no mode-map found."
5868   (loop
5869      ;; Start with a conventional mode-map name.
5870      with mode-map    = (intern-soft (format "%s-map" mode))
5871      with mode-string = (symbol-name mode)
5872      with mode-name   = (replace-regexp-in-string "-mode" "" mode-string)
5873      while (not mode-map)
5874      for count downfrom (length mode-name)
5875      ;; Return when no result after parsing entire string.
5876      when (eq count 0) return nil
5877      for sub-name = (substring mode-name 0 count)
5878      do (setq mode-map (intern-soft (format "%s-map" (concat sub-name "-mode"))))
5879      finally return mode-map))
5880
5881 (defun anything-M-x-current-mode-map-alist ()
5882   "Return mode-map alist of current `major-mode'."
5883   (let ((map (anything-get-mode-map-from-mode major-mode)))
5884     (when (and map (boundp map))
5885       (anything-M-x-get-major-mode-command-alist (symbol-value map)))))
5886
5887 (defface anything-M-x-key-face '((t (:foreground "orange" :underline t)))
5888   "*Face used in anything-M-x to show keybinding."
5889   :group 'anything)
5890
5891 (defun anything-M-x-transformer (candidates sources)
5892   "filtered-candidate-transformer to show bindings in emacs commands.
5893 Show global bindings and local bindings according to current `major-mode'."
5894   (with-current-buffer anything-current-buffer
5895     (loop
5896        with local-map = (anything-M-x-current-mode-map-alist)
5897        for cand in candidates
5898        for local-key  = (car (rassq cand local-map))
5899        for key        = (substitute-command-keys (format "\\[%s]" cand))
5900        collect
5901          (cons (cond ((and (string-match "^M-x" key) local-key)
5902                       (format "%s (%s)"
5903                               cand (propertize
5904                                     local-key
5905                                     'face 'anything-M-x-key-face)))
5906                      ((string-match "^M-x" key) cand)
5907                      (t (format "%s (%s)"
5908                                 cand (propertize
5909                                       key
5910                                       'face 'anything-M-x-key-face)))) cand))))
5911
5912 ;;; LaCarte
5913 (defvar anything-c-source-lacarte
5914   '((name . "Lacarte")
5915     (init . (lambda () (require 'lacarte )))
5916     (candidates . (lambda () (delete '(nil) (lacarte-get-overall-menu-item-alist))))
5917     (candidate-number-limit . 9999)
5918     (action . anything-c-call-interactively))
5919   "Needs lacarte.el.
5920
5921 http://www.emacswiki.org/cgi-bin/wiki/download/lacarte.el")
5922 ;; (anything 'anything-c-source-lacarte)
5923
5924 ;;;; <Function>
5925 ;;; Emacs functions
5926 (defvar anything-c-source-emacs-functions
5927   '((name . "Emacs Functions")
5928     (candidates . (lambda ()
5929                     (let (commands)
5930                       (mapatoms (lambda (a)
5931                                   (if (functionp a)
5932                                       (push (symbol-name a) commands))))
5933                       (sort commands 'string-lessp))))
5934     (type . function)
5935     (requires-pattern . 2))
5936   "Source for completing Emacs functions.")
5937 ;; (anything 'anything-c-source-emacs-functions)
5938
5939 ;;; With abbrev expansion
5940 ;;; Similar to my exec-abbrev-cmd.el
5941 ;;; See http://www.tsdh.de/cgi-bin/wiki.pl/exec-abbrev-cmd.el
5942 (defvar anything-c-function-abbrev-regexp nil
5943   "The regexp for `anything-c-source-emacs-functions-with-abbrevs'.
5944 Regexp built from the current `anything-pattern' interpreting it
5945 as abbreviation.
5946 Only for internal use.")
5947
5948 (defun anything-c-match-function-by-abbrev (candidate)
5949   "Return non-nil if `anything-pattern' is an abbreviation of the function CANDIDATE.
5950
5951 Abbreviations are made by taking the first character from each
5952 word in the function's name, e.g. \"bb\" is an abbrev for
5953 `bury-buffer', \"stb\" is an abbrev for `anything-c-switch-to-buffer'."
5954   (string-match anything-c-function-abbrev-regexp candidate))
5955
5956 (defvar anything-c-source-emacs-functions-with-abbrevs
5957   (append anything-c-source-emacs-functions
5958           '((match anything-c-match-function-by-abbrev
5959              anything-c-string-match))
5960           '((init
5961              . (lambda ()
5962                  (defadvice anything-update
5963                      (before anything-c-update-function-abbrev-regexp activate)
5964                    (let ((char-list (append anything-pattern nil))
5965                          (str "^"))
5966                      (dolist (c char-list)
5967                        (setq str (concat str (list c) "[^-]*-")))
5968                      (setq str (concat (substring str 0 (1- (length str))) "$"))
5969                      (setq anything-c-function-abbrev-regexp str))))))))
5970 ;; (anything 'anything-c-source-emacs-functions-with-abbrevs)
5971
5972 (defvar anything-c-source-advice
5973   '((name . "Function Advice")
5974     (candidates . anything-c-advice-candidates)
5975     (action ("Toggle Enable/Disable" . anything-c-advice-toggle))
5976     ;;    (real-to-display . anything-c-advice-real-to-display)
5977     (persistent-action . anything-c-advice-persistent-action)
5978     (persistent-help . "Describe function / C-u C-z: Toggle advice")))
5979 ;; (anything 'anything-c-source-advice)
5980 ;; (let ((debug-on-signal t))(anything 'anything-c-source-advice))
5981 ;; (testadvice)
5982
5983 (defun anything-c-advice-candidates ()
5984   (require 'advice)
5985   (loop for (fname) in ad-advised-functions
5986      for function = (intern fname)
5987      append
5988        (loop for class in ad-advice-classes append
5989             (loop for advice in (ad-get-advice-info-field function class)
5990                for enabled = (ad-advice-enabled advice)
5991                collect
5992                  (cons (format
5993                         "%s %s %s"
5994                         (if enabled "Enabled " "Disabled")
5995                         (propertize fname 'face 'font-lock-function-name-face)
5996                         (ad-make-single-advice-docstring advice class nil))
5997                        (list function class advice))))))
5998
5999 (defun anything-c-advice-persistent-action (func-class-advice)
6000   (if current-prefix-arg
6001       (anything-c-advice-toggle func-class-advice)
6002       (describe-function (car func-class-advice))))
6003
6004 (defun anything-c-advice-toggle (func-class-advice)
6005   (destructuring-bind (function class advice) func-class-advice
6006     (cond ((ad-advice-enabled advice)
6007            (ad-advice-set-enabled advice nil)
6008            (message "Disabled"))
6009           (t                            ;disabled
6010            (ad-advice-set-enabled advice t)
6011            (message "Enabled")))
6012     (ad-activate function)
6013     (and anything-in-persistent-action
6014          (anything-c-advice-update-current-display-string))))
6015
6016 (defun anything-c-advice-update-current-display-string ()
6017   (anything-edit-current-selection
6018     (let ((newword (cond ((looking-at "Disabled") "Enabled")
6019                          ((looking-at "Enabled")  "Disabled")))
6020           realvalue)
6021       (when newword
6022         (delete-region (point) (progn (forward-word 1) (point)))
6023         (insert newword)))))
6024
6025 ;;;###autoload
6026 (defun anything-manage-advice ()
6027   "Preconfigured `anything' to disable/enable function advices."
6028   (interactive)
6029   (anything-other-buffer 'anything-c-source-advice "*anything advice*"))
6030
6031 ;;;; <Variable>
6032 ;;; Emacs variables
6033 (defvar anything-c-source-emacs-variables
6034   '((name . "Emacs Variables")
6035     (candidates . (lambda ()
6036                     (sort (all-completions "" obarray 'boundp) 'string-lessp)))
6037     (type . variable)
6038     (requires-pattern . 2))
6039   "Source for completing Emacs variables.")
6040 ;; (anything 'anything-c-source-emacs-variables)
6041
6042 ;;;; <Bookmark>
6043 ;;; Bookmarks
6044 (eval-when-compile (require 'bookmark))
6045 (defvar anything-c-source-bookmarks
6046   '((name . "Bookmarks")
6047     (init . (lambda ()
6048               (require 'bookmark)))
6049     (candidates . bookmark-all-names)
6050     (type . bookmark))
6051   "See (info \"(emacs)Bookmarks\").")
6052 ;; (anything 'anything-c-source-bookmarks)
6053
6054 ;;; bookmark-set
6055 (defvar anything-c-source-bookmark-set
6056   '((name . "Set Bookmark")
6057     (dummy)
6058     (action . bookmark-set))
6059   "See (info \"(emacs)Bookmarks\").")
6060 ;; (anything 'anything-c-source-bookmark-set)
6061
6062 ;;; Visible Bookmarks
6063 ;; (install-elisp "http://cvs.savannah.gnu.org/viewvc/*checkout*/bm/bm/bm.el")
6064
6065
6066 ;; http://d.hatena.ne.jp/grandVin/20080911/1221114327
6067 (defvar anything-c-source-bm
6068   '((name . "Visible Bookmarks")
6069     (init . anything-c-bm-init)
6070     (candidates-in-buffer)
6071     (type . line))
6072   "Needs bm.el.
6073
6074 http://www.nongnu.org/bm/")
6075
6076 (defun anything-c-bm-init ()
6077   "Init function for `anything-c-source-bm'."
6078   (when (require 'bm nil t)
6079     (with-no-warnings
6080       (let ((bookmarks (bm-lists))
6081             (buf (anything-candidate-buffer 'global)))
6082         (dolist (bm (sort* (append (car bookmarks) (cdr bookmarks))
6083                            '< :key 'overlay-start))
6084           (let ((start (overlay-start bm))
6085                 (end (overlay-end bm))
6086                 (annotation (or (overlay-get bm 'annotation) "")))
6087             (unless (< (- end start) 1) ; org => (if (< (- end start) 2)
6088               (let ((str (format "%5d: [%s]: %s\n"
6089                                  (line-number-at-pos start)
6090                                  annotation
6091                                  (buffer-substring start (1- end)))))
6092                 (with-current-buffer buf (insert str))))))))))
6093
6094 ;;; Special bookmarks
6095 (defvar anything-c-source-bookmarks-ssh
6096   '((name . "Bookmarks-ssh")
6097     (init . (lambda ()
6098               (require 'bookmark)))
6099     (candidates . (lambda () (anything-c-collect-bookmarks :ssh t)))
6100     (type . bookmark))
6101   "See (info \"(emacs)Bookmarks\").")
6102 ;; (anything 'anything-c-source-bookmarks-ssh)
6103
6104 (defvar anything-c-source-bookmarks-su
6105   '((name . "Bookmarks-root")
6106     (init . (lambda ()
6107               (require 'bookmark)))
6108     (candidates . (lambda () (anything-c-collect-bookmarks :su t)))
6109     (filtered-candidate-transformer anything-c-highlight-bookmark-su)
6110
6111     (type . bookmark))
6112   "See (info \"(emacs)Bookmarks\").")
6113 ;; (anything 'anything-c-source-bookmarks-su)
6114
6115 (defvar anything-c-source-bookmarks-local
6116   '((name . "Bookmarks-Local")
6117     (init . (lambda ()
6118               (require 'bookmark)))
6119     (candidates . (lambda () (anything-c-collect-bookmarks :local t)))
6120     (filtered-candidate-transformer
6121      anything-c-adaptive-sort
6122      anything-c-highlight-bookmark)
6123     (type . bookmark))
6124   "See (info \"(emacs)Bookmarks\").")
6125 ;; (anything 'anything-c-source-bookmarks-local)
6126
6127 (defun* anything-c-collect-bookmarks (&key local su sudo ssh)
6128   (let* ((lis-all (bookmark-all-names))
6129          (lis-loc (cond (local (loop for i in lis-all
6130                                   unless (string-match "^(ssh)\\|^(su)" i)
6131                                   collect i))
6132                         (su (loop for i in lis-all
6133                                when (string-match "^(su)" i)
6134                                collect i))
6135                         (sudo (loop for i in lis-all
6136                                  when (string-match "^(sudo)" i)
6137                                  collect i))
6138                         (ssh (loop for i in lis-all
6139                                 when (string-match "^(ssh)" i)
6140                                 collect i)))))
6141     (sort lis-loc 'string-lessp)))
6142
6143 (defun anything-c-bookmark-root-logged-p ()
6144   (catch 'break
6145     (dolist (i (mapcar #'buffer-name (buffer-list)))
6146       (when (string-match (format "*tramp/%s ." anything-su-or-sudo) i)
6147         (throw 'break t)))))
6148
6149 (defun anything-c-highlight-bookmark-su (files source)
6150   (if (anything-c-bookmark-root-logged-p)
6151       (anything-c-highlight-bookmark files source)
6152       (anything-c-highlight-not-logged files source)))
6153
6154 (defun anything-c-highlight-not-logged (files source)
6155   (loop for i in files
6156      collect (propertize i 'face anything-c-bookmarks-face3)))
6157
6158 (defun anything-c-highlight-bookmark (bookmarks source)
6159   "Used as `candidate-transformer' to colorize bookmarks.
6160 Work both with standard Emacs bookmarks and bookmark-extensions.el."
6161   (loop for i in bookmarks
6162      for isfile        = (bookmark-get-filename i)
6163      for bufp          = (and (fboundp 'bmkext-get-buffer-name)
6164                               (bmkext-get-buffer-name i))
6165      for handlerp      = (and (fboundp 'bookmark-get-handler)
6166                               (bookmark-get-handler i))
6167      for isw3m         = (and (fboundp 'bmkext-w3m-bookmark-p)
6168                               (bmkext-w3m-bookmark-p i))
6169      for isgnus        = (and (fboundp 'bmkext-gnus-bookmark-p)
6170                               (bmkext-gnus-bookmark-p i))
6171      for isman         = (and (fboundp 'bmkext-man-bookmark-p) ; Man
6172                               (bmkext-man-bookmark-p i))
6173      for iswoman       = (and (fboundp 'bmkext-woman-bookmark-p) ; Woman
6174                               (bmkext-woman-bookmark-p i))
6175      for handlerp      = (bookmark-get-handler i)
6176      for isannotation  = (bookmark-get-annotation i)
6177      for isabook       = (string= (bookmark-prop-get i 'type) "addressbook")
6178      for isinfo        = (eq handlerp 'Info-bookmark-jump)
6179      ;; Add a * if bookmark have annotation
6180      if (and isannotation (not (string-equal isannotation "")))
6181      do (setq i (concat "*" i))
6182      collect (cond (;; info buffers
6183                     isinfo
6184                     (propertize i 'face 'anything-bmkext-info 'help-echo isfile))
6185                    (;; w3m buffers
6186                     isw3m
6187                     (propertize i 'face 'anything-bmkext-w3m 'help-echo isfile))
6188                    (;; gnus buffers
6189                     isgnus
6190                     (propertize i 'face 'anything-bmkext-gnus 'help-echo isfile))
6191                    (;; Man Woman
6192                     (or iswoman isman)
6193                     (propertize i 'face 'anything-bmkext-man 'help-echo isfile))
6194                    (;; Addressbook
6195                     isabook
6196                     (propertize i 'face '((:foreground "Tomato"))))
6197                    (;; directories
6198                     (and isfile (file-directory-p isfile))
6199                     (propertize i 'face anything-c-bookmarks-face1 'help-echo isfile))
6200                    (;; regular files
6201                     t
6202                     (propertize i 'face 'anything-bmkext-file 'help-echo isfile)))))
6203
6204
6205 ;;; Faces for bookmarks
6206 (defface anything-bmkext-info
6207     '((t (:foreground "green")))
6208   "*Face used for W3m Emacs bookmarks (not w3m bookmarks)."
6209   :group 'anything)
6210
6211 (defface anything-bmkext-w3m
6212     '((t (:foreground "yellow")))
6213   "*Face used for W3m Emacs bookmarks (not w3m bookmarks)."
6214   :group 'anything)
6215
6216 (defface anything-bmkext-gnus
6217     '((t (:foreground "magenta")))
6218   "*Face used for Gnus bookmarks."
6219   :group 'anything)
6220
6221 (defface anything-bmkext-man
6222     '((t (:foreground "Orange4")))
6223   "*Face used for Woman/man bookmarks."
6224   :group 'anything)
6225
6226 (defface anything-bmkext-no--file
6227     '((t (:foreground "grey")))
6228   "*Face used for non--file bookmarks."
6229   :group 'anything)
6230
6231 (defface anything-bmkext-file
6232     '((t (:foreground "Deepskyblue2")))
6233   "*Face used for non--file bookmarks."
6234   :group 'anything)
6235
6236 (defface anything-bookmarks-su-face '((t (:foreground "red")))
6237   "Face for su/sudo bookmarks."
6238   :group 'anything)
6239
6240 (defvar anything-c-bookmarks-face1 'anything-ff-directory)
6241 (defvar anything-c-bookmarks-face2 'anything-ff-file)
6242 (defvar anything-c-bookmarks-face3 'anything-bookmarks-su-face)
6243
6244
6245 ;;; Sources to filter bookmark-extensions bookmarks.
6246 ;; Dependency: http://mercurial.intuxication.org/hg/emacs-bookmark-extension
6247 ;; If you want to enable google-maps in addressbook you will need
6248 ;; Julien Danjou google-maps-el package available here:
6249 ;; http://julien.danjou.info/google-maps-el.html
6250
6251 (defun anything-c-bmkext-filter-setup-alist (fn &rest args)
6252   "Return a filtered `bookmark-alist' sorted alphabetically."
6253   (loop
6254      with alist = (if args
6255                       (apply #'(lambda (x) (funcall fn x)) args)
6256                       (funcall fn))
6257      for i in alist
6258      for b = (car i)
6259      collect b into sa
6260      finally return (sort sa 'string-lessp)))
6261
6262 ;; Addressbook
6263 (defvar anything-c-source-bmkext-addressbook
6264   '((name . "Bookmark Addressbook")
6265     (init . (lambda ()
6266               (require 'bookmark-extensions)
6267               (bookmark-maybe-load-default-file)))
6268     (candidates . anything-c-bmkext-addressbook-setup-alist)
6269     (persistent-action
6270      . (lambda (candidate)
6271          (let ((bmk (anything-bookmark-get-bookmark-from-name
6272                      candidate)))
6273            (bookmark--jump-via bmk 'pop-to-buffer))))
6274     (persistent-help . "Show contact - Prefix with C-u to append")
6275     (filtered-candidate-transformer
6276      anything-c-adaptive-sort
6277      anything-c-highlight-bookmark)
6278     (action . (("Show Contact(s)"
6279                 . (lambda (candidate)
6280                     (let* ((contacts (anything-marked-candidates))
6281                            (current-prefix-arg (or anything-current-prefix-arg
6282                                                    (> (length contacts) 1))))
6283                       (bookmark-jump
6284                        (anything-bookmark-get-bookmark-from-name (car contacts)))
6285                       (anything-aif (cdr contacts)
6286                         (loop for bmk in it do
6287                              (bookmark-jump
6288                               (anything-bookmark-get-bookmark-from-name bmk)))))))
6289                ("Send Mail"
6290                 . (lambda (candidate)
6291                     (let* ((contacts (anything-marked-candidates))
6292                            (bmk      (anything-bookmark-get-bookmark-from-name
6293                                       (car contacts)))
6294                            (append   (message-buffers)))
6295                       (if append
6296                           (addressbook-set-mail-buffer1 bmk 'append)
6297                           (addressbook-set-mail-buffer1 bmk))
6298                       (setq contacts (cdr contacts))
6299                       (when contacts
6300                         (loop for bmk in contacts do
6301                              (addressbook-set-mail-buffer1 bmk 'append))))))
6302                ("Edit Bookmark"
6303                 . (lambda (candidate)
6304                     (let ((bmk (anything-bookmark-get-bookmark-from-name
6305                                 candidate)))
6306                       (addressbook-bookmark-edit
6307                        (assoc bmk bookmark-alist)))))
6308                ("Insert Email at point"
6309                 . (lambda (candidate)
6310                     (let* ((bmk   (anything-bookmark-get-bookmark-from-name
6311                                    candidate))
6312                            (mlist (split-string
6313                                    (assoc-default
6314                                     'email (assoc bmk bookmark-alist))
6315                                    ", ")))
6316                       (insert
6317                        (if (> (length mlist) 1)
6318                            (anything-comp-read
6319                             "Insert Mail Address: " mlist :must-match t)
6320                            (car mlist))))))
6321                ("Show annotation"
6322                 . (lambda (candidate)
6323                     (let ((bmk (anything-bookmark-get-bookmark-from-name
6324                                 candidate)))
6325                       (bookmark-show-annotation bmk))))
6326                ("Edit annotation"
6327                 . (lambda (candidate)
6328                     (let ((bmk (anything-bookmark-get-bookmark-from-name
6329                                 candidate)))
6330                       (bookmark-edit-annotation bmk))))
6331                ("Show Google map"
6332                 . (lambda (candidate)
6333                     (let* ((bmk (anything-bookmark-get-bookmark-from-name
6334                                  candidate))
6335                            (full-bmk (assoc bmk bookmark-alist)))
6336                       (addressbook-google-map full-bmk))))))))
6337
6338
6339 (defun anything-c-bmkext-addressbook-setup-alist ()
6340   "Specialized filter function for bookmarks w3m."
6341   (anything-c-bmkext-filter-setup-alist 'bmkext-addressbook-alist-only))
6342
6343 ;; W3m
6344 (defvar anything-c-source-bookmark-w3m
6345   '((name . "Bookmark W3m")
6346     (init . (lambda ()
6347               (require 'bookmark-extensions)
6348               (bookmark-maybe-load-default-file)))
6349     (candidates . anything-c-bookmark-w3m-setup-alist)
6350     (filtered-candidate-transformer
6351      anything-c-adaptive-sort
6352      anything-c-highlight-bookmark)
6353     (type . bookmark)))
6354 ;; (anything 'anything-c-source-bookmark-w3m)
6355
6356 (defun anything-c-bookmark-w3m-setup-alist ()
6357   "Specialized filter function for bookmarks w3m."
6358   (anything-c-bmkext-filter-setup-alist 'bmkext-w3m-alist-only))
6359
6360 ;; Images
6361 (defvar anything-c-source-bookmark-images
6362   '((name . "Bookmark Images")
6363     (init . (lambda ()
6364               (require 'bookmark-extensions)
6365               (bookmark-maybe-load-default-file)))
6366     (candidates . anything-c-bookmark-images-setup-alist)
6367     (filtered-candidate-transformer
6368      anything-c-adaptive-sort
6369      anything-c-highlight-bookmark)
6370     (type . bookmark)))
6371 ;; (anything 'anything-c-source-bookmark-images)
6372
6373 (defun anything-c-bookmark-images-setup-alist ()
6374   "Specialized filter function for images bookmarks."
6375   (anything-c-bmkext-filter-setup-alist 'bmkext-image-file-alist-only))
6376
6377 ;; Woman Man
6378 (defvar anything-c-source-bookmark-man
6379   '((name . "Bookmark Woman&Man")
6380     (init . (lambda ()
6381               (require 'bookmark-extensions)
6382               (bookmark-maybe-load-default-file)))
6383     (candidates . anything-c-bookmark-man-setup-alist)
6384     (filtered-candidate-transformer
6385      anything-c-adaptive-sort
6386      anything-c-highlight-bookmark)
6387     (type . bookmark)))
6388 ;; (anything 'anything-c-source-bookmark-man)
6389
6390 (defun anything-c-bookmark-man-setup-alist ()
6391   "Specialized filter function for bookmarks w3m."
6392   (append (anything-c-bmkext-filter-setup-alist 'bmkext-man-alist-only)
6393           (anything-c-bmkext-filter-setup-alist 'bmkext-woman-alist-only)))
6394
6395 ;; Gnus
6396 (defvar anything-c-source-bookmark-gnus
6397   '((name . "Bookmark Gnus")
6398     (init . (lambda ()
6399               (require 'bookmark-extensions)
6400               (bookmark-maybe-load-default-file)))
6401     (candidates . anything-c-bookmark-gnus-setup-alist)
6402     (filtered-candidate-transformer
6403      anything-c-adaptive-sort
6404      anything-c-highlight-bookmark)
6405     (type . bookmark)))
6406 ;; (anything 'anything-c-source-bookmark-gnus)
6407
6408 (defun anything-c-bookmark-gnus-setup-alist ()
6409   "Specialized filter function for bookmarks gnus."
6410   (anything-c-bmkext-filter-setup-alist 'bmkext-gnus-alist-only))
6411
6412 ;; Info
6413 (defvar anything-c-source-bookmark-info
6414   '((name . "Bookmark Info")
6415     (init . (lambda ()
6416               (require 'bookmark-extensions)
6417               (bookmark-maybe-load-default-file)))
6418     (candidates . anything-c-bookmark-info-setup-alist)
6419     (filtered-candidate-transformer
6420      anything-c-adaptive-sort
6421      anything-c-highlight-bookmark)
6422     (type . bookmark)))
6423 ;; (anything 'anything-c-source-bookmark-info)
6424
6425 (defun anything-c-bookmark-info-setup-alist ()
6426   "Specialized filter function for bookmarks info."
6427   (anything-c-bmkext-filter-setup-alist 'bmkext-info-alist-only))
6428
6429 ;; Local Files&directories
6430 (defvar anything-c-source-bookmark-files&dirs
6431   '((name . "Bookmark Files&Directories")
6432     (init . (lambda ()
6433               (require 'bookmark-extensions)
6434               (bookmark-maybe-load-default-file)))
6435     (candidates . anything-c-bookmark-local-files-setup-alist)
6436     (filtered-candidate-transformer
6437      anything-c-adaptive-sort
6438      anything-c-highlight-bookmark)
6439     (type . bookmark)))
6440 ;; (anything 'anything-c-source-bookmark-files&dirs)
6441
6442 (defun anything-c-bookmark-local-files-setup-alist ()
6443   "Specialized filter function for bookmarks locals files."
6444   (anything-c-bmkext-filter-setup-alist 'bmkext-local-file-alist-only))
6445
6446 ;; Su Files&directories
6447 (defvar anything-c-source-bookmark-su-files&dirs
6448   '((name . "Bookmark Root-Files&Directories")
6449     (init . (lambda ()
6450               (require 'bookmark-extensions)
6451               (bookmark-maybe-load-default-file)))
6452     (candidates . anything-c-bookmark-su-files-setup-alist)
6453     (filtered-candidate-transformer
6454      anything-c-adaptive-sort
6455      anything-c-highlight-bookmark-su)
6456     (type . bookmark)))
6457 ;; (anything 'anything-c-source-bookmark-su-files&dirs)
6458
6459 (defun anything-c-bookmark-su-files-setup-alist ()
6460   "Specialized filter function for bookmarks su/sudo files."
6461   (loop
6462      with l = (anything-c-bmkext-filter-setup-alist 'bmkext-remote-file-alist-only)
6463      for i in l
6464      for isfile = (bookmark-get-filename i)
6465      for istramp = (and isfile (boundp 'tramp-file-name-regexp)
6466                         (save-match-data
6467                           (string-match tramp-file-name-regexp isfile)))
6468      for issu = (and istramp
6469                      (string-match bmkext-su-or-sudo-regexp isfile))
6470      if issu
6471      collect i))
6472
6473 ;; Ssh Files&directories
6474 (defvar anything-c-source-bookmark-ssh-files&dirs
6475   '((name . "Bookmark Ssh-Files&Directories")
6476     (init . (lambda ()
6477               (require 'bookmark-extensions)
6478               (bookmark-maybe-load-default-file)))
6479     (candidates . anything-c-bookmark-ssh-files-setup-alist)
6480     (filtered-candidate-transformer . anything-c-adaptive-sort)
6481     (type . bookmark)))
6482 ;; (anything 'anything-c-source-bookmark-ssh-files&dirs)
6483
6484 (defun anything-c-bookmark-ssh-files-setup-alist ()
6485   "Specialized filter function for bookmarks ssh files."
6486   (loop
6487      with l = (anything-c-bmkext-filter-setup-alist 'bmkext-remote-file-alist-only)
6488      for i in l
6489      for isfile = (bookmark-get-filename i)
6490      for istramp = (and isfile (boundp 'tramp-file-name-regexp)
6491                         (save-match-data
6492                           (string-match tramp-file-name-regexp isfile)))
6493      for isssh = (and istramp
6494                       (string-match "/ssh:" isfile))
6495      if isssh
6496      collect i))
6497
6498
6499 ;; All bookmark-extensions sources.
6500 ;;;###autoload
6501 (defun anything-bookmark-ext ()
6502   "Preconfigured `anything' for bookmark-extensions sources.
6503 Needs bookmark-ext.el:
6504 <http://mercurial.intuxication.org/hg/emacs-bookmark-extension>.
6505 Contain also `anything-c-source-google-suggest'."
6506   (interactive)
6507   (anything
6508    :sources
6509    '(anything-c-source-bookmark-files&dirs
6510      anything-c-source-bookmark-w3m
6511      anything-c-source-google-suggest
6512      anything-c-source-bmkext-addressbook
6513      anything-c-source-bookmark-gnus
6514      anything-c-source-bookmark-info
6515      anything-c-source-bookmark-man
6516      anything-c-source-bookmark-images
6517      anything-c-source-bookmark-su-files&dirs
6518      anything-c-source-bookmark-ssh-files&dirs)
6519    :prompt "SearchBookmark: "
6520    :buffer "*anything bmkext*"))
6521
6522
6523 ;; Firefox bookmarks
6524 ;; You will have to set firefox to import bookmarks in his html file bookmarks.html.
6525 ;; (only for firefox versions >=3)
6526 ;; To achieve that, open about:config in firefox and double click on this line to enable value
6527 ;; to true:
6528 ;; user_pref("browser.bookmarks.autoExportHTML", false);
6529 ;; You should have now:
6530 ;; user_pref("browser.bookmarks.autoExportHTML", true);
6531
6532 (defvar anything-firefox-bookmark-url-regexp "\\(https\\|http\\|ftp\\|about\\|file\\)://[^ \"]*")
6533 (defvar anything-firefox-bookmarks-regexp ">\\([^><]+.[^</a>]\\)")
6534
6535 (defun anything-get-firefox-user-init-dir ()
6536   "Guess the default Firefox user directory name."
6537   (let* ((moz-dir (concat (getenv "HOME") "/.mozilla/firefox/"))
6538          (moz-user-dir
6539           (with-current-buffer (find-file-noselect (concat moz-dir "profiles.ini"))
6540             (goto-char (point-min))
6541             (prog1
6542                 (when (search-forward "Path=" nil t)
6543                   (buffer-substring-no-properties (point) (point-at-eol)))
6544               (kill-buffer)))))
6545     (file-name-as-directory (concat moz-dir moz-user-dir))))
6546
6547 (defun anything-guess-firefox-bookmark-file ()
6548   "Return the path of the Firefox bookmarks file."
6549   (concat (anything-get-firefox-user-init-dir) "bookmarks.html"))
6550
6551 (defun anything-html-bookmarks-to-alist (file url-regexp bmk-regexp)
6552   "Parse html bookmark FILE and return an alist with (title . url) as elements."
6553   (let (bookmarks-alist url title)
6554     (with-temp-buffer
6555       (insert-file-contents file)
6556       (goto-char (point-min))
6557       (while (re-search-forward "href=\\|^ *<DT><A HREF=" nil t)
6558         (forward-line 0)
6559         (when (re-search-forward url-regexp nil t)
6560           (setq url (match-string 0)))
6561         (when (re-search-forward bmk-regexp nil t)
6562           (setq title (match-string 1)))
6563         (push (cons title url) bookmarks-alist)
6564         (forward-line)))
6565     (nreverse bookmarks-alist)))
6566
6567 (defvar anything-c-firefox-bookmarks-alist nil)
6568 (defvar anything-c-source-firefox-bookmarks
6569   '((name . "Firefox Bookmarks")
6570     (init . (lambda ()
6571               (setq anything-c-firefox-bookmarks-alist
6572                     (anything-html-bookmarks-to-alist
6573                      (anything-guess-firefox-bookmark-file)
6574                      anything-firefox-bookmark-url-regexp
6575                      anything-firefox-bookmarks-regexp))))
6576     (candidates . (lambda ()
6577                     (mapcar #'car anything-c-firefox-bookmarks-alist)))
6578     (filtered-candidate-transformer
6579      anything-c-adaptive-sort
6580      anything-c-highlight-firefox-bookmarks)
6581     (action . (("Browse Url Firefox"
6582                 . (lambda (candidate)
6583                     (browse-url-firefox
6584                      (anything-c-firefox-bookmarks-get-value candidate))))
6585                ("Browse Url w3m"
6586                 . (lambda (candidate)
6587                     (w3m-browse-url
6588                      (anything-c-firefox-bookmarks-get-value candidate))))
6589                ("Copy Url"
6590                 . (lambda (elm)
6591                     (kill-new (anything-c-w3m-bookmarks-get-value elm))))))))
6592
6593 ;; (anything 'anything-c-source-firefox-bookmarks)
6594
6595 (defun anything-c-firefox-bookmarks-get-value (elm)
6596   (assoc-default elm anything-c-firefox-bookmarks-alist))
6597
6598 (defun anything-c-highlight-firefox-bookmarks (bookmarks source)
6599   (loop for i in bookmarks
6600      collect (propertize
6601               i 'face '((:foreground "YellowGreen"))
6602               'help-echo (anything-c-firefox-bookmarks-get-value i))))
6603
6604 ;; W3m bookmark
6605 ;; Some users have the emacs-w3m library in load-path
6606 ;; without having the w3m executable :-;
6607 ;; So check if w3m program is present before trying to load
6608 ;; emacs-w3m.
6609 (eval-when-compile
6610   (when (executable-find "w3m")
6611     (require 'w3m-bookmark nil t)))
6612
6613 (defvar w3m-bookmark-file "~/.w3m/bookmark.html")
6614
6615
6616 (defface anything-w3m-bookmarks-face '((t (:foreground "cyan1" :underline t)))
6617   "Face for w3m bookmarks" :group 'anything)
6618
6619 (defvar anything-w3m-bookmarks-regexp ">\\([^><]+.[^</a>]\\)")
6620 (defvar anything-w3m-bookmark-url-regexp "\\(https\\|http\\|ftp\\|file\\)://[^>]*")
6621 (defvar anything-c-w3m-bookmarks-alist nil)
6622 (defvar anything-c-source-w3m-bookmarks
6623   '((name . "W3m Bookmarks")
6624     (init . (lambda ()
6625               (setq anything-c-w3m-bookmarks-alist
6626                     (anything-html-bookmarks-to-alist
6627                      w3m-bookmark-file
6628                      anything-w3m-bookmark-url-regexp
6629                      anything-w3m-bookmarks-regexp))))
6630     (candidates . (lambda ()
6631                     (mapcar #'car anything-c-w3m-bookmarks-alist)))
6632     (filtered-candidate-transformer
6633      anything-c-adaptive-sort
6634      anything-c-highlight-w3m-bookmarks)
6635     (action . (("Browse Url"
6636                 . (lambda (candidate)
6637                     (anything-c-w3m-browse-bookmark candidate)))
6638                ("Copy Url"
6639                 . (lambda (elm)
6640                     (kill-new (anything-c-w3m-bookmarks-get-value elm))))
6641                ("Browse Url Firefox"
6642                 . (lambda (candidate)
6643                     (anything-c-w3m-browse-bookmark candidate t)))
6644                ("Delete Bookmark"
6645                 . (lambda (candidate)
6646                     (anything-c-w3m-delete-bookmark candidate)))
6647                ("Rename Bookmark"
6648                 . (lambda (candidate)
6649                     (anything-c-w3m-rename-bookmark candidate)))))
6650     (persistent-action . (lambda (candidate)
6651                            (if current-prefix-arg
6652                                (anything-c-w3m-browse-bookmark candidate t)
6653                                (anything-c-w3m-browse-bookmark candidate nil t))))
6654     (persistent-help . "Open URL with emacs-w3m in new tab / \
6655 C-u \\[anything-execute-persistent-action]: Open URL with Firefox"))
6656   "Needs w3m and emacs-w3m.
6657
6658 http://w3m.sourceforge.net/
6659 http://emacs-w3m.namazu.org/")
6660
6661 ;; (anything 'anything-c-source-w3m-bookmarks)
6662
6663 (defun anything-c-w3m-bookmarks-get-value (elm)
6664   (replace-regexp-in-string
6665    "\"" "" (cdr (assoc elm anything-c-w3m-bookmarks-alist))))
6666
6667 (defun anything-c-w3m-browse-bookmark (elm &optional use-firefox new-tab)
6668   (let* ((fn (if use-firefox 'browse-url-firefox 'w3m-browse-url))
6669          (arg (and (eq fn 'w3m-browse-url) new-tab)))
6670     (funcall fn (anything-c-w3m-bookmarks-get-value elm) arg)))
6671
6672 (defun anything-c-highlight-w3m-bookmarks (bookmarks source)
6673   (loop for i in bookmarks
6674      collect (propertize
6675               i 'face 'anything-w3m-bookmarks-face
6676               'help-echo (anything-c-w3m-bookmarks-get-value i))))
6677
6678
6679 (defun anything-c-w3m-delete-bookmark (elm)
6680   (save-excursion
6681     (find-file-literally w3m-bookmark-file)
6682     (goto-char (point-min))
6683     (when (re-search-forward elm nil t)
6684       (beginning-of-line)
6685       (delete-region (point)
6686                      (line-end-position))
6687       (delete-blank-lines))
6688     (save-buffer (current-buffer))
6689     (kill-buffer (current-buffer))))
6690
6691 (defun anything-c-w3m-rename-bookmark (elm)
6692   (let* ((old-title (replace-regexp-in-string ">" "" elm))
6693          (new-title (read-string "NewTitle: " old-title)))
6694     (save-excursion
6695       (find-file-literally w3m-bookmark-file)
6696       (goto-char (point-min))
6697       (when (re-search-forward (concat elm "<") nil t)
6698         (goto-char (1- (point)))
6699         (delete-char (- (length old-title)))
6700         (insert new-title))
6701       (save-buffer (current-buffer))
6702       (kill-buffer (current-buffer)))))
6703
6704 ;;;; <Library>
6705 ;;; Elisp library scan
6706 (defvar anything-c-source-elisp-library-scan
6707   '((name . "Elisp libraries (Scan)")
6708     (init . (anything-c-elisp-library-scan-init))
6709     (candidates-in-buffer)
6710     (action ("Find library"
6711              . (lambda (candidate) (find-file (find-library-name candidate))))
6712      ("Find library other window"
6713       . (lambda (candidate)
6714           (find-file-other-window (find-library-name candidate))))
6715      ("Load library"
6716       . (lambda (candidate) (load-library candidate))))))
6717 ;; (anything 'anything-c-source-elisp-library-scan)
6718
6719 (defun anything-c-elisp-library-scan-init ()
6720   "Init anything buffer status."
6721   (let ((anything-buffer (anything-candidate-buffer 'global))
6722         (library-list (anything-c-elisp-library-scan-list)))
6723     (with-current-buffer anything-buffer
6724       (dolist (library library-list)
6725         (insert (format "%s\n" library))))))
6726
6727 (defun anything-c-elisp-library-scan-list (&optional dirs string)
6728   "Do completion for file names passed to `locate-file'.
6729 DIRS is directory to search path.
6730 STRING is string to match."
6731   ;; Use `load-path' as path when ignore `dirs'.
6732   (or dirs (setq dirs load-path))
6733   ;; Init with blank when ignore `string'.
6734   (or string (setq string ""))
6735   ;; Get library list.
6736   (let ((string-dir (file-name-directory string))
6737         ;; File regexp that suffix match `load-file-rep-suffixes'.
6738         (match-regexp (format "^.*\\.el%s$" (regexp-opt load-file-rep-suffixes)))
6739         name
6740         names)
6741     (dolist (dir dirs)
6742       (unless dir
6743         (setq dir default-directory))
6744       (if string-dir
6745           (setq dir (expand-file-name string-dir dir)))
6746       (when (file-directory-p dir)
6747         (dolist (file (file-name-all-completions
6748                        (file-name-nondirectory string) dir))
6749           ;; Suffixes match `load-file-rep-suffixes'.
6750           (setq name (if string-dir (concat string-dir file) file))
6751           (if (string-match match-regexp name)
6752               (add-to-list 'names name)))))
6753     names))
6754
6755 ;;;; <Programming>
6756 ;;; Imenu
6757 (defvar anything-c-imenu-delimiter " / ")
6758
6759 (defvar anything-c-imenu-index-filter nil)
6760 (make-variable-buffer-local 'anything-c-imenu-index-filter)
6761
6762 (defvar anything-c-cached-imenu-alist nil)
6763 (make-variable-buffer-local 'anything-c-cached-imenu-alist)
6764
6765 (defvar anything-c-cached-imenu-candidates nil)
6766 (make-variable-buffer-local 'anything-c-cached-imenu-candidates)
6767
6768 (defvar anything-c-cached-imenu-tick nil)
6769 (make-variable-buffer-local 'anything-c-cached-imenu-tick)
6770
6771 (eval-when-compile (require 'imenu))
6772 (setq imenu-auto-rescan t)
6773
6774 (defun anything-imenu-create-candidates (entry)
6775   "Create candidates with ENTRY."
6776   (if (listp (cdr entry))
6777       (mapcan
6778        (lambda (sub)
6779          (if (consp (cdr sub))
6780              (mapcar
6781               (lambda (subentry)
6782                 (concat (car entry) anything-c-imenu-delimiter subentry))
6783               (anything-imenu-create-candidates sub))
6784              (list (concat (car entry) anything-c-imenu-delimiter (car sub)))))
6785        (cdr entry))
6786       (list entry)))
6787
6788 (defvar anything-c-source-imenu
6789   '((name . "Imenu")
6790     (init . (lambda () (require 'imenu)))
6791     (candidates . anything-c-imenu-candidates)
6792     (persistent-action . (lambda (elm)
6793                            (anything-c-imenu-default-action elm)
6794                            (unless (fboundp 'semantic-imenu-tag-overlay)
6795                              (anything-match-line-color-current-line))))
6796     (persistent-help . "Show this entry")
6797     (action . anything-c-imenu-default-action))
6798   "See (info \"(emacs)Imenu\")")
6799
6800 ;; (anything 'anything-c-source-imenu)
6801
6802 (defun anything-c-imenu-candidates ()
6803   (with-current-buffer anything-current-buffer
6804     (let ((tick (buffer-modified-tick)))
6805       (if (eq anything-c-cached-imenu-tick tick)
6806           anything-c-cached-imenu-candidates
6807           (setq imenu--index-alist nil)
6808           (setq anything-c-cached-imenu-tick tick
6809                 anything-c-cached-imenu-candidates
6810                 (ignore-errors
6811                   (mapcan
6812                    'anything-imenu-create-candidates
6813                    (setq anything-c-cached-imenu-alist
6814                          (let ((index (imenu--make-index-alist)))
6815                            (if anything-c-imenu-index-filter
6816                                (funcall anything-c-imenu-index-filter index)
6817                                index))))))
6818           (setq anything-c-cached-imenu-candidates
6819                 (mapcar #'(lambda (x)
6820                             (if (stringp x)
6821                                 x
6822                                 (car x)))
6823                         anything-c-cached-imenu-candidates))))))
6824
6825 (setq imenu-default-goto-function 'imenu-default-goto-function)
6826 (defun anything-c-imenu-default-action (elm)
6827   "The default action for `anything-c-source-imenu'."
6828   (let ((path (split-string elm anything-c-imenu-delimiter))
6829         (alist anything-c-cached-imenu-alist))
6830     (dolist (elm path)
6831       (setq alist (assoc elm alist)))
6832     (imenu alist)))
6833
6834 ;;; Ctags
6835 (defvar anything-c-ctags-modes
6836   '( c-mode c++-mode awk-mode csharp-mode java-mode javascript-mode lua-mode
6837     makefile-mode pascal-mode perl-mode cperl-mode php-mode python-mode
6838     scheme-mode sh-mode slang-mode sql-mode tcl-mode ))
6839
6840 (defun anything-c-source-ctags-init ()
6841   (when (and buffer-file-name
6842              (memq major-mode anything-c-ctags-modes)
6843              (anything-current-buffer-is-modified))
6844     (with-current-buffer (anything-candidate-buffer 'local)
6845       (call-process-shell-command
6846        (if (string-match "\\.el\\.gz$" anything-buffer-file-name)
6847            (format "ctags -e -u -f- --language-force=lisp --fields=n =(zcat %s) "
6848                    anything-buffer-file-name)
6849            (format "ctags -e -u -f- --fields=n %s " anything-buffer-file-name))
6850        nil (current-buffer))
6851       (goto-char (point-min))
6852       (forward-line 2)
6853       (delete-region (point-min) (point))
6854       (loop while (and (not (eobp)) (search-forward "\001" (point-at-eol) t))
6855          for lineno-start = (point)
6856          for lineno = (buffer-substring
6857                        lineno-start
6858                        (1- (search-forward "," (point-at-eol) t)))
6859          do
6860            (beginning-of-line)
6861            (insert (format "%5s:" lineno))
6862            (search-forward "\177" (point-at-eol) t)
6863            (delete-region (1- (point)) (point-at-eol))
6864            (forward-line 1)))))
6865
6866 (defvar anything-c-source-ctags
6867   '((name . "Exuberant ctags")
6868     (init . anything-c-source-ctags-init)
6869     (candidates-in-buffer)
6870     (adjust)
6871     (type . line))
6872   "Needs Exuberant Ctags.
6873
6874 http://ctags.sourceforge.net/")
6875 ;; (anything 'anything-c-source-ctags)
6876
6877 ;; Semantic
6878 (eval-when-compile (require 'semantic nil t))
6879 (declare-function semantic-format-tag-summarize "ext:format.el" (tag &optional parent color) t)
6880 (declare-function semantic-tag-components "ext:tag.el" (tag) t)
6881 (declare-function semantic-go-to-tag "ext:tag-file.el" (tag) t)
6882 (declare-function semantic-tag-type "ext:tag-file.el" (tag) t)
6883 (declare-function semantic-tag-class "ext:tag-file.el" (tag) t)
6884 (defvar anything-semantic-candidates nil)
6885
6886 (defun anything-semantic-construct-candidates (tags depth)
6887   (when (require 'semantic nil t)
6888     (apply
6889      'append
6890      (mapcar
6891       (lambda (tag)
6892         (if (listp tag)
6893             (let ((type (semantic-tag-type tag))
6894                   (class (semantic-tag-class tag)))
6895               (if (or (and (stringp type)
6896                            (or (string= type "class")
6897                                (string= type "namespace")))
6898                       (eq class 'function)
6899                       (eq class 'variable))
6900                   (cons (cons (concat (make-string (* depth 2) ?\s)
6901                                       (semantic-format-tag-summarize tag nil t))
6902                               tag)
6903                         (anything-semantic-construct-candidates
6904                          (semantic-tag-components tag) (1+ depth)))))))
6905       tags))))
6906
6907 (defun anything-semantic-default-action (candidate)
6908   (let ((tag (cdr (assoc candidate anything-semantic-candidates))))
6909     (semantic-go-to-tag tag)))
6910
6911 (defvar anything-c-source-semantic
6912   '((name . "Semantic Tags")
6913     (init . (lambda ()
6914               (setq anything-semantic-candidates
6915                     (ignore-errors (anything-semantic-construct-candidates
6916                                     (semantic-fetch-tags) 0)))))
6917     (candidates . (lambda ()
6918                     (if anything-semantic-candidates
6919                         (mapcar 'car anything-semantic-candidates))))
6920     (persistent-action . (lambda (elm)
6921                            (anything-semantic-default-action elm)
6922                            (anything-match-line-color-current-line)))
6923     (persistent-help . "Show this entry")
6924     (action . anything-semantic-default-action)
6925     "Needs semantic in CEDET.
6926
6927 http://cedet.sourceforge.net/semantic.shtml
6928 http://cedet.sourceforge.net/"))
6929
6930 ;; (anything 'anything-c-source-semantic)
6931
6932 ;;; Function is called by
6933 ;;;###autoload
6934 (defun anything-simple-call-tree ()
6935   "Preconfigured `anything' for simple-call-tree. List function relationships.
6936
6937 Needs simple-call-tree.el.
6938 http://www.emacswiki.org/cgi-bin/wiki/download/simple-call-tree.el"
6939   (interactive)
6940   (anything-other-buffer
6941    '(anything-c-source-simple-call-tree-functions-callers
6942      anything-c-source-simple-call-tree-callers-functions)
6943    "*anything simple-call-tree*"))
6944
6945 (defvar anything-c-source-simple-call-tree-functions-callers
6946   '((name . "Function is called by")
6947     (init . anything-c-simple-call-tree-functions-callers-init)
6948     (multiline)
6949     (candidates . anything-c-simple-call-tree-candidates)
6950     (persistent-action . anything-c-simple-call-tree-persistent-action)
6951     (persistent-help . "Show function definitions by rotation")
6952     (action ("Find definition selected by persistent-action" .
6953              anything-c-simple-call-tree-find-definition)))
6954   "Needs simple-call-tree.el.
6955 http://www.emacswiki.org/cgi-bin/wiki/download/simple-call-tree.el")
6956
6957 (defvar anything-c-simple-call-tree-tick nil)
6958 (make-variable-buffer-local 'anything-c-simple-call-tree-tick)
6959 (defun anything-c-simple-call-tree-analyze-maybe ()
6960   (unless (eq (buffer-chars-modified-tick) anything-c-simple-call-tree-tick)
6961     (simple-call-tree-analyze)
6962     (setq anything-c-simple-call-tree-tick (buffer-chars-modified-tick))))
6963
6964 (defun anything-c-simple-call-tree-init-base (function message)
6965   (require 'simple-call-tree)
6966   (with-no-warnings
6967     (when (anything-current-buffer-is-modified)
6968       (anything-c-simple-call-tree-analyze-maybe)
6969       (let ((list (funcall function simple-call-tree-alist)))
6970         (with-current-buffer (anything-candidate-buffer 'local)
6971           (dolist (entry list)
6972             (let ((funcs (concat "  " (mapconcat #'identity (cdr entry) "\n  "))))
6973               (insert (car entry) message
6974                       (if (string= funcs "  ")
6975                           "  no functions."
6976                           funcs)
6977                       "\n\n"))))))))
6978
6979 (defun anything-c-simple-call-tree-functions-callers-init ()
6980   (anything-c-simple-call-tree-init-base 'simple-call-tree-invert
6981                                          " is called by\n"))
6982
6983 (defun anything-c-simple-call-tree-candidates ()
6984   (with-current-buffer (anything-candidate-buffer)
6985     (split-string (buffer-string) "\n\n")))
6986
6987 (defvar anything-c-simple-call-tree-related-functions nil)
6988 (defvar anything-c-simple-call-tree-function-index 0)
6989 (defun anything-c-simple-call-tree-persistent-action (candidate)
6990   (unless (eq last-command 'anything-execute-persistent-action)
6991     (setq anything-c-simple-call-tree-related-functions
6992           (delete "no functions."
6993                   (split-string
6994                    (replace-regexp-in-string "  \\| is called by\\| calls "
6995                                              "" candidate)
6996                    "\n")))
6997     (setq anything-c-simple-call-tree-function-index -1))
6998   (incf anything-c-simple-call-tree-function-index)
6999   (anything-c-simple-call-tree-find-definition candidate))
7000
7001 (defun anything-c-simple-call-tree-find-definition (candidate)
7002   (find-function
7003    (intern
7004     (nth (mod anything-c-simple-call-tree-function-index
7005               (length anything-c-simple-call-tree-related-functions))
7006          anything-c-simple-call-tree-related-functions))))
7007
7008 ;; (anything 'anything-c-source-simple-call-tree-functions-callers)
7009
7010 ;;; Function calls
7011 (defvar anything-c-source-simple-call-tree-callers-functions
7012   '((name . "Function calls")
7013     (init . anything-c-simple-call-tree-callers-functions-init)
7014     (multiline)
7015     (candidates . anything-c-simple-call-tree-candidates)
7016     (persistent-action . anything-c-simple-call-tree-persistent-action)
7017     (persistent-help . "Show function definitions by rotation")
7018     (action ("Find definition selected by persistent-action" .
7019              anything-c-simple-call-tree-find-definition)))
7020   "Needs simple-call-tree.el.
7021 http://www.emacswiki.org/cgi-bin/wiki/download/simple-call-tree.el")
7022
7023 (defun anything-c-simple-call-tree-callers-functions-init ()
7024   (anything-c-simple-call-tree-init-base 'identity " calls \n"))
7025
7026 ;; (anything 'anything-c-source-simple-call-tree-callers-functions)
7027
7028 ;;; Commands/Options with doc
7029 (defvar anything-c-auto-document-data nil)
7030 (make-variable-buffer-local 'anything-c-auto-document-data)
7031 (defvar anything-c-source-commands-and-options-in-file
7032   '((name . "Commands/Options in file")
7033     (header-name
7034      . (lambda (x) (format "Commands/Options in %s"
7035                            (buffer-local-value 'buffer-file-name
7036                                                anything-current-buffer))))
7037     (candidates . anything-command-and-options-candidates)
7038     (multiline)
7039     (action . imenu))
7040   "List Commands and Options with doc. It needs auto-document.el .
7041
7042 http://www.emacswiki.org/cgi-bin/wiki/download/auto-document.el")
7043
7044 (eval-when-compile (require 'auto-document nil t))
7045 (defun anything-command-and-options-candidates ()
7046   (with-current-buffer anything-current-buffer
7047     (when (and (require 'auto-document nil t)
7048                (eq major-mode 'emacs-lisp-mode)
7049                (or (anything-current-buffer-is-modified)
7050                    (not anything-c-auto-document-data)))
7051       (or imenu--index-alist (imenu--make-index-alist t))
7052       (setq anything-c-auto-document-data
7053             (destructuring-bind (commands options)
7054                 (adoc-construct anything-current-buffer)
7055               (append
7056                (loop for (command . doc) in commands
7057                   for cmdname = (symbol-name command)
7058                   collect
7059                     (cons
7060                      (format "Command: %s\n %s"
7061                              (propertize cmdname 'face font-lock-function-name-face)
7062                              (adoc-first-line doc))
7063                      (assoc cmdname imenu--index-alist)))
7064                (loop with var-alist = (cdr (assoc "Variables" imenu--index-alist))
7065                   for (option doc default) in options
7066                   for optname = (symbol-name option)
7067                   collect
7068                     (cons
7069                      (format "Option: %s\n %s\n default = %s"
7070                              (propertize optname 'face font-lock-variable-name-face)
7071                              (adoc-first-line doc)
7072                              (adoc-prin1-to-string default))
7073                      (assoc optname
7074                             var-alist)))))))
7075     anything-c-auto-document-data))
7076
7077 ;; (anything 'anything-c-source-commands-and-options-in-file)
7078
7079 ;;;; <Color and Face>
7080 ;;; Customize Face
7081 (defvar anything-c-source-customize-face
7082   '((name . "Customize Face")
7083     (init . (lambda ()
7084               (unless (anything-candidate-buffer)
7085                 (save-window-excursion (list-faces-display))
7086                 (anything-candidate-buffer (get-buffer "*Faces*")))))
7087     (candidates-in-buffer)
7088     (get-line . buffer-substring)
7089     (action . (lambda (line)
7090                 (customize-face (intern (car (split-string line))))))
7091     (requires-pattern . 3))
7092   "See (info \"(emacs)Faces\")")
7093 ;; (anything 'anything-c-source-customize-face)
7094
7095 ;; Color
7096 (defvar anything-c-source-colors
7097   '((name . "Colors")
7098     (init . (lambda () (unless (anything-candidate-buffer)
7099                          (save-window-excursion (list-colors-display))
7100                          (anything-candidate-buffer (get-buffer "*Colors*")))))
7101     (candidates-in-buffer)
7102     (get-line . buffer-substring)
7103     (action
7104      ("Copy Name" . (lambda (candidate)
7105                       (kill-new (anything-c-colors-get-name candidate))))
7106      ("Copy RGB" . (lambda (candidate)
7107                      (kill-new (anything-c-colors-get-rgb candidate))))
7108      ("Insert Name" . (lambda (candidate)
7109                         (with-current-buffer anything-current-buffer
7110                           (insert (anything-c-colors-get-name candidate)))))
7111      ("Insert RGB" . (lambda (candidate)
7112                        (with-current-buffer anything-current-buffer
7113                          (insert (anything-c-colors-get-rgb candidate))))))))
7114 ;; (anything 'anything-c-source-colors)
7115
7116 (defun anything-c-colors-get-name (candidate)
7117   "Get color name."
7118   (replace-regexp-in-string
7119    " " ""
7120    (with-temp-buffer
7121      (insert (capitalize candidate))
7122      (goto-char (point-min))
7123      (search-forward-regexp "\\s-\\{2,\\}")
7124      (delete-region (point) (point-max))
7125      (buffer-string))))
7126
7127 (defun anything-c-colors-get-rgb (candidate)
7128   "Get color RGB."
7129   (replace-regexp-in-string
7130    " " ""
7131    (with-temp-buffer
7132      (insert (capitalize candidate))
7133      (goto-char (point-max))
7134      (search-backward-regexp "\\s-\\{2,\\}")
7135      (delete-region (point) (point-min))
7136      (buffer-string))))
7137
7138 ;;;; <Search Engine>
7139 ;;; Tracker desktop search
7140 (defvar anything-c-source-tracker-search
7141   '((name . "Tracker Search")
7142     (candidates . (lambda ()
7143                     (start-process "tracker-search-process" nil
7144                                    "tracker-search"
7145                                    anything-pattern)))
7146     (type . file)
7147     (requires-pattern . 3)
7148     (delayed))
7149   "Source for retrieving files matching the current input pattern
7150 with the tracker desktop search.")
7151 ;; (anything 'anything-c-source-tracker-search)
7152
7153 ;;; Spotlight (MacOS X desktop search)
7154 (defvar anything-c-source-mac-spotlight
7155   '((name . "mdfind")
7156     (candidates
7157      . (lambda () (start-process "mdfind-process" nil "mdfind" anything-pattern)))
7158     (type . file)
7159     (requires-pattern . 3)
7160     (delayed))
7161   "Source for retrieving files via Spotlight's command line
7162 utility mdfind.")
7163 ;; (anything 'anything-c-source-mac-spotlight)
7164
7165
7166 ;;;; <Kill ring>
7167 ;;; Kill ring
7168 (defvar anything-c-source-kill-ring
7169   '((name . "Kill Ring")
7170     (init . (lambda () (anything-attrset 'last-command last-command)))
7171     (candidates . anything-c-kill-ring-candidates)
7172     (action . anything-c-kill-ring-action)
7173     (last-command)
7174     (migemo)
7175     (multiline))
7176   "Source for browse and insert contents of kill-ring.")
7177
7178 (defun anything-c-kill-ring-candidates ()
7179   (loop for kill in kill-ring
7180      unless (or (< (length kill) anything-kill-ring-threshold)
7181                 (string-match "^[\\s\\t]+$" kill))
7182      collect kill))
7183
7184 (defun anything-c-kill-ring-action (str)
7185   "Insert STR in `kill-ring' and set STR to the head.
7186 If this action is executed just after `yank',
7187 replace with STR as yanked string."
7188   (setq kill-ring (delete str kill-ring))
7189   (if (not (eq (anything-attr 'last-command) 'yank))
7190       (insert-for-yank str)
7191       ;; from `yank-pop'
7192       (let ((inhibit-read-only t)
7193             (before (< (point) (mark t))))
7194         (if before
7195             (funcall (or yank-undo-function 'delete-region) (point) (mark t))
7196             (funcall (or yank-undo-function 'delete-region) (mark t) (point)))
7197         (setq yank-undo-function nil)
7198         (set-marker (mark-marker) (point) (current-buffer))
7199         (insert-for-yank str)
7200         ;; Set the window start back where it was in the yank command,
7201         ;; if possible.
7202         (set-window-start (selected-window) yank-window-start t)
7203         (if before
7204             ;; This is like exchange-point-and-mark, but doesn't activate the mark.
7205             ;; It is cleaner to avoid activation, even though the command
7206             ;; loop would deactivate the mark because we inserted text.
7207             (goto-char (prog1 (mark t)
7208                          (set-marker (mark-marker) (point) (current-buffer)))))))
7209   (kill-new str))
7210
7211 ;; (anything 'anything-c-source-kill-ring)
7212
7213 ;;;; <Mark ring>
7214 ;; DO NOT include these sources in `anything-sources' use
7215 ;; the commands `anything-mark-ring', `anything-global-mark-ring' or
7216 ;; `anything-all-mark-rings' instead.
7217
7218 (defun anything-c-source-mark-ring-candidates ()
7219   (flet ((get-marks (pos)
7220            (save-excursion
7221              (goto-char pos)
7222              (beginning-of-line)
7223              (let ((line  (car (split-string (thing-at-point 'line) "[\n\r]"))))
7224                (when (string= "" line)
7225                  (setq line  "<EMPTY LINE>"))
7226                (format "%7d: %s" (line-number-at-pos) line)))))
7227     (with-current-buffer anything-current-buffer
7228       (loop
7229          with marks = (if (mark) (cons (mark-marker) mark-ring) mark-ring)
7230          with recip = nil
7231          for i in marks
7232          for m = (get-marks i)
7233          unless (member m recip)
7234          collect m into recip
7235          finally return recip))))
7236
7237 (defvar anything-mark-ring-cache nil)
7238 (defvar anything-c-source-mark-ring
7239   '((name . "mark-ring")
7240     (init . (lambda ()
7241               (setq anything-mark-ring-cache
7242                     (ignore-errors (anything-c-source-mark-ring-candidates)))))
7243     (candidates . (lambda ()
7244                     (anything-aif anything-mark-ring-cache
7245                         it)))
7246     (action . (("Goto line"
7247                 . (lambda (candidate)
7248                     (anything-goto-line (string-to-number candidate))))))
7249     (persistent-action . (lambda (candidate)
7250                            (anything-goto-line (string-to-number candidate))
7251                            (anything-match-line-color-current-line)))
7252     (persistent-help . "Show this line")))
7253
7254 ;; (anything 'anything-c-source-mark-ring)
7255
7256 ;;;###autoload
7257 (defun anything-mark-ring ()
7258   "Preconfigured `anything' for `anything-c-source-mark-ring'."
7259   (interactive)
7260   (anything 'anything-c-source-mark-ring))
7261
7262 ;;; Global-mark-ring
7263 (defvar anything-c-source-global-mark-ring
7264   '((name . "global-mark-ring")
7265     (candidates . anything-c-source-global-mark-ring-candidates)
7266     (action . (("Goto line"
7267                 . (lambda (candidate)
7268                     (let ((items (split-string candidate ":")))
7269                       (anything-c-switch-to-buffer (second items))
7270                       (anything-goto-line (string-to-number (car items))))))))
7271     (persistent-action . (lambda (candidate)
7272                            (let ((items (split-string candidate ":")))
7273                              (anything-c-switch-to-buffer (second items))
7274                              (anything-goto-line (string-to-number (car items)))
7275                              (anything-match-line-color-current-line))))
7276     (persistent-help . "Show this line")))
7277
7278 (defun anything-c-source-global-mark-ring-candidates ()
7279   (flet ((buf-fn (m)
7280            (with-current-buffer (marker-buffer m)
7281              (goto-char m)
7282              (beginning-of-line)
7283              (let (line)
7284                (if (string= "" line)
7285                    (setq line  "<EMPTY LINE>")
7286                    (setq line (car (split-string (thing-at-point 'line)
7287                                                  "[\n\r]"))))
7288                (format "%7d:%s:    %s"
7289                        (line-number-at-pos) (marker-buffer m) line)))))
7290     (loop
7291        with marks = global-mark-ring
7292        with recip = nil
7293        for i in marks
7294        for gm = (unless (or (string-match
7295                              "^ " (format "%s" (marker-buffer i)))
7296                             (null (marker-buffer i)))
7297                   (buf-fn i))
7298        when (and gm (not (member gm recip)))
7299        collect gm into recip
7300        finally return recip)))
7301
7302 ;; (anything 'anything-c-source-global-mark-ring)
7303
7304 ;;;###autoload
7305 (defun anything-global-mark-ring ()
7306   "Preconfigured `anything' for `anything-c-source-global-mark-ring'."
7307   (interactive)
7308   (anything 'anything-c-source-global-mark-ring))
7309
7310 ;;;###autoload
7311 (defun anything-all-mark-rings ()
7312   "Preconfigured `anything' for `anything-c-source-global-mark-ring' and \
7313 `anything-c-source-mark-ring'."
7314   (interactive)
7315   (anything '(anything-c-source-mark-ring
7316               anything-c-source-global-mark-ring)))
7317
7318 ;;;; <Register>
7319 ;;; Insert from register
7320 (defvar anything-c-source-register
7321   '((name . "Registers")
7322     (candidates . anything-c-register-candidates)
7323     (action-transformer . anything-c-register-action-transformer)
7324     (multiline)
7325     (action))
7326   "See (info \"(emacs)Registers\")")
7327
7328 (defun anything-c-register-candidates ()
7329   "Collecting register contents and appropriate commands."
7330   (loop for (char . val) in register-alist
7331      for key    = (single-key-description char)
7332      for string-actions =
7333        (cond
7334          ((numberp val)
7335           (list (int-to-string val)
7336                 'insert-register
7337                 'increment-register))
7338          ((markerp val)
7339           (let ((buf (marker-buffer val)))
7340             (if (null buf)
7341                 (list "a marker in no buffer")
7342                 (list (concat
7343                        "a buffer position:"
7344                        (buffer-name buf)
7345                        ", position "
7346                        (int-to-string (marker-position val)))
7347                       'jump-to-register
7348                       'insert-register))))
7349          ((and (consp val) (window-configuration-p (car val)))
7350           (list "window configuration."
7351                 'jump-to-register))
7352          ((and (consp val) (frame-configuration-p (car val)))
7353           (list "frame configuration."
7354                 'jump-to-register))
7355          ((and (consp val) (eq (car val) 'file))
7356           (list (concat "file:"
7357                         (prin1-to-string (cdr val))
7358                         ".")
7359                 'jump-to-register))
7360          ((and (consp val) (eq (car val) 'file-query))
7361           (list (concat "file:a file-query reference: file "
7362                         (car (cdr val))
7363                         ", position "
7364                         (int-to-string (car (cdr (cdr val))))
7365                         ".")
7366                 'jump-to-register))
7367          ((consp val)
7368           (let ((lines (format "%4d" (length val))))
7369             (list (format "%s: %s\n" lines
7370                           (truncate-string-to-width
7371                            (mapconcat 'identity (list (car val))
7372                                       ;; (mapconcat (lambda (y) y) val
7373                                       "^J") (- (window-width) 15)))
7374                   'insert-register)))
7375          ((stringp val)
7376           (list ;; without properties
7377            (substring-no-properties val)
7378            'insert-register
7379            'append-to-register
7380            'prepend-to-register))
7381          (t
7382           "GARBAGE!"))
7383      collect (cons (format "register %3s: %s" key (car string-actions))
7384                    (cons char (cdr string-actions)))))
7385
7386 (defun anything-c-register-action-transformer (actions register-and-functions)
7387   "Decide actions by the contents of register."
7388   (loop with func-actions =
7389        '((insert-register
7390           "Insert Register" .
7391           (lambda (c) (insert-register (car c))))
7392          (jump-to-register
7393           "Jump to Register" .
7394           (lambda (c) (jump-to-register (car c))))
7395          (append-to-register
7396           "Append Region to Register" .
7397           (lambda (c) (append-to-register
7398                        (car c) (region-beginning) (region-end))))
7399          (prepend-to-register
7400           "Prepend Region to Register" .
7401           (lambda (c) (prepend-to-register
7402                        (car c) (region-beginning) (region-end))))
7403          (increment-register
7404           "Increment Prefix Arg to Register" .
7405           (lambda (c) (increment-register
7406                        anything-current-prefix-arg (car c)))))
7407      for func in (cdr register-and-functions)
7408      for cell = (assq func func-actions)
7409      when cell
7410      collect (cdr cell)))
7411
7412 ;; (anything 'anything-c-source-register)
7413
7414 ;;; Latex completion
7415 (defun anything-c-latex-math-candidates ()
7416   "Collect candidates for latex math completion."
7417   (loop for i in (cddr LaTeX-math-menu)
7418      for elm = (loop for s in i when (vectorp s)
7419                   collect (cons (aref s 0) (aref s 1)))
7420      append elm))
7421
7422 (defvar anything-c-source-latex-math
7423   '((name . "Latex Math Menu")
7424     (init . (lambda ()
7425               (with-current-buffer anything-current-buffer
7426                 (LaTeX-math-mode 1))))
7427     (candidate-number-limit . 9999)
7428     (candidates . anything-c-latex-math-candidates)
7429     (action . (lambda (candidate)
7430                 (call-interactively candidate)))))
7431
7432 ;;;; <Headline Extraction>
7433 (defvar anything-c-source-fixme
7434   '((name . "TODO/FIXME/DRY comments")
7435     (headline . "^.*\\<\\(TODO\\|FIXME\\|DRY\\)\\>.*$")
7436     (adjust)
7437     (recenter))
7438   "Show TODO/FIXME/DRY comments in current file.")
7439 ;; (anything 'anything-c-source-fixme)
7440
7441 (defvar anything-c-source-rd-headline
7442   '((name . "RD HeadLine")
7443     (headline  "^= \\(.+\\)$" "^== \\(.+\\)$" "^=== \\(.+\\)$" "^==== \\(.+\\)$")
7444     (condition . (memq major-mode '(rdgrep-mode rd-mode)))
7445     (migemo)
7446     (subexp . 1))
7447   "Show RD headlines.
7448
7449 RD is Ruby's POD.
7450 http://en.wikipedia.org/wiki/Ruby_Document_format")
7451 ;; (anything 'anything-c-source-rd-headline)
7452
7453 (defvar anything-c-source-oddmuse-headline
7454   '((name . "Oddmuse HeadLine")
7455     (headline  "^= \\(.+\\) =$" "^== \\(.+\\) ==$"
7456      "^=== \\(.+\\) ===$" "^==== \\(.+\\) ====$")
7457     (condition . (memq major-mode '(oddmuse-mode yaoddmuse-mode)))
7458     (migemo)
7459     (subexp . 1))
7460   "Show Oddmuse headlines, such as EmacsWiki.")
7461 ;; (anything 'anything-c-source-oddmuse-headline)
7462
7463 (defvar anything-c-source-emacs-source-defun
7464   '((name . "Emacs Source DEFUN")
7465     (headline . "DEFUN\\|DEFVAR")
7466     (condition . (string-match "/emacs2[0-9].+/src/.+c$"
7467                   (or buffer-file-name ""))))
7468   "Show DEFUN/DEFVAR in Emacs C source file.")
7469 ;; (anything 'anything-c-source-emacs-source-defun)
7470
7471 (defvar anything-c-source-emacs-lisp-expectations
7472   '((name . "Emacs Lisp Expectations")
7473     (headline . "(desc[ ]\\|(expectations")
7474     (condition . (eq major-mode 'emacs-lisp-mode)))
7475   "Show descriptions (desc) in Emacs Lisp Expectations.
7476
7477 http://www.emacswiki.org/cgi-bin/wiki/download/el-expectations.el")
7478 ;; (anything 'anything-c-source-emacs-lisp-expectations)
7479
7480 (defvar anything-c-source-emacs-lisp-toplevels
7481   '((name . "Emacs Lisp Toplevel / Level 4 Comment / Linkd Star")
7482     (headline . "^(\\|(@\\*\\|^;;;;")
7483     (get-line . buffer-substring)
7484     (condition . (eq major-mode 'emacs-lisp-mode))
7485     (adjust))
7486   "Show top-level forms, level 4 comments and linkd stars (optional) in Emacs Lisp.
7487 linkd.el is optional because linkd stars are extracted by regexp.
7488 http://www.emacswiki.org/cgi-bin/wiki/download/linkd.el")
7489 ;; (anything 'anything-c-source-emacs-lisp-toplevels)
7490
7491 (defvar anything-c-source-org-headline
7492   '((name . "Org HeadLine")
7493     (headline
7494      "^\\* \\(.+?\\)\\([ \t]*:[a-zA-Z0-9_@:]+:\\)?[ \t]*$"
7495      "^\\*\\* \\(.+?\\)\\([ \t]*:[a-zA-Z0-9_@:]+:\\)?[ \t]*$"
7496      "^\\*\\*\\* \\(.+?\\)\\([ \t]*:[a-zA-Z0-9_@:]+:\\)?[ \t]*$"
7497      "^\\*\\*\\*\\* \\(.+?\\)\\([ \t]*:[a-zA-Z0-9_@:]+:\\)?[ \t]*$"
7498      "^\\*\\*\\*\\*\\* \\(.+?\\)\\([ \t]*:[a-zA-Z0-9_@:]+:\\)?[ \t]*$"
7499      "^\\*\\*\\*\\*\\*\\* \\(.+?\\)\\([ \t]*:[a-zA-Z0-9_@:]+:\\)?[ \t]*$"
7500      "^\\*\\*\\*\\*\\*\\*\\* \\(.+?\\)\\([ \t]*:[a-zA-Z0-9_@:]+:\\)?[ \t]*$"
7501      "^\\*\\*\\*\\*\\*\\*\\*\\* \\(.+?\\)\\([ \t]*:[a-zA-Z0-9_@:]+:\\)?[ \t]*$")
7502     (condition . (eq major-mode 'org-mode))
7503     (migemo)
7504     (subexp . 1)
7505     (persistent-action . (lambda (elm)
7506                            (anything-c-action-line-goto elm)
7507                            (org-cycle)))
7508     (action-transformer
7509      . (lambda (actions candidate)
7510          '(("Go to Line" . anything-c-action-line-goto)
7511            ("Insert Link to This Headline" . anything-c-org-headline-insert-link-to-headline)))))
7512   "Show Org headlines.
7513 org-mode is very very much extended text-mode/outline-mode.
7514
7515 See (find-library \"org.el\")
7516 See http://orgmode.org for the latest version.")
7517
7518 (defun anything-c-org-headline-insert-link-to-headline (lineno-and-content)
7519   (insert
7520    (save-excursion
7521      (anything-goto-line (car lineno-and-content))
7522      (and (looking-at org-complex-heading-regexp)
7523           (org-make-link-string (concat "*" (match-string 4)))))))
7524
7525 ;; (anything 'anything-c-source-org-headline)
7526
7527 ;;; Anything yaoddmuse
7528 ;; Be sure to have yaoddmuse.el installed
7529 ;; install-elisp may be required if you want to install elisp file from here.
7530 (defvar anything-yaoddmuse-use-cache-file nil)
7531 (defvar anything-c-yaoddmuse-cache-file "~/.emacs.d/yaoddmuse-cache.el")
7532 (defvar anything-c-yaoddmuse-ew-cache nil)
7533 (defvar anything-c-source-yaoddmuse-emacswiki-edit-or-view
7534   '((name . "Yaoddmuse Edit or View (EmacsWiki)")
7535     (candidates . (lambda ()
7536                     (if anything-yaoddmuse-use-cache-file
7537                         (ignore-errors
7538                           (unless anything-c-yaoddmuse-ew-cache
7539                             (load anything-c-yaoddmuse-cache-file)
7540                             (setq anything-c-yaoddmuse-ew-cache
7541                                   (gethash "EmacsWiki" yaoddmuse-pages-hash)))
7542                           anything-c-yaoddmuse-ew-cache)
7543                         (yaoddmuse-update-pagename t)
7544                         (gethash "EmacsWiki" yaoddmuse-pages-hash))))
7545     (action . (("Edit page" . (lambda (candidate)
7546                                 (yaoddmuse-edit "EmacsWiki" candidate)))
7547                ("Browse page" . (lambda (candidate)
7548                                   (yaoddmuse-browse-page "EmacsWiki" candidate)))
7549                ("Browse page other window" . (lambda (candidate)
7550                                                (if (one-window-p)
7551                                                    (split-window-vertically))
7552                                                (yaoddmuse-browse-page "EmacsWiki" candidate)))
7553                ("Browse diff" . (lambda (candidate)
7554                                   (yaoddmuse-browse-page-diff "EmacsWiki" candidate)))
7555                ("Copy URL" . (lambda (candidate)
7556                                (kill-new (yaoddmuse-url "EmacsWiki" candidate))
7557                                (message "Have copy page %s's URL to yank." candidate)))
7558                ("Create page" . (lambda (candidate)
7559                                   (yaoddmuse-edit "EmacsWiki" anything-input)))
7560                ("Update cache" . (lambda (candidate)
7561                                    (if anything-yaoddmuse-use-cache-file
7562                                        (progn
7563                                          (anything-yaoddmuse-cache-pages t)
7564                                          (setq anything-c-yaoddmuse-ew-cache
7565                                                (gethash "EmacsWiki" yaoddmuse-pages-hash)))
7566                                        (yaoddmuse-update-pagename))))))
7567     (action-transformer anything-c-yaoddmuse-action-transformer))
7568   "Needs yaoddmuse.el.
7569
7570 http://www.emacswiki.org/emacs/download/yaoddmuse.el")
7571
7572 ;; (anything 'anything-c-source-yaoddmuse-emacswiki-edit-or-view)
7573
7574 (defvar anything-c-source-yaoddmuse-emacswiki-post-library
7575   '((name . "Yaoddmuse Post library (EmacsWiki)")
7576     (init . (anything-yaoddmuse-init))
7577     (candidates-in-buffer)
7578     (action . (("Post library and Browse" . (lambda (candidate)
7579                                               (yaoddmuse-post-file (find-library-name candidate)
7580                                                                    "EmacsWiki"
7581                                                                    (file-name-nondirectory (find-library-name candidate))
7582                                                                    nil t)))
7583                ("Post library" . (lambda (candidate)
7584                                    (yaoddmuse-post-file (find-library-name candidate)
7585                                                         "EmacsWiki"
7586                                                         (file-name-nondirectory (find-library-name candidate))))))))
7587   "Needs yaoddmuse.el.
7588
7589 http://www.emacswiki.org/emacs/download/yaoddmuse.el")
7590
7591 ;; (anything 'anything-c-source-yaoddmuse-emacswiki-post-library)
7592
7593 (defun anything-c-yaoddmuse-action-transformer (actions candidate)
7594   "Allow the use of `install-elisp' only on elisp files."
7595   (if (string-match "\.el$" candidate)
7596       (append actions '(("Install Elisp" . (lambda (elm)
7597                                              (install-elisp-from-emacswiki elm)))))
7598       actions))
7599
7600 ;;;###autoload
7601 (defun anything-yaoddmuse-cache-pages (&optional load)
7602   "Fetch the list of files on emacswiki and create cache file.
7603 If load is non--nil load the file and feed `yaoddmuse-pages-hash'."
7604   (interactive)
7605   (yaoddmuse-update-pagename)
7606   (save-excursion
7607     (find-file anything-c-yaoddmuse-cache-file)
7608     (erase-buffer)
7609     (insert "(puthash \"EmacsWiki\" '(")
7610     (loop for i in (gethash "EmacsWiki" yaoddmuse-pages-hash)
7611        do
7612          (insert (concat "(\"" (car i) "\") ")))
7613     (insert ") yaoddmuse-pages-hash)\n")
7614     (save-buffer)
7615     (kill-buffer (current-buffer))
7616     (when (or current-prefix-arg
7617               load)
7618       (load anything-c-yaoddmuse-cache-file))))
7619
7620 ;;;###autoload
7621 (defun anything-yaoddmuse-emacswiki-edit-or-view ()
7622   "Preconfigured `anything' to edit or view EmacsWiki page.
7623
7624 Needs yaoddmuse.el.
7625
7626 http://www.emacswiki.org/emacs/download/yaoddmuse.el"
7627   (interactive)
7628   (anything 'anything-c-source-yaoddmuse-emacswiki-edit-or-view))
7629
7630 ;;;###autoload
7631 (defun anything-yaoddmuse-emacswiki-post-library ()
7632   "Preconfigured `anything' to post library to EmacsWiki.
7633
7634 Needs yaoddmuse.el.
7635
7636 http://www.emacswiki.org/emacs/download/yaoddmuse.el"
7637   (interactive)
7638   (anything 'anything-c-source-yaoddmuse-emacswiki-post-library))
7639
7640 (defun anything-yaoddmuse-init ()
7641   "Init anything buffer status."
7642   (let ((anything-buffer (anything-candidate-buffer 'global))
7643         (library-list (yaoddmuse-get-library-list)))
7644     (with-current-buffer anything-buffer
7645       ;; Insert library name.
7646       (dolist (library library-list)
7647         (insert (format "%s\n" library)))
7648       ;; Sort lines.
7649       (sort-lines nil (point-min) (point-max)))))
7650
7651 ;;; Eev anchors
7652 (defvar anything-c-source-eev-anchor
7653   '((name . "Anchors")
7654     (candidates
7655      . (lambda ()
7656          (ignore-errors
7657            (with-current-buffer anything-current-buffer
7658              (loop initially (goto-char (point-min))
7659                 while (re-search-forward (format ee-anchor-format "\\([^\.].+\\)") nil t)
7660                 for anchor = (match-string-no-properties 1)
7661                 collect (cons (format "%5d:%s"
7662                                       (line-number-at-pos (match-beginning 0))
7663                                       (format ee-anchor-format anchor)) anchor))))))
7664     (persistent-action . (lambda (item)
7665                            (ee-to item)
7666                            (anything-match-line-color-current-line)))
7667     (persistent-help . "Show this entry")
7668     (action . (("Goto link" . ee-to)))))
7669 ;; (anything 'anything-c-source-eev-anchor)
7670
7671 ;;;; <Misc>
7672 ;;; Org keywords
7673 (defvar anything-c-source-org-keywords
7674   '((name . "Org Keywords")
7675     (init . anything-c-org-keywords-init)
7676     (candidates . anything-c-org-keywords-candidates)
7677     (action . anything-c-org-keywords-insert)
7678     (persistent-action . anything-c-org-keywords-show-help)
7679     (persistent-help . "Show an example and info page to describe this keyword.")
7680     (keywords-examples)
7681     (keywords)))
7682 ;; (anything 'anything-c-source-org-keywords)
7683 (defvar anything-c-org-keywords-info-location
7684   '(("#+TITLE:" . "(org)Export options")
7685     ("#+AUTHOR:" . "(org)Export options")
7686     ("#+DATE:" . "(org)Export options")
7687     ("#+EMAIL:" . "(org)Export options")
7688     ("#+DESCRIPTION:" . "(org)Export options")
7689     ("#+KEYWORDS:" . "(org)Export options")
7690     ("#+LANGUAGE:" . "(org)Export options")
7691     ("#+TEXT:" . "(org)Export options")
7692     ("#+TEXT:" . "(org)Export options")
7693     ("#+OPTIONS:" . "(org)Export options")
7694     ("#+BIND:" . "(org)Export options")
7695     ("#+LINK_UP:" . "(org)Export options")
7696     ("#+LINK_HOME:" . "(org)Export options")
7697     ("#+LATEX_HEADER:" . "(org)Export options")
7698     ("#+EXPORT_SELECT_TAGS:" . "(org)Export options")
7699     ("#+EXPORT_EXCLUDE_TAGS:" . "(org)Export options")
7700     ("#+INFOJS_OPT" . "(org)Javascript support")
7701     ("#+BEGIN_HTML" . "(org)Quoting HTML tags")
7702     ("#+BEGIN_LaTeX" . "(org)Quoting LaTeX code")
7703     ("#+ORGTBL" . "(org)Radio tables")
7704     ("#+HTML:" . "(org)Quoting HTML tags")
7705     ("#+LaTeX:" . "(org)Quoting LaTeX code")
7706     ("#+BEGIN:" . "(org)Dynamic blocks") ;clocktable columnview
7707     ("#+BEGIN_EXAMPLE" . "(org)Literal examples")
7708     ("#+BEGIN_QUOTE" . "(org)Paragraphs")
7709     ("#+BEGIN_VERSE" . "(org)Paragraphs")
7710     ("#+BEGIN_SRC" . "(org)Literal examples")
7711     ("#+CAPTION" . "(org)Tables in HTML export")
7712     ("#+LABEL" . "(org)Tables in LaTeX export")
7713     ("#+ATTR_HTML" . "(org)Links")
7714     ("#+ATTR_LaTeX" . "(org)Images in LaTeX export")))
7715
7716 (defun anything-c-org-keywords-init ()
7717   (unless (anything-attr 'keywords-examples)
7718     (require 'org)
7719     (anything-attrset 'keywords-examples
7720                       (append
7721                        (mapcar
7722                         (lambda (x)
7723                           (string-match "^#\\+\\(\\([A-Z_]+:?\\).*\\)" x)
7724                           (cons (match-string 2 x) (match-string 1 x)))
7725                         (org-split-string (org-get-current-options) "\n"))
7726                        (mapcar 'list org-additional-option-like-keywords)))
7727     (anything-attrset 'keywords (mapcar 'car (anything-attr 'keywords-examples)))))
7728
7729 (defun anything-c-org-keywords-candidates ()
7730   (and (or (eq (buffer-local-value 'major-mode anything-current-buffer) 'org-mode)
7731            (eq (buffer-local-value 'major-mode anything-current-buffer) 'message-mode))
7732        (anything-attr 'keywords)))
7733
7734 (defun anything-c-org-keywords-insert (keyword)
7735   (cond ((and (string-match "BEGIN" keyword)
7736               (anything-region-active-p))
7737          (let ((beg (region-beginning))
7738                (end (region-end)))
7739            (goto-char end)
7740            (insert "\n#+" (replace-regexp-in-string
7741                            "BEGIN" "END" keyword) "\n")
7742            (goto-char beg)
7743            (insert "#+" keyword " ")
7744            (save-excursion (insert "\n"))))
7745         ((string-match "BEGIN" keyword)
7746          (insert "#+" keyword " ")
7747          (save-excursion
7748            (insert "\n#+" (replace-regexp-in-string
7749                            "BEGIN" "END" keyword) "\n")))
7750         (t (insert "#+" keyword " "))))
7751
7752 (defun anything-c-org-keywords-show-help (keyword)
7753   (info (or (assoc-default (concat "#+" keyword) anything-c-org-keywords-info-location)
7754             "(org)In-buffer settings"))
7755   (search-forward (concat "#+" keyword) nil t)
7756   (anything-persistent-highlight-point)
7757   (message "%s" (or (cdr (assoc keyword (anything-attr 'keywords-examples))) "")))
7758
7759
7760 ;;; Picklist
7761 (defvar anything-c-source-picklist
7762   '((name . "Picklist")
7763     (candidates . (lambda () (mapcar 'car picklist-list)))
7764     (type . file)))
7765 ;; (anything 'anything-c-source-picklist)
7766
7767 ;;; BBDB
7768 (defvar bbdb-records)
7769 (defvar bbdb-buffer-name)
7770 (declare-function bbdb "ext:bbdb-com")
7771 (declare-function bbdb-current-record "ext:bbdb-com")
7772 (declare-function bbdb-redisplay-one-record "ext:bbdb-com")
7773 (declare-function bbdb-record-net "ext:bbdb-com" (string) t)
7774 (declare-function bbdb-current-record "ext:bbdb-com")
7775 (declare-function bbdb-dwim-net-address "ext:bbdb-com")
7776 (declare-function bbdb-records "ext:bbdb-com"
7777                   (&optional dont-check-disk already-in-db-buffer))
7778
7779 (defun anything-c-bbdb-candidates ()
7780   "Return a list of all names in the bbdb database.  The format
7781 is \"Firstname Lastname\"."
7782   (mapcar (lambda (bbdb-record)
7783             (replace-regexp-in-string
7784              "\\s-+$" ""
7785              (concat (aref bbdb-record 0) " " (aref bbdb-record 1))))
7786           (bbdb-records)))
7787
7788 (defun anything-c-bbdb-create-contact (actions candidate)
7789   "Action transformer that returns only an entry to add the
7790 current `anything-pattern' as new contact.  All other actions are
7791 removed."
7792   (if (string= candidate "*Add to contacts*")
7793       '(("Add to contacts" . (lambda (actions)
7794                                (bbdb-create-internal
7795                                 (read-from-minibuffer "Name: " anything-c-bbdb-name)
7796                                 (read-from-minibuffer "Company: ")
7797                                 (read-from-minibuffer "Email: ")
7798                                 nil
7799                                 nil
7800                                 (read-from-minibuffer "Note: ")))))
7801       actions))
7802
7803 (defun anything-c-bbdb-get-record (candidate)
7804   "Return record that match CANDIDATE."
7805   (bbdb candidate nil)
7806   (set-buffer "*BBDB*")
7807   (bbdb-current-record))
7808
7809 (defvar anything-c-bbdb-name nil
7810   "Only for internal use.")
7811
7812 (defvar anything-c-source-bbdb
7813   '((name . "BBDB")
7814     (candidates . anything-c-bbdb-candidates)
7815     (action ("Send a mail" . anything-c-bbdb-compose-mail)
7816      ("View person's data" . anything-c-bbdb-view-person-action))
7817     (filtered-candidate-transformer . (lambda (candidates source)
7818                                         (setq anything-c-bbdb-name anything-pattern)
7819                                         (if (not candidates)
7820                                             (list "*Add to contacts*")
7821                                             candidates)))
7822     (action-transformer . (lambda (actions candidate)
7823                             (anything-c-bbdb-create-contact actions candidate))))
7824   "Needs BBDB.
7825
7826 http://bbdb.sourceforge.net/")
7827 ;; (anything 'anything-c-source-bbdb)
7828
7829 (defun anything-c-bbdb-view-person-action (candidate)
7830   "View BBDB data of single CANDIDATE or marked candidates."
7831   (anything-aif (anything-marked-candidates)
7832       (let ((bbdb-append-records (length it)))
7833         (dolist (i it)
7834           (bbdb-redisplay-one-record (anything-c-bbdb-get-record i))))
7835     (bbdb-redisplay-one-record (anything-c-bbdb-get-record candidate))))
7836
7837 (defun anything-c-bbdb-collect-mail-addresses ()
7838   "Return a list of all mail addresses of records in bbdb buffer."
7839   (with-current-buffer bbdb-buffer-name
7840     (loop for i in bbdb-records
7841        if (bbdb-record-net (car i))
7842        collect (bbdb-dwim-net-address (car i)))))
7843
7844 (defun anything-c-bbdb-compose-mail (candidate)
7845   "Compose a mail with all records of bbdb buffer."
7846   (anything-c-bbdb-view-person-action candidate)
7847   (let* ((address-list (anything-c-bbdb-collect-mail-addresses))
7848          (address-str  (mapconcat 'identity address-list ",\n    ")))
7849     (compose-mail address-str)))
7850
7851 ;;; Evaluation Result
7852 (defvar anything-c-source-evaluation-result
7853   '((name . "Evaluation Result")
7854     (disable-shortcuts)
7855     (dummy)
7856     (multiline)
7857     (mode-line . "C-RET: nl-and-indent, tab: reindent, C-tab:complete, C-p/n: next/prec-line.")
7858     (filtered-candidate-transformer . (lambda (candidates source)
7859                                         (list
7860                                          (condition-case nil
7861                                              (with-current-buffer anything-current-buffer
7862                                                (pp-to-string
7863                                                 (eval (read anything-pattern))))
7864                                            (error "Error")))))
7865     (action . (("Copy result to kill-ring" . (lambda (candidate)
7866                                                (with-current-buffer anything-buffer
7867                                                  (let ((end (save-excursion
7868                                                               (goto-char (point-max))
7869                                                               (search-backward "\n")
7870                                                               (point))))
7871                                                    (kill-region (point) end)))))
7872                ("copy sexp to kill-ring" . (lambda (candidate)
7873                                              (kill-new anything-input)))))))
7874 ;; (anything 'anything-c-source-evaluation-result)
7875
7876 ;;;###autoload
7877 (defun anything-eval-expression (arg)
7878   "Preconfigured anything for `anything-c-source-evaluation-result'."
7879   (interactive "P")
7880   (anything :sources 'anything-c-source-evaluation-result
7881             :input (when arg (thing-at-point 'sexp))
7882             :buffer "*anything eval*"
7883             :keymap anything-eval-expression-map))
7884
7885 (defun anything-eval-new-line-and-indent ()
7886   (interactive)
7887   (newline) (lisp-indent-line))
7888
7889 (defvar anything-eval-expression-map
7890   (let ((map (copy-keymap anything-map)))
7891     (define-key map (kbd "<C-return>") 'anything-eval-new-line-and-indent)
7892     (define-key map (kbd "<tab>")      'lisp-indent-line)
7893     (define-key map (kbd "<C-tab>")    'lisp-complete-symbol)
7894     (define-key map (kbd "C-p")        'previous-line)
7895     (define-key map (kbd "C-n")        'next-line)
7896     (define-key map (kbd "<up>")       'previous-line)
7897     (define-key map (kbd "<down>")     'next-line)
7898     (define-key map (kbd "<right>")    'forward-char)
7899     (define-key map (kbd "<left>")     'backward-char)
7900     map))
7901
7902 (defvar anything-eldoc-active-minibuffers-list nil)
7903 (defun anything-eldoc-store-minibuffer ()
7904   "Store minibuffer buffer name in `anything-eldoc-active-minibuffers-list'."
7905   (with-selected-window (minibuffer-window)
7906     (push (buffer-name) anything-eldoc-active-minibuffers-list)))
7907
7908 ;;;###autoload
7909 (defun anything-eval-expression-with-eldoc ()
7910   "Preconfigured anything for `anything-c-source-evaluation-result' with `eldoc' support. "
7911   (interactive)
7912   (let ((timer (run-with-idle-timer eldoc-idle-delay
7913                                     'repeat 'anything-eldoc-show-in-eval))
7914         (minibuffer-completing-symbol t) ; Enable lisp completion.
7915         (completion-cycle-threshold t))  ; Always cycle, no pesty completion buffer (emacs24 only).
7916     (unwind-protect
7917          (minibuffer-with-setup-hook
7918              'anything-eldoc-store-minibuffer
7919            (call-interactively 'anything-eval-expression))
7920       (and timer (cancel-timer timer))
7921       (setq anything-eldoc-active-minibuffers-list
7922             (cdr anything-eldoc-active-minibuffers-list)))))
7923
7924 (defun anything-eldoc-show-in-eval ()
7925   "Return eldoc in mode-line for current minibuffer input."
7926   (let ((buf (with-selected-window (minibuffer-window)
7927                (buffer-name))))
7928     (when (member buf anything-eldoc-active-minibuffers-list)
7929       (let* ((str-all (with-current-buffer buf
7930                         (minibuffer-completion-contents)))
7931              (sym     (when str-all
7932                         (with-temp-buffer
7933                           (insert str-all)
7934                           (goto-char (point-max))
7935                           (unless (looking-back ")\\|\"") (forward-char -1))
7936                           (eldoc-current-symbol))))
7937              (info-fn (eldoc-fnsym-in-current-sexp))
7938              (doc     (or (eldoc-get-var-docstring sym)
7939                           (eldoc-get-fnsym-args-string
7940                            (car info-fn) (cadr info-fn)))))
7941         (when doc (funcall anything-c-eldoc-in-minibuffer-show-fn doc))))))
7942
7943 (defcustom anything-c-eldoc-in-minibuffer-show-fn 'anything-c-eldoc-show-in-mode-line
7944   "A function to display eldoc info.
7945 Should take one arg: the string to display."
7946   :group 'anything-config
7947   :type  'symbol)
7948
7949 (defvar anything-c-eldoc-show-in-mode-line-delay 12)
7950 (defun anything-c-eldoc-show-in-mode-line (str)
7951   "Show string STR in mode-line."
7952   (save-window-excursion
7953     (with-current-buffer anything-buffer
7954       (let ((mode-line-format (concat " " str)))
7955         (force-mode-line-update)
7956         (sit-for anything-c-eldoc-show-in-mode-line-delay))
7957       (force-mode-line-update))))
7958
7959 ;;; Calculation Result
7960 (defvar anything-c-source-calculation-result
7961   '((name . "Calculation Result")
7962     (dummy)
7963     (filtered-candidate-transformer . (lambda (candidates source)
7964                                         (list
7965                                          (condition-case nil
7966                                              (calc-eval anything-pattern)
7967                                            (error "error")))))
7968     (action ("Copy result to kill-ring" . kill-new))))
7969 ;; (anything 'anything-c-source-calculation-result)
7970
7971 ;;;###autoload
7972 (defun anything-calcul-expression ()
7973   "Preconfigured anything for `anything-c-source-calculation-result'."
7974   (interactive)
7975   (anything-other-buffer 'anything-c-source-calculation-result "*anything calcul*"))
7976
7977 ;;; Google Suggestions
7978 (defvar anything-ggs-max-length-real-flag 0)
7979 (defvar anything-ggs-max-length-num-flag 0)
7980 (defun anything-c-google-suggest-fetch (input)
7981   "Fetch suggestions for INPUT from XML buffer.
7982 Return an alist with elements like (data . number_results)."
7983   (setq anything-ggs-max-length-real-flag 0
7984         anything-ggs-max-length-num-flag 0)
7985   (let ((request (concat anything-c-google-suggest-url
7986                          (url-hexify-string input))))
7987     (flet ((fetch ()
7988              (loop
7989                 with result-alist = (xml-get-children
7990                                      (car (xml-parse-region
7991                                            (point-min) (point-max)))
7992                                      'CompleteSuggestion)
7993                 for i in result-alist
7994                 for data = (cdr (caadr (assoc 'suggestion i)))
7995                 for nqueries = (cdr (caadr (assoc 'num_queries i)))
7996                 for lqueries = (length (anything-c-ggs-set-number-result
7997                                         nqueries))
7998                 for ldata = (length data)
7999                 do
8000                   (progn
8001                     (when (> ldata anything-ggs-max-length-real-flag)
8002                       (setq anything-ggs-max-length-real-flag ldata))
8003                     (when (> lqueries anything-ggs-max-length-num-flag)
8004                       (setq anything-ggs-max-length-num-flag lqueries)))
8005                 collect (cons data nqueries) into cont
8006                 finally return cont)))
8007       (if anything-google-suggest-use-curl-p
8008           (with-temp-buffer
8009             (call-process "curl" nil t nil request)
8010             (fetch))
8011           (with-current-buffer
8012               (url-retrieve-synchronously request)
8013             (fetch))))))
8014
8015 (defun anything-c-google-suggest-set-candidates (&optional request-prefix)
8016   "Set candidates with result and number of google results found."
8017   (let ((suggestions
8018          (loop with suggested-results = (anything-c-google-suggest-fetch
8019                                          (or (and request-prefix
8020                                                   (concat request-prefix " " anything-pattern))
8021                                              anything-pattern))
8022             for (real . numresult) in suggested-results
8023             ;; Prepare number of results with ","
8024             for fnumresult = (anything-c-ggs-set-number-result numresult)
8025             ;; Calculate number of spaces to add before fnumresult
8026             ;; if it is smaller than longest result
8027             ;; `anything-ggs-max-length-num-flag'.
8028             ;; e.g 1,234,567
8029             ;;       345,678
8030             ;; To be sure it is aligned properly.
8031             for nspaces = (if (< (length fnumresult) anything-ggs-max-length-num-flag)
8032                               (- anything-ggs-max-length-num-flag (length fnumresult))
8033                               0)
8034             ;; Add now the spaces before fnumresult.
8035             for align-fnumresult = (concat (make-string nspaces ? ) fnumresult)
8036             for interval = (- anything-ggs-max-length-real-flag (length real))
8037             for spaces   = (make-string (+ 2 interval) ? )
8038             for display = (format "%s%s(%s results)" real spaces align-fnumresult)
8039             collect (cons display real))))
8040     (if (loop for (disp . dat) in suggestions
8041            thereis (equal dat anything-pattern))
8042         suggestions
8043         ;; if there is no suggestion exactly matching the input then
8044         ;; prepend a Search on Google item to the list
8045         (append
8046          suggestions
8047          (list (cons (concat "Search for " "'" anything-input "'" " on Google")
8048                      anything-input))))))
8049
8050 (defun anything-c-ggs-set-number-result (num)
8051   (if num
8052       (progn
8053         (and (numberp num) (setq num (number-to-string num)))
8054         (loop for i in (reverse (split-string num "" t))
8055            for count from 1
8056            append (list i) into C
8057            when (= count 3)
8058            append (list ",") into C
8059            and do (setq count 0)
8060            finally return
8061              (replace-regexp-in-string
8062               "^," "" (mapconcat 'identity (reverse C) ""))))
8063       "?"))
8064
8065 (defvar anything-c-google-suggest-default-browser-function nil
8066   "*The browse url function you prefer to use with google suggest.
8067 When nil, use the first browser function available
8068 See `anything-browse-url-default-browser-alist'.")
8069
8070 (defun anything-c-google-suggest-action (candidate)
8071   "Default action to jump to a google suggested candidate."
8072   (let ((arg (concat anything-c-google-suggest-search-url
8073                                  (url-hexify-string candidate))))
8074     (anything-aif anything-c-google-suggest-default-browser-function
8075         (funcall it arg)
8076       (anything-c-browse-url arg))))
8077
8078 (defvar anything-c-google-suggest-default-function
8079   'anything-c-google-suggest-set-candidates
8080   "Default function to use in anything google suggest.")
8081
8082 (defvar anything-c-source-google-suggest
8083   '((name . "Google Suggest")
8084     (candidates . (lambda ()
8085                     (funcall anything-c-google-suggest-default-function)))
8086     (action . (("Google Search" . anything-c-google-suggest-action)))
8087     (volatile)
8088     (requires-pattern . 3)
8089     (delayed)))
8090
8091 (defun anything-c-google-suggest-emacs-lisp ()
8092   "Try to emacs lisp complete with google suggestions."
8093   (anything-c-google-suggest-set-candidates "emacs lisp"))
8094
8095 ;; (anything 'anything-c-source-google-suggest)
8096
8097 ;;; Yahoo suggestions
8098
8099 (defun anything-c-yahoo-suggest-fetch (input)
8100   "Fetch Yahoo suggestions for INPUT from XML buffer.
8101 Return an alist with elements like (data . number_results)."
8102   (let ((request (concat anything-c-yahoo-suggest-url
8103                          (url-hexify-string input))))
8104     (flet ((fetch ()
8105              (loop
8106                 with result-alist = (xml-get-children
8107                                      (car (xml-parse-region (point-min) (point-max)))
8108                                      'Result)
8109                 for i in result-alist
8110                 collect (caddr i))))
8111       (with-current-buffer
8112           (url-retrieve-synchronously request)
8113         (fetch)))))
8114
8115 (defun anything-c-yahoo-suggest-set-candidates ()
8116   "Set candidates with Yahoo results found."
8117   (let ((suggestions (anything-c-yahoo-suggest-fetch anything-input)))
8118     (or suggestions
8119         (append
8120          suggestions
8121          (list (cons (concat "Search for " "'" anything-input "'" " on Yahoo")
8122                      anything-input))))))
8123
8124 (defun anything-c-yahoo-suggest-action (candidate)
8125   "Default action to jump to a Yahoo suggested candidate."
8126   (anything-c-browse-url (concat anything-c-yahoo-suggest-search-url
8127                                  (url-hexify-string candidate))))
8128
8129 (defvar anything-c-source-yahoo-suggest
8130   '((name . "Yahoo Suggest")
8131     (candidates . anything-c-yahoo-suggest-set-candidates)
8132     (action . (("Yahoo Search" . anything-c-yahoo-suggest-action)))
8133     (volatile)
8134     (requires-pattern . 3)
8135     (delayed)))
8136
8137 ;; (anything 'anything-c-source-yahoo-suggest)
8138
8139 ;;; Surfraw
8140 ;;; Need external program surfraw.
8141 ;;; http://surfraw.alioth.debian.org/
8142 ;; user variables
8143 (require 'browse-url)
8144 ;; If default setting of `w3m-command' is not
8145 ;; what you want you and you modify it, you will have to reeval
8146 ;; also `anything-browse-url-default-browser-alist'.
8147 (defvar w3m-command "/usr/bin/w3m")
8148 (defvar anything-c-home-url "http://www.google.fr"
8149   "*Default url to use as home url.")
8150
8151 (defvar browse-url-chromium-program "chromium-browser")
8152 (defvar browse-url-uzbl-program "uzbl-browser")
8153 (defvar anything-browse-url-default-browser-alist
8154   `((,w3m-command . w3m-browse-url)
8155     (,browse-url-firefox-program . browse-url-firefox)
8156     (,browse-url-chromium-program . browse-url-chromium)
8157     (,browse-url-uzbl-program . browse-url-uzbl)
8158     (,browse-url-kde-program . browse-url-kde)
8159     (,browse-url-gnome-moz-program . browse-url-gnome-moz)
8160     (,browse-url-mozilla-program . browse-url-mozilla)
8161     (,browse-url-galeon-program . browse-url-galeon)
8162     (,browse-url-netscape-program . browse-url-netscape)
8163     (,browse-url-mosaic-program . browse-url-mosaic)
8164     (,browse-url-xterm-program . browse-url-text-xterm))
8165   "*Alist of (executable . function) to try to find a suitable url browser.")
8166
8167 (defun* anything-c-generic-browser (url name &rest args)
8168   "Browse URL with NAME browser."
8169   (let ((proc (concat name " " url)))
8170     (message "Starting %s..." name)
8171     (apply 'start-process proc nil name
8172            (append args (list url)))
8173     (set-process-sentinel
8174      (get-process proc)
8175      #'(lambda (process event)
8176          (when (string= event "finished\n")
8177            (message "%s process %s" process event))))))
8178
8179 (defun browse-url-chromium (url)
8180   "Browse URL with google chrome browser."
8181   (interactive "sURL: ")
8182   (anything-c-generic-browser
8183    url browse-url-chromium-program))
8184
8185 (defun browse-url-uzbl (url &optional ignore)
8186   "Browse URL with uzbl browser."
8187   (interactive "sURL: ")
8188   (anything-c-generic-browser url browse-url-uzbl-program "-u"))
8189
8190 (defun anything-browse-url-default-browser (url &rest args)
8191   "Find the first available browser and ask it to load URL."
8192   (let ((default-browser-fn
8193          (loop for (exe . fn) in anything-browse-url-default-browser-alist
8194             thereis (and exe (executable-find exe) fn))))
8195     (if default-browser-fn
8196         (apply default-browser-fn url args)
8197         (error "No usable browser found"))))
8198
8199 (defun* anything-c-browse-url (&optional (url anything-c-home-url))
8200   "Default command to browse URL."
8201   (if browse-url-browser-function
8202       (browse-url url)
8203       (anything-browse-url-default-browser url)))
8204
8205 (defun anything-c-build-elvi-list ()
8206   "Return list of all engines and descriptions handled by surfraw."
8207   (cdr
8208    (with-temp-buffer
8209      (call-process "surfraw" nil t nil
8210                    "-elvi")
8211      (split-string (buffer-string) "\n"))))
8212
8213 (defvar anything-surfraw-default-browser-function nil
8214   "*The browse url function you prefer to use with surfraw.
8215 When nil, fallback to `browse-url-browser-function'.")
8216 (defvar anything-surfraw-engines-history nil)
8217 ;;;###autoload
8218 (defun anything-surfraw (pattern engine)
8219   "Preconfigured `anything' to search PATTERN with search ENGINE."
8220   (interactive (list (read-string "SearchFor: ")
8221                      (anything-comp-read
8222                       "Engine: "
8223                       (anything-c-build-elvi-list)
8224                       :must-match t
8225                       :name "Surfraw Search Engines"
8226                       :history anything-surfraw-engines-history)))
8227   (let* ((engine-nodesc               (car (split-string engine)))
8228          (url                         (shell-command-to-string
8229                                        (format "surfraw %s -p %s"
8230                                                engine-nodesc pattern)))
8231          (browse-url-browser-function (or anything-surfraw-default-browser-function
8232                                           browse-url-browser-function)))
8233     (if (string= engine-nodesc "W")
8234         (anything-c-browse-url)
8235         (anything-c-browse-url url)
8236         (setq anything-surfraw-engines-history
8237               (cons engine (delete engine anything-surfraw-engines-history))))))
8238
8239 ;;; Emms
8240
8241 (defun anything-emms-stream-edit-bookmark (elm)
8242   "Change the information of current emms-stream bookmark from anything."
8243   (let* ((cur-buf anything-current-buffer)
8244          (bookmark (assoc elm emms-stream-list))
8245          (name     (read-from-minibuffer "Description: "
8246                                          (nth 0 bookmark)))
8247          (url      (read-from-minibuffer "URL: "
8248                                          (nth 1 bookmark)))
8249          (fd       (read-from-minibuffer "Feed Descriptor: "
8250                                          (int-to-string (nth 2 bookmark))))
8251          (type     (read-from-minibuffer "Type (url, streamlist, or lastfm): "
8252                                          (format "%s" (car (last bookmark))))))
8253     (save-excursion
8254       (emms-streams)
8255       (when (re-search-forward (concat "^" name) nil t)
8256         (beginning-of-line)
8257         (emms-stream-delete-bookmark)
8258         (emms-stream-add-bookmark name url (string-to-number fd) type)
8259         (emms-stream-save-bookmarks-file)
8260         (emms-stream-quit)
8261         (anything-c-switch-to-buffer cur-buf)))))
8262
8263 (defun anything-emms-stream-delete-bookmark (elm)
8264   "Delete an emms-stream bookmark from anything."
8265   (let* ((cur-buf anything-current-buffer)
8266          (bookmark (assoc elm emms-stream-list))
8267          (name (nth 0 bookmark)))
8268     (save-excursion
8269       (emms-streams)
8270       (when (re-search-forward (concat "^" name) nil t)
8271         (beginning-of-line)
8272         (emms-stream-delete-bookmark)
8273         (emms-stream-save-bookmarks-file)
8274         (emms-stream-quit)
8275         (anything-c-switch-to-buffer cur-buf)))))
8276
8277 (defvar anything-c-source-emms-streams
8278   '((name . "Emms Streams")
8279     (init . (lambda ()
8280               (emms-stream-init)))
8281     (candidates . (lambda ()
8282                     (mapcar 'car emms-stream-list)))
8283     (action . (("Play" . (lambda (elm)
8284                            (let* ((stream (assoc elm emms-stream-list))
8285                                   (fn (intern (concat "emms-play-" (symbol-name (car (last stream))))))
8286                                   (url (second stream)))
8287                              (funcall fn url))))
8288                ("Delete" . anything-emms-stream-delete-bookmark)
8289                ("Edit" . anything-emms-stream-edit-bookmark)))
8290     (filtered-candidate-transformer . anything-c-adaptive-sort)))
8291 ;; (anything 'anything-c-source-emms-streams)
8292
8293 ;; Don't forget to set `emms-source-file-default-directory'
8294 (defvar anything-c-source-emms-dired
8295   '((name . "Music Directory")
8296     (candidates . (lambda ()
8297                     (cddr (directory-files emms-source-file-default-directory))))
8298     (action .
8299      (("Play Directory" . (lambda (item)
8300                             (emms-play-directory
8301                              (expand-file-name
8302                               item
8303                               emms-source-file-default-directory))))
8304       ("Open dired in file's directory" . (lambda (item)
8305                                             (anything-c-open-dired
8306                                              (expand-file-name
8307                                               item
8308                                               emms-source-file-default-directory))))))
8309     (filtered-candidate-transformer . anything-c-adaptive-sort)))
8310 ;; (anything 'anything-c-source-emms-dired)
8311
8312 (defface anything-emms-playlist
8313     '((t (:foreground "Springgreen4" :underline t)))
8314   "*Face used for tracks in current emms playlist."
8315   :group 'anything)
8316
8317 (defun anything-c-emms-files-modifier (candidates source)
8318   (let ((current-playlist (with-current-emms-playlist
8319                             (loop
8320                                with cur-list = (emms-playlist-tracks-in-region
8321                                                 (point-min) (point-max))
8322                                for i in cur-list
8323                                collect (assoc-default 'name i)))))
8324     (loop for i in candidates
8325        if (member (cdr i) current-playlist)
8326        collect (cons (propertize (car i)
8327                                  'face 'anything-emms-playlist)
8328                      (cdr i)) into lis
8329        else collect i into lis
8330        finally return lis)))
8331
8332 (defun anything-c-emms-play-current-playlist ()
8333   "Play current playlist."
8334   (with-current-emms-playlist
8335     (emms-playlist-first)
8336     (emms-playlist-mode-play-smart)))
8337
8338 (defvar anything-c-source-emms-files
8339   '((name . "Emms files")
8340     (candidates . (lambda ()
8341                     (loop for v being the hash-values in emms-cache-db
8342                        for name      = (assoc-default 'name v)
8343                        for artist    = (or (assoc-default 'info-artist v) "unknown")
8344                        for genre     = (or (assoc-default 'info-genre v) "unknown")
8345                        for tracknum  = (or (assoc-default 'info-tracknumber v) "unknown")
8346                        for song      = (or (assoc-default 'info-title v) "unknown")
8347                        for info      = (concat artist " - " genre " - " tracknum ": " song)
8348                        unless (string-match "^http:" name) collect (cons info name))))
8349     (filtered-candidate-transformer . anything-c-emms-files-modifier)
8350     (action . (("Play file" . emms-play-file)
8351                ("Add to Playlist and play (C-u clear current)"
8352                 . (lambda (candidate)
8353                     (when anything-current-prefix-arg
8354                       (emms-playlist-current-clear))
8355                     (emms-playlist-new)
8356                     (mapc 'emms-add-playlist-file (anything-marked-candidates))
8357                     (unless emms-player-playing-p
8358                       (anything-c-emms-play-current-playlist))))))))
8359
8360 ;; (anything 'anything-c-source-emms-files)
8361
8362 ;;; Jabber Contacts (jabber.el)
8363 (defun anything-c-jabber-online-contacts ()
8364   "List online Jabber contacts."
8365   (with-no-warnings
8366     (let (jids)
8367       (dolist (item (jabber-concat-rosters) jids)
8368         (when (get item 'connected)
8369           (push (if (get item 'name)
8370                     (cons (get item 'name) item)
8371                     (cons (symbol-name item) item)) jids))))))
8372
8373 (defvar anything-c-source-jabber-contacts
8374   '((name . "Jabber Contacts")
8375     (init . (lambda () (require 'jabber)))
8376     (candidates . (lambda () (mapcar 'car (anything-c-jabber-online-contacts))))
8377     (action . (lambda (x)
8378                 (jabber-chat-with
8379                  (jabber-read-account)
8380                  (symbol-name
8381                   (cdr (assoc x (anything-c-jabber-online-contacts)))))))))
8382 ;; (anything 'anything-c-source-jabber-contacts)
8383
8384
8385 ;;; Call source.
8386 (defvar anything-source-select-buffer "*anything source select*")
8387 (defvar anything-c-source-call-source
8388   `((name . "Call anything source")
8389     (candidate-number-limit)
8390     (candidates . (lambda ()
8391                     (loop for vname in (all-completions "anything-c-source-" obarray)
8392                        for var = (intern vname)
8393                        for name = (ignore-errors (assoc-default 'name (symbol-value var)))
8394                        if name collect (cons (format "%s `%s'"
8395                                                      name (propertize vname 'face 'font-lock-variable-name-face))
8396                                              var))))
8397     (action . (("Invoke anything with selected source" .
8398                                                        (lambda (candidate)
8399                                                          (setq anything-candidate-number-limit 9999)
8400                                                          (anything candidate nil nil nil nil
8401                                                                    anything-source-select-buffer)))
8402                ("Describe variable" . describe-variable)
8403                ("Find variable" . find-variable)))
8404     (persistent-action . describe-variable)
8405     (persistent-help . "Show description of this source")))
8406 ;; (anything 'anything-c-source-call-source)
8407
8408 ;;;###autoload
8409 (defun anything-call-source ()
8410   "Preconfigured `anything' to call anything source."
8411   (interactive)
8412   (anything 'anything-c-source-call-source nil nil nil nil
8413             anything-source-select-buffer))
8414
8415 (defun anything-call-source-from-anything ()
8416   "Call anything source within `anything' session."
8417   (interactive)
8418   (setq anything-input-idle-delay 0)
8419   (anything-set-sources '(anything-c-source-call-source)))
8420
8421 ;;; Execute Preconfigured anything.
8422 (defvar anything-c-source-anything-commands
8423   '((name . "Preconfigured Anything")
8424     (candidates . anything-c-anything-commands-candidates)
8425     (type . command)
8426     (candidate-number-limit)))
8427 ;; (anything 'anything-c-source-anything-commands)
8428
8429 (defun anything-c-anything-commands-candidates ()
8430   (loop for (cmd . desc) in (anything-c-list-preconfigured-anything)
8431      collect (cons (if (where-is-internal cmd nil t)
8432                        (substitute-command-keys (format "M-x %s (\\[%s]) : %s" cmd cmd desc))
8433                        (substitute-command-keys (format "\\[%s] : %s" cmd desc)))
8434                    cmd)))
8435
8436 ;;;###autoload
8437 (defun anything-execute-anything-command ()
8438   "Preconfigured `anything' to execute preconfigured `anything'."
8439   (interactive)
8440   (anything-other-buffer 'anything-c-source-anything-commands
8441                          "*anything commands*"))
8442
8443 ;; Occur
8444 (defun anything-c-occur-init ()
8445   (anything-candidate-buffer anything-current-buffer))
8446
8447 (defun anything-c-occur-get-line (s e)
8448   (format "%7d:%s" (line-number-at-pos (1- s)) (buffer-substring s e)))
8449
8450 (defvar anything-c-source-occur
8451   '((name . "Occur")
8452     (init . anything-c-occur-init)
8453     (candidates-in-buffer)
8454     (migemo)
8455     (get-line . anything-c-occur-get-line)
8456     (type . line)
8457     (recenter)
8458     (requires-pattern . 1)
8459     (delayed)
8460     (volatile)))
8461 ;; (anything 'anything-c-source-occur)
8462
8463 ;;; Anything browse code.
8464 (defun anything-c-browse-code-get-line (beg end)
8465   "Select line if it match the regexp corresponding to current `major-mode'.
8466 Line is parsed for BEG position to END position."
8467   (let ((str-line (buffer-substring beg end))
8468         (regexp   (assoc-default major-mode
8469                                  anything-c-browse-code-regexp-alist))
8470         (num-line (if (string= anything-pattern "") beg (1- beg))))
8471     (when (and regexp (string-match regexp str-line))
8472       (format "%4d:%s" (line-number-at-pos num-line) str-line))))
8473
8474
8475 (defvar anything-c-source-browse-code
8476   '((name . "Browse code")
8477     (init . (lambda ()
8478               (anything-candidate-buffer anything-current-buffer)
8479               (with-current-buffer anything-current-buffer
8480                 (jit-lock-fontify-now))))
8481     (candidate-number-limit . 9999)
8482     (candidates-in-buffer)
8483     (get-line . anything-c-browse-code-get-line)
8484     (type . line)
8485     (recenter)))
8486
8487 ;; Do many actions for input
8488 (defvar anything-c-source-create
8489   '((name . "Create")
8490     (dummy)
8491     (action)
8492     (action-transformer . anything-create--actions))
8493   "Do many create actions from `anything-pattern'.
8494 See also `anything-create--actions'.")
8495 ;; (anything 'anything-c-source-create)
8496
8497 (defun anything-create-from-anything ()
8498   "Run `anything-create' from `anything' as a fallback."
8499   (interactive)
8500   (anything-run-after-quit 'anything-create nil anything-pattern))
8501
8502 ;;;###autoload
8503 (defun anything-create (&optional string initial-input)
8504   "Preconfigured `anything' to do many create actions from STRING.
8505 See also `anything-create--actions'."
8506   (interactive)
8507   (setq string (or string (read-string "Create Anything: " initial-input)))
8508   (anything '(((name . "Anything Create")
8509                (header-name . (lambda (_) (format "Action for \"%s\"" string)))
8510                (candidates . anything-create--actions)
8511                (candidate-number-limit)
8512                (action . (lambda (func) (funcall func string)))))))
8513
8514 (defun anything-create--actions (&rest ignored)
8515   "Default actions for `anything-create' / `anything-c-source-create'."
8516   (remove-if-not
8517    (lambda (pair) (and (consp pair) (functionp (cdr pair))))
8518    (append anything-create--actions-private
8519            '(("find-file" . find-file)
8520              ("find-file other window" . find-file-other-window)
8521              ("New buffer" . anything-c-switch-to-buffer)
8522              ("New buffer other window" . switch-to-buffer-other-window)
8523              ("Bookmark Set" . bookmark-set)
8524              ("Set Register" .
8525               (lambda (x) (set-register (read-char "Register: ") x)))
8526              ("Insert Linkd star" . linkd-insert-star)
8527              ("Insert Linkd Tag" . linkd-insert-tag)
8528              ("Insert Linkd Link" . linkd-insert-link)
8529              ("Insert Linkd Lisp" . linkd-insert-lisp)
8530              ("Insert Linkd Wiki" . linkd-insert-wiki)
8531              ("Google Search" . google)))))
8532
8533 ;; Minibuffer History
8534 (defvar anything-c-source-minibuffer-history
8535   '((name . "Minibuffer History")
8536     (header-name . (lambda (name) (format "%s (%s)" name minibuffer-history-variable)))
8537     (candidates
8538      . (lambda ()
8539          (let ((history (loop
8540                            for i in (symbol-value minibuffer-history-variable)
8541                            unless (string= "" i) collect i)))
8542            (if (consp (car history))
8543                (mapcar 'prin1-to-string history)
8544                history))))
8545     (migemo)
8546     (action . insert)))
8547 ;; (anything 'anything-c-source-minibuffer-history)
8548
8549 ;; elscreen
8550 (defvar anything-c-source-elscreen
8551   '((name . "Elscreen")
8552     (candidates . (lambda ()
8553                     (if (cdr (elscreen-get-screen-to-name-alist))
8554                         (sort
8555                          (loop for sname in (elscreen-get-screen-to-name-alist)
8556                             append (list (format "[%d] %s" (car sname) (cdr sname))) into lst
8557                             finally (return lst))
8558                          #'(lambda (a b) (compare-strings a nil nil b nil nil))))))
8559     (action . (("Change Screen".
8560                                (lambda (candidate)
8561                                  (elscreen-goto (- (aref candidate 1) (aref "0" 0)))))
8562                ("Kill Screen(s)".
8563                                 (lambda (candidate)
8564                                   (dolist (i (anything-marked-candidates))
8565                                     (elscreen-goto (- (aref i 1) (aref "0" 0)))
8566                                     (elscreen-kill))))
8567                ("Only Screen".
8568                              (lambda (candidate)
8569                                (elscreen-goto (- (aref candidate 1) (aref "0" 0)))
8570                                (elscreen-kill-others)))))))
8571 ;; (anything 'anything-c-source-elscreen)
8572
8573 ;;;; <System>
8574
8575 ;;; Top (process)
8576 (defvar anything-c-top-command "COLUMNS=%s top -b -n 1"
8577   "Top command (batch mode). %s is replaced with `frame-width'.")
8578 (defvar anything-c-source-top
8579   '((name . "Top (Press C-c C-u to refresh)")
8580     (init . anything-c-top-init)
8581     (candidates-in-buffer)
8582     (display-to-real . anything-c-top-display-to-real)
8583     (update . anything-c-top-update)
8584     (persistent-action . anything-c-top-sh-persistent-action)
8585     (persistent-help . "SIGTERM")
8586     (action
8587      ("kill (TERM)" . (lambda (pid) (anything-c-top-sh (format "kill -TERM %s" pid))))
8588      ("kill (KILL)" . (lambda (pid) (anything-c-top-sh (format "kill -KILL %s" pid))))
8589      ("Copy PID" . (lambda (pid) (kill-new pid))))))
8590 ;; (anything 'anything-c-source-top)
8591
8592 (defun anything-c-top-sh (cmd)
8593   (message "Executed %s\n%s" cmd (shell-command-to-string cmd)))
8594
8595 (defun anything-c-top-sh-persistent-action (pid)
8596   (delete-other-windows)
8597   (anything-c-top-sh (format "kill -TERM %s" pid))
8598   (anything-force-update))
8599
8600 (defun anything-c-top-init ()
8601   (with-current-buffer (anything-candidate-buffer 'global)
8602     (call-process-shell-command
8603      (format anything-c-top-command
8604              (- (frame-width) (if anything-enable-digit-shortcuts 4 0)))
8605      nil (current-buffer))))
8606
8607 (defun anything-c-top-display-to-real (line)
8608   (car (split-string line)))
8609
8610 (defun anything-c-top-update ()
8611   (let ((anything-source-name (assoc-default 'name anything-c-source-top))) ;UGLY HACK
8612     (anything-c-top-init)))
8613
8614 ;;;###autoload
8615 (defun anything-top ()
8616   "Preconfigured `anything' for top command."
8617   (interactive)
8618   (let ((anything-samewindow t)
8619         (anything-enable-shortcuts)
8620         (anything-display-function 'anything-default-display-buffer)
8621         (anything-candidate-number-limit 9999))
8622     (save-window-excursion
8623       (delete-other-windows)
8624       (anything-other-buffer 'anything-c-source-top "*anything top*"))))
8625
8626 ;;; Timers
8627 (defvar anything-c-source-absolute-time-timers
8628   '((name . "Absolute Time Timers")
8629     (candidates . timer-list)
8630     (type . timer)))
8631 ;; (anything 'anything-c-source-absolute-time-timers)
8632
8633 (defvar anything-c-source-idle-time-timers
8634   '((name . "Idle Time Timers")
8635     (candidates . timer-idle-list)
8636     (type . timer)))
8637 ;; (anything 'anything-c-source-idle-time-timers)
8638
8639 (defun anything-c-timer-real-to-display (timer)
8640   (destructuring-bind (triggered t1 t2 t3 repeat-delay func args idle-delay)
8641       (append timer nil)                ;use `append' to convert vector->list
8642     (format "%s repeat=%5S %s(%s)"
8643             (let ((time (list t1 t2 t3)))
8644               (if idle-delay
8645                   (format-time-string "idle-for=%5s" time)
8646                   (format-time-string "%m/%d %T" time)))
8647             repeat-delay
8648             func
8649             (mapconcat 'prin1-to-string args " "))))
8650
8651 ;;; X RandR resolution change
8652 ;;; FIXME I do not care multi-display.
8653 (defvar anything-c-xrandr-output "VGA")
8654 (defvar anything-c-xrandr-screen "0")
8655 (defvar anything-c-source-xrandr-change-resolution
8656   '((name . "Change Resolution")
8657     (candidates
8658      . (lambda ()
8659          (with-temp-buffer
8660            (call-process "xrandr" nil (current-buffer) nil
8661                          "--screen" anything-c-xrandr-screen "-q")
8662            (goto-char 1)
8663            (loop while (re-search-forward "   \\([0-9]+x[0-9]+\\)" nil t)
8664               collect (match-string 1)))))
8665     (action
8666      ("Change Resolution" . (lambda (mode)
8667                               (call-process "xrandr" nil nil nil
8668                                             "--screen" anything-c-xrandr-screen
8669                                             "--output" anything-c-xrandr-output
8670                                             "--mode" mode))))))
8671 ;; (anything 'anything-c-source-xrandr-change-resolution)
8672
8673 ;;; Xfont selection
8674 (defun anything-c-persistent-xfont-action (elm)
8675   "Show current font temporarily"
8676   (let ((current-font (cdr (assoc 'font (frame-parameters))))
8677         (default-font elm))
8678     (unwind-protect
8679          (progn (set-frame-font default-font 'keep-size) (sit-for 2))
8680       (set-frame-font current-font))))
8681
8682 (defvar anything-c-xfonts-cache nil)
8683 (defvar anything-c-source-xfonts
8684   '((name . "X Fonts")
8685     (init . (lambda ()
8686               (unless anything-c-xfonts-cache
8687                 (setq anything-c-xfonts-cache
8688                       (x-list-fonts "*")))))
8689     (candidates . anything-c-xfonts-cache)
8690     (action . (("Copy to kill ring" . (lambda (elm)
8691                                         (kill-new elm)))
8692                ("Set Font" . (lambda (elm)
8693                                (kill-new elm)
8694                                (set-frame-font elm 'keep-size)
8695                                (message "New font have been copied to kill ring")))))
8696     (persistent-action . anything-c-persistent-xfont-action)
8697     (persistent-help . "Switch to this font temporarily")))
8698
8699 ;;;###autoload
8700 (defun anything-select-xfont ()
8701   "Preconfigured `anything' to select Xfont."
8702   (interactive)
8703   (anything-other-buffer 'anything-c-source-xfonts "*anything select* xfont"))
8704
8705 ;; (anything 'anything-c-source-xfonts)
8706
8707 ;;; World time
8708
8709 (defvar anything-c-source-time-world
8710   '((name . "Time World List")
8711     (init . (lambda ()
8712               (let ((anything-buffer (anything-candidate-buffer 'global)))
8713                 (with-current-buffer anything-buffer
8714                   (display-time-world-display display-time-world-list)))))
8715     (candidates-in-buffer)))
8716
8717 ;;;###autoload
8718 (defun anything-world-time ()
8719   "Preconfigured `anything' to show world time."
8720   (interactive)
8721   (anything-other-buffer 'anything-c-source-time-world "*anything world time*"))
8722
8723 ;;; Source for Debian/Ubuntu users
8724 (defvar anything-c-source-apt
8725   '((name . "APT")
8726     (init . anything-c-apt-init)
8727     (candidates-in-buffer)
8728     (candidate-transformer anything-c-apt-candidate-transformer)
8729     (display-to-real . anything-c-apt-display-to-real)
8730     (candidate-number-limit . 9999)
8731     (action
8732      ("Show package description" . anything-c-apt-cache-show)
8733      ("Install package" . anything-c-apt-install)
8734      ("Remove package" . anything-c-apt-uninstall)
8735      ("Purge package" . anything-c-apt-purge))
8736     (persistent-action . anything-c-apt-persistent-action)
8737     (persistent-help . "Show - C-u Refresh")))
8738 ;; (anything 'anything-c-source-apt)
8739
8740 (defvar anything-c-apt-query "emacs")
8741 (defvar anything-c-apt-search-command "apt-cache search '%s'")
8742 (defvar anything-c-apt-show-command "apt-cache show '%s'")
8743 (defvar anything-c-apt-installed-packages nil)
8744
8745 (defface anything-apt-installed
8746     '((t (:foreground "green")))
8747   "*Face used for apt installed candidates."
8748   :group 'anything)
8749
8750 (defun anything-c-apt-refresh ()
8751   "Refresh installed candidates list."
8752   (setq anything-c-apt-installed-packages nil)
8753   (anything-force-update))
8754
8755 (defun anything-c-apt-persistent-action (candidate)
8756   "Persistent action for APT source."
8757   (if current-prefix-arg
8758       (anything-c-apt-refresh)
8759       (anything-c-apt-cache-show candidate)))
8760
8761 ;;;###autoload
8762 (defun anything-apt (query)
8763   "Preconfigured `anything' : frontend of APT package manager."
8764   (interactive "sAPT search: ")
8765   (let ((anything-c-apt-query query))
8766     (anything 'anything-c-source-apt)))
8767
8768 (defun anything-c-apt-candidate-transformer (candidates)
8769   "Show installed candidates in a different color."
8770   (loop
8771      with all
8772      for cand in candidates
8773      for name = (anything-c-apt-display-to-real cand)
8774      if (member name anything-c-apt-installed-packages)
8775      collect (propertize cand 'face 'anything-apt-installed) into all
8776      else collect cand into all finally return all))
8777
8778 (defun anything-c-apt-init ()
8779   "Initialize list of debian packages."
8780   (unless anything-c-apt-installed-packages
8781     (message "Updating installed candidate list...")
8782     (setq anything-c-apt-installed-packages
8783           (with-temp-buffer
8784             (call-process-shell-command "dpkg --get-selections"
8785                                         nil (current-buffer))
8786             (loop for i in (split-string (buffer-string) "\n" t)
8787                collect (car (split-string i))))))
8788   (with-current-buffer
8789       (anything-candidate-buffer
8790        (get-buffer-create (format "*anything-apt:%s*" anything-c-apt-query)))
8791     (erase-buffer)
8792     (call-process-shell-command
8793      (format anything-c-apt-search-command anything-c-apt-query)
8794      nil (current-buffer)))
8795   (message "Updating installed candidate list...done"))
8796
8797 (defun anything-c-apt-display-to-real (line)
8798   "Return only name of a debian package.
8799 LINE is displayed like:
8800 package name - description."
8801   (car (split-string line " - ")))
8802
8803 ;;;###autoload
8804 (defun anything-c-shell-command-if-needed (command)
8805   (interactive "sShell command: ")
8806   (if (get-buffer command)              ; if the buffer already exists
8807       (anything-c-switch-to-buffer command)     ; then just switch to it
8808       (anything-c-switch-to-buffer command)     ; otherwise create it
8809       (insert (shell-command-to-string command))))
8810
8811 (defun anything-c-apt-cache-show (package)
8812   (anything-c-shell-command-if-needed (format anything-c-apt-show-command package)))
8813
8814 (defun anything-c-apt-install (package)
8815   (anything-c-apt-install1 :action 'install))
8816
8817 (defun anything-c-apt-uninstall (package)
8818   (anything-c-apt-install1 :action 'uninstall))
8819
8820 (defun anything-c-apt-purge (package)
8821   (anything-c-apt-install1 :action 'purge))
8822
8823 (defun* anything-c-apt-install1 (&key action)
8824   (ansi-term (getenv "SHELL") "anything apt")
8825   (term-line-mode)
8826   (let ((command   (case action
8827                    ('install   "sudo apt-get install ")
8828                    ('uninstall "sudo apt-get remove ")
8829                    ('purge     "sudo apt-get purge ")
8830                    (t          (error "Unknow action"))))
8831         (beg       (point))
8832         end
8833         (cand-list (mapconcat #'(lambda (x) (format "'%s'" x))
8834                               (anything-marked-candidates) " ")))
8835     (goto-char (point-max))
8836     (insert (concat command cand-list))
8837     (setq end (point))
8838     (if (y-or-n-p (format "%s package" (symbol-name action)))
8839         (progn
8840           (setq anything-c-external-commands-list nil)
8841           (setq anything-c-apt-installed-packages nil)
8842           (term-char-mode) (term-send-input))
8843         (delete-region beg end) (term-send-eof) (kill-buffer))))
8844
8845 ;; (anything-c-apt-install "jed")
8846
8847 ;;; Sources for gentoo users
8848 (defvar anything-c-gentoo-use-flags nil)
8849 (defvar anything-c-gentoo-buffer "*anything-gentoo-output*")
8850 (defvar anything-c-cache-gentoo nil)
8851 (defvar anything-c-cache-world nil)
8852 (defvar anything-c-source-gentoo
8853   '((name . "Portage sources")
8854     (init . (lambda ()
8855               (get-buffer-create anything-c-gentoo-buffer)
8856               (unless anything-c-cache-gentoo
8857                 (anything-c-gentoo-setup-cache))
8858               (unless anything-c-cache-world
8859                 (setq anything-c-cache-world (anything-c-gentoo-get-world)))
8860               (anything-c-gentoo-init-list)))
8861     (candidates-in-buffer)
8862     (match . identity)
8863     (candidate-transformer anything-c-highlight-world)
8864     (action . (("Show package" . (lambda (elm)
8865                                    (anything-c-gentoo-eshell-action elm "eix")))
8866                ("Show history" . (lambda (elm)
8867                                    (if (member elm anything-c-cache-world)
8868                                        (anything-c-gentoo-eshell-action elm "genlop -qe")
8869                                        (message "No infos on packages not yet installed"))))
8870                ("Copy in kill-ring" . kill-new)
8871                ("insert at point" . insert)
8872                ("Browse HomePage" . (lambda (elm)
8873                                       (let ((urls (anything-c-gentoo-get-url elm)))
8874                                         (browse-url (anything-comp-read "Url: " urls :must-match t)))))
8875                ("Show extra infos" . (lambda (elm)
8876                                        (if (member elm anything-c-cache-world)
8877                                            (anything-c-gentoo-eshell-action elm "genlop -qi")
8878                                            (message "No infos on packages not yet installed"))))
8879                ("Show use flags" . (lambda (elm)
8880                                      (anything-c-gentoo-default-action elm "equery" "-C" "u")
8881                                      (font-lock-add-keywords nil '(("^\+.*" . font-lock-variable-name-face)))
8882                                      (font-lock-mode 1)))
8883                ("Run emerge pretend" . (lambda (elm)
8884                                          (anything-c-gentoo-eshell-action elm "emerge -p")))
8885                ("Emerge" . (lambda (elm)
8886                              (anything-gentoo-install elm :action 'install)))
8887                ("Unmerge" . (lambda (elm)
8888                               (anything-gentoo-install elm :action 'uninstall)))
8889                ("Show dependencies" . (lambda (elm)
8890                                         (anything-c-gentoo-default-action elm "equery" "-C" "d")))
8891                ("Show related files" . (lambda (elm)
8892                                          (anything-c-gentoo-default-action elm "equery" "files")))
8893                ("Refresh" . (lambda (elm)
8894                               (anything-c-gentoo-setup-cache)
8895                               (setq anything-c-cache-world (anything-c-gentoo-get-world))))))))
8896
8897 ;; (anything 'anything-c-source-gentoo)
8898
8899 (defun* anything-gentoo-install (candidate &key action)
8900   (setq anything-c-external-commands-list nil)
8901   (ansi-term (getenv "SHELL") "Gentoo emerge")
8902   (term-line-mode)
8903   (let ((command (case action
8904                    ('install "sudo emerge -av ")
8905                    ('uninstall "sudo emerge -avC ")
8906                    (t (error "Unknow action"))))
8907         (elms (mapconcat 'identity (anything-marked-candidates) " "))
8908         (beg (point)) end)
8909     (goto-char (point-max))
8910     (insert (concat command elms))
8911     (setq end (point))
8912     (term-char-mode) (term-send-input)))
8913
8914 (defun anything-c-gentoo-default-action (elm command &rest args)
8915   "Gentoo default action that use `anything-c-gentoo-buffer'."
8916   (if (member elm anything-c-cache-world)
8917       (progn
8918         (anything-c-switch-to-buffer anything-c-gentoo-buffer)
8919         (erase-buffer)
8920         (let ((com-list (append args (list elm))))
8921           (apply #'call-process command nil t nil
8922                  com-list)))
8923       (message "No infos on packages not yet installed")))
8924
8925 (defvar anything-c-source-use-flags
8926   '((name . "Use Flags")
8927     (init . (lambda ()
8928               (unless anything-c-gentoo-use-flags
8929                 (anything-c-gentoo-setup-use-flags-cache))
8930               (anything-c-gentoo-get-use)))
8931     (candidates-in-buffer)
8932     (match . identity)
8933     (candidate-transformer anything-c-highlight-local-use)
8934     (action . (("Description"
8935                 . (lambda (elm)
8936                     (anything-c-switch-to-buffer anything-c-gentoo-buffer)
8937                     (erase-buffer)
8938                     (apply #'call-process "euse" nil t nil
8939                            `("-i"
8940                              ,elm))
8941                     (font-lock-add-keywords nil `((,elm . font-lock-variable-name-face)))
8942                     (font-lock-mode 1)))
8943                ("Enable"
8944                 . (lambda (elm)
8945                     (anything-c-gentoo-eshell-action elm "*sudo -p Password: euse -E")))
8946                ("Disable"
8947                 . (lambda (elm)
8948                     (anything-c-gentoo-eshell-action elm "*sudo -p Password: euse -D")))
8949                ("Remove"
8950                 . (lambda (elm)
8951                     (anything-c-gentoo-eshell-action elm "*sudo -p Password: euse -P")))
8952                ("Show which dep use this flag"
8953                 . (lambda (elm)
8954                     (anything-c-switch-to-buffer anything-c-gentoo-buffer)
8955                     (erase-buffer)
8956                     (apply #'call-process "equery" nil t nil
8957                            `("-C"
8958                              "h"
8959                              ,elm))))))))
8960
8961
8962 ;; (anything 'anything-c-source-use-flags)
8963
8964 (defun anything-c-gentoo-init-list ()
8965   "Initialize buffer with all packages in Portage."
8966   (let* ((portage-buf (get-buffer-create "*anything-gentoo*"))
8967          (buf (anything-candidate-buffer 'portage-buf)))
8968     (with-current-buffer buf
8969       (dolist (i anything-c-cache-gentoo)
8970         (insert (concat i "\n"))))))
8971
8972 (defun anything-c-gentoo-setup-cache ()
8973   "Set up `anything-c-cache-gentoo'"
8974   (setq anything-c-cache-gentoo
8975         (split-string (with-temp-buffer
8976                         (call-process "eix" nil t nil
8977                                       "--only-names")
8978                         (buffer-string)))))
8979
8980 (defun anything-c-gentoo-eshell-action (elm command)
8981   (when (get-buffer "*EShell Command Output*")
8982     (kill-buffer "*EShell Command Output*"))
8983   (message "Wait searching...")
8984   (let ((buf-fname (buffer-file-name anything-current-buffer)))
8985     (if (and buf-fname (string-match tramp-file-name-regexp buf-fname))
8986         (progn
8987           (save-window-excursion
8988             (pop-to-buffer "*scratch*")
8989             (eshell-command (format "%s %s" command elm)))
8990           (pop-to-buffer "*EShell Command Output*"))
8991         (eshell-command (format "%s %s" command elm)))))
8992
8993 (defun anything-c-gentoo-get-use ()
8994   "Initialize buffer with all use flags."
8995   (let* ((use-buf (get-buffer-create "*anything-gentoo-use*"))
8996          (buf (anything-candidate-buffer 'use-buf)))
8997     (with-current-buffer buf
8998       (dolist (i anything-c-gentoo-use-flags)
8999         (insert (concat i "\n"))))))
9000
9001
9002 (defun anything-c-gentoo-setup-use-flags-cache ()
9003   "Setup `anything-c-gentoo-use-flags'"
9004   (setq anything-c-gentoo-use-flags
9005         (split-string (with-temp-buffer
9006                         (call-process "eix" nil t nil
9007                                       "--print-all-useflags")
9008                         (buffer-string)))))
9009
9010 (defun anything-c-gentoo-get-url (elm)
9011   "Return a list of urls from eix output."
9012   (loop
9013      with url-list = (split-string
9014                       (with-temp-buffer
9015                         (call-process "eix" nil t nil
9016                                       elm "--format" "<homepage>\n")
9017                         (buffer-string)))
9018      with all
9019      for i in url-list
9020      when (and (string-match "^http://.*" i)
9021                (not (member i all)))
9022      collect i into all
9023      finally return all))
9024
9025 (defun anything-c-gentoo-get-world ()
9026   "Return list of all installed package on your system."
9027   (split-string (with-temp-buffer
9028                   (call-process "qlist" nil t nil
9029                                 "-I")
9030                   (buffer-string))))
9031
9032 (defun anything-c-gentoo-get-local-use ()
9033   (split-string (with-temp-buffer
9034                   (call-process "portageq" nil t nil
9035                                 "envvar"
9036                                 "USE")
9037                   (buffer-string))))
9038
9039 (defface anything-gentoo-match-face '((t (:foreground "red")))
9040   "Face for anything-gentoo installed packages."
9041   :group 'traverse-faces)
9042
9043 (defun anything-c-highlight-world (eix)
9044   "Highlight all installed package."
9045   (loop for i in eix
9046      if (member i anything-c-cache-world)
9047      collect (propertize i 'face 'anything-gentoo-match-face)
9048      else
9049      collect i))
9050
9051 (defun anything-c-highlight-local-use (use-flags)
9052   (let ((local-uses (anything-c-gentoo-get-local-use)))
9053     (loop for i in use-flags
9054        if (member i local-uses)
9055        collect (propertize i 'face 'anything-gentoo-match-face)
9056        else
9057        collect i)))
9058
9059 (defvar anything-c-source-emacs-process
9060   '((name . "Emacs Process")
9061     (candidates . (lambda () (mapcar #'process-name (process-list))))
9062     (persistent-action . (lambda (elm)
9063                            (delete-process (get-process elm))
9064                            (anything-delete-current-selection)))
9065     (persistent-help . "Kill Process")
9066     (action ("Kill Process" . (lambda (elm)
9067                                 (delete-process (get-process elm)))))))
9068
9069 ;; (anything 'anything-c-source-emacs-process)
9070
9071 ;;; Anything `completing-read' replacement
9072 ;;
9073 ;;
9074 (defun anything-comp-read-get-candidates (collection &optional test sort-fn alistp)
9075   "Convert COLLECTION to list removing elements that don't match TEST.
9076 SORT-FN is a predicate to sort COLLECTION.
9077 ALISTP is a flag to not use `all-completions' which doesn't handle alists correctly\
9078 for anything.
9079 If collection is an `obarray', a TEST is needed. See `obarray'."
9080   (let ((cands
9081          (cond ((and (eq collection obarray) test)
9082                 (all-completions "" collection test))
9083                ((and (vectorp collection) test)
9084                 (loop for i across collection when (funcall test i) collect i))
9085                ((vectorp collection)
9086                 (loop for i across collection collect i))
9087                ((and alistp test)
9088                 (loop for i in collection when (funcall test i) collect i))
9089                (alistp collection)
9090                ((and collection test)
9091                 (all-completions "" collection test))
9092                (t (all-completions "" collection)))))
9093     (if sort-fn (sort cands sort-fn) cands)))
9094
9095 (defun anything-cr-default-transformer (candidates source)
9096   "Default filter candidate function for `anything-comp-read'.
9097 Do nothing, just return candidate list unmodified."
9098   candidates)
9099
9100 (defun* anything-comp-read (prompt collection
9101                                    &key
9102                                    test
9103                                    initial-input
9104                                    (buffer "*Anything Completions*")
9105                                    must-match
9106                                    (requires-pattern 0)
9107                                    (history nil)
9108                                    (persistent-action nil)
9109                                    (persistent-help "DoNothing")
9110                                    (name "Anything Completions")
9111                                    (volatile t)
9112                                    sort
9113                                    (fc-transformer 'anything-cr-default-transformer)
9114                                    (marked-candidates nil)
9115                                    (alistp t))
9116   "Anything `completing-read' emulation.
9117 PROMPT is the prompt name to use.
9118 COLLECTION can be a list, vector, obarray or hash-table.
9119 Keys:
9120
9121 TEST: A predicate called with one arg i.e candidate.
9122 INITIAL-INPUT: Same as initial-input arg in `anything'.
9123 BUFFER: Name of anything-buffer.
9124 MUST-MATCH: Candidate selected must be one of COLLECTION.
9125 REQUIRES-PATTERN: Same as anything attribute, default is 0.
9126 HISTORY: A list containing specific history, default is nil.
9127 When it is non--nil, all elements of HISTORY are displayed in
9128 anything-buffer before COLLECTION.
9129 PERSISTENT-ACTION: A function called with one arg i.e candidate.
9130 PERSISTENT-HELP: A string to document PERSISTENT-ACTION.
9131 NAME: The name related to this local source.
9132 VOLATILE: Use volatile attribute.
9133 SORT: A predicate to give to `sort' e.g `string-lessp'.
9134 FC-TRANSFORMER: A `filtered-candidate-transformer' function.
9135 MARKED-CANDIDATES: If non--nil return candidate or marked candidates as a list.
9136 ALISTP: when non--nil \(default\) cdr of alist is returned otherwise it is the car.
9137
9138 Any prefix args passed during `anything-comp-read' invocation will be recorded
9139 in `anything-current-prefix-arg', otherwise if prefix args where given before
9140 `anything-comp-read' invocation, the value of `current-prefix-arg' will be used.
9141 That's mean you can pass prefix arg before or after calling
9142 a command that use `anything-comp-read'.
9143 It support now also a function as argument, See `all-completions' for more details."
9144   (when (get-buffer anything-action-buffer)
9145     (kill-buffer anything-action-buffer))
9146   (flet ((action-fn (candidate)
9147            (if marked-candidates
9148                (anything-marked-candidates)
9149                (identity candidate))))
9150     (let ((hist `((name . ,(format "%s History" name))
9151                   (candidates . (lambda ()
9152                                   (anything-comp-read-get-candidates
9153                                    history nil nil ,alistp)))
9154                   (persistent-action . ,persistent-action)
9155                   (persistent-help . ,persistent-help)
9156                   (action . ,'action-fn)))
9157           (src `((name . ,name)
9158                  (candidates
9159                   . (lambda ()
9160                       (let ((cands (anything-comp-read-get-candidates
9161                                     collection test sort alistp)))
9162                         (if (or must-match (string= anything-pattern ""))
9163                             cands (append (list anything-pattern) cands)))))
9164                  (filtered-candidate-transformer ,fc-transformer)
9165                  (requires-pattern . ,requires-pattern)
9166                  (persistent-action . ,persistent-action)
9167                  (persistent-help . ,persistent-help)
9168                  (action . ,'action-fn))))
9169       (when volatile (setq src (append src '((volatile)))))
9170       (or (anything
9171            :sources `(,hist ,src)
9172            :input initial-input
9173            :prompt prompt
9174            :resume 'noresume
9175            :buffer buffer)
9176           (keyboard-quit)))))
9177
9178 ;; Generic completing-read
9179 ;;
9180 ;; Support also function as collection.
9181 ;; e.g M-x man is supported.
9182 ;; Support hash-table and vectors as collection.
9183 ;; NOTE:
9184 ;; Some crap emacs functions may not be supported
9185 ;; like ffap-alternate-file (bad use of completing-read)
9186 ;; and maybe others.
9187 ;; Provide a mode `anything-completion-mode' which turn on
9188 ;; anything in all `completing-read' and `read-file-name' in Emacs.
9189 ;;
9190 (defun anything-completing-read-default
9191     (prompt collection &optional
9192                          predicate require-match
9193                          initial-input hist def
9194                          inherit-input-method)
9195     "An anything replacement of `completing-read'.
9196
9197 Don't use it directly, use instead `anything-comp-read' in your programs \
9198 which is more powerful.
9199
9200 See documentation of `completing-read' and `all-completions' for details."
9201   (let ((init (or def initial-input)))
9202     (anything-comp-read
9203      prompt collection
9204      :test predicate
9205      :fc-transformer #'(lambda (candidates source)
9206                          (loop for i in candidates
9207                             if (consp i) collect (car i)
9208                             else collect i))
9209      :history (eval (or (car-safe hist) hist))
9210      :must-match require-match
9211      :alistp nil
9212      :initial-input init)))
9213
9214 (defun anything-generic-read-file-name
9215     (prompt &optional dir default-filename mustmatch initial predicate)
9216   "An anything replacement of `read-file-name'."
9217   (let* ((default (and default-filename
9218                       (if (listp default-filename)
9219                           (car default-filename)
9220                           default-filename)))
9221          (init (or default initial dir default-directory))
9222          (ini-input (and init (expand-file-name init))))
9223     (anything-c-read-file-name prompt
9224                                :initial-input init
9225                                :alistp nil
9226                                :must-match mustmatch
9227                                :test predicate)))
9228
9229 (defvar anything-completion-mode-string " AC")
9230 ;;;###autoload
9231 (define-minor-mode anything-completion-mode
9232     "Toggle generic anything completion."
9233   :group 'anything
9234   :global t
9235   :lighter anything-completion-mode-string
9236   (if anything-completion-mode
9237       (progn
9238         (setq completing-read-function 'anything-completing-read-default
9239               read-file-name-function  'anything-generic-read-file-name)
9240         (message "Anything completion enabled"))
9241       (setq completing-read-function 'completing-read-default
9242             read-file-name-function  'read-file-name-default)
9243       (message "Anything completion disabled")))
9244
9245 ;;; Eshell completion.
9246 ;;
9247 ;; Enable like this in .emacs:
9248 ;;
9249 ;; (add-hook 'eshell-mode-hook
9250 ;;           #'(lambda ()
9251 ;;               (define-key eshell-mode-map [remap pcomplete] 'anything-esh-pcomplete)))
9252 ;;
9253 (defvar anything-c-source-esh
9254   '((name . "Eshell completions")
9255     (init . (lambda ()
9256               (setq anything-ec-target (thing-at-point 'symbol)
9257                     pcomplete-current-completions nil
9258                     pcomplete-last-completion-raw nil)))
9259     (candidates . anything-esh-get-candidates)
9260     (action . anything-ec-insert))
9261   "Anything source for Eshell completion.")
9262
9263 ;; Internal.
9264 (defvar anything-ec-target "")
9265 (defun anything-ec-insert (candidate)
9266   "Insert CANDIDATE at point.
9267 This is the same as `ac-insert', just inlined here for compatibility."
9268   (let ((pt (point)))
9269     (when (and (search-backward anything-ec-target nil t)
9270                (string= (buffer-substring (point) pt) anything-ec-target))
9271       (delete-region (point) pt)))
9272   (insert candidate))
9273
9274 (defun anything-esh-get-candidates ()
9275   "Get candidates for eshell completion using `pcomplete'."
9276   (catch 'pcompleted
9277     (let* ((pcomplete-stub)
9278            pcomplete-seen pcomplete-norm-func
9279            pcomplete-args pcomplete-last pcomplete-index
9280            (pcomplete-autolist pcomplete-autolist)
9281            (pcomplete-suffix-list pcomplete-suffix-list))
9282       (with-current-buffer anything-current-buffer
9283         (loop
9284            with table  = (pcomplete-completions)
9285            with entry  = (condition-case nil
9286                              ;; For Emacs24
9287                              (funcall (pcomplete-entries) anything-pattern nil nil)
9288                            ;; Fall back to this in Emacs23 as pcomplete-entries seem broken.
9289                            (error
9290                             nil
9291                             (let ((fc (car (last (pcomplete-parse-arguments)))))
9292                               ;; Check if last arg require fname completion.
9293                               (and (file-name-directory fc) fc))))
9294            for i in (if (listp table) table                     ; Emacs23 or commands.
9295                         (all-completions pcomplete-stub table)) ; Emacs24
9296            for file-cand = (and entry (expand-file-name i (file-name-directory entry)))
9297            if (and file-cand (file-exists-p file-cand)) collect file-cand into ls
9298            else collect i into ls
9299            finally return
9300            (if (and entry (not (string= entry "")) (file-exists-p entry))
9301                (append (list (expand-file-name entry default-directory)) ls) ls))))))
9302
9303 ;;;###autoload
9304 (defun anything-esh-pcomplete ()
9305   "Preconfigured anything to provide anything completion in eshell."
9306   (interactive)
9307   (let ((anything-quit-if-no-candidate t)
9308         (anything-execute-action-at-once-if-one t))
9309     (anything :sources 'anything-c-source-esh
9310               :input (anything-ff-set-pattern   ; Handle tramp filenames.
9311                       (car (last (ignore-errors ; Needed in lisp symbols completion.
9312                                    (pcomplete-parse-arguments))))))))
9313
9314 ;;; Lisp symbol completion.
9315 ;;
9316 ;;
9317 (defcustom anything-lisp-completion-or-indent-delay 0.6
9318   "After this delay `anything-lisp-completion-counter' is reset to 0.
9319 This allow to indent again without completing lisp symbol after this delay.
9320 Default is 0.6 seconds."
9321   :group 'anything-config
9322   :type  'number)
9323
9324 (defcustom anything-c-turn-on-show-completion t
9325   "Display candidate in buffer while moving selection when non--nil."
9326   :group 'anything-config
9327   :type 'boolean)
9328
9329 (defface anything-lisp-show-completion
9330   '((t (:background "DarkSlateGray")))
9331   "*Face used for showing candidates in `anything-lisp-completion'."
9332   :group 'anything-config)
9333
9334 (defface anything-lisp-completion-info
9335   '((t (:foreground "red")))
9336   "*Face used for showing info in `anything-lisp-completion'."
9337   :group 'anything-config)
9338
9339 ;; Show completion - an alternative of anything-show-completion.el.
9340 ;;
9341 ;; Provide show completion with macro `with-anything-show-completion'.
9342
9343 ;; Internal
9344 (defvar anything-c-show-completion-overlay nil)
9345
9346 (defun anything-c-show-completion ()
9347   (overlay-put anything-c-show-completion-overlay
9348                'display (anything-get-selection)))
9349
9350 (defun anything-c-completion-init-overlay (beg end)
9351   (and anything-c-turn-on-show-completion
9352        (setq anything-c-show-completion-overlay (make-overlay beg end))
9353        (overlay-put anything-c-show-completion-overlay
9354                     'face 'anything-lisp-show-completion)))
9355
9356 (defmacro with-anything-show-completion (beg end &rest body)
9357   "Show anything candidate in an overlay at point.
9358 BEG and END are the beginning and end position of the current completion
9359 in `anything-current-buffer'.
9360 BODY is an anything call where we want to enable show completion.
9361 If `anything-c-turn-on-show-completion' is nil just do nothing."
9362   (declare (indent 2) (debug t))
9363   `(let ((anything-move-selection-after-hook
9364           (and anything-c-turn-on-show-completion
9365                (append (list 'anything-c-show-completion)
9366                        anything-move-selection-after-hook))))
9367      (unwind-protect
9368           (progn (anything-c-completion-init-overlay ,beg ,end)
9369                  ,@body)
9370        (and anything-c-turn-on-show-completion
9371             (delete-overlay anything-c-show-completion-overlay)))))
9372
9373 ;;;###autoload
9374 (defun anything-lisp-completion-at-point ()
9375   "Anything lisp symbol completion at point."
9376   (interactive)
9377   (let* ((data   (lisp-completion-at-point))
9378          (beg    (car data))
9379          (end    (point)) ; 'cadr data' is wrong when no space after point.
9380          (plist  (nthcdr 3 data))
9381          (pred   (plist-get plist :predicate))
9382          (lgst-len 0)
9383          (target (and beg end (buffer-substring-no-properties beg end)))
9384          (anything-quit-if-no-candidate t)
9385          (anything-execute-action-at-once-if-one t)
9386          (anything-match-plugin-enabled
9387          (member 'anything-compile-source--match-plugin
9388                  anything-compile-source-functions)))
9389     (unwind-protect
9390          (when data
9391            (with-anything-show-completion beg end
9392              (anything
9393               :sources
9394               '((name . "Lisp completion")
9395                 (init . (lambda ()
9396                           (with-current-buffer (anything-candidate-buffer 'global)
9397                             (loop for sym in (all-completions target (nth 2 data) pred)
9398                                for len = (length sym)
9399                                when (> len lgst-len) do (setq lgst-len len)
9400                                do (insert (concat sym "\n"))))))
9401                 (candidates-in-buffer)
9402                 (persistent-action . (lambda (candidate)
9403                                        (let (mode-line-in-non-selected-windows)
9404                                          (anything-c-eldoc-show-in-mode-line
9405                                           (propertize
9406                                            (anything-c-get-first-line-documentation
9407                                             (intern candidate))
9408                                            'face 'anything-lisp-completion-info)))))
9409                 (persistent-help . "Show brief doc in mode-line")
9410                 (filtered-candidate-transformer anything-lisp-completion-transformer)
9411                 (action . (lambda (candidate)
9412                             (delete-region beg end)
9413                             (insert candidate))))
9414               :input (if anything-match-plugin-enabled (concat target " ") target)))))))
9415
9416 (defun anything-lisp-completion-transformer (candidates source)
9417   "Anything candidates transformer for lisp completion."
9418   (declare (special lgst-len))
9419   (loop for c in candidates
9420      for sym = (intern c)
9421      for annot = (cond ((commandp sym) " (Com)")
9422                        ((fboundp sym)  " (Fun)")
9423                        ((boundp sym)   " (Var)")
9424                        ((facep sym)    " (Face)"))
9425      for spaces = (make-string (- lgst-len (length c)) ? )
9426      collect (cons (concat c spaces annot) c)))
9427
9428 (defun anything-c-get-first-line-documentation (sym)
9429   "Return first line documentation of symbol SYM.
9430 If SYM is not documented, return \"Not documented\"."
9431   (let ((doc (cond ((fboundp sym)
9432                     (documentation sym t))
9433                    ((boundp sym)
9434                     (documentation-property sym 'variable-documentation t))
9435                    ((facep sym)
9436                     (face-documentation sym))
9437                    (t nil))))
9438     (if (and doc (not (string= doc ""))
9439              ;; `documentation' return "\n\n(args...)"
9440              ;; for CL-style functions.
9441              (not (string-match-p "^\n\n" doc)))
9442         (car (split-string doc "\n"))
9443         "Not documented")))
9444
9445 ;; Internal
9446 (defvar anything-lisp-completion-counter 0)
9447
9448 ;;;###autoload
9449 (defun anything-lisp-completion-at-point-or-indent (arg)
9450   "First call indent and second call complete lisp symbol.
9451 The second call should happen before `anything-lisp-completion-or-indent-delay',
9452 after this delay, next call will indent again.
9453 After completion, next call is always indent.
9454 See that like click and double mouse click.
9455 One hit indent, two quick hits maybe indent and complete."
9456   (interactive "P")
9457   ;; Be sure `indent-for-tab-command' will not try
9458   ;; to use `completion-at-point'.
9459   (let ((tab-always-indent (if (eq tab-always-indent 'complete)
9460                                t tab-always-indent)))
9461     (incf anything-lisp-completion-counter)
9462     (unwind-protect
9463          (if (> anything-lisp-completion-counter 1)
9464              (anything-lisp-completion-at-point)
9465              (indent-for-tab-command arg))
9466       ;; After `anything-lisp-completion-or-indent-delay' seconds
9467       ;; reset to 0.
9468       (run-with-timer anything-lisp-completion-or-indent-delay nil
9469                       #'(lambda ()
9470                           (setq anything-lisp-completion-counter 0)))
9471       ;; Always reset to 0 at second hit.
9472       (when (eq anything-lisp-completion-counter 2)
9473         (setq anything-lisp-completion-counter 0)))))
9474
9475 ;;; File completion.
9476 ;;
9477 ;; Complete file name at point.
9478
9479 ;;;###autoload
9480 (defun anything-c-complete-file-name-at-point ()
9481   "Complete file name at point."
9482   (interactive)
9483   (let* ((init (substring-no-properties (thing-at-point 'filename)))
9484          (end  (point))
9485          (beg  (- (point) (length init)))
9486          completion)
9487   (with-anything-show-completion beg end
9488     (setq completion (anything-c-read-file-name "FileName: "
9489                                                 :initial-input init)))
9490   (anything-c-insert-file-name-completion-at-point completion)))
9491
9492 ;;; Run Externals commands within Emacs with anything completion
9493 ;;
9494 (defun anything-c-get-pid-from-process-name (process-name)
9495   "Get pid from running process PROCESS-NAME."
9496   (loop with process-list = (list-system-processes)
9497      for pid in process-list
9498      for process = (assoc-default 'comm (process-attributes pid))
9499      when (and process (string-match process-name process))
9500      return pid))
9501
9502
9503 (defun anything-run-or-raise (exe &optional file)
9504   "Generic command that run asynchronously EXE.
9505 If EXE is already running just jump to his window if `anything-raise-command'
9506 is non--nil.
9507 When FILE argument is provided run EXE with FILE.
9508 In this case EXE must be provided as \"EXE %s\"."
9509   (lexical-let* ((real-com (car (split-string (replace-regexp-in-string
9510                                                "'%s'" "" exe))))
9511                  (proc     (if file (concat real-com " " file) real-com)))
9512     (if (get-process proc)
9513         (if anything-raise-command
9514             (shell-command  (format anything-raise-command real-com))
9515             (error "Error: %s is already running" real-com))
9516         (when (loop for i in anything-c-external-commands-list thereis real-com)
9517           (message "Starting %s..." real-com)
9518           (if file
9519               (start-process-shell-command proc nil (format exe file))
9520               (start-process-shell-command proc nil real-com))
9521           (set-process-sentinel
9522            (get-process proc)
9523            #'(lambda (process event)
9524                (when (and (string= event "finished\n")
9525                           anything-raise-command
9526                           (not (anything-c-get-pid-from-process-name real-com)))
9527                  (shell-command  (format anything-raise-command "emacs")))
9528                (message "%s process...Finished." process))))
9529         (setq anything-c-external-commands-list
9530               (cons real-com
9531                     (delete real-com anything-c-external-commands-list))))))
9532
9533
9534 (defvar anything-external-command-history nil)
9535 ;;;###autoload
9536 (defun anything-c-run-external-command (program)
9537   "Preconfigured `anything' to run External PROGRAM asyncronously from Emacs.
9538 If program is already running exit with error.
9539 You can set your own list of commands with
9540 `anything-c-external-commands-list'."
9541   (interactive (list
9542                 (anything-comp-read
9543                  "RunProgram: "
9544                  (anything-c-external-commands-list-1 'sort)
9545                  :must-match t
9546                  :name "External Commands"
9547                  :history anything-external-command-history)))
9548   (anything-run-or-raise program)
9549   (setq anything-external-command-history
9550         (cons program (delete program
9551                               (loop for i in anything-external-command-history
9552                                  when (executable-find i) collect i)))))
9553
9554 (defsubst* anything-c-position (item seq &key (test 'eq))
9555   "A simple and faster replacement of CL `position'."
9556   (loop for i in seq for index from 0
9557      when (funcall test i item) return index))
9558
9559 (defvar anything-c-source-ratpoison-commands
9560   '((name . "Ratpoison Commands")
9561     (init . anything-c-ratpoison-commands-init)
9562     (candidates-in-buffer)
9563     (action ("Execute the command" . anything-c-ratpoison-commands-execute))
9564     (display-to-real . anything-c-ratpoison-commands-display-to-real)
9565     (candidate-number-limit)))
9566 ;; (anything 'anything-c-source-ratpoison-commands)
9567
9568 (defun anything-c-ratpoison-commands-init ()
9569   (unless (anything-candidate-buffer)
9570     (with-current-buffer (anything-candidate-buffer 'global)
9571       ;; with ratpoison prefix key
9572       (save-excursion
9573         (call-process "ratpoison" nil (current-buffer) nil "-c" "help"))
9574       (while (re-search-forward "^\\([^ ]+\\) \\(.+\\)$" nil t)
9575         (replace-match "<ratpoison> \\1: \\2"))
9576       (goto-char (point-max))
9577       ;; direct binding
9578       (save-excursion
9579         (call-process "ratpoison" nil (current-buffer) nil "-c" "help top"))
9580       (while (re-search-forward "^\\([^ ]+\\) \\(.+\\)$" nil t)
9581         (replace-match "\\1: \\2")))))
9582
9583 (defun anything-c-ratpoison-commands-display-to-real (display)
9584   (and (string-match ": " display)
9585        (substring display (match-end 0))))
9586
9587 (defun anything-c-ratpoison-commands-execute (candidate)
9588   (call-process "ratpoison" nil nil nil "-ic" candidate))
9589
9590 ;;;###autoload
9591 (defun anything-ratpoison-commands ()
9592   "Preconfigured `anything' to execute ratpoison commands."
9593   (interactive)
9594   (anything-other-buffer 'anything-c-source-ratpoison-commands
9595                          "*anything ratpoison commands*"))
9596
9597 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Action Helpers ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
9598 ;;; Files
9599 (defvar anything-c-external-commands-list nil
9600   "A list of all external commands the user can execute.  If this
9601 variable is not set by the user, it will be calculated
9602 automatically.")
9603
9604 (defun anything-c-external-commands-list-1 (&optional sort)
9605   "Returns a list of all external commands the user can execute.
9606 If `anything-c-external-commands-list' is non-nil it will
9607 return its contents.  Else it calculates all external commands
9608 and sets `anything-c-external-commands-list'."
9609   (if anything-c-external-commands-list
9610       anything-c-external-commands-list
9611       (setq anything-c-external-commands-list
9612             (loop
9613                with paths = (split-string (getenv "PATH") path-separator)
9614                with completions = ()
9615                for dir in paths
9616                when (and (file-exists-p dir) (file-accessible-directory-p dir))
9617                for lsdir = (loop for i in (directory-files dir t)
9618                               for bn = (file-name-nondirectory i)
9619                               when (and (not (member bn completions))
9620                                         (not (file-directory-p i))
9621                                         (file-executable-p i))
9622                               collect bn)
9623                append lsdir into completions
9624                finally return (if sort (sort completions 'string-lessp) completions)))))
9625
9626
9627 (defun anything-c-file-buffers (filename)
9628   "Returns a list of buffer names corresponding to FILENAME."
9629   (let ((name     (expand-file-name filename))
9630         (buf-list ()))
9631     (dolist (buf (buffer-list) buf-list)
9632       (let ((bfn (buffer-file-name buf)))
9633         (when (and bfn (string= name bfn))
9634           (push (buffer-name buf) buf-list))))))
9635
9636
9637 (defun anything-c-delete-file (file)
9638   "Delete the given file after querying the user.
9639 Ask to kill buffers associated with that file, too."
9640   (let ((buffers (anything-c-file-buffers file)))
9641     (if (< emacs-major-version 24)
9642         ;; `dired-delete-file' in Emacs versions < 24
9643         ;; doesn't support delete-by-moving-to-trash
9644         ;; so use `delete-directory' and `delete-file'
9645         ;; that handle it.
9646         (cond ((and (not (file-symlink-p file))
9647                     (file-directory-p file)
9648                     (directory-files file t dired-re-no-dot))
9649                (when (y-or-n-p (format "Recursive delete of `%s'? " file))
9650                  (delete-directory file 'recursive)))
9651               ((and (not (file-symlink-p file))
9652                     (file-directory-p file))
9653                (delete-directory file))
9654               (t (delete-file file)))
9655         (dired-delete-file
9656          file 'dired-recursive-deletes delete-by-moving-to-trash))
9657     (when buffers
9658       (dolist (buf buffers)
9659         (when (y-or-n-p (format "Kill buffer %s, too? " buf))
9660           (kill-buffer buf))))))
9661
9662 (defun anything-get-mailcap-for-file (filename)
9663   "Get the command to use for FILENAME from mailcap files.
9664 The command is like <command %s> and is meant to use with `format'."
9665   (mailcap-parse-mailcaps)
9666   (let* ((ext  (file-name-extension filename))
9667          (mime (when ext (mailcap-extension-to-mime ext)))
9668          (result (when mime (mailcap-mime-info mime))))
9669     ;; If elisp file have no associations in .mailcap
9670     ;; `mailcap-maybe-eval' is returned, in this case just return nil.
9671     (when (stringp result) result)))
9672
9673 (defcustom anything-c-default-external-file-browser "nautilus"
9674   "Default external file browser for your system.
9675 Directories will be opened externally with it.
9676 Set to nil if you do not have external file browser
9677 or do not want to use it."
9678   :group 'anything-config
9679   :type  'string)
9680
9681 (defun anything-get-default-program-for-file (filename)
9682   "Try to find a default program to open FILENAME.
9683 Try first in `anything-c-external-programs-associations' and then in mailcap file
9684 if nothing found return nil."
9685   (let* ((ext      (file-name-extension filename))
9686          (def-prog (assoc-default ext anything-c-external-programs-associations)))
9687     (cond ((and def-prog (not (string= def-prog "")))
9688            (concat def-prog " %s"))
9689           ((and anything-c-default-external-file-browser
9690                 (file-directory-p filename))
9691            (concat anything-c-default-external-file-browser " %s"))
9692           (t (anything-get-mailcap-for-file filename)))))
9693
9694 (defun anything-c-open-file-externally (file)
9695   "Open FILE with an external program.
9696 Try to guess which program to use with `anything-get-default-program-for-file'.
9697 If not found or a prefix arg is given query the user which tool to use."
9698   (let* ((fname          (expand-file-name file))
9699          (collection     (anything-c-external-commands-list-1 'sort))
9700          (def-prog       (anything-get-default-program-for-file fname))
9701          (real-prog-name (if (or anything-current-prefix-arg (not def-prog))
9702                              ;; Prefix arg or no default program.
9703                              (prog1
9704                                  (anything-comp-read
9705                                   "Program: " collection
9706                                   :must-match t
9707                                   :name "Open file Externally"
9708                                   :history anything-external-command-history)
9709                                ;; Always prompt to set this program as default.
9710                                (setq def-prog nil))
9711                              ;; No prefix arg or default program exists.
9712                              (replace-regexp-in-string " %s\\| '%s'" "" def-prog)))
9713          (program        (concat real-prog-name " '%s'")))
9714     (unless (or def-prog ; Association exists, no need to record it.
9715                 ;; Don't try to record non--filenames associations (e.g urls).
9716                 (not (file-exists-p fname)))
9717       (when
9718           (y-or-n-p
9719            (format
9720             "Do you want to make `%s' the default program for this kind of files? "
9721             real-prog-name))
9722         (anything-aif (assoc (file-name-extension fname)
9723                              anything-c-external-programs-associations)
9724             (setq anything-c-external-programs-associations
9725                   (delete it anything-c-external-programs-associations)))
9726         (push (cons (file-name-extension fname)
9727                     (read-string
9728                      "Program (Add args maybe and confirm): " real-prog-name))
9729               anything-c-external-programs-associations)
9730         (customize-save-variable 'anything-c-external-programs-associations
9731                                  anything-c-external-programs-associations)))
9732     (anything-run-or-raise program file)
9733     (setq anything-external-command-history
9734           (cons real-prog-name
9735                 (delete real-prog-name
9736                         (loop for i in anything-external-command-history
9737                              when (executable-find i) collect i))))))
9738
9739
9740 ;;;###autoload
9741 (defun w32-shell-execute-open-file (file)
9742   (interactive "fOpen file:")
9743   (with-no-warnings
9744     (w32-shell-execute "open" (replace-regexp-in-string ;for UNC paths
9745                                "/" "\\"
9746                                (replace-regexp-in-string ; strip cygdrive paths
9747                                 "/cygdrive/\\(.\\)" "\\1:"
9748                                 file nil nil) nil t))))
9749
9750 (defun anything-c-open-file-with-default-tool (file)
9751   "Open FILE with the default tool on this platform."
9752   (if (eq system-type 'windows-nt)
9753       (w32-shell-execute-open-file file)
9754     (start-process "anything-c-open-file-with-default-tool"
9755                    nil
9756                    (cond ((eq system-type 'gnu/linux)
9757                           "xdg-open")
9758                          ((or (eq system-type 'darwin) ;; Mac OS X
9759                               (eq system-type 'macos)) ;; Mac OS 9
9760                           "open"))
9761                    file)))
9762
9763 (defun anything-c-open-dired (file)
9764   "Opens a dired buffer in FILE's directory.  If FILE is a
9765 directory, open this directory."
9766   (if (file-directory-p file)
9767       (dired file)
9768     (dired (file-name-directory file))
9769     (dired-goto-file file)))
9770
9771 (defun anything-c-display-to-real-line (candidate)
9772   (if (string-match "^ *\\([0-9]+\\):\\(.*\\)$" candidate)
9773       (list (string-to-number (match-string 1 candidate)) (match-string 2 candidate))
9774     (error "Line number not found")))
9775
9776 (defun anything-c-action-line-goto (lineno-and-content)
9777   (apply #'anything-goto-file-line (anything-interpret-value (anything-attr 'target-file))
9778          (append lineno-and-content
9779                  (list (if (and (anything-attr-defined 'target-file)
9780                                 (not anything-in-persistent-action))
9781                            'find-file-other-window
9782                          'find-file)))))
9783
9784 (defun* anything-c-action-file-line-goto (file-line-content &optional (find-file-function #'find-file))
9785   (apply #'anything-goto-file-line
9786          (if (stringp file-line-content)
9787              ;; Case: filtered-candidate-transformer is skipped
9788              (cdr (anything-c-filtered-candidate-transformer-file-line-1 file-line-content))
9789            file-line-content)))
9790
9791 (require 'compile)
9792 (defun anything-c-filtered-candidate-transformer-file-line (candidates source)
9793   (delq nil (mapcar 'anything-c-filtered-candidate-transformer-file-line-1 candidates)))
9794
9795 (defun anything-c-filtered-candidate-transformer-file-line-1 (candidate)
9796   (when (string-match "^\\(.+?\\):\\([0-9]+\\):\\(.*\\)$" candidate)
9797     (let ((filename (match-string 1 candidate))
9798           (lineno (match-string 2 candidate))
9799           (content (match-string 3 candidate)))
9800       (cons (format "%s:%s\n %s"
9801                     (propertize filename 'face compilation-info-face)
9802                     (propertize lineno 'face compilation-line-face)
9803                     content)
9804             (list (expand-file-name
9805                    filename
9806                    (or (anything-interpret-value (anything-attr 'default-directory))
9807                        (and (anything-candidate-buffer)
9808                             (buffer-local-value
9809                              'default-directory (anything-candidate-buffer)))))
9810                   (string-to-number lineno) content)))))
9811
9812 (defun* anything-goto-file-line (file lineno content &optional (find-file-function #'find-file))
9813   (anything-aif (anything-attr 'before-jump-hook)
9814       (funcall it))
9815   (when file (funcall find-file-function file))
9816   (if (anything-attr-defined 'adjust)
9817       (anything-c-goto-line-with-adjustment lineno content)
9818     (anything-goto-line lineno))
9819   (unless (anything-attr-defined 'recenter)
9820     (set-window-start (get-buffer-window anything-current-buffer) (point)))
9821   (anything-aif (anything-attr 'after-jump-hook)
9822       (funcall it))
9823   (when anything-in-persistent-action
9824     (anything-match-line-color-current-line)))
9825
9826 (defun anything-find-file-as-root (candidate)
9827   (find-file (concat "/" anything-su-or-sudo "::" (expand-file-name candidate))))
9828
9829 (defun anything-find-many-files (ignore)
9830   (mapc 'find-file (anything-marked-candidates)))
9831
9832 ;; borrowed from etags.el
9833 ;; (anything-c-goto-line-with-adjustment (line-number-at-pos) ";; borrowed from etags.el")
9834 (defun anything-c-goto-line-with-adjustment (line line-content)
9835   (let ((startpos)
9836         offset found pat)
9837     ;; This constant is 1/2 the initial search window.
9838     ;; There is no sense in making it too small,
9839     ;; since just going around the loop once probably
9840     ;; costs about as much as searching 2000 chars.
9841     (setq offset 1000
9842           found nil
9843           pat (concat (if (eq selective-display t)
9844                           "\\(^\\|\^m\\) *" "^ *") ;allow indent
9845                       (regexp-quote line-content)))
9846     ;; If no char pos was given, try the given line number.
9847     (setq startpos (progn (anything-goto-line line) (point)))
9848     (or startpos (setq startpos (point-min)))
9849     ;; First see if the tag is right at the specified location.
9850     (goto-char startpos)
9851     (setq found (looking-at pat))
9852     (while (and (not found)
9853                 (progn
9854                   (goto-char (- startpos offset))
9855                   (not (bobp))))
9856       (setq found
9857             (re-search-forward pat (+ startpos offset) t)
9858             offset (* 3 offset)))       ; expand search window
9859     (or found
9860         (re-search-forward pat nil t)
9861         (error "not found")))
9862   ;; Position point at the right place
9863   ;; if the search string matched an extra Ctrl-m at the beginning.
9864   (and (eq selective-display t)
9865        (looking-at "\^m")
9866        (forward-char 1))
9867   (beginning-of-line))
9868
9869 (anything-document-attribute 'default-directory "type . file-line"
9870   "`default-directory' to interpret file.")
9871 (anything-document-attribute 'before-jump-hook "type . file-line / line"
9872   "Function to call before jumping to the target location.")
9873 (anything-document-attribute 'after-jump-hook "type . file-line / line"
9874   "Function to call after jumping to the target location.")
9875 (anything-document-attribute 'adjust "type . file-line"
9876   "Search around line matching line contents.")
9877 (anything-document-attribute 'recenter "type . file-line / line"
9878   "`recenter' after jumping.")
9879 (anything-document-attribute 'target-file "type . line"
9880   "Goto line of target-file.")
9881
9882 ;;;###autoload
9883 (defun anything-c-call-interactively (cmd-or-name)
9884   "Execute CMD-OR-NAME as Emacs command.
9885 It is added to `extended-command-history'.
9886 `anything-current-prefix-arg' is used as the command's prefix argument."
9887   (setq extended-command-history
9888         (cons (anything-c-stringify cmd-or-name)
9889               (delete (anything-c-stringify cmd-or-name) extended-command-history)))
9890   (let ((current-prefix-arg anything-current-prefix-arg)
9891         (cmd (anything-c-symbolify cmd-or-name)))
9892     (if (stringp (symbol-function cmd))
9893         (execute-kbd-macro (symbol-function cmd))
9894       (setq this-command cmd)
9895       (call-interactively cmd))))
9896
9897 ;;;###autoload
9898 (defun anything-c-set-variable (var)
9899   "Set value to VAR interactively."
9900   (interactive)
9901   (let ((sym (anything-c-symbolify var)))
9902     (set sym (eval-minibuffer (format "Set %s: " var)
9903                               (prin1-to-string (symbol-value sym))))))
9904 ;; (setq hh 12)
9905 ;; (anything-c-set-variable 'hh)
9906
9907 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Persistent Action Helpers ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
9908 (defvar anything-match-line-overlay-face nil)
9909 (defvar anything-match-line-overlay nil)
9910
9911 (defun anything-match-line-color-current-line (&optional start end buf face rec)
9912   "Highlight and underline current position"
9913   (let ((args (list (or start (line-beginning-position))
9914                     (or end (1+ (line-end-position)))
9915                     buf)))
9916     (if (not anything-match-line-overlay)
9917         (setq anything-match-line-overlay (apply 'make-overlay args))
9918       (apply 'move-overlay anything-match-line-overlay args)))
9919   (overlay-put anything-match-line-overlay
9920                'face (or face anything-match-line-overlay-face))
9921   (when rec
9922     (goto-char start)
9923     (recenter)))
9924
9925 (defalias 'anything-persistent-highlight-point 'anything-match-line-color-current-line)
9926
9927 (defface anything-overlay-line-face '((t (:background "IndianRed4" :underline t)))
9928   "Face for source header in the anything buffer." :group 'anything)
9929
9930 (setq anything-match-line-overlay-face 'anything-overlay-line-face)
9931
9932 (defun anything-match-line-cleanup ()
9933   (when anything-match-line-overlay
9934     (delete-overlay anything-match-line-overlay)
9935     (setq anything-match-line-overlay nil)))
9936
9937 (defun anything-match-line-update ()
9938   (when anything-match-line-overlay
9939     (delete-overlay anything-match-line-overlay)
9940     (anything-match-line-color-current-line)))
9941
9942 (add-hook 'anything-cleanup-hook 'anything-match-line-cleanup)
9943 (add-hook 'anything-after-persistent-action-hook 'anything-match-line-update)
9944
9945 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Actions Transformers ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
9946 ;;; Files
9947 (defun anything-c-transform-file-load-el (actions candidate)
9948   "Add action to load the file CANDIDATE if it is an emacs lisp
9949 file.  Else return ACTIONS unmodified."
9950   (if (member (file-name-extension candidate) '("el" "elc"))
9951       (append actions '(("Load Emacs Lisp File" . load-file)))
9952     actions))
9953
9954 (defun anything-c-transform-file-browse-url (actions candidate)
9955   "Add an action to browse the file CANDIDATE if it in a html
9956 file or URL.  Else return ACTIONS unmodified."
9957   (let ((browse-action '("Browse with Browser" . browse-url)))
9958     (cond ((string-match "^http\\|^ftp" candidate)
9959            (cons browse-action actions))
9960           ((string-match "\\.html?$" candidate)
9961            (append actions (list browse-action)))
9962           (t actions))))
9963
9964 ;;;; Function
9965 (defun anything-c-transform-function-call-interactively (actions candidate)
9966   "Add an action to call the function CANDIDATE interactively if
9967 it is a command.  Else return ACTIONS unmodified."
9968   (if (commandp (intern-soft candidate))
9969       (append actions '(("Call Interactively"
9970                          .
9971                          anything-c-call-interactively)))
9972     actions))
9973
9974 ;;;; S-Expressions
9975 (defun anything-c-transform-sexp-eval-command-sexp (actions candidate)
9976   "If CANDIDATE's `car' is a command, then add an action to
9977 evaluate it and put it onto the `command-history'."
9978   (if (commandp (car (read candidate)))
9979       ;; Make it first entry
9980       (cons '("Eval and put onto command-history" .
9981               (lambda (sexp)
9982                 (let ((sym (read sexp)))
9983                   (eval sym)
9984                   (setq command-history
9985                         (cons sym command-history)))))
9986             actions)
9987     actions))
9988
9989 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Candidate Transformers ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
9990 ;;; Buffers
9991 (defun anything-c-skip-boring-buffers (buffers)
9992   (anything-c-skip-entries buffers anything-c-boring-buffer-regexp))
9993
9994 (defun anything-c-skip-current-buffer (buffers)
9995   (if anything-allow-skipping-current-buffer
9996       (remove (buffer-name anything-current-buffer) buffers)
9997       buffers))
9998
9999 (defun anything-c-shadow-boring-buffers (buffers)
10000   "Buffers matching `anything-c-boring-buffer-regexp' will be
10001 displayed with the `file-name-shadow' face if available."
10002   (anything-c-shadow-entries buffers anything-c-boring-buffer-regexp))
10003
10004 (defvar anything-c-buffer-display-string-functions
10005   '(anything-c-buffer-display-string--compilation
10006     anything-c-buffer-display-string--shell
10007     anything-c-buffer-display-string--eshell)
10008   "Functions to setup display string for buffer.
10009
10010 Function has one argument, buffer name.
10011 If it returns string, use it.
10012 If it returns nil, display buffer name.
10013 See `anything-c-buffer-display-string--compilation' for example.")
10014
10015 (defun anything-c-transform-buffer-display-string (buffers)
10016   "Setup display string for buffer candidates
10017 using `anything-c-buffer-display-string-functions'."
10018   (loop for buf in buffers
10019         if (consp buf)
10020         collect buf
10021         else
10022         for disp = (progn (set-buffer buf)
10023                           (run-hook-with-args-until-success
10024                            'anything-c-buffer-display-string-functions buf))
10025         collect (if disp (cons disp buf) buf)))
10026
10027 (defun anything-c-buffer-display-string--compilation (buf)
10028   (anything-aif (car compilation-arguments)
10029       (format "%s: %s [%s]" buf it default-directory)))
10030 (defun anything-c-buffer-display-string--eshell (buf)
10031   (when (eq major-mode 'eshell-mode)
10032     (format "%s: %s [%s]" buf
10033             (ignore-errors (ring-ref eshell-history-ring 0))
10034             default-directory)))
10035 (defun anything-c-buffer-display-string--shell (buf)
10036   (when (eq major-mode 'shell-mode)
10037     (format "%s: %s [%s]" buf
10038             (ignore-errors (ring-ref comint-input-ring 0))
10039             default-directory)))
10040
10041 ;;; Files
10042 (defun anything-c-shadow-boring-files (files)
10043   "Files matching `anything-c-boring-file-regexp' will be
10044 displayed with the `file-name-shadow' face if available."
10045   (anything-c-shadow-entries files anything-c-boring-file-regexp))
10046
10047 (defun anything-c-skip-boring-files (files)
10048   "Files matching `anything-c-boring-file-regexp' will be skipped."
10049   (anything-c-skip-entries files anything-c-boring-file-regexp))
10050 ;; (anything-c-skip-boring-files '("README" "/src/.svn/hoge"))
10051
10052 (defun anything-c-skip-current-file (files)
10053   "Current file will be skipped."
10054   (remove (buffer-file-name anything-current-buffer) files))
10055
10056 (defun anything-c-w32-pathname-transformer (args)
10057   "Change undesirable features of windows pathnames to ones more acceptable to
10058 other candidate transformers."
10059   (if (eq system-type 'windows-nt)
10060       (mapcar (lambda (x)
10061                 (replace-regexp-in-string "/cygdrive/\\(.\\)" "\\1:" x))
10062               (mapcar (lambda (y)
10063                         (replace-regexp-in-string "\\\\" "/" y)) args))
10064     args))
10065
10066 (defun anything-c-shorten-home-path (files)
10067   "Replaces /home/user with ~."
10068   (let ((home (replace-regexp-in-string "\\\\" "/" ; stupid Windows...
10069                                         (getenv "HOME"))))
10070     (mapcar (lambda (file)
10071               (if (and (stringp file) (string-match home file))
10072                   (cons (replace-match "~" nil nil file) file)
10073                 file))
10074             files)))
10075
10076 ;;; Functions
10077 (defun anything-c-mark-interactive-functions (functions)
10078   "Mark interactive functions (commands) with (i) after the function name."
10079   (let (list)
10080     (loop for function in functions
10081           do (push (cons (concat function
10082                                  (when (commandp (intern-soft function)) " (i)"))
10083                          function)
10084                    list)
10085           finally (return (nreverse list)))))
10086
10087 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Adaptive Sorting of Candidates ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10088
10089 ;; Internal
10090 (defvar anything-c-adaptive-done nil
10091   "nil if history information is not yet stored for the current
10092 selection.")
10093
10094 (defvar anything-c-adaptive-history nil
10095   "Contains the stored history information.
10096 Format: ((SOURCE-NAME (SELECTED-CANDIDATE (PATTERN . NUMBER-OF-USE) ...) ...) ...)")
10097
10098 (defcustom anything-c-use-adaptative-sorting nil
10099   "*Wheter to use or not adaptative sorting.
10100 Even if a source use it, it will have no effect when set to nil."
10101   :type 'boolean
10102   :group 'anything-config)
10103
10104 (defadvice anything-initialize (before anything-c-adaptive-initialize activate)
10105   "Advise `anything-initialize' to reset `anything-c-adaptive-done'
10106 when anything is started."
10107   (when anything-c-use-adaptative-sorting
10108     (setq anything-c-adaptive-done nil)))
10109
10110 (defadvice anything-exit-minibuffer (before anything-c-adaptive-exit-minibuffer activate)
10111   "Advise `anything-exit-minibuffer' to store history information
10112 when a candidate is selected with RET."
10113   (when anything-c-use-adaptative-sorting
10114     (anything-c-adaptive-store-selection)))
10115
10116 (defadvice anything-select-action (before anything-c-adaptive-select-action activate)
10117   "Advise `anything-select-action' to store history information
10118 when the user goes to the action list with TAB."
10119   (when anything-c-use-adaptative-sorting
10120     (anything-c-adaptive-store-selection)))
10121
10122 (defun anything-c-source-use-adaptative-p (&optional source-name)
10123   "Return current source only if it use adaptative history, nil otherwise."
10124   (when anything-c-use-adaptative-sorting
10125     (let* ((source (or source-name (anything-get-current-source)))
10126            (adapt-source (or (assoc-default 'filtered-candidate-transformer
10127                                             (assoc (assoc-default 'type source)
10128                                                    anything-type-attributes))
10129                              (assoc-default 'candidate-transformer
10130                                             (assoc (assoc-default 'type source)
10131                                                    anything-type-attributes))
10132                              (assoc-default 'filtered-candidate-transformer source)
10133                              (assoc-default 'candidate-transformer source))))
10134       (if (listp adapt-source)
10135           (when (member 'anything-c-adaptive-sort adapt-source) source)
10136           (when (eq adapt-source 'anything-c-adaptive-sort) source)))))
10137
10138 (defun anything-c-adaptive-store-selection ()
10139   "Store history information for the selected candidate."
10140   (unless anything-c-adaptive-done
10141     (setq anything-c-adaptive-done t)
10142     (let ((source (anything-c-source-use-adaptative-p)))
10143       (when source
10144         (let* ((source-name (or (assoc-default 'type source)
10145                                 (assoc-default 'name source)))
10146                (source-info (or (assoc source-name anything-c-adaptive-history)
10147                                 (progn
10148                                   (push (list source-name) anything-c-adaptive-history)
10149                                   (car anything-c-adaptive-history))))
10150                (selection (anything-get-selection))
10151                (selection-info (progn
10152                                  (setcdr source-info
10153                                          (cons
10154                                           (let ((found (assoc selection (cdr source-info))))
10155                                             (if (not found)
10156                                                 ;; new entry
10157                                                 (list selection)
10158
10159                                                 ;; move entry to the beginning of the
10160                                                 ;; list, so that it doesn't get
10161                                                 ;; trimmed when the history is
10162                                                 ;; truncated
10163                                                 (setcdr source-info
10164                                                         (delete found (cdr source-info)))
10165                                                 found))
10166                                           (cdr source-info)))
10167                                  (cadr source-info)))
10168                (pattern-info (progn
10169                                (setcdr selection-info
10170                                        (cons
10171                                         (let ((found (assoc anything-pattern (cdr selection-info))))
10172                                           (if (not found)
10173                                               ;; new entry
10174                                               (cons anything-pattern 0)
10175
10176                                               ;; move entry to the beginning of the
10177                                               ;; list, so if two patterns used the
10178                                               ;; same number of times then the one
10179                                               ;; used last appears first in the list
10180                                               (setcdr selection-info
10181                                                       (delete found (cdr selection-info)))
10182                                               found))
10183                                         (cdr selection-info)))
10184                                (cadr selection-info))))
10185
10186           ;; increase usage count
10187           (setcdr pattern-info (1+ (cdr pattern-info)))
10188
10189           ;; truncate history if needed
10190           (if (> (length (cdr selection-info)) anything-c-adaptive-history-length)
10191               (setcdr selection-info
10192                       (subseq (cdr selection-info) 0 anything-c-adaptive-history-length))))))))
10193
10194 (defun anything-c-adaptative-maybe-load-history ()
10195   (when (and anything-c-use-adaptative-sorting
10196            (file-readable-p anything-c-adaptive-history-file))
10197   (load-file anything-c-adaptive-history-file)))
10198
10199 (add-hook 'emacs-startup-hook 'anything-c-adaptative-maybe-load-history)
10200 (add-hook 'kill-emacs-hook 'anything-c-adaptive-save-history)
10201
10202 (defun anything-c-adaptive-save-history ()
10203   "Save history information to file given by `anything-c-adaptive-history-file'."
10204   (interactive)
10205   (when anything-c-use-adaptative-sorting
10206     (with-temp-buffer
10207       (insert
10208        ";; -*- mode: emacs-lisp -*-\n"
10209        ";; History entries used for anything adaptive display.\n")
10210       (prin1 `(setq anything-c-adaptive-history ',anything-c-adaptive-history)
10211              (current-buffer))
10212       (insert ?\n)
10213       (write-region (point-min) (point-max) anything-c-adaptive-history-file nil
10214                     (unless (interactive-p) 'quiet)))))
10215
10216 (defun anything-c-adaptive-sort (candidates source)
10217   "Sort the CANDIDATES for SOURCE by usage frequency.
10218 This is a filtered candidate transformer you can use for the
10219 attribute `filtered-candidate-transformer' of a source in
10220 `anything-sources' or a type in `anything-type-attributes'."
10221   (let* ((source-name (or (assoc-default 'type source)
10222                           (assoc-default 'name source)))
10223          (source-info (assoc source-name anything-c-adaptive-history)))
10224     (if source-info
10225         (let ((usage
10226                ;; ... assemble a list containing the (CANIDATE . USAGE-COUNT)
10227                ;; pairs
10228                (mapcar (lambda (candidate-info)
10229                          (let ((count 0))
10230                            (dolist (pattern-info (cdr candidate-info))
10231                              (if (not (equal (car pattern-info)
10232                                              anything-pattern))
10233                                  (incf count (cdr pattern-info))
10234
10235                                  ;; if current pattern is equal to the previously
10236                                  ;; used one then this candidate has priority
10237                                  ;; (that's why its count is boosted by 10000) and
10238                                  ;; it only has to compete with other candidates
10239                                  ;; which were also selected with the same pattern
10240                                  (setq count (+ 10000 (cdr pattern-info)))
10241                                  (return)))
10242                            (cons (car candidate-info) count)))
10243                        (cdr source-info)))
10244               sorted)
10245           (if (and usage (consp usage))
10246               ;; sort the list in descending order, so candidates with highest
10247               ;; priorty come first
10248               (progn
10249                 (setq usage (sort usage (lambda (first second)
10250                                           (> (cdr first) (cdr second)))))
10251
10252                 ;; put those candidates first which have the highest usage count
10253                 (dolist (info usage)
10254                   (when (member* (car info) candidates
10255                                  :test 'anything-c-adaptive-compare)
10256                     (push (car info) sorted)
10257                     (setq candidates (remove* (car info) candidates
10258                                               :test 'anything-c-adaptive-compare))))
10259
10260                 ;; and append the rest
10261                 (append (reverse sorted) candidates nil))
10262               (message "Your `%s' is maybe corrupted or too old, \
10263 you should reinitialize it with `anything-c-reset-adaptative-history'"
10264                        anything-c-adaptive-history-file)
10265               (sit-for 1)
10266               candidates))
10267         ;; if there is no information stored for this source then do nothing
10268         candidates)))
10269
10270 ;;;###autoload
10271 (defun anything-c-reset-adaptative-history ()
10272   "Delete all `anything-c-adaptive-history' and his file.
10273 Useful when you have a old or corrupted `anything-c-adaptive-history-file'."
10274   (interactive)
10275   (when (y-or-n-p "Really delete all your `anything-c-adaptive-history'? ")
10276     (setq anything-c-adaptive-history nil)
10277     (delete-file anything-c-adaptive-history-file)))
10278
10279 (defun anything-c-adaptive-compare (x y)
10280   "Compare candidates X and Y taking into account that the
10281 candidate can be in (DISPLAY . REAL) format."
10282   (equal (if (listp x)
10283              (cdr x)
10284            x)
10285          (if (listp y)
10286              (cdr y)
10287            y)))
10288
10289 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Outliner ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10290 (defvar anything-outline-goto-near-line-flag t)
10291 (defvar anything-outline-using nil)
10292 (defun anything-after-update-hook--outline ()
10293   (if (and (eq anything-outline-using t)
10294            (eq anything-outline-goto-near-line-flag t))
10295       (anything-outline-goto-near-line)))
10296 (add-hook 'anything-after-update-hook 'anything-after-update-hook--outline)
10297
10298 (defun anything-outline-goto-near-line ()
10299   (with-anything-window
10300     ;; TODO need consideration whether to update position by every input.
10301     (when t ; (equal anything-pattern "")
10302       (anything-goto-line 2)
10303       (let ((lineno (with-current-buffer anything-current-buffer
10304                       (line-number-at-pos (car anything-current-position)))))
10305         (block exit
10306           (while (<= (progn (skip-chars-forward " ")
10307                             (or (number-at-point) lineno))
10308                      lineno)
10309             (forward-line 1)
10310             (when (eobp)
10311               (forward-line -1)
10312               (return-from exit))))
10313         (forward-line -1)
10314         (and (bobp) (forward-line 1))
10315         (and (anything-pos-header-line-p) (forward-line -2))
10316         (anything-mark-current-line)))))
10317
10318 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Plug-in ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10319 ;; Plug-in: info-index
10320 (defun* anything-c-info-init (&optional (file (anything-attr 'info-file)))
10321   (let (result)
10322     (unless (anything-candidate-buffer)
10323       (save-window-excursion
10324         (info file)
10325         (let (Info-history
10326               (tobuf (anything-candidate-buffer 'global))
10327               (infobuf (current-buffer))
10328               s e)
10329           (dolist (node (or (anything-attr 'index-nodes) (Info-index-nodes)))
10330             (Info-goto-node node)
10331             (goto-char (point-min))
10332             (while (search-forward "\n* " nil t)
10333               (unless (search-forward "Menu:\n" (1+ (point-at-eol)) t)
10334                 '(save-current-buffer (buffer-substring-no-properties (point-at-bol) (point-at-eol)) result)
10335                 (setq s (point-at-bol)
10336                       e (point-at-eol))
10337                 (with-current-buffer tobuf
10338                   (insert-buffer-substring infobuf s e)
10339                   (insert "\n"))))))))))
10340
10341 (defun anything-c-info-goto (node-line)
10342   (Info-goto-node (car node-line))
10343   (anything-goto-line (cdr node-line)))
10344
10345 (defun anything-c-info-display-to-real (line)
10346   (and (string-match
10347         ;; This regexp is stolen from Info-apropos-matches
10348         "\\* +\\([^\n]*.+[^\n]*\\):[ \t]+\\([^\n]*\\)\\.\\(?:[ \t\n]*(line +\\([0-9]+\\))\\)?" line)
10349        (cons (format "(%s)%s" (anything-attr 'info-file) (match-string 2 line))
10350              (string-to-number (or (match-string 3 line) "1")))))
10351
10352 (defun anything-c-make-info-source (source file)
10353   `(,@source
10354     (name . ,(concat "Info Index: " file))
10355     (info-file . ,file)
10356     (init . anything-c-info-init)
10357     (display-to-real . anything-c-info-display-to-real)
10358     (get-line . buffer-substring)
10359     (candidates-in-buffer)
10360     (action ("Goto node" . anything-c-info-goto))))
10361
10362 (defun anything-compile-source--info-index (source)
10363   (anything-aif (anything-interpret-value (assoc-default 'info-index source))
10364       (anything-c-make-info-source source it)
10365     source))
10366 (add-to-list 'anything-compile-source-functions 'anything-compile-source--info-index)
10367
10368 (anything-document-attribute 'info-index "info-index plugin"
10369   "Create a source of info index very easily.
10370
10371 ex. (defvar anything-c-source-info-wget '((info-index . \"wget\"))")
10372
10373 (anything-document-attribute 'index-nodes "info-index plugin (optional)"
10374   "Index nodes of info file.
10375
10376 If it is omitted, `Info-index-nodes' is used to collect index nodes.
10377 Some info files are missing index specification.
10378
10379 ex. See `anything-c-source-info-screen'.")
10380
10381 ;; Plug-in: candidates-file
10382 (defun anything-compile-source--candidates-file (source)
10383   (if (assoc-default 'candidates-file source)
10384       `((init anything-p-candidats-file-init
10385               ,@(let ((orig-init (assoc-default 'init source)))
10386                   (cond ((null orig-init) nil)
10387                         ((functionp orig-init) (list orig-init))
10388                         (t orig-init))))
10389         (candidates-in-buffer)
10390         ,@source)
10391     source))
10392 (add-to-list 'anything-compile-source-functions 'anything-compile-source--candidates-file)
10393
10394 (defun anything-p-candidats-file-init ()
10395   (destructuring-bind (file &optional updating)
10396       (anything-mklist (anything-attr 'candidates-file))
10397     (setq file (anything-interpret-value file))
10398     (with-current-buffer (anything-candidate-buffer (find-file-noselect file))
10399       (when updating
10400         (buffer-disable-undo)
10401         (font-lock-mode -1)
10402         (auto-revert-mode 1)))))
10403
10404 (anything-document-attribute 'candidates-file "candidates-file plugin"
10405   "Use a file as the candidates buffer.
10406
10407 1st argument is a filename, string or function name or variable name.
10408 If optional 2nd argument is non-nil, the file opened with `auto-revert-mode'.")
10409
10410 ;; Plug-in: headline
10411 (defun anything-compile-source--anything-headline (source)
10412   (if (assoc-default 'headline source)
10413       (append '((init . anything-headline-init)
10414                 (get-line . buffer-substring)
10415                 (type . line))
10416               source
10417               '((candidates-in-buffer)
10418                 (persistent-help . "Show this line")))
10419     source))
10420 (add-to-list 'anything-compile-source-functions 'anything-compile-source--anything-headline)
10421
10422 (defun anything-headline-init ()
10423   (when (and (anything-current-buffer-is-modified)
10424              (with-current-buffer anything-current-buffer
10425                (eval (or (anything-attr 'condition) t))))
10426     (anything-headline-make-candidate-buffer
10427      (anything-interpret-value (anything-attr 'headline))
10428      (anything-interpret-value (anything-attr 'subexp)))))
10429
10430 (anything-document-attribute 'headline "Headline plug-in"
10431   "Regexp string for anything-headline to scan.")
10432 (anything-document-attribute 'condition "Headline plug-in"
10433   "A sexp representing the condition to use anything-headline.")
10434 (anything-document-attribute 'subexp "Headline plug-in"
10435   "Display (match-string-no-properties subexp).")
10436
10437
10438 (defun anything-headline-get-candidates (regexp subexp)
10439   (with-current-buffer anything-current-buffer
10440     (save-excursion
10441       (goto-char (point-min))
10442       (if (functionp regexp) (setq regexp (funcall regexp)))
10443       (let (hierarchy curhead)
10444         (flet ((matched ()
10445                  (if (numberp subexp)
10446                      (cons (match-string-no-properties subexp) (match-beginning subexp))
10447                      (cons (buffer-substring (point-at-bol) (point-at-eol))
10448                            (point-at-bol))))
10449                (hierarchies (headlines)
10450                  (1+ (loop for (_ . hierarchy) in headlines
10451                         maximize hierarchy)))
10452                (vector-0-n (v n)
10453                  (loop for i from 0 to hierarchy
10454                     collecting (aref curhead i)))
10455                (arrange (headlines)
10456                  (unless (null headlines) ; FIX headlines empty bug!
10457                    (loop with curhead = (make-vector (hierarchies headlines) "")
10458                       for ((str . pt) . hierarchy) in headlines
10459                       do (aset curhead hierarchy str)
10460                       collecting
10461                         (cons
10462                          (format "H%d:%s" (1+ hierarchy)
10463                                  (mapconcat 'identity (vector-0-n curhead hierarchy) " / "))
10464                          pt)))))
10465             (if (listp regexp)
10466               (arrange
10467                (sort
10468                 (loop for re in regexp
10469                    for hierarchy from 0
10470                    do (goto-char (point-min))
10471                    appending
10472                      (loop
10473                         while (re-search-forward re nil t)
10474                         collect (cons (matched) hierarchy)))
10475                 (lambda (a b) (> (cdar b) (cdar a)))))
10476               (loop while (re-search-forward regexp nil t)
10477                  collect (matched))))))))
10478
10479
10480 (defun anything-headline-make-candidate-buffer (regexp subexp)
10481   (with-current-buffer (anything-candidate-buffer 'local)
10482     (loop for (content . pos) in (anything-headline-get-candidates regexp subexp)
10483           do (insert
10484               (format "%5d:%s\n"
10485                       (with-current-buffer anything-current-buffer
10486                         (line-number-at-pos pos))
10487                       content)))))
10488
10489 (defun anything-headline-goto-position (pos recenter)
10490   (goto-char pos)
10491   (unless recenter
10492     (set-window-start (get-buffer-window anything-current-buffer) (point))))
10493
10494 (defun anything-revert-buffer (candidate)
10495   (with-current-buffer candidate
10496     (when (or (buffer-modified-p)
10497               (not (verify-visited-file-modtime
10498                     (get-buffer candidate))))
10499       (revert-buffer t t))))
10500
10501 (defun anything-revert-marked-buffers (ignore)
10502   (mapc 'anything-revert-buffer (anything-marked-candidates)))
10503
10504 (defun anything-kill-marked-buffers (ignore)
10505   (mapc 'kill-buffer (anything-marked-candidates)))
10506
10507 ;; Plug-in: persistent-help
10508 (defun anything-compile-source--persistent-help (source)
10509   (append source '((header-line . anything-persistent-help-string))))
10510 (add-to-list 'anything-compile-source-functions 'anything-compile-source--persistent-help)
10511
10512 (defun anything-persistent-help-string ()
10513   (substitute-command-keys
10514    (concat "\\<anything-map>\\[anything-execute-persistent-action]: "
10515            (or (anything-interpret-value (anything-attr 'persistent-help))
10516                (anything-aif (or (assoc-default 'persistent-action
10517                                                 (anything-get-current-source))
10518                                  (assoc-default 'action
10519                                                 (anything-get-current-source)))
10520                    (cond ((symbolp it) (symbol-name it))
10521                          ((listp it) (or (ignore-errors (caar it))  ""))))
10522                "")
10523            " (keeping session)")))
10524
10525 (anything-document-attribute 'persistent-help "persistent-help plug-in"
10526   "A string to explain persistent-action of this source.
10527 It also accepts a function or a variable name.")
10528
10529 ;;; (anything '(((name . "persistent-help test")(candidates "a")(persistent-help . "TEST"))))
10530
10531 ;; Plug-in: Type customize
10532 (defun anything-c-uniq-list (lst)
10533   "Like `remove-duplicates' in CL.
10534 But cut deeper duplicates and test by `equal'. "
10535   (reverse (remove-duplicates (reverse lst) :test 'equal)))
10536 (defvar anything-additional-type-attributes nil)
10537 (defun anything-c-arrange-type-attribute (type spec)
10538   "Override type attributes by `define-anything-type-attribute'.
10539
10540 The SPEC is like source. The symbol `REST' is replaced with original attribute value.
10541
10542  Example: Set `play-sound-file' as default action
10543    (anything-c-arrange-type-attribute 'file
10544       '((action (\"Play sound\" . play-sound-file)
10545                 REST ;; Rest of actions (find-file, find-file-other-window, ...)
10546    )))
10547 "
10548   (add-to-list 'anything-additional-type-attributes
10549                (cons type
10550                      (loop with typeattr = (assoc-default type anything-type-attributes)
10551                       for (attr . value) in spec
10552                       if (listp value)
10553                       collect (cons attr
10554                                     (anything-c-uniq-list
10555                                      (loop for v in value
10556                                            if (eq v 'REST)
10557                                            append (assoc-default attr typeattr)
10558                                            else
10559                                            collect v)))
10560                       else
10561                       collect (cons attr value)))))
10562 (put 'anything-c-arrange-type-attribute 'lisp-indent-function 1)
10563
10564 (defun anything-compile-source--type-customize (source)
10565   (anything-aif (assoc-default (assoc-default 'type source) anything-additional-type-attributes)
10566       (append it source)
10567     source))
10568 (add-to-list 'anything-compile-source-functions 'anything-compile-source--type-customize t)
10569
10570 ;; Plug-in: default-action
10571 (defun anything-compile-source--default-action (source)
10572   (anything-aif (assoc-default 'default-action source)
10573       (append `((action ,it ,@(remove it (assoc-default 'action source))))
10574               source)
10575     source))
10576 (add-to-list 'anything-compile-source-functions 'anything-compile-source--default-action t)
10577 (anything-document-attribute 'default-action "default-action plug-in"
10578   "Default action.")
10579
10580 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10581
10582 (defun anything-c-find-file-or-marked (candidate)
10583   "Open file CANDIDATE or open anything marked files in background."
10584   (let ((marked (anything-marked-candidates)))
10585     (if (> (length marked) 1)
10586         ;; Open all marked files in background.
10587         (mapc 'find-file-noselect marked)
10588         (if (and (not (file-exists-p candidate))
10589                  (and ffap-url-regexp
10590                       (not (string-match ffap-url-regexp candidate)))
10591                  (string-match "/$" candidate))
10592             ;; A a non--existing filename ending with /
10593             ;; Create a directory and jump to it.
10594             (when (y-or-n-p (format "Create directory `%s'? " candidate))
10595               (let ((dirfname (directory-file-name candidate)))
10596                 (if (file-exists-p dirfname)
10597                     (error "Mkdir: Unable to create directory `%s': file exists."
10598                            (anything-c-basename dirfname))
10599                     (make-directory candidate 'parent)))
10600               (anything-find-files1 candidate))
10601             ;; A non--existing filename NOT ending with / or
10602             ;; an existing filename, create or jump to it.
10603             (find-file-at-point (car marked))))))
10604
10605 (defun anything-delete-marked-files (ignore)
10606   (let* ((files (anything-marked-candidates))
10607          (len (length files)))
10608     (if (not (y-or-n-p
10609               (format "Delete *%s File(s):\n%s"
10610                       len
10611                       (mapconcat (lambda (f) (format "- %s\n" f)) files ""))))
10612         (message "(No deletions performed)")
10613       (dolist (i files)
10614         (set-text-properties 0 (length i) nil i)
10615         (anything-c-delete-file i))
10616       (message "%s File(s) deleted" len))))
10617
10618 (defun anything-ediff-marked-buffers (candidate &optional merge)
10619   "Ediff 2 marked buffers or 1 marked buffer and current-buffer.
10620 With optional arg `merge' call `ediff-merge-buffers'."
10621   (let ((lg-lst (length (anything-marked-candidates)))
10622         buf1 buf2)
10623     (case lg-lst
10624       (0
10625        (error "Error:You have to mark at least 1 buffer"))
10626       (1
10627        (setq buf1 anything-current-buffer
10628              buf2 (first (anything-marked-candidates))))
10629       (2
10630        (setq buf1 (first (anything-marked-candidates))
10631              buf2 (second (anything-marked-candidates))))
10632       (t
10633        (error "Error:To much buffers marked!")))
10634     (if merge
10635         (ediff-merge-buffers buf1 buf2)
10636         (ediff-buffers buf1 buf2))))
10637
10638 (defun anything-bookmark-get-bookmark-from-name (bmk)
10639   "Return bookmark name even if it is a bookmark with annotation.
10640 e.g prepended with *.
10641 Return nil if bmk is not a valid bookmark."
10642   (let ((bookmark (replace-regexp-in-string "\*" "" bmk)))
10643     (if (assoc bookmark bookmark-alist)
10644         bookmark
10645         (when (assoc bmk bookmark-alist)
10646           bmk))))
10647
10648 (defun anything-delete-marked-bookmarks (ignore)
10649   "Delete this bookmark or all marked bookmarks."
10650   (dolist (i (anything-marked-candidates))
10651     (bookmark-delete (anything-bookmark-get-bookmark-from-name i)
10652                      'batch)))
10653
10654 (defun anything-require-or-error (feature function)
10655   (or (require feature nil t)
10656       (error "Need %s to use `%s'." feature function)))
10657
10658 (defun anything-find-buffer-on-elscreen (candidate)
10659   "Open buffer in new screen, if marked buffers open all in elscreens."
10660   (anything-require-or-error 'elscreen 'anything-find-buffer-on-elscreen)
10661   (anything-aif (anything-marked-candidates)
10662       (dolist (i it)
10663         (let ((target-screen (elscreen-find-screen-by-buffer
10664                               (get-buffer i) 'create)))
10665           (elscreen-goto target-screen)))
10666     (let ((target-screen (elscreen-find-screen-by-buffer
10667                           (get-buffer candidate) 'create)))
10668       (elscreen-goto target-screen))))
10669
10670 (defun anything-elscreen-find-file (file)
10671   (anything-require-or-error 'elscreen 'anything-elscreen-find-file)
10672   (elscreen-find-file file))
10673
10674 ;; Toggle anything-match-plugin
10675 (defvar anything-mp-initial-highlight-delay nil)
10676 (defun anything-c-toggle-match-plugin ()
10677   "Toggle anything-match-plugin."
10678   (interactive)
10679   (let ((anything-match-plugin-enabled
10680          (member 'anything-compile-source--match-plugin
10681                  anything-compile-source-functions)))
10682     (flet ((disable-match-plugin ()
10683              (setq anything-compile-source-functions
10684                    (delq 'anything-compile-source--match-plugin
10685                          anything-compile-source-functions))
10686              (setq anything-mp-initial-highlight-delay
10687                    anything-mp-highlight-delay)
10688              (setq anything-mp-highlight-delay nil))
10689            (enable-match-plugin ()
10690              (require 'anything-match-plugin)
10691              (unless anything-mp-initial-highlight-delay
10692                (setq anything-mp-initial-highlight-delay
10693                      anything-mp-highlight-delay))
10694              (setq anything-compile-source-functions
10695                    (cons 'anything-compile-source--match-plugin
10696                          anything-compile-source-functions))
10697              (unless anything-mp-highlight-delay
10698                (setq anything-mp-highlight-delay
10699                      anything-mp-initial-highlight-delay))))
10700       (if anything-match-plugin-enabled
10701           (when (y-or-n-p "Really disable match-plugin? ")
10702             (disable-match-plugin)
10703             (message "Anything-match-plugin disabled"))
10704           (when (y-or-n-p "Really enable match-plugin? ")
10705             (enable-match-plugin)
10706             (message "Anything-match-plugin enabled"))))))
10707
10708 ;; anything switch to buffer
10709 ;; Shut up byte compiler in emacs24.
10710 ;;
10711 (defun anything-c-switch-to-buffer (buffer-or-name)
10712   "Same as `switch-to-buffer' whithout warnings at compile time."
10713   (with-no-warnings
10714     (switch-to-buffer buffer-or-name)))
10715
10716 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Setup ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10717
10718 ;;;; Type Attributes
10719 (define-anything-type-attribute 'buffer
10720   `((action
10721      ("Switch to buffer" . anything-c-switch-to-buffer)
10722      ,(and (locate-library "popwin") '("Switch to buffer in popup window" . popwin:popup-buffer))
10723      ("Switch to buffer other window" . switch-to-buffer-other-window)
10724      ("Switch to buffer other frame" . switch-to-buffer-other-frame)
10725      ,(and (locate-library "elscreen") '("Display buffer in Elscreen" . anything-find-buffer-on-elscreen))
10726      ("Query replace regexp" . anything-c-buffer-query-replace-regexp)
10727      ("View buffer" . view-buffer)
10728      ("Display buffer"   . display-buffer)
10729      ("Grep buffers (C-u grep all buffers)" . anything-c-grep-buffers)
10730      ("Revert buffer(s)" . anything-revert-marked-buffers)
10731      ("Insert buffer" . insert-buffer)
10732      ("Kill buffer(s)" . anything-kill-marked-buffers)
10733      ("Diff with file" . diff-buffer-with-file)
10734      ("Ediff Marked buffers" . anything-ediff-marked-buffers)
10735      ("Ediff Merge marked buffers" . (lambda (candidate)
10736                                        (anything-ediff-marked-buffers candidate t))))
10737     (persistent-help . "Show this buffer")
10738     (candidate-transformer anything-c-skip-current-buffer
10739                            anything-c-skip-boring-buffers
10740                            anything-c-transform-buffer-display-string))
10741   "Buffer or buffer name.")
10742
10743 (define-anything-type-attribute 'file
10744   `((action
10745      ("Find file" . anything-find-many-files)
10746      ,(and (locate-library "popwin") '("Find file in popup window" . popwin:find-file))
10747      ("Find file as root" . anything-find-file-as-root)
10748      ("Find file other window" . find-file-other-window)
10749      ("Find file other frame" . find-file-other-frame)
10750      ("Open dired in file's directory" . anything-c-open-dired)
10751      ("Grep File(s) `C-u recurse'" . anything-find-files-grep)
10752      ("Pdfgrep File(s)" . anything-ff-pdfgrep)
10753      ("View file" . view-file)
10754      ("Insert file" . insert-file)
10755      ("Delete file(s)" . anything-delete-marked-files)
10756      ("Open file externally (C-u to choose)" . anything-c-open-file-externally)
10757      ("Open file with default tool" . anything-c-open-file-with-default-tool)
10758      ("Find file in hex dump" . hexl-find-file))
10759     (persistent-help . "Show this file")
10760     (action-transformer anything-c-transform-file-load-el
10761                         anything-c-transform-file-browse-url)
10762     (candidate-transformer anything-c-w32-pathname-transformer
10763                            anything-c-skip-current-file
10764                            anything-c-skip-boring-files
10765                            anything-c-shorten-home-path))
10766   "File name.")
10767
10768 (let ((actions '(("Describe command" . describe-function)
10769                  ("Add command to kill ring" . anything-c-kill-new)
10770                  ("Go to command's definition" . find-function)
10771                  ("Debug on entry" . debug-on-entry)
10772                  ("Cancel debug on entry" . cancel-debug-on-entry)
10773                  ("Trace function" . trace-function)
10774                  ("Trace function (background)" . trace-function-background)
10775                  ("Untrace function" . untrace-function))))
10776   (define-anything-type-attribute 'command
10777     `((action ("Call interactively" . anything-c-call-interactively)
10778               ,@actions)
10779       ;; Sort commands according to their usage count.
10780       ;(filtered-candidate-transformer . anything-c-adaptive-sort)
10781       (coerce . anything-c-symbolify)
10782       (persistent-action . describe-function))
10783     "Command. (string or symbol)")
10784
10785   (define-anything-type-attribute 'function
10786     `((action . ,actions)
10787       (action-transformer anything-c-transform-function-call-interactively)
10788       (candidate-transformer anything-c-mark-interactive-functions)
10789       (coerce . anything-c-symbolify))
10790     "Function. (string or symbol)"))
10791
10792 (define-anything-type-attribute 'variable
10793   '((action ("Describe variable" . describe-variable)
10794             ("Add variable to kill ring" . anything-c-kill-new)
10795             ("Go to variable's definition" . find-variable)
10796             ("Set variable" . anything-c-set-variable))
10797     (coerce . anything-c-symbolify))
10798   "Variable.")
10799
10800 (define-anything-type-attribute 'sexp
10801   '((action ("Eval s-expression" . (lambda (c) (eval (read c))))
10802             ("Add s-expression to kill ring" . kill-new))
10803     (action-transformer anything-c-transform-sexp-eval-command-sexp))
10804   "String representing S-Expressions.")
10805
10806 (define-anything-type-attribute 'bookmark
10807   `((coerce . anything-bookmark-get-bookmark-from-name)
10808     (action
10809      ("Jump to bookmark" . (lambda (bookmark)
10810                              (let ((current-prefix-arg anything-current-prefix-arg))
10811                                (bookmark-jump bookmark))
10812                              (anything-update)))
10813      ("Jump to BM other window" . (lambda (bookmark)
10814                                     (bookmark-jump-other-window bookmark)
10815                                     (anything-update)))
10816      ("Bookmark edit annotation" . bookmark-edit-annotation)
10817      ("Bookmark show annotation" . bookmark-show-annotation)
10818      ("Delete bookmark(s)" . anything-delete-marked-bookmarks)
10819      ,@(and (locate-library "bookmark-extensions")
10820            `(("Edit Bookmark" . bmkext-edit-bookmark)))
10821      ("Rename bookmark" . bookmark-rename)
10822      ("Relocate bookmark" . bookmark-relocate)))
10823      "Bookmark name.")
10824
10825 (define-anything-type-attribute 'line
10826   '((display-to-real . anything-c-display-to-real-line)
10827     (action ("Go to Line" . anything-c-action-line-goto)))
10828   "LINENO:CONTENT string, eg. \"  16:foo\".
10829
10830 Optional `target-file' attribute is a name of target file.
10831
10832 Optional `before-jump-hook' attribute is a function with no
10833 arguments which is called before jumping to position.
10834
10835 Optional `after-jump-hook' attribute is a function with no
10836 arguments which is called after jumping to position.
10837
10838 If `adjust' attribute is specified, searches the line whose
10839 content is CONTENT near the LINENO.
10840
10841 If `recenter' attribute is specified, the line is displayed at
10842 the center of window, otherwise at the top of window.
10843 ")
10844
10845 (define-anything-type-attribute 'file-line
10846   `((filtered-candidate-transformer anything-c-filtered-candidate-transformer-file-line)
10847     (multiline)
10848     (action ("Go to" . anything-c-action-file-line-goto)))
10849   "FILENAME:LINENO:CONTENT string, eg. \"~/.emacs:16:;; comment\".
10850
10851 Optional `default-directory' attribute is a default-directory
10852 FILENAME is interpreted.
10853
10854 Optional `before-jump-hook' attribute is a function with no
10855 arguments which is called before jumping to position.
10856
10857 Optional `after-jump-hook' attribute is a function with no
10858 arguments which is called after jumping to position.
10859
10860 If `adjust' attribute is specified, searches the line whose
10861 content is CONTENT near the LINENO.
10862
10863 If `recenter' attribute is specified, the line is displayed at
10864 the center of window, otherwise at the top of window.
10865 ")
10866
10867 (define-anything-type-attribute 'timer
10868   '((real-to-display . anything-c-timer-real-to-display)
10869     (action ("Cancel Timer" . cancel-timer)
10870             ("Describe Function" . (lambda (tm) (describe-function (timer--function tm))))
10871             ("Find Function" . (lambda (tm) (find-function (timer--function tm)))))
10872     (persistent-action . (lambda (tm) (describe-function (timer--function tm))))
10873     (persistent-help . "Describe Function"))
10874   "Timer.")
10875
10876 ;;;; Default `anything-sources'
10877 ;; Setting `anything-sources' is DEPRECATED, but it seems that newbies
10878 ;; tend to invoke M-x anything directly. So I offer default setting.
10879 (setq anything-sources
10880       '(anything-c-source-buffers+
10881         anything-c-source-recentf
10882         anything-c-source-files-in-current-dir+))
10883
10884 ;; Unit tests are now in ../developer-tools/unit-test-anything-config.el.
10885
10886 (provide 'anything-config)
10887
10888 ;;; Local Variables:
10889 ;;; time-stamp-format: "%:y-%02m-%02d %02H:%02M:%02S (%Z) %u"
10890 ;;; End:
10891
10892 ;; How to save (DO NOT REMOVE!!)
10893 ;; (progn (magit-push) (emacswiki-post "anything-config.el"))
10894 ;;; anything-config.el ends here
10895
10896 ;;; LocalWords:  Tassilo Patrovics Vagn Johansen Dahl Clementson infos
10897 ;;; LocalWords:  Kamphausen informations McBrayer Volpiatto bbdb bb
10898 ;;; LocalWords:  iswitchb imenu Recentf sym samewindow pos bol eol
10899 ;;; LocalWords:  aif str lst func attrib recentf lessp prin mapatoms commandp
10900 ;;; LocalWords:  cmd stb Picklist picklist mapcan subentry destructuring dirs
10901 ;;; LocalWords:  darwin locat MacOS mdfind Firstname Lastname calc prepend jids
10902 ;;; LocalWords:  dotimes Thierry online vname
10903 ;;; LocalWords:  csharp javascript lua makefile cperl zcat lineno buf
10904 ;;; LocalWords:  multiline href fn cand NewTitle cwd filepath thru ret
10905 ;;; LocalWords:  bfn fOpen UNC cygdrive nt xdg macos FILE's elc rx svn hg
10906 ;;; LocalWords:  CANDIDATE's darcs facep pathname args pathnames subseq priorty
10907 ;;; LocalWords:  Vokes rfind berkeley JST ffap lacarte bos
10908 ;;; LocalWords:  Lacarte Minibuf epp LaCarte bm attrset migemo attr conf mklist
10909 ;;; LocalWords:  startpos noselect dont desc