Paste number 9883: Complete solution for dealing with obscured email addresses on a per-group basis.

Index of paste annotations: 1

Paste number 9883: Complete solution for dealing with obscured email addresses on a per-group basis.
Pasted by: mwolson
When:3 years, 11 months ago
Share:Tweet this! | http://paste.lisp.org/+7MJ
Channel:#emacs
Paste contents:
Raw Source | XML | Display As

;; For each group that has obscured email addresses, enter it, do
;; C-M-e, and fill in:

((dummy
  (set
   (make-local-variable 'bbdb/gnus-update-records-mode)
   'searching)))

;; Then put the following function definition in your .emacs or .gnus,
;; after the (require 'bbdb) statement.

;; Consult the summary buffer for whether or not to prompt for new
;; email addresses on a known account.

(defun bbdb/gnus-update-records (&optional offer-to-create)
  "Return the records corresponding to the current GNUS message, creating
or modifying it as necessary.  A record will be created if
bbdb/news-auto-create-p is non-nil or if OFFER-TO-CREATE is true
and the user confirms the creation.

The variable `bbdb/gnus-update-records-mode' controls what actions
are performed and it might override `bbdb-update-records-mode'.

When hitting C-g once you will not be asked anymore for new people listed
in this message, but it will search only for existing records.  When hitting
C-g again it will stop scanning."
  (let ((bbdb-update-records-mode
         (when (and (boundp 'gnus-summary-buffer) gnus-summary-buffer)
           (with-current-buffer gnus-summary-buffer
             bbdb/gnus-update-records-mode)))
        (bbdb/gnus-offer-to-create offer-to-create)
        ;; here we may distiguish between different type of messages
        ;; for those that have no message id we have to find something
        ;; else as message key.
        (msg-id (bbdb/gnus-get-message-id))
        records cache)
    (save-excursion
      (set-buffer gnus-article-buffer)
      (if (and msg-id (not bbdb/gnus-offer-to-create))
          (setq cache (bbdb-message-cache-lookup msg-id)))

      (if cache
          (setq records (if bbdb-get-only-first-address-p
                            (list (car cache))
                          cache))
        (setq records (bbdb-update-records
                       (bbdb-get-addresses
                        bbdb-get-only-first-address-p
                        (or (if (boundp 'gnus-ignored-from-addresses)
                                gnus-ignored-from-addresses)
                            bbdb-user-mail-names)
                        'gnus-fetch-field)
                       bbdb/news-auto-create-p
                       offer-to-create))
        (if (and bbdb-message-caching-enabled msg-id)
            (bbdb-encache-message msg-id records))))
    records))

Annotations for this paste:

Annotation number 1: use buffer-live-p
Pasted by: mwolson
When:3 years, 11 months ago
Share:Tweet this! | http://paste.lisp.org/+7MJ#1
Paste contents:
Raw Source | Display As
(defun bbdb/gnus-update-records (&optional offer-to-create)
  "Return the records corresponding to the current GNUS message, creating
or modifying it as necessary.  A record will be created if
bbdb/news-auto-create-p is non-nil or if OFFER-TO-CREATE is true
and the user confirms the creation.

The variable `bbdb/gnus-update-records-mode' controls what actions
are performed and it might override `bbdb-update-records-mode'.

When hitting C-g once you will not be asked anymore for new people listed
in this message, but it will search only for existing records.  When hitting
C-g again it will stop scanning."
  (let ((bbdb-update-records-mode
         (when (and (boundp 'gnus-summary-buffer)
                    (buffer-live-p gnus-summary-buffer))
           (with-current-buffer gnus-summary-buffer
             bbdb/gnus-update-records-mode)))
        (bbdb/gnus-offer-to-create offer-to-create)
        ;; here we may distiguish between different type of messages
        ;; for those that have no message id we have to find something
        ;; else as message key.
        (msg-id (bbdb/gnus-get-message-id))
        records cache)
    (save-excursion
      (set-buffer gnus-article-buffer)
      (if (and msg-id (not bbdb/gnus-offer-to-create))
          (setq cache (bbdb-message-cache-lookup msg-id)))

      (if cache
          (setq records (if bbdb-get-only-first-address-p
                            (list (car cache))
                          cache))
        (setq records (bbdb-update-records
                       (bbdb-get-addresses
                        bbdb-get-only-first-address-p
                        (or (if (boundp 'gnus-ignored-from-addresses)
                                gnus-ignored-from-addresses)
                            bbdb-user-mail-names)
                        'gnus-fetch-field)
                       bbdb/news-auto-create-p
                       offer-to-create))
        (if (and bbdb-message-caching-enabled msg-id)
            (bbdb-encache-message msg-id records))))
    records))

Colorize as:
Show Line Numbers
Index of paste annotations: 1

Lisppaste pastes can be made by anyone at any time. Imagine a fearsomely comprehensive disclaimer of liability. Now fear, comprehensively.