;;; .gnus.el --- All gnus settings.
;;; Settings and insinuation
;; Be sure that we can make X-Face headers and picons
(require 'gnus-fun)
(require 'gnus-picon)
;; Work around annoying bug
(load "mm-util")
;; Load GPG integration
;(add-to-list 'load-path "~/proj/emacs/easypg")
;(require 'pgg)
;(setq pgg-scheme 'epg)
(require 'epa-setup)
(setq mml2015-use 'epg)
;; Read debian groups (hopefully)
;;(require 'gnus-BTS)
;;; Apply Darcs patches
(require 'gnus-art)
(defun my-gnus-darcs-apply-part (repo)
"Apply the MIME part under point to a Darcs repository."
(interactive "DApply to Darcs repository: ")
(gnus-article-check-buffer)
(let ((data (get-text-property (point)
'gnus-data)))
(when data
(mm-with-unibyte-buffer
(mm-insert-part data)
(my-send-region-to-command (point-min)
(point-max)
"darcs" "apply"
(format "--repodir=%s"
(expand-file-name repo))
"-a")))))
(define-key gnus-mime-button-map (kbd "a d") 'my-gnus-darcs-apply-part)
(defun my-send-region-to-command (beg end command &rest args)
"Call COMMAND with ARGS, and display output in a special buffer."
(let* ((coding-system-for-write 'binary)
(buf (with-current-buffer
(get-buffer-create "*Shell Command Output*")
(setq buffer-read-only nil)
(erase-buffer)
(current-buffer)))
(exit-status (apply 'call-process-region
beg end
command
nil buf nil
args)))
(with-current-buffer buf
(setq mode-line-process
(cond ((null exit-status)
" - Error")
((stringp exit-status)
(format " - Signal [%s]" exit-status))
((not (equal 0 exit-status))
(format " - Exit [%d]" exit-status)))))
(if (with-current-buffer buf (> (point-max)
(point-min)))
;; There's some output, display it
(display-message-or-buffer buf)
;; No output; error?
(cond ((null exit-status)
(message "(Command failed with error)"))
((equal 0 exit-status)
(message "(Command succeeded with no output)"))
((stringp exit-status)
(message "(Command killed by signal %s)"
exit-status))
(t
(message "(Command failed with code %d and no output)"
exit-status output))))))
;;; Deal with comment spam
(defun my-gnus-submit-comment-spam (num)
"Prepare a message for submission as spam to my remote blog setup."
(interactive "p")
(let ((gnus-plugged t)
(spam-buf (get-buffer-create "*akismet spam*"))
match)
;; move to end of spam buffer
(with-current-buffer spam-buf
(set (make-local-variable 'default-directory)
(expand-file-name "~/"))
(goto-char (point-max)))
;; fetch comment locations from articles
(dotimes (i num)
(save-window-excursion
(save-excursion
(set-buffer gnus-article-buffer)
(goto-char (point-min))
(when (re-search-forward "^Comment location: .+$" nil t)
(setq match (match-string 0))
(with-current-buffer spam-buf
(insert match "\n")))))
(gnus-summary-next-subject 1))
(message "Placed spam in *akismet spam* buffer")))
(define-key gnus-summary-mode-map (kbd "s") 'my-gnus-submit-comment-spam)
;;; Remove highlighting of emphasis with "/" because it's annoying
(setq gnus-emphasis-alist
(gnus-remove-if (lambda (arg) (eq (nth 3 arg) 'gnus-emphasis-italic))
gnus-emphasis-alist))
;;; Insinuate BBDB with Gnus
(require 'bbdb-gnus)
(bbdb-insinuate-gnus)
(bbdb-insinuate-message)
(add-to-list 'gnus-summary-local-variables
'(bbdb/gnus-update-records-mode (lambda nil 'annotating)))
;; Allow for uninsinuation
(defun bbdb-uninsinuate-gnus ()
"Call this function to remove BBDB from Gnus."
(interactive)
(setq gnus-optional-headers nil)
(remove-hook 'gnus-article-prepare-hook 'bbdb/gnus-pop-up-bbdb-buffer)
(remove-hook 'gnus-save-newsrc-hook 'bbdb-offer-save)
;; Scoring
(remove-hook 'bbdb-after-change-hook 'bbdb/gnus-score-invalidate-alist))
;;; Miscellaneous
;; Don't mess up Face headers in outgoing email
;;(push '(Face ignore) message-field-fillers)
;; Use the "links" program to wash HTML
;;(setq gnus-article-wash-function 'links)
;; Tells Gnus to inline the part
(eval-after-load "mm-decode"
'(add-to-list 'mm-inlined-types "application/pgp$"))
;; Tells Gnus how to display the part when it is requested
(eval-after-load "mm-decode"
'(add-to-list 'mm-inline-media-tests '("application/pgp$"
mm-inline-text identity)))
;; Tell Gnus not to wait for a request, just display the thing
;; straight away.
(eval-after-load "mm-decode"
'(add-to-list 'mm-automatic-display "application/pgp$"))
;; I don't like HTML email
(when (boundp 'mm-automatic-display)
(setq mm-discouraged-alternatives '("text/html" "text/richtext")
mm-automatic-display (remove "text/html" mm-automatic-display)))
;; Check mail every N minutes
;;(gnus-demon-add-handler 'gnus-group-get-new-news 20 t)
;;(gnus-demon-init)
;;(gnus-demon-add-handler 'gnus-group-get-new-news 2 t)
;;(gnus-demon-init)
;; Deal with a missing definition in
;; `mm-inline-text-html-render-with-w3m'
;; (defun mm-w3m-local-map-property ()
;; "Return the text property and value that establishes a local keymap."
;; (list (if (or (featurep 'xemacs)
;; (>= emacs-major-version 21))
;; 'keymap
;; 'local-map)
;; w3m-mode-map))
;;; Extra functions
(defvar my-gnus-face-directory "/home/mwolson/News/faces")
(defvar my-gnus-default-face
(expand-file-name "me-2004-take_1.png" my-gnus-face-directory))
(defun my-gnus-default-face ()
"Return Face header data chosen randomly from
`my-gnus-face-directory'."
(interactive)
(save-match-data
(when (and (not (string= my-gnus-default-face ""))
(file-exists-p my-gnus-default-face))
(gnus-convert-png-to-face my-gnus-default-face))))
(defun my-gnus-random-face ()
"Return Face header data chosen randomly from
`my-gnus-face-directory'."
(interactive)
(save-match-data
(when (file-exists-p my-gnus-face-directory)
(let* ((files (delete my-gnus-default-face
(directory-files my-gnus-face-directory
t "\\.png$")))
(file (nth (random (length files)) files)))
(when file
(gnus-convert-png-to-face file))))))
;; Specify headers that I want in every message
(defun my-message-insert-extra-headers ()
(goto-char (point-min))
(insert "Face: " (my-gnus-default-face) "\n"
"Face: " (my-gnus-random-face) "\n"))
(add-hook 'message-header-setup-hook 'my-message-insert-extra-headers)
;; Consult the summary buffer for whether or not to prompt for new
;; email addresses on a known account.
(defun bbdb/gnus-update-records (&optional offer-to-create)
"Return the records corresponding to the current GNUS message, creating
or modifying it as necessary. A record will be created if
bbdb/news-auto-create-p is non-nil or if OFFER-TO-CREATE is true
and the user confirms the creation.
The variable `bbdb/gnus-update-records-mode' controls what actions
are performed and it might override `bbdb-update-records-mode'.
When hitting C-g once you will not be asked anymore for new people listed
in this message, but it will search only for existing records. When hitting
C-g again it will stop scanning."
(let ((bbdb-update-records-mode
(when (and (boundp 'gnus-summary-buffer)
(buffer-live-p gnus-summary-buffer))
(with-current-buffer gnus-summary-buffer
bbdb/gnus-update-records-mode)))
(bbdb/gnus-offer-to-create offer-to-create)
;; here we may distiguish between different type of messages
;; for those that have no message id we have to find something
;; else as message key.
(msg-id (bbdb/gnus-get-message-id))
records cache)
(save-excursion
(set-buffer gnus-article-buffer)
(if (and msg-id (not bbdb/gnus-offer-to-create))
(setq cache (bbdb-message-cache-lookup msg-id)))
(if cache
(setq records (if bbdb-get-only-first-address-p
(list (car cache))
cache))
(setq records (bbdb-update-records
(bbdb-get-addresses
bbdb-get-only-first-address-p
(or (if (boundp 'gnus-ignored-from-addresses)
gnus-ignored-from-addresses)
bbdb-user-mail-names)
'gnus-fetch-field)
bbdb/news-auto-create-p
offer-to-create))
(if (and bbdb-message-caching-enabled msg-id)
(bbdb-encache-message msg-id records))))
records))
;; Note to self: add this to a group by hitting C-M-e in order for
;; addy's in the group to be ignored by BBDB
;; ((dummy
;; (set
;; (make-local-variable 'bbdb/gnus-update-records-mode)
;; 'searching)))
(defun my-gnus-engl421-people ()
"If replying to a message, use the person that we want to reply to.
Otherwise, send to my ENGL421 group."
(if gnus-article-reply
(save-excursion
(set-buffer gnus-article-buffer)
(message-fetch-field "From"))
(concat "Liz Alleman <ealleman@purdue.edu>, "
"Dan Baker <dabaker@purdue.edu>, "
"Laura Fitzpatric <lfitzpat@purdue.edu>, "
"Gabe Fleck <gfleck@purdue.edu>")))
(defun my-git-to-header ()
"Massage To header for git list."
(save-excursion
(save-match-data
(set-buffer gnus-article-buffer)
(let ((field (message-fetch-field "from")))
(unless (string-match (regexp-quote "git@vger.kernel.org")
field)
(setq field (concat "git@vger.kernel.org, " field)))
(when (string-match ",[^,\n]*<?mwolson@gnu\\.org>?" field)
(setq field (replace-match "" t t field)))
field))))
;;; Variables
;; Use different email addresses sometimes
(setq gnus-posting-styles
'(((header "to" "mwolson@gnu.org")
(from (concat user-full-name " <mwolson@gnu.org>")))
((header "cc" "mwolson@gnu.org")
(from (concat user-full-name " <mwolson@gnu.org>")))
((header "to" "mwolson@hcoop.net")
(from (concat user-full-name " <mwolson@hcoop.net>")))
((header "cc" "mwolson@hcoop.net")
(from (concat user-full-name " <mwolson@hcoop.net>")))
((header "to" "me@mwolson.org")
(from (concat user-full-name " <me@mwolson.org>")))
((header "cc" "me@mwolson.org")
(from (concat user-full-name " <me@mwolson.org>")))
((header "to" "me.xmas@mwolson.org")
(from (concat user-full-name " <me.xmas@mwolson.org>")))
((header "cc" "me.xmas@mwolson.org")
(from (concat user-full-name " <me.xmas@mwolson.org>")))
("INBOX\\.Backpack"
(to (concat user-full-name " <me+backpack@mwolson.org>")))
("INBOX\\.Bugs"
(from (concat user-full-name " <mwolson@gnu.org>")))
("INBOX\\.Cerias"
(from (concat user-full-name " <me+cerias@mwolson.org>")))
("INBOX\\.Lists\\.Erbot"
(from (concat user-full-name " <mwolson@gnu.org>"))
(to "ErBot discussion list <erbot-discuss@nongnu.org>"))
("INBOX\\.Lists\\.Hcoop"
(from (concat user-full-name " <mwolson@hcoop.net>")))
("INBOX\\.Lists.Hcoop\\.Announce"
(to "hcoop-announce@hcoop.net"))
("INBOX\\.Lists.Hcoop\\.Discuss"
(to "hcoop-discuss@hcoop.net"))
("INBOX\\.Lists.Hcoop\\.Misc"
(to "hcoop-misc@hcoop.net"))
("INBOX\\.Lists.Hcoop\\.Sysadmin"
(to "hcoop-sysadmin@hcoop.net"))
;; don't need this anymore, now that cclausen is gone
;; ;; *grmbl* at cclausen, who uses a crappy email client
;; (eval (set (make-local-variable 'message-setup-hook)
;; 'mml-secure-message-sign-pgp)))
("INBOX\\.Lists\\.Metaconference"
(from (concat user-full-name " <mwolson@gnu.org>"))
(to "metaconference@emacsen.org"))
("INBOX\\.Lists\\.Plug-officers"
(from (concat user-full-name " <mwolson@member.fsf.org>"))
(to "PLUG Officers <plug-officers@lists.csociety.org>"))
("INBOX\\.School"
(from (concat user-full-name " <mwolson@purdue.edu>")))
("INBOX\\.School\\.ENGL421"
(from (concat user-full-name " <me+engl421@mwolson.org>"))
(to (my-gnus-engl421-people)))
("INBOX\\.Work"
(from (concat user-full-name " <me+work@mwolson.org>")))
("^gmane\\."
(from (concat user-full-name " <mwolson@gnu.org>")))
("^gmane\\.comp\\.version-control\\.git"
(from (concat user-full-name " <mwolson@gnu.org>"))
(to (my-git-to-header))
(newsgroups nil))
("^gmane\\.comp\\.web\\.pyblosxom\\.user"
(to "pyblosxom-users@lists.sourceforge.net")
(newsgroups nil))
("^gmane\\.discuss"
(from (concat user-full-name " <mwolson@member.fsf.org>")))
("^gmane\\.emacs\\.wiki\\.general"
(to "Emacs Wiki Discussion List <emacs-wiki-discuss@nongnu.org>")
(newsgroups nil))
("^gmane\\.emacs\\.emms\\.patches"
(to "EMMS Patches <emms-patches@gnu.org>")
(newsgroups nil))
("^gmane\\.emacs\\.gnus\\.general"
(to "ding@gnus.org")
(from (concat user-full-name " <mwolson@member.fsf.org>"))
(newsgroups nil))
("^gmane\\.emacs\\.erc\\.announce"
(from (concat user-full-name " <mwolson@gnu.org>"))
(to "erc-announce@gnu.org, erc-discuss@gnu.org")
(newsgroups nil))
("^gmane\\.emacs\\.muse\\.announce"
(from (concat user-full-name " <mwolson@gnu.org>"))
(to "muse-el-announce@gna.org, muse-el-discuss@gna.org")
(newsgroups nil))
("^gmane\\.org\\.user-groups\\.linux\\.purdue"
(from (concat user-full-name " <mwolson@member.fsf.org>")))
("^gmane\\.org\\.user-groups\\.linux\\.purdue\\.announce"
(to "PLUG Announcements <plug-announce@lists.csociety.org>, plug@lists.csociety.org")
(newsgroups nil))
("^purdue\\."
(from (concat user-full-name " <mwolson@purdue.edu>")))
("^\\(gnu\\|comp\\|rec\\)\\." ; deal with newsserver lameness
(Date (progn
(set (make-local-variable 'message-required-news-headers)
(delq 'Date message-required-news-headers))
nil)))
))
;; the kinder, gentler way to set group parameters
(setq gnus-parameters
`((,(concat "gmane\\.linux\\.ubuntu\\.motu\\|gmane\\..*\\.cvs"
"\\|gmane\\.comp\\.web\\.pyblosxom\\.user"
"\\|gmane\\.org\\.user-groups\\.linux\\.purdue\\.announce"
"\\|INBOX\\.Bugs")
(dummy (set (make-local-variable 'bbdb/gnus-update-records-mode)
'searching)))))
;; Don't warn me about multiple Face headers
(add-to-list 'message-syntax-checks
'(multiple-headers . disabled))
;;; Key customizations
(define-key gnus-article-mode-map "\\" nil)
;;; Customizations
(custom-set-variables
'(canlock-password "fffefe1a9fab1bd9ea8f78fce54966536045e050")
'(gnus-asynchronous t)
'(gnus-buttonized-mime-types (quote ("multipart/encrypted" "multipart/signed")))
'(gnus-cache-enter-articles (quote (ticked dormant unread)))
'(gnus-cacheable-groups ".*")
'(gnus-group-mode-hook (quote (gnus-topic-mode gnus-agent-mode)))
'(gnus-ignored-from-addresses "bigmike160@yahoo\\|mwolson@purdue\\|mwolson@member\\|@mwolson\\.org\\|mwolson@gnu\\.org\\|mwolson@hcoop\\.net")
'(gnus-message-archive-group (lambda (&rest ignore) (if (message-news-p) "sent-news" "sent-mail")))
'(gnus-mode-non-string-length 20)
'(gnus-picon-databases (quote ("/usr/share/picons" "/usr/local/faces")))
'(gnus-picon-style (quote right))
'(gnus-secondary-select-methods (quote ((nnimap "hcoop" (gnus-agent-synchronize-flags nil) (nnimap-address "deleuze.hcoop.net") (nnimap-stream tls) (nnimap-nov-is-evil t) (nnimap-authinfo-file "~/.emacs.d/.authinfo")) (nnmbox "mbox"))))
'(gnus-select-method (quote (nntp "localhost" (nntp-marks-is-evil t))))
'(gnus-thread-sort-functions (quote ((lambda (th1 th2) (if (message-news-p) (gnus-thread-sort-by-number th1 th2) (gnus-thread-sort-by-date th1 th2))))))
'(gnus-treat-display-smileys nil)
'(gnus-treat-display-x-face (quote head))
'(gnus-treat-from-picon (quote head))
'(gnus-treat-mail-picon (quote head))
'(gnus-treat-newsgroups-picon (quote head))
'(gnus-treat-strip-leading-blank-lines t)
'(gnus-treat-strip-multiple-blank-lines t)
'(gnus-treat-strip-pgp nil)
'(gnus-treat-strip-trailing-blank-lines t)
'(gnus-treat-x-pgp-sig t)
'(gnus-uncacheable-groups "^nnmbox")
'(gnus-use-cache t)
'(message-generate-hashcash t)
'(message-mode-hook (quote (gmane-setup-message turn-on-auto-fill turn-on-muse-list-edit-minor-mode)))
'(message-send-mail-function (quote message-send-mail-with-sendmail))
'(message-sendmail-envelope-from (quote header))
'(message-sendmail-f-is-evil t)
'(message-setup-hook (quote (mml-secure-message-sign)))
'(mm-decrypt-option (quote known))
'(mm-inline-text-html-with-w3m-keymap t)
'(mm-text-html-renderer (quote w3m))
'(mm-verify-option (quote known))
'(nnmail-crosspost nil)
'(nnmail-message-id-cache-file "~/.emacs.d/.nnmail-cache")
'(nnmail-use-long-file-names t)
'(pgg-default-user-id "Michael W. Olson <mwolson@member.fsf.org>")
'(pgg-query-keyserver nil))
(custom-set-faces)
;; Set up Gmane admin stuff, if available
(condition-case nil
(progn
(load "~/.emacs.d/.gmane.el"))
(error nil))
;;; .gnus.el ends here
;; '(gnus-secondary-select-methods (quote ((nnimap "hcoop" (gnus-agent-synchronize-flags nil) (nnimap-address "hcoop.net") (nnimap-stream tls) (nnimap-nov-is-evil t) (nnimap-authinfo-file "~/.emacs.d/.authinfo")) (nnimap "hcoop.new" (gnus-agent-synchronize-flags nil) (nnimap-address "deleuze.hcoop.net") (nnimap-stream tls) (nnimap-nov-is-evil t) (nnimap-authinfo-file "~/.emacs.d/.authinfo")) (nnimap "plug" (gnus-agent-synchronize-flags nil) (nnimap-address "mail.purduelug.org") (nnimap-stream tls) (nnimap-nov-is-evil t) (nnimap-authinfo-file "~/.emacs.d/.authinfo")) (nnmbox "mbox"))))
;; (nnimap "hcoop.old" (gnus-agent-synchronize-flags nil) (nnimap-address "fyodor.hcoop.net") (nnimap-stream tls) (nnimap-nov-is-evil t) (nnimap-authinfo-file "~/.emacs.d/.authinfo"))
;; Run this to test SMTP
;;; (require 'smtpmail)
;;; (setq message-send-mail-function 'smtpmail-send-it
;;; smtpmail-smtp-server "deleuze.hcoop.net"
;;; smtpmail-smtp-service 25
;;; smtpmail-starttls-credentials '(("deleuze.hcoop.net" 25 nil nil))
;;; smtpmail-debug-info t ; optional, but handy in case something goes wrong
;;; smtpmail-auth-supported '(login))
;;; (setq smtpmail-auth-credentials "~/.emacs.d/.authinfo")