[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/ebdb 9b1a2cf 25/33: Use simpler home-grown version of c
From: |
Eric Abrahamsen |
Subject: |
[elpa] externals/ebdb 9b1a2cf 25/33: Use simpler home-grown version of char-fold-to-regexp |
Date: |
Sun, 3 Sep 2017 17:02:24 -0400 (EDT) |
branch: externals/ebdb
commit 9b1a2cf78a811dfdd040730e900213d31dda135f
Author: Eric Abrahamsen <address@hidden>
Commit: Eric Abrahamsen <address@hidden>
Use simpler home-grown version of char-fold-to-regexp
* ebdb.el (ebdb-char-fold-table): Char table holding simplified
correspondences between characters and their decomposition.
(ebdb-char-fold-to-regexp): New function for creating a regexp that
only targets alphabetic characters, while leaving regexp-special
characters alone.
---
ebdb.el | 62 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-
1 file changed, 61 insertions(+), 1 deletion(-)
diff --git a/ebdb.el b/ebdb.el
index 56d57d0..b47301c 100644
--- a/ebdb.el
+++ b/ebdb.el
@@ -5065,6 +5065,66 @@ With prefix ARG, insert string at point."
(defvar ebdb-search-invert nil
"Bind this variable to t in order to invert the result of `ebdb-search'.")
+;; Char folding: a simplified version of what happens in char-fold.el.
+
+(defconst ebdb-char-fold-table
+ (eval-when-compile
+ (let ((tbl (make-char-table 'char-fold-table))
+ (uni (unicode-property-table-internal 'decomposition))
+ ;; Lowercase and uppercase alphabet.
+ (target-seq (append (number-sequence 65 90)
+ (number-sequence 97 122))))
+
+ ;; I don't understand what's happening here, but it's necessary.
+ (let ((func (char-table-extra-slot uni 1)))
+ (map-char-table (lambda (char v)
+ (when (consp char)
+ (funcall func (car char) v uni)))
+ uni))
+ ;; Create lists of equivalent chars, keyed to the most basic
+ ;; ascii letter.
+ (map-char-table
+ (lambda (char decomp)
+ (when (consp decomp)
+ (when (symbolp (car decomp))
+ (setq decomp (cdr decomp)))
+ (when (memq (car decomp) target-seq)
+ (aset tbl (car decomp)
+ (cons char
+ (aref tbl (car decomp)))))))
+ uni)
+ ;; Then turn the lists into regexps.
+ (map-char-table
+ (lambda (char dec-list)
+ (let ((re (regexp-opt (cons (char-to-string char)
+ (mapcar #'string dec-list)))))
+ (aset tbl char re)))
+ tbl)
+ tbl))
+ "Char-table holding regexps used in char fold searches.
+Keys are characters in the upper- and lower-case ascii ranges.
+Values are a regexp matching all characters that decompose to the
+key character.")
+
+(defun ebdb-char-fold-to-regexp (string)
+ "A highly simplified version of `char-fold-to-regexp'.
+Only converts characters that decompose to the range [a-zA-Z]."
+ (let ((out nil)
+ (end (length string))
+ char
+ (i 0))
+ (while (< i end)
+ (setq char (aref string i))
+ (push
+ (or (aref ebdb-char-fold-table char)
+ (string char))
+ out)
+ (cl-incf i))
+ (setq out (apply #'concat (nreverse out)))
+ (if (> (length out) 5000)
+ (regexp-quote string)
+ out)))
+
(defun ebdb-message-search (name mail)
"Return list of EBDB records matching NAME and/or MAIL.
First try to find a record matching both NAME and MAIL.
@@ -5114,7 +5174,7 @@ interpreted as t, ie the record passes."
(dolist (c clauses)
(when (and (consp c)
(stringp (cadr c)))
- (setf (cadr c) (char-fold-to-regexp (cadr c))))))
+ (setf (cadr c) (ebdb-char-fold-to-regexp (cadr c))))))
(seq-filter
(lambda (r)
(eql (null invert)
- [elpa] externals/ebdb 3d819bc 17/33: Have ebdb-do-records filter out stub uuids, (continued)
- [elpa] externals/ebdb 3d819bc 17/33: Have ebdb-do-records filter out stub uuids, Eric Abrahamsen, 2017/09/03
- [elpa] externals/ebdb 423be4d 14/33: Add ebdb-field-singleton abstract field class, Eric Abrahamsen, 2017/09/03
- [elpa] externals/ebdb 9b07ad6 15/33: Add gender field class, Eric Abrahamsen, 2017/09/03
- [elpa] externals/ebdb 123ebae 09/33: Base ebdb-db-save method should be on ebdb-db class, Eric Abrahamsen, 2017/09/03
- [elpa] externals/ebdb 63509c6 01/33: Work on getting ebdb-vm.el back into place, Eric Abrahamsen, 2017/09/03
- [elpa] externals/ebdb 8291f3d 13/33: Refine database disabling/re-enabling, Eric Abrahamsen, 2017/09/03
- [elpa] externals/ebdb 21ed4b7 19/33: Don't hide cl-print-object definitions, Eric Abrahamsen, 2017/09/03
- [elpa] externals/ebdb 99a1563 12/33: Fix custom type for database buffer-char slot, Eric Abrahamsen, 2017/09/03
- [elpa] externals/ebdb aa668d7 08/33: Add "force" argument to ebdb-db-save, Eric Abrahamsen, 2017/09/03
- [elpa] externals/ebdb 7bed578 11/33: Provide more careful control of finding related records, Eric Abrahamsen, 2017/09/03
- [elpa] externals/ebdb 9b1a2cf 25/33: Use simpler home-grown version of char-fold-to-regexp,
Eric Abrahamsen <=
- [elpa] externals/ebdb c362c2a 23/33: Protect against searching labeled fields with no label, Eric Abrahamsen, 2017/09/03
- [elpa] externals/ebdb 9ff8795 30/33: Alter migration process to convert various folder fields, Eric Abrahamsen, 2017/09/03
- [elpa] externals/ebdb af264e3 18/33: Stop pretending we don't depend on calendar.el, Eric Abrahamsen, 2017/09/03
- [elpa] externals/ebdb 764d89d 21/33: Provide ebdb-load guard in mua-auto-update, Eric Abrahamsen, 2017/09/03
- [elpa] externals/ebdb 70ef68e 22/33: Fix compiler warnings, Eric Abrahamsen, 2017/09/03
- [elpa] externals/ebdb 886c134 27/33: Add new ebdb-field-mail-folder fieldclass, Eric Abrahamsen, 2017/09/03
- [elpa] externals/ebdb 823a7d4 29/33: Use value of ebdb-mua-folder-list in VM splitting, Eric Abrahamsen, 2017/09/03
- [elpa] externals/ebdb a5ffda9 33/33: Merge remote-tracking branch 'elpa/externals/ebdb', Eric Abrahamsen, 2017/09/03
- [elpa] externals/ebdb d6b9b77 06/33: Re-remove ebdb-vm, Eric Abrahamsen, 2017/09/03
- [elpa] externals/ebdb ea2a149 16/33: Add generic tags field, Eric Abrahamsen, 2017/09/03