extensions/anything-complete.el

   1 ;;; anything-complete.el --- completion with anything
   2 ;; $Id: anything-complete.el,v 1.86 2010-03-31 23:14:13 rubikitch Exp $
   3
   4 ;; Copyright (C) 2008, 2009, 2010 rubikitch
   5
   6 ;; Author: rubikitch <rubikitch@ruby-lang.org>
   7 ;; Keywords: matching, convenience, anything
   8 ;; URL: http://www.emacswiki.org/cgi-bin/wiki/download/anything-complete.el
   9
  10 ;; This file is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2, or (at your option)
  13 ;; any later version.
  14
  15 ;; This file is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  22 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  23 ;; Boston, MA 02110-1301, USA.
  24
  25 ;;; Commentary:
  26
  27 ;; Completion with Anything interface.
  28
  29 ;;; Commands:
  30 ;;
  31 ;; Below are complete command list:
  32 ;;
  33 ;;  `alcs-update-restart'
  34 ;;    Update lisp symbols and restart current `anything' session.
  35 ;;  `anything-lisp-complete-symbol'
  36 ;;    `lisp-complete-symbol' replacement using `anything'.
  37 ;;  `anything-lisp-complete-symbol-partial-match'
  38 ;;    `lisp-complete-symbol' replacement using `anything' (partial match).
  39 ;;  `anything-apropos'
  40 ;;    `apropos' replacement using `anything'.
  41 ;;  `anything-read-file-name-follow-directory'
  42 ;;    Follow directory in `anything-read-file-name'.
  43 ;;  `anything-read-string-mode'
  44 ;;    If this minor mode is on, use `anything' version of `completing-read' and `read-file-name'.
  45 ;;  `anything-complete-shell-history'
  46 ;;    Select a command from shell history and insert it.
  47 ;;  `anything-execute-extended-command'
  48 ;;    Replacement of `execute-extended-command'.
  49 ;;  `anything-find-file'
  50 ;;    Replacement of `find-file'.
  51 ;;
  52 ;;; Customizable Options:
  53 ;;
  54 ;; Below are customizable option list:
  55 ;;
  56 ;;  `anything-complete-sort-candidates'
  57 ;;    *Whether to sort completion candidates.
  58 ;;    default = nil
  59 ;;  `anything-execute-extended-command-use-kyr'
  60 ;;    *Use `anything-kyr' (context-aware commands) in `anything-execute-extended-command'.
  61 ;;    default = t
  62
  63 ;; * `anything-lisp-complete-symbol', `anything-lisp-complete-symbol-partial-match':
  64 ;;     `lisp-complete-symbol' with `anything'
  65 ;; * `anything-apropos': `apropos' with `anything'
  66 ;; * `anything-complete-shell-history': complete from .*sh_history
  67 ;; * Many read functions:
  68 ;;     `anything-read-file-name', `anything-read-buffer', `anything-read-variable',
  69 ;;     `anything-read-command', `anything-completing-read'
  70 ;; * `anything-read-string-mode' replaces default read functions with anything ones.
  71 ;; * Many anything sources:
  72 ;;     [EVAL IT] (occur "defvar anything-c-source")
  73
  74 ;;; Installation:
  75
  76 ;; Put anything-complete.el to your load-path.
  77 ;; The load-path is usually ~/elisp/.
  78 ;; It's set in your ~/.emacs like this:
  79 ;; (add-to-list 'load-path (expand-file-name "~/elisp"))
  80 ;;
  81 ;; Then install dependencies.
  82 ;;
  83 ;; Install anything-match-plugin.el (must).
  84 ;; M-x install-elisp http://www.emacswiki.org/cgi-bin/wiki/download/anything-match-plugin.el
  85 ;;
  86 ;; shell-history.el / shell-command.el would help you (optional).
  87 ;; M-x install-elisp http://www.emacswiki.org/cgi-bin/wiki/download/shell-history.el
  88 ;; M-x install-elisp http://www.emacswiki.org/cgi-bin/wiki/download/shell-command.el
  89 ;;
  90 ;; If you want `anything-execute-extended-command' to show
  91 ;; context-aware commands, use anything-kyr.el and
  92 ;; anything-kyr-config.el (optional).
  93 ;;
  94 ;; M-x install-elisp http://www.emacswiki.org/cgi-bin/wiki/download/anything-kyr.el
  95 ;; M-x install-elisp http://www.emacswiki.org/cgi-bin/wiki/download/anything-kyr-config.el
  96
  97 ;; And the following to your ~/.emacs startup file.
  98 ;;
  99 ;; (require 'anything-complete)
 100 ;; ;; Automatically collect symbols by 150 secs
 101 ;; (anything-lisp-complete-symbol-set-timer 150)
 102 ;; (define-key emacs-lisp-mode-map "\C-\M-i" 'anything-lisp-complete-symbol-partial-match)
 103 ;; (define-key lisp-interaction-mode-map "\C-\M-i" 'anything-lisp-complete-symbol-partial-match)
 104 ;; ;; replace completion commands with `anything'
 105 ;; (anything-read-string-mode 1)
 106 ;; ;; Bind C-o to complete shell history
 107 ;; (anything-complete-shell-history-setup-key "\C-o")
 108
 109 ;;; History:
 110
 111 ;; $Log: anything-complete.el,v $
 112 ;; Revision 1.86  2010-03-31 23:14:13  rubikitch
 113 ;; `anything-completing-read': Fix a case when HIST is a cons.
 114 ;;
 115 ;; Revision 1.85  2010/03/31 03:22:29  rubikitch
 116 ;; anything attribute completion from M-x anything-lisp-complete-symbol(-partial-match)
 117 ;;
 118 ;; Revision 1.84  2010/03/27 02:43:45  rubikitch
 119 ;; Use `anything-force-update' feature
 120 ;;
 121 ;; Revision 1.83  2010/03/22 06:10:40  rubikitch
 122 ;; tidy
 123 ;;
 124 ;; Revision 1.82  2010/03/22 05:57:57  rubikitch
 125 ;; New sources:
 126 ;;   `anything-c-source-complete-emacs-faces',
 127 ;;   `anything-c-source-apropos-emacs-faces',
 128 ;;   `anything-c-source-emacs-face-at-point'
 129 ;; `anything-lisp-complete-symbol', `anything-apropos': Search faces too
 130 ;;
 131 ;; Revision 1.81  2010/02/20 10:38:31  rubikitch
 132 ;; More strict version check.
 133 ;;
 134 ;; Revision 1.80  2010/02/20 10:16:30  rubikitch
 135 ;; * `ac-new-input-source': remove unnecessary attributes
 136 ;; * version check
 137 ;;
 138 ;; Revision 1.79  2010/02/06 23:38:21  rubikitch
 139 ;; * `alcs-update-restart': use `anything-update' instead
 140 ;; * Minor fix in `anything-execute-extended-command-sources'
 141 ;;
 142 ;; Revision 1.78  2010/02/04 19:27:07  rubikitch
 143 ;; Added docstrings
 144 ;;
 145 ;; Revision 1.77  2010/01/29 09:20:33  rubikitch
 146 ;; update Copyright
 147 ;;
 148 ;; Revision 1.76  2010/01/29 09:19:21  rubikitch
 149 ;; New option: `anything-execute-extended-command-use-kyr'
 150 ;;
 151 ;; Revision 1.75  2010/01/29 09:15:24  rubikitch
 152 ;; Make `anything-execute-extended-command' faster
 153 ;; * eliminate "Commands (by prefix)", which makes it slow down
 154 ;; * `C-c C-u' to update commands instead
 155 ;;
 156 ;; Revision 1.74  2010/01/23 04:18:18  rubikitch
 157 ;; `ac-new-input-source': temporarily disable shortcuts
 158 ;;
 159 ;; Revision 1.73  2009/12/25 01:35:59  rubikitch
 160 ;; Adjust `anything-noresume' to latest version of `anything'
 161 ;;
 162 ;; Revision 1.72  2009/12/14 00:13:28  rubikitch
 163 ;; New command: `alcs-update-restart'
 164 ;;
 165 ;; Pressing `C-c C-u' in `anything-lisp-complete-symbol' and `anything-lisp-complete-symbol-partial-match' recollects symbols and reexecutes this command.
 166 ;;
 167 ;; Revision 1.71  2009/12/13 23:34:19  rubikitch
 168 ;; Show timestamp of lisp symbols
 169 ;;
 170 ;; Revision 1.70  2009/12/13 23:17:18  rubikitch
 171 ;; Make alcs-make-candidates timer singleton
 172 ;;
 173 ;; Revision 1.69  2009/12/13 23:06:34  rubikitch
 174 ;; New variable `anything-lisp-complete-symbol-add-space-on-startup':
 175 ;;
 176 ;; If non-nil, `anything-lisp-complete-symbol' and `anything-lisp-complete-symbol-partial-match' adds space on startup.
 177 ;; It utilizes anything-match-plugin's feature.
 178 ;;
 179 ;; Revision 1.68  2009/11/11 19:01:09  rubikitch
 180 ;; Bug fix when completing at right side
 181 ;;
 182 ;; Revision 1.67  2009/11/11 18:03:49  rubikitch
 183 ;; New implementation of `alcs-current-physical-column'
 184 ;;
 185 ;; Revision 1.66  2009/10/26 09:38:39  rubikitch
 186 ;; `anything-completing-read': Show default source first when require-match and default is specified.
 187 ;;
 188 ;; Revision 1.65  2009/10/22 08:54:58  rubikitch
 189 ;; `anything-complete-shell-history-setup-key': Use `minibuffer-local-shell-command-map' if any
 190 ;;
 191 ;; Revision 1.64  2009/10/13 05:40:51  rubikitch
 192 ;; `anything-completing-read': Show completions first when require-match == t
 193 ;;
 194 ;; Revision 1.63  2009/10/11 20:27:22  rubikitch
 195 ;; `alcs-transformer-prepend-spacer': use physical column instead of logical column
 196 ;;
 197 ;; Revision 1.62  2009/10/10 03:27:33  rubikitch
 198 ;; New variable: `anything-complete-sort-candidates'
 199 ;;
 200 ;; Revision 1.61  2009/10/08 17:06:35  rubikitch
 201 ;; `anything-complete-shell-history': taller window
 202 ;;
 203 ;; Revision 1.60  2009/10/08 05:12:27  rubikitch
 204 ;; If anything-show-completion.el is available, candidates are shown near the point.
 205 ;;
 206 ;; Revision 1.59  2009/10/07 10:29:34  rubikitch
 207 ;; `anything-find-file': use `anything-other-buffer' instead of `anything-complete'
 208 ;;
 209 ;; Revision 1.58  2009/10/01 03:07:44  rubikitch
 210 ;; Fix an error in `anything-find-file'. Thanks to troter.
 211 ;; http://d.hatena.ne.jp/troter/20090929/1254199115
 212 ;;
 213 ;; Revision 1.57  2009/08/02 04:19:52  rubikitch
 214 ;; New variable: `anything-complete-persistent-action'
 215 ;;
 216 ;; Revision 1.56  2009/07/26 21:25:04  rubikitch
 217 ;; New variable: `anything-completing-read-use-default'
 218 ;; New variable: `anything-completing-read-history-first'
 219 ;; `anything-completing-read', `anything-read-file-name': history order bug fix
 220 ;;
 221 ;; Revision 1.55  2009/07/19 07:33:33  rubikitch
 222 ;; `anything-execute-extended-command': adjust to keyboard macro command
 223 ;;
 224 ;; Revision 1.54  2009/06/29 15:13:02  rubikitch
 225 ;; New function: `anything-complete-shell-history-setup-key'
 226 ;;
 227 ;; Revision 1.53  2009/06/24 15:37:50  rubikitch
 228 ;; `anything-c-source-complete-shell-history': require bug fix
 229 ;;
 230 ;; Revision 1.52  2009/05/30 05:04:30  rubikitch
 231 ;; Set `anything-execute-action-at-once-if-one' to t
 232 ;;
 233 ;; Revision 1.51  2009/05/25 18:57:22  rubikitch
 234 ;; Removed experimental tags
 235 ;;
 236 ;; Revision 1.50  2009/05/06 12:34:45  rubikitch
 237 ;; `anything-complete': target is default input.
 238 ;;
 239 ;; Revision 1.49  2009/05/04 14:51:18  rubikitch
 240 ;; use `define-anything-type-attribute' to add `anything-type-attributes' entry.
 241 ;;
 242 ;; Revision 1.48  2009/05/03 19:07:22  rubikitch
 243 ;; anything-complete: `enable-recursive-minibuffers' = t
 244 ;;
 245 ;; Revision 1.47  2009/05/03 18:42:23  rubikitch
 246 ;; Remove *-partial-match sources.
 247 ;; They are aliased for compatibility.
 248 ;;
 249 ;; Revision 1.46  2009/05/03 18:33:35  rubikitch
 250 ;; Remove dependency of `ac-candidates-in-buffer'
 251 ;;
 252 ;; Revision 1.45  2009/04/20 16:24:33  rubikitch
 253 ;; Set anything-samewindow to nil for in-buffer completion.
 254 ;;
 255 ;; Revision 1.44  2009/04/18 10:07:35  rubikitch
 256 ;; * auto-document.
 257 ;; * Use anything-show-completion.el if available.
 258 ;;
 259 ;; Revision 1.43  2009/02/27 14:45:26  rubikitch
 260 ;; Fix a read-only bug in `alcs-make-candidates'.
 261 ;;
 262 ;; Revision 1.42  2009/02/19 23:04:33  rubikitch
 263 ;; * update doc
 264 ;; * use anything-kyr if any
 265 ;;
 266 ;; Revision 1.41  2009/02/19 22:54:29  rubikitch
 267 ;; refactoring
 268 ;;
 269 ;; Revision 1.40  2009/02/06 09:19:08  rubikitch
 270 ;; Fix a bug when 2nd argument of `anything-read-file-name' (DIR) is not a directory.
 271 ;;
 272 ;; Revision 1.39  2009/01/28 20:33:31  rubikitch
 273 ;; add persistent-action for `anything-read-file-name' and `anything-read-buffer'.
 274 ;;
 275 ;; Revision 1.38  2009/01/08 19:28:33  rubikitch
 276 ;; `anything-completing-read': fixed a bug when COLLECTION is a non-nested list.
 277 ;;
 278 ;; Revision 1.37  2009/01/02 15:08:03  rubikitch
 279 ;; `anything-execute-extended-command': show commands which are not collected.
 280 ;;
 281 ;; Revision 1.36  2008/11/27 08:12:36  rubikitch
 282 ;; `anything-read-buffer': accept empty buffer name
 283 ;;
 284 ;; Revision 1.35  2008/11/02 06:30:06  rubikitch
 285 ;; `anything-execute-extended-command': fixed a bug
 286 ;;
 287 ;; Revision 1.34  2008/10/30 18:45:27  rubikitch
 288 ;; `arfn-sources': use `file-name-history' instead
 289 ;;
 290 ;; Revision 1.33  2008/10/30 16:39:17  rubikitch
 291 ;; *** empty log message ***
 292 ;;
 293 ;; Revision 1.32  2008/10/30 11:09:17  rubikitch
 294 ;; New command: `anything-find-file'
 295 ;;
 296 ;; Revision 1.31  2008/10/30 10:29:56  rubikitch
 297 ;; `ac-new-input-source', `ac-default-source', `acr-sources', `arfn-sources', `arb-sources': changed args
 298 ;;
 299 ;; Revision 1.30  2008/10/30 09:33:50  rubikitch
 300 ;; `anything-execute-extended-command': fixed a bug
 301 ;;
 302 ;; Revision 1.29  2008/10/27 10:55:55  rubikitch
 303 ;; New command: `anything-execute-extended-command'
 304 ;;
 305 ;; Revision 1.28  2008/10/27 10:41:33  rubikitch
 306 ;; use linkd tag (no code change)
 307 ;;
 308 ;; Revision 1.27  2008/10/21 18:02:39  rubikitch
 309 ;; `anything-noresume': restore `anything-last-buffer'
 310 ;;
 311 ;; Revision 1.26  2008/10/03 09:55:45  rubikitch
 312 ;; anything-read-file-name bug fix
 313 ;;
 314 ;; Revision 1.25  2008/09/30 22:49:22  rubikitch
 315 ;; `anything-completing-read': handle empty input.
 316 ;;
 317 ;; Revision 1.24  2008/09/22 09:15:03  rubikitch
 318 ;; *** empty log message ***
 319 ;;
 320 ;; Revision 1.23  2008/09/22 09:12:42  rubikitch
 321 ;; set `anything-input-idle-delay'.
 322 ;;
 323 ;; Revision 1.22  2008/09/20 20:27:46  rubikitch
 324 ;; s/anything-attr/anything-attr-defined/ because of `anything-attr' change
 325 ;;
 326 ;; Revision 1.21  2008/09/15 17:31:34  rubikitch
 327 ;; *** empty log message ***
 328 ;;
 329 ;; Revision 1.20  2008/09/14 15:20:12  rubikitch
 330 ;; set `anything-input-idle-delay'.
 331 ;;
 332 ;; Revision 1.19  2008/09/12 02:56:33  rubikitch
 333 ;; Complete functions using `anything' restore `anything-last-sources'
 334 ;; and `anything-compiled-sources' now, because resuming
 335 ;; `anything'-complete session is useless.
 336 ;;
 337 ;; Revision 1.18  2008/09/10 23:27:09  rubikitch
 338 ;; Use *anything complete* buffer instead
 339 ;;
 340 ;; Revision 1.17  2008/09/10 09:59:22  rubikitch
 341 ;; arfn-sources: bug fix
 342 ;;
 343 ;; Revision 1.16  2008/09/10 09:40:31  rubikitch
 344 ;; arfn-sources: paren bug fix
 345 ;;
 346 ;; Revision 1.15  2008/09/09 01:19:49  rubikitch
 347 ;; add (require 'shell-history)
 348 ;;
 349 ;; Revision 1.14  2008/09/05 13:59:39  rubikitch
 350 ;; bugfix
 351 ;;
 352 ;; Revision 1.13  2008/09/05 13:50:14  rubikitch
 353 ;; * Use `keyboard-quit' when anything-read-* is quit.
 354 ;; * Change keybinding of `anything-read-file-name-follow-directory' to Tab
 355 ;; * `anything-read-file-name-follow-directory': smarter behavior
 356 ;;
 357 ;; Revision 1.12  2008/09/05 12:46:27  rubikitch
 358 ;; bugfix
 359 ;;
 360 ;; Revision 1.11  2008/09/05 03:15:26  rubikitch
 361 ;; *** empty log message ***
 362 ;;
 363 ;; Revision 1.10  2008/09/05 01:49:56  rubikitch
 364 ;; `anything-completing-read' supports list collection only.
 365 ;;
 366 ;; Revision 1.9  2008/09/05 00:09:46  rubikitch
 367 ;; New functions: moved from anything.el
 368 ;;   `anything-completing-read', `anything-read-file-name', `anything-read-buffer',
 369 ;;   `anything-read-variable', `anything-read-command', `anything-read-string-mode'.
 370 ;;
 371 ;; Revision 1.8  2008/09/04 16:54:59  rubikitch
 372 ;; add commentary
 373 ;;
 374 ;; Revision 1.7  2008/09/04 08:36:08  rubikitch
 375 ;; fixed a bug when `symbol-at-point' is nil.
 376 ;;
 377 ;; Revision 1.6  2008/09/04 08:29:40  rubikitch
 378 ;; remove unneeded code.
 379 ;;
 380 ;; Revision 1.5  2008/09/04 08:12:05  rubikitch
 381 ;; absorb anything-lisp-complete-symbol.el v1.13.
 382 ;;
 383 ;; Revision 1.4  2008/09/04 07:36:23  rubikitch
 384 ;; Use type plug-in instead.
 385 ;;
 386 ;; Revision 1.3  2008/09/03 04:13:23  rubikitch
 387 ;; `anything-c-source-complete-shell-history': deleted requires-pattern
 388 ;;
 389 ;; Revision 1.2  2008/09/01 22:27:45  rubikitch
 390 ;; *** empty log message ***
 391 ;;
 392 ;; Revision 1.1  2008/09/01 22:23:55  rubikitch
 393 ;; Initial revision
 394 ;;
 395
 396 ;;; Code:
 397
 398 (defvar anything-complete-version "$Id: anything-complete.el,v 1.86 2010-03-31 23:14:13 rubikitch Exp $")
 399 (require 'anything-match-plugin)
 400 (require 'thingatpt)
 401
 402 ;; version check
 403 (let ((version "1.263"))
 404   (when (and (string= "1." (substring version 0 2))
 405              (string-match "1\.\\([0-9]+\\)" anything-version)
 406              (< (string-to-number (match-string 1 anything-version))
 407                 (string-to-number (substring version 2))))
 408     (error "Please update anything.el!!
 409
 410 http://www.emacswiki.org/cgi-bin/wiki/download/anything.el
 411
 412 or  M-x install-elisp-from-emacswiki anything.el")))
 413
 414 ;; (@* "overlay")
 415 (when (require 'anything-show-completion nil t)
 416   (dolist (f '(anything-complete
 417                anything-lisp-complete-symbol
 418                anything-lisp-complete-symbol-partial-match))
 419     (use-anything-show-completion f '(length anything-complete-target))))
 420
 421 ;; (@* "core")
 422 (defvar anything-complete-target "")
 423
 424 (defun ac-insert (candidate)
 425   (let ((pt (point)))
 426     (when (and (search-backward anything-complete-target nil t)
 427                (string= (buffer-substring (point) pt) anything-complete-target))
 428       (delete-region (point) pt)))
 429   (insert candidate))
 430
 431 (define-anything-type-attribute 'complete
 432   '((candidates-in-buffer)
 433     (action . ac-insert)))
 434
 435 ;; Warning: I'll change this function's interface. DON'T USE IN YOUR PROGRAM!
 436 (defun anything-noresume (&optional any-sources any-input any-prompt any-resume any-preselect any-buffer)
 437   (let (anything-last-sources anything-compiled-sources anything-last-buffer)
 438     (anything any-sources any-input any-prompt 'noresume any-preselect any-buffer)))
 439
 440 (defun anything-complete (sources target &optional limit idle-delay input-idle-delay)
 441   "Basic completion interface using `anything'."
 442   (let ((anything-candidate-number-limit (or limit anything-candidate-number-limit))
 443         (anything-idle-delay (or idle-delay anything-idle-delay))
 444         (anything-input-idle-delay (or input-idle-delay anything-input-idle-delay))
 445         (anything-complete-target target)
 446         (anything-execute-action-at-once-if-one t)
 447         (enable-recursive-minibuffers t)
 448         anything-samewindow)
 449     (anything-noresume sources target nil nil nil "*anything complete*")))
 450
 451 ;; (@* "`lisp-complete-symbol' and `apropos' replacement")
 452 (defvar anything-lisp-complete-symbol-input-idle-delay 0.1
 453   "`anything-input-idle-delay' for `anything-lisp-complete-symbol',
 454 `anything-lisp-complete-symbol-partial-match' and `anything-apropos'.")
 455 (defvar anything-lisp-complete-symbol-add-space-on-startup t
 456   "If non-nil, `anything-lisp-complete-symbol' and `anything-lisp-complete-symbol-partial-match' adds space on startup.
 457 It utilizes anything-match-plugin's feature.")
 458
 459 (defun alcs-create-buffer (name)
 460   (let ((b (get-buffer-create name)))
 461     (with-current-buffer b
 462       (buffer-disable-undo)
 463       (erase-buffer)
 464       b)))
 465
 466 (defvar alcs-variables-buffer " *variable symbols*")
 467 (defvar alcs-functions-buffer " *function symbols*")
 468 (defvar alcs-commands-buffer " *command symbols*")
 469 (defvar alcs-faces-buffer " *face symbols*")
 470 (defvar alcs-symbol-buffer " *other symbols*")
 471
 472 (defvar alcs-symbols-time nil
 473   "Timestamp of collected symbols")
 474
 475 (defun alcs-make-candidates ()
 476   (message "Collecting symbols...")
 477   ;; To ignore read-only property.
 478   (let ((inhibit-read-only t))
 479     (setq alcs-symbols-time (current-time))
 480     (alcs-create-buffer alcs-variables-buffer)
 481     (alcs-create-buffer alcs-functions-buffer)
 482     (alcs-create-buffer alcs-commands-buffer)
 483     (alcs-create-buffer alcs-faces-buffer)
 484     (alcs-create-buffer alcs-symbol-buffer)
 485     (mapatoms
 486      (lambda (sym)
 487        (let ((name (symbol-name sym))
 488              (bp (boundp sym))
 489              (fbp (fboundp sym)))
 490          (cond ((commandp sym)    (set-buffer alcs-commands-buffer) (insert name "\n"))
 491                (fbp               (set-buffer alcs-functions-buffer) (insert name "\n")))
 492          (cond (bp                (set-buffer alcs-variables-buffer) (insert name "\n")))
 493          (cond ((facep sym)       (set-buffer alcs-faces-buffer) (insert name "\n"))
 494                ((not (or bp fbp)) (set-buffer alcs-symbol-buffer) (insert name "\n")))))))
 495   (message "Collecting symbols...done"))
 496
 497 (defun alcs-header-name (name)
 498   (format "%s at %s (Press `C-c C-u' to update)"
 499           name (format-time-string "%H:%M:%S" alcs-symbols-time)))
 500
 501 (defvar alcs-make-candidates-timer nil)
 502 (defun anything-lisp-complete-symbol-set-timer (update-period)
 503   "Update Emacs symbols list when Emacs is idle,
 504 used by `anything-lisp-complete-symbol-set-timer' and `anything-apropos'"
 505   (when alcs-make-candidates-timer
 506     (cancel-timer alcs-make-candidates-timer))
 507   (setq alcs-make-candidates-timer
 508         (run-with-idle-timer update-period t 'alcs-make-candidates)))
 509
 510 (defvar alcs-physical-column-at-startup nil)
 511 (defun alcs-init (bufname)
 512   (declare (special anything-dabbrev-last-target))
 513   (setq alcs-physical-column-at-startup nil)
 514   (setq anything-complete-target
 515         (if (loop for src in (anything-get-sources)
 516                   thereis (string-match "^dabbrev" (assoc-default 'name src)))
 517             anything-dabbrev-last-target
 518           (anything-aif (symbol-at-point) (symbol-name it) "")))
 519   (anything-candidate-buffer (get-buffer bufname)))
 520
 521 (defcustom anything-complete-sort-candidates nil
 522   "*Whether to sort completion candidates."
 523   :type 'boolean
 524   :group 'anything-complete)
 525
 526 (defcustom anything-execute-extended-command-use-kyr t
 527   "*Use `anything-kyr' (context-aware commands) in `anything-execute-extended-command'. "
 528   :type 'boolean
 529   :group 'anything-complete)
 530 (defun alcs-sort-maybe (candidates source)
 531   (if anything-complete-sort-candidates
 532       (sort candidates #'string<)
 533     candidates))
 534 (defun alcs-fontify-face (candidates source)
 535   (mapcar
 536    (lambda (facename)
 537      (propertize facename 'face (intern-soft facename)))
 538    candidates))
 539 ;;; borrowed from pulldown.el
 540 (defun alcs-current-physical-column ()
 541   "Current physical column. (not logical column)"
 542   ;; (- (point) (save-excursion (vertical-motion 0) (point)))
 543   (car (posn-col-row (posn-at-point))))
 544
 545 (defun alcs-transformer-prepend-spacer (candidates source)
 546   "Prepend spaces according to `current-column' for each CANDIDATES."
 547   (setq alcs-physical-column-at-startup
 548         (or alcs-physical-column-at-startup
 549             (with-current-buffer anything-current-buffer
 550               (save-excursion
 551                 (backward-char (string-width anything-complete-target))
 552                 (alcs-current-physical-column)))))
 553   (mapcar (lambda (cand) (cons (concat (make-string alcs-physical-column-at-startup ? ) cand) cand))
 554           candidates))
 555
 556 (defun alcs-transformer-prepend-spacer-maybe (candidates source)
 557   ;; `anything-show-completion-activate' is defined in anything-show-completion.el
 558   (if (and (boundp 'anything-show-completion-activate)
 559            anything-show-completion-activate)
 560       (alcs-transformer-prepend-spacer candidates source)
 561     candidates))
 562
 563 (defun alcs-describe-function (name)
 564   (describe-function (anything-c-symbolify name)))
 565 (defun alcs-describe-variable (name)
 566   (describe-variable (anything-c-symbolify name)))
 567 (defun alcs-describe-face (name)
 568   (describe-face (anything-c-symbolify name)))
 569 (defun alcs-customize-face (name)
 570   (customize-face (anything-c-symbolify name)))
 571 (defun alcs-find-function (name)
 572   (find-function (anything-c-symbolify name)))
 573 (defun alcs-find-variable (name)
 574   (find-variable (anything-c-symbolify name)))
 575
 576 (defvar anything-c-source-complete-emacs-functions
 577   '((name . "Functions")
 578     (init . (lambda () (alcs-init alcs-functions-buffer)))
 579     (candidates-in-buffer)
 580     (type . complete-function)))
 581 (defvar anything-c-source-complete-emacs-commands
 582   '((name . "Commands")
 583     (init . (lambda () (alcs-init alcs-commands-buffer)))
 584     (candidates-in-buffer)
 585     (type . complete-function)))
 586 (defvar anything-c-source-complete-emacs-variables
 587   '((name . "Variables")
 588     (init . (lambda () (alcs-init alcs-variables-buffer)))
 589     (candidates-in-buffer)
 590     (type . complete-variable)))
 591 (defvar anything-c-source-complete-emacs-faces
 592   '((name . "Faces")
 593     (init . (lambda () (alcs-init alcs-faces-buffer)))
 594     (candidates-in-buffer)
 595     (type . complete-face)))
 596 (defvar anything-c-source-complete-emacs-other-symbols
 597   '((name . "Other Symbols")
 598     (init . (lambda () (alcs-init alcs-symbol-buffer)))
 599     (candidates-in-buffer)
 600     (filtered-candidate-transformer . alcs-sort-maybe)
 601     (action . ac-insert)))
 602 (defvar anything-c-source-apropos-emacs-functions
 603   '((name . "Apropos Functions")
 604     (init . (lambda () (alcs-init alcs-functions-buffer)))
 605     (candidates-in-buffer)
 606     (requires-pattern . 3)
 607     (type . apropos-function)))
 608 (defvar anything-c-source-apropos-emacs-commands
 609   '((name . "Apropos Commands")
 610     (init . (lambda () (alcs-init alcs-commands-buffer)))
 611     (candidates-in-buffer)
 612     (requires-pattern . 3)
 613     (type . apropos-function)))
 614 (defvar anything-c-source-apropos-emacs-variables
 615   '((name . "Apropos Variables")
 616     (init . (lambda () (alcs-init alcs-variables-buffer)))
 617     (candidates-in-buffer)
 618     (requires-pattern . 3)
 619     (type . apropos-variable)))
 620 (defvar anything-c-source-apropos-emacs-faces
 621   '((name . "Apropos Faces")
 622     (init . (lambda () (alcs-init alcs-faces-buffer)))
 623     (candidates-in-buffer)
 624     (requires-pattern . 3)
 625     (type . apropos-face)))
 626 (defvar anything-c-source-emacs-function-at-point
 627   '((name . "Function at point")
 628     (candidates
 629      . (lambda () (with-current-buffer anything-current-buffer
 630                     (anything-aif (function-called-at-point)
 631                         (list (symbol-name it))))))
 632     (type . apropos-function)))
 633 (defvar anything-c-source-emacs-variable-at-point
 634   '((name . "Variable at point")
 635     (candidates
 636      . (lambda () (with-current-buffer anything-current-buffer
 637                     (anything-aif (variable-at-point)
 638                         (unless (equal 0 it) (list (symbol-name it)))))))
 639     (type . apropos-variable)))
 640 (defvar anything-c-source-emacs-face-at-point
 641   '((name . "Face at point")
 642     (candidates
 643      . (lambda () (with-current-buffer anything-current-buffer
 644                     (anything-aif (face-at-point)
 645                         (unless (equal 0 it) (list (symbol-name it)))))))
 646     (type . apropos-variable)))
 647
 648 (defvar anything-lisp-complete-symbol-sources
 649   '(anything-c-source-complete-anything-attributes
 650     anything-c-source-complete-emacs-commands
 651     anything-c-source-complete-emacs-functions
 652     anything-c-source-complete-emacs-variables
 653     anything-c-source-complete-emacs-faces))
 654
 655 (defvar anything-apropos-sources
 656   '(anything-c-source-apropos-emacs-commands
 657     anything-c-source-apropos-emacs-functions
 658     anything-c-source-apropos-emacs-variables
 659     anything-c-source-apropos-emacs-faces))
 660
 661 (define-anything-type-attribute 'apropos-function
 662   '((filtered-candidate-transformer . alcs-sort-maybe)
 663     (header-name . alcs-header-name)
 664     (persistent-action . alcs-describe-function)
 665     (update . alcs-make-candidates)
 666     (action
 667      ("Describe Function" . alcs-describe-function)
 668      ("Find Function" . alcs-find-function))))
 669 (define-anything-type-attribute 'apropos-variable
 670   '((filtered-candidate-transformer . alcs-sort-maybe)
 671     (header-name . alcs-header-name)
 672     (persistent-action . alcs-describe-variable)
 673     (update . alcs-make-candidates)
 674     (action
 675      ("Describe Variable" . alcs-describe-variable)
 676      ("Find Variable" . alcs-find-variable))))
 677 (define-anything-type-attribute 'apropos-face
 678   '((filtered-candidate-transformer alcs-sort-maybe alcs-fontify-face)
 679     (get-line . buffer-substring)
 680     (header-name . alcs-header-name)
 681     (update . alcs-make-candidates)
 682     (persistent-action . alcs-describe-face)
 683     (action
 684      ("Customize Face" . alcs-customize-face)
 685      ("Describe Face" . alcs-describe-face))))
 686 (define-anything-type-attribute 'complete-function
 687   '((filtered-candidate-transformer alcs-sort-maybe alcs-transformer-prepend-spacer-maybe)
 688     (header-name . alcs-header-name)
 689     (action . ac-insert)
 690     (update . alcs-make-candidates)
 691     (persistent-action . alcs-describe-function)))
 692 (define-anything-type-attribute 'complete-variable
 693   '((filtered-candidate-transformer alcs-sort-maybe alcs-transformer-prepend-spacer-maybe)
 694     (header-name . alcs-header-name)
 695     (action . ac-insert)
 696     (update . alcs-make-candidates)
 697     (persistent-action . alcs-describe-variable)))
 698 (define-anything-type-attribute 'complete-face
 699   '((filtered-candidate-transformer alcs-sort-maybe alcs-transformer-prepend-spacer-maybe)
 700     (header-name . alcs-header-name)
 701     (action . ac-insert)
 702     (update . alcs-make-candidates)
 703     (persistent-action . alcs-describe-face)))
 704
 705 (defvar alcs-this-command nil)
 706 (defun* anything-lisp-complete-symbol-1 (update sources input &optional (buffer "*anything complete*"))
 707   (setq alcs-this-command this-command)
 708   (when (or update (null (get-buffer alcs-variables-buffer)))
 709     (alcs-make-candidates))
 710   (let (anything-samewindow
 711         (anything-input-idle-delay
 712          (or anything-lisp-complete-symbol-input-idle-delay
 713              anything-input-idle-delay)))
 714     (funcall
 715      (if (equal buffer "*anything complete*") 'anything-noresume 'anything)
 716      sources input nil nil nil buffer)))
 717
 718 ;; Test alcs-update-restart (with-current-buffer alcs-commands-buffer (erase-buffer))
 719 ;; Test alcs-update-restart (kill-buffer alcs-commands-buffer)
 720 (defun alcs-update-restart ()
 721   "Update lisp symbols and restart current `anything' session."
 722   (interactive)
 723   (alcs-make-candidates)
 724   (anything-update))
 725
 726 (defun alcs-initial-input (partial-match)
 727   (anything-aif (symbol-at-point)
 728       (format "%s%s%s"
 729               (if partial-match "" "^")
 730               it
 731               (if anything-lisp-complete-symbol-add-space-on-startup " " ""))
 732     ""))
 733
 734 (defun anything-lisp-complete-symbol (update)
 735   "`lisp-complete-symbol' replacement using `anything'."
 736   (interactive "P")
 737   (anything-lisp-complete-symbol-1 update anything-lisp-complete-symbol-sources
 738                                    (alcs-initial-input nil)))
 739 (defun anything-lisp-complete-symbol-partial-match (update)
 740   "`lisp-complete-symbol' replacement using `anything' (partial match)."
 741   (interactive "P")
 742   (anything-lisp-complete-symbol-1 update anything-lisp-complete-symbol-sources
 743                                    (alcs-initial-input t)))
 744 (defun anything-apropos (update)
 745   "`apropos' replacement using `anything'."
 746   (interactive "P")
 747   (anything-lisp-complete-symbol-1 update anything-apropos-sources nil "*anything apropos*"))
 748
 749 ;; (@* "anything attribute completion")
 750 (defvar anything-c-source-complete-anything-attributes
 751   '((name . "Anything Attributes")
 752     (candidates . acaa-candidates)
 753     (action . ac-insert)
 754     (persistent-action . acaa-describe-anything-attribute)
 755     (filtered-candidate-transformer alcs-sort-maybe alcs-transformer-prepend-spacer-maybe)
 756     (header-name . alcs-header-name)
 757     (action . ac-insert)))
 758 ;; (anything 'anything-c-source-complete-anything-attributes)
 759
 760 (defun acaa-describe-anything-attribute (str)
 761   (anything-describe-anything-attribute (anything-c-symbolify str)))
 762
 763 (defun acaa-candidates ()
 764   (with-current-buffer anything-current-buffer
 765     (when (and (require 'yasnippet nil t)
 766                (acaa-completing-attribute-p (point)))
 767       (mapcar 'symbol-name anything-additional-attributes))))
 768
 769 (defvar acaa-anything-commands-regexp
 770   (concat "(" (regexp-opt '("anything" "anything-other-buffer")) " "))
 771
 772 (defun acaa-completing-attribute-p (point)
 773   (save-excursion
 774     (goto-char point)
 775     (ignore-errors
 776       (or (save-excursion
 777             (backward-up-list 3)
 778             (looking-at (concat "(defvar anything-c-source-"
 779                                 "\\|"
 780                                 acaa-anything-commands-regexp)))
 781           (save-excursion
 782             (backward-up-list 4)
 783             (looking-at acaa-anything-commands-regexp))))))
 784
 785 ;; (anything '(ini
 786 ;;;; unit test
 787 ;; (install-elisp "http://www.emacswiki.org/cgi-bin/wiki/download/el-expectations.el")
 788 ;; (install-elisp "http://www.emacswiki.org/cgi-bin/wiki/download/el-mock.el")
 789 (dont-compile
 790   (when (fboundp 'expectations)
 791     (expectations
 792       (desc "acaa-completing-attribute-p")
 793       (expect t
 794         (with-temp-buffer
 795           (insert "(anything '(((na")
 796           (acaa-completing-attribute-p (point))))
 797       (expect t
 798         (with-temp-buffer
 799           (insert "(anything '((na")
 800           (acaa-completing-attribute-p (point))))
 801       (expect nil
 802         (with-temp-buffer
 803           (insert "(anything-hoge '((na")
 804           (acaa-completing-attribute-p (point))))
 805       (expect nil
 806         (with-temp-buffer
 807           (insert "(anything-hoge '(((na")
 808           (acaa-completing-attribute-p (point))))
 809       (expect t
 810         (with-temp-buffer
 811           (insert "(defvar anything-c-source-hoge '((na")
 812           (acaa-completing-attribute-p (point))))
 813
 814       )))
 815
 816 ;; (@* "anything-read-string-mode / read-* compatibility functions")
 817 ;; moved from anything.el
 818 (defun anything-compile-source--default-value (source)
 819   (anything-aif (assoc-default 'default-value source)
 820       (append source
 821               `((candidates ,it)
 822                 (filtered-candidate-transformer
 823                  . (lambda (cands source)
 824                      (if (string= anything-pattern "") cands nil)))))
 825     source))
 826 (add-to-list 'anything-compile-source-functions 'anything-compile-source--default-value)
 827
 828 (defun ac-new-input-source (prompt require-match &optional additional-attrs)
 829   (unless require-match
 830     `((name . ,prompt)
 831       (dummy)
 832       ,@additional-attrs)))
 833 (defun* ac-default-source (default &optional accept-empty (additional-attrs '((action . identity))))
 834   `((name . "Default")
 835     (default-value . ,(or default (and accept-empty "")))
 836     ,@additional-attrs
 837     ,(if accept-empty '(accept-empty))))
 838 ;; (ac-default-source "a")
 839 ;; (ac-default-source "a" t)
 840 ;; (ac-default-source nil t)
 841 ;; (ac-default-source nil)
 842
 843 ;; (@* "`completing-read' compatible read function ")
 844 (defvar anything-use-original-function nil
 845   "If non-nil, use original implementation not anything version.")
 846 (defun anything-completing-read (prompt collection &optional predicate require-match initial hist default inherit-input-method)
 847   (if (or anything-use-original-function
 848           (arrayp collection) (functionp collection))
 849       (anything-old-completing-read prompt collection predicate require-match initial hist default inherit-input-method)
 850     ;; support only collection list.
 851     (setq hist (or (car-safe hist) hist))
 852     (let* (anything-input-idle-delay
 853            (result (or (anything-noresume (acr-sources
 854                                            prompt
 855                                            collection
 856                                            predicate require-match initial
 857                                            hist default inherit-input-method)
 858                                           initial prompt nil nil "*anything complete*")
 859                        (keyboard-quit))))
 860       (when (stringp result)
 861         (prog1 result
 862           (setq hist (or hist 'minibuffer-history))
 863           (set hist (cons result (ignore-errors (delete result (symbol-value hist))))))))))
 864
 865 ;; TODO obarray/predicate hacks: command/variable/symbol
 866 (defvar anything-completing-read-use-default t
 867   "Whether to use default value source.")
 868 (defvar anything-completing-read-history-first nil
 869   "Whether to display history source first.")
 870 (defvar anything-complete-persistent-action nil
 871   "Persistent action function used by `anything-completing-read'.
 872 It accepts one argument, selected candidate.")
 873
 874 (defun* acr-sources (prompt collection predicate require-match initial hist default inherit-input-method &optional (additional-attrs '((action . identity))))
 875   "`anything' replacement for `completing-read'."
 876   (let* ((transformer-func
 877           (if predicate
 878               `(candidate-transformer
 879                 . (lambda (cands)
 880                     (remove-if-not (lambda (c) (,predicate
 881                                                 (if (listp c) (car c) c))) cands)))))
 882          (persistent-action
 883           (if anything-complete-persistent-action
 884               '(persistent-action
 885                 . (lambda (cand) (funcall anything-complete-persistent-action cand)))))
 886          (new-input-source (ac-new-input-source prompt require-match additional-attrs))
 887          (histvar (or hist 'minibuffer-history))
 888          (history-source (when (and (boundp histvar) (not require-match))
 889                            `((name . "History")
 890                              (candidates . ,histvar)
 891                              ,persistent-action
 892                              ,@additional-attrs)))
 893          (default-source (and anything-completing-read-use-default (ac-default-source default t)))
 894          (main-source `((name . "Completions")
 895                         (candidates . ,(mapcar (lambda (x) (or (car-safe x) x)) collection))
 896                         ,@additional-attrs
 897                         ,persistent-action
 898                         ,transformer-func)))
 899     (cond ((and require-match default)
 900            (list default-source main-source))
 901           (require-match
 902            (list main-source default-source))
 903           (anything-completing-read-history-first
 904            (list default-source history-source main-source new-input-source))
 905           (t
 906            (list default-source main-source history-source new-input-source)))))
 907 ;; (anything-completing-read "Command: " obarray 'commandp t)
 908 ;; (anything-completing-read "Test: " '(("hoge")("foo")("bar")) nil nil nil 'hoge-history)
 909 ;; hoge-history
 910 ;; (anything-completing-read "Test: " '(("hoge")("foo")("bar")) nil nil nil)
 911 ;; (anything-completing-read "Test: " '(("hoge")("foo")("bar")) nil t)
 912 ;; (anything-completing-read "Test: " '(("hoge")("foo")("bar")) nil t nil nil "foo")
 913 ;; (let ((anything-complete-persistent-action 'message)) (anything-completing-read "Test: " '(("hoge")("foo")("bar")) nil t))
 914 ;; (anything-old-completing-read "Test: " '(("hoge")("foo")("bar")) nil t)
 915 ;; (anything-completing-read "Test: " '(("hoge")("foo")("bar")) nil nil "f" nil)
 916 ;; (completing-read "Test: " '(("hoge")("foo")("bar")) nil nil "f" nil nil t)
 917 ;; (anything-completing-read "Test: " '(("hoge")("foo")("bar")) nil nil nil nil "nana")
 918 ;; (anything-completing-read "Test: " '("hoge" "foo" "bar"))
 919
 920 ;; (@* "`read-file-name' compatible read function ")
 921 (defvar anything-read-file-name-map nil)
 922 (defvar arfn-followed nil)
 923 (defvar arfn-dir nil)
 924 (defun anything-read-file-name-map ()
 925   "Lazy initialization of `anything-read-file-name-map'."
 926   (unless anything-read-file-name-map
 927     (setq anything-read-file-name-map (copy-keymap anything-map))
 928     (define-key anything-read-file-name-map "\C-i" 'anything-read-file-name-follow-directory)
 929     (define-key anything-read-file-name-map [tab] 'anything-read-file-name-follow-directory))
 930   anything-read-file-name-map)
 931
 932 (defun anything-read-file-name-follow-directory ()
 933   "Follow directory in `anything-read-file-name'."
 934   (interactive)
 935   ;; These variables are bound by `arfn-sources' or `anything-find-file'.
 936   (declare (special prompt default-filename require-match predicate additional-attrs))
 937   (setq arfn-followed t)
 938   (let* ((sel (anything-get-selection))
 939          (f (expand-file-name sel arfn-dir)))
 940     (cond ((and (file-directory-p f) (not (string-match "/\\.$" sel)))
 941            (with-selected-window (minibuffer-window) (delete-minibuffer-contents))
 942            (setq anything-pattern "")
 943            ;;(setq arfn-dir f)
 944            (anything-set-sources
 945             (arfn-sources
 946              prompt f default-filename require-match nil predicate additional-attrs))
 947            (anything-update))
 948           ((string-match "^\\(.+\\)/\\([^/]+\\)$" sel)
 949            (with-selected-window (minibuffer-window)
 950              (delete-minibuffer-contents)
 951              (insert (match-string 2 sel)))
 952            (anything-set-sources
 953             (arfn-sources
 954              prompt (expand-file-name (match-string 1 sel) arfn-dir) nil require-match (match-string 2 sel) predicate additional-attrs))
 955            (anything-update)))))
 956
 957 (defun* anything-read-file-name (prompt &optional dir default-filename require-match initial-input predicate (additional-attrs '((action . identity))))
 958   "`anything' replacement for `read-file-name'."
 959   (setq arfn-followed nil)
 960   (let* ((anything-map (anything-read-file-name-map))
 961          anything-input-idle-delay
 962          (result (or (anything-noresume (arfn-sources
 963                                          prompt dir default-filename require-match
 964                                          initial-input predicate additional-attrs)
 965                                         initial-input prompt nil nil "*anything complete*")
 966                      (keyboard-quit))))
 967     (when (and require-match
 968                (not (and (file-exists-p result)
 969                          (funcall (or predicate 'identity) result))))
 970       (error "anything-read-file-name: file `%s' is not matched" result))
 971     (when (stringp result)
 972       (prog1 result
 973         (add-to-list 'file-name-history result)
 974         (setq file-name-history (cons result (delete result file-name-history)))))))
 975
 976 (defun arfn-candidates (dir)
 977   (if (file-directory-p dir)
 978       (loop for (f _ _ _ _ _ _ _ _ perm _ _ _) in (directory-files-and-attributes dir t)
 979             for basename = (file-name-nondirectory f)
 980             when (string= "d" (substring perm 0 1))
 981             collect (cons (concat basename "/") f)
 982             else collect (cons basename f))))
 983
 984 (defun* arfn-sources (prompt dir default-filename require-match initial-input predicate &optional (additional-attrs '((action . identity))))
 985   (setq arfn-dir dir)
 986   (let* ((dir (or dir default-directory))
 987          (transformer-func
 988           (if predicate
 989               `(candidate-transformer
 990                 . (lambda (cands)
 991                     (remove-if-not
 992                      (lambda (c) (,predicate (if (consp c) (cdr c) c))) cands)))))
 993          (new-input-source (ac-new-input-source
 994                             prompt nil
 995                             (append '((display-to-real . (lambda (f) (expand-file-name f arfn-dir))))
 996                                     additional-attrs)))
 997          (history-source (unless require-match
 998                            `((name . "History")
 999                              (candidates . file-name-history)
1000                              (persistent-action . find-file)
1001                              ,@additional-attrs))))
1002     `(((name . "Default")
1003        (candidates . ,(if default-filename (list default-filename)))
1004        (persistent-action . find-file)
1005        (filtered-candidate-transformer
1006         . (lambda (cands source)
1007             (if (and (not arfn-followed) (string= anything-pattern "")) cands nil)))
1008        (display-to-real . (lambda (f) (expand-file-name f ,dir)))
1009        ,@additional-attrs)
1010       ((name . ,dir)
1011        (candidates . (lambda () (arfn-candidates ,dir)))
1012        (persistent-action . find-file)
1013        ,@additional-attrs
1014        ,transformer-func)
1015       ,new-input-source
1016       ,history-source)))
1017 ;; (anything-read-file-name "file: " "~" ".emacs")
1018 ;; (anything-read-file-name "file: " "~" ".emacs" t)
1019 ;; (anything-read-file-name "file: " "~" )
1020 ;; (anything-read-file-name "file: ")
1021 ;; (read-file-name "file: " "/tmp")
1022
1023 ;; (@* "`read-buffer' compatible read function ")
1024 (defun anything-read-buffer (prompt &optional default require-match start matches-set)
1025   "`anything' replacement for `read-buffer'."
1026   (let (anything-input-idle-delay)
1027     (or (anything-noresume (arb-sources prompt
1028                                         (if (bufferp default) (buffer-name default) default)
1029                                         require-match start matches-set)
1030                            start prompt nil nil "*anything complete*")
1031         (keyboard-quit))))
1032
1033 (defun* arb-sources (prompt default require-match start matches-set &optional (additional-attrs '((action . identity))))
1034   `(,(ac-default-source default t)
1035     ((name . ,prompt)
1036      (persistent-action . switch-to-buffer)
1037      (candidates . (lambda () (mapcar 'buffer-name (buffer-list))))
1038      ,@additional-attrs)
1039     ,(ac-new-input-source prompt require-match additional-attrs)))
1040
1041 ;; (anything-read-buffer "test: "  nil)
1042 ;; (anything-read-buffer "test: " "*scratch*" t)
1043 ;; (anything-read-buffer "test: " "*scratch*" t "*")
1044
1045 ;; (read-variable "variable: " "find-file-hooks")
1046 ;; (read-variable "variable: " 'find-file-hooks)
1047 ;; (read-variable "variable: " )
1048 (defun anything-read-symbol-1 (prompt buffer default-value)
1049   (let (anything-input-idle-delay anything-samewindow)
1050     (intern (or (anything-noresume `(,(ac-default-source
1051                                        (if default-value (format "%s" default-value)))
1052                                      ((name . ,prompt)
1053                                       (init . (lambda () (alcs-init ,buffer)))
1054                                       (candidates-in-buffer)
1055                                       (action . identity)))
1056                                    nil prompt nil nil "*anything complete*")
1057                 (keyboard-quit)))))
1058
1059 ;; (@* "`read-variable' compatible read function ")
1060 (defun anything-read-variable (prompt &optional default-value)
1061   (anything-read-symbol-1 prompt alcs-variables-buffer default-value))
1062 ;; (anything-read-variable "variable: " 'find-file-hooks)
1063
1064 ;; (@* "`read-command' compatible read function ")
1065 (defun anything-read-command (prompt &optional default-value)
1066   (anything-read-symbol-1 prompt alcs-commands-buffer default-value))
1067 ;; (anything-read-variable "command: ")
1068
1069
1070 ;; (@* "`anything-read-string-mode' initialization")
1071 (defvar anything-read-string-mode nil)
1072 (unless anything-read-string-mode
1073   (defalias 'anything-old-completing-read (symbol-function 'completing-read))
1074   (defalias 'anything-old-read-file-name (symbol-function 'read-file-name))
1075   (defalias 'anything-old-read-buffer (symbol-function 'read-buffer))
1076   (defalias 'anything-old-read-variable (symbol-function 'read-variable))
1077   (defalias 'anything-old-read-command (symbol-function 'read-command))
1078   (put 'anything-read-string-mode 'orig-read-buffer-function read-buffer-function))
1079
1080 ;; (progn (anything-read-string-mode -1) anything-read-string-mode)
1081 ;; (progn (anything-read-string-mode 1) anything-read-string-mode)
1082 ;; (progn (anything-read-string-mode 0) anything-read-string-mode)
1083 ;; (progn (anything-read-string-mode '(string buffer variable command)) anything-read-string-mode)
1084 (defvar anything-read-string-mode-flags '(string file buffer variable command)
1085   "Saved ARG of `anything-read-string-mode'.")
1086 (defun anything-read-string-mode (arg)
1087   "If this minor mode is on, use `anything' version of `completing-read' and `read-file-name'.
1088
1089 ARG also accepts a symbol list. The elements are:
1090 string:   replace `completing-read'
1091 file:     replace `read-file-name' and `find-file'
1092 buffer:   replace `read-buffer'
1093 variable: replace `read-variable'
1094 command:  replace `read-command' and M-x
1095
1096 So, (anything-read-string-mode 1) and
1097  (anything-read-string-mode '(string file buffer variable command) are identical."
1098   (interactive "P")
1099   (when (consp anything-read-string-mode)
1100     (anything-read-string-mode-uninstall))
1101   (setq anything-read-string-mode
1102         (cond ((consp arg) (setq anything-read-string-mode-flags arg)) ; not interactive
1103               (arg (> (prefix-numeric-value arg) 0))  ; C-u M-x
1104               (t   (not anything-read-string-mode)))) ; M-x
1105   (when (eq anything-read-string-mode t)
1106     (setq anything-read-string-mode anything-read-string-mode-flags))
1107   (if anything-read-string-mode
1108       (anything-read-string-mode-install)
1109     (anything-read-string-mode-uninstall)))
1110
1111 (defun anything-read-string-mode-install ()
1112   ;; redefine to anything version
1113   (when (memq 'string anything-read-string-mode)
1114     (defalias 'completing-read (symbol-function 'anything-completing-read)))
1115   (when (memq 'file anything-read-string-mode)
1116     (defalias 'read-file-name (symbol-function 'anything-read-file-name))
1117     (substitute-key-definition 'find-file 'anything-find-file global-map))
1118   (when (memq 'buffer anything-read-string-mode)
1119     (setq read-buffer-function 'anything-read-buffer)
1120     (defalias 'read-buffer (symbol-function 'anything-read-buffer)))
1121   (when (memq 'variable anything-read-string-mode)
1122     (defalias 'read-variable (symbol-function 'anything-read-variable)))
1123   (when (memq 'command anything-read-string-mode)
1124     (defalias 'read-command (symbol-function 'anything-read-command))
1125     (substitute-key-definition 'execute-extended-command 'anything-execute-extended-command global-map))
1126   (message "Installed anything version of read functions."))
1127 (defun anything-read-string-mode-uninstall ()
1128   ;; restore to original version
1129   (defalias 'completing-read (symbol-function 'anything-old-completing-read))
1130   (defalias 'read-file-name (symbol-function 'anything-old-read-file-name))
1131   (setq read-buffer-function (get 'anything-read-string-mode 'orig-read-buffer-function))
1132   (defalias 'read-buffer (symbol-function 'anything-old-read-buffer))
1133   (defalias 'read-variable (symbol-function 'anything-old-read-variable))
1134   (defalias 'read-command (symbol-function 'anything-old-read-command))
1135   (substitute-key-definition 'anything-execute-extended-command 'execute-extended-command global-map)
1136   (substitute-key-definition 'anything-find-file 'find-file global-map)
1137   (message "Uninstalled anything version of read functions."))
1138
1139
1140 ;; (@* " shell history")
1141 (defun anything-complete-shell-history ()
1142   "Select a command from shell history and insert it."
1143   (interactive)
1144   (let ((anything-show-completion-minimum-window-height (/ (frame-height) 2)))
1145     (anything-complete 'anything-c-source-complete-shell-history
1146                       (or (word-at-point) "")
1147                       20)))
1148 (defun anything-complete-shell-history-setup-key (key)
1149   ;; for Emacs22
1150   (when (and (not (boundp 'minibuffer-local-shell-command-map))
1151              (require 'shell-command nil t)
1152              (boundp 'shell-command-minibuffer-map))
1153     (shell-command-completion-mode)
1154     (define-key shell-command-minibuffer-map key 'anything-complete-shell-history))
1155   ;; for Emacs23
1156   (when (boundp 'minibuffer-local-shell-command-map)
1157     (define-key minibuffer-local-shell-command-map key 'anything-complete-shell-history))
1158
1159   (when (require 'background nil t)
1160     (define-key background-minibuffer-map key 'anything-complete-shell-history))
1161   (require 'shell)
1162   (define-key shell-mode-map key 'anything-complete-shell-history))
1163
1164 (defvar zsh-p nil)
1165 (defvar anything-c-source-complete-shell-history
1166   '((name . "Shell History")
1167     (init . (lambda ()
1168               (require 'shell-history)
1169               (with-current-buffer (anything-candidate-buffer (shell-history-buffer))
1170                 (revert-buffer t t)
1171                 (set (make-local-variable 'zsh-p)
1172                      (shell-history-zsh-extended-history-p)))))
1173     (get-line . acsh-get-line)
1174     (search-from-end)
1175     (type . complete)))
1176
1177 (defun acsh-get-line (s e)
1178   (let ((extended-history (string= (buffer-substring s (+ s 2)) ": "))
1179         (single-line (not (string= (buffer-substring (1- e) e) "\\"))))
1180     (cond ((not zsh-p)
1181            (buffer-substring s e))
1182           ((and extended-history single-line)
1183            (buffer-substring (+ s 15) e))
1184           (extended-history             ;zsh multi-line / 1st line
1185            (goto-char e)
1186            (let ((e2 (1- (if (re-search-forward "^: [0-9]+:[0-9];" nil t)
1187                              (match-beginning 0)
1188                            (point-max)))))
1189              (prog1 (replace-regexp-in-string
1190                      "\\\\\n" ";" (buffer-substring (+ s 15) e2))
1191                (goto-char s))))
1192           (t                   ; zsh multi-line history / not 1st line
1193            (goto-char s)
1194            (re-search-backward "^: [0-9]+:[0-9];" nil t)
1195            (let ((s2 (match-end 0)) e2)
1196              (goto-char s2)
1197              (setq e2 (1- (if (re-search-forward "^: [0-9]+:[0-9];" nil t)
1198                               (match-beginning 0)
1199                             (point-max))))
1200              (prog1 (replace-regexp-in-string
1201                      "\\\\\n" ";" (buffer-substring s2 e2))
1202                (goto-char s2)))))))
1203
1204 ;; I do not want to make anything-c-source-* symbols because they are
1205 ;; private in `anything-execute-extended-command'.
1206 (defvar anything-execute-extended-command-sources
1207   '(((name . "Emacs Commands History")
1208      (candidates . extended-command-history)
1209      (action . identity)
1210      (update . alcs-make-candidates)
1211      (persistent-action . alcs-describe-function))
1212     ((name . "Commands")
1213      (header-name . alcs-header-name)
1214      (init . (lambda () (anything-candidate-buffer
1215                          (get-buffer-create alcs-commands-buffer))))
1216      (candidates-in-buffer)
1217      (action . identity)
1218      (update . alcs-make-candidates)
1219      (persistent-action . alcs-describe-function))))
1220
1221 ;; (with-current-buffer " *command symbols*" (erase-buffer))
1222 (defun anything-execute-extended-command ()
1223   "Replacement of `execute-extended-command'."
1224   (interactive)
1225   (setq alcs-this-command this-command)
1226   (let* ((cmd (anything
1227               (if (and anything-execute-extended-command-use-kyr
1228                        (require 'anything-kyr-config nil t))
1229                   (cons anything-c-source-kyr
1230                         anything-execute-extended-command-sources)
1231                 anything-execute-extended-command-sources))))
1232     (when cmd
1233       (setq extended-command-history (cons cmd (delete cmd extended-command-history)))
1234       (setq cmd (intern cmd))
1235       (if (or (stringp (symbol-function cmd))
1236               (vectorp (symbol-function cmd)))
1237           (execute-kbd-macro (symbol-function cmd))
1238         (setq this-command cmd)
1239         (call-interactively cmd)))))
1240
1241 (defvar anything-find-file-additional-sources nil)
1242 (defun anything-find-file ()
1243   "Replacement of `find-file'."
1244   (interactive)
1245   (let ((anything-map (anything-read-file-name-map))
1246         ;; anything-read-file-name-follow-directory uses these variables
1247         (prompt "Find File: ")
1248         default-filename require-match predicate
1249         (additional-attrs '(;; because anything-c-skip-boring-files cannot
1250                             ;; handle (display . real) candidates
1251                             (candidate-transformer)
1252                             (type . file))))
1253     (anything-other-buffer (append (arfn-sources prompt default-directory
1254                                                  nil nil nil nil additional-attrs)
1255                                    anything-find-file-additional-sources)
1256                            "*anything find-file*")))
1257 ;;(anything-find-file)
1258
1259 (add-hook 'after-init-hook 'alcs-make-candidates)
1260
1261
1262 ;;;; unit test
1263 ;; (install-elisp "http://www.emacswiki.org/cgi-bin/wiki/download/el-expectations.el")
1264 ;; (install-elisp "http://www.emacswiki.org/cgi-bin/wiki/download/el-mock.el")
1265 (dont-compile
1266   (when (fboundp 'expectations)
1267     (expectations
1268       (desc "acsh-get-line command")
1269       (expect "ls"
1270         (let ((zsh-p t))
1271           (with-temp-buffer
1272             (insert ": 1118554690:0;cat ~/.zsh_history\n"
1273                     ": 1118554690:0;ls\n")
1274             (forward-line -1)
1275             (acsh-get-line (point-at-bol) (point-at-eol)))))
1276       (expect "cd;ls -l"
1277         (let ((zsh-p t))
1278           (with-temp-buffer
1279             (insert ": 1118554690:0;cat ~/.zsh_history\n"
1280                     ": 1118554690:0;cd\\\n"
1281                     "ls -l\n"
1282                     ": 1118554690:0;hoge\n")
1283             (forward-line -2)
1284             (acsh-get-line (point-at-bol) (point-at-eol)))))
1285       (expect "cd;ls -l"
1286         (let ((zsh-p t))
1287           (with-temp-buffer
1288             (insert ": 1118554690:0;cat ~/.zsh_history\n"
1289                     ": 1118554690:0;cd\\\n"
1290                     "ls -l\n"
1291                     ": 1118554690:0;hoge\n")
1292             (forward-line -3)
1293             (acsh-get-line (point-at-bol) (point-at-eol)))))
1294       (expect "cd;ls -l"
1295         (let ((zsh-p t))
1296           (with-temp-buffer
1297             (insert ": 1118554690:0;cat ~/.zsh_history\n"
1298                     ": 1118554690:0;cd\\\n"
1299                     "ls -l\n")
1300             (forward-line -1)
1301             (acsh-get-line (point-at-bol) (point-at-eol)))))
1302       (expect "cd;ls -l"
1303         (let ((zsh-p t))
1304           (with-temp-buffer
1305             (insert ": 1118554690:0;cat ~/.zsh_history\n"
1306                     ": 1118554690:0;cd\\\n"
1307                     "ls -l\n")
1308             (forward-line -2)
1309             (acsh-get-line (point-at-bol) (point-at-eol)))))
1310       (expect "pwd"
1311         (let ((zsh-p nil))
1312           (with-temp-buffer
1313             (insert "foo\n"
1314                     "pwd\n")
1315             (forward-line -1)
1316             (acsh-get-line (point-at-bol) (point-at-eol)))))
1317       (desc "acsh-get-line lineno")
1318       (expect 2
1319         (let ((zsh-p t))
1320           (with-temp-buffer
1321             (insert ": 1118554690:0;cat ~/.zsh_history\n"
1322                     ": 1118554690:0;cd\\\n"
1323                     "ls -l\n"
1324                     ": 1118554690:0;hoge\n")
1325             (forward-line -2)
1326             (acsh-get-line (point-at-bol) (point-at-eol))
1327             (line-number-at-pos))))
1328       (expect 2
1329         (let ((zsh-p t))
1330           (with-temp-buffer
1331             (insert ": 1118554690:0;cat ~/.zsh_history\n"
1332                     ": 1118554690:0;cd\\\n"
1333                     "ls -l\n"
1334                     ": 1118554690:0;hoge\n")
1335             (forward-line -3)
1336             (acsh-get-line (point-at-bol) (point-at-eol))
1337             (line-number-at-pos))))
1338
1339       )))
1340
1341 ;;; for compatibility
1342 (defvaralias 'anything-c-source-complete-emacs-variables-partial-match
1343   'anything-c-source-complete-emacs-variables)
1344 (defvaralias 'anything-c-source-complete-emacs-commands-partial-match
1345   'anything-c-source-complete-emacs-commands)
1346 (defvaralias 'anything-c-source-complete-emacs-functions-partial-match
1347   'anything-c-source-complete-emacs-functions)
1348
1349
1350
1351 (provide 'anything-complete)
1352
1353 ;; How to save (DO NOT REMOVE!!)
1354 ;; (progn (magit-push) (emacswiki-post "anything-complete.el"))
1355 ;;; anything-complete.el ends here