(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)
(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
(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")
(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)
--- /dev/null
+;;; -*- 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 --------------------------------------------------
--- /dev/null
+;;; 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)
## 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
emacspkg="
make-regexp
ew-hols
+ mdw-gnus-patch
git git-blame vc-git stgit
quilt"
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 \
;;;
;;; 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"
~mdw / profile / commitdiff