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