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