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               (and anything-grep-candidates-fast-directory-regexp
 464                    (string-match
 465                     anything-grep-candidates-fast-directory-regexp
 466                     (or (car (anything-mklist (anything-interpret-value it))) "")))))
 467          (cond ((not (anything-interpret-value it)) nil)
 468                ((and use-fast-directory (assq 'direct-insert-match source))
 469                 (anything-log "fastest version (use-fast-directory and direct-insert-match)")
 470                 `((candidates . agp-candidates-synchronous-grep--direct-insert-match)
 471                   (match identity)
 472                   (volatile)
 473                   (requires-pattern)))
 474                (use-fast-directory
 475                 (anything-log "faster version (use-fast-directory)")
 476                 `((candidates . agp-candidates-synchronous-grep)
 477                   (match identity)
 478                   (volatile)
 479                   (requires-pattern)))
 480                (t
 481                 (anything-log "normal version")
 482                 '((candidates . agp-candidates)
 483                   (delayed))))))
 484     source))
 485 (add-to-list 'anything-compile-source-functions 'anything-compile-source--grep-candidates)
 486
 487 (anything-document-attribute 'grep-candidates "grep-candidates plug-in"
 488   "grep-candidates plug-in provides anything-match-plugin.el feature with grep and head program.
 489 It is MUCH FASTER than normal match-plugin to search from vary large (> 1MB) candidates.
 490 Make sure to install these programs.
 491
 492 It expands `candidates' and `delayed' attributes.
 493
 494 `grep-candidates' attribute accepts a filename or list of filename.
 495 It also accepts 0-argument function name or variable name.")
 496
 497 ;; (anything '(((name . "grep-test")  (grep-candidates . "~/.emacs.el") (action . message))))
 498 ;; (let ((a "~/.emacs.el")) (anything '(((name . "grep-test")  (grep-candidates . a) (action . message) (delayed)))))
 499 ;; (let ((a "~/.emacs.el")) (anything '(((name . "grep-test")  (grep-candidates . (lambda () a)) (action . message) (delayed)))))
 500 ;; (anything '(((name . "grep-test")  (grep-candidates . "~/.emacs.el") (action . message) (delayed) (candidate-number-limit . 2))))
 501 ;; (let ((anything-candidate-number-limit 2)) (anything '(((name . "grep-test")  (grep-candidates . "~/.emacs.el") (action . message) (delayed)))))
 502
 503 ;;;; Compatibility
 504 (unless (fboundp 'apply-partially)
 505   (defun apply-partially (fun &rest args)
 506     "Return a function that is a partial application of FUN to ARGS.
 507 ARGS is a list of the first N arguments to pass to FUN.
 508 The result is a new function which does the same as FUN, except that
 509 the first N arguments are fixed at the values with which this function
 510 was called."
 511     (lexical-let ((fun fun) (args1 args))
 512       (lambda (&rest args2) (apply fun (append args1 args2))))))
 513
 514 ;;;; unit test
 515 ;; (install-elisp "http://www.emacswiki.org/cgi-bin/wiki/download/el-expectations.el")
 516 ;; (install-elisp "http://www.emacswiki.org/cgi-bin/wiki/download/el-mock.el")
 517 (dont-compile
 518   (when (fboundp 'expectations)
 519     (expectations
 520       (desc "amp-mp-make-regexps")
 521       (expect '("")
 522         (amp-mp-make-regexps ""))
 523       (expect '("foo" "bar")
 524         (amp-mp-make-regexps "foo bar"))
 525       (expect '("foo" "bar")
 526         (amp-mp-make-regexps " foo bar"))
 527       (expect '("foo" "bar")
 528         (amp-mp-make-regexps " foo bar "))
 529       (expect '("foo bar" "baz")
 530         (let ((anything-mp-space-regexp "\\\\ "))
 531           (amp-mp-make-regexps "foo\\ bar baz")))
 532       (desc "anything-mp-3-get-patterns-internal")
 533       (expect '((identity . "foo"))
 534         (anything-mp-3-get-patterns-internal "foo"))
 535       (expect '((identity . "foo") (identity . "bar"))
 536         (anything-mp-3-get-patterns-internal "foo bar"))
 537       (expect '((identity . "foo") (not . "bar"))
 538         (anything-mp-3-get-patterns-internal "foo !bar"))
 539       (desc "agp-command-line")
 540       (expect "grep -ih foo /f1"
 541         (agp-command-line "foo" '("/f1")))
 542       (expect "grep -ih foo /f1 | grep -ih bar"
 543         (agp-command-line "foo bar" '("/f1")))
 544       (expect "grep -ih foo /f1 | grep -ih -v bar"
 545         (agp-command-line "foo !bar" '("/f1")))
 546       (expect "grep -ih foo /f1 /f\\ 2 | grep -ih -v bar | grep -ih baz"
 547         (agp-command-line "foo !bar baz" '("/f1" "/f 2")))
 548       (expect (concat "grep -ih foo " (expand-file-name "~/.emacs.el"))
 549         (agp-command-line "foo" '("~/.emacs.el")))
 550       (expect "grep -ih f\\ o /f\\ 1"
 551         (agp-command-line "f  o" '("/f 1")))
 552       (expect "grep -ih foo /f1 | head -n 5"
 553         (agp-command-line "foo" '("/f1") 5))
 554       (expect "grep -ih foo /f1 | head -n 5 | nkf -w"
 555         (agp-command-line "foo" '("/f1") 5 "nkf -w"))
 556       (desc "anything-exact-match")
 557       (expect (non-nil)
 558         (anything-exact-match "thunder" "thunder"))
 559       (expect nil
 560         (anything-exact-match "thunder" "fire"))
 561       (desc "anything-exact-search")
 562       (expect (non-nil)
 563         (with-temp-buffer
 564           (insert "fire\nthunder\n")
 565           (goto-char 1)
 566           (anything-exact-search "thunder" nil t)))
 567       (expect (non-nil)
 568         (with-temp-buffer
 569           (insert "\nfire\nthunder\n")
 570           (goto-char 1)
 571           (anything-exact-search "fire" nil t)))
 572       (desc "anything-prefix-search")
 573       (expect (non-nil)
 574         (with-temp-buffer
 575           (insert "fire\nthunder\n")
 576           (goto-char (point-min))
 577           (anything-prefix-search "thund" nil t)))
 578       (expect nil
 579         (with-temp-buffer
 580           (insert "fire\nthunder\n")
 581           (goto-char (point-min))
 582           (anything-prefix-search "hund" nil t)))
 583       (desc "anything-prefix-search-backward")
 584       (expect (non-nil)
 585         (with-temp-buffer
 586           (insert "fire\nthunder\n")
 587           (goto-char (point-max))
 588           (anything-prefix-search-backward "thund" nil t)))
 589       (expect nil
 590         (with-temp-buffer
 591           (insert "fire\nthunder\n")
 592           (goto-char (point-max))
 593           (anything-prefix-search-backward "hund" nil t)))
 594       (desc "amp-mp-1-make-regexp")
 595       (expect "a.*b"
 596         (amp-mp-1-make-regexp "a b"))
 597       (expect "a b"
 598         (let ((anything-mp-space-regexp "\\\\ "))
 599           (amp-mp-1-make-regexp "a\\ b")))
 600       (expect "a.*b c"
 601         (let ((anything-mp-space-regexp "\\\\ "))
 602           (amp-mp-1-make-regexp "a b\\ c")))
 603       (expect ""
 604         (amp-mp-1-make-regexp ""))
 605       (desc "anything-mp-1-search")
 606       (expect (non-nil)
 607         (with-temp-buffer
 608           (insert "fire\nthunder\n")
 609           (goto-char 1)
 610           (anything-mp-1-search "th+ r" nil t)))
 611       (desc "anything-mp-2-search")
 612       (expect (non-nil)
 613         (with-temp-buffer
 614           (insert "fire\nthunder\n")
 615           (goto-char 1)
 616           (anything-mp-2-search "h+ r" nil t)))
 617       (expect nil
 618         (with-temp-buffer
 619           (insert "fire\nthunder\n")
 620           (goto-char 1)
 621           (anything-mp-2-search "th+ r" nil t)))
 622       (desc "anything-mp-3-search")
 623       (expect (non-nil)
 624         (with-temp-buffer
 625           (insert "fire\nthunder\n")
 626           (goto-char 1)
 627           (anything-mp-3-search "h+ r" nil t)))
 628       (expect (non-nil)
 629         (with-temp-buffer
 630           (insert "fire\nthunder\n")
 631           (goto-char 1)
 632           (anything-mp-3-search "th+ r" nil t)))
 633       (expect (non-nil)
 634         (with-temp-buffer
 635           (insert "fire\nthunder\n")
 636           (goto-char 1)
 637           (anything-mp-3-search "r th+" nil t)))
 638       (expect nil
 639         (with-temp-buffer
 640           (insert "fire\nthunder\n")
 641           (goto-char 1)
 642           (anything-mp-3-search "under hue" nil t)))
 643       (expect (non-nil)
 644         (with-temp-buffer
 645           (insert "fire\nthunder\n")
 646           (goto-char 1)
 647           (anything-mp-3-search "r th+ n" nil t)))
 648       (desc "anything-mp-3-search")
 649       (expect (non-nil)
 650         (with-temp-buffer
 651           (insert "fire\nthunder\n")
 652           (goto-char 1)
 653           (anything-mp-3-search "th der" nil t)))
 654       (expect nil
 655         (with-temp-buffer
 656           (insert "fire\nthunder\n")
 657           (goto-char 1)
 658           (anything-mp-3-search "th ders" nil t)))
 659       (desc "anything-mp-3-search not")
 660       (expect t
 661         (with-temp-buffer
 662           (insert "threshold\nthunder\n")
 663           (goto-char 1)
 664           (anything-mp-3-search "h !der" nil t)))
 665       (expect t
 666         (with-temp-buffer
 667           (insert "threshold\nthunder\n")
 668           (goto-char 1)
 669           (anything-mp-3-search "th !der" nil t)))
 670       (desc "anything-mp-3p-search")
 671       (expect (non-nil)
 672         (with-temp-buffer
 673           (insert "fire\nthunder\n")
 674           (goto-char 1)
 675           (anything-mp-3p-search "th der" nil t)))
 676       (expect nil
 677         (with-temp-buffer
 678           (insert "fire\nthunder\n")
 679           (goto-char 1)
 680           (anything-mp-3p-search "h ders" nil t)))
 681       (desc "anything-mp-3p-search not")
 682       (expect t
 683         (with-temp-buffer
 684           (insert "\nthreshold\nthunder\n")
 685           (goto-char 1)
 686           (anything-mp-3p-search "th !der" nil t)))
 687       (expect nil
 688         (with-temp-buffer
 689           (insert "threshold\nthunder\n")
 690           (goto-char 1)
 691           (anything-mp-3p-search "h !der" nil t)))
 692       (desc "anything-mp-3-search-backward")
 693       (expect (non-nil)
 694         (with-temp-buffer
 695           (insert "fire\nthunder\n")
 696           (goto-char (point-max))
 697           (anything-mp-3-search-backward "h der" nil t)))
 698       (expect nil
 699         (with-temp-buffer
 700           (insert "fire\nthunder\n")
 701           (goto-char (point-max))
 702           (anything-mp-3-search-backward "th ders" nil t)))
 703       (desc "anything-mp-3-search-backward not")
 704       (expect t
 705         (with-temp-buffer
 706           (insert "threshold\nthunder\n")
 707           (goto-char (point-max))
 708           (anything-mp-3-search-backward "h !der" nil t)))
 709       (expect t
 710         (with-temp-buffer
 711           (insert "threshold\nthunder\n")
 712           (goto-char (point-max))
 713           (anything-mp-3-search-backward "th !der" nil t)))
 714       (desc "anything-mp-3p-search-backward")
 715       (expect (non-nil)
 716         (with-temp-buffer
 717           (insert "fire\nthunder\n")
 718           (goto-char (point-max))
 719           (anything-mp-3p-search-backward "th der" nil t)))
 720       (expect nil
 721         (with-temp-buffer
 722           (insert "fire\nthunder\n")
 723           (goto-char (point-max))
 724           (anything-mp-3p-search-backward "h der" nil t)))
 725       (desc "anything-mp-3p-search-backward not")
 726       (expect t
 727         (with-temp-buffer
 728           (insert "\nthreshold\nthunder\n")
 729           (goto-char (point-max))
 730           (anything-mp-3p-search-backward "th !der" nil t)))
 731       (expect nil
 732         (with-temp-buffer
 733           (insert "threshold\nthunder\n")
 734           (goto-char (point-max))
 735           (anything-mp-3p-search-backward "h !der" nil t)))
 736       (desc "anything-mp-1-match")
 737       (expect (non-nil)
 738         (anything-mp-1-match "thunder" "th+ r"))
 739       (desc "anything-mp-2-match")
 740       (expect (non-nil)
 741         (anything-mp-2-match "thunder" "h+ r"))
 742       (expect nil
 743         (anything-mp-2-match "thunder" "th+ r"))
 744       (desc "anything-mp-3-match")
 745       (expect (non-nil)
 746         (anything-mp-3-match "thunder" "h+ r"))
 747       (expect (non-nil)
 748         (anything-mp-3-match "thunder" "th+ r"))
 749       (expect (non-nil)
 750         (anything-mp-3-match "thunder" "r th+"))
 751       (expect nil
 752         (anything-mp-3-match "thunder" "under hue"))
 753       (expect (non-nil)
 754         (anything-mp-3-match "thunder" "r th+ n"))
 755       (desc "anything-mp-3-match not")
 756       (expect (non-nil)
 757         (anything-mp-3-match "threshold" "th !der"))
 758       (desc "anything-prefix-match")
 759       (expect (non-nil)
 760         (anything-prefix-match "fobar" "fo"))
 761       (expect nil
 762         (anything-prefix-match "xfobar" "fo"))
 763
 764       (desc "anything-mp-3-match")
 765       (expect (non-nil)
 766         (anything-mp-3-match "thunder" "h der"))
 767       (expect nil
 768         (anything-mp-3-match "thunder" "h ders"))
 769       (desc "anything-mp-3p-match")
 770       (expect (non-nil)
 771         (anything-mp-3p-match "thunder" "th der"))
 772       (expect nil
 773         (anything-mp-3p-match "thunder" "h der"))
 774       (desc "anything-mp-3p-match not")
 775       (expect (non-nil)
 776         (anything-mp-3p-match "threshold" "th !der"))
 777       (expect nil
 778         (anything-mp-3p-match "threshold" "h !der"))
 779       (desc "with identity match")
 780       (expect '(identity)
 781         (assoc-default 'match
 782                        (car (anything-compile-sources
 783                              '(((name . "FOO")
 784                                 (candidates-in-buffer)))
 785                              '(anything-compile-source--candidates-in-buffer
 786                                anything-compile-source--match-plugin)))))
 787       (expect '(identity)
 788         (assoc-default 'match
 789                        (car (anything-compile-sources
 790                              '(((name . "FOO")
 791                                 (match identity)))
 792                              '(anything-compile-source--match-plugin)))))
 793       (desc "functional")
 794       (expect '(("FOO" ("thunder")))
 795         (anything-test-candidates '(((name . "FOO")
 796                                      (candidates "fire" "thunder")))
 797                                   "th r"
 798                                   '(anything-compile-source--match-plugin)))
 799       (expect '(("FOO" ("one two")))
 800         (let ((anything-mp-space-regexp "\\\\ "))
 801           (anything-test-candidates '(((name . "FOO")
 802                                        (candidates "one two" "three four")))
 803                                     "e\\ t"
 804                                     '(anything-compile-source--match-plugin))))
 805       (expect '(("FOO" ("one two")))
 806         (let ((anything-mp-space-regexp "  "))
 807           (anything-test-candidates '(((name . "FOO")
 808                                        (candidates "one two" "three four")))
 809                                     "e  t"
 810                                     '(anything-compile-source--match-plugin))))
 811       (expect '(("FOO" ("thunder")))
 812         (anything-test-candidates '(((name . "FOO")
 813                                      (init
 814                                       . (lambda ()
 815                                           (with-current-buffer (anything-candidate-buffer 'global)
 816                                             (insert "fire\nthunder\nthanks\n"))))
 817                                      (candidates-in-buffer)))
 818                                   "th r"
 819                                   '(anything-compile-source--candidates-in-buffer
 820                                     anything-compile-source--match-plugin)))
 821       (expect '(("FOO" ("foo" "foobar")))
 822         (anything-test-candidates '(((name . "FOO")
 823                                      (candidates "foobar" "foo")))
 824                                   "foo"
 825                                   '(anything-compile-source--match-plugin)))
 826       (expect '(("FOO" ("foo" "foobar")))
 827         (anything-test-candidates '(((name . "FOO")
 828                                      (init
 829                                       . (lambda ()
 830                                           (with-current-buffer (anything-candidate-buffer 'global)
 831                                             (insert "foobar\nfoo\n"))))
 832                                      (candidates-in-buffer)))
 833                                   "foo"
 834                                   '(anything-compile-source--candidates-in-buffer
 835                                     anything-compile-source--match-plugin)))
 836       (expect '(("FOO" ("foo")))
 837         (anything-test-candidates '(((name . "FOO")
 838                                      (init
 839                                       . (lambda ()
 840                                           (with-current-buffer (anything-candidate-buffer 'global)
 841                                             (insert "foo\n"))))
 842                                      (candidates-in-buffer)))
 843                                   "foo"
 844                                   '(anything-compile-source--candidates-in-buffer
 845                                     anything-compile-source--match-plugin)))
 846       (expect '(("FOO" ("foo")))
 847         (anything-test-candidates '(((name . "FOO")
 848                                      (init
 849                                       . (lambda ()
 850                                           (with-current-buffer (anything-candidate-buffer 'global)
 851                                             (insert "bar\nfoo\ntest\n"))))
 852                                      (candidates-in-buffer)))
 853                                   "foo"
 854                                   '(anything-compile-source--candidates-in-buffer
 855                                     anything-compile-source--match-plugin)))
 856       (expect '(("FOO" ("foobar" "foo")))
 857         (anything-test-candidates '(((name . "FOO")
 858                                      (init
 859                                       . (lambda ()
 860                                           (with-current-buffer (anything-candidate-buffer 'global)
 861                                             (insert "foobar\nfoo\n"))))
 862                                      (candidates-in-buffer)))
 863                                   ""
 864                                   '(anything-compile-source--candidates-in-buffer
 865                                     anything-compile-source--match-plugin)))
 866       (expect '(("FOO" ("foo" "foobar")))
 867         (anything-test-candidates '(((name . "FOO")
 868                                      (init
 869                                       . (lambda ()
 870                                           (with-current-buffer (anything-candidate-buffer 'global)
 871                                             (insert "foobar\nfoo\n"))))
 872                                      (candidates-in-buffer)
 873                                      (search-from-end)))
 874                                   "foo"
 875                                   '(anything-compile-source--candidates-in-buffer
 876                                     anything-compile-source--match-plugin)))
 877       (expect '(("FOO" ("elisp" "elp")))
 878         (anything-test-candidates '(((name . "FOO")
 879                                      (init
 880                                       . (lambda ()
 881                                           (with-current-buffer (anything-candidate-buffer 'global)
 882                                             (insert "elp\nelisp\n"))))
 883                                      (candidates-in-buffer)
 884                                      (search-from-end)))
 885                                   "el p"
 886                                   '(anything-compile-source--candidates-in-buffer
 887                                     anything-compile-source--match-plugin)))
 888       (expect '(("FOO" ("elisp" )))
 889         (anything-test-candidates '(((name . "FOO")
 890                                      (init
 891                                       . (lambda ()
 892                                           (with-current-buffer (anything-candidate-buffer 'global)
 893                                             (insert "elp\nelisp\n"))))
 894                                      (candidates-in-buffer)
 895                                      (search-from-end)))
 896                                   "el+ isp"
 897                                   '(anything-compile-source--candidates-in-buffer
 898                                     anything-compile-source--match-plugin)))
 899       ;; prefix multi -> multi
 900       (expect '(("FOO" ("elisp-info" "info.el")))
 901         (anything-test-candidates '(((name . "FOO")
 902                                      (init
 903                                       . (lambda ()
 904                                           (with-current-buffer (anything-candidate-buffer 'global)
 905                                             (insert "info.el\nelisp-info\n"))))
 906                                      (candidates-in-buffer)
 907                                      ))
 908                                   "el info"
 909                                   '(anything-compile-source--candidates-in-buffer
 910                                     anything-compile-source--match-plugin)))
 911       ;; multi not
 912       (expect '(("FOO" ("info.el")))
 913         (anything-test-candidates '(((name . "FOO")
 914                                      (init
 915                                       . (lambda ()
 916                                           (with-current-buffer (anything-candidate-buffer 'global)
 917                                             (insert "info.el\nelisp-info\n"))))
 918                                      (candidates-in-buffer)
 919                                      ))
 920                                   "info !elisp"
 921                                   '(anything-compile-source--candidates-in-buffer
 922                                     anything-compile-source--match-plugin)))
 923       ;; anything-mp-match-source-name
 924       (expect '(("SourceName" ("foo")))
 925         (let ((anything-mp-match-source-name t))
 926           (anything-test-candidates '(((name . "SourceName")
 927                                        (candidates "foo" "bar")))
 928                                     "source f"
 929                                     '(anything-compile-source--match-plugin))))
 930       (expect '(("SourceName cib" ("foo")))
 931         (let ((anything-mp-match-source-name t))
 932           (anything-test-candidates '(((name . "SourceName cib")
 933                                        (init
 934                                         . (lambda ()
 935                                             (with-current-buffer (anything-candidate-buffer 'global)
 936                                               (insert "foo\nbar\n"))))
 937                                        (candidates-in-buffer)))
 938                                     "source f"
 939                                     '(anything-compile-source--candidates-in-buffer
 940                                       anything-compile-source--match-plugin))))
 941       (expect '(("SourceName cib search-from-end" ("bar")))
 942         (let ((anything-mp-match-source-name t))
 943           (anything-test-candidates '(((name . "SourceName cib search-from-end")
 944                                        (init
 945                                         . (lambda ()
 946                                             (with-current-buffer (anything-candidate-buffer 'global)
 947                                               (insert "foo\nbar\n"))))
 948                                        (search-from-end)
 949                                        (candidates-in-buffer)))
 950                                     "source b"
 951                                     '(anything-compile-source--candidates-in-buffer
 952                                       anything-compile-source--match-plugin))))
 953       (expect '(("SourceName" ("foo" "bar")))
 954         (let ((anything-mp-match-source-name t))
 955           (anything-test-candidates '(((name . "SourceName")
 956                                        (candidates "foo" "bar")))
 957                                     "source ."
 958                                     '(anything-compile-source--match-plugin))))
 959       (expect '(("SourceName cib" ("foo" "bar")))
 960         (let ((anything-mp-match-source-name t))
 961           (anything-test-candidates '(((name . "SourceName cib")
 962                                        (init
 963                                         . (lambda ()
 964                                             (with-current-buffer (anything-candidate-buffer 'global)
 965                                               (insert "foo\nbar\n"))))
 966                                        (candidates-in-buffer)))
 967                                     "source ."
 968                                     '(anything-compile-source--candidates-in-buffer
 969                                       anything-compile-source--match-plugin))))
 970       (expect '(("SourceName cib search-from-end" ("bar" "foo")))
 971         (let ((anything-mp-match-source-name t))
 972           (anything-test-candidates '(((name . "SourceName cib search-from-end")
 973                                        (init
 974                                         . (lambda ()
 975                                             (with-current-buffer (anything-candidate-buffer 'global)
 976                                               (insert "foo\nbar\n"))))
 977                                        (search-from-end)
 978                                        (candidates-in-buffer)))
 979                                     "source ."
 980                                     '(anything-compile-source--candidates-in-buffer
 981                                       anything-compile-source--match-plugin))))
 982       )))
 983 ;; (anything-compile-sources '(((name . "test"))) anything-compile-source-functions)
 984 (provide 'anything-match-plugin)
 985
 986 ;; How to save (DO NOT REMOVE!!)
 987 ;; (progn (magit-push) (emacswiki-post "anything-match-plugin.el"))
 988 ;;; anything-match-plugin.el ends here