;;; init-message-modes.el --- Initialize mail-related modes.

;;; Copyright (C) 2001--2011 Nix <nix@esperi.org.uk>.

;; Author: Nix <nix@esperi.org.uk>
;; Created: 2001-07-23
;; Keywords: c lisp local

;; This file is not part of Emacs.

;; This library is free software; you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2.1, or (at your option)
;; any later version.

;;; Commentary:

;; This file does all the initialization that I need for email, news and so
;; forth --- other than Gnus-specific initialization, which is in ~/.gnus.el.

;;; Requirements:

(require 'message)                              ; To avoid an infinite loop of requirements lower down
(require 'boxquote)                             ; This is very cool
(require 'silly-mail)

;;; Code:

(add-hook 'message-mode-hook #'(lambda () (setq fill-column 72))) ; A small width for mail, as netiquette dictates
(add-hook 'mail-mode-hook #'(lambda () (setq fill-column 72)))

;; Get my name and mail address right

(setq user-mail-address "nix@esperi.org.uk"
      query-user-mail-address nil)
(setq mail-host-address "esperi.org.uk")

;; Set up BBDB

;; All other BBDB initialization is expensive and so can be skipped on request.

(if (not (member "--skip-bbdb" command-line-args))
    (progn
      (require 'bbdb)
      (require 'bbdb-com)

      (setq bbdb-hashtable-size 6133)         ; I have a big BBDB: make the hash bigger too

      (bbdb-insinuate-message)

      (add-hook 'gnus-startup-hook 'bbdb-insinuate-gnus)
      (add-hook 'mail-setup-hook 'bbdb-insinuate-sendmail)

      (defun nix-gnus-newsgroup-name (field)
        "Get the current newsgroup name."
        gnus-newsgroup-name)

      (defun nix-fold-continuations-violently (field &optional with)
        "Strip RFC822-style continuation lines from FIELD.
If WITH is non-nil, replace with it.
If nil, replace with nothing whatever, ramming lines together."
        (let ((with (or with "")))
          (replace-in-string field "\\(\r?\n[ \t]+\\)+" with)))

      (defun nix-bbdb-refile-newsgroups-unique-commafied (string1 string2)
        "Merge two newsgroups lists together, eliminating common entries."
        (let ((first-newsgroup-list (split-string string1 "[, ]+"))
              (second-newsgroup-list (split-string string2 "[, ]+")))
          (set 'first-newsgroup-list
                       (append first-newsgroup-list
                               (mapcar (lambda (el) (if (find el first-newsgroup-list :test 'equal)
                                                        nil el))
                               second-newsgroup-list)))
          (mapconcat 'identity (remove* nil first-newsgroup-list) ", ")))

      (defun nix-bbdb-return-first (string1 string2)
        "Return the first argument."
        string1)

      (setq bbdb-auto-notes-alist '(("Newsgroups" (".*" newsgroups nix-gnus-newsgroup-name))
                                    ("Precedence" ("\\(bulk\\|list\\)" newsgroups nix-gnus-newsgroup-name))
                                    ("X-Face" (".*" face nix-fold-continuations-violently))
                                    ("Face" (".*" face nix-fold-continuations-violently)))
            bbdb-user-mail-names "\\(\\(nix\\|\\$}xinix{\\$\\|nix-.*\\)@esperi\\.\\(demon\\.co\\|\\.org\\)\\.uk\\|nick\\.alcock@oracle\\.com\\)"
            bbdb-completion-type 'primary-or-name
            bbdb-get-only-first-address-p nil
            bbdb-pop-up-target-lines 6
            bbdb-complete-name-allow-cycling t
            bbdb-ignore-some-messages-alist '(("Reply-To" . ".*@bugs\\.debian\\.org")
                                              ("From" . "me@privacy\\.net")
                                              ("From" . "copyright-clerk@fsf\\.org")
                                              ("From" . "nospam@nospam\\.com"))
            bbdb-offer-save 'always)

      (setq bbdb-refile-notes-generate-alist
            (append bbdb-refile-notes-generate-alist
                    '((newsgroups . nix-bbdb-refile-newsgroups-unique-commafied)
                      (face . nix-bbdb-return-first))))

      (add-hook 'bbdb-change-hook 'bbdb-delete-redundant-nets)
      (add-hook 'bbdb-notice-hook 'bbdb-auto-notes-hook)

      (require 'bbdb-expire)
      (add-hook 'bbdb-expire-initialize-hook 'bbdb-expire-initialize-bbdb-expire-record-single-hit-p)
      (add-hook 'bbdb-expire-expiry-functions 'bbdb-expire-record-single-hit-p)
      (bbdb-expire-initialize))
  (setq command-line-args (delete "--skip-bbdb" command-line-args)))

;; Certain people have mangled names that we can detect and de-mangle.

(defun nix-bbdb-canonicalize-net-hook (addr)
  "Transform email addresses from tricksy sods with morphing addresses."
  (cond ((string-match "^\\(mouse\\)-[cn][0-9]*\\(@prism\\.datastacks\\.com\\)$" addr)
         (concat (substring addr (match-beginning 1) (match-end 1))
                 (substring addr (match-beginning 2) (match-end 2))))
        ((string-match "^\\(kaih\\)=[a-zA-Z0-9$-]*\\(@khms\\.westfalen\\.de\\)$" addr)
         (concat (substring addr (match-beginning 1) (match-end 1))
                 (substring addr (match-beginning 2) (match-end 2))))
        ((string-match "^\\(apommer\\)\\+[0-9]+\\(@cosy\\.sbg\\.ac\\.at\\)$" addr)
         (concat (substring addr (match-beginning 1) (match-end 1))
                 (substring addr (match-beginning 2) (match-end 2))))
        ((string-match"usenet-.*@\\(.*\\.vegetable\\.org\\.uk\\)$" addr)
         (concat "piglet@"
                 (substring addr (match-beginning 1) (match-end 1))))
        ((and (string-match "@\\(gurus\\.tf\\|\\miggy\\.org\\)$" addr)
              (not (string= "athanasius@miggy.org" addr))
              (not (string= "athanasius@gurus.tf" addr)))
         (concat "athanasius@"
                 (substring addr (match-beginning 1) (match-end 1))))
        ((string-match "^rjk\\+.*@.*\\.greenend\\.org\\.uk$" addr)
         "rjk@greenend.org.uk")
        ((string-match "^news[0-9]+@w21\\.org$" addr)
         "Juergen.Nickelsen@jnickelsen.de")
        ((and (string-match "\\(@pir\\.net\\)$" addr)
              (not (string= "fubar@pir.net" addr))
              (not (string= "dsr@pir.net" addr))
              (not (string= "leeann@pir.net" addr))
              (not (string= "pir@pir.net" addr)))
         (concat "pir"
                 (substring addr (match-beginning 1) (match-end 1))))
        ((string-match "^gtaylor+.*@picante\\.com$" addr)
         "gtaylor@picante.com")
                                        ; This one is unusual: a bugs.d.o address in a reply-to yields
                                        ; a corrupted unnamed record.
        ((and (string-match ".*@bugs\\.debian\\.org" addr))
         "submit@bugs.debian.org")
        (t addr)))

(setq bbdb-canonicalize-net-hook 'nix-bbdb-canonicalize-net-hook)

;; Taunt the poor sods I'm mailing to.
;; Note that there are at least two, maybe three, different hooks to set. Argh.

(defun frob-vm-mode-hooks ()
 "Frob the VM mode hooks as VM is loaded.
  Currently puts the Emacs insulter into place."
 (add-hook 'vm-mail-mode-hook 'sm-add-emacs-taunt)
 (remove-hook 'vm-mode-hook 'frob-vm-mode-hooks))

(add-hook 'vm-mode-hook 'frob-vm-mode-hooks)
(add-hook 'message-send-hook 'sm-add-emacs-taunt)

(defvar sm-emacs-taunt-header "X-Emacs")

(provide 'init-message-modes)

;; Stuff for IRC.
;; This relies upon the (rather cool) speechd working on the system.

(setq erc-nick "NullNix"
      erc-user-full-name "Nix"
      erc-server "ircnet.demon.co.uk"
      erc-port "6666"
      erc-auto-query 'window-noselect
      erc-filling t
      erc-bbdb-auto-create-on-join-p t
      erc-bbdb-auto-create-on-nick-p t
      erc-bbdb-auto-create-on-whois-p t
      erc-interpret-mirc-color t
      erc-default-fill-column 132
      erc-fill-column 132
      erc-play-sound nil
      erc-page-function #'(lambda (sender msg)
                            (condition-case nil    ; Emacs emits a useless error when writing to a FIFO
                                (with-temp-buffer
                                  (insert (concat "IRC Page from " sender ": " msg))
                                  (write-region (point-min) (point-max) "/dev/speech"))
                              (file-error t)))
      erc-paranoid t
      erc-disable-ctcp-replies nil
      erc-anonymous-login t
      erc-email-userid "not-available"
      erc-pals '("AllNight^" "AllNight")
      erc-host-danger-highlight nil
      erc-max-buffer-size 200000
      erc-log-channels-directory (expand-file-name "~/var/log/erc")
      erc-log-channels t
      erc-user-information "If you can see this, I have a bug. Please tell me."
      erc-insert-hook '(erc-truncate-buffer)
      erc-manual-set-nick-on-bad-nick-p t
      erc-minibuffer-notice t
      erc-modules '(autoaway autojoin bbdb button fill
                    irccontrols log match netsplit noncommands
                    notify pcomplete readonly ring services
                    stamp track)
      erc-nickserv-passwords '((DALnet (("NullNix" "CT01kaxc22H"))))
      erc-netsplit-show-server-mode-changes-flag t
      erc-prompt-for-password nil
      erc-reuse-buffers nil
      erc-server-flood-margin 50
      erc-server-send-ping-interval 300
      erc-whowas-on-nosuchnick t)