Gnus Email and NNTP Handling

(setq
 nntp-marks-is-evil t
 bbdb-always-add-address t                ;; add new addresses to existing...
 bbbd-message-caching-enabled t           ;; be fast
 bbdb-elided-display t                    ;; single-line addresses
 bbdb-ignore-some-messages-alist ;; don't ask about fake addresses
 ;; NOTE: there can be only one entry per header (such as To, From)
 ;; http://flex.ee.uec.ac.jp/texi/bbdb/bbdb_11.html
 '(( "From" . "no.?reply\\|DAEMON\\|daemon\\|facebookmail\\|twitter")))


(require 'bbdb)
(require 'bbdb-autoloads)
(bbdb-initialize 'gnus 'message)
(add-hook 'message-setup-hook 'bbdb-define-all-aliases)

(spam-initialize)

(require 'w3m)
(require 'gnushush)
(require 'manatee)
(require 'miniedit)

;;    (load "gnus-load")  ;; Needed if using  nognus.

(define-key mode-specific-map [?m] 'gnus)

;(if (featurep 'xemacs)
;    (add-to-list 'Info-directory-list "~/builds/gnus/texi/")
;  (add-to-list 'Info-default-directory-list "~/builds/gnus/texi/"))


(require 'offlineimap)
(add-hook 'gnus-get-new-news-hook 'offlineimap)

(require 'spam)
(spam-initialize)

;; which email addresses to detect for special highlighting 
(defvar rgr-mails
  "rileyrg@googlemail\\.com\\|rgr@richardriley\\.net\\|rileyrgdev@googlemail\\.com")

(defun store-gnus-outgoing-message-group ()
  (cond ((and gnus-newsgroup-name
              (not (message-news-p))
              (stringp gnus-newsgroup-name))
         gnus-newsgroup-name)
        (t ted-default-gcc-group)))

(setq gnus-outgoing-message-group nil)


(setq rgr/server-name-maps
      '(("RI" . "Email")
        ("SH" . "Pub")
        ("FR" . "Friends")
        ("KL" . "Sport")
        ("HA" . "Fun")
        ("GM" . "Gmane")
        ("GN" . "Gnu")
        ("GW" . "Gwene")
        ("" . "Unknown")
        ))

;; (copy-face 'default 'my-gnus-face)
;; (copy-face 'my-gnus-face 'my-subject-face)

;; (copy-face 'my-gnus-face 'my-group-face)
;; (set-face-attribute 'my-group-face nil :inherit 'my-gnus-face)

;; (copy-face 'my-group-face 'my-group-face-unread)
;; (set-face-attribute 'my-group-face-unread nil :inherit 'my-group-face)

;; (copy-face 'my-group-face 'my-group-server-face)
;; (copy-face 'my-group-server-face 'my-group-server-face-unread)
;; (set-face-attribute 'my-group-server-face-unread nil :inherit 'my-group-server-face)

;; (copy-face 'my-group-face 'my-unread-count-face)
;; (copy-face 'my-unread-count-face 'my-unread-count-face-unread)
;; (set-face-attribute 'my-unread-count-face-unread nil :inherit 'my-unread-count-face)

;; (copy-face 'my-group-face 'my-inbox-icon-face)
;; (copy-face 'my-inbox-icon-face 'my-inbox-icon-face-unread)
;; (set-face-attribute 'my-inbox-icon-face-unread nil :inherit 'my-inbox-icon-face)

;; (copy-face 'my-gnus-face 'my-topic-empty-face)
;; (copy-face 'my-gnus-face 'my-topic-face)


(setq gnus-topic-line-format "%i[ %u&topic-line; ] %v\n")

(defun rgr/unread-face (f)
  (intern (if (> (string-to-number gnus-tmp-number-of-unread) 0) (concat f "-unread") f)))

;; this corresponds to a topic line format of "%n %A"
(defun gnus-user-format-function-topic-line (dummy)
  (let ((topic-face (if (zerop total-number-of-articles)
                        'my-topic-empty-face
                      'my-topic-face)))
    (propertize
     (format "%s %d" name total-number-of-articles)
     'face topic-face)))

(defun gnus-user-format-function-s (header)
  (propertize (mail-header-subject header) 'face 'my-subject-face 'gnus-face t))

(defun gnus-user-format-function-g (headers) ;; gnus-group-line-format use %ug to call this func! e.g  "%M%S%p%P%(%-40,40ug%)%-5uy %ud\n"
  ;; split full group protocol-server:group into three parts.
  (string-match "\\(^.*\\)\\+\\(.*\\):\\(.*\\)" gnus-tmp-group)
  ;; map the first two letters of the server name to a more friendly and cuddly display name
  (let*  ((match-ok (match-string 2 gnus-tmp-group))
          (server-key (if (null match-ok) nil (upcase(substring match-ok 0 2)))))
    (if (zerop (length server-key))
        gnus-tmp-group
      ;; construct new group format line with a small envelope taking the place of any INBOX
      (concat 
       (propertize 
        (format "%-8s" (cdr (assoc server-key rgr/server-name-maps)))
        'face (rgr/unread-face "my-group-server-face") 'face (rgr/unread-face (concat "my-group-server-face-" server-key)) 'gnus-face t)
       " - "
       (if (string-match "INBOX" (match-string 3 gnus-tmp-group) )
           (propertize "\x2709" 'face (rgr/unread-face "my-inbox-icon-face") 'gnus-face t)
         (propertize (match-string 3 gnus-tmp-group) 'face (rgr/unread-face "my-group-face") 'gnus-face t) )))))


(defun gnus-user-format-function-j (headers)
  ;; prefix each post depending on whether to, cc or Bcc to
  (let ((to (gnus-extra-header 'To headers)))
    (if (string-match rgr-mails to)
        (if (string-match "," to) "~" "»")
      (if (or (string-match rgr-mails
                            (gnus-extra-header 'Cc headers))
              (string-match rgr-mails
                            (gnus-extra-header 'BCc headers)))
          "~"
        " "))))

(defun gnus-user-format-function-y (headers)
  "return string representation for unread articles"
  (concat
   (propertize  (if (= (string-to-number  gnus-tmp-number-of-unread) 0) "" "\x2709") 'face (rgr/unread-face "my-inbox-icon-face") 'gnus-face t)
   (propertize  (if (= (string-to-number  gnus-tmp-number-of-unread) 0) ""
                  (concat "   (" gnus-tmp-number-of-unread ")")) 'face (rgr/unread-face "my-unread-count-face") 'gnus-face t)))



(setq  gnus-user-date-format-alist
       ;; Format the date so we can see today/tomorrow quickly.
       ;; See http://emacs.wordpress.com/category/gnus/ for the original.
       '(
         ((gnus-seconds-today) . "Today, %H:%M")
         ((+ 86400 (gnus-seconds-today)) . "Yesterday, %H:%M")
         (604800 . "%A %H:%M") ;;that's one week
         ((gnus-seconds-month) . "%A %d")
         ((gnus-seconds-year) . "%B %d")
         (t . "%B %d '%y"))) ;;this one is used when no other does match


(defun gnus-group-read-group-no-prompt ()
  "Read news in this newsgroup and don't prompt.
                   Use the value of `gnus-large-newsgroup'."
  (interactive)
  (gnus-group-read-group gnus-large-newsgroup))

(defun gnus-article-sort-by-chars (h1 h2)
  "Sort articles by size."
  (< (mail-header-chars h1)
     (mail-header-chars h2)))

(add-to-list 'message-syntax-checks '(existing-newsgroups . disabled))

(defun message-check-news-syntax ()
  "Check the syntax of the message and prompt the user to be sure he wants to send."
  (and
   (save-excursion
     (save-restriction
       (widen)
       (and
        ;; We narrow to the headers and check them first.
        (save-excursion
          (save-restriction
            (message-narrow-to-headers)
            (message-check-news-header-syntax)))
        ;; Check the body.
        (message-check-news-body-syntax))))
                                        ; sm: this last line is my addition
   (y-or-n-p "Post the message? ")
   ))



(defun wicked/gnus-add-subject-to-bbdb-record ()
  "Add datestamped subject note for each person this message has been sent to."
  (let* ((subject (concat (format-time-string "%Y.%m.%d")
                          ": E-mail: " (message-fetch-field "Subject") "\n"))
         (bbdb-get-addresses-headers
          (list (assoc 'recipients bbdb-get-addresses-headers)))
         records)
    (setq records
          (bbdb-update-records
           (bbdb-get-addresses nil gnus-ignored-from-addresses 'gnus-fetch-field)
           nil nil))
    (mapc (lambda (rec)
            (bbdb-record-putprop rec
                                 'contact
                                 (concat subject
                                         (or
                                          (bbdb-record-getprop rec 'contact)
                                          ""))))
          records)))

(add-hook 'message-send-hook 'wicked/gnus-add-subject-to-bbdb-record)

(defun DE-bbdb-match-field-recipient (field regexp)
  "Match FIELD for recipient against REGEXP.
                   FIELD must be a symbol, e.g. 'email-type."
  (let (who rec)
    (when (and
           (gnus-buffer-live-p gnus-article-copy)
           (setq who
                 (with-current-buffer gnus-article-copy
                   (save-restriction
                     (nnheader-narrow-to-headers)
                     (or (message-fetch-field "reply-to")
                         (message-fetch-field "from")))))
           (setq rec
                 (bbdb-search-simple
                  nil
                  (cadr (gnus-extract-address-components who)))))
      (string-match regexp (bbdb-get-field rec field)))))


;; group topics
(add-hook 'gnus-group-mode-hook 'gnus-topic-mode)



;; we are all a bit egotistical and interested in our own ...
(add-hook 'message-sent-hook 'gnus-score-followup-article)
(add-hook 'message-sent-hook 'gnus-score-followup-thread) 

;;F6 killfiles a poster, F7 ignores a thread
(define-key gnus-summary-mode-map (kbd "<f6>") "LA")
(define-key gnus-summary-mode-map (kbd "<f7>") 'gnus-summary-kill-thread)
(define-key gnus-summary-mode-map (kbd "<deletechar>") (lambda ()(interactive)(gnus-summary-delete-article)(next-line)))

;; some comfort keys to scroll article in other window when in summary window
(define-key gnus-summary-mode-map [(meta up)] (lambda() (interactive) (scroll-other-window -1)))
(define-key gnus-summary-mode-map [(meta down)] (lambda() (interactive) (scroll-other-window 1)))
;; thread navigation
(define-key gnus-summary-mode-map [(control down)] 'gnus-summary-next-thread)
(define-key gnus-summary-mode-map [(control up)] 'gnus-summary-prev-thread)

;; indexing in mail groups supported by dovecot on the server side.
(require 'nnir)
(define-key gnus-group-mode-map (kbd "<f1>") 'gnus-group-make-nnir-group)

(unless (assoc "audio/x-wav" w3m-content-type-alist)
  (setq w3m-content-type-alist
        (cons '("audio/x-wav" "\\.wav$" ("play" file))
              w3m-content-type-alist)))

(defun playwav (url)
  (interactive)
  (message "url is %s" url)
  (w3m-view-this-url url)
  )

;; some trickery to show the newsread people are using and colour code depending on type
;; in this case highlight users of any outlook type dross :-;
(setq  gnus-header-face-alist nil)
(add-to-list
 'gnus-header-face-alist
 (list (concat
        "^"
        (regexp-opt '("User-Agent" "X-Mailer" "Newsreader" "X-Newsreader") t)
        ":.*") ;; other
       nil font-lock-comment-face))

(add-to-list
 'gnus-header-face-alist
 (list (concat
        "^"
        (regexp-opt '("User-Agent" "X-Mailer" "Newsreader" "X-Newsreader") t)
        ":.*Outlook.*")
       nil 'gnus-emphasis-highlight-words))

;; And show any real men who use Gnus!
(add-to-list
 'gnus-header-face-alist
 (list (concat
        "^"
        (regexp-opt '("User-Agent" "X-Mailer" "Newsreader" "X-Newsreader") t)
        ":.*Gnus.*")
       nil 'gnus-server-opened))

(defun jao-gnus-goto-google ()
  (interactive)
  (when (memq major-mode '(gnus-summary-mode gnus-article-mode))
    (when (eq major-mode 'gnus-article-mode)
      (gnus-article-show-summary))
    (let* ((article (gnus-summary-article-number))
           (header (gnus-summary-article-header article))
           (id (substring (mail-header-id header) 1 -1))
           (url (format "http://groups.google.com/groups?selm=%s" id)))
      (if current-prefix-arg
          (when url (browse-url-default-browser url))
        (if  url (browse-url url) (call-interactively 'browse-url))))))


(defun save-to-list ()
  (interactive)
  (bbdb/gnus-show-all-recipients)
  )


;; Format RSS feed titles nicely
(add-hook 'gnus-summary-mode-hook
          (lambda ()
            (if (string-match "^nnrss:.*" gnus-newsgroup-name)
                (progn
                  (make-local-variable 'gnus-show-threads)
                  (make-local-variable 'gnus-article-sort-functions)
                  (make-local-variable 'gnus-use-adaptive-scoring)
                  (make-local-variable 'gnus-use-scoring)
                  (make-local-variable 'gnus-score-find-score-files-function)
                  (make-local-variable 'gnus-summary-line-format)
                  (setq gnus-show-threads nil)
                  (setq gnus-article-sort-functions 'gnus-article-sort-by-date)
                  (setq gnus-use-adaptive-scoring nil)
                  (setq gnus-use-scoring t)
                  (setq gnus-score-find-score-files-function 'gnus-score-find-single)
                  (setq gnus-summary-line-format "%U%R%z%d %I%(%[ %s %]%)\n")))))


(add-hook 'gnus-select-group-hook 'gnus-group-set-timestamp)

(defun gnus-user-format-function-d (headers)
  (let ((time (gnus-group-timestamp gnus-tmp-group)))
    (if time
        (format-time-string "%b %d  %H:%M" time)
      ""
      )
    )
  )

(setq mail-sources
      '((file :path "/var/spool/mail/shamrock")))

(setq gnus-select-method '(nnml ""))

(add-to-list 'gnus-secondary-select-methods
             '(nnimap "riley"
                      (nnimap-address "offlineimap")
                      (nnir-search-engine imap)
                      (nnimap-stream network)
                      (nnimap-authinfo-file "~/.authinfo.gpg")))

(add-to-list 'gnus-secondary-select-methods
             '(nnimap "shamrockpub"
                      (nnimap-address "offlineimap")
                      (nnir-search-engine imap)
                      (nnimap-stream network)
                      (nnimap-authinfo-file "~/.authinfo.gpg")))

(add-to-list 'gnus-secondary-select-methods
             '(nnimap "friends"
                      (nnimap-address "offlineimap")
                      (nnir-search-engine imap)
                      (nnimap-stream network)
                      (nnimap-authinfo-file "~/.authinfo.gpg")))


(add-to-list 'gnus-secondary-select-methods '(nntp "Gmane" (nntp-address "news.gmane.org")))
(add-to-list 'gnus-secondary-select-methods '(nntp "Gwene" (nntp-address "news.gwene.org")))
(add-to-list 'gnus-secondary-select-methods '(nntp "Gnus"  (nntp-address "news.gnus.org")))


(setq gnus-posting-styles `((".*"
                             (name "Richard Riley")
                             (from "Richard Riley <rileyrg@googlemail.com>")
                             (eval(setq gnushush-user-agent-header (quote real)))
                             (signature-file "~/.emacs.d/.sigs/rgr.sig")
                             (eval (setq mml2015-signers '("AB23BE58")))
                             (organization "aich tea tea pea dicky riley dot net"))))



(setq mail-host-address "news.eternal-september.org")

;; Select the correct smtp server based on the from address.
(defun msmtp-account (&optional def)
  (let* ((from
          (save-restriction    
            (message-narrow-to-headers)
            (message-fetch-field "From")))
         (account (if from (catch 'match
                             (dolist (element msmtp-name-list)
                               ;; (message (format "smpt chosen is %s" element))
                               (when (string-match (format ".*%s.*" element) from)
                                 (throw 'match element)))) nil)))
    (if account account (if def def "default"))))

(defun msmtp-change-smtp ()
  (setq sendmail-program "/usr/bin/msmtp")
  (setq smtpmail-starttls-credentials '(("smtp.googlemail.com" 587 nil nil)))
  (setq smtpmail-smtp-server "smtp.googlemail.com")
  (setq message-sendmail-envelope-from 'header)
  (if (message-mail-p)
      (setq message-sendmail-extra-arguments (list "-a" (msmtp-account "default")))))    
(add-hook 'message-send-hook 'msmtp-change-smtp)

(setq message-required-news-headers
      (remove' Message-ID message-required-news-headers))