[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] scratch/mheerdegen-preview fadf6f9 05/33: WIP: New :key arg for "
From: |
Michael Heerdegen |
Subject: |
[elpa] scratch/mheerdegen-preview fadf6f9 05/33: WIP: New :key arg for "filename" and new pattern types "file" and "dir" |
Date: |
Wed, 24 Oct 2018 18:30:46 -0400 (EDT) |
branch: scratch/mheerdegen-preview
commit fadf6f9b97f2a0995e5018e3ef69ec7a274faea9
Author: Michael Heerdegen <address@hidden>
Commit: Michael Heerdegen <address@hidden>
WIP: New :key arg for "filename" and new pattern types "file" and "dir"
---
packages/el-search/el-search.el | 81 +++++++++++++++++++++++++++++++----------
1 file changed, 61 insertions(+), 20 deletions(-)
diff --git a/packages/el-search/el-search.el b/packages/el-search/el-search.el
index 6176811..c6a3093 100644
--- a/packages/el-search/el-search.el
+++ b/packages/el-search/el-search.el
@@ -2090,42 +2090,83 @@ is matched by the `el-search-regexp-like-p' REGEXP."
',regexp)
,this)))))
-(defun el-search--filename-matcher (&rest regexps)
+(defun el-search--filename-matcher (fun &rest regexps)
;; Return a file name matcher for the REGEXPS. This is a predicate
;; accepting two arguments that returns non-nil when the first
;; argument is a file name (i.e. a string) that is matched by all
;; `el-search-regexp-like-p' REGEXPS, or a buffer whose associated file
;; name matches accordingly. It ignores the second argument.
- (let ((get-file-name (lambda (file-name-or-buffer)
- (if (bufferp file-name-or-buffer)
- (buffer-file-name file-name-or-buffer)
- file-name-or-buffer))))
- (if (not regexps)
- (lambda (file-name-or-buffer _) (funcall get-file-name
file-name-or-buffer))
- (let* ((regexp-matchers (mapcar #'el-search--string-matcher regexps))
- (test-file-name-or-buffer
- (el-search-with-short-term-memory
- (lambda (file-name-or-buffer)
- (when-let ((file-name (funcall get-file-name
file-name-or-buffer)))
- (cl-every (lambda (matcher) (funcall matcher file-name))
regexp-matchers))))))
- (lambda (file-name-or-buffer _) (funcall test-file-name-or-buffer
file-name-or-buffer))))))
+ (let (real-fun)
+ (pcase regexps
+ (`(:key ,specified-fun . ,more-regexps)
+ (setq real-fun (lambda (arg) (funcall specified-fun (funcall fun
arg)))
+ regexps more-regexps))
+ (_ (setq real-fun fun)))
+ (let ((get-file-name (lambda (file-name-or-buffer)
+ (funcall real-fun
+ (if (bufferp file-name-or-buffer)
+ (buffer-file-name file-name-or-buffer)
+ file-name-or-buffer)))))
+ (if (not regexps)
+ (lambda (file-name-or-buffer _) (funcall get-file-name
file-name-or-buffer))
+ (let* ((regexp-matchers (mapcar #'el-search--string-matcher regexps))
+ (test-file-name-or-buffer
+ (el-search-with-short-term-memory
+ (lambda (file-name-or-buffer)
+ (when-let ((file-name (funcall get-file-name
file-name-or-buffer)))
+ (cl-every (lambda (matcher) (funcall matcher file-name))
regexp-matchers))))))
+ (lambda (file-name-or-buffer _) (funcall test-file-name-or-buffer
file-name-or-buffer)))))))
(el-search-defpattern filename (&rest regexps)
"Matches anything when the searched buffer has an associated file.
With any `el-search-regexp-like-p' REGEXPS given, the file's
-absolute name must be matched by all of them."
- ;;FIXME: should we also allow to match the f-n-nondirectory and
- ;;f-n-sans-extension? Maybe it could become a new pattern type named
`feature'?
- (declare (heuristic-matcher #'el-search--filename-matcher)
+absolute name must be matched by all of them.
+
+The list of REGEXPS can optionally be prefixed with two elements :key
+KEYFUN. Then the filename will be passed to KEYFUN before matching.
+
+Example: This will match any pattern in any file whose name without
+extension matches \"el\":
+
+ (filename :key file-name-sans-extension \"el\").
+
+See also the pattern types \"file\" and \"dir\" that use a key
+function implicitly (but support to specify a :key nonetheless)."
+ (declare (heuristic-matcher (apply-partially #'el-search--filename-matcher
#'identity))
(inverse-heuristic-matcher t))
- (el-search-defpattern--check-args "filename" regexps
#'el-search-regexp-like-p)
- (let ((file-name-matcher (apply #'el-search--filename-matcher regexps)))
+ (el-search-defpattern--check-args "filename"
+ (if (eq (car-safe regexps) :key) (cddr
regexps) regexps)
+ #'el-search-regexp-like-p)
+ (let ((file-name-matcher (apply #'el-search--filename-matcher #'identity
regexps)))
;; We can't expand to just t because this would not work with `not'.
;; `el-search--filename-matcher' caches the result, so this is still a
;; pseudo constant
`(guard (funcall ',file-name-matcher (current-buffer) nil))))
+(defun el-search--file-directory (name)
+ (directory-file-name (file-name-directory name)))
+
+(el-search-defpattern file (&rest regexps)
+ "Like \"filename\" but matches REGEXPS against file names without directory."
+ (declare (heuristic-matcher (apply-partially #'el-search--filename-matcher
#'file-name-nondirectory))
+ (inverse-heuristic-matcher t))
+ (el-search-defpattern--check-args "file"
+ (if (eq (car-safe regexps) :key) (cddr
regexps) regexps)
+ #'el-search-regexp-like-p)
+ (let ((file-name-matcher (apply #'el-search--filename-matcher
#'file-name-nondirectory regexps)))
+ `(guard (funcall ',file-name-matcher (current-buffer) nil))))
+
+(el-search-defpattern dir (&rest regexps)
+ "Like \"filename\" but matches REGEXPS against directory names."
+ (declare (heuristic-matcher (apply-partially #'el-search--filename-matcher
#'el-search--file-directory))
+ (inverse-heuristic-matcher t))
+ (el-search-defpattern--check-args "dir"
+ (if (eq (car-safe regexps) :key) (cddr
regexps) regexps)
+ #'el-search-regexp-like-p)
+ (let ((file-name-matcher (apply #'el-search--filename-matcher
#'el-search--file-directory regexps)))
+ `(guard (funcall ',file-name-matcher (current-buffer) nil))))
+
;;;; Highlighting
- [elpa] scratch/mheerdegen-preview a006107 02/33: WIP: Add diverse "sloppy" pattern types, (continued)
- [elpa] scratch/mheerdegen-preview a006107 02/33: WIP: Add diverse "sloppy" pattern types, Michael Heerdegen, 2018/10/24
- [elpa] scratch/mheerdegen-preview 0107628 04/33: WIP: New package "gnus-article-notes", Michael Heerdegen, 2018/10/24
- [elpa] scratch/mheerdegen-preview efe4f41 01/33: WIP: [el-search] Fix nested match issues in *El Occur*, Michael Heerdegen, 2018/10/24
- [elpa] scratch/mheerdegen-preview 3c43b86 08/33: WIP: New command 'el-search-repository', Michael Heerdegen, 2018/10/24
- [elpa] scratch/mheerdegen-preview c88c4c1 27/33: WIP: Include leading comments in occur defun context, Michael Heerdegen, 2018/10/24
- [elpa] scratch/mheerdegen-preview 3f656ab 11/33: WIP [el-search] Add quick help command, Michael Heerdegen, 2018/10/24
- [elpa] scratch/mheerdegen-preview 2d15aa7 22/33: WIP: [el-search] Fine tune separator for splicing replace, Michael Heerdegen, 2018/10/24
- [elpa] scratch/mheerdegen-preview 9cfe823 32/33: WIP: [el-search] Enhance doc of el-search-occur-mode, Michael Heerdegen, 2018/10/24
- [elpa] scratch/mheerdegen-preview d774bfe 24/33: WIP: Test: Make mouse clicks not abort the search, Michael Heerdegen, 2018/10/24
- [elpa] scratch/mheerdegen-preview 1020ca9 16/33: WIP: Optimize caching, Michael Heerdegen, 2018/10/24
- [elpa] scratch/mheerdegen-preview fadf6f9 05/33: WIP: New :key arg for "filename" and new pattern types "file" and "dir",
Michael Heerdegen <=
- [elpa] scratch/mheerdegen-preview 1fcb333 03/33: WIP: Add package "sscell", Michael Heerdegen, 2018/10/24
- [elpa] scratch/mheerdegen-preview 35be4f8 12/33: WIP [el-search] Fix more "redundant _ pattern" cases, Michael Heerdegen, 2018/10/24
- [elpa] scratch/mheerdegen-preview fa8dbb8 07/33: WIP: New file el-search/el-search-pp.el, Michael Heerdegen, 2018/10/24
- [elpa] scratch/mheerdegen-preview ffd1bb1 13/33: WIP [el-search] Discourage using symbols as LPATS in `append' and `l', Michael Heerdegen, 2018/10/24
- [elpa] scratch/mheerdegen-preview aca1cea 10/33: WIP [el-search] Implement 'el-search-keyboard-quit', Michael Heerdegen, 2018/10/24
- [elpa] scratch/mheerdegen-preview 9773b43 18/33: WIP [el-search] Fix search setup when occur flag bound, Michael Heerdegen, 2018/10/24
- [elpa] scratch/mheerdegen-preview 35edf10 23/33: WIP: Improvise eldoc support for search pattern prompt, Michael Heerdegen, 2018/10/24
- [elpa] scratch/mheerdegen-preview 08e0d20 15/33: WIP: Additions to "Mb hints", Michael Heerdegen, 2018/10/24
- [elpa] scratch/mheerdegen-preview 60fd31c 19/33: WIP [el-search] Adjust prev/next match commands for search and occur, Michael Heerdegen, 2018/10/24
- [elpa] scratch/mheerdegen-preview fb5a73b 30/33: WIP: Small fix in 'el-search--reset-wrap-flag', Michael Heerdegen, 2018/10/24