At 04 Mar 2003 08:56:16 +1100, Alan L Tyree wrote:
> I would very much appreciate a copy of you .wl file.
some probably needs explanation and much of it is most likely not
useful to you. feel free to ask.
in ~/.xemacs/init.el i have:
;; use wanderlust for default compose-mail
(autoload 'wl-user-agent-compose "wl-draft" nil t)
(if (boundp 'mail-user-agent)
(setq mail-user-agent 'wl-user-agent))
(if (fboundp 'define-mail-user-agent)
(define-mail-user-agent
'wl-user-agent
'wl-user-agent-compose
'wl-draft-send
'wl-draft-kill
'mail-send-hook))
my ~/.wl is attached. its complicated by the fact that i read both
home and work mail from the one wanderlust (two different imap
servers). thus i need to fully qualify many of the mail folder names.
unless you already use BBDB, you can probably ignore that whole
section, and some of the Debian-mail-specific bits.
- Gus
; wanderlust setup -*- emacs-lisp -*-
; see nice example at http://www.tamaru.kuee.kyoto-u.ac.jp/~kokada/wl/src
(setq wl-user-mail-address-list
(list "[EMAIL PROTECTED]"
"[EMAIL PROTECTED]"
"[EMAIL PROTECTED]"
"[EMAIL PROTECTED]"
"[EMAIL PROTECTED]"
"[EMAIL PROTECTED]"
"[EMAIL PROTECTED]"))
(setq wl-subscribed-mailing-list
'("[EMAIL PROTECTED]"
"[EMAIL PROTECTED]"
"[EMAIL PROTECTED]"
"[EMAIL PROTECTED]"
"[EMAIL PROTECTED]"
"[EMAIL PROTECTED]"
"[EMAIL PROTECTED]"
"[EMAIL PROTECTED]"
"[EMAIL PROTECTED]"))
(setq wl-local-domain "inodes.org"
wl-message-id-domain "gus.inodes.org") ; random unique string
; ldap
;(setq wl-use-ldap t
;wl-ldap-server "coke.int-server.urnet.com.au"
;wl-ldap-base "ou=People,dc=urnet,dc=com,dc=au")
(setq elmo-nntp-default-server "news.gmane.org")
(setq wl-from "Angus Lees <[EMAIL PROTECTED]>")
;(setq wl-from "Angus Lees <[EMAIL PROTECTED]>")
(setq wl-draft-config-alist
'(("^\\(To\\|Cc\\): [EMAIL PROTECTED]"
("From" . "Angus Lees <[EMAIL PROTECTED]>"))
("^\\(To\|Cc\\): [EMAIL PROTECTED]"
(template . "debian"))
("^To: [EMAIL PROTECTED]"
("Mail-Followup-To" . "[EMAIL PROTECTED]"))
("^To: [EMAIL PROTECTED]"
("From" . "Angus Lees <[EMAIL PROTECTED]>"))))
;; add a (pgp-sign . BOOL)
(unless (assq 'pgp-sign wl-draft-config-sub-func-alist)
(wl-append wl-draft-config-sub-func-alist
'((pgp-sign . mime-edit-set-sign))))
;; add a (pgp-encrypt . BOOL)
(unless (assq 'pgp-encrypt wl-draft-config-sub-func-alist)
(wl-append wl-draft-config-sub-func-alist
'((pgp-encrypt . mime-edit-set-encrypt))))
; add a (signature . "filename")
(unless (assq 'signature wl-draft-config-sub-func-alist)
(wl-append wl-draft-config-sub-func-alist
'((signature . wl-draft-config-sub-signature))))
(defun wl-draft-config-sub-signature (content)
(require 'signature)
(let ((signature-insert-at-eof nil)
(signature-file-name content))
;; should remove old signature first..
(goto-char (mime-edit-content-end)) ; part-bottom
(insert-signature)))
; apply wl-draft-config-alist when draft buffer is prepared, not when sent
(remove-hook 'wl-draft-send-hook 'wl-draft-config-exec)
(add-hook 'wl-mail-setup-hook
'(lambda ()
(unless wl-draft-reedit
(wl-draft-config-exec wl-draft-config-alist))))
(setq wl-draft-reply-buffer-style 'full)
(setq wl-draft-always-delete-myself t
wl-insert-mail-followup-to t)
; templates :)
(setq wl-template-alist
'(("default"
("From" . wl-from)
(signature . "~/.signature"))
("corporate"
("From" . "[EMAIL PROTECTED]")
("Organization" . "Ursys")
(signature . "~/.signature"))
("debian"
("From" . "[EMAIL PROTECTED]")
("Organization" . "Debian")
(signature . "~/.signature")
(pgp-sign . t))))
; silly-mail headers. heh.
(if (fboundp 'sm-add-random-header)
(add-hook 'wl-mail-setup-hook 'sm-add-random-header))
; cache sent messages in 'sendlog
(setq wl-draft-use-cache t
wl-fcc "+outbox"
wl-fcc-force-as-read t
wl-draft-delete-myself-from-bcc-fcc t)
(setq wl-plugged t
elmo-enable-disconnected-operation t
elmo-plugged-condition 'elmo-plug-on-by-exclude-servers
wl-auto-flush-queue t)
(setq wl-folder-access-subscribe-alist
'(("^%" . (t ".")))
wl-folder-hierarchy-access-folders
'("^-$" "^-alt$"
"^-gmane$" "^-gmane.comp$" "^-gmane.linux$"))
(setq wl-summary-target-above 2000
wl-score-folder-alist
'(("^%Mail/slug$" "slug.SCORE")
("^-gmane\\." "gmane.SCORE")))
(setq wl-thread-insert-opened t
wl-summary-divide-thread-when-subject-changed t)
(setq wl-highlight-folder-by-numbers 1)
(setq wl-fldmgr-add-complete-with-current-folder-list t)
;; bind "b" to resend-message
(define-key wl-summary-mode-map "b" 'wl-summary-resend-message)
;; emulate some mailcrypt (non-mime) PGP functions
(require 'wl-pgp-nonmime)
;;{{{ BBDB
;;
;; FIXME: somehow ignore name changes to wl-subscribed-mailing-list
;;
(require 'bbdb-wl)
(bbdb-wl-setup)
(setq bbdb/mail-auto-create-p 'bbdb-ignore-some-messages-hook
bbdb-ignore-some-messages-alist
'(("From" . "mailer.daemon")
("Resent-Sender" . "[EMAIL PROTECTED]"))
bbdb-use-pop-up nil
bbdb-electric-p t
bbdb-offer-save 'just-save-dammit
;bbdb-pop-up-elided-display t
;bbdb-pop-up-target-lines 5
signature-use-bbdb t
wl-summary-from-function 'bbdb-wl-from-func
bbdb-user-mail-names (mapconcat 'regexp-quote
wl-user-mail-address-list "\\|"))
(add-hook 'bbdb-change-hook 'bbdb-delete-redundant-nets)
(defun my-bbdb-canonicalize-net-hook (addr)
(cond
;; rewrite mail-drop hosts (from sample-bbdb-canonicalize-net-hook)
((string-match
(concat "\\`\\([EMAIL PROTECTED]@\\).*\\.\\(" bbdb-canonical-hosts "\\)\\'")
addr)
(concat (bbdb-match-substring addr 1) (bbdb-match-substring addr 2)))
;; drop user+whatever
((string-match "\\`\\([EMAIL PROTECTED])[EMAIL
PROTECTED](@switchonline\\.com\\.au\\)\\'" addr)
(concat (bbdb-match-substring addr 1) (bbdb-match-substring addr 2)))
;; drop tmda foo-dated-whatever
((string-match "\\`\\([EMAIL PROTECTED])[EMAIL PROTECTED](@.*\\)\\'" addr)
(concat (bbdb-match-substring addr 1) (bbdb-match-substring addr 2)))
(t addr)))
(setq bbdb-canonicalize-net-hook 'my-bbdb-canonicalize-net-hook)
(defun my-bbdb-canonicalize-name-hook (name)
(cond
;; replace multiple whitespace with single
((string-match "[ \f\t\n\r\v]\\{2,\\}" name)
(replace-match " " nil t name))
;; strip leading whitespace (this is a bug in std11 libs?)
((string-match "\\`[ \t]+\\(.*\\)" name)
(bbdb-match-substring name 1))
;; strip extra quotes (Some MS mailer likes "'full name'")
((string-match "\\`[`'\"]\\(.*\\)[`'\"]\\'" name)
(bbdb-match-substring name 1))
;; Surname, Firstname -> Firstname Surname
((string-match "\\`\\(\\w+\\), \\(\\w+\\)\\'" name)
(concat (bbdb-match-substring name 2) " " (bbdb-match-substring name 1)))
(t name)))
(defun my-bbdb-canonicalize-name (name)
(when name ;name is sometimes nil?
(while (not (eq name (setq name (my-bbdb-canonicalize-name-hook name))))))
name)
(setq bbdb-wl-canonicalize-full-name-function 'my-bbdb-canonicalize-name)
;; bugfix? bbdb-hack-x-face assumes highlight-headers-hack-x-face-p is a function
(defun-when-void highlight-headers-hack-x-face-p ()
highlight-headers-hack-x-face-p)
(put 'face 'field-separator "\n")
(put 'cface 'field-separator "\n")
;; from Steve Youngs, slightly modified to remove call to gnus-convert-face-to-png
(defun steve-bbdb-display-colour-face ()
"Search for face properties and display the faces.
This is from Alex Schroeder."
(let ((inhibit-read-only t); edit the BBDB buffer
(all-records bbdb-records)
cface record start)
(while all-records
(setq record (caar all-records)
cface (bbdb-record-getprop record 'cface)
start (marker-position (nth 2 (car all-records))))
(if cface
(progn
(set-extent-begin-glyph
(make-extent start start)
(make-glyph
(list (vector 'png ':data (base64-decode-string cface)))))
(insert " ")))
(setq all-records (cddr all-records)))))
(add-hook 'bbdb-list-hook 'steve-bbdb-display-colour-face)
(add-hook 'bbdb-notice-hook 'bbdb-auto-notes-hook)
(setq bbdb-auto-notes-alist
'(("Organization" (".*" company 0))
("List-Id"
("<.*slug\\.org\\.au>" . "SLUG")
("<.*\\.lists\\.freeswan\\.org>" . "FreeSWAN"))
("X-Mailing-List"
("[EMAIL PROTECTED]" . "Debian")
("[EMAIL PROTECTED]" . "Embperl"))
("X-URL" (".*" www 0))
("X-URI" (".*" www 0))
("User-Agent" (".*" mailer 0))
("X-Mailer" (".*" mailer 0))
("X-Newsreader" (".*" mailer 0))
("Subject" (".*" last-subj 0 'replace))
("X-Face" (".+" face 0 'replace))
("Face" (".+" cface 0 'replace))))
;;}}}
(setq elmo-msgdb-extra-fields
'("x-spam-flag" "x-ml-name" "list-id" "mailing-list"))
(setq wl-message-ignored-field-list
'(".*Received:" ".*Path:" ".*I[dD]:" "^Replied:" "^Errors-To:"
"^Lines:" "^\\(X-\\)?Sender:" ".*Host:" "^Xref:" "^Precedence:"
"^\\(X-\\(MSMail-\\)?\\)?Priority:" "^Status:" "^X-VM-.*:"
"^List-" "^Content-" "^Delivered-To:" "^Mime-Version:"
"^\\(X-\\)?Mailing-List:" "^X-BeenThere:" "^X-Mailman" "^X-MimeOLE:"
"^X-Loop:" "^X-From_:" "^X-OriginalArrivalTime:" "^X-Orcpt:"
"^X-Authentication-Warning:" "^X-Uptime:" "^X-Original-Date:"
"^X-Fetchmail-Warning:" "^X-MIMETrack:" "^Managed-by:"
"^X-Virus-Scanned\\(-By\\)?:" "^X-MailScanner:"
"^X-MIME-Autoconverted:"
"^X-Sanitizer:" "^X-Browser:" "^X-Spam-Level:"
"^X-Spam-Rating:" "X-Qmail-Scanner\\(-Mail-From\\)?:"
"^X-Mail-Count:" "^X-MLServer:" "^X-ML-Info:"
"^X-\\(Debian-PR\\|PTS\\)-Keywords?:" "^X-Unsubscribe:")
wl-message-visible-field-list
'("^To:" "^Cc:" "^From:" "^Subject:" "^Organi[sz]ation:")
wl-message-sort-field-list
'("Return-Path" "Received" "^To" "^Cc" "Newsgroups"
"Subject" "^From" "^Organi[sz]ation" "^Date" "^Resent"))
;; Don't rewrap "formatted" headers
(mime-set-field-decoder 'X-Spam-Status 'wide nil)
;;{{{ Debian buttons
;; debian bug numbers
(when (fboundp 'debian-bug-web-bug)
(autoload 'debian-bug-web-package "debian-bug")
(wl-append wl-message-header-button-alist
'(("^Subject:" "Bug#\\([0-9]+\\)"
0 debian-bug-web-bug 1 12)
("^X-Debian-PR-Message:" "[0-9]+"
0 debian-bug-web-bug 0 8)
("^X-\\(Debian-PR\\|PTS\\)-Package:" "[-.A-Za-z0-9]+"
0 debian-bug-web-package 0 25)))
(wl-append wl-message-body-button-alist
'(("\\<\\([Cc]loses:? *#?\\|[Bb]ugs?#? *\\)?\\([0-9]+\\)"
0 debian-bug-web-bug 2 1024))))
(set-alist 'wl-message-header-button-alist
"URL" (list mime-browse-url-regexp 0 'browse-url 0 40))
;;}}}
;;{{{ RT buttons
;; RT hyperlinks (because i could)
(defvar rt-web-server-alist
'(("busibox.com.au" . "http://rt.urnet.com.au/";))
"Alist of RT ticket \"rtnames\" and their corresponding web server")
(defvar rt-default-rtname "busibox.com.au"
"Default RT ticket \"rtname\" to use if no other is specified")
(defun rt-web-ticket (ticket &optional rtname)
"Jump to a Request Tracker ticket via browse-url"
(interactive "sTicket:")
(if (string-equal ticket "")
(message "No ticket to look up.")
(let* ((r (or rtname rt-default-rtname))
(server (cdr (or (assoc r rt-web-server-alist)
(error (format "No server known for `%s'" r))))))
(browse-url (concat server "/Ticket/Display.html?id=" ticket))
(message "Looking up ticket %s/%s via browse-url" r ticket))))
(defun rt-web-ticket-button (string)
"Call `rt-web-ticket' after splitting STRING into rtname and ticket id"
(save-match-data
(string-match "\\([^ ]*\\) +#\\([0-9]+\\)" string)
(rt-web-ticket (match-string 2 string) (match-string 1 string))))
;; FIXME needs to be a reply to current-buffer.
;; In particular needs to keep RT-Ticket header.
(defun rt-reply-to-originator (originator)
"Compose reply to ORIGINATOR."
(compose-mail originator))
(set-alist 'wl-message-header-button-alist "^RT-Ticket:"
'("[^ ]* +#[0-9]+" 0 rt-web-ticket-button 0 25))
(set-alist 'wl-message-header-button-alist "^RT-Originator:"
'("[^ [EMAIL PROTECTED]" 0 rt-reply-to-originator 0 25))
;;}}}
(setq wl-generate-mailer-string-function
(function
(lambda ()
(wl-generate-user-agent-string-1 nil))))
(setq wl-biff-check-interval 300 ; 300 seconds (5 mins)
wl-biff-check-folder-list
'("%Mail/[EMAIL PROTECTED]"))
;(defun my-wl-update-current-summaries ()
; (let ((buffers (wl-collect-summary)))
; (while buffers
; (with-current-buffer (car buffers)
; (save-excursion
; (wl-summary-sync-update)))
; (setq buffers (cdr buffers)))))
;(add-hook 'wl-biff-notify-hook 'my-wl-update-current-summaries)
(setq wl-refile-rule-alist
'(("List-Id"
("<pdftex\\.tug\\.org>" . "%Mail/[EMAIL PROTECTED]")
("<design\\.lists\\.freeswan\\.org>" . "%inbox/freeswan:[EMAIL
PROTECTED]/[EMAIL PROTECTED]"))
("Mailing-List"
("[EMAIL PROTECTED]" . "%Mail/[EMAIL PROTECTED]"))
("Cc"
("\\(aegis\\|cook\\)[EMAIL PROTECTED]" . "%Mail/[EMAIL PROTECTED]"))
("From"
("oriel\\.com\\.au" . "%Mail/[EMAIL PROTECTED]")
("whirlwind\\(sydney\\)?\\.\\(com\\|net\\)\\.au"
. "%Mail/[EMAIL PROTECTED]"))))
;; strip [listname] from subject lines in folders that only contain that list
(defvar my-folder-subject-functions-alist
'(("slug" my-summary-subject-strip "\\[SLUG\\] *"))
"alist of (regex function args) pairs for filtering subjects.
ALL functions matching the current folder name are called.")
(defun my-summary-subject-function (subject)
"call appropriate function from `my-folder-subject-functions' on SUBJECT"
(let ((case-fold-search t)
(alist my-folder-subject-functions-alist)
(folder (wl-summary-buffer-folder-name))
entry)
(if folder
(save-match-data
(while alist
(setq entry (car alist)
alist (cdr alist))
(when (string-match (car entry) folder)
(let ((func (cdr entry))
(args '()))
(if (listp func)
(setq args (cdr func)
func (car func)))
(setq subject (apply func subject args)))))))
subject))
(defun my-summary-subject-strip (subject regexp)
"Strip REGEXP from SUBJECT"
(save-match-data
(if (string-match regexp subject)
(concat (substring subject 0 (match-beginning 0))
(substring subject (match-end 0)))
subject)))
(setq wl-summary-subject-function 'my-summary-subject-function)
;; new Face header
;; http://triaez.kaisei.org/~kaoru/diary/?200301b#200301192
(defun wl-highlight-face-header ()
(save-restriction
(save-excursion
(x-face-narrow-to-header)
(let ((hide-props (if x-face-xmas-inhibit-read-only
'(invisible t)
'(invisible t read-only t)))
face from-pt face-pt)
(when (and (setq face (x-face-mail-fetch-field "Face"))
(goto-char (point-min))
(setq from-pt (x-face-search-field "^From")))
(set-extent-end-glyph
(make-extent (nth 1 from-pt) (nth 1 from-pt))
(make-glyph (vector 'png :data (base64-decode-string face))))
;; Hide Face field
(goto-char (point-min))
(setq face-pt (x-face-search-field "^Face"))
(add-text-properties (nth 0 face-pt) (nth 2 face-pt) hide-props))))))
;; x-face
(when window-system
(cond ((and (featurep 'xemacs) ; for XEmacs
(module-installed-p 'x-face))
(require 'x-face)
;(autoload 'x-face-xmas-wl-display-x-face "x-face")
(setq wl-highlight-x-face-function
(lambda ()
(cond ((std11-field-body "Face")
(wl-highlight-face-header))
((std11-field-body "X-Face")
(x-face-xmas-wl-display-x-face))))))
;; for Emacs21
((and (not (featurep 'xemacs))
(= emacs-major-version 21)
(module-installed-p 'x-face-e21))
(autoload 'x-face-decode-message-header "x-face-e21")
(setq wl-highlight-x-face-function 'x-face-decode-message-header))
;; for Emacs 19.34, Emacs 20.x
((module-installed-p 'x-face-mule)
;; x-face-mule distributed with bitmap-mule 8.0 or later
(autoload 'x-face-decode-message-header "x-face-mule")
(setq wl-highlight-x-face-function 'x-face-decode-message-header))
))
(defun mime-display-application/ms-tnef (entity situation)
(save-restriction
(narrow-to-region (point-max)(point-max))
(mime-insert-entity-content entity)
(shell-command-on-region (point-min) (point-max)
"tnef --list" nil t)))
(defun mime-extract-application/ms-tnef (entity situation)
(let ((dir (if (eq t mime-save-directory)
default-directory
mime-save-directory))
(tmpfile (make-temp-name (expand-file-name "mime-tnef"
(temp-directory)))))
(setq dir (read-directory-name
(format "Extract contents into: (default %s) " dir) dir))
(unless (file-exists-p dir)
(if (yes-or-no-p (format "Directory %s does not exist. Create? " dir))
(make-directory dir t)
(error 'file-error)))
(mime-write-entity-content entity tmpfile)
(shell-command (format "tnef --interactive --directory %s --file %s"
dir tmpfile))
(delete-file tmpfile)))
(mime-add-condition
'preview
'((type . application)(subtype . ms-tnef)
(body . visible)
(body-presentation-method . mime-display-application/ms-tnef)))
(mime-add-condition
'action
'((type . application)(subtype . ms-tnef)
(mode . "view")
(method . mime-extract-application/ms-tnef)))
;; use with mhc
(when (fboundp 'mhc-select-mailer-package)
(mhc-select-mailer-package 'wl))
;; FIXME: add archiving for expiry from outbox
(setq wl-expire-alist
'(("^\\+trash$" (date 14) remove)
("^%Mail/\\(slarken\\|debian-devel\\|debian-mentors\\)[EMAIL PROTECTED]" (date
14) remove)))
