;; ;; dot-gnus-bbdb.el --- BBDB-related stuff for Gnus. ;; ;; Automatically create BBDB entries for posts in almost all groups. ;; This is complicated, because we need the `news-auto-create-p' variable to be ;; buffer-local, as we may well visit a mail group with BBDB-creation and a normal ;; one at the same time, and we do not want them to interfere with each other. ;; In a sane world we could just make the `bbdb/news-auto-create-p' variable ;; buffer-local, and it would just work; but unfortunately BBDB looks at the ;; value of that variable in the *article* buffer. So we have to advise the ;; function that does that lookup, suck the value of the variable out of the ;; summary buffer, and locally bind it. Dynamic scope is sometimes *so* useful... (make-variable-buffer-local 'bbdb/news-auto-create-p) (defsubst nix-backwards-string-match (string regexp) "Like `string-match', but with inverted arguments." (string-match regexp string)) (defadvice bbdb/gnus-update-records (around nix-bbdb-use-summary-buffer-news-auto-create-p activate preactivate) "Propagate the value of `news-auto-create-p' from the Summary buffer. This allows it to be buffer-local there, so that we can have different values of this variable in different simultaneously active Summary buffers." (let ((bbdb/news-auto-create-p (symbol-value-in-buffer 'bbdb/news-auto-create-p gnus-summary-buffer))) ad-do-it)) (defun nix-select-group-create-bbdb () "Set up this group to automatically create BBDB entries, if necessary. Must be called from the `gnus-select-group-hook'." (setq bbdb/news-auto-create-p (if (and gnus-newsgroup-name (not (member* gnus-newsgroup-name '("nnml:blockbox" "nnml:spambox" "nnmh:spambox-verified" "fm.announce" "rec.humor.funny.reruns" "rec.humor.oracle") :test 'string=)) (not (member* gnus-newsgroup-name '("^nndoc:") :test 'nix-backwards-string-match))) 'bbdb-ignore-some-messages-hook nil))) ;; Disable Gnus popups entirely in certain groups with high levels of forgery ;; (read: spam groups). (defvar nix-bbdb-suppressed-groups '("nnml:blockbox" "nnml:spambox" "nnmh:spambox-verified") "A list of newsgroups in which the BBDB is entirely deactivated.") (defadvice bbdb/gnus-pop-up-bbdb-buffer (around nix-bbdb-suppress-bbdb activate preactivate) "Suppress all BBDB operations in specific newsgroups." (when (not (member gnus-newsgroup-name nix-bbdb-suppressed-groups)) ad-do-it)) ;; People seen in personal mail should have `permanent' set to `t' in their BBDB ;; entry, so that they are never expired. ;; We need the same sort of ugly hack here to propagate the value of ;; `nix-bbdb-make-permanent' to the right functions as we needed for ;; `bbdb/gnus-update-record'. (defvar nix-bbdb-make-permanent nil "All BBDB records accessed while this is non-nil should be preserved forever. You should bind or locally set this variable, never set it globally.") (defun nix-bbdb-maybe-make-permanent (record) "Make sure that the RECORD never expires." (if (and nix-bbdb-make-permanent (not (bbdb-record-getprop record 'permanent))) (bbdb-record-putprop record 'permanent "t"))) (add-hook 'bbdb-notice-hook 'nix-bbdb-maybe-make-permanent) (defadvice bbdb-annotate-message-sender (around nix-bbdb-use-summary-buffer-nix-bbdb-make-permanent activate preactivate) "Propagate the value of `nix-bbdb-make-permanent' from the Summary buffer. This allows it to be buffer-local there, so that we can have different values of this variable in different simultaneously active Summary buffers." (let ((nix-bbdb-make-permanent (symbol-value-in-buffer 'nix-bbdb-make-permanent gnus-summary-buffer))) ad-do-it)) (defun nix-select-group-permanent-bbdb () "BBDB entries seen in certain groups are never expired at all." (if (string= gnus-newsgroup-name "nnml:Mailbox") (progn (make-local-variable 'nix-bbdb-make-permanent) (setq nix-bbdb-make-permanent t)))) (add-hook 'gnus-select-group-hook 'nix-select-group-create-bbdb) (add-hook 'gnus-select-group-hook 'nix-select-group-permanent-bbdb) ;; Support BBDB for all mail sending, even querying in the minibuffer (define-key message-minibuffer-local-map (kbd "") 'bbdb-complete-name) (provide 'dot-gnus-bbdb)