From 0f521bf1badd555d545946220b022a6b2614b863 Mon Sep 17 00:00:00 2001 From: ueno Date: Sun, 20 Feb 2000 06:24:51 +0000 Subject: [PATCH] * lisp/gnus-bbdb.el: Sync up with Nana-gnus 7 for supporting `gnus-bbdb/split-mail'. * README-gnus-bbdb.ja: Ditto. --- README-gnus-bbdb.ja | 34 ++++++++++++++++++++++ lisp/gnus-bbdb.el | 78 +++++++++++++++++++++++++++++++++++++++++++++++---- 2 files changed, 107 insertions(+), 5 deletions(-) diff --git a/README-gnus-bbdb.ja b/README-gnus-bbdb.ja index 18f3e9b..393256e 100644 --- a/README-gnus-bbdb.ja +++ b/README-gnus-bbdb.ja @@ -102,3 +102,37 @@ FLIM $B$G$O(B quote $B$5$l$?(B eword encoded word $B$O(B decode $B$5$l$^$ ------ cut here ------ cut here ------ cut here ------ cut here ------ --- +gnus-bbdb/split-mail() + +nnmail-split-fancy $B$G;HMQ$9$k$?$a$N4X?t$G$9!#l9g!"(B + `foo-group' $B$K?6$jJ,$1$^$9!#(B + +*2 : `company' $B%U%#!<%k%I$,(B `bar' $B$G;O$^$C$F$$$k>l9g!"(B`company' $B%U%#!<(B + $B%k%I$NFbMF$r$=$N$^$^%0%k!<%WL>$H$7$F;HMQ$7!"?6$jJ,$1$^$9!#(B + +*3 : `group' $B%U%#!<%k%I$,$"$k>l9g!"(B`group' $B%U%#!<%k%I$NFbMF$r$=$N$^$^(B + $B%0%k!<%WL>$H$7$F;HMQ$7!"?6$jJ,$1$^$9!#(B + +*4 : `note' $B%U%#!<%k%I$K(B `my friend' $B$,4^$^$l$k>l9g!"$=$N8e$m$K;XDj$5(B + $B$l$?5,B'$G?6$jJ,$1$^$9!#$3$N5,B'$N5-=RJ}K!$O!"DL>o$N(B + `nnmail-split-fancy' $B$G$N5-=RJ}K!$HF1$8$b$N$G$9!#(B diff --git a/lisp/gnus-bbdb.el b/lisp/gnus-bbdb.el index 93da055..d6e8165 100644 --- a/lisp/gnus-bbdb.el +++ b/lisp/gnus-bbdb.el @@ -3,7 +3,7 @@ ;; Copyright (c) 1991,1992,1993 Jamie Zawinski . ;; Copyright (C) 1995,1996,1997 Shuhei KOBAYASHI ;; Copyright (C) 1997,1998 MORIOKA Tomohiko -;; Copyright (C) 1998 Keiichi Suzuki +;; Copyright (C) 1998,1999 Keiichi Suzuki ;; Author: Keiichi Suzuki ;; Author: Shuhei KOBAYASHI @@ -29,9 +29,11 @@ ;;; Code: (require 'bbdb) +(require 'bbdb-com) (require 'gnus) (require 'std11) (eval-when-compile + (defvar bbdb-pop-up-elided-display) ; default unbound. (require 'gnus-win)) (defvar gnus-bbdb/decode-field-body-function 'nnheader-decode-field-body @@ -53,8 +55,8 @@ the user confirms the creation." (gnus-bbdb/pop-up-bbdb-buffer offer-to-create) (save-excursion (let (from) + (set-buffer gnus-original-article-buffer) (save-restriction - (set-buffer gnus-original-article-buffer) (widen) (narrow-to-region (point-min) (progn (goto-char (point-min)) @@ -78,7 +80,7 @@ the user confirms the creation." (or (bbdb-invoke-hook-for-value bbdb/news-auto-create-p) offer-to-create) - offer-to-create))))))) + offer-to-create)))))) ) ;;;###autoload (defun gnus-bbdb/annotate-sender (string &optional replace) @@ -110,8 +112,6 @@ This buffer will be in bbdb-mode, with associated keybindings." (bbdb-display-records (list record)) (error "unperson")))) -;; Avoid byte-compile warning. -(defvar bbdb-pop-up-elided-display) (defun gnus-bbdb/pop-up-bbdb-buffer (&optional offer-to-create) "Make the *BBDB* buffer be displayed along with the GNUS windows, @@ -146,6 +146,74 @@ displaying the record corresponding to the sender of the current message." (set-buffer b) record))) +;;;###autoload +(defun gnus-bbdb/split-mail (header-field bbdb-field + &optional regexp group) + "Mail split method for `nnmail-split-fancy'. +HEADER-FIELED is a regexp or list of regexps as mail header field name +for gathering mail addresses. If HEADER-FIELED is a string, then it's +used for just matching pattern. If HEADER-FIELED is a list of strings, +then these strings have priorities in the order. + +BBDB-FIELD is field name of BBDB. +Optional argument REGEXP is regexp string for matching BBDB-FIELD value. +If REGEXP is nil or not specified, then all BBDB-FIELD value is matched. + +If GROUP is nil or not specified, then BBDB-FIELD value is returned as +group name. If GROUP is a symbol `&', then list of all matcing group's +BBDB-FEILD values is returned. Otherwise, GROUP is returned." + (if (listp header-field) + (if (eq group '&) + (gnus-bbdb/split-mail (mapconcat 'identity header-field "\\|") + bbdb-field regexp group) + (let (rest) + (while (and header-field + (null (setq rest (gnus-bbdb/split-mail + (car header-field) bbdb-field + regexp group)))) + (setq header-field (cdr header-field))) + rest)) + (let ((pat (concat "^\\(" header-field "\\):[ \t]")) + header-values) + (goto-char (point-min)) + (while (re-search-forward pat nil t) + (setq header-values (cons (buffer-substring (point) + (std11-field-end)) + header-values))) + (let ((address-regexp + (mapconcat + (lambda (lal) + (regexp-quote (std11-address-string lal))) + (apply 'nconc + (mapcar #'std11-parse-addresses-string + header-values)) + "\\|"))) + (unless (zerop (length address-regexp)) + (gnus-bbdb/split-mail-1 address-regexp bbdb-field regexp group)))))) + +(defun gnus-bbdb/split-mail-1 (address-regexp bbdb-field regexp group) + (let ((records (bbdb-search (bbdb-records) nil nil address-regexp)) + prop rest) + (or regexp (setq regexp "")) + (catch 'done + (cond + ((eq group '&) + (while records + (when (and (setq prop (bbdb-record-getprop (car records) bbdb-field)) + (string-match regexp prop) + (not (member prop rest))) + (setq rest (cons prop rest))) + (setq records (cdr records))) + (throw 'done (when rest (cons '& rest)))) + (t + (while records + (when (or (null bbdb-field) + (and (setq prop (bbdb-record-getprop (car records) + bbdb-field)) + (string-match regexp prop))) + (throw 'done (or group prop))) + (setq records (cdr records)))))))) + ;; ;; Announcing BBDB entries in the summary buffer ;; -- 1.7.10.4