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