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 'fboundp) "\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 ;; (@* "`anything-read-string-mode' initialization")
 557 (defvar anything-read-string-mode nil)
 558 (defvar anything-read-string-mode-flags '(string buffer variable command)
 559   "Saved ARG of `anything-read-string-mode'.")
 560 (defun anything-read-string-mode (arg)
 561   "If this minor mode is on, use `anything' version of `completing-read' and `read-file-name'.
 562
 563 ARG also accepts a symbol list. The elements are:
 564 string:   replace `completing-read' except `read-file-name'
 565 command:  replace M-x
 566 file:     replace `read-file-name' (disabled by default)
 567
 568 So, (anything-read-string-mode 1) and
 569  (anything-read-string-mode '(string buffer variable command) are identical.
 570
 571 It is deprecated now, fall back to `anything-completion-mode'
 572 because it is better implementation."
 573   (interactive "P")
 574   (when (consp anything-read-string-mode)
 575     (anything-read-string-mode-uninstall))
 576   (setq anything-read-string-mode
 577         (cond ((consp arg) (setq anything-read-string-mode-flags arg)) ; not interactive
 578               (arg (> (prefix-numeric-value arg) 0))  ; C-u M-x
 579               (t   (not anything-read-string-mode)))) ; M-x
 580   (when (eq anything-read-string-mode t)
 581     (setq anything-read-string-mode anything-read-string-mode-flags))
 582   (if anything-read-string-mode
 583       (anything-read-string-mode-install)
 584     (anything-read-string-mode-uninstall)))
 585
 586 (defun anything-read-string-mode-install ()
 587   ;; redefine to anything version
 588   (setq anything-completion-types
 589         (if (memq 'file anything-read-string-mode)
 590             '(complete file) '(complete)))
 591   (anything-completion-mode 1)
 592   (when (memq 'command anything-read-string-mode)
 593     (substitute-key-definition 'execute-extended-command 'anything-execute-extended-command global-map))
 594   (message "Installed anything version of read functions."))
 595 (defun anything-read-string-mode-uninstall ()
 596   ;; restore to original version
 597   (anything-completion-mode -1)
 598   (substitute-key-definition 'anything-execute-extended-command 'execute-extended-command global-map)
 599   (substitute-key-definition 'anything-find-file 'find-file global-map)
 600   (message "Uninstalled anything version of read functions."))
 601
 602
 603 ;; (@* " shell history")
 604 (defun anything-complete-shell-history ()
 605   "Select a command from shell history and insert it."
 606   (interactive)
 607   (let ((anything-show-completion-minimum-window-height (/ (frame-height) 2)))
 608     (anything-complete 'anything-c-source-complete-shell-history
 609                       (or (word-at-point) "")
 610                       20)))
 611 (defun anything-complete-shell-history-setup-key (key)
 612   ;; for Emacs22
 613   (when (and (not (boundp 'minibuffer-local-shell-command-map))
 614              (require 'shell-command nil t)
 615              (boundp 'shell-command-minibuffer-map))
 616     (shell-command-completion-mode)
 617     (define-key shell-command-minibuffer-map key 'anything-complete-shell-history))
 618   ;; for Emacs23
 619   (when (boundp 'minibuffer-local-shell-command-map)
 620     (define-key minibuffer-local-shell-command-map key 'anything-complete-shell-history))
 621
 622   (when (require 'background nil t)
 623     (define-key background-minibuffer-map key 'anything-complete-shell-history))
 624   (require 'shell)
 625   (define-key shell-mode-map key 'anything-complete-shell-history))
 626
 627 (defvar zsh-p nil)
 628 (defvar anything-c-source-complete-shell-history
 629   '((name . "Shell History")
 630     (init . (lambda ()
 631               (require 'shell-history)
 632               (with-current-buffer (anything-candidate-buffer (shell-history-buffer))
 633                 (revert-buffer t t)
 634                 (set (make-local-variable 'zsh-p)
 635                      (shell-history-zsh-extended-history-p)))))
 636     (get-line . acsh-get-line)
 637     (search-from-end)
 638     (type . complete)))
 639
 640 (defun acsh-get-line (s e)
 641   (let ((extended-history (string= (buffer-substring s (+ s 2)) ": "))
 642         (single-line (not (string= (buffer-substring (1- e) e) "\\"))))
 643     (cond ((not zsh-p)
 644            (buffer-substring s e))
 645           ((and extended-history single-line)
 646            (buffer-substring (+ s 15) e))
 647           (extended-history             ;zsh multi-line / 1st line
 648            (goto-char e)
 649            (let ((e2 (1- (if (re-search-forward "^: [0-9]+:[0-9];" nil t)
 650                              (match-beginning 0)
 651                            (point-max)))))
 652              (prog1 (replace-regexp-in-string
 653                      "\\\\\n" ";" (buffer-substring (+ s 15) e2))
 654                (goto-char s))))
 655           (t                   ; zsh multi-line history / not 1st line
 656            (goto-char s)
 657            (re-search-backward "^: [0-9]+:[0-9];" nil t)
 658            (let ((s2 (match-end 0)) e2)
 659              (goto-char s2)
 660              (setq e2 (1- (if (re-search-forward "^: [0-9]+:[0-9];" nil t)
 661                               (match-beginning 0)
 662                             (point-max))))
 663              (prog1 (replace-regexp-in-string
 664                      "\\\\\n" ";" (buffer-substring s2 e2))
 665                (goto-char s2)))))))
 666
 667 ;;;; M-x
 668 (defvar anything-execute-extended-command-map
 669   (let ((map (make-sparse-keymap)))
 670     (set-keymap-parent map anything-map)
 671     (define-key map (kbd "M-x") 'anything-next-line)
 672     map))
 673
 674 (define-anything-type-attribute 'execute-command
 675   `((update . alcs-make-candidates)
 676     (keymap . ,anything-execute-extended-command-map)
 677     (persistent-action . alcs-describe-function)
 678     (action ("Execute" . anything-execute-extended-command-execute)
 679             ("Describe Function" . alcs-describe-function)
 680             ("Find Function" . alcs-find-function))))
 681
 682 ;; I do not want to make anything-c-source-* symbols because they are
 683 ;; private in `anything-execute-extended-command'.
 684 (defvar anything-execute-extended-command-sources
 685   '(((name . "Emacs Commands History")
 686      (candidates . extended-command-history)
 687      (type . execute-command))
 688     ((name . "Commands")
 689      (header-name . alcs-header-name)
 690      (init . (lambda () (anything-candidate-buffer
 691                          (get-buffer-create alcs-commands-buffer))))
 692      (candidates-in-buffer)
 693      (type . execute-command))
 694     ((name . "New Command")
 695      (dummy)
 696      (type . execute-command))))
 697
 698 ;; (with-current-buffer " *command symbols*" (erase-buffer))
 699 (defvar anything-execute-extended-command-prefix-arg nil)
 700
 701 (defun anything-execute-extended-command-execute (cmdname)
 702   (let ((sym-com (and (stringp cmdname) (intern-soft cmdname))))
 703     (unless (and sym-com (commandp sym-com))
 704       (error "No such command: %s" cmdname))
 705     (setq this-command sym-com
 706           real-this-command sym-com)
 707     (let ((prefix-arg anything-execute-extended-command-prefix-arg))
 708       (setq extended-command-history
 709             (cons cmdname
 710                   (delete cmdname extended-command-history)))
 711       (command-execute sym-com 'record))))
 712
 713 (defun anything-execute-extended-command (arg)
 714   "Replacement of `execute-extended-command'."
 715   (interactive "P")
 716   (setq anything-execute-extended-command-prefix-arg arg)
 717   (setq alcs-this-command this-command)
 718   (anything
 719    (if (and anything-execute-extended-command-use-kyr
 720             (require 'anything-kyr-config nil t))
 721        (cons anything-c-source-kyr
 722              anything-execute-extended-command-sources)
 723      anything-execute-extended-command-sources)))
 724
 725 (add-hook 'after-init-hook 'alcs-make-candidates)
 726
 727
 728 ;;;; unit test
 729 ;; (install-elisp "http://www.emacswiki.org/cgi-bin/wiki/download/el-expectations.el")
 730 ;; (install-elisp "http://www.emacswiki.org/cgi-bin/wiki/download/el-mock.el")
 731 (dont-compile
 732   (when (fboundp 'expectations)
 733     (expectations
 734       (desc "acsh-get-line command")
 735       (expect "ls"
 736         (let ((zsh-p t))
 737           (with-temp-buffer
 738             (insert ": 1118554690:0;cat ~/.zsh_history\n"
 739                     ": 1118554690:0;ls\n")
 740             (forward-line -1)
 741             (acsh-get-line (point-at-bol) (point-at-eol)))))
 742       (expect "cd;ls -l"
 743         (let ((zsh-p t))
 744           (with-temp-buffer
 745             (insert ": 1118554690:0;cat ~/.zsh_history\n"
 746                     ": 1118554690:0;cd\\\n"
 747                     "ls -l\n"
 748                     ": 1118554690:0;hoge\n")
 749             (forward-line -2)
 750             (acsh-get-line (point-at-bol) (point-at-eol)))))
 751       (expect "cd;ls -l"
 752         (let ((zsh-p t))
 753           (with-temp-buffer
 754             (insert ": 1118554690:0;cat ~/.zsh_history\n"
 755                     ": 1118554690:0;cd\\\n"
 756                     "ls -l\n"
 757                     ": 1118554690:0;hoge\n")
 758             (forward-line -3)
 759             (acsh-get-line (point-at-bol) (point-at-eol)))))
 760       (expect "cd;ls -l"
 761         (let ((zsh-p t))
 762           (with-temp-buffer
 763             (insert ": 1118554690:0;cat ~/.zsh_history\n"
 764                     ": 1118554690:0;cd\\\n"
 765                     "ls -l\n")
 766             (forward-line -1)
 767             (acsh-get-line (point-at-bol) (point-at-eol)))))
 768       (expect "cd;ls -l"
 769         (let ((zsh-p t))
 770           (with-temp-buffer
 771             (insert ": 1118554690:0;cat ~/.zsh_history\n"
 772                     ": 1118554690:0;cd\\\n"
 773                     "ls -l\n")
 774             (forward-line -2)
 775             (acsh-get-line (point-at-bol) (point-at-eol)))))
 776       (expect "pwd"
 777         (let ((zsh-p nil))
 778           (with-temp-buffer
 779             (insert "foo\n"
 780                     "pwd\n")
 781             (forward-line -1)
 782             (acsh-get-line (point-at-bol) (point-at-eol)))))
 783       (desc "acsh-get-line lineno")
 784       (expect 2
 785         (let ((zsh-p t))
 786           (with-temp-buffer
 787             (insert ": 1118554690:0;cat ~/.zsh_history\n"
 788                     ": 1118554690:0;cd\\\n"
 789                     "ls -l\n"
 790                     ": 1118554690:0;hoge\n")
 791             (forward-line -2)
 792             (acsh-get-line (point-at-bol) (point-at-eol))
 793             (line-number-at-pos))))
 794       (expect 2
 795         (let ((zsh-p t))
 796           (with-temp-buffer
 797             (insert ": 1118554690:0;cat ~/.zsh_history\n"
 798                     ": 1118554690:0;cd\\\n"
 799                     "ls -l\n"
 800                     ": 1118554690:0;hoge\n")
 801             (forward-line -3)
 802             (acsh-get-line (point-at-bol) (point-at-eol))
 803             (line-number-at-pos))))
 804
 805       )))
 806
 807 ;;; for compatibility
 808 (defvaralias 'anything-c-source-complete-emacs-variables-partial-match
 809   'anything-c-source-complete-emacs-variables)
 810 (defvaralias 'anything-c-source-complete-emacs-commands-partial-match
 811   'anything-c-source-complete-emacs-commands)
 812 (defvaralias 'anything-c-source-complete-emacs-functions-partial-match
 813   'anything-c-source-complete-emacs-functions)
 814
 815
 816
 817 (provide 'anything-complete)
 818
 819 ;; How to save (DO NOT REMOVE!!)
 820 ;; (progn (magit-push) (emacswiki-post "anything-complete.el"))
 821 ;;; anything-complete.el ends here