;; -*- emacs-lisp -*- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; $Id: gnus_bbdb.el,v 1.24 2006-11-06 21:02:42 rscholz Exp $ ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; Einstellungen für BBDB (Adressbuch) ;; ;; Die offizielle Quelle dieser Datei ist ;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; BBDB ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; CVS BBDB im $HOME (add-to-list 'load-path (concat zonix-elisp-dir "bbdb/lisp")) (add-to-list 'load-path (concat zonix-elisp-dir "bbdb/bits")) (add-to-list 'Info-default-directory-list (expand-file-name (concat zonix-elisp-dir "bbdb/texinfo"))) ;; BBDB-Utils (add-to-list 'load-path (concat zonix-elisp-dir "bbdb-utils")) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Initialisierung ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (require 'bbdb) ;; Einbinden ;(bbdb-initialize 'gnus 'message 'w3) (bbdb-initialize 'gnus 'message) ;; Message-Mode für Mails verwenden (setq bbdb-send-mail-style 'compose-mail) ;; BBDB-Einträge als normale Aliase im Message-Mode (add-hook 'message-setup-hook 'bbdb-define-all-aliases) (add-hook 'message-setup-hook 'mail-abbrevs-setup) ;; BBDB bei message-resend benutzen (ab Gnus 5.10) (require 'message) (define-key message-minibuffer-local-map [(tab)] 'bbdb-complete-name) ;; eigene Adresse ignorieren (setq bbdb-user-mail-names gnus-ignored-from-addresses) ;; kein Land als Default in der Adresse (setq bbdb-default-country nil) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Interna ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; kein Syntax-Check für Telefonnummern (setq bbdb-north-american-phone-numbers-p nil) ;; immer zu vollem Namen expandieren (setq bbdb-dwim-net-address-allow-redundancy t) ;; rotieren bei mehr als einer Adresse (setq bbdb-complete-name-allow-cycling t) ;; auf Namen und erste Adresse expandieren ;(setq bbdb-completion-type 'primary-or-name) ;; auf alle Einträge expandieren (setq bbdb-completion-type nil) ;; automatisch abspeichern (setq bbdb-offer-save 'auto) ;; ab BBDB 2.35 ;(setq bbdb-file-coding-system 'utf-8) ;; keine US-Schemata für Adressen (setq bbdb-address-editing-function 'bbdb-address-edit-continental) (setq bbdb-continental-zip-regexp "^\\s *\\([A-Z][A-Z]?\\s *-\\s *\\)?[0-9][0-9][0-9]") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Darstellung ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; 2 Zeilen-Layout (setq window-min-height 1) (setq bbdb-pop-up-target-lines 1) ;; Kurzform ;(setq bbdb-elided-display t) ;; Kurzform ;(setq bbdb-pop-up-elided-display t) (setq bbdb-pop-up-display-layout 'multi-line) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Informationen sammeln ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; automatisch (add-hook 'bbdb-notice-hook 'bbdb-auto-notes-hook) (setq bbdb-auto-notes-alist (list '("Organization" (".*" company 0)) '("Organisation" (".*" company 0)) '("Newsgroups" ("[^,]+" newsgroups 0)) '("X-BeenThere" (".*" mailinglists 0)) '("X-Mailing-List" (".*" mailinglists 0)) '("Mailing-List" (".*" mailinglists 0)) '("Errors-To" (".*" mailinglists 0)) '("List-Post" (".*" mailinglists 0)) ; '("X-Face" (".*" face 0 t)) ; '("X-Face-Img" (".*" face 0 t)) '("Subject" (".*" subjects 0)) '("X-Now-Playing" (".*" playlist 0)) '("User-Agent" (".*" mailer 0)) '("X-URL" (".*" www 0)) '("X-Mailer" (".*" mailer 0)) '("X-Newsreader" (".*" mailer 0)) ; '("Message-ID" (".*" last-msgid 0 t)) )) ;; Reiner Steib in (setq rs-bbdb-ignored-from-list '("member@orkut.com" "me@privacy.net" "@public.gmane.org")) (setq bbdb/news-auto-create-p nil) (setq bbdb/news-auto-create-hook 'bbdb-ignore-some-messages-hook) (setq bbdb/mail-auto-create-p 'bbdb-ignore-some-messages-hook) (setq bbdb-ignore-some-messages-alist `(("From" . , (regexp-opt rs-bbdb-ignored-from-list)))) ;; Automagisch in BBDB aufnehmen ;(defun my-bbdb-news-auto-create-p () ; (or (string-match "mail.privat" gnus-newsgroup-name) ; (string-match "mail.website" gnus-newsgroup-name))) ;(setq bbdb/news-auto-create-p 'my-bbdb-news-auto-create-p)) ;; Trennen der Infos mit Newlines (setq bbdb-notes-default-separator "\n") (add-hook 'bbdb-notice-hook 'bbdb-timestamp-hook) (add-hook 'bbdb-create-hook 'bbdb-creation-date-hook) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; variable Email-Adressen automatisch zurechtschneiden ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Obsolete Adressen in das Feld obsolete-net verschieben (require 'bbdb-obsolete-net "bbdb-obsolete") ;; Datumsabhaengige Adressen umsetzen joe-2000@domain.xx -> joe@domain.xx ;; NG-abhaengige Adressen umsetzen joe+gnu.emacs.gnus@domain.xx -> joe@domain.xx ;; TMDA-Adressen umsetzen joe-dated-989958350.021c23@domain.xx -> joe@domain.xx ;; Hexadezimale Adressen umsetzen joe-0A@domain.xx -> joe@domain.xx (setq bbdb-canonicalize-net-hook '(lambda (addr) (cond ((string-match "\\`\\([^=-]+\\)[=-].*public\.gmane\.org\\'" addr) (concat (substring addr (match-beginning 1) (match-end 1)) "@public.gmane.org")) ((string-match "\\`\\([^0-9]+\\)\\(-\\(dated\\|exp\\)-[^@]+\\|-[0-9ABCDEF]+\\|\\+[^@]+\\)\\(@.*\\)\\'" addr) (concat (substring addr (match-beginning 1) (match-end 1)) (substring addr (match-beginning 4) (match-end 4)))) (t (bbdb-obsolete-net-canonicalize-net-hook addr))))) ;; "\\(-dated-[^@]+\\|-[0-9]+\\|\\+[^@]+\\.[^@]+\\)" ;; http://my.gnus.org/Lisp/1012312767 ;; FIXME: in der CVS-Version von BBDB ist es ein "richtiger" Hook, in ;; den man Funktionen hängen kann. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; BBDB-Felder automatisch kürzen ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Steven L. Ulmer in ;; generische Erweiterung von mir (defun ulmer:bbdb-trim-notes (record field num-to-keep) "Remove all but the first some lines from a notes field of a BBDB record. Meant to be added to bbdb-notice-hook." (let* ((sep (get field 'field-separator)) (foo (reverse (split-string (or (bbdb-record-getprop record field) "") sep))) (new-field "")) (while (and (> num-to-keep 0) (> (length foo) 0)) (if (> (length (car foo)) 0) (setq new-field (concat (car foo) (if (> (length new-field) 0) (concat sep new-field) "")) num-to-keep (- num-to-keep 1))) (setq foo (cdr foo))) (and (> (length foo) 0) (bbdb-record-putprop record field new-field)))) (defun ulmer:bbdb-trim-subjects (record) (ulmer:bbdb-trim-notes record 'subjects 20)) (defun ulmer:bbdb-trim-playlist (record) (ulmer:bbdb-trim-notes record 'playlist 20)) (defun ulmer:bbdb-trim-mailer (record) (ulmer:bbdb-trim-notes record 'mailer 20)) (defun ulmer:bbdb-trim-newsgroups (record) (ulmer:bbdb-trim-notes record 'newsgroups 20)) (defun ulmer:bbdb-trim-company (record) (ulmer:bbdb-trim-notes record 'company 3)) (put 'subjects 'field-separator "\n") (put 'playlist 'field-separator "\n") (put 'mailer 'field-separator "\n") (put 'newsgroups 'field-separator "\n") ;(put 'company 'field-separator "\n") (add-hook 'bbdb-notice-hook 'ulmer:bbdb-trim-subjects) (add-hook 'bbdb-notice-hook 'ulmer:bbdb-trim-playlist) (add-hook 'bbdb-notice-hook 'ulmer:bbdb-trim-mailer) (add-hook 'bbdb-notice-hook 'ulmer:bbdb-trim-newsgroups) (add-hook 'bbdb-notice-hook 'ulmer:bbdb-trim-company) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; erweiterte Funktionen / Add-Ons ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Druckfunktionen (add-hook 'bbdb-load-hook (function (lambda () (require 'bbdb-print)))) (setq bbdb-print-require t) ;; BBDB-Query (require 'bbdb-query) (global-set-key [C-f10] 'bbdb-create) (global-set-key [C-f11] 'bbdb-query) ;; Work around für bbdb-query, diese Variable ist in neueren ;; BBDB-Versionen nicht mehr vorhanden (setq bbdb-elided-display nil) ;; BBDB-Buffer schließen, wenn Gnus beendet wird (add-hook 'gnus-exit-group-hook '(lambda nil (let ((buf (get-buffer "*BBDB*"))) (when buf (bury-buffer buf))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; bbdb-pgp (Automatisches Verschlüsseln / Signieren abhängig von Adressat) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (require 'bbdb-pgp) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Mehrere Datenbanken ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Von Thomas Gerds in (defun bbdb-switch-to-other-bbdb-file (&optional db dont-ask) (interactive) (bbdb-save-db) (unless db (setq db (if dont-ask (expand-file-name "~/.bbdb") (read-file-name "Use bbdb database ")))) (setq bbdb-file db bbdb-buffer (get-file-buffer db))) ;; (add-hook 'gnus-select-group-hook ;; '(lambda () ;; (let ((bbdb (cond ((string-match "some-special-group" ;; (zonix-get-group-name)) ;; "~/.bbdb-special") ;; (t "~/.bbdb")))) ;; (bbdb-switch-to-other-bbdb-file bbdb t)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; BBDB-Eintrag für alle ausgehenden Mails ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Michael R. Wolf in : ;; BBDB-Einträge erstellen für ausgehende Mails ;; TODO: Remove the mapconcat addition of commas, that get removed by m-t-h (defun wolf3-bbdb-add-recipients-to-bbdb () "Add all recipients to BBDB, using this list of headers: from, sender, to, cc, bcc, resent-from, resent-to, resent-cc, resent-bcc." (let ((fields '("from" "sender" "to" "cc" "bcc" "resent-from" "resent-to" "resent-cc" "resent-bcc"))) (mapc (lambda (address) (bbdb-annotate-message-sender address t t t)) (save-restriction (message-narrow-to-headers) (message-tokenize-header (mapconcat 'message-fetch-field fields ",")))))) ;; Could go into many hooks: ;; message-send-mail-hook ;; message-send-news-hook ;; message-send-hook ;; message-sent-hook ;(add-hook 'message-send-hook 'wolf3-bbdb-add-recipients-to-bbdb)