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