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