the user confirms the creation."
(if bbdb-use-pop-up
(gnus-bbdb/pop-up-bbdb-buffer offer-to-create)
- (save-excursion
- (let (from)
- (set-buffer gnus-original-article-buffer)
- (save-restriction
- (widen)
- (narrow-to-region (point-min)
- (progn (goto-char (point-min))
- (or (search-forward "\n\n" nil t)
- (error "message unexists"))
- (- (point) 2)))
- (when (setq from (mail-fetch-field "from"))
- (setq from (gnus-bbdb/extract-address-components
- (gnus-bbdb/decode-field-body from 'From))))
- (when (and (car (cdr from))
- (string-match (bbdb-user-mail-names)
- (car (cdr from))))
- ;; if logged-in user sent this, use recipients.
- (let ((to (mail-fetch-field "to")))
- (when to
- (setq from
- (gnus-bbdb/extract-address-components
- (gnus-bbdb/decode-field-body to 'To))))))
- (when from
- (bbdb-annotate-message-sender from t
- (or (bbdb-invoke-hook-for-value
- bbdb/news-auto-create-p)
- offer-to-create)
- offer-to-create)))))) )
+ (let ((from (mime-entity-fetch-field gnus-current-headers "from")))
+ (when from
+ (setq from (gnus-bbdb/extract-address-components
+ (gnus-bbdb/decode-field-body from 'From))))
+ (when (and (car (cdr from))
+ (string-match (bbdb-user-mail-names)
+ (car (cdr from))))
+ ;; if logged-in user sent this, use recipients.
+ (let ((to (mime-entity-fetch-field gnus-current-headers "to")))
+ (when to
+ (setq from
+ (gnus-bbdb/extract-address-components
+ (gnus-bbdb/decode-field-body to 'To))))))
+ (when from
+ (bbdb-annotate-message-sender from t
+ (or (bbdb-invoke-hook-for-value
+ bbdb/news-auto-create-p)
+ offer-to-create)
+ offer-to-create)))))
;;;###autoload
(defun gnus-bbdb/annotate-sender (string &optional replace)
replace the existing notes entry (if any)."
(interactive (list (if bbdb-readonly-p
(error "The Insidious Big Brother Database is read-only.")
- (read-string "Comments: "))))
+ (read-string "Comments: "))))
(bbdb-annotate-notes (gnus-bbdb/update-record t) string 'notes replace))
(defun gnus-bbdb/edit-notes (&optional arg)
(cond
(record
(bbdb-pop-up-bbdb-buffer
- (function (lambda (w)
- (with-current-buffer (window-buffer w)
- (memq major-mode
- '(mime-view-mode gnus-article-mode))))))
+ (lambda (w)
+ (with-current-buffer (window-buffer w)
+ (memq major-mode
+ '(mime-view-mode gnus-article-mode)))))
(bbdb-display-records (list record)))
((and (not bbdb-inside-electric-display)
(get-buffer-window bbdb-buffer-name))
(goto-char (point-min))
(while (re-search-forward pat nil t)
(setq header-values (cons (buffer-substring (point)
- (std11-field-end))
+ (std11-field-end))
header-values)))
(let ((address-regexp
(with-temp-buffer
:group 'bbdb-mua-specific-gnus
:type '(choice (const :tag "Mark known posters" t)
(const :tag "Do not mark known posters" nil)))
-(defvaralias 'gnus-bbdb/mark-known-posters
- 'gnus-bbdb/summary-mark-known-posters)
+(static-when (and (fboundp 'defvaralias)
+ (subrp (symbol-function 'defvaralias)))
+ (defvaralias 'gnus-bbdb/mark-known-posters
+ 'gnus-bbdb/summary-mark-known-posters))
(defcustom gnus-bbdb/summary-known-poster-mark "+"
"This is the default character to prefix author names with if
must be `gnus-bbdb/lines-and-from' for GNUS users.)"
:group 'bbdb-mua-specific-gnus
:type 'boolean)
-(defvaralias 'gnus-bbdb/header-show-bbdb-names
- 'gnus-bbdb/summary-show-bbdb-names)
+(static-when (and (fboundp 'defvaralias)
+ (subrp (symbol-function 'defvaralias)))
+ (defvaralias 'gnus-bbdb/header-show-bbdb-names
+ 'gnus-bbdb/summary-show-bbdb-names))
(defcustom gnus-bbdb/summary-prefer-bbdb-data t
"If t, then for posters who are in our BBDB, replace the information
:group 'bbdb-mua-specific-gnus
:type '(choice (const :tag "Prefer real names" t)
(const :tag "Prefer network addresses" nil)))
-(defvaralias 'gnus-bbdb/header-prefer-real-names
- 'gnus-bbdb/summary-prefer-real-names)
+(static-when (and (fboundp 'defvaralias)
+ (subrp (symbol-function 'defvaralias)))
+ (defvaralias 'gnus-bbdb/header-prefer-real-names
+ 'gnus-bbdb/summary-prefer-real-names))
(defcustom gnus-bbdb/summary-user-format-letter "B"
"This is the gnus-user-format-function- that will be used to insert
gnus-bbdb/score-alist)
(defun gnus-bbdb/extract-field-value-init ()
- (when (or (and (eq (current-buffer) (get-buffer gnus-article-buffer))
- (buffer-live-p gnus-original-article-buffer)
- (set-buffer gnus-original-article-buffer))
- (eq (current-buffer) (get-buffer gnus-original-article-buffer)))
- (widen)
- (narrow-to-region (point-min)
- (progn (goto-char (point-min))
- (or (search-forward "\n\n" nil t)
- (error "message unexists"))
- (- (point) 2)))
- 'gnus-bbdb/extract-field-value))
+ (function gnus-bbdb/extract-field-value))
(defun gnus-bbdb/extract-field-value (field-name)
"Given the name of a field (like \"Subject\") this returns the value of
;; divided real-names from addresses; the actual From: and Subject: fields
;; exist only in the message.
(let (value)
- (when (setq value (mail-fetch-field field-name))
+ (when (setq value (mime-entity-fetch-field
+ gnus-current-headers field-name))
(gnus-bbdb/decode-field-body value field-name))))
;;; @ mail-extr
(if (string= address "") (setq address nil))
(if (string= phrase "") (setq phrase nil))
(when (or phrase address)
- (list phrase address))
- ))
+ (list phrase address))))
;;; @ full-name canonicalization methods
;;;
(let (dest)
(while (string-match "\\s +" str)
(setq dest (cons (substring str 0 (match-beginning 0)) dest))
- (setq str (substring str (match-end 0)))
- )
+ (setq str (substring str (match-end 0))))
(or (string= str "")
(setq dest (cons str dest)))
(setq dest (nreverse dest))
- (mapconcat 'identity dest " ")
- ))
+ (mapconcat 'identity dest " ")))
(defun gnus-bbdb/canonicalize-dots (str)
(let (dest)
(while (string-match "\\." str)
(setq dest (cons (substring str 0 (match-end 0)) dest))
- (setq str (substring str (match-end 0)))
- )
+ (setq str (substring str (match-end 0))))
(or (string= str "")
(setq dest (cons str dest)))
(setq dest (nreverse dest))
- (mapconcat 'identity dest " ")
- ))
+ (mapconcat 'identity dest " ")))
;;
;; Insinuation
(when (boundp 'bbdb-extract-field-value-function-list)
(add-to-list 'bbdb-extract-field-value-function-list
'gnus-bbdb/extract-field-value-init))
- (add-hook 'gnus-article-prepare-hook 'gnus-bbdb/update-record)
+ (add-hook 'gnus-article-display-hook 'gnus-bbdb/update-record)
(add-hook 'gnus-save-newsrc-hook 'bbdb-offer-save)
(define-key gnus-summary-mode-map ":" 'gnus-bbdb/show-sender)
(define-key gnus-summary-mode-map ";" 'gnus-bbdb/edit-notes)
projects / elisp / gnus.git- / blobdiff