From a3bdb4d9d30a78f20b81e7fae5953d35c05198ed Mon Sep 17 00:00:00 2001 From: Mark Wooding Date: Thu, 26 Feb 2009 18:09:16 +0000 Subject: [PATCH] The great Gnus switchover! * Move some of the VM configuration -- particularly the hacking of `movemail' -- to the general population. * Insinuate BBDB into my world of email. * Tidy up dot-emacs.el's email settings. * Add configuration of Gnus. * Apply some very unpleasant hacking to the guts of Gnus so that it works with broken Exchange servers. --- dot-emacs.el | 124 ++++++++++++++++++++--------------- emacs | 13 +++- gnus.el | 82 +++++++++++++++++++++++ mdw-gnus-patch.el | 193 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ setup | 11 +++- vm | 7 -- 6 files changed, 367 insertions(+), 63 deletions(-) create mode 100644 gnus.el create mode 100644 mdw-gnus-patch.el diff --git a/dot-emacs.el b/dot-emacs.el index b2653c5..9c9a2cb 100644 --- a/dot-emacs.el +++ b/dot-emacs.el @@ -188,6 +188,78 @@ symbols `sunday', `monday', etc. (or a mixture). If the date stored in (nth 2 when)))))))) (eq w d))) +;;;----- Mail and news hacking ---------------------------------------------- + +(define-derived-mode mdwmail-mode mail-mode "[mdw] mail" + "Major mode for editing news and mail messages from external programs +Not much right now. Just support for doing MailCrypt stuff." + :syntax-table nil + :abbrev-table nil + (run-hooks 'mail-setup-hook)) + +(define-key mdwmail-mode-map [?\C-c ?\C-c] 'disabled-operation) + +(add-hook 'mdwail-mode-hook + (lambda () + (set-buffer-file-coding-system 'utf-8) + (make-local-variable 'paragraph-separate) + (make-local-variable 'paragraph-start) + (setq paragraph-start + (concat "[ \t]*[-_][-_][-_]+$\\|^-- \\|-----\\|" + paragraph-start)) + (setq paragraph-separate + (concat "[ \t]*[-_][-_][-_]+$\\|^-- \\|-----\\|" + paragraph-separate)))) + +;; --- How to encrypt in mdwmail --- + +(defun mdwmail-mc-encrypt (&optional recip scm start end from sign) + (or start + (setq start (save-excursion + (goto-char (point-min)) + (or (search-forward "\n\n" nil t) (point-min))))) + (or end + (setq end (point-max))) + (mc-encrypt-generic recip scm start end from sign)) + +;; --- How to sign in mdwmail --- + +(defun mdwmail-mc-sign (key scm start end uclr) + (or start + (setq start (save-excursion + (goto-char (point-min)) + (or (search-forward "\n\n" nil t) (point-min))))) + (or end + (setq end (point-max))) + (mc-sign-generic key scm start end uclr)) + +;; --- Some signature mangling --- + +(defun mdwmail-mangle-signature () + (save-excursion + (goto-char (point-min)) + (perform-replace "\n-- \n" "\n-- " nil nil nil))) +(add-hook 'mail-setup-hook 'mdwmail-mangle-signature) +(add-hook 'message-setup-hook 'mdwmail-mangle-signature) + +;; --- Insert my login name into message-ids, so I can score replies --- + +(defadvice message-unique-id (after mdw-user-name last activate compile) + "Ensure that the user's name appears at the end of the message-id string, +so that it can be used for convenient filtering." + (setq ad-return-value (concat ad-return-value "." (user-login-name)))) + +;; --- Tell my movemail hack where movemail is --- +;; +;; This is needed to shup up warnings about LD_PRELOAD. + +(let ((path exec-path)) + (while path + (let ((try (expand-file-name "movemail" (car path)))) + (if (file-executable-p try) + (setenv "REAL_MOVEMAIL" try)) + (setq path (cdr path))))) + ;;;----- Utility functions -------------------------------------------------- (or (fboundp 'line-number-at-pos) @@ -323,58 +395,6 @@ get itself into a twist." (mdw-check-autorevert)) (defadvice write-file (after mdw-autorevert activate) (mdw-check-autorevert)) - -(define-derived-mode mdwmail-mode mail-mode "[mdw] mail" - "Major mode for editing news and mail messages from external programs -Not much right now. Just support for doing MailCrypt stuff." - :syntax-table nil - :abbrev-table nil - (run-hooks 'mail-setup-hook)) - -(define-key mdwmail-mode-map [?\C-c ?\C-c] 'disabled-operation) - -(add-hook 'mdwail-mode-hook - (lambda () - (set-buffer-file-coding-system 'utf-8) - (make-local-variable 'paragraph-separate) - (make-local-variable 'paragraph-start) - (setq paragraph-start - (concat "[ \t]*[-_][-_][-_]+$\\|^-- \\|-----\\|" - paragraph-start)) - (setq paragraph-separate - (concat "[ \t]*[-_][-_][-_]+$\\|^-- \\|-----\\|" - paragraph-separate)))) - -;; --- How to encrypt in mdwmail --- - -(defun mdwmail-mc-encrypt (&optional recip scm start end from sign) - (or start - (setq start (save-excursion - (goto-char (point-min)) - (or (search-forward "\n\n" nil t) (point-min))))) - (or end - (setq end (point-max))) - (mc-encrypt-generic recip scm start end from sign)) - -;; --- How to sign in mdwmail --- - -(defun mdwmail-mc-sign (key scm start end uclr) - (or start - (setq start (save-excursion - (goto-char (point-min)) - (or (search-forward "\n\n" nil t) (point-min))))) - (or end - (setq end (point-max))) - (mc-sign-generic key scm start end uclr)) - -;; --- Some signature mangling --- - -(defun mdwmail-mangle-signature () - (save-excursion - (goto-char (point-min)) - (perform-replace "\n-- \n" "\n-- " nil nil nil))) -(add-hook 'mail-setup-hook 'mdwmail-mangle-signature) - ;;;----- Dired hacking ------------------------------------------------------ (defadvice dired-maybe-insert-subdir diff --git a/emacs b/emacs index 40d4b0f..e803bdc 100644 --- a/emacs +++ b/emacs @@ -116,6 +116,18 @@ (setq rmail-display-summary t) (setq rmail-file-name "~/Mail/rmail") +(setq sendmail-program "~/bin/sendmail-hack") + +(setq mail-user-agent 'message-user-agent) + +(and (fboundp 'turn-on-gnus-dired-mode) + (not mdw-fast-startup) + (add-hook 'dired-mode-hook 'turn-on-gnus-dired-mode)) + +(or mdw-fast-startup + (trap (bbdb-initialize 'gnus 'sendmail 'vm 'message))) +(setq bbdb-north-american-phone-numbers-p nil) + ;; --- Customization --- (setq custom-file "~/.emacs-custom") @@ -373,7 +385,6 @@ (global-set-key [?\C-x ?/] 'auto-fill-mode) (global-set-key [?\C-x ?w ?d] 'mdw-divvy-window) (global-set-key [insertchar] 'overwrite-mode) -(global-set-key [?\C-x ?m] 'vm-mail) (global-set-key [?\C-x ?\C-n] 'skel-create-file) (global-set-key [?\C-x ?4 ?n] 'skel-create-file-other-window) (global-set-key [?\C-x ?5 ?n] 'skel-create-file-other-frame) diff --git a/gnus.el b/gnus.el new file mode 100644 index 0000000..cf2ebbc --- /dev/null +++ b/gnus.el @@ -0,0 +1,82 @@ +;;; -*- mode: emacs-lisp; coding: utf-8 -*- +;;; +;;; GNUS configuration +;;; +;;; (c) 2009 Mark Wooding +;;; + +;;;----- Licensing notice --------------------------------------------------- +;;; +;;; This program 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 of the License, or +;;; (at your option) any later version. +;;; +;;; This program is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with this program; if not, write to the Free Software +;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA + +;;;-------------------------------------------------------------------------- +;;; General Gnus preferences. + +;; Divide the main groups list by topics. +(add-hook 'gnus-group-mode-hook 'gnus-topic-mode) +(setq gnus-subscribe-newsgroup-method 'gnus-subscribe-topics) + +;; Use hacky movemail program to move mail. +(setq mail-source-movemail-program "~/bin/movemail-hack") + +;; Don't force use of a full window. +(setq gnus-use-full-window nil) + +;; Display a slrn-like tree view in the summary window. +(setq gnus-use-trees nil) +(setq gnus-summary-line-format "%U%R%z%4L %(%[%-16,16f%]%): %B %s\n") +(setq gnus-sum-thread-tree-root ">" + gnus-sum-thread-tree-false-root ">" + gnus-sum-thread-tree-single-indent "=" + gnus-sum-thread-tree-indent " ") +(if (eq (coding-system-get (terminal-coding-system) 'mime-charset) 'utf-8) + (setq gnus-sum-thread-tree-leaf-with-other "├─>" + gnus-sum-thread-tree-vertical "│ " + gnus-sum-thread-tree-single-leaf "╰─>") + (setq gnus-sum-thread-tree-leaf-with-other "|->" + gnus-sum-thread-tree-vertical "| " + gnus-sum-thread-tree-single-leaf "'->")) + +;; Sort threads in a useful way. +(setq gnus-thread-sort-functions + '(gnus-thread-sort-by-number + gnus-thread-sort-by-subject + gnus-thread-sort-by-total-score)) + +;; Don't expand threads on initial opening. +(setq gnus-thread-hide-subtree t) + +;; Don't use strange icons instead of traditional smileys. +(setq gnus-treat-display-smileys nil) + +;; Fairly large numbers of articles are OK; don't bother warning me. +(setq gnus-large-newsgroup 500) + +;; When splitting articles, crossposting is a reasonable thing to do. +(setq nnimap-split-crosspost t) + +;; We may have the misfortune to talk to an Exchange server. +(setq imap-enable-exchange-bug-workaround t) + +;;;-------------------------------------------------------------------------- +;;; Local configuration. + +;; Fetching news from the local news server seems sensible. +(setq gnus-select-method `(nntp ,(mdw-config 'nntp-server))) + +;; Now load a local configuration file. +(load "~/.gnus-local.el") + +;;;----- That's all, folks -------------------------------------------------- diff --git a/mdw-gnus-patch.el b/mdw-gnus-patch.el new file mode 100644 index 0000000..49e1072 --- /dev/null +++ b/mdw-gnus-patch.el @@ -0,0 +1,193 @@ +;;; very unpleasant hacking; may it not last long + +(require 'imap) +(require 'nnimap) +(require 'cl) + +(defsubst imap-parse-number () + (when (looking-at "-?[0-9]+") + (prog1 + (string-to-number (match-string 0)) + (goto-char (match-end 0))))) + +(defun imap-parse-body () + (let (body) + (when (eq (char-after) ?\() + (imap-forward) + (if (eq (char-after) ?\() + (let (subbody) + (while (and (eq (char-after) ?\() + (setq subbody + (imap-parse-body))) + ;; buggy stalker communigate pro + ;; 3.0 insert a SPC between + ;; parts in multiparts + (when (and (eq (char-after) ?\ + ) + (eq (char-after (1+ + (point))) ?\()) + (imap-forward)) + (push subbody body)) + (imap-forward) + (push (imap-parse-string) body) + ;; media-subtype + (when (eq (char-after) ?\ ) ;; body-ext-mpart: + (imap-forward) + (if (eq + (char-after) + ?\() ;; body-fld-param + (push + (imap-parse-string-list) body) + (push (and + (imap-parse-nil) nil) body)) + (setq body + (append + (imap-parse-body-ext) body))) ;; body-ext-... + (assert (eq (char-after) + ?\)) nil "In imap-parse-body") + (imap-forward) + (nreverse body)) + + (push (imap-parse-string) body) ;; media-type + (imap-forward) + (push (imap-parse-string) body) ;; media-subtype + (imap-forward) + ;; next line for Sun SIMS bug + (and (eq (char-after) ? ) (imap-forward)) + (if (eq (char-after) ?\() ;; body-fld-param + (push (imap-parse-string-list) body) + (push (and (imap-parse-nil) nil) body)) + (imap-forward) + (push (imap-parse-nstring) body) ;; body-fld-id + (imap-forward) + (push (imap-parse-nstring) body) ;; body-fld-desc + (imap-forward) + ;; next `or' for Sun SIMS bug, it regard + ;; body-fld-enc as a + ;; nstring and return nil instead of defaulting + ;; back to 7BIT + ;; as the standard says. + (push (or (imap-parse-nstring) "7BIT") body) ;; body-fld-enc + (imap-forward) + (push (imap-parse-number) body) ;; body-fld-octets + + ;; ok, we're done parsing the required parts, + ;; what comes now is one + ;; of three things: + ;; + ;; envelope (then we're parsing + ;; body-type-msg) + ;; body-fld-lines (then we're parsing + ;; body-type-text) + ;; body-ext-1part (then we're parsing + ;; body-type-basic) + ;; + ;; the problem is that the two first are in + ;; turn optionally followed + ;; by the third. So we parse the first two here + ;; (if there are any)... + + (when (eq (char-after) ?\ ) + (imap-forward) + (let (lines) + (cond ((eq (char-after) ?\() ;; body-type-msg: + (push (imap-parse-envelope) + body) ;; envelope + (imap-forward) + (push + (imap-parse-body) body) ;; body + ;; buggy stalker + ;; communigate pro + ;; 3.0 doesn't + ;; print + ;; number of lines + ;; in + ;; message/rfc822 + ;; attachment + (if (eq + (char-after) ?\)) + (push 0 + body) + (imap-forward) + (push + (imap-parse-number) body))) ;; body-fld-lines + ((setq lines + (imap-parse-number)) ;; body-type-text: + (push lines body)) ;; body-fld-lines + (t + (backward-char))))) ;; no match... + + ;; ...and then parse the third one here... + + (when (eq (char-after) ?\ ) ;; body-ext-1part: + (imap-forward) + (push (imap-parse-nstring) body) ;; body-fld-md5 + (setq body (append (imap-parse-body-ext) + body))) ;; body-ext-1part.. + + (assert (eq (char-after) ?\)) nil "In + imap-parse-body 2") + (imap-forward) + (nreverse body))))) + +(defvar imap-enable-exchange-bug-workaround nil + "Send FETCH UID commands as *:* instead of *. +Enabling this appears to be required for some servers (e.g., +Microsoft Exchange) which otherwise would trigger a response 'BAD +The specified message set is invalid.'. + +BACKPORT from No Gnus!") + +(defun nnimap-find-minmax-uid (group &optional examine) + "Find lowest and highest active article number in GROUP. +If EXAMINE is non-nil the group is selected read-only." + (with-current-buffer nnimap-server-buffer + (when (or (string= group (imap-current-mailbox)) + (imap-mailbox-select group examine)) + (let (minuid maxuid) + (when (> (imap-mailbox-get 'exists) 0) + (imap-fetch (if imap-enable-exchange-bug-workaround "1,*:*" "1,*") + "UID" nil 'nouidfetch) + (imap-message-map (lambda (uid Uid) + (setq minuid (if minuid (min minuid uid) uid) + maxuid (if maxuid (max maxuid uid) uid))) + 'UID)) + (list (imap-mailbox-get 'exists) minuid maxuid))))) + +(defun imap-message-copyuid-1 (mailbox) + (if (imap-capability 'UIDPLUS) + (list (nth 0 (imap-mailbox-get-1 'copyuid mailbox)) + (string-to-number (nth 2 (imap-mailbox-get-1 'copyuid mailbox)))) + (let ((old-mailbox imap-current-mailbox) + (state imap-state) + (imap-message-data (make-vector 2 0))) + (when (imap-mailbox-examine-1 mailbox) + (prog1 + (and (imap-fetch + (if imap-enable-exchange-bug-workaround "*:*" "*") "UID") + (list (imap-mailbox-get-1 'uidvalidity mailbox) + (apply 'max (imap-message-map + (lambda (uid prop) uid) 'UID)))) + (if old-mailbox + (imap-mailbox-select old-mailbox (eq state 'examine)) + (imap-mailbox-unselect))))))) + +(defun imap-message-appenduid-1 (mailbox) + (if (imap-capability 'UIDPLUS) + (imap-mailbox-get-1 'appenduid mailbox) + (let ((old-mailbox imap-current-mailbox) + (state imap-state) + (imap-message-data (make-vector 2 0))) + (when (imap-mailbox-examine-1 mailbox) + (prog1 + (and (imap-fetch + (if imap-enable-exchange-bug-workaround "*:*" "*") "UID") + (list (imap-mailbox-get-1 'uidvalidity mailbox) + (apply 'max (imap-message-map + (lambda (uid prop) uid) 'UID)))) + (if old-mailbox + (imap-mailbox-select old-mailbox (eq state 'examine)) + (imap-mailbox-unselect))))))) + +;;(setq imap-log t) +(provide 'mdw-gnus-patch) diff --git a/setup b/setup index b1dcf58..79a6f34 100755 --- a/setup +++ b/setup @@ -129,7 +129,7 @@ fi ## Symlink the various dotfiles into place dotfiles=" bash_profile bash_logout bashrc inputrc bash_completion - emacs emacs-calc vm + emacs emacs-calc vm gnus.el vimrc mg mailrc signature cgrc tigrc @@ -230,6 +230,7 @@ echo "Installing Emacs packages..." emacspkg=" make-regexp ew-hols + mdw-gnus-patch git git-blame vc-git stgit quilt" for elib in $emacspkg; do @@ -242,8 +243,12 @@ for elib in $emacspkg; do (error 1))))'; then echo " already installed." else - $echon " downloading$echoc" - $GETURL $HOME$sub/lib/emacs/$elib.el $REPO/$elib.el + if [ -f $elib.el ]; then + cp $elib.el $HOME$sub/lib/emacs/$elib.el + else + $echon " downloading$echoc" + $GETURL $HOME$sub/lib/emacs/$elib.el $REPO/$elib.el + fi $echon " compiling$echoc" (cd $HOME$sub/lib/emacs; $emacs >/dev/null 2>&1 --no-site-file --batch \ diff --git a/vm b/vm index fcd353d..3a1d494 100644 --- a/vm +++ b/vm @@ -2,13 +2,6 @@ ;;; ;;; Configuration for VM -(let ((path exec-path)) - (while path - (let ((try (expand-file-name "movemail" (car path)))) - (if (file-executable-p try) - (setenv "REAL_MOVEMAIL" try)) - (setq path (cdr path))))) - (setq vm-reply-subject-prefix "Re: " vm-included-text-prefix "> " vm-included-text-attribution-format "%F <%f> wrote:\n\n" -- 2.11.0