Monday, September 13, 2010

Gnus Email and NNTP Handling

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)
'(( "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)


(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)

;; which email addresses to detect for special highlighting
(defvar rgr-mails

(defun store-gnus-outgoing-message-group ()
(cond ((and gnus-newsgroup-name
(not (message-news-p))
(stringp 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)
(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))
;; construct new group format line with a small envelope taking the place of any INBOX
(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"
(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 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-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."
;; We narrow to the headers and check them first.
;; Check the body.
; 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"))
(list (assoc 'recipients bbdb-get-addresses-headers)))
(setq records
(bbdb-get-addresses nil gnus-ignored-from-addresses 'gnus-fetch-field)
nil nil))
(mapc (lambda (rec)
(bbdb-record-putprop rec
(concat subject
(bbdb-record-getprop rec 'contact)

(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
(or (message-fetch-field "reply-to")
(message-fetch-field "from")))))
(setq rec
(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))

(defun playwav (url)
(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)
(list (concat
(regexp-opt '("User-Agent" "X-Mailer" "Newsreader" "X-Newsreader") t)
":.*") ;; other
nil font-lock-comment-face))

(list (concat
(regexp-opt '("User-Agent" "X-Mailer" "Newsreader" "X-Newsreader") t)
nil 'gnus-emphasis-highlight-words))

;; And show any real men who use Gnus!
(list (concat
(regexp-opt '("User-Agent" "X-Mailer" "Newsreader" "X-Newsreader") t)
nil 'gnus-server-opened))

(defun jao-gnus-goto-google ()
(when (memq major-mode '(gnus-summary-mode gnus-article-mode))
(when (eq major-mode 'gnus-article-mode)
(let* ((article (gnus-summary-article-number))
(header (gnus-summary-article-header article))
(id (substring (mail-header-id header) 1 -1))
(url (format "" 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 ()

;; Format RSS feed titles nicely
(add-hook 'gnus-summary-mode-hook
(lambda ()
(if (string-match "^nnrss:.*" gnus-newsgroup-name)
(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 "")))
(add-to-list 'gnus-secondary-select-methods '(nntp "Gwene" (nntp-address "")))
(add-to-list 'gnus-secondary-select-methods '(nntp "Gnus" (nntp-address "")))

(setq gnus-posting-styles `((".*"
(name "Richard Riley")
(from "Richard Riley <>")
(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 "")

;; Select the correct smtp server based on the from address.
(defun msmtp-account (&optional def)
(let* ((from
(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 '(("" 587 nil nil)))
(setq smtpmail-smtp-server "")
(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))

No comments:

Post a Comment