anything-match-plugin.el

   1 ;;; anything-match-plugin.el --- Humane match plug-in for anything
   2 ;; $Id: anything-match-plugin.el,v 1.27 2010-03-24 11:11:28 rubikitch Exp $
   3
   4 ;; Copyright (C) 2008  rubikitch
   5
   6 ;; Author: rubikitch <rubikitch@ruby-lang.org>
   7 ;; Keywords: anything, matching
   8 ;; URL: http://www.emacswiki.org/cgi-bin/wiki/download/anything-match-plugin.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 ;; Change anything.el matching algorithm humanely.
  28 ;; It gives anything.el search refinement functionality.
  29 ;; exact match -> prefix match -> multiple regexp match
  30
  31 ;;; Commands:
  32 ;;
  33 ;; Below are complete command list:
  34 ;;
  35 ;;
  36 ;;; Customizable Options:
  37 ;;
  38 ;; Below are customizable option list:
  39 ;;
  40 ;;  `anything-grep-candidates-fast-directory-regexp'
  41 ;;    *Directory regexp where a RAM disk (or tmpfs) is mounted.
  42 ;;    default = nil
  43
  44 ;; A query of multiple regexp match is space-delimited string.
  45 ;; Anything displays candidates which matches all the regexps.
  46 ;; A regexp with "!" prefix means not matching the regexp.
  47 ;; To include spaces to a regexp, prefix "\" before space,
  48 ;; it is controlled by `anything-mp-space-regexp' variable.
  49
  50 ;; If multiple regexps are specified, first one also tries to match the source name.
  51 ;; If you want to disable this feature, evaluate
  52 ;;   (setq anything-mp-match-source-name nil) .
  53
  54 ;; This file highlights patterns like `occur'. Note that patterns
  55 ;; longer than `anything-mp-highlight-threshold' are highlighted. And
  56 ;; region out of screen is highlighted after
  57 ;; `anything-mp-highlight-delay' seconds.
  58 ;;
  59 ;; Highlight in Emacs is time-consuming process for slow computers. To
  60 ;; disable it is to set nil to `anything-mp-highlight-delay'.
  61
  62 ;; Just require it to use.
  63
  64 ;;; History:
  65
  66 ;; $Log: anything-match-plugin.el,v $
  67 ;; Revision 1.27  2010-03-24 11:11:28  rubikitch
  68 ;; Added :group keyword to `defface anything-match'
  69 ;;
  70 ;; Revision 1.26  2010/03/24 10:48:55  rubikitch
  71 ;; grep-candidates plug-in: document / imply `delayed' attribute
  72 ;;
  73 ;; Revision 1.25  2010/03/24 10:38:48  rubikitch
  74 ;; grep-candidates plugin: grep-candidates attribute can also accept variable/function name.
  75 ;;
  76 ;; Revision 1.24  2010/03/22 09:01:22  rubikitch
  77 ;; grep-candidates plugin released
  78 ;;
  79 ;; Revision 1.23  2010/03/22 08:02:11  rubikitch
  80 ;; grep-candidates plugin prototype
  81 ;;
  82 ;; Revision 1.22  2009/03/03 10:21:45  rubikitch
  83 ;; * Remove highlight.el dependency.
  84 ;; * Very faster highlight.
  85 ;;
  86 ;; Revision 1.21  2009/03/03 08:51:23  rubikitch
  87 ;; New variable: `anything-mp-highlight-threshold'
  88 ;;
  89 ;; Revision 1.20  2009/03/03 07:29:24  rubikitch
  90 ;; Highlight matches!
  91 ;;
  92 ;; Revision 1.19  2008/09/08 06:58:59  rubikitch
  93 ;; changed default `anything-mp-space-regexp' to "[\\ ] "
  94 ;;
  95 ;; Revision 1.18  2008/09/07 12:09:01  rubikitch
  96 ;; *** empty log message ***
  97 ;;
  98 ;; Revision 1.17  2008/09/07 07:48:12  rubikitch
  99 ;; Append commentary.
 100 ;; Multiple regexp match with regexp negation.
 101 ;;
 102 ;; Revision 1.16  2008/09/07 06:58:11  rubikitch
 103 ;; Added mp-3p match: permutation with prefix match
 104 ;;
 105 ;; Revision 1.15  2008/09/07 05:23:07  rubikitch
 106 ;; New variable: `anything-mp-space-regexp'
 107 ;;
 108 ;; Revision 1.14  2008/09/03 03:33:09  rubikitch
 109 ;; anything-exact-*, anything-prefix-*: memoize
 110 ;;
 111 ;; Revision 1.13  2008/09/02 10:56:50  rubikitch
 112 ;; anything-mp-3-*: MUCH MUCH FASTER
 113 ;;   changed algorithm
 114 ;;
 115 ;; Revision 1.12  2008/09/01 13:41:57  rubikitch
 116 ;; search functions for search-from-end
 117 ;;
 118 ;; Revision 1.11  2008/08/24 20:40:27  rubikitch
 119 ;; prevent the unit test from being byte-compiled.
 120 ;;
 121 ;; Revision 1.10  2008/08/24 17:48:53  rubikitch
 122 ;; Add commentary
 123 ;;
 124 ;; Revision 1.9  2008/08/24 08:23:16  rubikitch
 125 ;; Rename `anything-candidates-buffer' -> `anything-candidate-buffer'
 126 ;;
 127 ;; Revision 1.8  2008/08/22 21:25:44  rubikitch
 128 ;; *** empty log message ***
 129 ;;
 130 ;; Revision 1.7  2008/08/22 21:17:58  rubikitch
 131 ;; exact, prefix match: faster
 132 ;;
 133 ;; Revision 1.6  2008/08/22 19:40:22  rubikitch
 134 ;; exact -> prefix -> mp-3 by default because of speed
 135 ;;
 136 ;; Revision 1.5  2008/08/22 19:04:53  rubikitch
 137 ;; reimplemented
 138 ;;
 139 ;; Revision 1.4  2008/08/20 00:10:15  rubikitch
 140 ;; *** empty log message ***
 141 ;;
 142 ;; Revision 1.3  2008/08/19 23:30:39  rubikitch
 143 ;; exact match support
 144 ;;
 145 ;; Revision 1.2  2008/08/19 23:02:29  rubikitch
 146 ;; candidates-in-buffer hack
 147 ;;
 148 ;; Revision 1.1  2008/08/19 19:45:11  rubikitch
 149 ;; Initial revision
 150 ;;
 151
 152 ;;; Code:
 153
 154 (require 'anything)
 155 (require 'cl)
 156
 157
 158 (defcustom anything-grep-candidates-fast-directory-regexp nil
 159   "*Directory regexp where a RAM disk (or tmpfs) is mounted.
 160
 161 If non-nil, grep-candidates plugin gets faster because it uses
 162 grep as synchronous process.
 163
 164 ex. (setq anything-grep-candidates-fast-directory-regexp \"^/tmp/\")"
 165   :type 'string
 166   :group 'anything)
 167
 168 ;;;; multiple patterns
 169 (defvar anything-use-multiple-patterns t
 170   "If non-nil, enable anything-use-multiple-patterns.")
 171 (defvar anything-mp-space-regexp "[\\ ] "
 172   "Regexp to represent space itself in multiple regexp match.")
 173 (defvar anything-mp-match-source-name t
 174   "If non-nil, first query in space-delimited pattern try to match the source name.
 175 It needs at least two queries.
 176 For example, to list candidats of \"foo\" source, input pattern as \"foo .\".")
 177
 178 (defun amp-mp-make-regexps (pattern)
 179   (if (string= pattern "") '("")
 180     (loop for s in (split-string
 181                     (replace-regexp-in-string anything-mp-space-regexp
 182                                               "\000\000" pattern) " " t)
 183         collect (replace-regexp-in-string "\000\000" " " s))))
 184
 185 (defun amp-mp-1-make-regexp (pattern)
 186   (mapconcat 'identity (amp-mp-make-regexps pattern) ".*"))
 187
 188 (defmacro amp-define-memoizer (prefix pattern-expr)
 189   (let ((pattern-str (intern (concat prefix "pattern-str")))
 190         (pattern-real (intern (concat prefix "pattern-real")))
 191         (get-pattern (intern (concat prefix "get-pattern"))))
 192     `(progn
 193        (defvar ,pattern-str nil)
 194        (defvar ,pattern-real nil)
 195        (defsubst ,get-pattern (pattern)
 196          (unless (equal pattern ,pattern-str)
 197            (setq ,pattern-str pattern
 198                  ,pattern-real ,pattern-expr))
 199          ,pattern-real))))
 200
 201 (defmacro amp-define (prefix pattern-expr)
 202   (let ((get-pattern (intern (concat prefix "get-pattern")))
 203         (match (intern (concat prefix "match")))
 204         (search (intern (concat prefix "search")))
 205         (search-backward (intern (concat prefix "search-backward"))))
 206     `(progn
 207        (amp-define-memoizer ,prefix ,pattern-expr)
 208        (defun* ,match (str &optional (pattern anything-pattern))
 209          (string-match (,get-pattern pattern) str))
 210        (defun ,search (pattern &rest ignore)
 211          (re-search-forward (,get-pattern pattern) nil t))
 212        (defun ,search-backward (pattern &rest ignore)
 213          (re-search-backward (,get-pattern pattern) nil t)))))
 214
 215 ;; exact match
 216 ;(amp-define "anything-exact-" (concat (anything-prefix-get-pattern pattern) "$"))
 217 (amp-define-memoizer "anything-exact-" (concat "\n" pattern "\n"))
 218 (defun anything-exact-match (str &optional pattern)
 219   (string= str (or pattern anything-pattern)))
 220 (defun anything-exact-search (pattern &rest ignore)
 221   (and (search-forward (anything-exact-get-pattern pattern) nil t)
 222        (forward-line -1)))
 223 (defun anything-exact-search-backward (pattern &rest ignore)
 224   (and (search-backward (anything-exact-get-pattern pattern) nil t)
 225        (forward-line 1)))
 226 ;; prefix match
 227 ;;(amp-define "anything-prefix-" (concat "^" (regexp-quote pattern)))
 228 (amp-define-memoizer "anything-prefix-" (concat "\n" pattern))
 229 (defun anything-prefix-match (str &optional pattern)
 230   (setq pattern (or pattern anything-pattern))
 231   (let ((len (length pattern)))
 232     (and (<= len (length str))
 233          (string= (substring str 0 len) pattern ))))
 234 (defun anything-prefix-search (pattern &rest ignore)
 235   (search-forward (anything-prefix-get-pattern pattern) nil t))
 236 (defun anything-prefix-search-backward (pattern &rest ignore)
 237   (and (search-backward (anything-prefix-get-pattern pattern) nil t)
 238        (forward-line 1)))
 239 ;; multiple regexp patterns 1 (order is preserved / prefix)
 240 (amp-define "anything-mp-1-" (concat "^" (amp-mp-1-make-regexp pattern)))
 241 ;; multiple regexp patterns 2 (order is preserved / partial)
 242 (amp-define "anything-mp-2-" (concat "^.+" (amp-mp-1-make-regexp pattern)))
 243
 244 ;;;; multiple regexp patterns 3 (permutation)
 245 (defvar anything-mp-3-pattern-str nil)
 246 (defvar anything-mp-3-pattern-list nil)
 247 (defsubst anything-mp-3-get-patterns (pattern)
 248   (unless (equal pattern anything-mp-3-pattern-str)
 249     (setq anything-mp-3-pattern-str pattern
 250           anything-mp-3-pattern-list
 251           (anything-mp-3-get-patterns-internal pattern)))
 252   anything-mp-3-pattern-list)
 253 (defun anything-mp-3-get-patterns-internal (pattern)
 254   (unless (string= pattern "")
 255     (loop for pat in (amp-mp-make-regexps pattern)
 256           collect (if (string= "!" (substring pat 0 1))
 257                       (cons 'not (substring pat 1))
 258                     (cons 'identity pat)))))
 259 (defun anything-mp-handle-source-name-maybe (pattern self else)
 260   (when (stringp pattern)
 261     (setq pattern (anything-mp-3-get-patterns pattern)))
 262   ;; PATTERN is list of (pred . re) now.
 263   (when pattern
 264     (destructuring-bind ((first-pred . first-re) . rest) pattern
 265       (if (and anything-mp-match-source-name
 266                (stringp anything-source-name)
 267                (eq 'identity first-pred))
 268           (let (anything-mp-match-source-name)
 269             (or (and (string-match first-re anything-source-name)
 270                      (funcall self rest))
 271                 (funcall self pattern)))
 272         (funcall else)))))
 273
 274 (defun* anything-mp-3-match (str &optional (pattern anything-pattern))
 275   (anything-mp-handle-source-name-maybe
 276    pattern (apply-partially 'anything-mp-3-match str)
 277    (lambda ()
 278      (loop for (pred . re) in pattern
 279            always (funcall pred (string-match re str))))))
 280
 281 (defmacro anything-mp-3-search-base (searchfn1 searchfn2 b e)
 282   `(loop with pat = (if (stringp pattern)
 283                         (anything-mp-3-get-patterns pattern)
 284                       pattern)
 285          while (,searchfn1 (or (cdar pat) "") nil t)
 286          for bol = (point-at-bol)
 287          for eol = (point-at-eol)
 288          if (loop
 289              for (pred . s) in (cdr pat)
 290              always (progn (goto-char ,b)
 291                            (funcall pred (,searchfn2 s ,e t))))
 292          do (goto-char ,e) (return t)
 293          else do
 294          (goto-char ,e)
 295          finally (return nil)))
 296
 297 (defun anything-mp-3-search (pattern &rest ignore)
 298   (anything-mp-handle-source-name-maybe
 299    pattern 'anything-mp-3-search
 300    (lambda () (anything-mp-3-search-base
 301                re-search-forward re-search-forward bol eol))))
 302 (defun anything-mp-3-search-backward (pattern &rest ignore)
 303   (anything-mp-handle-source-name-maybe
 304    pattern 'anything-mp-3-search-backward
 305    (lambda () (anything-mp-3-search-base
 306                re-search-backward re-search-backward eol bol))))
 307 ;; mp-3p- (multiple regexp pattern 3 with prefix search)
 308 (defun* anything-mp-3p-match (str &optional (pattern anything-pattern))
 309   (anything-mp-handle-source-name-maybe
 310    pattern (apply-partially 'anything-mp-3p-match str)
 311    (lambda ()
 312      (declare (special first-pred first-re rest))
 313      (and (funcall first-pred (anything-prefix-match str first-re))
 314           (loop for (pred . re) in rest
 315                 always (funcall pred (string-match re str)))))))
 316
 317 (defun anything-mp-3p-search (pattern &rest ignore)
 318   (anything-mp-handle-source-name-maybe
 319    pattern 'anything-mp-3p-search
 320    (lambda () (anything-mp-3-search-base
 321                anything-prefix-search re-search-forward bol eol))))
 322
 323 (defun anything-mp-3p-search-backward (pattern &rest ignore)
 324   (anything-mp-handle-source-name-maybe
 325    pattern 'anything-mp-3p-search-backward
 326    (lambda () (anything-mp-3-search-base
 327                anything-prefix-search-backward re-search-backward eol bol))))
 328
 329 ;;;; Highlight matches
 330 (defface anything-match
 331   '((t (:inherit match)))
 332   "Face used to highlight matches."
 333   :group 'anything)
 334
 335 (defvar anything-mp-highlight-delay 0.7
 336   "Highlight matches with `anything-match' face after this many seconds.
 337  If nil, no highlight. ")
 338
 339 (defvar anything-mp-highlight-threshold 2
 340   "Minimum length of pattern to highlight.
 341 The smaller  this value is, the slower highlight is.")
 342
 343 (defun anything-mp-highlight-match ()
 344   "Highlight matches after `anything-mp-highlight-delay' seconds."
 345   (when (and anything-mp-highlight-delay
 346              (not (string= anything-pattern "")))
 347     (anything-mp-highlight-match-internal (window-end (anything-window)))
 348     (run-with-idle-timer anything-mp-highlight-delay nil
 349                          'anything-mp-highlight-match-internal
 350                          (with-current-buffer anything-buffer (point-max)))))
 351 (add-hook 'anything-update-hook 'anything-mp-highlight-match)
 352
 353 (defun anything-mp-highlight-region (start end regexp face)
 354   (save-excursion
 355     (goto-char start)
 356     (let (me)
 357       (while (and (setq me (re-search-forward regexp nil t))
 358                   (< (point) end)
 359                   (< 0 (- (match-end 0) (match-beginning 0))))
 360         (put-text-property (match-beginning 0) me 'face face)))))
 361
 362 (defun* anything-mp-highlight-match-internal (end)
 363   (when (anything-window)
 364     (set-buffer anything-buffer)
 365     (let ((requote (regexp-quote anything-pattern)))
 366       (when (>= (length requote) anything-mp-highlight-threshold)
 367         (anything-mp-highlight-region (point-min) end
 368                                     requote 'anything-match)))
 369     (loop for (pred . re) in (anything-mp-3-get-patterns anything-pattern)
 370           when (and (eq pred 'identity)
 371                     (>= (length re) anything-mp-highlight-threshold))
 372           do
 373           (anything-mp-highlight-region (point-min) end re 'anything-match))))
 374
 375 ;;;; source compier
 376 (defvar anything-mp-default-match-functions
 377   '(anything-exact-match anything-mp-3p-match anything-mp-3-match))
 378 (defvar anything-mp-default-search-functions
 379   '(anything-exact-search anything-mp-3p-search anything-mp-3-search))
 380 (defvar anything-mp-default-search-backward-functions
 381   '(anything-exact-search-backward anything-mp-3p-search-backward
 382                                    anything-mp-3-search-backward))
 383 (defun anything-compile-source--match-plugin (source)
 384   (let ((searchers (if (assoc 'search-from-end source)
 385                        anything-mp-default-search-backward-functions
 386                      anything-mp-default-search-functions)))
 387     `(,(if (or (assoc 'candidates-in-buffer source)
 388                (equal '(identity) (assoc-default 'match source)))
 389            '(match identity)
 390          `(match ,@anything-mp-default-match-functions
 391                  ,@(assoc-default 'match source)))
 392       (search ,@searchers
 393               ,@(assoc-default 'search source))
 394       ,@source)))
 395
 396 (add-to-list 'anything-compile-source-functions 'anything-compile-source--match-plugin t)
 397
 398 ;;;; grep-candidates plug-in
 399 (defun agp-candidates (&optional filter)
 400   "Normal version of grep-candidates candidates function.
 401 Grep is run by asynchronous process."
 402   (start-process-shell-command
 403    "anything-grep-candidates" nil
 404    (agp-command-line-2 filter (anything-attr-defined 'search-from-end))))
 405 (defun agp-candidates-synchronous-grep (&optional filter)
 406   "Faster version of grep-candidates candidates function.
 407 Grep is run by synchronous process.
 408 It is faster when candidate files are in ramdisk."
 409   (split-string
 410    (shell-command-to-string
 411     (agp-command-line-2 filter (anything-attr-defined 'search-from-end)))
 412    "\n"))
 413 (defun agp-candidates-synchronous-grep--direct-insert-match (&optional filter)
 414   "[EXPERIMENTAL]Fastest version of grep-candidates candidates function at the cost of absense of transformers.
 415 Grep is run by synchronous process.
 416 It is faster when candidate files are in ramdisk.
 417
 418 If (direct-insert-match) is in the source, this function is used."
 419   (with-current-buffer (anything-candidate-buffer 'global)
 420     (call-process-shell-command
 421      (agp-command-line-2 filter (anything-attr-defined 'search-from-end))
 422      nil t)))
 423
 424 (defun agp-command-line (query files &optional limit filter search-from-end)
 425   "Build command line used by grep-candidates from QUERY, FILES, LIMIT, and FILTER."
 426   (let ((allfiles (mapconcat (lambda (f) (shell-quote-argument (expand-file-name f)))
 427                              files " ")))
 428     (with-temp-buffer
 429       (when search-from-end
 430         (insert "tac " allfiles))
 431       (if (string= query "")
 432           (unless search-from-end
 433             (insert "cat " allfiles))
 434         (when search-from-end (insert " | "))
 435         (loop for (flag . re) in (anything-mp-3-get-patterns-internal query)
 436               for i from 0
 437               do
 438               (setq re (replace-regexp-in-string "^-" "\\-" re))
 439               (unless (zerop i) (insert " | "))
 440               (insert "grep -ih "
 441                       (if (eq flag 'identity) "" "-v ")
 442                       (shell-quote-argument re))
 443               (when (and (not search-from-end) (zerop i))
 444                 (insert " " allfiles))))
 445
 446       (when limit (insert (format " | head -n %d" limit)))
 447       (when filter (insert " | " filter))
 448       (buffer-string))))
 449 (defun agp-command-line-2 (filter &optional search-from-end)
 450   "Build command line used by grep-candidates from FILTER and current source."
 451   (agp-command-line
 452    anything-pattern
 453    (anything-mklist (anything-interpret-value (anything-attr 'grep-candidates)))
 454    (anything-candidate-number-limit (anything-get-current-source))
 455    filter search-from-end))
 456 (defun anything-compile-source--grep-candidates (source)
 457   (anything-aif (assoc-default 'grep-candidates source)
 458       (append
 459        source
 460        (let ((use-fast-directory
 461               (and anything-grep-candidates-fast-directory-regexp
 462                    (string-match
 463                     anything-grep-candidates-fast-directory-regexp
 464                     (or (car (anything-mklist (anything-interpret-value it))) "")))))
 465          (cond ((not (anything-interpret-value it)) nil)
 466                ((and use-fast-directory (assq 'direct-insert-match source))
 467                 (anything-log "fastest version (use-fast-directory and direct-insert-match)")
 468                 `((candidates . agp-candidates-synchronous-grep--direct-insert-match)
 469                   (match identity)
 470                   (volatile)))
 471                (use-fast-directory
 472                 (anything-log "faster version (use-fast-directory)")
 473                 `((candidates . agp-candidates-synchronous-grep)
 474                   (match identity)
 475                   (volatile)))
 476                (t
 477                 (anything-log "normal version")
 478                 '((candidates . agp-candidates)
 479                   (delayed))))))
 480     source))
 481 (add-to-list 'anything-compile-source-functions 'anything-compile-source--grep-candidates)
 482
 483 (anything-document-attribute 'grep-candidates "grep-candidates plug-in"
 484   "grep-candidates plug-in provides anything-match-plugin.el feature with grep and head program.
 485 It is MUCH FASTER than normal match-plugin to search from vary large (> 1MB) candidates.
 486 Make sure to install these programs.
 487
 488 It expands `candidates' and `delayed' attributes.
 489
 490 `grep-candidates' attribute accepts a filename or list of filename.
 491 It also accepts 0-argument function name or variable name.")
 492
 493 ;; (anything '(((name . "grep-test")  (grep-candidates . "~/.emacs.el") (action . message))))
 494 ;; (let ((a "~/.emacs.el")) (anything '(((name . "grep-test")  (grep-candidates . a) (action . message) (delayed)))))
 495 ;; (let ((a "~/.emacs.el")) (anything '(((name . "grep-test")  (grep-candidates . (lambda () a)) (action . message) (delayed)))))
 496 ;; (anything '(((name . "grep-test")  (grep-candidates . "~/.emacs.el") (action . message) (delayed) (candidate-number-limit . 2))))
 497 ;; (let ((anything-candidate-number-limit 2)) (anything '(((name . "grep-test")  (grep-candidates . "~/.emacs.el") (action . message) (delayed)))))
 498
 499 ;;;; Compatibility
 500 (unless (fboundp 'apply-partially)
 501   (defun apply-partially (fun &rest args)
 502     "Return a function that is a partial application of FUN to ARGS.
 503 ARGS is a list of the first N arguments to pass to FUN.
 504 The result is a new function which does the same as FUN, except that
 505 the first N arguments are fixed at the values with which this function
 506 was called."
 507     (lexical-let ((fun fun) (args1 args))
 508       (lambda (&rest args2) (apply fun (append args1 args2))))))
 509
 510 ;;;; unit test
 511 ;; (install-elisp "http://www.emacswiki.org/cgi-bin/wiki/download/el-expectations.el")
 512 ;; (install-elisp "http://www.emacswiki.org/cgi-bin/wiki/download/el-mock.el")
 513 (dont-compile
 514   (when (fboundp 'expectations)
 515     (expectations
 516       (desc "amp-mp-make-regexps")
 517       (expect '("")
 518         (amp-mp-make-regexps ""))
 519       (expect '("foo" "bar")
 520         (amp-mp-make-regexps "foo bar"))
 521       (expect '("foo" "bar")
 522         (amp-mp-make-regexps " foo bar"))
 523       (expect '("foo" "bar")
 524         (amp-mp-make-regexps " foo bar "))
 525       (expect '("foo bar" "baz")
 526         (let ((anything-mp-space-regexp "\\\\ "))
 527           (amp-mp-make-regexps "foo\\ bar baz")))
 528       (desc "anything-mp-3-get-patterns-internal")
 529       (expect '((identity . "foo"))
 530         (anything-mp-3-get-patterns-internal "foo"))
 531       (expect '((identity . "foo") (identity . "bar"))
 532         (anything-mp-3-get-patterns-internal "foo bar"))
 533       (expect '((identity . "foo") (not . "bar"))
 534         (anything-mp-3-get-patterns-internal "foo !bar"))
 535       (desc "agp-command-line")
 536       (expect "grep -ih foo /f1"
 537         (agp-command-line "foo" '("/f1")))
 538       (expect "grep -ih foo /f1 | grep -ih bar"
 539         (agp-command-line "foo bar" '("/f1")))
 540       (expect "grep -ih foo /f1 | grep -ih -v bar"
 541         (agp-command-line "foo !bar" '("/f1")))
 542       (expect "grep -ih foo /f1 /f\\ 2 | grep -ih -v bar | grep -ih baz"
 543         (agp-command-line "foo !bar baz" '("/f1" "/f 2")))
 544       (expect (concat "grep -ih foo " (expand-file-name "~/.emacs.el"))
 545         (agp-command-line "foo" '("~/.emacs.el")))
 546       (expect "grep -ih f\\ o /f\\ 1"
 547         (agp-command-line "f  o" '("/f 1")))
 548       (expect "grep -ih foo /f1 | head -n 5"
 549         (agp-command-line "foo" '("/f1") 5))
 550       (expect "grep -ih foo /f1 | head -n 5 | nkf -w"
 551         (agp-command-line "foo" '("/f1") 5 "nkf -w"))
 552       (expect "cat /f1 | head -n 5 | nkf -w"
 553         (agp-command-line "" '("/f1") 5 "nkf -w"))
 554       (expect "tac /f1 | grep -ih foo"
 555         (agp-command-line "foo" '("/f1") nil nil t))
 556       (expect "tac /f1 | grep -ih foo | head -n 5 | nkf -w"
 557         (agp-command-line "foo" '("/f1") 5 "nkf -w" t))
 558       (expect "tac /f1 | head -n 5 | nkf -w"
 559         (agp-command-line "" '("/f1") 5 "nkf -w" t))
 560       (desc "anything-exact-match")
 561       (expect (non-nil)
 562         (anything-exact-match "thunder" "thunder"))
 563       (expect nil
 564         (anything-exact-match "thunder" "fire"))
 565       (desc "anything-exact-search")
 566       (expect (non-nil)
 567         (with-temp-buffer
 568           (insert "fire\nthunder\n")
 569           (goto-char 1)
 570           (anything-exact-search "thunder" nil t)))
 571       (expect (non-nil)
 572         (with-temp-buffer
 573           (insert "\nfire\nthunder\n")
 574           (goto-char 1)
 575           (anything-exact-search "fire" nil t)))
 576       (desc "anything-prefix-search")
 577       (expect (non-nil)
 578         (with-temp-buffer
 579           (insert "fire\nthunder\n")
 580           (goto-char (point-min))
 581           (anything-prefix-search "thund" nil t)))
 582       (expect nil
 583         (with-temp-buffer
 584           (insert "fire\nthunder\n")
 585           (goto-char (point-min))
 586           (anything-prefix-search "hund" nil t)))
 587       (desc "anything-prefix-search-backward")
 588       (expect (non-nil)
 589         (with-temp-buffer
 590           (insert "fire\nthunder\n")
 591           (goto-char (point-max))
 592           (anything-prefix-search-backward "thund" nil t)))
 593       (expect nil
 594         (with-temp-buffer
 595           (insert "fire\nthunder\n")
 596           (goto-char (point-max))
 597           (anything-prefix-search-backward "hund" nil t)))
 598       (desc "amp-mp-1-make-regexp")
 599       (expect "a.*b"
 600         (amp-mp-1-make-regexp "a b"))
 601       (expect "a b"
 602         (let ((anything-mp-space-regexp "\\\\ "))
 603           (amp-mp-1-make-regexp "a\\ b")))
 604       (expect "a.*b c"
 605         (let ((anything-mp-space-regexp "\\\\ "))
 606           (amp-mp-1-make-regexp "a b\\ c")))
 607       (expect ""
 608         (amp-mp-1-make-regexp ""))
 609       (desc "anything-mp-1-search")
 610       (expect (non-nil)
 611         (with-temp-buffer
 612           (insert "fire\nthunder\n")
 613           (goto-char 1)
 614           (anything-mp-1-search "th+ r" nil t)))
 615       (desc "anything-mp-2-search")
 616       (expect (non-nil)
 617         (with-temp-buffer
 618           (insert "fire\nthunder\n")
 619           (goto-char 1)
 620           (anything-mp-2-search "h+ r" nil t)))
 621       (expect nil
 622         (with-temp-buffer
 623           (insert "fire\nthunder\n")
 624           (goto-char 1)
 625           (anything-mp-2-search "th+ r" nil t)))
 626       (desc "anything-mp-3-search")
 627       (expect (non-nil)
 628         (with-temp-buffer
 629           (insert "fire\nthunder\n")
 630           (goto-char 1)
 631           (anything-mp-3-search "h+ r" nil t)))
 632       (expect (non-nil)
 633         (with-temp-buffer
 634           (insert "fire\nthunder\n")
 635           (goto-char 1)
 636           (anything-mp-3-search "th+ r" nil t)))
 637       (expect (non-nil)
 638         (with-temp-buffer
 639           (insert "fire\nthunder\n")
 640           (goto-char 1)
 641           (anything-mp-3-search "r th+" nil t)))
 642       (expect nil
 643         (with-temp-buffer
 644           (insert "fire\nthunder\n")
 645           (goto-char 1)
 646           (anything-mp-3-search "under hue" nil t)))
 647       (expect (non-nil)
 648         (with-temp-buffer
 649           (insert "fire\nthunder\n")
 650           (goto-char 1)
 651           (anything-mp-3-search "r th+ n" nil t)))
 652       (desc "anything-mp-3-search")
 653       (expect (non-nil)
 654         (with-temp-buffer
 655           (insert "fire\nthunder\n")
 656           (goto-char 1)
 657           (anything-mp-3-search "th der" nil t)))
 658       (expect nil
 659         (with-temp-buffer
 660           (insert "fire\nthunder\n")
 661           (goto-char 1)
 662           (anything-mp-3-search "th ders" nil t)))
 663       (desc "anything-mp-3-search not")
 664       (expect t
 665         (with-temp-buffer
 666           (insert "threshold\nthunder\n")
 667           (goto-char 1)
 668           (anything-mp-3-search "h !der" nil t)))
 669       (expect t
 670         (with-temp-buffer
 671           (insert "threshold\nthunder\n")
 672           (goto-char 1)
 673           (anything-mp-3-search "th !der" nil t)))
 674       (desc "anything-mp-3p-search")
 675       (expect (non-nil)
 676         (with-temp-buffer
 677           (insert "fire\nthunder\n")
 678           (goto-char 1)
 679           (anything-mp-3p-search "th der" nil t)))
 680       (expect nil
 681         (with-temp-buffer
 682           (insert "fire\nthunder\n")
 683           (goto-char 1)
 684           (anything-mp-3p-search "h ders" nil t)))
 685       (desc "anything-mp-3p-search not")
 686       (expect t
 687         (with-temp-buffer
 688           (insert "\nthreshold\nthunder\n")
 689           (goto-char 1)
 690           (anything-mp-3p-search "th !der" nil t)))
 691       (expect nil
 692         (with-temp-buffer
 693           (insert "threshold\nthunder\n")
 694           (goto-char 1)
 695           (anything-mp-3p-search "h !der" nil t)))
 696       (desc "anything-mp-3-search-backward")
 697       (expect (non-nil)
 698         (with-temp-buffer
 699           (insert "fire\nthunder\n")
 700           (goto-char (point-max))
 701           (anything-mp-3-search-backward "h der" nil t)))
 702       (expect nil
 703         (with-temp-buffer
 704           (insert "fire\nthunder\n")
 705           (goto-char (point-max))
 706           (anything-mp-3-search-backward "th ders" nil t)))
 707       (desc "anything-mp-3-search-backward not")
 708       (expect t
 709         (with-temp-buffer
 710           (insert "threshold\nthunder\n")
 711           (goto-char (point-max))
 712           (anything-mp-3-search-backward "h !der" nil t)))
 713       (expect t
 714         (with-temp-buffer
 715           (insert "threshold\nthunder\n")
 716           (goto-char (point-max))
 717           (anything-mp-3-search-backward "th !der" nil t)))
 718       (desc "anything-mp-3p-search-backward")
 719       (expect (non-nil)
 720         (with-temp-buffer
 721           (insert "fire\nthunder\n")
 722           (goto-char (point-max))
 723           (anything-mp-3p-search-backward "th der" nil t)))
 724       (expect nil
 725         (with-temp-buffer
 726           (insert "fire\nthunder\n")
 727           (goto-char (point-max))
 728           (anything-mp-3p-search-backward "h der" nil t)))
 729       (desc "anything-mp-3p-search-backward not")
 730       (expect t
 731         (with-temp-buffer
 732           (insert "\nthreshold\nthunder\n")
 733           (goto-char (point-max))
 734           (anything-mp-3p-search-backward "th !der" nil t)))
 735       (expect nil
 736         (with-temp-buffer
 737           (insert "threshold\nthunder\n")
 738           (goto-char (point-max))
 739           (anything-mp-3p-search-backward "h !der" nil t)))
 740       (desc "anything-mp-1-match")
 741       (expect (non-nil)
 742         (anything-mp-1-match "thunder" "th+ r"))
 743       (desc "anything-mp-2-match")
 744       (expect (non-nil)
 745         (anything-mp-2-match "thunder" "h+ r"))
 746       (expect nil
 747         (anything-mp-2-match "thunder" "th+ r"))
 748       (desc "anything-mp-3-match")
 749       (expect (non-nil)
 750         (anything-mp-3-match "thunder" "h+ r"))
 751       (expect (non-nil)
 752         (anything-mp-3-match "thunder" "th+ r"))
 753       (expect (non-nil)
 754         (anything-mp-3-match "thunder" "r th+"))
 755       (expect nil
 756         (anything-mp-3-match "thunder" "under hue"))
 757       (expect (non-nil)
 758         (anything-mp-3-match "thunder" "r th+ n"))
 759       (desc "anything-mp-3-match not")
 760       (expect (non-nil)
 761         (anything-mp-3-match "threshold" "th !der"))
 762       (desc "anything-prefix-match")
 763       (expect (non-nil)
 764         (anything-prefix-match "fobar" "fo"))
 765       (expect nil
 766         (anything-prefix-match "xfobar" "fo"))
 767
 768       (desc "anything-mp-3-match")
 769       (expect (non-nil)
 770         (anything-mp-3-match "thunder" "h der"))
 771       (expect nil
 772         (anything-mp-3-match "thunder" "h ders"))
 773       (desc "anything-mp-3p-match")
 774       (expect (non-nil)
 775         (anything-mp-3p-match "thunder" "th der"))
 776       (expect nil
 777         (anything-mp-3p-match "thunder" "h der"))
 778       (desc "anything-mp-3p-match not")
 779       (expect (non-nil)
 780         (anything-mp-3p-match "threshold" "th !der"))
 781       (expect nil
 782         (anything-mp-3p-match "threshold" "h !der"))
 783       (desc "with identity match")
 784       (expect '(identity)
 785         (assoc-default 'match
 786                        (car (anything-compile-sources
 787                              '(((name . "FOO")
 788                                 (candidates-in-buffer)))
 789                              '(anything-compile-source--candidates-in-buffer
 790                                anything-compile-source--match-plugin)))))
 791       (expect '(identity)
 792         (assoc-default 'match
 793                        (car (anything-compile-sources
 794                              '(((name . "FOO")
 795                                 (match identity)))
 796                              '(anything-compile-source--match-plugin)))))
 797       (desc "functional")
 798       (expect '(("FOO" ("thunder")))
 799         (anything-test-candidates '(((name . "FOO")
 800                                      (candidates "fire" "thunder")))
 801                                   "th r"
 802                                   '(anything-compile-source--match-plugin)))
 803       (expect '(("FOO" ("one two")))
 804         (let ((anything-mp-space-regexp "\\\\ "))
 805           (anything-test-candidates '(((name . "FOO")
 806                                        (candidates "one two" "three four")))
 807                                     "e\\ t"
 808                                     '(anything-compile-source--match-plugin))))
 809       (expect '(("FOO" ("one two")))
 810         (let ((anything-mp-space-regexp "  "))
 811           (anything-test-candidates '(((name . "FOO")
 812                                        (candidates "one two" "three four")))
 813                                     "e  t"
 814                                     '(anything-compile-source--match-plugin))))
 815       (expect '(("FOO" ("thunder")))
 816         (anything-test-candidates '(((name . "FOO")
 817                                      (init
 818                                       . (lambda ()
 819                                           (with-current-buffer (anything-candidate-buffer 'global)
 820                                             (insert "fire\nthunder\nthanks\n"))))
 821                                      (candidates-in-buffer)))
 822                                   "th r"
 823                                   '(anything-compile-source--candidates-in-buffer
 824                                     anything-compile-source--match-plugin)))
 825       (expect '(("FOO" ("foo" "foobar")))
 826         (anything-test-candidates '(((name . "FOO")
 827                                      (candidates "foobar" "foo")))
 828                                   "foo"
 829                                   '(anything-compile-source--match-plugin)))
 830       (expect '(("FOO" ("foo" "foobar")))
 831         (anything-test-candidates '(((name . "FOO")
 832                                      (init
 833                                       . (lambda ()
 834                                           (with-current-buffer (anything-candidate-buffer 'global)
 835                                             (insert "foobar\nfoo\n"))))
 836                                      (candidates-in-buffer)))
 837                                   "foo"
 838                                   '(anything-compile-source--candidates-in-buffer
 839                                     anything-compile-source--match-plugin)))
 840       (expect '(("FOO" ("foo")))
 841         (anything-test-candidates '(((name . "FOO")
 842                                      (init
 843                                       . (lambda ()
 844                                           (with-current-buffer (anything-candidate-buffer 'global)
 845                                             (insert "foo\n"))))
 846                                      (candidates-in-buffer)))
 847                                   "foo"
 848                                   '(anything-compile-source--candidates-in-buffer
 849                                     anything-compile-source--match-plugin)))
 850       (expect '(("FOO" ("foo")))
 851         (anything-test-candidates '(((name . "FOO")
 852                                      (init
 853                                       . (lambda ()
 854                                           (with-current-buffer (anything-candidate-buffer 'global)
 855                                             (insert "bar\nfoo\ntest\n"))))
 856                                      (candidates-in-buffer)))
 857                                   "foo"
 858                                   '(anything-compile-source--candidates-in-buffer
 859                                     anything-compile-source--match-plugin)))
 860       (expect '(("FOO" ("foobar" "foo")))
 861         (anything-test-candidates '(((name . "FOO")
 862                                      (init
 863                                       . (lambda ()
 864                                           (with-current-buffer (anything-candidate-buffer 'global)
 865                                             (insert "foobar\nfoo\n"))))
 866                                      (candidates-in-buffer)))
 867                                   ""
 868                                   '(anything-compile-source--candidates-in-buffer
 869                                     anything-compile-source--match-plugin)))
 870       (expect '(("FOO" ("foo" "foobar")))
 871         (anything-test-candidates '(((name . "FOO")
 872                                      (init
 873                                       . (lambda ()
 874                                           (with-current-buffer (anything-candidate-buffer 'global)
 875                                             (insert "foobar\nfoo\n"))))
 876                                      (candidates-in-buffer)
 877                                      (search-from-end)))
 878                                   "foo"
 879                                   '(anything-compile-source--candidates-in-buffer
 880                                     anything-compile-source--match-plugin)))
 881       (expect '(("FOO" ("elisp" "elp")))
 882         (anything-test-candidates '(((name . "FOO")
 883                                      (init
 884                                       . (lambda ()
 885                                           (with-current-buffer (anything-candidate-buffer 'global)
 886                                             (insert "elp\nelisp\n"))))
 887                                      (candidates-in-buffer)
 888                                      (search-from-end)))
 889                                   "el p"
 890                                   '(anything-compile-source--candidates-in-buffer
 891                                     anything-compile-source--match-plugin)))
 892       (expect '(("FOO" ("elisp" )))
 893         (anything-test-candidates '(((name . "FOO")
 894                                      (init
 895                                       . (lambda ()
 896                                           (with-current-buffer (anything-candidate-buffer 'global)
 897                                             (insert "elp\nelisp\n"))))
 898                                      (candidates-in-buffer)
 899                                      (search-from-end)))
 900                                   "el+ isp"
 901                                   '(anything-compile-source--candidates-in-buffer
 902                                     anything-compile-source--match-plugin)))
 903       ;; prefix multi -> multi
 904       (expect '(("FOO" ("elisp-info" "info.el")))
 905         (anything-test-candidates '(((name . "FOO")
 906                                      (init
 907                                       . (lambda ()
 908                                           (with-current-buffer (anything-candidate-buffer 'global)
 909                                             (insert "info.el\nelisp-info\n"))))
 910                                      (candidates-in-buffer)
 911                                      ))
 912                                   "el info"
 913                                   '(anything-compile-source--candidates-in-buffer
 914                                     anything-compile-source--match-plugin)))
 915       ;; multi not
 916       (expect '(("FOO" ("info.el")))
 917         (anything-test-candidates '(((name . "FOO")
 918                                      (init
 919                                       . (lambda ()
 920                                           (with-current-buffer (anything-candidate-buffer 'global)
 921                                             (insert "info.el\nelisp-info\n"))))
 922                                      (candidates-in-buffer)
 923                                      ))
 924                                   "info !elisp"
 925                                   '(anything-compile-source--candidates-in-buffer
 926                                     anything-compile-source--match-plugin)))
 927       ;; anything-mp-match-source-name
 928       (expect '(("SourceName" ("foo")))
 929         (let ((anything-mp-match-source-name t))
 930           (anything-test-candidates '(((name . "SourceName")
 931                                        (candidates "foo" "bar")))
 932                                     "source f"
 933                                     '(anything-compile-source--match-plugin))))
 934       (expect '(("SourceName cib" ("foo")))
 935         (let ((anything-mp-match-source-name t))
 936           (anything-test-candidates '(((name . "SourceName cib")
 937                                        (init
 938                                         . (lambda ()
 939                                             (with-current-buffer (anything-candidate-buffer 'global)
 940                                               (insert "foo\nbar\n"))))
 941                                        (candidates-in-buffer)))
 942                                     "source f"
 943                                     '(anything-compile-source--candidates-in-buffer
 944                                       anything-compile-source--match-plugin))))
 945       (expect '(("SourceName cib search-from-end" ("bar")))
 946         (let ((anything-mp-match-source-name t))
 947           (anything-test-candidates '(((name . "SourceName cib search-from-end")
 948                                        (init
 949                                         . (lambda ()
 950                                             (with-current-buffer (anything-candidate-buffer 'global)
 951                                               (insert "foo\nbar\n"))))
 952                                        (search-from-end)
 953                                        (candidates-in-buffer)))
 954                                     "source b"
 955                                     '(anything-compile-source--candidates-in-buffer
 956                                       anything-compile-source--match-plugin))))
 957       (expect '(("SourceName" ("foo" "bar")))
 958         (let ((anything-mp-match-source-name t))
 959           (anything-test-candidates '(((name . "SourceName")
 960                                        (candidates "foo" "bar")))
 961                                     "source ."
 962                                     '(anything-compile-source--match-plugin))))
 963       (expect '(("SourceName cib" ("foo" "bar")))
 964         (let ((anything-mp-match-source-name t))
 965           (anything-test-candidates '(((name . "SourceName cib")
 966                                        (init
 967                                         . (lambda ()
 968                                             (with-current-buffer (anything-candidate-buffer 'global)
 969                                               (insert "foo\nbar\n"))))
 970                                        (candidates-in-buffer)))
 971                                     "source ."
 972                                     '(anything-compile-source--candidates-in-buffer
 973                                       anything-compile-source--match-plugin))))
 974       (expect '(("SourceName cib search-from-end" ("bar" "foo")))
 975         (let ((anything-mp-match-source-name t))
 976           (anything-test-candidates '(((name . "SourceName cib search-from-end")
 977                                        (init
 978                                         . (lambda ()
 979                                             (with-current-buffer (anything-candidate-buffer 'global)
 980                                               (insert "foo\nbar\n"))))
 981                                        (search-from-end)
 982                                        (candidates-in-buffer)))
 983                                     "source ."
 984                                     '(anything-compile-source--candidates-in-buffer
 985                                       anything-compile-source--match-plugin))))
 986       )))
 987 ;; (anything-compile-sources '(((name . "test"))) anything-compile-source-functions)
 988 (provide 'anything-match-plugin)
 989
 990 ;; How to save (DO NOT REMOVE!!)
 991 ;; (progn (magit-push) (emacswiki-post "anything-match-plugin.el"))
 992 ;;; anything-match-plugin.el ends here