Emacs config utilizing prelude as a base
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

677 lines
26 KiB

  1. ;;; anything-match-plugin.el --- Multiple regexp matching methods for anything
  2. ;; Author: rubikitch <rubikitch@ruby-lang.org>
  3. ;; Maintainers: rubikitch <rubikitch@ruby-lang.org>
  4. ;; Thierry Volpiatto <thierry.volpiatto@gmail.com>
  5. ;; Copyright (C) 2008~2012, rubikitch, all rights reserved.
  6. ;; Copyright (C) 2011~2012, Thierry Volpiatto, all rights reserved.
  7. ;; Keywords: anything, matching
  8. ;; X-URL: <http://repo.or.cz/w/anything-config.git>
  9. ;; This file is free software; you can redistribute it and/or modify
  10. ;; it under the terms of the GNU General Public License as published by
  11. ;; the Free Software Foundation; either version 2, or (at your option)
  12. ;; any later version.
  13. ;; This file is distributed in the hope that it will be useful,
  14. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  16. ;; GNU General Public License for more details.
  17. ;; You should have received a copy of the GNU General Public License
  18. ;; along with GNU Emacs; see the file COPYING. If not, write to
  19. ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  20. ;; Boston, MA 02110-1301, USA.
  21. ;;; Auto documentation
  22. ;; ------------------
  23. ;;
  24. ;; * User variables
  25. ;; [EVAL] (autodoc-document-lisp-buffer :type 'user-variable :prefix "anything-mp" :var-value t)
  26. ;; `anything-mp-matching-method'
  27. ;; Default Value: multi3
  28. ;; `anything-mp-highlight-delay'
  29. ;; Default Value: 0.7
  30. ;; `anything-mp-highlight-threshold'
  31. ;; Default Value: 2
  32. ;;
  33. ;; * Internal variables
  34. ;; [EVAL] (autodoc-document-lisp-buffer :type 'internal-variable :prefix "anything-mp" :var-value t)
  35. ;; `anything-mp-default-match-functions'
  36. ;; Default Value: (anything-mp-exact-match anything-mp-3-match)
  37. ;; `anything-mp-default-search-functions'
  38. ;; Default Value: (anything-mp-exact-search anything-mp-3-search)
  39. ;; `anything-mp-default-search-backward-functions'
  40. ;; Default Value: (anything-mp-exact-search-backward anything-mp-3-search-backward)
  41. ;; `anything-mp-space-regexp'
  42. ;; Default Value: "[\\ ] "
  43. ;; `anything-mp-exact-pattern-str'
  44. ;; Default Value: "autod"
  45. ;; `anything-mp-exact-pattern-real'
  46. ;; Default Value: "\nautod\n"
  47. ;; `anything-mp-prefix-pattern-str'
  48. ;; Default Value: nil
  49. ;; `anything-mp-prefix-pattern-real'
  50. ;; Default Value: nil
  51. ;; `anything-mp-1-pattern-str'
  52. ;; Default Value: nil
  53. ;; `anything-mp-1-pattern-real'
  54. ;; Default Value: nil
  55. ;; `anything-mp-2-pattern-str'
  56. ;; Default Value: nil
  57. ;; `anything-mp-2-pattern-real'
  58. ;; Default Value: nil
  59. ;; `anything-mp-3-pattern-str'
  60. ;; Default Value: "autod"
  61. ;; `anything-mp-3-pattern-list'
  62. ;; Default Value: ((identity . "autod"))
  63. ;; `anything-mp-initial-highlight-delay'
  64. ;; Default Value: nil
  65. ;;
  66. ;; * Anything match plugin Functions
  67. ;; [EVAL] (autodoc-document-lisp-buffer :type 'function :prefix "anything-mp")
  68. ;; `anything-mp-set-matching-method'
  69. ;; `anything-mp-make-regexps'
  70. ;; `anything-mp-1-make-regexp'
  71. ;; `anything-mp-exact-get-pattern'
  72. ;; `anything-mp-exact-match'
  73. ;; `anything-mp-exact-search'
  74. ;; `anything-mp-exact-search-backward'
  75. ;; `anything-mp-prefix-get-pattern'
  76. ;; `anything-mp-prefix-match'
  77. ;; `anything-mp-prefix-search'
  78. ;; `anything-mp-prefix-search-backward'
  79. ;; `anything-mp-1-get-pattern'
  80. ;; `anything-mp-1-match'
  81. ;; `anything-mp-1-search'
  82. ;; `anything-mp-1-search-backward'
  83. ;; `anything-mp-2-get-pattern'
  84. ;; `anything-mp-2-match'
  85. ;; `anything-mp-2-search'
  86. ;; `anything-mp-2-search-backward'
  87. ;; `anything-mp-3-get-patterns'
  88. ;; `anything-mp-3-get-patterns-internal'
  89. ;; `anything-mp-3-match'
  90. ;; `anything-mp-3-search-base'
  91. ;; `anything-mp-3-search'
  92. ;; `anything-mp-3-search-backward'
  93. ;; `anything-mp-3p-match'
  94. ;; `anything-mp-3p-search'
  95. ;; `anything-mp-3p-search-backward'
  96. ;; `anything-mp-highlight-match'
  97. ;; `anything-mp-highlight-region'
  98. ;; `anything-mp-highlight-match-internal'
  99. ;; *** END auto-documentation
  100. ;;; Commentary:
  101. ;; Change anything.el matching algorithm humanely.
  102. ;; It gives anything.el search refinement functionality.
  103. ;; exact match -> prefix match -> multiple regexp match
  104. ;;; Commands:
  105. ;;
  106. ;; Below are complete command list:
  107. ;;
  108. ;;
  109. ;;; Customizable Options:
  110. ;;
  111. ;; Below are customizable option list:
  112. ;;
  113. ;; `anything-grep-candidates-fast-directory-regexp'
  114. ;; *Directory regexp where a RAM disk (or tmpfs) is mounted.
  115. ;; default = nil
  116. ;; A query of multiple regexp match is space-delimited string.
  117. ;; Anything displays candidates which matches all the regexps.
  118. ;; A regexp with "!" prefix means not matching the regexp.
  119. ;; To include spaces to a regexp, prefix "\" before space,
  120. ;; it is controlled by `anything-mp-space-regexp' variable.
  121. ;; If multiple regexps are specified, first one also tries to match the source name.
  122. ;; If you want to disable this feature, evaluate
  123. ;; (setq anything-mp-match-source-name nil) .
  124. ;; NOTE: This is obsolete and disabled in anything versions >= 1.3.7
  125. ;; This file highlights patterns like `occur'. Note that patterns
  126. ;; longer than `anything-mp-highlight-threshold' are highlighted. And
  127. ;; region out of screen is highlighted after
  128. ;; `anything-mp-highlight-delay' seconds.
  129. ;;
  130. ;; Highlight in Emacs is time-consuming process for slow computers. To
  131. ;; disable it is to set nil to `anything-mp-highlight-delay'.
  132. ;; anything-match-plugin is enable by default in anything.
  133. ;; To disable/enable it use M-x anything-c-toggle-match-plugin.
  134. ;;; Code:
  135. (require 'anything)
  136. (require 'cl)
  137. ;;;; Match-plugin
  138. ;; Internal
  139. (defvar anything-mp-default-match-functions nil)
  140. (defvar anything-mp-default-search-functions nil)
  141. (defvar anything-mp-default-search-backward-functions nil)
  142. (defun anything-mp-set-matching-method (var key)
  143. "Default function to set matching methods in anything match plugin."
  144. (set-default var key)
  145. (case (symbol-value var)
  146. (multi1 (setq anything-mp-default-match-functions
  147. '(anything-mp-exact-match anything-mp-1-match)
  148. anything-mp-default-search-functions
  149. '(anything-mp-exact-search anything-mp-1-search)
  150. anything-mp-default-search-backward-functions
  151. '(anything-mp-exact-search-backward
  152. anything-mp-1-search-backward)))
  153. (multi2 (setq anything-mp-default-match-functions
  154. '(anything-mp-exact-match anything-mp-2-match)
  155. anything-mp-default-search-functions
  156. '(anything-mp-exact-search anything-mp-2-search)
  157. anything-mp-default-search-backward-functions
  158. '(anything-mp-exact-search-backward
  159. anything-mp-2-search-backward)))
  160. (multi3 (setq anything-mp-default-match-functions
  161. '(anything-mp-exact-match anything-mp-3-match)
  162. anything-mp-default-search-functions
  163. '(anything-mp-exact-search anything-mp-3-search)
  164. anything-mp-default-search-backward-functions
  165. '(anything-mp-exact-search-backward
  166. anything-mp-3-search-backward)))
  167. (multi3p (setq anything-mp-default-match-functions
  168. '(anything-mp-exact-match anything-mp-3p-match)
  169. anything-mp-default-search-functions
  170. '(anything-mp-exact-search anything-mp-3p-search)
  171. anything-mp-default-search-backward-functions
  172. '(anything-mp-exact-search-backward
  173. anything-mp-3p-search-backward)))
  174. (t (error "Unknow value: %s" anything-mp-matching-method))))
  175. (defgroup anything-match-plugin nil
  176. "Anything match plugin."
  177. :group 'anything)
  178. (defcustom anything-mp-matching-method 'multi3
  179. "Matching method for anything match plugin.
  180. You can set here different methods to match candidates in anything.
  181. Here are the possible value of this symbol and their meaning:
  182. - multi1: Respect order, prefix of pattern must match.
  183. - multi2: Same but with partial match.
  184. - multi3: The best, multiple regexp match, allow negation.
  185. - multi3p: Same but prefix must match.
  186. Default is multi3."
  187. :type '(radio :tag "Matching methods for anything"
  188. (const :tag "Multiple regexp 1 ordered with prefix match" multi1)
  189. (const :tag "Multiple regexp 2 ordered with partial match" multi2)
  190. (const :tag "Multiple regexp 3 matching no order, partial, best." multi3)
  191. (const :tag "Multiple regexp 3p matching with prefix match" multi3p))
  192. :set 'anything-mp-set-matching-method
  193. :group 'anything-match-plugin)
  194. (defface anything-match
  195. '((t (:inherit match)))
  196. "Face used to highlight matches."
  197. :group 'anything-match-plugin)
  198. (defcustom anything-mp-highlight-delay 0.7
  199. "Highlight matches with `anything-match' face after this many seconds.
  200. If nil, no highlight. "
  201. :type 'integer
  202. :group 'anything-match-plugin)
  203. (defcustom anything-mp-highlight-threshold 2
  204. "Minimum length of pattern to highlight.
  205. The smaller this value is, the slower highlight is."
  206. :type 'integer
  207. :group 'anything-match-plugin)
  208. ;;; Build regexps
  209. ;;
  210. ;;
  211. (defvar anything-mp-space-regexp "[\\ ] "
  212. "Regexp to represent space itself in multiple regexp match.")
  213. (defun anything-mp-make-regexps (pattern)
  214. "Split PATTERN if it contain spaces and return resulting list.
  215. If spaces in PATTERN are escaped, don't split at this place.
  216. i.e \"foo bar\"=> (\"foo\" \"bar\")
  217. but \"foo\ bar\"=> (\"foobar\")."
  218. (if (string= pattern "")
  219. '("")
  220. (loop for s in (split-string
  221. (replace-regexp-in-string anything-mp-space-regexp
  222. "\000\000" pattern)
  223. " " t)
  224. collect (replace-regexp-in-string "\000\000" " " s))))
  225. (defun anything-mp-1-make-regexp (pattern)
  226. "Replace spaces in PATTERN with \"\.*\"."
  227. (mapconcat 'identity (anything-mp-make-regexps pattern) ".*"))
  228. ;;; Exact match.
  229. ;;
  230. ;;
  231. ;; Internal.
  232. (defvar anything-mp-exact-pattern-str nil)
  233. (defvar anything-mp-exact-pattern-real nil)
  234. (defun anything-mp-exact-get-pattern (pattern)
  235. (unless (equal pattern anything-mp-exact-pattern-str)
  236. (setq anything-mp-exact-pattern-str pattern
  237. anything-mp-exact-pattern-real (concat "\n" pattern "\n")))
  238. anything-mp-exact-pattern-real)
  239. (defun anything-mp-exact-match (str &optional pattern)
  240. (string= str (or pattern anything-pattern)))
  241. (defun anything-mp-exact-search (pattern &rest ignore)
  242. (and (search-forward (anything-mp-exact-get-pattern pattern) nil t)
  243. (forward-line -1)))
  244. (defun anything-mp-exact-search-backward (pattern &rest ignore)
  245. (and (search-backward (anything-mp-exact-get-pattern pattern) nil t)
  246. (forward-line 1)))
  247. ;;; Prefix match
  248. ;;
  249. ;;
  250. ;; Internal
  251. (defvar anything-mp-prefix-pattern-str nil)
  252. (defvar anything-mp-prefix-pattern-real nil)
  253. (defun anything-mp-prefix-get-pattern (pattern)
  254. (unless (equal pattern anything-mp-prefix-pattern-str)
  255. (setq anything-mp-prefix-pattern-str pattern
  256. anything-mp-prefix-pattern-real (concat "\n" pattern)))
  257. anything-mp-prefix-pattern-real)
  258. (defun anything-mp-prefix-match (str &optional pattern)
  259. (setq pattern (or pattern anything-pattern))
  260. (let ((len (length pattern)))
  261. (and (<= len (length str))
  262. (string= (substring str 0 len) pattern ))))
  263. (defun anything-mp-prefix-search (pattern &rest ignore)
  264. (search-forward (anything-mp-prefix-get-pattern pattern) nil t))
  265. (defun anything-mp-prefix-search-backward (pattern &rest ignore)
  266. (and (search-backward (anything-mp-prefix-get-pattern pattern) nil t)
  267. (forward-line 1)))
  268. ;;; Multiple regexp patterns 1 (order is preserved / prefix).
  269. ;;
  270. ;;
  271. ;; Internal
  272. (defvar anything-mp-1-pattern-str nil)
  273. (defvar anything-mp-1-pattern-real nil)
  274. (defun anything-mp-1-get-pattern (pattern)
  275. (unless (equal pattern anything-mp-1-pattern-str)
  276. (setq anything-mp-1-pattern-str pattern
  277. anything-mp-1-pattern-real
  278. (concat "^" (anything-mp-1-make-regexp pattern))))
  279. anything-mp-1-pattern-real)
  280. (defun* anything-mp-1-match (str &optional (pattern anything-pattern))
  281. (string-match (anything-mp-1-get-pattern pattern) str))
  282. (defun anything-mp-1-search (pattern &rest ignore)
  283. (re-search-forward (anything-mp-1-get-pattern pattern) nil t))
  284. (defun anything-mp-1-search-backward (pattern &rest ignore)
  285. (re-search-backward (anything-mp-1-get-pattern pattern) nil t))
  286. ;;; Multiple regexp patterns 2 (order is preserved / partial).
  287. ;;
  288. ;;
  289. ;; Internal
  290. (defvar anything-mp-2-pattern-str nil)
  291. (defvar anything-mp-2-pattern-real nil)
  292. (defun anything-mp-2-get-pattern (pattern)
  293. (unless (equal pattern anything-mp-2-pattern-str)
  294. (setq anything-mp-2-pattern-str pattern
  295. anything-mp-2-pattern-real
  296. (concat "^.*" (anything-mp-1-make-regexp pattern))))
  297. anything-mp-2-pattern-real)
  298. (defun* anything-mp-2-match (str &optional (pattern anything-pattern))
  299. (string-match (anything-mp-2-get-pattern pattern) str))
  300. (defun anything-mp-2-search (pattern &rest ignore)
  301. (re-search-forward (anything-mp-2-get-pattern pattern) nil t))
  302. (defun anything-mp-2-search-backward (pattern &rest ignore)
  303. (re-search-backward (anything-mp-2-get-pattern pattern) nil t))
  304. ;;; Multiple regexp patterns 3 (permutation).
  305. ;;
  306. ;;
  307. ;; Internal
  308. (defvar anything-mp-3-pattern-str nil)
  309. (defvar anything-mp-3-pattern-list nil)
  310. (defun anything-mp-3-get-patterns (pattern)
  311. "Return `anything-mp-3-pattern-list', a list of predicate/regexp cons cells.
  312. e.g ((identity . \"foo\") (identity . \"bar\")).
  313. This is done only if `anything-mp-3-pattern-str' is same as PATTERN."
  314. (unless (equal pattern anything-mp-3-pattern-str)
  315. (setq anything-mp-3-pattern-str pattern
  316. anything-mp-3-pattern-list
  317. (anything-mp-3-get-patterns-internal pattern)))
  318. anything-mp-3-pattern-list)
  319. (defun anything-mp-3-get-patterns-internal (pattern)
  320. "Return a list of predicate/regexp cons cells.
  321. e.g ((identity . \"foo\") (identity . \"bar\"))."
  322. (unless (string= pattern "")
  323. (loop for pat in (anything-mp-make-regexps pattern)
  324. collect (if (string= "!" (substring pat 0 1))
  325. (cons 'not (substring pat 1))
  326. (cons 'identity pat)))))
  327. (defun anything-mp-3-match (str &optional pattern)
  328. "Check if PATTERN match STR.
  329. When PATTERN contain a space, it is splitted and matching is done
  330. with the several resulting regexps against STR.
  331. e.g \"bar foo\" will match \"foobar\" and \"barfoo\".
  332. Argument PATTERN, a string, is transformed in a list of
  333. cons cell with `anything-mp-3-get-patterns' if it contain a space.
  334. e.g \"foo bar\"=>((identity . \"foo\") (identity . \"bar\")).
  335. Then each predicate of cons cell(s) is called with regexp of same
  336. cons cell against STR (a candidate).
  337. i.e (identity (string-match \"foo\" \"foo bar\")) => t."
  338. (let ((pat (anything-mp-3-get-patterns (or pattern anything-pattern))))
  339. (loop for (predicate . regexp) in pat
  340. always (funcall predicate (string-match regexp str)))))
  341. (defun anything-mp-3-search-base (pattern searchfn1 searchfn2)
  342. (loop with pat = (if (stringp pattern)
  343. (anything-mp-3-get-patterns pattern)
  344. pattern)
  345. while (funcall searchfn1 (or (cdar pat) "") nil t)
  346. for bol = (point-at-bol)
  347. for eol = (point-at-eol)
  348. if (loop for (pred . str) in (cdr pat) always
  349. (progn (goto-char bol)
  350. (funcall pred (funcall searchfn2 str eol t))))
  351. do (goto-char eol) and return t
  352. else do (goto-char eol)
  353. finally return nil))
  354. (defun anything-mp-3-search (pattern &rest ignore)
  355. (when (stringp pattern)
  356. (setq pattern (anything-mp-3-get-patterns pattern)))
  357. (anything-mp-3-search-base
  358. pattern 're-search-forward 're-search-forward))
  359. (defun anything-mp-3-search-backward (pattern &rest ignore)
  360. (when (stringp pattern)
  361. (setq pattern (anything-mp-3-get-patterns pattern)))
  362. (anything-mp-3-search-base
  363. pattern 're-search-backward 're-search-backward))
  364. ;;; mp-3p- (multiple regexp pattern 3 with prefix search)
  365. ;;
  366. ;;
  367. (defun anything-mp-3p-match (str &optional pattern)
  368. "Check if PATTERN match STR.
  369. Same as `anything-mp-3-match' but more strict, matching against prefix also.
  370. e.g \"bar foo\" will match \"barfoo\" but not \"foobar\" contrarily to
  371. `anything-mp-3-match'."
  372. (let* ((pat (anything-mp-3-get-patterns (or pattern anything-pattern)))
  373. (first (car pat)))
  374. (and (funcall (car first) (anything-mp-prefix-match str (cdr first)))
  375. (loop for (predicate . regexp) in (cdr pat)
  376. always (funcall predicate (string-match regexp str))))))
  377. (defun anything-mp-3p-search (pattern &rest ignore)
  378. (when (stringp pattern)
  379. (setq pattern (anything-mp-3-get-patterns pattern)))
  380. (anything-mp-3-search-base
  381. pattern 'anything-mp-prefix-search 're-search-forward))
  382. (defun anything-mp-3p-search-backward (pattern &rest ignore)
  383. (when (stringp pattern)
  384. (setq pattern (anything-mp-3-get-patterns pattern)))
  385. (anything-mp-3-search-base
  386. pattern 'anything-mp-prefix-search-backward 're-search-backward))
  387. ;;; source compiler
  388. ;;
  389. ;;
  390. (defun anything-compile-source--match-plugin (source)
  391. (let ((searchers (if (assoc 'search-from-end source)
  392. anything-mp-default-search-backward-functions
  393. anything-mp-default-search-functions)))
  394. `(,(if (or (assoc 'candidates-in-buffer source)
  395. (equal '(identity) (assoc-default 'match source)))
  396. '(match identity)
  397. `(match ,@anything-mp-default-match-functions
  398. ,@(assoc-default 'match source)))
  399. (search ,@searchers
  400. ,@(assoc-default 'search source))
  401. ,@source)))
  402. (add-to-list 'anything-compile-source-functions 'anything-compile-source--match-plugin t)
  403. ;;; Highlight matches.
  404. ;;
  405. ;;
  406. (defun anything-mp-highlight-match ()
  407. "Highlight matches after `anything-mp-highlight-delay' seconds."
  408. (when (and anything-mp-highlight-delay
  409. (not (string= anything-pattern "")))
  410. (anything-mp-highlight-match-internal (window-end (anything-window)))
  411. (run-with-idle-timer anything-mp-highlight-delay nil
  412. 'anything-mp-highlight-match-internal
  413. (with-current-buffer anything-buffer (point-max)))))
  414. (add-hook 'anything-update-hook 'anything-mp-highlight-match)
  415. (defun anything-mp-highlight-region (start end regexp face)
  416. (save-excursion
  417. (goto-char start)
  418. (let (me)
  419. (while (and (setq me (re-search-forward regexp nil t))
  420. (< (point) end)
  421. (< 0 (- (match-end 0) (match-beginning 0))))
  422. (unless (anything-pos-header-line-p)
  423. (put-text-property (match-beginning 0) me 'face face))))))
  424. (defun anything-mp-highlight-match-internal (end)
  425. (when (anything-window)
  426. (set-buffer anything-buffer)
  427. (let ((requote (loop for (pred . re) in
  428. (anything-mp-3-get-patterns anything-pattern)
  429. when (and (eq pred 'identity)
  430. (>= (length re)
  431. anything-mp-highlight-threshold))
  432. collect re into re-list
  433. finally return
  434. (if (and re-list (>= (length re-list) 1))
  435. (mapconcat 'identity re-list "\\|")
  436. (regexp-quote anything-pattern)))))
  437. (when (>= (length requote) anything-mp-highlight-threshold)
  438. (anything-mp-highlight-region
  439. (point-min) end requote 'anything-match)))))
  440. ;;; Toggle anything-match-plugin
  441. ;;
  442. ;;
  443. (defvar anything-mp-initial-highlight-delay nil)
  444. ;;;###autoload
  445. (defun anything-mp-toggle-match-plugin ()
  446. "Turn on/off multiple regexp matching in anything.
  447. i.e anything-match-plugin."
  448. (interactive)
  449. (let ((anything-match-plugin-enabled
  450. (member 'anything-compile-source--match-plugin
  451. anything-compile-source-functions)))
  452. (flet ((disable-match-plugin ()
  453. (setq anything-compile-source-functions
  454. (delq 'anything-compile-source--match-plugin
  455. anything-compile-source-functions))
  456. (setq anything-mp-initial-highlight-delay
  457. anything-mp-highlight-delay)
  458. (setq anything-mp-highlight-delay nil))
  459. (enable-match-plugin ()
  460. (unless anything-mp-initial-highlight-delay
  461. (setq anything-mp-initial-highlight-delay
  462. anything-mp-highlight-delay))
  463. (setq anything-compile-source-functions
  464. (cons 'anything-compile-source--match-plugin
  465. anything-compile-source-functions))
  466. (unless anything-mp-highlight-delay
  467. (setq anything-mp-highlight-delay
  468. anything-mp-initial-highlight-delay))))
  469. (if anything-match-plugin-enabled
  470. (when (y-or-n-p "Really disable match-plugin? ")
  471. (disable-match-plugin)
  472. (message "Anything-match-plugin disabled"))
  473. (when (y-or-n-p "Really enable match-plugin? ")
  474. (enable-match-plugin)
  475. (message "Anything-match-plugin enabled"))))))
  476. ;;;; Grep-candidates plug-in
  477. (defcustom anything-grep-candidates-fast-directory-regexp nil
  478. "*Directory regexp where a RAM disk (or tmpfs) is mounted.
  479. If non-nil, grep-candidates plugin gets faster because it uses
  480. grep as synchronous process.
  481. ex. (setq anything-grep-candidates-fast-directory-regexp \"^/tmp/\")"
  482. :type 'string
  483. :group 'anything)
  484. (defun agp-candidates (&optional filter)
  485. "Normal version of grep-candidates candidates function.
  486. Grep is run by asynchronous process."
  487. (start-process-shell-command
  488. "anything-grep-candidates" nil
  489. (agp-command-line-2 filter (anything-attr-defined 'search-from-end))))
  490. (defun agp-candidates-synchronous-grep (&optional filter)
  491. "Faster version of grep-candidates candidates function.
  492. Grep is run by synchronous process.
  493. It is faster when candidate files are in ramdisk."
  494. (split-string
  495. (shell-command-to-string
  496. (agp-command-line-2 filter (anything-attr-defined 'search-from-end)))
  497. "\n"))
  498. (defun agp-candidates-synchronous-grep--direct-insert-match (&optional filter)
  499. "[EXPERIMENTAL]Fastest version of grep-candidates candidates function at the cost of absense of transformers.
  500. Grep is run by synchronous process.
  501. It is faster when candidate files are in ramdisk.
  502. If (direct-insert-match) is in the source, this function is used."
  503. (with-current-buffer (anything-candidate-buffer 'global)
  504. (call-process-shell-command
  505. (agp-command-line-2 filter (anything-attr-defined 'search-from-end))
  506. nil t)))
  507. (defun agp-command-line (query files &optional limit filter search-from-end)
  508. "Build command line used by grep-candidates from QUERY, FILES, LIMIT, and FILTER."
  509. (let ((allfiles (mapconcat (lambda (f) (shell-quote-argument (expand-file-name f)))
  510. files " ")))
  511. (with-temp-buffer
  512. (when search-from-end
  513. (insert "tac " allfiles))
  514. (if (string= query "")
  515. (unless search-from-end
  516. (insert "cat " allfiles))
  517. (when search-from-end (insert " | "))
  518. (loop for (flag . re) in (anything-mp-3-get-patterns-internal query)
  519. for i from 0
  520. do
  521. (setq re (replace-regexp-in-string "^-" "\\-" re))
  522. (unless (zerop i) (insert " | "))
  523. (insert "grep -ih "
  524. (if (eq flag 'identity) "" "-v ")
  525. (shell-quote-argument re))
  526. (when (and (not search-from-end) (zerop i))
  527. (insert " " allfiles))))
  528. (when limit (insert (format " | head -n %d" limit)))
  529. (when filter (insert " | " filter))
  530. (buffer-string))))
  531. (defun agp-command-line-2 (filter &optional search-from-end)
  532. "Build command line used by grep-candidates from FILTER and current source."
  533. (agp-command-line
  534. anything-pattern
  535. (anything-mklist (anything-interpret-value (anything-attr 'grep-candidates)))
  536. (anything-candidate-number-limit (anything-get-current-source))
  537. filter search-from-end))
  538. (defun anything-compile-source--grep-candidates (source)
  539. (anything-aif (assoc-default 'grep-candidates source)
  540. (append
  541. source
  542. (let ((use-fast-directory
  543. (and anything-grep-candidates-fast-directory-regexp
  544. (string-match
  545. anything-grep-candidates-fast-directory-regexp
  546. (or (car (anything-mklist (anything-interpret-value it))) "")))))
  547. (cond ((not (anything-interpret-value it)) nil)
  548. ((and use-fast-directory (assq 'direct-insert-match source))
  549. (anything-log "fastest version (use-fast-directory and direct-insert-match)")
  550. `((candidates . agp-candidates-synchronous-grep--direct-insert-match)
  551. (match identity)
  552. (volatile)))
  553. (use-fast-directory
  554. (anything-log "faster version (use-fast-directory)")
  555. `((candidates . agp-candidates-synchronous-grep)
  556. (match identity)
  557. (volatile)))
  558. (t
  559. (anything-log "normal version")
  560. '((candidates . agp-candidates)
  561. (delayed))))))
  562. source))
  563. (add-to-list 'anything-compile-source-functions 'anything-compile-source--grep-candidates)
  564. (anything-document-attribute 'grep-candidates "grep-candidates plug-in"
  565. "grep-candidates plug-in provides anything-match-plugin.el feature with grep and head program.
  566. It is MUCH FASTER than normal match-plugin to search from vary large (> 1MB) candidates.
  567. Make sure to install these programs.
  568. It expands `candidates' and `delayed' attributes.
  569. `grep-candidates' attribute accepts a filename or list of filename.
  570. It also accepts 0-argument function name or variable name.")
  571. ;; (anything '(((name . "grep-test") (grep-candidates . "~/.emacs.el") (action . message))))
  572. ;; (let ((a "~/.emacs.el")) (anything '(((name . "grep-test") (grep-candidates . a) (action . message) (delayed)))))
  573. ;; (let ((a "~/.emacs.el")) (anything '(((name . "grep-test") (grep-candidates . (lambda () a)) (action . message) (delayed)))))
  574. ;; (anything '(((name . "grep-test") (grep-candidates . "~/.emacs.el") (action . message) (delayed) (candidate-number-limit . 2))))
  575. ;; (let ((anything-candidate-number-limit 2)) (anything '(((name . "grep-test") (grep-candidates . "~/.emacs.el") (action . message) (delayed)))))
  576. ;;;; unit test
  577. ;; unit test for match plugin are now in developper-tools/unit-test-match-plugin.el
  578. (provide 'anything-match-plugin)
  579. ;;; anything-match-plugin.el ends here