;; -*- 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
;;   <http://www.zonix.de/projects/emacs/config>
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; BBDB                              <http://www.waider.ie/hacks/emacs/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 <v98yjymgkz.fsf@marauder.physik.uni-ulm.de>
(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 <wjhitglrgje.fsf@spnode33.nerdc.ufl.edu>
;; 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 <nbd7033fyk.fsf@paracelsus.fdm.uni-freiburg.de>
(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 <uu1bhifnn.fsf@att.net>:
;; 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)