From 9256ce2794c90cf7d45f6aacd042ef4a7526c0ff Mon Sep 17 00:00:00 2001 From: yamaoka Date: Mon, 10 Sep 2001 05:53:44 +0000 Subject: [PATCH] * lisp/gnus-namazu.el: Autoload "regexp-opt" for Mule 2.3. * Mule23@1934.en, Mule23@1934.ja: To install contrib/regexp-opt.el is required. * contrib/regexp-opt.el: Imported from Emacs 20.2. * lisp/gnus-bbdb.el (gnus-bbdb/pop-up-bbdb-buffer): Use `bbdb-display-layout' or `bbdb-pop-up-display-layout' instead of `bbdb-elided-display' or `bbdb-pop-up-elided-display' when BBDB v2.33 or later is running. --- ChangeLog | 14 +++ Mule23@1934.en | 14 +++ Mule23@1934.ja | 14 +++ contrib/regexp-opt.el | 238 +++++++++++++++++++++++++++++++++++++++++++++++++ lisp/gnus-bbdb.el | 7 +- lisp/gnus-namazu.el | 3 + 6 files changed, 289 insertions(+), 1 deletion(-) create mode 100644 contrib/regexp-opt.el diff --git a/ChangeLog b/ChangeLog index 1492c75..17e12db 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,17 @@ +2001-09-10 Katsumi Yamaoka + + * lisp/gnus-namazu.el: Autoload "regexp-opt" for Mule 2.3. + + * Mule23@1934.en, Mule23@1934.ja: To install contrib/regexp-opt.el + is required. + + * contrib/regexp-opt.el: Imported from Emacs 20.2. + + * lisp/gnus-bbdb.el (gnus-bbdb/pop-up-bbdb-buffer): Use + `bbdb-display-layout' or `bbdb-pop-up-display-layout' instead of + `bbdb-elided-display' or `bbdb-pop-up-elided-display' when BBDB + v2.33 or later is running. + 2001-09-10 TSUCHIYA Masatoshi * lisp/gnus-namazu.el (top): Not require `std11'. diff --git a/Mule23@1934.en b/Mule23@1934.en index ae13f11..214ca64 100644 --- a/Mule23@1934.en +++ b/Mule23@1934.en @@ -62,6 +62,20 @@ By the way, the latest CUSTOM package for Emacs v19 is available from: ftp://ftp.dina.kvl.dk/pub/Staff/Per.Abrahamsen/custom/custom-1.9962.tar.gz +INSTALL regexp-opt.el +===================== + +Some T-gnus modules use the functions `regexp-opt', etc. That +functions are defined in regexp-opt.el(c) in the recent Emacsen, +however, Mule 2.3 does not contain it in the standard Lisp libraries. +Copy the file contrib/regexp-opt.el to site-lisp directory (or any +other directory), and byte-compile it as follows: + + % cp -p contrib/regexp-opt.el /usr/local/share/mule/site-lisp + % cd /usr/local/share/mule/site-lisp/ + % mule -batch -q -no-site-file -f batch-byte-compile regexp-opt.el + + INSTALL T-gnus ============== diff --git a/Mule23@1934.ja b/Mule23@1934.ja index ec2aecf..b69d2c7 100644 --- a/Mule23@1934.ja +++ b/Mule23@1934.ja @@ -63,6 +63,20 @@ T-gnus $B$O:G?7HG$N(B CUSTOM, APEL, FLIM $B$*$h$S(B SEMI $B$+(B WEMI $B$r ftp://ftp.dina.kvl.dk/pub/Staff/Per.Abrahamsen/custom/custom-1.9962.tar.gz +INSTALL regexp-opt.el +===================== + +T-gnus $B$N$$$/$D$+$N%b%8%e!<%k$O(B `regexp-opt' $B$J$I$N4X?t$r;H$$$^$9!#$=(B +$B$l$i$N4X?t$O!":G6a$N(B Emacsen $B$G$O(B regexp-opt.el(c) $B$GDj5A$5$l$F$$$k$N(B +$B$G$9$,!"(BMule 2.3 $B$O$=$l$rI8=`$N(B Lisp $B%i%$%V%i%j$NCf$K4^$s$G$$$^$;$s!#(B +$B0J2<$N$h$&$K(B contrib/regexp-opt.el $B$r(B site-lisp $B%G%#%l%/%H%j(B ($B$^$?$OB>(B +$B$N%G%#%l%/%H%j(B) $B$K%3%T!<$7$F!"(Bbyte-compile $B$7$F2<$5$$!#(B + + % cp -p contrib/regexp-opt.el /usr/local/share/mule/site-lisp + % cd /usr/local/share/mule/site-lisp/ + % mule -batch -q -no-site-file -f batch-byte-compile regexp-opt.el + + INSTALL T-gnus ============== diff --git a/contrib/regexp-opt.el b/contrib/regexp-opt.el new file mode 100644 index 0000000..589f1b7 --- /dev/null +++ b/contrib/regexp-opt.el @@ -0,0 +1,238 @@ +;;; regexp-opt.el --- generate efficient regexps to match strings. + +;; Copyright (C) 1994, 1995, 1996, 1997 Free Software Foundation, Inc. + +;; Author: Simon Marshall +;; Keywords: strings, regexps + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; The "opt" in "regexp-opt" stands for "optim\\(al\\|i\\(se\\|ze\\)\\)". +;; +;; This package generates a regexp from a given list of strings (which matches +;; one of those strings) so that the regexp generated by: +;; +;; (regexp-opt strings) +;; +;; is equivalent to, but more efficient than, the regexp generated by: +;; +;; (mapconcat 'regexp-quote strings "\\|") +;; +;; For example: +;; +;; (let ((strings '("cond" "if" "when" "unless" "while" +;; "let" "let*" "progn" "prog1" "prog2" +;; "save-restriction" "save-excursion" "save-window-excursion" +;; "save-current-buffer" "save-match-data" +;; "catch" "throw" "unwind-protect" "condition-case"))) +;; (concat "(" (regexp-opt strings t) "\\>")) +;; => "(\\(c\\(atch\\|ond\\(ition-case\\)?\\)\\|if\\|let\\*?\\|prog[12n]\\|save-\\(current-buffer\\|excursion\\|match-data\\|restriction\\|window-excursion\\)\\|throw\\|un\\(less\\|wind-protect\\)\\|wh\\(en\\|ile\\)\\)\\>" +;; +;; Searching using the above example `regexp-opt' regexp takes approximately +;; two-thirds of the time taken using the equivalent `mapconcat' regexp. + +;; Since this package was written to produce efficient regexps, not regexps +;; efficiently, it is probably not a good idea to in-line too many calls in +;; your code, unless you use the following trick with `eval-when-compile': +;; +;; (defvar definition-regexp +;; (eval-when-compile +;; (concat "^(" +;; (regexp-opt '("defun" "defsubst" "defmacro" "defalias" +;; "defvar" "defconst") t) +;; "\\>"))) +;; +;; The `byte-compile' code will be as if you had defined the variable thus: +;; +;; (defvar definition-regexp +;; "^(\\(def\\(alias\\|const\\|macro\\|subst\\|un\\|var\\)\\)\\>") +;; +;; Note that if you use this trick for all instances of `regexp-opt' and +;; `regexp-opt-depth' in your code, regexp-opt.el would only have to be loaded +;; at compile time. But note also that using this trick means that should +;; regexp-opt.el be changed, perhaps to fix a bug or to add a feature to +;; improve the efficiency of `regexp-opt' regexps, you would have to recompile +;; your code for such changes to have effect in your code. + +;; Originally written for font-lock.el, from an idea from Stig's hl319.el, with +;; thanks for ideas also to Michael Ernst, Bob Glickstein and Dan Nicolaescu. +;; Please don't tell me that it doesn't produce optimal regexps; I know that +;; already. For example, the above explanation for the meaning of "opt" would +;; be more efficient as "optim\\(al\\|i[sz]e\\)", but this requires complex +;; forward looking. But (ideas or) code to improve things (are) is welcome. + +;;; Code: + +;;;###autoload +(defun regexp-opt (strings &optional paren) + "Return a regexp to match a string in STRINGS. +Each string should be unique in STRINGS and should not contain any regexps, +quoted or not. If optional PAREN is non-nil, ensure that the returned regexp +is enclosed by at least one regexp grouping construct. +The returned regexp is typically more efficient than the equivalent regexp: + + (let ((open-paren (if PAREN \"\\\\(\" \"\")) (close-paren (if PAREN \"\\\\)\" \"\"))) + (concat open-paren (mapconcat 'regexp-quote STRINGS \"\\\\|\") close-paren)) + +but typically contains more regexp grouping constructs. +Use `regexp-opt-depth' to count them." + (save-match-data + ;; Recurse on the sorted list. + (let ((max-lisp-eval-depth (* 1024 1024)) + (completion-ignore-case nil)) + (regexp-opt-group (sort (copy-sequence strings) 'string-lessp) paren)))) + +;;;###autoload +(defun regexp-opt-depth (regexp) + "Return the depth of REGEXP. +This means the number of regexp grouping constructs (parenthesised expressions) +in REGEXP." + (save-match-data + ;; Hack to signal an error if REGEXP does not have balanced parentheses. + (string-match regexp "") + ;; Count the number of open parentheses in REGEXP. + (let ((count 0) start) + (while (string-match "\\\\(" regexp start) + (setq count (1+ count) start (match-end 0))) + count))) + +;;; Workhorse functions. + +(eval-when-compile + (require 'cl)) + +(unless (fboundp 'make-bool-vector) + (defalias 'make-bool-vector 'make-vector)) + +(defun regexp-opt-group (strings &optional paren lax) + ;; + ;; Return a regexp to match a string in STRINGS. + ;; If PAREN non-nil, output regexp parentheses around returned regexp. + ;; If LAX non-nil, don't output parentheses if it doesn't require them. + ;; Merges keywords to avoid backtracking in Emacs' regexp matcher. + ;; + ;; The basic idea is to find the shortest common prefix, remove it and + ;; recurse. If there is no prefix, we divide the list into two so that (at + ;; least) one half will have at least a one-character common prefix. + ;; + ;; Also we delay the addition of grouping parenthesis as long as possible + ;; until we're sure we need them, and try to remove one-character sequences + ;; so we can use character sets rather than grouping parenthesis. + ;; + (let* ((open-group (if paren "\\(" "")) + (close-group (if paren "\\)" "")) + (open-charset (if lax "" open-group)) + (close-charset (if lax "" close-group))) + (cond + ;; + ;; If there is only one string, just return it. + ((= (length strings) 1) + (if (= (length (car strings)) 1) + (concat open-charset (regexp-quote (car strings)) close-charset) + (concat open-group (regexp-quote (car strings)) close-group))) + ;; + ;; If there is an empty string, remove it and recurse on the rest. + ((= (length (car strings)) 0) + (concat open-charset + (regexp-opt-group (cdr strings) t t) "?" + close-charset)) + ;; + ;; If all are one-character strings, just return a character set. + ((= (length strings) (apply '+ (mapcar 'length strings))) + (concat open-charset + (regexp-opt-charset strings) + close-charset)) + ;; + ;; We have a list of different length strings. + (t + (let ((prefix (try-completion "" (mapcar 'list strings))) + (letters (let ((completion-regexp-list '("^.$"))) + (all-completions "" (mapcar 'list strings))))) + (cond + ;; + ;; If there is a common prefix, remove it and recurse on the suffixes. + ((> (length prefix) 0) + (let* ((length (length prefix)) + (suffixes (mapcar (lambda (s) (substring s length)) strings))) + (concat open-group + (regexp-quote prefix) (regexp-opt-group suffixes t t) + close-group))) + ;; + ;; If there are several one-character strings, remove them and recurse + ;; on the rest (first so the final regexp finds the longest match). + ((> (length letters) 1) + (let ((rest (let ((completion-regexp-list '("^..+$"))) + (all-completions "" (mapcar 'list strings))))) + (concat open-group + (regexp-opt-group rest) "\\|" (regexp-opt-charset letters) + close-group))) + ;; + ;; Otherwise, divide the list into those that start with a particular + ;; letter and those that do not, and recurse on them. + (t + (let* ((char (substring (car strings) 0 1)) + (half1 (all-completions char (mapcar 'list strings))) + (half2 (nthcdr (length half1) strings))) + (concat open-group + (regexp-opt-group half1) "\\|" (regexp-opt-group half2) + close-group))))))))) + +(defun regexp-opt-charset (chars) + ;; + ;; Return a regexp to match a character in CHARS. + ;; + ;; The basic idea is to find character ranges. Also we take care in the + ;; position of character set meta characters in the character set regexp. + ;; + (let* ((charwidth 256) ; Yeah, right. + (charmap (make-bool-vector charwidth nil)) + (charset "") + (bracket "") (dash "") (caret "")) + ;; + ;; Make a character map but extract character set meta characters. + (dolist (char (mapcar 'string-to-char chars)) + (case char + (?\] + (setq bracket "]")) + (?^ + (setq caret "^")) + (?- + (setq dash "-")) + (otherwise + (aset charmap char t)))) + ;; + ;; Make a character set from the map using ranges where applicable. + (dotimes (char charwidth) + (let ((start char)) + (while (and (< char charwidth) (aref charmap char)) + (incf char)) + (cond ((> char (+ start 3)) + (setq charset (format "%s%c-%c" charset start (1- char)))) + ((> char start) + (setq charset (format "%s%c" charset (setq char start))))))) + ;; + ;; Make sure a caret is not first and a dash is first or last. + (if (and (string-equal charset "") (string-equal bracket "")) + (concat "[" dash caret "]") + (concat "[" bracket charset caret dash "]")))) + +(provide 'regexp-opt) + +;;; regexp-opt.el ends here diff --git a/lisp/gnus-bbdb.el b/lisp/gnus-bbdb.el index 1bd2cdc..e2dbeca 100644 --- a/lisp/gnus-bbdb.el +++ b/lisp/gnus-bbdb.el @@ -114,7 +114,12 @@ displaying the record corresponding to the sender of the current message." (record (let (bbdb-use-pop-up) (gnus-bbdb/update-record offer-to-create))) - (bbdb-elided-display (bbdb-pop-up-elided-display))) + (bbdb-display-layout + (cond ((boundp 'bbdb-pop-up-display-layout) + (symbol-value 'bbdb-pop-up-display-layout)) + ((boundp 'bbdb-pop-up-elided-display) + (symbol-value 'bbdb-pop-up-elided-display)))) + (bbdb-elided-display bbdb-display-layout)) (save-current-buffer ;; display the bbdb buffer iff there is a record for this article. (cond diff --git a/lisp/gnus-namazu.el b/lisp/gnus-namazu.el index 4707858..ff157af 100644 --- a/lisp/gnus-namazu.el +++ b/lisp/gnus-namazu.el @@ -69,6 +69,9 @@ (require 'nnmail) (require 'gnus-sum) +;; It is required for Mule 2.3. See the file Mule23@1934.en. +(eval-and-compile + (autoload 'regexp-opt "regexp-opt")) (defgroup gnus-namazu nil "Search nnmh and nnml groups in Gnus with Namazu." -- 1.7.10.4