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 (let ((version "1.283"))
 158   (when (and (string= "1." (substring version 0 2))
 159              (string-match "1\.\\([0-9]+\\)" anything-version)
 160              (< (string-to-number (match-string 1 anything-version))
 161                 (string-to-number (substring version 2))))
 162     (error "Please update anything.el!!
 163
 164 http://www.emacswiki.org/cgi-bin/wiki/download/anything.el
 165
 166 or  M-x install-elisp-from-emacswiki anything.el")))
 167
 168 (defcustom anything-grep-candidates-fast-directory-regexp nil
 169   "*Directory regexp where a RAM disk (or tmpfs) is mounted.
 170
 171 If non-nil, grep-candidates plugin gets faster because it uses
 172 grep as synchronous process.
 173
 174 ex. (setq anything-grep-candidates-fast-directory-regexp \"^/tmp/\")"
 175   :type 'string
 176   :group 'anything)
 177
 178 ;;;; multiple patterns
 179 (defvar anything-use-multiple-patterns t
 180   "If non-nil, enable anything-use-multiple-patterns.")
 181 (defvar anything-mp-space-regexp "[\\ ] "
 182   "Regexp to represent space itself in multiple regexp match.")
 183 (defvar anything-mp-match-source-name t
 184   "If non-nil, first query in space-delimited pattern try to match the source name.
 185 It needs at least two queries.
 186 For example, to list candidats of \"foo\" source, input pattern as \"foo .\".")
 187
 188 (defun amp-mp-make-regexps (pattern)
 189   (if (string= pattern "") '("")
 190     (loop for s in (split-string
 191                     (replace-regexp-in-string anything-mp-space-regexp
 192                                               "\000\000" pattern) " " t)
 193         collect (replace-regexp-in-string "\000\000" " " s))))
 194
 195 (defun amp-mp-1-make-regexp (pattern)
 196   (mapconcat 'identity (amp-mp-make-regexps pattern) ".*"))
 197
 198 (defmacro amp-define-memoizer (prefix pattern-expr)
 199   (let ((pattern-str (intern (concat prefix "pattern-str")))
 200         (pattern-real (intern (concat prefix "pattern-real")))
 201         (get-pattern (intern (concat prefix "get-pattern"))))
 202     `(progn
 203        (defvar ,pattern-str nil)
 204        (defvar ,pattern-real nil)
 205        (defsubst ,get-pattern (pattern)
 206          (unless (equal pattern ,pattern-str)
 207            (setq ,pattern-str pattern
 208                  ,pattern-real ,pattern-expr))
 209          ,pattern-real))))
 210
 211 (defmacro amp-define (prefix pattern-expr)
 212   (let ((get-pattern (intern (concat prefix "get-pattern")))
 213         (match (intern (concat prefix "match")))
 214         (search (intern (concat prefix "search")))
 215         (search-backward (intern (concat prefix "search-backward"))))
 216     `(progn
 217        (amp-define-memoizer ,prefix ,pattern-expr)
 218        (defun* ,match (str &optional (pattern anything-pattern))
 219          (string-match (,get-pattern pattern) str))
 220        (defun ,search (pattern &rest ignore)
 221          (re-search-forward (,get-pattern pattern) nil t))
 222        (defun ,search-backward (pattern &rest ignore)
 223          (re-search-backward (,get-pattern pattern) nil t)))))
 224
 225 ;; exact match
 226 ;(amp-define "anything-exact-" (concat (anything-prefix-get-pattern pattern) "$"))
 227 (amp-define-memoizer "anything-exact-" (concat "\n" pattern "\n"))
 228 (defun anything-exact-match (str &optional pattern)
 229   (string= str (or pattern anything-pattern)))
 230 (defun anything-exact-search (pattern &rest ignore)
 231   (and (search-forward (anything-exact-get-pattern pattern) nil t)
 232        (forward-line -1)))
 233 (defun anything-exact-search-backward (pattern &rest ignore)
 234   (and (search-backward (anything-exact-get-pattern pattern) nil t)
 235        (forward-line 1)))
 236 ;; prefix match
 237 ;;(amp-define "anything-prefix-" (concat "^" (regexp-quote pattern)))
 238 (amp-define-memoizer "anything-prefix-" (concat "\n" pattern))
 239 (defun anything-prefix-match (str &optional pattern)
 240   (setq pattern (or pattern anything-pattern))
 241   (let ((len (length pattern)))
 242     (and (<= len (length str))
 243          (string= (substring str 0 len) pattern ))))
 244 (defun anything-prefix-search (pattern &rest ignore)
 245   (search-forward (anything-prefix-get-pattern pattern) nil t))
 246 (defun anything-prefix-search-backward (pattern &rest ignore)
 247   (and (search-backward (anything-prefix-get-pattern pattern) nil t)
 248        (forward-line 1)))
 249 ;; multiple regexp patterns 1 (order is preserved / prefix)
 250 (amp-define "anything-mp-1-" (concat "^" (amp-mp-1-make-regexp pattern)))
 251 ;; multiple regexp patterns 2 (order is preserved / partial)
 252 (amp-define "anything-mp-2-" (concat "^.+" (amp-mp-1-make-regexp pattern)))
 253
 254 ;;;; multiple regexp patterns 3 (permutation)
 255 (defvar anything-mp-3-pattern-str nil)
 256 (defvar anything-mp-3-pattern-list nil)
 257 (defsubst anything-mp-3-get-patterns (pattern)
 258   (unless (equal pattern anything-mp-3-pattern-str)
 259     (setq anything-mp-3-pattern-str pattern
 260           anything-mp-3-pattern-list
 261           (anything-mp-3-get-patterns-internal pattern)))
 262   anything-mp-3-pattern-list)
 263 (defun anything-mp-3-get-patterns-internal (pattern)
 264   (loop for pat in (amp-mp-make-regexps pattern)
 265         collect (if (string= "!" (substring pat 0 1))
 266                             (cons 'not (substring pat 1))
 267                           (cons 'identity pat))))
 268 (defun anything-mp-handle-source-name-maybe (pattern self else)
 269   (when (stringp pattern)
 270     (setq pattern (anything-mp-3-get-patterns pattern)))
 271   ;; PATTERN is list of (pred . re) now.
 272   (when pattern
 273     (destructuring-bind ((first-pred . first-re) . rest) pattern
 274       (if (and anything-mp-match-source-name
 275                (stringp anything-source-name)
 276                (eq 'identity first-pred))
 277           (let (anything-mp-match-source-name)
 278             (or (and (string-match first-re anything-source-name)
 279                      (funcall self rest))
 280                 (funcall self pattern)))
 281         (funcall else)))))
 282
 283 (defun* anything-mp-3-match (str &optional (pattern anything-pattern))
 284   (anything-mp-handle-source-name-maybe
 285    pattern (apply-partially 'anything-mp-3-match str)
 286    (lambda ()
 287      (loop for (pred . re) in pattern
 288            always (funcall pred (string-match re str))))))
 289
 290 (defmacro anything-mp-3-search-base (searchfn1 searchfn2 b e)
 291   `(loop with pat = (if (stringp pattern)
 292                         (anything-mp-3-get-patterns pattern)
 293                       pattern)
 294          while (,searchfn1 (or (cdar pat) "") nil t)
 295          for bol = (point-at-bol)
 296          for eol = (point-at-eol)
 297          if (loop
 298              for (pred . s) in (cdr pat)
 299              always (progn (goto-char ,b)
 300                            (funcall pred (,searchfn2 s ,e t))))
 301          do (goto-char ,e) (return t)
 302          else do
 303          (goto-char ,e)
 304          finally (return nil)))
 305
 306 (defun anything-mp-3-search (pattern &rest ignore)
 307   (anything-mp-handle-source-name-maybe
 308    pattern 'anything-mp-3-search
 309    (lambda () (anything-mp-3-search-base
 310                re-search-forward re-search-forward bol eol))))
 311 (defun anything-mp-3-search-backward (pattern &rest ignore)
 312   (anything-mp-handle-source-name-maybe
 313    pattern 'anything-mp-3-search-backward
 314    (lambda () (anything-mp-3-search-base
 315                re-search-backward re-search-backward eol bol))))
 316 ;; mp-3p- (multiple regexp pattern 3 with prefix search)
 317 (defun* anything-mp-3p-match (str &optional (pattern anything-pattern))
 318   (anything-mp-handle-source-name-maybe
 319    pattern (apply-partially 'anything-mp-3p-match str)
 320    (lambda ()
 321      (declare (special first-pred first-re))
 322      (and (funcall first-pred (anything-prefix-match str first-re))
 323           (loop for (pred . re) in rest
 324                 always (funcall pred (string-match re str)))))))
 325
 326 (defun anything-mp-3p-search (pattern &rest ignore)
 327   (anything-mp-handle-source-name-maybe
 328    pattern 'anything-mp-3p-search
 329    (lambda () (anything-mp-3-search-base
 330                anything-prefix-search re-search-forward bol eol))))
 331
 332 (defun anything-mp-3p-search-backward (pattern &rest ignore)
 333   (anything-mp-handle-source-name-maybe
 334    pattern 'anything-mp-3p-search-backward
 335    (lambda () (anything-mp-3-search-base
 336                anything-prefix-search-backward re-search-backward eol bol))))
 337
 338 ;;;; Highlight matches
 339 (defface anything-match
 340   '((t (:inherit match)))
 341   "Face used to highlight matches."
 342   :group 'anything)
 343
 344 (defvar anything-mp-highlight-delay 0.7
 345   "Highlight matches with `anything-match' face after this many seconds.
 346  If nil, no highlight. ")
 347
 348 (defvar anything-mp-highlight-threshold 2
 349   "Minimum length of pattern to highlight.
 350 The smaller  this value is, the slower highlight is.")
 351
 352 (defun anything-mp-highlight-match ()
 353   "Highlight matches after `anything-mp-highlight-delay' seconds."
 354   (when (and anything-mp-highlight-delay
 355              (not (string= anything-pattern "")))
 356     (anything-mp-highlight-match-internal (window-end (anything-window)))
 357     (run-with-idle-timer anything-mp-highlight-delay nil
 358                          'anything-mp-highlight-match-internal
 359                          (with-current-buffer anything-buffer (point-max)))))
 360 (add-hook 'anything-update-hook 'anything-mp-highlight-match)
 361
 362 (defun anything-mp-highlight-region (start end regexp face)
 363   (save-excursion
 364     (goto-char start)
 365     (let (me)
 366       (while (and (setq me (re-search-forward regexp nil t))
 367                   (< (point) end)
 368                   (< 0 (- (match-end 0) (match-beginning 0))))
 369         (put-text-property (match-beginning 0) me 'face face)))))
 370
 371 (defun* anything-mp-highlight-match-internal (end)
 372   (when (anything-window)
 373     (set-buffer anything-buffer)
 374     (let ((requote (regexp-quote anything-pattern)))
 375       (when (>= (length requote) anything-mp-highlight-threshold)
 376         (anything-mp-highlight-region (point-min) end
 377                                     requote 'anything-match)))
 378     (loop for (pred . re) in (anything-mp-3-get-patterns anything-pattern)
 379           when (and (eq pred 'identity)
 380                     (>= (length re) anything-mp-highlight-threshold))
 381           do
 382           (anything-mp-highlight-region (point-min) end re 'anything-match))))
 383
 384 ;;;; source compier
 385 (defvar anything-mp-default-match-functions
 386   '(anything-exact-match anything-mp-3p-match anything-mp-3-match))
 387 (defvar anything-mp-default-search-functions
 388   '(anything-exact-search anything-mp-3p-search anything-mp-3-search))
 389 (defvar anything-mp-default-search-backward-functions
 390   '(anything-exact-search-backward anything-mp-3p-search-backward
 391                                    anything-mp-3-search-backward))
 392 (defun anything-compile-source--match-plugin (source)
 393   (let ((searchers (if (assoc 'search-from-end source)
 394                        anything-mp-default-search-backward-functions
 395                      anything-mp-default-search-functions)))
 396     `(,(if (or (assoc 'candidates-in-buffer source)
 397                (equal '(identity) (assoc-default 'match source)))
 398            '(match identity)
 399          `(match ,@anything-mp-default-match-functions
 400                  ,@(assoc-default 'match source)))
 401       (search ,@searchers
 402               ,@(assoc-default 'search source))
 403       ,@source)))
 404
 405 (add-to-list 'anything-compile-source-functions 'anything-compile-source--match-plugin t)
 406
 407 ;;;; grep-candidates plug-in
 408 (defun agp-candidates (&optional filter)
 409   "Normal version of grep-candidates candidates function.
 410 Grep is run by asynchronous process."
 411   (start-process-shell-command "anything-grep-candidates" nil
 412                                (agp-command-line-2 filter)))
 413 (defun agp-candidates-synchronous-grep (&optional filter)
 414   "Faster version of grep-candidates candidates function.
 415 Grep is run by synchronous process.
 416 It is faster when candidate files are in ramdisk."
 417   (split-string (shell-command-to-string (agp-command-line-2 filter)) "\n"))
 418 (defun agp-candidates-synchronous-grep--direct-insert-match (&optional filter)
 419   "[EXPERIMENTAL]Fastest version of grep-candidates candidates function at the cost of absense of transformers.
 420 Grep is run by synchronous process.
 421 It is faster when candidate files are in ramdisk.
 422
 423 If (direct-insert-match) is in the source, this function is used."
 424   (with-current-buffer (anything-candidate-buffer 'global)
 425     (call-process-shell-command (agp-command-line-2 filter) nil t)))
 426
 427 (defun agp-command-line (query files &optional limit filter)
 428   "Build command line used by grep-candidates from QUERY, FILES, LIMIT, and FILTER."
 429   (with-temp-buffer
 430     (if (string= query "")
 431         (insert "cat "
 432                 (mapconcat
 433                  (lambda (f) (shell-quote-argument (expand-file-name f)))
 434                  files " "))
 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 (zerop i)
 444               (insert " "
 445                       (mapconcat (lambda (f) (shell-quote-argument
 446                                               (expand-file-name f)))
 447                                  files " ")))))
 448     (when limit (insert (format " | head -n %d" limit)))
 449     (when filter (insert " | " filter))
 450     (buffer-string)))
 451 (defun agp-command-line-2 (filter)
 452   "Build command line used by grep-candidates from FILTER and current source."
 453   (agp-command-line
 454    anything-pattern
 455    (anything-mklist (anything-interpret-value (anything-attr 'grep-candidates)))
 456    (anything-candidate-number-limit (anything-get-current-source))
 457    filter))
 458 (defun anything-compile-source--grep-candidates (source)
 459   (anything-aif (assoc-default 'grep-candidates source)
 460       (append
 461        source
 462        (let ((use-fast-directory
 463               (string-match
 464                anything-grep-candidates-fast-directory-regexp
 465                (or (car (anything-mklist (anything-interpret-value it))) ""))))
 466          (cond ((not (anything-interpret-value it)) nil)
 467                ((and use-fast-directory (assq 'direct-insert-match source))
 468                 (anything-log "fastest version (use-fast-directory and direct-insert-match)")
 469                 `((candidates . agp-candidates-synchronous-grep--direct-insert-match)
 470                   (match identity)
 471                   (volatile)
 472                   (requires-pattern)))
 473                (use-fast-directory
 474                 (anything-log "faster version (use-fast-directory)")
 475                 `((candidates . agp-candidates-synchronous-grep)
 476                   (match identity)
 477                   (volatile)
 478                   (requires-pattern)))
 479                (t
 480                 (anything-log "normal version")
 481                 '((candidates . agp-candidates)
 482                   (delayed))))))
 483     source))
 484 (add-to-list 'anything-compile-source-functions 'anything-compile-source--grep-candidates)
 485
 486 (anything-document-attribute 'grep-candidates "grep-candidates plug-in"
 487   "grep-candidates plug-in provides anything-match-plugin.el feature with grep and head program.
 488 It is MUCH FASTER than normal match-plugin to search from vary large (> 1MB) candidates.
 489 Make sure to install these programs.
 490
 491 It expands `candidates' and `delayed' attributes.
 492
 493 `grep-candidates' attribute accepts a filename or list of filename.
 494 It also accepts 0-argument function name or variable name.")
 495
 496 ;; (anything '(((name . "grep-test")  (grep-candidates . "~/.emacs.el") (action . message))))
 497 ;; (let ((a "~/.emacs.el")) (anything '(((name . "grep-test")  (grep-candidates . a) (action . message) (delayed)))))
 498 ;; (let ((a "~/.emacs.el")) (anything '(((name . "grep-test")  (grep-candidates . (lambda () a)) (action . message) (delayed)))))
 499 ;; (anything '(((name . "grep-test")  (grep-candidates . "~/.emacs.el") (action . message) (delayed) (candidate-number-limit . 2))))
 500 ;; (let ((anything-candidate-number-limit 2)) (anything '(((name . "grep-test")  (grep-candidates . "~/.emacs.el") (action . message) (delayed)))))
 501
 502 ;;;; Compatibility
 503 (unless (fboundp 'apply-partially)
 504   (defun apply-partially (fun &rest args)
 505     "Return a function that is a partial application of FUN to ARGS.
 506 ARGS is a list of the first N arguments to pass to FUN.
 507 The result is a new function which does the same as FUN, except that
 508 the first N arguments are fixed at the values with which this function
 509 was called."
 510     (lexical-let ((fun fun) (args1 args))
 511       (lambda (&rest args2) (apply fun (append args1 args2))))))
 512
 513 ;;;; unit test
 514 ;; (install-elisp "http://www.emacswiki.org/cgi-bin/wiki/download/el-expectations.el")
 515 ;; (install-elisp "http://www.emacswiki.org/cgi-bin/wiki/download/el-mock.el")
 516 (dont-compile
 517   (when (fboundp 'expectations)
 518     (expectations
 519       (desc "amp-mp-make-regexps")
 520       (expect '("")
 521         (amp-mp-make-regexps ""))
 522       (expect '("foo" "bar")
 523         (amp-mp-make-regexps "foo bar"))
 524       (expect '("foo" "bar")
 525         (amp-mp-make-regexps " foo bar"))
 526       (expect '("foo" "bar")
 527         (amp-mp-make-regexps " foo bar "))
 528       (expect '("foo bar" "baz")
 529         (let ((anything-mp-space-regexp "\\\\ "))
 530           (amp-mp-make-regexps "foo\\ bar baz")))
 531       (desc "anything-mp-3-get-patterns-internal")
 532       (expect '((identity . "foo"))
 533         (anything-mp-3-get-patterns-internal "foo"))
 534       (expect '((identity . "foo") (identity . "bar"))
 535         (anything-mp-3-get-patterns-internal "foo bar"))
 536       (expect '((identity . "foo") (not . "bar"))
 537         (anything-mp-3-get-patterns-internal "foo !bar"))
 538       (desc "agp-command-line")
 539       (expect "grep -ih foo /f1"
 540         (agp-command-line "foo" '("/f1")))
 541       (expect "grep -ih foo /f1 | grep -ih bar"
 542         (agp-command-line "foo bar" '("/f1")))
 543       (expect "grep -ih foo /f1 | grep -ih -v bar"
 544         (agp-command-line "foo !bar" '("/f1")))
 545       (expect "grep -ih foo /f1 /f\\ 2 | grep -ih -v bar | grep -ih baz"
 546         (agp-command-line "foo !bar baz" '("/f1" "/f 2")))
 547       (expect (concat "grep -ih foo " (expand-file-name "~/.emacs.el"))
 548         (agp-command-line "foo" '("~/.emacs.el")))
 549       (expect "grep -ih f\\ o /f\\ 1"
 550         (agp-command-line "f  o" '("/f 1")))
 551       (expect "grep -ih foo /f1 | head -n 5"
 552         (agp-command-line "foo" '("/f1") 5))
 553       (expect "grep -ih foo /f1 | head -n 5 | nkf -w"
 554         (agp-command-line "foo" '("/f1") 5 "nkf -w"))
 555       (desc "anything-exact-match")
 556       (expect (non-nil)
 557         (anything-exact-match "thunder" "thunder"))
 558       (expect nil
 559         (anything-exact-match "thunder" "fire"))
 560       (desc "anything-exact-search")
 561       (expect (non-nil)
 562         (with-temp-buffer
 563           (insert "fire\nthunder\n")
 564           (goto-char 1)
 565           (anything-exact-search "thunder" nil t)))
 566       (expect (non-nil)
 567         (with-temp-buffer
 568           (insert "\nfire\nthunder\n")
 569           (goto-char 1)
 570           (anything-exact-search "fire" nil t)))
 571       (desc "anything-prefix-search")
 572       (expect (non-nil)
 573         (with-temp-buffer
 574           (insert "fire\nthunder\n")
 575           (goto-char (point-min))
 576           (anything-prefix-search "thund" nil t)))
 577       (expect nil
 578         (with-temp-buffer
 579           (insert "fire\nthunder\n")
 580           (goto-char (point-min))
 581           (anything-prefix-search "hund" nil t)))
 582       (desc "anything-prefix-search-backward")
 583       (expect (non-nil)
 584         (with-temp-buffer
 585           (insert "fire\nthunder\n")
 586           (goto-char (point-max))
 587           (anything-prefix-search-backward "thund" nil t)))
 588       (expect nil
 589         (with-temp-buffer
 590           (insert "fire\nthunder\n")
 591           (goto-char (point-max))
 592           (anything-prefix-search-backward "hund" nil t)))
 593       (desc "amp-mp-1-make-regexp")
 594       (expect "a.*b"
 595         (amp-mp-1-make-regexp "a b"))
 596       (expect "a b"
 597         (let ((anything-mp-space-regexp "\\\\ "))
 598           (amp-mp-1-make-regexp "a\\ b")))
 599       (expect "a.*b c"
 600         (let ((anything-mp-space-regexp "\\\\ "))
 601           (amp-mp-1-make-regexp "a b\\ c")))
 602       (expect ""
 603         (amp-mp-1-make-regexp ""))
 604       (desc "anything-mp-1-search")
 605       (expect (non-nil)
 606         (with-temp-buffer
 607           (insert "fire\nthunder\n")
 608           (goto-char 1)
 609           (anything-mp-1-search "th+ r" nil t)))
 610       (desc "anything-mp-2-search")
 611       (expect (non-nil)
 612         (with-temp-buffer
 613           (insert "fire\nthunder\n")
 614           (goto-char 1)
 615           (anything-mp-2-search "h+ r" nil t)))
 616       (expect nil
 617         (with-temp-buffer
 618           (insert "fire\nthunder\n")
 619           (goto-char 1)
 620           (anything-mp-2-search "th+ r" nil t)))
 621       (desc "anything-mp-3-search")
 622       (expect (non-nil)
 623         (with-temp-buffer
 624           (insert "fire\nthunder\n")
 625           (goto-char 1)
 626           (anything-mp-3-search "h+ r" nil t)))
 627       (expect (non-nil)
 628         (with-temp-buffer
 629           (insert "fire\nthunder\n")
 630           (goto-char 1)
 631           (anything-mp-3-search "th+ 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 "r th+" nil t)))
 637       (expect nil
 638         (with-temp-buffer
 639           (insert "fire\nthunder\n")
 640           (goto-char 1)
 641           (anything-mp-3-search "under hue" nil t)))
 642       (expect (non-nil)
 643         (with-temp-buffer
 644           (insert "fire\nthunder\n")
 645           (goto-char 1)
 646           (anything-mp-3-search "r th+ n" nil t)))
 647       (desc "anything-mp-3-search")
 648       (expect (non-nil)
 649         (with-temp-buffer
 650           (insert "fire\nthunder\n")
 651           (goto-char 1)
 652           (anything-mp-3-search "th der" nil t)))
 653       (expect nil
 654         (with-temp-buffer
 655           (insert "fire\nthunder\n")
 656           (goto-char 1)
 657           (anything-mp-3-search "th ders" nil t)))
 658       (desc "anything-mp-3-search not")
 659       (expect t
 660         (with-temp-buffer
 661           (insert "threshold\nthunder\n")
 662           (goto-char 1)
 663           (anything-mp-3-search "h !der" nil t)))
 664       (expect t
 665         (with-temp-buffer
 666           (insert "threshold\nthunder\n")
 667           (goto-char 1)
 668           (anything-mp-3-search "th !der" nil t)))
 669       (desc "anything-mp-3p-search")
 670       (expect (non-nil)
 671         (with-temp-buffer
 672           (insert "fire\nthunder\n")
 673           (goto-char 1)
 674           (anything-mp-3p-search "th der" nil t)))
 675       (expect nil
 676         (with-temp-buffer
 677           (insert "fire\nthunder\n")
 678           (goto-char 1)
 679           (anything-mp-3p-search "h ders" nil t)))
 680       (desc "anything-mp-3p-search not")
 681       (expect t
 682         (with-temp-buffer
 683           (insert "\nthreshold\nthunder\n")
 684           (goto-char 1)
 685           (anything-mp-3p-search "th !der" nil t)))
 686       (expect nil
 687         (with-temp-buffer
 688           (insert "threshold\nthunder\n")
 689           (goto-char 1)
 690           (anything-mp-3p-search "h !der" nil t)))
 691       (desc "anything-mp-3-search-backward")
 692       (expect (non-nil)
 693         (with-temp-buffer
 694           (insert "fire\nthunder\n")
 695           (goto-char (point-max))
 696           (anything-mp-3-search-backward "h der" nil t)))
 697       (expect nil
 698         (with-temp-buffer
 699           (insert "fire\nthunder\n")
 700           (goto-char (point-max))
 701           (anything-mp-3-search-backward "th ders" nil t)))
 702       (desc "anything-mp-3-search-backward not")
 703       (expect t
 704         (with-temp-buffer
 705           (insert "threshold\nthunder\n")
 706           (goto-char (point-max))
 707           (anything-mp-3-search-backward "h !der" nil t)))
 708       (expect t
 709         (with-temp-buffer
 710           (insert "threshold\nthunder\n")
 711           (goto-char (point-max))
 712           (anything-mp-3-search-backward "th !der" nil t)))
 713       (desc "anything-mp-3p-search-backward")
 714       (expect (non-nil)
 715         (with-temp-buffer
 716           (insert "fire\nthunder\n")
 717           (goto-char (point-max))
 718           (anything-mp-3p-search-backward "th der" nil t)))
 719       (expect nil
 720         (with-temp-buffer
 721           (insert "fire\nthunder\n")
 722           (goto-char (point-max))
 723           (anything-mp-3p-search-backward "h der" nil t)))
 724       (desc "anything-mp-3p-search-backward not")
 725       (expect t
 726         (with-temp-buffer
 727           (insert "\nthreshold\nthunder\n")
 728           (goto-char (point-max))
 729           (anything-mp-3p-search-backward "th !der" nil t)))
 730       (expect nil
 731         (with-temp-buffer
 732           (insert "threshold\nthunder\n")
 733           (goto-char (point-max))
 734           (anything-mp-3p-search-backward "h !der" nil t)))
 735       (desc "anything-mp-1-match")
 736       (expect (non-nil)
 737         (anything-mp-1-match "thunder" "th+ r"))
 738       (desc "anything-mp-2-match")
 739       (expect (non-nil)
 740         (anything-mp-2-match "thunder" "h+ r"))
 741       (expect nil
 742         (anything-mp-2-match "thunder" "th+ r"))
 743       (desc "anything-mp-3-match")
 744       (expect (non-nil)
 745         (anything-mp-3-match "thunder" "h+ r"))
 746       (expect (non-nil)
 747         (anything-mp-3-match "thunder" "th+ r"))
 748       (expect (non-nil)
 749         (anything-mp-3-match "thunder" "r th+"))
 750       (expect nil
 751         (anything-mp-3-match "thunder" "under hue"))
 752       (expect (non-nil)
 753         (anything-mp-3-match "thunder" "r th+ n"))
 754       (desc "anything-mp-3-match not")
 755       (expect (non-nil)
 756         (anything-mp-3-match "threshold" "th !der"))
 757       (desc "anything-prefix-match")
 758       (expect (non-nil)
 759         (anything-prefix-match "fobar" "fo"))
 760       (expect nil
 761         (anything-prefix-match "xfobar" "fo"))
 762
 763       (desc "anything-mp-3-match")
 764       (expect (non-nil)
 765         (anything-mp-3-match "thunder" "h der"))
 766       (expect nil
 767         (anything-mp-3-match "thunder" "h ders"))
 768       (desc "anything-mp-3p-match")
 769       (expect (non-nil)
 770         (anything-mp-3p-match "thunder" "th der"))
 771       (expect nil
 772         (anything-mp-3p-match "thunder" "h der"))
 773       (desc "anything-mp-3p-match not")
 774       (expect (non-nil)
 775         (anything-mp-3p-match "threshold" "th !der"))
 776       (expect nil
 777         (anything-mp-3p-match "threshold" "h !der"))
 778       (desc "with identity match")
 779       (expect '(identity)
 780         (assoc-default 'match
 781                        (car (anything-compile-sources
 782                              '(((name . "FOO")
 783                                 (candidates-in-buffer)))
 784                              '(anything-compile-source--candidates-in-buffer
 785                                anything-compile-source--match-plugin)))))
 786       (expect '(identity)
 787         (assoc-default 'match
 788                        (car (anything-compile-sources
 789                              '(((name . "FOO")
 790                                 (match identity)))
 791                              '(anything-compile-source--match-plugin)))))
 792       (desc "functional")
 793       (expect '(("FOO" ("thunder")))
 794         (anything-test-candidates '(((name . "FOO")
 795                                      (candidates "fire" "thunder")))
 796                                   "th r"
 797                                   '(anything-compile-source--match-plugin)))
 798       (expect '(("FOO" ("one two")))
 799         (let ((anything-mp-space-regexp "\\\\ "))
 800           (anything-test-candidates '(((name . "FOO")
 801                                        (candidates "one two" "three four")))
 802                                     "e\\ t"
 803                                     '(anything-compile-source--match-plugin))))
 804       (expect '(("FOO" ("one two")))
 805         (let ((anything-mp-space-regexp "  "))
 806           (anything-test-candidates '(((name . "FOO")
 807                                        (candidates "one two" "three four")))
 808                                     "e  t"
 809                                     '(anything-compile-source--match-plugin))))
 810       (expect '(("FOO" ("thunder")))
 811         (anything-test-candidates '(((name . "FOO")
 812                                      (init
 813                                       . (lambda ()
 814                                           (with-current-buffer (anything-candidate-buffer 'global)
 815                                             (insert "fire\nthunder\nthanks\n"))))
 816                                      (candidates-in-buffer)))
 817                                   "th r"
 818                                   '(anything-compile-source--candidates-in-buffer
 819                                     anything-compile-source--match-plugin)))
 820       (expect '(("FOO" ("foo" "foobar")))
 821         (anything-test-candidates '(((name . "FOO")
 822                                      (candidates "foobar" "foo")))
 823                                   "foo"
 824                                   '(anything-compile-source--match-plugin)))
 825       (expect '(("FOO" ("foo" "foobar")))
 826         (anything-test-candidates '(((name . "FOO")
 827                                      (init
 828                                       . (lambda ()
 829                                           (with-current-buffer (anything-candidate-buffer 'global)
 830                                             (insert "foobar\nfoo\n"))))
 831                                      (candidates-in-buffer)))
 832                                   "foo"
 833                                   '(anything-compile-source--candidates-in-buffer
 834                                     anything-compile-source--match-plugin)))
 835       (expect '(("FOO" ("foo")))
 836         (anything-test-candidates '(((name . "FOO")
 837                                      (init
 838                                       . (lambda ()
 839                                           (with-current-buffer (anything-candidate-buffer 'global)
 840                                             (insert "foo\n"))))
 841                                      (candidates-in-buffer)))
 842                                   "foo"
 843                                   '(anything-compile-source--candidates-in-buffer
 844                                     anything-compile-source--match-plugin)))
 845       (expect '(("FOO" ("foo")))
 846         (anything-test-candidates '(((name . "FOO")
 847                                      (init
 848                                       . (lambda ()
 849                                           (with-current-buffer (anything-candidate-buffer 'global)
 850                                             (insert "bar\nfoo\ntest\n"))))
 851                                      (candidates-in-buffer)))
 852                                   "foo"
 853                                   '(anything-compile-source--candidates-in-buffer
 854                                     anything-compile-source--match-plugin)))
 855       (expect '(("FOO" ("foobar" "foo")))
 856         (anything-test-candidates '(((name . "FOO")
 857                                      (init
 858                                       . (lambda ()
 859                                           (with-current-buffer (anything-candidate-buffer 'global)
 860                                             (insert "foobar\nfoo\n"))))
 861                                      (candidates-in-buffer)))
 862                                   ""
 863                                   '(anything-compile-source--candidates-in-buffer
 864                                     anything-compile-source--match-plugin)))
 865       (expect '(("FOO" ("foo" "foobar")))
 866         (anything-test-candidates '(((name . "FOO")
 867                                      (init
 868                                       . (lambda ()
 869                                           (with-current-buffer (anything-candidate-buffer 'global)
 870                                             (insert "foobar\nfoo\n"))))
 871                                      (candidates-in-buffer)
 872                                      (search-from-end)))
 873                                   "foo"
 874                                   '(anything-compile-source--candidates-in-buffer
 875                                     anything-compile-source--match-plugin)))
 876       (expect '(("FOO" ("elisp" "elp")))
 877         (anything-test-candidates '(((name . "FOO")
 878                                      (init
 879                                       . (lambda ()
 880                                           (with-current-buffer (anything-candidate-buffer 'global)
 881                                             (insert "elp\nelisp\n"))))
 882                                      (candidates-in-buffer)
 883                                      (search-from-end)))
 884                                   "el p"
 885                                   '(anything-compile-source--candidates-in-buffer
 886                                     anything-compile-source--match-plugin)))
 887       (expect '(("FOO" ("elisp" )))
 888         (anything-test-candidates '(((name . "FOO")
 889                                      (init
 890                                       . (lambda ()
 891                                           (with-current-buffer (anything-candidate-buffer 'global)
 892                                             (insert "elp\nelisp\n"))))
 893                                      (candidates-in-buffer)
 894                                      (search-from-end)))
 895                                   "el+ isp"
 896                                   '(anything-compile-source--candidates-in-buffer
 897                                     anything-compile-source--match-plugin)))
 898       ;; prefix multi -> multi
 899       (expect '(("FOO" ("elisp-info" "info.el")))
 900         (anything-test-candidates '(((name . "FOO")
 901                                      (init
 902                                       . (lambda ()
 903                                           (with-current-buffer (anything-candidate-buffer 'global)
 904                                             (insert "info.el\nelisp-info\n"))))
 905                                      (candidates-in-buffer)
 906                                      ))
 907                                   "el info"
 908                                   '(anything-compile-source--candidates-in-buffer
 909                                     anything-compile-source--match-plugin)))
 910       ;; multi not
 911       (expect '(("FOO" ("info.el")))
 912         (anything-test-candidates '(((name . "FOO")
 913                                      (init
 914                                       . (lambda ()
 915                                           (with-current-buffer (anything-candidate-buffer 'global)
 916                                             (insert "info.el\nelisp-info\n"))))
 917                                      (candidates-in-buffer)
 918                                      ))
 919                                   "info !elisp"
 920                                   '(anything-compile-source--candidates-in-buffer
 921                                     anything-compile-source--match-plugin)))
 922       ;; anything-mp-match-source-name
 923       (expect '(("SourceName" ("foo")))
 924         (let ((anything-mp-match-source-name t))
 925           (anything-test-candidates '(((name . "SourceName")
 926                                        (candidates "foo" "bar")))
 927                                     "source f"
 928                                     '(anything-compile-source--match-plugin))))
 929       (expect '(("SourceName cib" ("foo")))
 930         (let ((anything-mp-match-source-name t))
 931           (anything-test-candidates '(((name . "SourceName cib")
 932                                        (init
 933                                         . (lambda ()
 934                                             (with-current-buffer (anything-candidate-buffer 'global)
 935                                               (insert "foo\nbar\n"))))
 936                                        (candidates-in-buffer)))
 937                                     "source f"
 938                                     '(anything-compile-source--candidates-in-buffer
 939                                       anything-compile-source--match-plugin))))
 940       (expect '(("SourceName cib search-from-end" ("bar")))
 941         (let ((anything-mp-match-source-name t))
 942           (anything-test-candidates '(((name . "SourceName cib search-from-end")
 943                                        (init
 944                                         . (lambda ()
 945                                             (with-current-buffer (anything-candidate-buffer 'global)
 946                                               (insert "foo\nbar\n"))))
 947                                        (search-from-end)
 948                                        (candidates-in-buffer)))
 949                                     "source b"
 950                                     '(anything-compile-source--candidates-in-buffer
 951                                       anything-compile-source--match-plugin))))
 952       (expect '(("SourceName" ("foo" "bar")))
 953         (let ((anything-mp-match-source-name t))
 954           (anything-test-candidates '(((name . "SourceName")
 955                                        (candidates "foo" "bar")))
 956                                     "source ."
 957                                     '(anything-compile-source--match-plugin))))
 958       (expect '(("SourceName cib" ("foo" "bar")))
 959         (let ((anything-mp-match-source-name t))
 960           (anything-test-candidates '(((name . "SourceName cib")
 961                                        (init
 962                                         . (lambda ()
 963                                             (with-current-buffer (anything-candidate-buffer 'global)
 964                                               (insert "foo\nbar\n"))))
 965                                        (candidates-in-buffer)))
 966                                     "source ."
 967                                     '(anything-compile-source--candidates-in-buffer
 968                                       anything-compile-source--match-plugin))))
 969       (expect '(("SourceName cib search-from-end" ("bar" "foo")))
 970         (let ((anything-mp-match-source-name t))
 971           (anything-test-candidates '(((name . "SourceName cib search-from-end")
 972                                        (init
 973                                         . (lambda ()
 974                                             (with-current-buffer (anything-candidate-buffer 'global)
 975                                               (insert "foo\nbar\n"))))
 976                                        (search-from-end)
 977                                        (candidates-in-buffer)))
 978                                     "source ."
 979                                     '(anything-compile-source--candidates-in-buffer
 980                                       anything-compile-source--match-plugin))))
 981       )))
 982 ;; (anything-compile-sources '(((name . "test"))) anything-compile-source-functions)
 983 (provide 'anything-match-plugin)
 984
 985 ;; How to save (DO NOT REMOVE!!)
 986 ;; (progn (magit-push) (emacswiki-post "anything-match-plugin.el"))
 987 ;;; anything-match-plugin.el ends here