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