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, 2011 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-string-mode'
  42 ;;    If this minor mode is on, use `anything' version of `completing-read' and `read-file-name'.
  43 ;;  `anything-complete-shell-history'
  44 ;;    Select a command from shell history and insert it.
  45 ;;  `anything-execute-extended-command'
  46 ;;    Replacement of `execute-extended-command'.
  47 ;;
  48 ;;; Customizable Options:
  49 ;;
  50 ;; Below are customizable option list:
  51 ;;
  52 ;;  `anything-complete-sort-candidates'
  53 ;;    *Whether to sort completion candidates.
  54 ;;    default = nil
  55 ;;  `anything-execute-extended-command-use-kyr'
  56 ;;    *Use `anything-kyr' (context-aware commands) in `anything-execute-extended-command'.
  57 ;;    default = t
  58
  59 ;; * `anything-lisp-complete-symbol', `anything-lisp-complete-symbol-partial-match':
  60 ;;     `lisp-complete-symbol' with `anything'
  61 ;; * `anything-apropos': `apropos' with `anything'
  62 ;; * `anything-complete-shell-history': complete from .*sh_history
  63 ;; * Many read functions:
  64 ;;     `anything-read-file-name', `anything-read-buffer', `anything-read-variable',
  65 ;;     `anything-read-command', `anything-completing-read'
  66 ;; * `anything-read-string-mode' replaces default read functions with anything ones.
  67 ;; * Many anything sources:
  68 ;;     [EVAL IT] (occur "defvar anything-c-source")
  69
  70 ;;; Installation:
  71
  72 ;; Put anything-complete.el to your load-path.
  73 ;; The load-path is usually ~/elisp/.
  74 ;; It's set in your ~/.emacs like this:
  75 ;; (add-to-list 'load-path (expand-file-name "~/elisp"))
  76 ;;
  77 ;; Then install dependencies.
  78 ;;
  79 ;; Install anything-match-plugin.el (must).
  80 ;; M-x install-elisp http://www.emacswiki.org/cgi-bin/wiki/download/anything-match-plugin.el
  81 ;;
  82 ;; shell-history.el / shell-command.el would help you (optional).
  83 ;; M-x install-elisp http://www.emacswiki.org/cgi-bin/wiki/download/shell-history.el
  84 ;; M-x install-elisp http://www.emacswiki.org/cgi-bin/wiki/download/shell-command.el
  85 ;;
  86 ;; If you want `anything-execute-extended-command' to show
  87 ;; context-aware commands, use anything-kyr.el and
  88 ;; anything-kyr-config.el (optional).
  89 ;;
  90 ;; M-x install-elisp http://www.emacswiki.org/cgi-bin/wiki/download/anything-kyr.el
  91 ;; M-x install-elisp http://www.emacswiki.org/cgi-bin/wiki/download/anything-kyr-config.el
  92
  93 ;; And the following to your ~/.emacs startup file.
  94 ;;
  95 ;; (require 'anything-complete)
  96 ;; ;; Automatically collect symbols by 150 secs
  97 ;; (anything-lisp-complete-symbol-set-timer 150)
  98 ;; (define-key emacs-lisp-mode-map "\C-\M-i" 'anything-lisp-complete-symbol-partial-match)
  99 ;; (define-key lisp-interaction-mode-map "\C-\M-i" 'anything-lisp-complete-symbol-partial-match)
 100 ;; ;; replace completion commands with `anything'
 101 ;; (anything-read-string-mode 1)
 102 ;; ;; Bind C-o to complete shell history
 103 ;; (anything-complete-shell-history-setup-key "\C-o")
 104
 105 ;;; Change log:
 106 ;;
 107 ;;  Change log of this file is found at
 108 ;;  http://repo.or.cz/w/anything-config.git/history/master:/anything-complete.el
 109 ;;
 110 ;;  Change log of this project is found at
 111 ;;  http://repo.or.cz/w/anything-config.git?a=shortlog
 112
 113
 114 ;;; Code:
 115
 116 (defvar anything-complete-version "$Id: anything-complete.el,v 1.86 2010-03-31 23:14:13 rubikitch Exp $")
 117 (require 'anything-match-plugin)
 118 (require 'thingatpt)
 119 (require 'anything-obsolete)
 120
 121
 122 ;; (@* "overlay")
 123 (when (require 'anything-show-completion nil t)
 124   (dolist (f '(anything-complete
 125                anything-lisp-complete-symbol
 126                anything-lisp-complete-symbol-partial-match))
 127     (use-anything-show-completion f '(length anything-complete-target))))
 128
 129 ;; (@* "core")
 130 (defvar anything-complete-target "")
 131
 132 (defun ac-insert (candidate)
 133   (let ((pt (point)))
 134     (when (and (search-backward anything-complete-target nil t)
 135                (string= (buffer-substring (point) pt) anything-complete-target))
 136       (delete-region (point) pt)))
 137   (insert candidate))
 138
 139 (define-anything-type-attribute 'complete
 140   '((candidates-in-buffer)
 141     (action . ac-insert)))
 142
 143 ;; Warning: I'll change this function's interface. DON'T USE IN YOUR PROGRAM!
 144 (defun anything-noresume (&optional any-sources any-input any-prompt any-resume any-preselect any-buffer)
 145   (let (anything-last-sources anything-compiled-sources anything-last-buffer)
 146     (anything any-sources any-input any-prompt 'noresume any-preselect any-buffer)))
 147
 148 (defun anything-complete (sources target &optional limit idle-delay input-idle-delay)
 149   "Basic completion interface using `anything'."
 150   (let ((anything-candidate-number-limit (or limit anything-candidate-number-limit))
 151         (anything-idle-delay (or idle-delay anything-idle-delay))
 152         (anything-input-idle-delay (or input-idle-delay anything-input-idle-delay))
 153         (anything-complete-target target)
 154         (anything-execute-action-at-once-if-one t)
 155         (enable-recursive-minibuffers t)
 156         anything-samewindow)
 157     (anything-noresume sources target nil nil nil "*anything complete*")))
 158
 159 ;; (@* "`lisp-complete-symbol' and `apropos' replacement")
 160 (defvar anything-lisp-complete-symbol-input-idle-delay 0.1
 161   "`anything-input-idle-delay' for `anything-lisp-complete-symbol',
 162 `anything-lisp-complete-symbol-partial-match' and `anything-apropos'.")
 163 (defvar anything-lisp-complete-symbol-add-space-on-startup t
 164   "If non-nil, `anything-lisp-complete-symbol' and `anything-lisp-complete-symbol-partial-match' adds space on startup.
 165 It utilizes anything-match-plugin's feature.")
 166
 167 (defun alcs-create-buffer (name)
 168   (let ((b (get-buffer-create name)))
 169     (with-current-buffer b
 170       (buffer-disable-undo)
 171       (erase-buffer)
 172       b)))
 173
 174 (defvar alcs-variables-buffer " *variable symbols*")
 175 (defvar alcs-functions-buffer " *function symbols*")
 176 (defvar alcs-commands-buffer " *command symbols*")
 177 (defvar alcs-faces-buffer " *face symbols*")
 178 (defvar alcs-symbol-buffer " *other symbols*")
 179
 180 (defvar alcs-symbols-time nil
 181   "Timestamp of collected symbols")
 182
 183 (defun alcs-make-candidates ()
 184   (message "Collecting symbols...")
 185   ;; To ignore read-only property.
 186   (let ((inhibit-read-only t))
 187     (setq alcs-symbols-time (current-time))
 188     (alcs-create-buffer alcs-variables-buffer)
 189     (alcs-create-buffer alcs-functions-buffer)
 190     (alcs-create-buffer alcs-commands-buffer)
 191     (alcs-create-buffer alcs-faces-buffer)
 192     (alcs-create-buffer alcs-symbol-buffer)
 193     (mapatoms
 194      (lambda (sym)
 195        (let ((name (symbol-name sym))
 196              (bp (boundp sym))
 197              (fbp (fboundp sym)))
 198          (cond ((commandp sym)    (set-buffer alcs-commands-buffer) (insert name "\n"))
 199                (fbp               (set-buffer alcs-functions-buffer) (insert name "\n")))
 200          (cond (bp                (set-buffer alcs-variables-buffer) (insert name "\n")))
 201          (cond ((facep sym)       (set-buffer alcs-faces-buffer) (insert name "\n"))
 202                ((not (or bp fbp)) (set-buffer alcs-symbol-buffer) (insert name "\n")))))))
 203   (message "Collecting symbols...done"))
 204
 205 (defun alcs-header-name (name)
 206   (format "%s at %s (Press `C-c C-u' to update)"
 207           name (format-time-string "%H:%M:%S" alcs-symbols-time)))
 208
 209 (defvar alcs-make-candidates-timer nil)
 210 (defun anything-lisp-complete-symbol-set-timer (update-period)
 211   "Update Emacs symbols list when Emacs is idle,
 212 used by `anything-lisp-complete-symbol-set-timer' and `anything-apropos'"
 213   (when alcs-make-candidates-timer
 214     (cancel-timer alcs-make-candidates-timer))
 215   (setq alcs-make-candidates-timer
 216         (run-with-idle-timer update-period t 'alcs-make-candidates)))
 217
 218 (defvar alcs-physical-column-at-startup nil)
 219 (defun alcs-init (bufname)
 220   (declare (special anything-dabbrev-last-target))
 221   (setq alcs-physical-column-at-startup nil)
 222   (setq anything-complete-target
 223         (if (loop for src in (anything-get-sources)
 224                   thereis (string-match "^dabbrev" (assoc-default 'name src)))
 225             anything-dabbrev-last-target
 226           (or (tap-symbol) "")))
 227   (anything-candidate-buffer (get-buffer bufname)))
 228
 229 (defcustom anything-complete-sort-candidates nil
 230   "*Whether to sort completion candidates."
 231   :type 'boolean
 232   :group 'anything-complete)
 233
 234 (defcustom anything-execute-extended-command-use-kyr t
 235   "*Use `anything-kyr' (context-aware commands) in `anything-execute-extended-command'. "
 236   :type 'boolean
 237   :group 'anything-complete)
 238 (defun alcs-sort-maybe (candidates source)
 239   (if anything-complete-sort-candidates
 240       (sort candidates #'string<)
 241     candidates))
 242 (defun alcs-fontify-face (candidates source)
 243   (mapcar
 244    (lambda (facename)
 245      (propertize facename 'face (intern-soft facename)))
 246    candidates))
 247 ;;; borrowed from pulldown.el
 248 (defun alcs-current-physical-column ()
 249   "Current physical column. (not logical column)"
 250   ;; (- (point) (save-excursion (vertical-motion 0) (point)))
 251   (car (posn-col-row (posn-at-point))))
 252
 253 (defun alcs-transformer-prepend-spacer (candidates source)
 254   "Prepend spaces according to `current-column' for each CANDIDATES."
 255   (setq alcs-physical-column-at-startup
 256         (or alcs-physical-column-at-startup
 257             (with-current-buffer anything-current-buffer
 258               (save-excursion
 259                 (backward-char (string-width anything-complete-target))
 260                 (max 0
 261                      (- (alcs-current-physical-column)
 262                         (if (buffer-local-value 'anything-enable-shortcuts (get-buffer anything-buffer))
 263                             4           ;length of shortcut overlay
 264                           0)))))))
 265   (mapcar (lambda (cand) (cons (concat (make-string alcs-physical-column-at-startup ? ) cand) cand))
 266           candidates))
 267
 268 (defun alcs-transformer-prepend-spacer-maybe (candidates source)
 269   ;; `anything-show-completion-activate' is defined in anything-show-completion.el
 270   (if (and (boundp 'anything-show-completion-activate)
 271            anything-show-completion-activate)
 272       (alcs-transformer-prepend-spacer candidates source)
 273     candidates))
 274
 275 (defun alcs-describe-function (name)
 276   (describe-function (anything-c-symbolify name)))
 277 (defun alcs-describe-variable (name)
 278   (describe-variable (anything-c-symbolify name)))
 279 (defun alcs-describe-face (name)
 280   (describe-face (anything-c-symbolify name)))
 281 (defun alcs-customize-face (name)
 282   (customize-face (anything-c-symbolify name)))
 283 (defun alcs-find-function (name)
 284   (find-function (anything-c-symbolify name)))
 285 (defun alcs-find-variable (name)
 286   (find-variable (anything-c-symbolify name)))
 287
 288 (defvar anything-c-source-complete-emacs-functions
 289   '((name . "Functions")
 290     (init . (lambda () (alcs-init alcs-functions-buffer)))
 291     (candidates-in-buffer)
 292     (type . complete-function)))
 293 (defvar anything-c-source-complete-emacs-commands
 294   '((name . "Commands")
 295     (init . (lambda () (alcs-init alcs-commands-buffer)))
 296     (candidates-in-buffer)
 297     (type . complete-function)))
 298 (defvar anything-c-source-complete-emacs-variables
 299   '((name . "Variables")
 300     (init . (lambda () (alcs-init alcs-variables-buffer)))
 301     (candidates-in-buffer)
 302     (type . complete-variable)))
 303 (defvar anything-c-source-complete-emacs-faces
 304   '((name . "Faces")
 305     (init . (lambda () (alcs-init alcs-faces-buffer)))
 306     (candidates-in-buffer)
 307     (type . complete-face)))
 308 (defvar anything-c-source-complete-emacs-other-symbols
 309   '((name . "Other Symbols")
 310     (init . (lambda () (alcs-init alcs-symbol-buffer)))
 311     (candidates-in-buffer)
 312     (filtered-candidate-transformer . alcs-sort-maybe)
 313     (action . ac-insert)))
 314 (defvar anything-c-source-apropos-emacs-functions
 315   '((name . "Apropos Functions")
 316     (init . (lambda () (alcs-init alcs-functions-buffer)))
 317     (candidates-in-buffer)
 318     (requires-pattern . 3)
 319     (type . apropos-function)))
 320 (defvar anything-c-source-apropos-emacs-commands
 321   '((name . "Apropos Commands")
 322     (init . (lambda () (alcs-init alcs-commands-buffer)))
 323     (candidates-in-buffer)
 324     (requires-pattern . 3)
 325     (type . apropos-function)))
 326 (defvar anything-c-source-apropos-emacs-variables
 327   '((name . "Apropos Variables")
 328     (init . (lambda () (alcs-init alcs-variables-buffer)))
 329     (candidates-in-buffer)
 330     (requires-pattern . 3)
 331     (type . apropos-variable)))
 332 (defvar anything-c-source-apropos-emacs-faces
 333   '((name . "Apropos Faces")
 334     (init . (lambda () (alcs-init alcs-faces-buffer)))
 335     (candidates-in-buffer)
 336     (requires-pattern . 3)
 337     (type . apropos-face)))
 338 (defvar anything-c-source-emacs-function-at-point
 339   '((name . "Function at point")
 340     (candidates
 341      . (lambda () (with-current-buffer anything-current-buffer
 342                     (anything-aif (function-called-at-point)
 343                         (list (symbol-name it))))))
 344     (type . apropos-function)))
 345 (defvar anything-c-source-emacs-variable-at-point
 346   '((name . "Variable at point")
 347     (candidates
 348      . (lambda () (with-current-buffer anything-current-buffer
 349                     (anything-aif (variable-at-point)
 350                         (unless (equal 0 it) (list (symbol-name it)))))))
 351     (type . apropos-variable)))
 352 (defvar anything-c-source-emacs-face-at-point
 353   '((name . "Face at point")
 354     (candidates
 355      . (lambda () (with-current-buffer anything-current-buffer
 356                     (anything-aif (face-at-point)
 357                         (unless (equal 0 it) (list (symbol-name it)))))))
 358     (type . apropos-variable)))
 359
 360 (defvar anything-lisp-complete-symbol-sources
 361   '(anything-c-source-complete-anything-attributes
 362     anything-c-source-complete-emacs-commands
 363     anything-c-source-complete-emacs-functions
 364     anything-c-source-complete-emacs-variables
 365     anything-c-source-complete-emacs-faces))
 366
 367 (defvar anything-apropos-sources
 368   '(anything-c-source-emacs-function-at-point
 369     anything-c-source-emacs-variable-at-point
 370     anything-c-source-apropos-emacs-commands
 371     anything-c-source-apropos-emacs-functions
 372     anything-c-source-apropos-emacs-variables
 373     anything-c-source-apropos-emacs-faces))
 374
 375 (define-anything-type-attribute 'apropos-function
 376   '((filtered-candidate-transformer . alcs-sort-maybe)
 377     (header-name . alcs-header-name)
 378     (persistent-action . alcs-describe-function)
 379     (update . alcs-make-candidates)
 380     (action
 381      ("Describe Function" . alcs-describe-function)
 382      ("Find Function" . alcs-find-function))))
 383 (define-anything-type-attribute 'apropos-variable
 384   '((filtered-candidate-transformer . alcs-sort-maybe)
 385     (header-name . alcs-header-name)
 386     (persistent-action . alcs-describe-variable)
 387     (update . alcs-make-candidates)
 388     (action
 389      ("Describe Variable" . alcs-describe-variable)
 390      ("Find Variable" . alcs-find-variable))))
 391 (define-anything-type-attribute 'apropos-face
 392   '((filtered-candidate-transformer alcs-sort-maybe alcs-fontify-face)
 393     (get-line . buffer-substring)
 394     (header-name . alcs-header-name)
 395     (update . alcs-make-candidates)
 396     (persistent-action . alcs-describe-face)
 397     (action
 398      ("Customize Face" . alcs-customize-face)
 399      ("Describe Face" . alcs-describe-face))))
 400 (define-anything-type-attribute 'complete-function
 401   '((filtered-candidate-transformer alcs-sort-maybe alcs-transformer-prepend-spacer-maybe)
 402     (header-name . alcs-header-name)
 403     (action . ac-insert)
 404     (update . alcs-make-candidates)
 405     (persistent-action . alcs-describe-function)))
 406 (define-anything-type-attribute 'complete-variable
 407   '((filtered-candidate-transformer alcs-sort-maybe alcs-transformer-prepend-spacer-maybe)
 408     (header-name . alcs-header-name)
 409     (action . ac-insert)
 410     (update . alcs-make-candidates)
 411     (persistent-action . alcs-describe-variable)))
 412 (define-anything-type-attribute 'complete-face
 413   '((filtered-candidate-transformer alcs-sort-maybe alcs-transformer-prepend-spacer-maybe)
 414     (header-name . alcs-header-name)
 415     (action . ac-insert)
 416     (update . alcs-make-candidates)
 417     (persistent-action . alcs-describe-face)))
 418
 419 (defvar alcs-this-command nil)
 420 (defun* anything-lisp-complete-symbol-1 (update sources input &optional (buffer "*anything complete*"))
 421   (setq alcs-this-command this-command)
 422   (when (or update (null (get-buffer alcs-variables-buffer)))
 423     (alcs-make-candidates))
 424   (let (anything-samewindow
 425         (anything-input-idle-delay
 426          (or anything-lisp-complete-symbol-input-idle-delay
 427              anything-input-idle-delay)))
 428     (funcall
 429      (if (equal buffer "*anything complete*") 'anything-noresume 'anything)
 430      sources input nil nil nil buffer)))
 431
 432 ;; Test alcs-update-restart (with-current-buffer alcs-commands-buffer (erase-buffer))
 433 ;; Test alcs-update-restart (kill-buffer alcs-commands-buffer)
 434 (defun alcs-update-restart ()
 435   "Update lisp symbols and restart current `anything' session."
 436   (interactive)
 437   (alcs-make-candidates)
 438   (anything-update))
 439
 440 (defun tap-symbol ()
 441   "Get symbol name before point."
 442   (save-excursion
 443     (let ((beg (point)))
 444       ;; older regexp "\(\\|\\s-\\|^\\|\\_<\\|\r\\|'\\|#'"
 445       (when (re-search-backward "\\_<" (point-at-bol) t)
 446         (buffer-substring-no-properties beg (match-end 0))))))
 447
 448 (defun alcs-initial-input (partial-match)
 449   (anything-aif (tap-symbol)
 450       (format "%s%s%s"
 451               (if partial-match "" "^")
 452               it
 453               (if anything-lisp-complete-symbol-add-space-on-startup " " ""))
 454     ""))
 455
 456 (defun anything-lisp-complete-symbol (update)
 457   "`lisp-complete-symbol' replacement using `anything'."
 458   (interactive "P")
 459   (anything-lisp-complete-symbol-1 update anything-lisp-complete-symbol-sources
 460                                    (alcs-initial-input nil)))
 461 (defun anything-lisp-complete-symbol-partial-match (update)
 462   "`lisp-complete-symbol' replacement using `anything' (partial match)."
 463   (interactive "P")
 464   (anything-lisp-complete-symbol-1 update anything-lisp-complete-symbol-sources
 465                                    (alcs-initial-input t)))
 466 (defun anything-apropos (update)
 467   "`apropos' replacement using `anything'."
 468   (interactive "P")
 469   (anything-lisp-complete-symbol-1 update anything-apropos-sources nil "*anything apropos*"))
 470
 471 ;; (@* "anything attribute completion")
 472 (defvar anything-c-source-complete-anything-attributes
 473   '((name . "Anything Attributes")
 474     (candidates . acaa-candidates)
 475     (action . ac-insert)
 476     (persistent-action . acaa-describe-anything-attribute)
 477     (filtered-candidate-transformer alcs-sort-maybe alcs-transformer-prepend-spacer-maybe)
 478     (header-name . alcs-header-name)
 479     (action . ac-insert)))
 480 ;; (anything 'anything-c-source-complete-anything-attributes)
 481
 482 (defun acaa-describe-anything-attribute (str)
 483   (anything-describe-anything-attribute (anything-c-symbolify str)))
 484
 485 (defun acaa-candidates ()
 486   (with-current-buffer anything-current-buffer
 487     (when (and (require 'yasnippet nil t)
 488                (acaa-completing-attribute-p (point)))
 489       (mapcar 'symbol-name anything-additional-attributes))))
 490
 491 (defvar acaa-anything-commands-regexp
 492   (concat "(" (regexp-opt
 493                '("anything" "anything-other-buffer"
 494                  "define-anything-type-attribute" "anything-c-arrange-type-attribute"))
 495           " "))
 496
 497 (defun acaa-completing-attribute-p (point)
 498   (save-excursion
 499     (goto-char point)
 500     (ignore-errors
 501       (or (save-excursion
 502             (backward-up-list 3)
 503             (looking-at (concat "(defvar anything-c-source-"
 504                                 "\\|"
 505                                 acaa-anything-commands-regexp)))
 506           (save-excursion
 507             (backward-up-list 4)
 508             (looking-at acaa-anything-commands-regexp))))))
 509
 510 ;; (anything '(ini
 511 ;;;; unit test
 512 ;; (install-elisp "http://www.emacswiki.org/cgi-bin/wiki/download/el-expectations.el")
 513 ;; (install-elisp "http://www.emacswiki.org/cgi-bin/wiki/download/el-mock.el")
 514 (dont-compile
 515   (when (fboundp 'expectations)
 516     (expectations
 517       (desc "acaa-completing-attribute-p")
 518       (expect t
 519         (with-temp-buffer
 520           (insert "(anything '(((na")
 521           (acaa-completing-attribute-p (point))))
 522       (expect t
 523         (with-temp-buffer
 524           (insert "(anything '((na")
 525           (acaa-completing-attribute-p (point))))
 526       (expect nil
 527         (with-temp-buffer
 528           (insert "(anything-hoge '((na")
 529           (acaa-completing-attribute-p (point))))
 530       (expect nil
 531         (with-temp-buffer
 532           (insert "(anything-hoge '(((na")
 533           (acaa-completing-attribute-p (point))))
 534       (expect t
 535         (with-temp-buffer
 536           (insert "(defvar anything-c-source-hoge '((na")
 537           (acaa-completing-attribute-p (point))))
 538
 539       )))
 540
 541 ;; (@* "anything-read-string-mode / read-* compatibility functions")
 542 ;; moved from anything.el
 543 (defun anything-compile-source--default-value (source)
 544   (anything-aif (assoc-default 'default-value source)
 545       (append source
 546               `((candidates ,it)
 547                 (filtered-candidate-transformer
 548                  . (lambda (cands source)
 549                      (if (string= anything-pattern "") cands nil)))))
 550     source))
 551 (add-to-list 'anything-compile-source-functions 'anything-compile-source--default-value)
 552
 553 (defun ac-new-input-source (prompt require-match &optional additional-attrs)
 554   (unless require-match
 555     `((name . ,prompt)
 556       (dummy)
 557       ,@additional-attrs)))
 558 (defun* ac-default-source (default &optional accept-empty (additional-attrs '((action . identity))))
 559   `((name . "Default")
 560     (default-value . ,(or default (and accept-empty "")))
 561     ,@additional-attrs
 562     ,(if accept-empty '(accept-empty))))
 563 ;; (ac-default-source "a")
 564 ;; (ac-default-source "a" t)
 565 ;; (ac-default-source nil t)
 566 ;; (ac-default-source nil)
 567
 568 ;; (@* "`completing-read' compatible read function ")
 569 (defvar anything-use-original-function nil
 570   "If non-nil, use original implementation not anything version.")
 571 (defun anything-completing-read (prompt collection &optional predicate require-match initial hist default inherit-input-method)
 572   (if (or anything-use-original-function
 573           (arrayp collection) (functionp collection))
 574       (anything-old-completing-read prompt collection predicate require-match initial hist default inherit-input-method)
 575     ;; support only collection list.
 576     (setq hist (or (car-safe hist) hist))
 577     (let* (anything-input-idle-delay
 578            (result (or (anything-noresume (acr-sources
 579                                            prompt
 580                                            collection
 581                                            predicate require-match initial
 582                                            hist default inherit-input-method)
 583                                           initial prompt nil nil "*anything complete*")
 584                        (keyboard-quit))))
 585       (when (stringp result)
 586         (prog1 result
 587           (setq hist (or hist 'minibuffer-history))
 588           (set hist (cons result (ignore-errors (delete result (symbol-value hist))))))))))
 589
 590 ;; TODO obarray/predicate hacks: command/variable/symbol
 591 (defvar anything-completing-read-use-default t
 592   "Whether to use default value source.")
 593 (defvar anything-completing-read-history-first nil
 594   "Whether to display history source first.")
 595 (defvar anything-complete-persistent-action nil
 596   "Persistent action function used by `anything-completing-read'.
 597 It accepts one argument, selected candidate.")
 598
 599 (defun* acr-sources (prompt collection predicate require-match initial hist default inherit-input-method &optional (additional-attrs '((action . identity))))
 600   "`anything' replacement for `completing-read'."
 601   (let* ((transformer-func
 602           (if predicate
 603               `(candidate-transformer
 604                 . (lambda (cands)
 605                     (remove-if-not (lambda (c) (,predicate
 606                                                 (if (listp c) (car c) c))) cands)))))
 607          (persistent-action
 608           (if anything-complete-persistent-action
 609               '(persistent-action
 610                 . (lambda (cand) (funcall anything-complete-persistent-action cand)))))
 611          (new-input-source (ac-new-input-source prompt require-match additional-attrs))
 612          (histvar (or hist 'minibuffer-history))
 613          (history-source (when (and (boundp histvar) (not require-match))
 614                            `((name . "History")
 615                              (candidates . ,histvar)
 616                              ,persistent-action
 617                              ,@additional-attrs)))
 618          (default-source (and anything-completing-read-use-default (ac-default-source default t)))
 619          (main-source `((name . "Completions")
 620                         (candidates . ,(mapcar (lambda (x) (or (car-safe x) x)) collection))
 621                         ,@additional-attrs
 622                         ,persistent-action
 623                         ,transformer-func)))
 624     (cond ((and require-match default)
 625            (list default-source main-source))
 626           (require-match
 627            (list main-source default-source))
 628           (anything-completing-read-history-first
 629            (list default-source history-source main-source new-input-source))
 630           (t
 631            (list default-source main-source history-source new-input-source)))))
 632 ;; (anything-completing-read "Command: " obarray 'commandp t)
 633 ;; (anything-completing-read "Test: " '(("hoge")("foo")("bar")) nil nil nil 'hoge-history)
 634 ;; hoge-history
 635 ;; (anything-completing-read "Test: " '(("hoge")("foo")("bar")) nil nil nil)
 636 ;; (anything-completing-read "Test: " '(("hoge")("foo")("bar")) nil t)
 637 ;; (anything-completing-read "Test: " '(("hoge")("foo")("bar")) nil t nil nil "foo")
 638 ;; (let ((anything-complete-persistent-action 'message)) (anything-completing-read "Test: " '(("hoge")("foo")("bar")) nil t))
 639 ;; (anything-old-completing-read "Test: " '(("hoge")("foo")("bar")) nil t)
 640 ;; (anything-completing-read "Test: " '(("hoge")("foo")("bar")) nil nil "f" nil)
 641 ;; (completing-read "Test: " '(("hoge")("foo")("bar")) nil nil "f" nil nil t)
 642 ;; (anything-completing-read "Test: " '(("hoge")("foo")("bar")) nil nil nil nil "nana")
 643 ;; (anything-completing-read "Test: " '("hoge" "foo" "bar"))
 644
 645 ;; (@* "`read-buffer' compatible read function ")
 646 (defun anything-read-buffer (prompt &optional default require-match start matches-set)
 647   "`anything' replacement for `read-buffer'."
 648   (let (anything-input-idle-delay)
 649     (or (anything-noresume (arb-sources prompt
 650                                         (if (bufferp default) (buffer-name default) default)
 651                                         require-match start matches-set)
 652                            start prompt nil nil "*anything complete*")
 653         (keyboard-quit))))
 654
 655 (defun* arb-sources (prompt default require-match start matches-set &optional (additional-attrs '((action . identity))))
 656   `(,(ac-default-source default t)
 657     ((name . ,prompt)
 658      (persistent-action . switch-to-buffer)
 659      (candidates . (lambda () (mapcar 'buffer-name (buffer-list))))
 660      ,@additional-attrs)
 661     ,(ac-new-input-source prompt require-match additional-attrs)))
 662
 663 ;; (anything-read-buffer "test: "  nil)
 664 ;; (anything-read-buffer "test: " "*scratch*" t)
 665 ;; (anything-read-buffer "test: " "*scratch*" t "*")
 666
 667 ;; (read-variable "variable: " "find-file-hooks")
 668 ;; (read-variable "variable: " 'find-file-hooks)
 669 ;; (read-variable "variable: " )
 670 (defun anything-read-symbol-1 (prompt buffer default-value)
 671   (let (anything-input-idle-delay anything-samewindow)
 672     (intern (or (anything-noresume `(,(ac-default-source
 673                                        (if default-value (format "%s" default-value)))
 674                                      ((name . ,prompt)
 675                                       (init . (lambda () (alcs-init ,buffer)))
 676                                       (candidates-in-buffer)
 677                                       (action . identity)))
 678                                    nil prompt nil nil "*anything complete*")
 679                 (keyboard-quit)))))
 680
 681 ;; (@* "`read-variable' compatible read function ")
 682 (defun anything-read-variable (prompt &optional default-value)
 683   (anything-read-symbol-1 prompt alcs-variables-buffer default-value))
 684 ;; (anything-read-variable "variable: " 'find-file-hooks)
 685
 686 ;; (@* "`read-command' compatible read function ")
 687 (defun anything-read-command (prompt &optional default-value)
 688   (anything-read-symbol-1 prompt alcs-commands-buffer default-value))
 689 ;; (anything-read-variable "command: ")
 690
 691
 692 ;; (@* "`anything-read-string-mode' initialization")
 693 (defvar anything-read-string-mode nil)
 694 (unless anything-read-string-mode
 695   (defalias 'anything-old-completing-read (symbol-function 'completing-read))
 696   (defalias 'anything-old-read-file-name (symbol-function 'read-file-name))
 697   (defalias 'anything-old-read-buffer (symbol-function 'read-buffer))
 698   (defalias 'anything-old-read-variable (symbol-function 'read-variable))
 699   (defalias 'anything-old-read-command (symbol-function 'read-command))
 700   (put 'anything-read-string-mode 'orig-read-buffer-function read-buffer-function))
 701
 702 ;; (progn (anything-read-string-mode -1) anything-read-string-mode)
 703 ;; (progn (anything-read-string-mode 1) anything-read-string-mode)
 704 ;; (progn (anything-read-string-mode 0) anything-read-string-mode)
 705 ;; (progn (anything-read-string-mode '(string buffer variable command)) anything-read-string-mode)
 706 (defvar anything-read-string-mode-flags '(string buffer variable command)
 707   "Saved ARG of `anything-read-string-mode'.")
 708 (defun anything-read-string-mode (arg)
 709   "If this minor mode is on, use `anything' version of `completing-read' and `read-file-name'.
 710
 711 ARG also accepts a symbol list. The elements are:
 712 string:   replace `completing-read'
 713 buffer:   replace `read-buffer'
 714 variable: replace `read-variable'
 715 command:  replace `read-command' and M-x
 716 file:     replace `read-file-name' and `find-file' (disabled by default)
 717
 718 So, (anything-read-string-mode 1) and
 719  (anything-read-string-mode '(string buffer variable command) are identical."
 720   (interactive "P")
 721   (when (consp anything-read-string-mode)
 722     (anything-read-string-mode-uninstall))
 723   (setq anything-read-string-mode
 724         (cond ((consp arg) (setq anything-read-string-mode-flags arg)) ; not interactive
 725               (arg (> (prefix-numeric-value arg) 0))  ; C-u M-x
 726               (t   (not anything-read-string-mode)))) ; M-x
 727   (when (eq anything-read-string-mode t)
 728     (setq anything-read-string-mode anything-read-string-mode-flags))
 729   (if anything-read-string-mode
 730       (anything-read-string-mode-install)
 731     (anything-read-string-mode-uninstall)))
 732
 733 (defun anything-read-string-mode-install ()
 734   ;; redefine to anything version
 735   (when (memq 'string anything-read-string-mode)
 736     (defalias 'completing-read (symbol-function 'anything-completing-read)))
 737   (when (memq 'file anything-read-string-mode)
 738     (defalias 'read-file-name (symbol-function 'anything-read-file-name))
 739     (substitute-key-definition 'find-file 'anything-find-file global-map))
 740   (when (memq 'buffer anything-read-string-mode)
 741     (setq read-buffer-function 'anything-read-buffer)
 742     (defalias 'read-buffer (symbol-function 'anything-read-buffer)))
 743   (when (memq 'variable anything-read-string-mode)
 744     (defalias 'read-variable (symbol-function 'anything-read-variable)))
 745   (when (memq 'command anything-read-string-mode)
 746     (defalias 'read-command (symbol-function 'anything-read-command))
 747     (substitute-key-definition 'execute-extended-command 'anything-execute-extended-command global-map))
 748   (message "Installed anything version of read functions."))
 749 (defun anything-read-string-mode-uninstall ()
 750   ;; restore to original version
 751   (defalias 'completing-read (symbol-function 'anything-old-completing-read))
 752   (defalias 'read-file-name (symbol-function 'anything-old-read-file-name))
 753   (setq read-buffer-function (get 'anything-read-string-mode 'orig-read-buffer-function))
 754   (defalias 'read-buffer (symbol-function 'anything-old-read-buffer))
 755   (defalias 'read-variable (symbol-function 'anything-old-read-variable))
 756   (defalias 'read-command (symbol-function 'anything-old-read-command))
 757   (substitute-key-definition 'anything-execute-extended-command 'execute-extended-command global-map)
 758   (substitute-key-definition 'anything-find-file 'find-file global-map)
 759   (message "Uninstalled anything version of read functions."))
 760
 761
 762 ;; (@* " shell history")
 763 (defun anything-complete-shell-history ()
 764   "Select a command from shell history and insert it."
 765   (interactive)
 766   (let ((anything-show-completion-minimum-window-height (/ (frame-height) 2)))
 767     (anything-complete 'anything-c-source-complete-shell-history
 768                       (or (word-at-point) "")
 769                       20)))
 770 (defun anything-complete-shell-history-setup-key (key)
 771   ;; for Emacs22
 772   (when (and (not (boundp 'minibuffer-local-shell-command-map))
 773              (require 'shell-command nil t)
 774              (boundp 'shell-command-minibuffer-map))
 775     (shell-command-completion-mode)
 776     (define-key shell-command-minibuffer-map key 'anything-complete-shell-history))
 777   ;; for Emacs23
 778   (when (boundp 'minibuffer-local-shell-command-map)
 779     (define-key minibuffer-local-shell-command-map key 'anything-complete-shell-history))
 780
 781   (when (require 'background nil t)
 782     (define-key background-minibuffer-map key 'anything-complete-shell-history))
 783   (require 'shell)
 784   (define-key shell-mode-map key 'anything-complete-shell-history))
 785
 786 (defvar zsh-p nil)
 787 (defvar anything-c-source-complete-shell-history
 788   '((name . "Shell History")
 789     (init . (lambda ()
 790               (require 'shell-history)
 791               (with-current-buffer (anything-candidate-buffer (shell-history-buffer))
 792                 (revert-buffer t t)
 793                 (set (make-local-variable 'zsh-p)
 794                      (shell-history-zsh-extended-history-p)))))
 795     (get-line . acsh-get-line)
 796     (search-from-end)
 797     (type . complete)))
 798
 799 (defun acsh-get-line (s e)
 800   (let ((extended-history (string= (buffer-substring s (+ s 2)) ": "))
 801         (single-line (not (string= (buffer-substring (1- e) e) "\\"))))
 802     (cond ((not zsh-p)
 803            (buffer-substring s e))
 804           ((and extended-history single-line)
 805            (buffer-substring (+ s 15) e))
 806           (extended-history             ;zsh multi-line / 1st line
 807            (goto-char e)
 808            (let ((e2 (1- (if (re-search-forward "^: [0-9]+:[0-9];" nil t)
 809                              (match-beginning 0)
 810                            (point-max)))))
 811              (prog1 (replace-regexp-in-string
 812                      "\\\\\n" ";" (buffer-substring (+ s 15) e2))
 813                (goto-char s))))
 814           (t                   ; zsh multi-line history / not 1st line
 815            (goto-char s)
 816            (re-search-backward "^: [0-9]+:[0-9];" nil t)
 817            (let ((s2 (match-end 0)) e2)
 818              (goto-char s2)
 819              (setq e2 (1- (if (re-search-forward "^: [0-9]+:[0-9];" nil t)
 820                               (match-beginning 0)
 821                             (point-max))))
 822              (prog1 (replace-regexp-in-string
 823                      "\\\\\n" ";" (buffer-substring s2 e2))
 824                (goto-char s2)))))))
 825
 826 ;; I do not want to make anything-c-source-* symbols because they are
 827 ;; private in `anything-execute-extended-command'.
 828 (defvar anything-execute-extended-command-sources
 829   '(((name . "Emacs Commands History")
 830      (candidates . extended-command-history)
 831      (action . identity)
 832      (update . alcs-make-candidates)
 833      (persistent-action . alcs-describe-function))
 834     ((name . "Commands")
 835      (header-name . alcs-header-name)
 836      (init . (lambda () (anything-candidate-buffer
 837                          (get-buffer-create alcs-commands-buffer))))
 838      (candidates-in-buffer)
 839      (action . identity)
 840      (update . alcs-make-candidates)
 841      (persistent-action . alcs-describe-function))
 842     ((name . "New Command")
 843      (dummy)
 844      (action . identity)
 845      (persistent-action . alcs-describe-function))))
 846
 847 ;; (with-current-buffer " *command symbols*" (erase-buffer))
 848 (defun anything-execute-extended-command ()
 849   "Replacement of `execute-extended-command'."
 850   (interactive)
 851   (setq alcs-this-command this-command)
 852   (let* ((cmd (anything
 853                (if (and anything-execute-extended-command-use-kyr
 854                         (require 'anything-kyr-config nil t))
 855                    (cons anything-c-source-kyr
 856                          anything-execute-extended-command-sources)
 857                  anything-execute-extended-command-sources))))
 858     (unless (and cmd (commandp (intern-soft cmd)))
 859       (error "No command: %s" cmd))
 860     (setq extended-command-history (cons cmd (delete cmd extended-command-history)))
 861     (setq cmd (intern cmd))
 862     (if (or (stringp (symbol-function cmd))
 863             (vectorp (symbol-function cmd)))
 864         (execute-kbd-macro (symbol-function cmd))
 865       (setq this-command cmd)
 866       (call-interactively cmd))))
 867
 868 (add-hook 'after-init-hook 'alcs-make-candidates)
 869
 870
 871 ;;;; unit test
 872 ;; (install-elisp "http://www.emacswiki.org/cgi-bin/wiki/download/el-expectations.el")
 873 ;; (install-elisp "http://www.emacswiki.org/cgi-bin/wiki/download/el-mock.el")
 874 (dont-compile
 875   (when (fboundp 'expectations)
 876     (expectations
 877       (desc "acsh-get-line command")
 878       (expect "ls"
 879         (let ((zsh-p t))
 880           (with-temp-buffer
 881             (insert ": 1118554690:0;cat ~/.zsh_history\n"
 882                     ": 1118554690:0;ls\n")
 883             (forward-line -1)
 884             (acsh-get-line (point-at-bol) (point-at-eol)))))
 885       (expect "cd;ls -l"
 886         (let ((zsh-p t))
 887           (with-temp-buffer
 888             (insert ": 1118554690:0;cat ~/.zsh_history\n"
 889                     ": 1118554690:0;cd\\\n"
 890                     "ls -l\n"
 891                     ": 1118554690:0;hoge\n")
 892             (forward-line -2)
 893             (acsh-get-line (point-at-bol) (point-at-eol)))))
 894       (expect "cd;ls -l"
 895         (let ((zsh-p t))
 896           (with-temp-buffer
 897             (insert ": 1118554690:0;cat ~/.zsh_history\n"
 898                     ": 1118554690:0;cd\\\n"
 899                     "ls -l\n"
 900                     ": 1118554690:0;hoge\n")
 901             (forward-line -3)
 902             (acsh-get-line (point-at-bol) (point-at-eol)))))
 903       (expect "cd;ls -l"
 904         (let ((zsh-p t))
 905           (with-temp-buffer
 906             (insert ": 1118554690:0;cat ~/.zsh_history\n"
 907                     ": 1118554690:0;cd\\\n"
 908                     "ls -l\n")
 909             (forward-line -1)
 910             (acsh-get-line (point-at-bol) (point-at-eol)))))
 911       (expect "cd;ls -l"
 912         (let ((zsh-p t))
 913           (with-temp-buffer
 914             (insert ": 1118554690:0;cat ~/.zsh_history\n"
 915                     ": 1118554690:0;cd\\\n"
 916                     "ls -l\n")
 917             (forward-line -2)
 918             (acsh-get-line (point-at-bol) (point-at-eol)))))
 919       (expect "pwd"
 920         (let ((zsh-p nil))
 921           (with-temp-buffer
 922             (insert "foo\n"
 923                     "pwd\n")
 924             (forward-line -1)
 925             (acsh-get-line (point-at-bol) (point-at-eol)))))
 926       (desc "acsh-get-line lineno")
 927       (expect 2
 928         (let ((zsh-p t))
 929           (with-temp-buffer
 930             (insert ": 1118554690:0;cat ~/.zsh_history\n"
 931                     ": 1118554690:0;cd\\\n"
 932                     "ls -l\n"
 933                     ": 1118554690:0;hoge\n")
 934             (forward-line -2)
 935             (acsh-get-line (point-at-bol) (point-at-eol))
 936             (line-number-at-pos))))
 937       (expect 2
 938         (let ((zsh-p t))
 939           (with-temp-buffer
 940             (insert ": 1118554690:0;cat ~/.zsh_history\n"
 941                     ": 1118554690:0;cd\\\n"
 942                     "ls -l\n"
 943                     ": 1118554690:0;hoge\n")
 944             (forward-line -3)
 945             (acsh-get-line (point-at-bol) (point-at-eol))
 946             (line-number-at-pos))))
 947
 948       )))
 949
 950 ;;; for compatibility
 951 (defvaralias 'anything-c-source-complete-emacs-variables-partial-match
 952   'anything-c-source-complete-emacs-variables)
 953 (defvaralias 'anything-c-source-complete-emacs-commands-partial-match
 954   'anything-c-source-complete-emacs-commands)
 955 (defvaralias 'anything-c-source-complete-emacs-functions-partial-match
 956   'anything-c-source-complete-emacs-functions)
 957
 958
 959
 960 (provide 'anything-complete)
 961
 962 ;; How to save (DO NOT REMOVE!!)
 963 ;; (progn (magit-push) (emacswiki-post "anything-complete.el"))
 964 ;;; anything-complete.el ends here