;;; .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) (require 'mml) (setq mml2015-use 'epg) (defun mml-read-part (&optional mml) "Return the buffer up till the next part, multipart or closing part or multipart. If MML is non-nil, return the buffer up till the correspondent mml tag." (let ((beg (point)) (count 1)) ;; If the tag ended at the end of the line, we go to the next line. (when (looking-at "[ \t]*\n") (forward-line 1)) (if mml (progn (while (and (> count 0) (not (eobp))) (if (re-search-forward "<#\\(/\\)?mml." nil t) (setq count (+ count (if (match-beginning 1) -1 1))) (goto-char (point-max)))) (mml-buffer-substring-no-properties-except-hard-newlines beg (if (> count 0) (point) (match-beginning 0)))) (if (re-search-forward "^<#\\(/\\)?\\(multipart\\|part\\|external\\|mml\\)." nil t) (prog1 (mml-buffer-substring-no-properties-except-hard-newlines beg (match-beginning 0)) (if (or (not (match-beginning 1)) (equal (match-string 2) "multipart")) (goto-char (match-beginning 0)) (when (looking-at "[ \t]*\n") (forward-line 1)))) (mml-buffer-substring-no-properties-except-hard-newlines beg (goto-char (point-max))))))) ;; 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-to (list me) "Massage To header for various lists." (save-excursion (save-match-data (set-buffer gnus-article-buffer) (let ((field (message-fetch-field "from"))) (unless (string-match (regexp-quote list) field) (setq field (concat field ", " list))) (when (string-match (concat ",[^,\n]*?") 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 " "))) ((header "cc" "mwolson@gnu.org") (from (concat user-full-name " "))) ((header "to" "mwolson@hcoop.net") (from (concat user-full-name " ")) (signature-file "~/.signature.hcoop")) ((header "cc" "mwolson@hcoop.net") (from (concat user-full-name " ")) (signature-file "~/.signature.hcoop")) ((header "to" "admins@hcoop.net") (from (concat user-full-name " ")) (signature-file "~/.signature.hcoop")) ((header "cc" "admins@hcoop.net") (from (concat user-full-name " ")) (signature-file "~/.signature.hcoop")) ((header "to" "me@mwolson.org") (from (concat user-full-name " "))) ((header "cc" "me@mwolson.org") (from (concat user-full-name " "))) ((header "to" "me.xmas@mwolson.org") (from (concat user-full-name " "))) ((header "cc" "me.xmas@mwolson.org") (from (concat user-full-name " "))) ("INBOX\\.Backpack" (to (concat user-full-name " "))) ("INBOX\\.Bugs" (from (concat user-full-name " "))) ("INBOX\\.HCoop\\.Admins" (from (concat user-full-name " ")) (signature-file "~/.signature.hcoop")) ("INBOX\\.Lists\\.DVC" (from (concat user-full-name " "))) ("INBOX\\.Lists\\.EMMS" (from (concat user-full-name " "))) ("INBOX\\.Lists\\.Erbot" (from (concat user-full-name " "))) ("INBOX\\.Lists\\.ERC" (from (concat user-full-name " "))) ("INBOX\\.Lists\\.Hcoop" (from (concat user-full-name " ")) (signature-file "~/.signature.hcoop")) ("INBOX\\.Lists.Hcoop\\.Announce" (to "hcoop-announce@hcoop.net") (cc nil)) ;; 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 " "))) ("INBOX\\.Lists\\.Muse" (from (concat user-full-name " "))) ("INBOX\\.Lists\\.Plug-officers" (from (concat user-full-name " ")) (to "PLUG Officers ")) ("INBOX\\.School" (from (concat user-full-name " "))) ("INBOX\\.Work" (from (concat user-full-name " "))) ("^gmane\\." (from (concat user-full-name " "))) ("^gmane\\.comp\\.version-control\\.git" (from (concat user-full-name " ")) ;; (to (my-gnus-to "git@vger.kernel.org" "mwolson@gnu.org")) (newsgroups nil)) ("^gmane\\.discuss" (from (concat user-full-name " "))) ("^gmane\\.emacs\\.wiki\\.general" (to "Emacs Wiki Discussion List ") (newsgroups nil)) ("^gmane\\.emacs\\.emms\\.patches" (newsgroups nil)) ("^gmane\\.emacs\\.gnus\\.general" (from (concat user-full-name " ")) (newsgroups nil)) ("^gmane\\.emacs\\.erc\\.announce" (from (concat user-full-name " ")) (to "erc-announce@gnu.org, erc-discuss@gnu.org") (cc "info-gnu@gnu.org, gnu-emacs-sources@gnu.org") (newsgroups nil)) ("^gmane\\.emacs\\.muse\\.announce" (from (concat user-full-name " ")) (to "muse-el-announce@gna.org, muse-el-discuss@gna.org") (cc "info-gnu@gnu.org, gnu-emacs-sources@gnu.org") (newsgroups nil)) ("^gmane\\.org\\.user-groups\\.linux\\.purdue" (from (concat user-full-name " "))) ("^gmane\\.org\\.user-groups\\.linux\\.purdue\\.announce" (to "plug-announce@lists.csociety.org, plug@lists.csociety.org") (newsgroups nil)) ("^\\(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))) ("INBOX\\.HCoop\\.Admins" (to-list . "admins@hcoop.net")) ("INBOX\\.Lists\\.DVC\\.Discuss" (to-list . "dvc-dev@gna.org")) ("INBOX\\.Lists\\.EMMS\\.Commits" (to-list . "emms-patches@gnu.org")) ("INBOX\\.Lists\\.EMMS\\.Discuss" (to-list . "emms-help@gnu.org")) ("INBOX\\.Lists\\.Erbot" (to-list . "erbot-discuss@nongnu.org")) ("INBOX\\.Lists\\.ERC\\.Commits" (to-list . "erc-commit@gnu.org")) ("INBOX\\.Lists\\.ERC\\.Discuss" (to-list . "erc-discuss@gnu.org")) ("INBOX\\.Lists\\.Gerber-xmas" (to-list . "gerber-xmas@mwolson.org")) ("INBOX\\.Lists.Hcoop\\.Discuss" (to-list . "hcoop-discuss@hcoop.net")) ("INBOX\\.Lists.Hcoop\\.Help" (to-list . "hcoop-help@hcoop.net")) ("INBOX\\.Lists.Hcoop\\.Misc" (to-list . "hcoop-misc@hcoop.net")) ("INBOX\\.Lists.Hcoop\\.Sysadmin" (to-list . "hcoop-sysadmin@hcoop.net")) ("INBOX\\.Lists\\.Metaconference" (to-list . "metaconference@emacsen.org")) ("INBOX\\.Lists\\.Muse\\.Commits" (to-list . "muse-el-logs@gna.org")) ("INBOX\\.Lists\\.Muse\\.Discuss" (to-list . "muse-el-discuss@gna.org")) ("^gmane\\.comp\\.version-control\\.git" (to-list . "git@vger.kernel.org")) ("^gmane\\.comp\\.web\\.pyblosxom\\.user" (to-list . "pyblosxom-users@lists.sourceforge.net")) ("^gmane\\.emacs\\.emms\\.patches" (to-list . "emms-patches@gnu.org")) ("^gmane\\.emacs\\.gnus\\.general" (to-list . "ding@gnus.org")) )) ;; Don't warn me about multiple Face headers (add-to-list 'message-syntax-checks '(multiple-headers . disabled)) ;; nnimap: nov is not evil ... i think ... (setq nnimap-nov-is-evil nil) ;; Time out the logout process after 15 seconds (setq nnimap-logout-timeout 15) ;;; 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-default-directory "/home/mwolson") '(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\\|emacs.hacker@gmail.com") '(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" (nnimap-address "mail.hcoop.net") (nnimap-stream tls) (nnimap-authinfo-file "~/.emacs.d/.authinfo")) (nnimap "gmail" (nnimap-address "imap.gmail.com") (nnimap-stream ssl) (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) '(mm-decrypt-option (quote known)) '(mm-inline-text-html-with-w3m-keymap t) '(mm-text-html-renderer (quote w3m)) '(mm-verify-option (quote known)) '(nnimap-authinfo-file "~/.emacs.d/authinfo") '(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 ") '(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 "mail.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 "mail.hcoop.net" ;;; smtpmail-smtp-service 25 ;;; smtpmail-starttls-credentials '(("mail.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")