Download
(require 'anything)
(require 'cl)
(defvar anything-mp-default-match-functions nil)
(defvar anything-mp-default-search-functions nil)
(defvar anything-mp-default-search-backward-functions nil)
(defun anything-mp-set-matching-method (var key)
"Default function to set matching methods in anything match plugin."
(set-default var key)
(case (symbol-value var)
(multi1 (setq anything-mp-default-match-functions
'(anything-mp-exact-match anything-mp-1-match)
anything-mp-default-search-functions
'(anything-mp-exact-search anything-mp-1-search)
anything-mp-default-search-backward-functions
'(anything-mp-exact-search-backward
anything-mp-1-search-backward)))
(multi2 (setq anything-mp-default-match-functions
'(anything-mp-exact-match anything-mp-2-match)
anything-mp-default-search-functions
'(anything-mp-exact-search anything-mp-2-search)
anything-mp-default-search-backward-functions
'(anything-mp-exact-search-backward
anything-mp-2-search-backward)))
(multi3 (setq anything-mp-default-match-functions
'(anything-mp-exact-match anything-mp-3-match)
anything-mp-default-search-functions
'(anything-mp-exact-search anything-mp-3-search)
anything-mp-default-search-backward-functions
'(anything-mp-exact-search-backward
anything-mp-3-search-backward)))
(multi3p (setq anything-mp-default-match-functions
'(anything-mp-exact-match anything-mp-3p-match)
anything-mp-default-search-functions
'(anything-mp-exact-search anything-mp-3p-search)
anything-mp-default-search-backward-functions
'(anything-mp-exact-search-backward
anything-mp-3p-search-backward)))
(t (error "Unknow value: %s" anything-mp-matching-method))))
(defgroup anything-match-plugin nil
"Anything match plugin."
:group 'anything)
(defcustom anything-mp-matching-method 'multi3
"Matching method for anything match plugin.
You can set here different methods to match candidates in anything.
Here are the possible value of this symbol and their meaning:
- multi1: Respect order, prefix of pattern must match.
- multi2: Same but with partial match.
- multi3: The best, multiple regexp match, allow negation.
- multi3p: Same but prefix must match.
Default is multi3."
:type '(radio :tag "Matching methods for anything"
(const :tag "Multiple regexp 1 ordered with prefix match" multi1)
(const :tag "Multiple regexp 2 ordered with partial match" multi2)
(const :tag "Multiple regexp 3 matching no order, partial, best." multi3)
(const :tag "Multiple regexp 3p matching with prefix match" multi3p))
:set 'anything-mp-set-matching-method
:group 'anything-match-plugin)
(defface anything-match
'((t (:inherit match)))
"Face used to highlight matches."
:group 'anything-match-plugin)
(defcustom anything-mp-highlight-delay 0.7
"Highlight matches with `anything-match' face after this many seconds.
If nil, no highlight. "
:type 'integer
:group 'anything-match-plugin)
(defcustom anything-mp-highlight-threshold 2
"Minimum length of pattern to highlight.
The smaller this value is, the slower highlight is."
:type 'integer
:group 'anything-match-plugin)
(defvar anything-mp-space-regexp "[\\ ] "
"Regexp to represent space itself in multiple regexp match.")
(defun anything-mp-make-regexps (pattern)
"Split PATTERN if it contain spaces and return resulting list.
If spaces in PATTERN are escaped, don't split at this place.
i.e \"foo bar\"=> (\"foo\" \"bar\")
but \"foo\ bar\"=> (\"foobar\")."
(if (string= pattern "")
'("")
(loop for s in (split-string
(replace-regexp-in-string anything-mp-space-regexp
"\000\000" pattern)
" " t)
collect (replace-regexp-in-string "\000\000" " " s))))
(defun anything-mp-1-make-regexp (pattern)
"Replace spaces in PATTERN with \"\.*\"."
(mapconcat 'identity (anything-mp-make-regexps pattern) ".*"))
(defvar anything-mp-exact-pattern-str nil)
(defvar anything-mp-exact-pattern-real nil)
(defun anything-mp-exact-get-pattern (pattern)
(unless (equal pattern anything-mp-exact-pattern-str)
(setq anything-mp-exact-pattern-str pattern
anything-mp-exact-pattern-real (concat "\n" pattern "\n")))
anything-mp-exact-pattern-real)
(defun anything-mp-exact-match (str &optional pattern)
(string= str (or pattern anything-pattern)))
(defun anything-mp-exact-search (pattern &rest ignore)
(and (search-forward (anything-mp-exact-get-pattern pattern) nil t)
(forward-line -1)))
(defun anything-mp-exact-search-backward (pattern &rest ignore)
(and (search-backward (anything-mp-exact-get-pattern pattern) nil t)
(forward-line 1)))
(defvar anything-mp-prefix-pattern-str nil)
(defvar anything-mp-prefix-pattern-real nil)
(defun anything-mp-prefix-get-pattern (pattern)
(unless (equal pattern anything-mp-prefix-pattern-str)
(setq anything-mp-prefix-pattern-str pattern
anything-mp-prefix-pattern-real (concat "\n" pattern)))
anything-mp-prefix-pattern-real)
(defun anything-mp-prefix-match (str &optional pattern)
(setq pattern (or pattern anything-pattern))
(let ((len (length pattern)))
(and (<= len (length str))
(string= (substring str 0 len) pattern ))))
(defun anything-mp-prefix-search (pattern &rest ignore)
(search-forward (anything-mp-prefix-get-pattern pattern) nil t))
(defun anything-mp-prefix-search-backward (pattern &rest ignore)
(and (search-backward (anything-mp-prefix-get-pattern pattern) nil t)
(forward-line 1)))
(defvar anything-mp-1-pattern-str nil)
(defvar anything-mp-1-pattern-real nil)
(defun anything-mp-1-get-pattern (pattern)
(unless (equal pattern anything-mp-1-pattern-str)
(setq anything-mp-1-pattern-str pattern
anything-mp-1-pattern-real
(concat "^" (anything-mp-1-make-regexp pattern))))
anything-mp-1-pattern-real)
(defun* anything-mp-1-match (str &optional (pattern anything-pattern))
(string-match (anything-mp-1-get-pattern pattern) str))
(defun anything-mp-1-search (pattern &rest ignore)
(re-search-forward (anything-mp-1-get-pattern pattern) nil t))
(defun anything-mp-1-search-backward (pattern &rest ignore)
(re-search-backward (anything-mp-1-get-pattern pattern) nil t))
(defvar anything-mp-2-pattern-str nil)
(defvar anything-mp-2-pattern-real nil)
(defun anything-mp-2-get-pattern (pattern)
(unless (equal pattern anything-mp-2-pattern-str)
(setq anything-mp-2-pattern-str pattern
anything-mp-2-pattern-real
(concat "^.*" (anything-mp-1-make-regexp pattern))))
anything-mp-2-pattern-real)
(defun* anything-mp-2-match (str &optional (pattern anything-pattern))
(string-match (anything-mp-2-get-pattern pattern) str))
(defun anything-mp-2-search (pattern &rest ignore)
(re-search-forward (anything-mp-2-get-pattern pattern) nil t))
(defun anything-mp-2-search-backward (pattern &rest ignore)
(re-search-backward (anything-mp-2-get-pattern pattern) nil t))
(defvar anything-mp-3-pattern-str nil)
(defvar anything-mp-3-pattern-list nil)
(defun anything-mp-3-get-patterns (pattern)
"Return `anything-mp-3-pattern-list', a list of predicate/regexp cons cells.
e.g ((identity . \"foo\") (identity . \"bar\")).
This is done only if `anything-mp-3-pattern-str' is same as PATTERN."
(unless (equal pattern anything-mp-3-pattern-str)
(setq anything-mp-3-pattern-str pattern
anything-mp-3-pattern-list
(anything-mp-3-get-patterns-internal pattern)))
anything-mp-3-pattern-list)
(defun anything-mp-3-get-patterns-internal (pattern)
"Return a list of predicate/regexp cons cells.
e.g ((identity . \"foo\") (identity . \"bar\"))."
(unless (string= pattern "")
(if (string-match "^!" pattern)
(anything-mp-3-get-patterns-internal (concat ". " pattern))
(loop for pat in (anything-mp-make-regexps pattern)
collect (if (string= "!" (substring pat 0 1))
(cons 'not (substring pat 1))
(cons 'identity pat))))))
(defun anything-mp-3-match (str &optional pattern)
"Check if PATTERN match STR.
When PATTERN contain a space, it is splitted and matching is done
with the several resulting regexps against STR.
e.g \"bar foo\" will match \"foobar\" and \"barfoo\".
Argument PATTERN, a string, is transformed in a list of
cons cell with `anything-mp-3-get-patterns' if it contain a space.
e.g \"foo bar\"=>((identity . \"foo\") (identity . \"bar\")).
Then each predicate of cons cell(s) is called with regexp of same
cons cell against STR (a candidate).
i.e (identity (string-match \"foo\" \"foo bar\")) => t."
(let ((pat (anything-mp-3-get-patterns (or pattern anything-pattern))))
(loop for (predicate . regexp) in pat
always (funcall predicate (string-match regexp str)))))
(defun anything-mp-3-search-base (pattern searchfn1 searchfn2)
(loop with pat = (if (stringp pattern)
(anything-mp-3-get-patterns pattern)
pattern)
while (funcall searchfn1 (or (cdar pat) "") nil t)
for bol = (point-at-bol)
for eol = (point-at-eol)
for (b . e) = (if (eq searchfn2 're-search-backward)
(cons eol bol)
(cons bol eol))
if (loop for (pred . str) in (cdr pat) always
(progn (goto-char b)
(funcall pred (funcall searchfn2 str e t))))
do (goto-char e) and return t
else do (goto-char e)
finally return nil))
(defun anything-mp-3-search (pattern &rest ignore)
(when (stringp pattern)
(setq pattern (anything-mp-3-get-patterns pattern)))
(anything-mp-3-search-base
pattern 're-search-forward 're-search-forward))
(defun anything-mp-3-search-backward (pattern &rest ignore)
(when (stringp pattern)
(setq pattern (anything-mp-3-get-patterns pattern)))
(anything-mp-3-search-base
pattern 're-search-backward 're-search-backward))
(defun anything-mp-3p-match (str &optional pattern)
"Check if PATTERN match STR.
Same as `anything-mp-3-match' but more strict, matching against prefix also.
e.g \"bar foo\" will match \"barfoo\" but not \"foobar\" contrarily to
`anything-mp-3-match'."
(let* ((pat (anything-mp-3-get-patterns (or pattern anything-pattern)))
(first (car pat)))
(and (funcall (car first) (anything-mp-prefix-match str (cdr first)))
(loop for (predicate . regexp) in (cdr pat)
always (funcall predicate (string-match regexp str))))))
(defun anything-mp-3p-search (pattern &rest ignore)
(when (stringp pattern)
(setq pattern (anything-mp-3-get-patterns pattern)))
(anything-mp-3-search-base
pattern 'anything-mp-prefix-search 're-search-forward))
(defun anything-mp-3p-search-backward (pattern &rest ignore)
(when (stringp pattern)
(setq pattern (anything-mp-3-get-patterns pattern)))
(anything-mp-3-search-base
pattern 'anything-mp-prefix-search-backward 're-search-backward))
(defun anything-compile-source--match-plugin (source)
(let ((searchers (if (assoc 'search-from-end source)
anything-mp-default-search-backward-functions
anything-mp-default-search-functions)))
`(,(if (or (assoc 'candidates-in-buffer source)
(equal '(identity) (assoc-default 'match source)))
'(match identity)
`(match ,@anything-mp-default-match-functions
,@(assoc-default 'match source)))
(search ,@searchers
,@(assoc-default 'search source))
,@source)))
(add-to-list 'anything-compile-source-functions 'anything-compile-source--match-plugin t)
(defun anything-mp-highlight-match ()
"Highlight matches after `anything-mp-highlight-delay' seconds."
(when (and anything-mp-highlight-delay
(not (string= anything-pattern "")))
(anything-mp-highlight-match-internal (window-end (anything-window)))
(run-with-idle-timer anything-mp-highlight-delay nil
'anything-mp-highlight-match-internal
(with-current-buffer anything-buffer (point-max)))))
(add-hook 'anything-update-hook 'anything-mp-highlight-match)
(defun anything-mp-highlight-region (start end regexp face)
(save-excursion
(goto-char start)
(let (me)
(while (and (setq me (re-search-forward regexp nil t))
(< (point) end)
(< 0 (- (match-end 0) (match-beginning 0))))
(unless (anything-pos-header-line-p)
(put-text-property (match-beginning 0) me 'face face))))))
(defun anything-mp-highlight-match-internal (end)
(when (anything-window)
(set-buffer anything-buffer)
(let ((requote (loop for (pred . re) in
(anything-mp-3-get-patterns anything-pattern)
when (and (eq pred 'identity)
(>= (length re)
anything-mp-highlight-threshold))
collect re into re-list
finally return
(if (and re-list (>= (length re-list) 1))
(mapconcat 'identity re-list "\\|")
(regexp-quote anything-pattern)))))
(when (>= (length requote) anything-mp-highlight-threshold)
(anything-mp-highlight-region
(point-min) end requote 'anything-match)))))
(defvar anything-mp-initial-highlight-delay nil)
(defun anything-mp-toggle-match-plugin ()
"Turn on/off multiple regexp matching in anything.
i.e anything-match-plugin."
(interactive)
(let ((anything-match-plugin-enabled
(member 'anything-compile-source--match-plugin
anything-compile-source-functions)))
(flet ((disable-match-plugin ()
(setq anything-compile-source-functions
(delq 'anything-compile-source--match-plugin
anything-compile-source-functions))
(setq anything-mp-initial-highlight-delay
anything-mp-highlight-delay)
(setq anything-mp-highlight-delay nil))
(enable-match-plugin ()
(unless anything-mp-initial-highlight-delay
(setq anything-mp-initial-highlight-delay
anything-mp-highlight-delay))
(setq anything-compile-source-functions
(cons 'anything-compile-source--match-plugin
anything-compile-source-functions))
(unless anything-mp-highlight-delay
(setq anything-mp-highlight-delay
anything-mp-initial-highlight-delay))))
(if anything-match-plugin-enabled
(when (y-or-n-p "Really disable match-plugin? ")
(disable-match-plugin)
(message "Anything-match-plugin disabled"))
(when (y-or-n-p "Really enable match-plugin? ")
(enable-match-plugin)
(message "Anything-match-plugin enabled"))))))
(defcustom anything-grep-candidates-fast-directory-regexp nil
"*Directory regexp where a RAM disk (or tmpfs) is mounted.
If non-nil, grep-candidates plugin gets faster because it uses
grep as synchronous process.
ex. (setq anything-grep-candidates-fast-directory-regexp \"^/tmp/\")"
:type 'string
:group 'anything)
(defcustom anything-grep-candidates-requires-pattern 2
"*Required length of input to grep search.
The greater this value is, the faster grep-candidates works."
:type 'integer
:group 'anything)
(defun agp-candidates (&optional filter)
"Normal version of grep-candidates candidates function.
Grep is run by asynchronous process."
(start-process-shell-command
"anything-grep-candidates" nil
(agp-command-line-2 filter (anything-attr-defined 'search-from-end))))
(defun agp-candidates-synchronous-grep (&optional filter)
"Faster version of grep-candidates candidates function.
Grep is run by synchronous process.
It is faster when candidate files are in ramdisk."
(let ((x (split-string
(shell-command-to-string
(agp-command-line-2 filter (anything-attr-defined 'search-from-end)))
"\n")))
(unless (equal x '("")) x)))
(defun agp-candidates-synchronous-grep--direct-insert-match (&optional filter)
"[EXPERIMENTAL]Fastest version of grep-candidates candidates function at the cost of absense of transformers.
Grep is run by synchronous process.
It is faster when candidate files are in ramdisk.
If (direct-insert-match) is in the source, this function is used."
(with-current-buffer (anything-candidate-buffer 'global)
(call-process-shell-command
(agp-command-line-2 filter (anything-attr-defined 'search-from-end))
nil t)))
(defun agp-command-line (query files &optional limit filter search-from-end)
"Build command line used by grep-candidates from QUERY, FILES, LIMIT, and FILTER."
(let ((allfiles (mapconcat (lambda (f) (shell-quote-argument (expand-file-name f)))
files " ")))
(with-temp-buffer
(when search-from-end
(insert "tac " allfiles))
(if (< (length query) anything-grep-candidates-requires-pattern)
(unless search-from-end
(insert "cat " allfiles))
(when search-from-end (insert " | "))
(loop for (flag . re) in (anything-mp-3-get-patterns-internal query)
for i from 0
do
(setq re (replace-regexp-in-string "^-" "\\-" re))
(unless (zerop i) (insert " | "))
(insert "grep -ih "
(if (eq flag 'identity) "" "-v ")
(shell-quote-argument re))
(when (and (not search-from-end) (zerop i))
(insert " " allfiles))))
(when limit (insert (format " | head -n %d" limit)))
(when filter (insert " | " filter))
(buffer-string))))
(defun agp-command-line-2 (filter &optional search-from-end)
"Build command line used by grep-candidates from FILTER and current source."
(agp-command-line
anything-pattern
(anything-mklist (anything-interpret-value (anything-attr 'grep-candidates)))
(anything-candidate-number-limit (anything-get-current-source))
filter search-from-end))
(defun anything-compile-source--grep-candidates (source)
(anything-aif (assoc-default 'grep-candidates source)
(append
source
(let ((use-fast-directory
(and anything-grep-candidates-fast-directory-regexp
(string-match
anything-grep-candidates-fast-directory-regexp
(or (car (anything-mklist (anything-interpret-value it))) "")))))
(cond ((not (anything-interpret-value it)) nil)
((and use-fast-directory (assq 'direct-insert-match source))
(anything-log "fastest version (use-fast-directory and direct-insert-match)")
`((candidates . agp-candidates-synchronous-grep--direct-insert-match)
(match identity)
(volatile)))
(use-fast-directory
(anything-log "faster version (use-fast-directory)")
`((candidates . agp-candidates-synchronous-grep)
(match identity)
(volatile)))
(t
(anything-log "normal version")
'((candidates . agp-candidates)
(delayed))))))
source))
(add-to-list 'anything-compile-source-functions 'anything-compile-source--grep-candidates)
(anything-document-attribute 'grep-candidates "grep-candidates plug-in"
"grep-candidates plug-in provides anything-match-plugin.el feature with grep and head program.
It is MUCH FASTER than normal match-plugin to search from vary large (> 1MB) candidates.
Make sure to install these programs.
It expands `candidates' and `delayed' attributes.
`grep-candidates' attribute accepts a filename or list of filename.
It also accepts 0-argument function name or variable name.")
(provide 'anything-match-plugin)