From 0709fe8e05c8773b4f0db21d6513c27f74a3d790 Mon Sep 17 00:00:00 2001 From: Feng Shu Date: Sat, 30 May 2015 09:33:12 +0800 Subject: [PATCH] bbdb-search: make `string-match' customizable. User can use different string match function by set `bbdb-string-match-function', The below example can search CJK string by pinyin: (setq bbdb-string-match-function 'my-bbdb-string-match) (defun my-bbdb-string-match (regexp string) (let ((string-list `(,string ,@(when (and string (featurep 'chinese-pyim)) (pyim-hanzi2pinyin string t nil t)) ,@(when (and string (featurep 'chinese-pyim)) (pyim-hanzi2pinyin string nil nil t))))) (cl-some #'(lambda (x) (string-match regexp x)) string-list))) --- ChangeLog | 8 ++++++++ lisp/bbdb-com.el | 48 ++++++++++++++++++++++++++---------------------- lisp/bbdb.el | 7 +++++++ 3 files changed, 41 insertions(+), 22 deletions(-) diff --git a/ChangeLog b/ChangeLog index c31dad4..aa4f55c 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,11 @@ +2015-05-30 Feng Shu + * lisp/bbdb.el (bbdb-string-match-function): Add defcustom, + `bbdb-string-match-function'. + * lisp/bbdb-com.el (bbdb-string-match): Add `bbdb-string-match' + function. + (bbdb-search): replace "string-match" with + "funcall bbdb-string-match-function". + 2015-05-23 Eric Abrahamsen * lisp/bbdb.el (bbdb-record-set-field, bbdb-parse-records): Use equal for comparison when populating lists of labels. diff --git a/lisp/bbdb-com.el b/lisp/bbdb-com.el index 6074bab..0dba7d5 100644 --- a/lisp/bbdb-com.el +++ b/lisp/bbdb-com.el @@ -179,6 +179,10 @@ With prefix ARG a negative number, do not invert next search." "\\\\[bbdb-search-invert]"))) (bbdb-prefix-message)) +(defun bbdb-string-match (regexp string) + "Default string match function used by `bbdb-search'" + (string-match regexp string)) + (defmacro bbdb-search (records &optional name-re org-re mail-re xfield-re phone-re address-re) "Search RECORDS for fields matching regexps. @@ -206,12 +210,12 @@ but not allowing for regexps." (or (stringp phone-re) (symbolp phone-re) (error "phone-re must be atomic")) (or (stringp address-re) (symbolp address-re) (error "address-re must be atomic")) (when name-re - (push `(string-match ,name-re (or (bbdb-record-name record) "")) clauses) - (push `(string-match ,name-re (or (bbdb-record-name-lf record) "")) clauses) + (push `(funcall bbdb-string-match-function ,name-re (or (bbdb-record-name record) "")) clauses) + (push `(funcall bbdb-string-match-function ,name-re (or (bbdb-record-name-lf record) "")) clauses) (push `(let ((akas (bbdb-record-field record 'aka-all)) aka done) (while (and (setq aka (pop akas)) (not done)) - (setq done (string-match ,name-re aka))) + (setq done (funcall bbdb-string-match-function ,name-re aka))) done) clauses)) (if org-re @@ -219,10 +223,10 @@ but not allowing for regexps." org done) (if organizations (while (and (setq org (pop organizations)) (not done)) - (setq done (string-match ,org-re org))) + (setq done (funcall bbdb-string-match-function ,org-re org))) ;; so that "^$" can be used to find records that ;; have no organization - (setq done (string-match ,org-re ""))) + (setq done (funcall bbdb-string-match-function ,org-re ""))) done) clauses)) @@ -231,11 +235,11 @@ but not allowing for regexps." ph done) (if phones (while (and (setq ph (pop phones)) (not done)) - (setq done (string-match ,phone-re - (bbdb-phone-string ph)))) + (setq done (funcall bbdb-string-match-function ,phone-re + (bbdb-phone-string ph)))) ;; so that "^$" can be used to find records that ;; have no phones - (setq done (string-match ,phone-re ""))) + (setq done (funcall bbdb-string-match-function ,phone-re ""))) done) clauses)) (if address-re @@ -243,11 +247,11 @@ but not allowing for regexps." a done) (if addresses (while (and (setq a (pop addresses)) (not done)) - (setq done (string-match ,address-re - (bbdb-format-address a 2)))) + (setq done (funcall bbdb-string-match-function ,address-re + (bbdb-format-address a 2)))) ;; so that "^$" can be used to find records that ;; have no addresses. - (setq done (string-match ,address-re ""))) + (setq done (funcall bbdb-string-match-function ,address-re ""))) done) clauses)) (if mail-re @@ -256,35 +260,35 @@ but not allowing for regexps." m done) (if mails (while (and (setq m (pop mails)) (not done)) - (setq done (string-match ,mail-re m))) + (setq done (funcall bbdb-string-match-function ,mail-re m))) ;; so that "^$" can be used to find records that ;; have no mail addresses. - (setq done (string-match ,mail-re ""))) + (setq done (funcall bbdb-string-match-function ,mail-re ""))) done) clauses)) (if xfield-re (push `(cond ((stringp ,xfield-re) ;; check xfield `bbdb-default-xfield' - (string-match ,xfield-re - (or (bbdb-record-xfield-string - record bbdb-default-xfield) ""))) + (funcall bbdb-string-match-function ,xfield-re + (or (bbdb-record-xfield-string + record bbdb-default-xfield) ""))) ((eq (car ,xfield-re) '*) ;; check all xfields (let ((labels bbdb-xfield-label-list) done tmp) (if (bbdb-record-xfields record) (while (and (not done) labels) (setq tmp (bbdb-record-xfield-string record (car labels)) - done (and tmp (string-match (cdr ,xfield-re) - tmp)) + done (and tmp (funcall bbdb-string-match-function (cdr ,xfield-re) + tmp)) labels (cdr labels))) ;; so that "^$" can be used to find records that ;; have no notes - (setq done (string-match (cdr ,xfield-re) ""))) + (setq done (funcall bbdb-string-match-function (cdr ,xfield-re) ""))) done)) (t ; check one field - (string-match (cdr ,xfield-re) - (or (bbdb-record-xfield-string - record (car ,xfield-re)) "")))) + (funcall bbdb-string-match-function (cdr ,xfield-re) + (or (bbdb-record-xfield-string + record (car ,xfield-re)) "")))) clauses)) `(let ((case-fold-search bbdb-case-fold-search) (invert (bbdb-search-invert-p)) diff --git a/lisp/bbdb.el b/lisp/bbdb.el index 514fb0d..8f2fb18 100644 --- a/lisp/bbdb.el +++ b/lisp/bbdb.el @@ -288,6 +288,13 @@ Lisp Hackers: See also `bbdb-silent-internal'." :type '(choice (const :tag "Standard location" nil) (file :tag "Nonstandard location"))) +(defcustom bbdb-string-match-function 'bbdb-string-match + "String match function used by `bbdb-search', the function need two +arguments, the first argument is `regexp', the second argument +is `string'." + :group 'bbdb + :type 'function) + ;;; Record display -- 2.1.4