Re: Customizing wanderlust reply header
On November 20, 2003 at 12:35AM +0800,
csj@myrealbox.com wrote:
> Is the separated date and time a mew feature?
No. The my-simplify-822date function (defined in my ~/.emacs)
provides that feature.
----
(my-simplify-822date "Thu, 20 Nov 2003 01:14:24 +0900 (JST)" 'at-time)
"November 20, 2003 at 1:14AM +0900"
(my-simplify-822date "Thu, 20 Nov 2003 01:14:24 +0900 (JST)" 'at-time 'iso-ymd)
"2003-11-20 at 1:14AM +0900"
(my-simplify-822date "Thu, 20 Nov 2003 01:14:24 +0900 (JST)")
"November 20, 2003"
----
> I was looking for ("On DATE at TIME, SOMEONE wrote)
See the following trick for Wanderlust with mu-cite.
----
(add-hook 'mail-citation-hook (function mu-cite-original))
(setq message-cite-function (function mu-cite-original))
;;;(add-hook 'mew-cite-hook 'mu-cite-original) ;; for Mew
(setq mu-cite-cited-prefix-regexp "^\x00\xff\x00$") ;; insert prefix at all
(setq mu-cite-prefix-format '("> "))
(setq mu-cite-top-format '(my-cite-label))
(add-hook 'mu-cite-instantiation-hook 'my-mu-cite-set-methods)
(defun my-mu-cite-set-methods ()
(setq mu-cite-methods-alist
(cons
(cons 'my-cite-label
(function
(lambda ()
(my-get-cite-label
(mu-cite-get-field-value "From")
(mu-cite-get-field-value "Date")
(mu-cite-get-field-value "Subject")
(mu-cite-get-value 'ml-name)
(mu-cite-get-value 'ml-count)))))
mu-cite-methods-alist)))
(defun my-get-cite-label (from dt subj
&optional ml-nm ml-cnt ml-cnt2 ml-cnt3)
(let ((ml-prefix "[") (ml-sep ":") (ml-suffix "]")
from-wrote)
(if (= (length from) 0)
(setq from "???"))
(setq from-wrote (concat (my-simplify-822from from) " wrote:\n\n"))
(if (not (string-match
"^\\([[(]\\)\\([a-zA-Z0-9._-]+\\)\\([ :,]\\)\\([0-9]+\\)\\([])]\\)" subj))
()
(setq ml-prefix (my-match-string 1 subj))
(setq ml-nm (my-match-string 2 subj))
(setq ml-sep (my-match-string 3 subj))
(setq ml-cnt (my-match-string 4 subj))
(setq ml-suffix (my-match-string 5 subj)))
(if (= (length ml-cnt) 0)
(setq ml-cnt ml-cnt2))
(if (= (length ml-cnt) 0)
(setq ml-cnt ml-cnt3))
(if (= (length dt) 0)
from-wrote
(if (or (= (length ml-nm) 0) (= (length ml-cnt) 0))
(concat "On " (my-simplify-822date dt 'at-time (not 'iso-ymd)) ",\n" from-wrote)
(concat "On " (my-simplify-822date dt nil (not 'iso-ymd))
", " ml-prefix ml-nm ml-sep ml-cnt ml-suffix
",\n" from-wrote)))))
(setq my-time-mon-alist
'(("Jan" 1 "January" "Jan.") ("Feb" 2 "February" "Feb.")
("Mar" 3 "March" "Mar.") ("Apr" 4 "April" "Apr.")
("May" 5 "May" "May") ("Jun" 6 "June" "June")
("Jul" 7 "July" "July") ("Aug" 8 "August" "Aug.")
("Sep" 9 "September" "Sep.") ("Oct" 10 "October" "Oct.")
("Nov" 11 "November" "Nov.") ("Dec" 12 "December" "Dec.")))
(defun my-time-mon-to-int (str)
(or (nth 1 (assoc (capitalize str) my-time-mon-alist)) 0))
(defun my-time-mon-to-month (str)
(or (nth 2 (assoc (capitalize str) my-time-mon-alist)) str))
(defun my-time-mon-to-mon4 (str)
(or (nth 3 (assoc (capitalize str) my-time-mon-alist)) str))
(defun my-simplify-822date (str &optional at-time iso-ymd)
"Simplify `Date' in RFC 822 message.
Note: the simplified date is not conformed to RFC 822."
(if (not (string-match "\\([0-9]+\\)[ \t]+\\([a-zA-Z]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+\\):\\([0-9]+\\)\\(:\\([0-9]+\\)\\)?\\([ \t]+\\([-+0-9a-zA-Z]+\\)\\)?" str))
str
(let (day mon year month ymd hour min ampm tmzn)
(setq day (string-to-int (my-match-string 1 str)))
(setq mon (my-match-string 2 str))
(setq year (string-to-int (my-match-string 3 str)))
(if (< year 50)
(setq year (+ year 2000))
(if (< year 1000)
(setq year (+ year 1900))))
(if iso-ymd
(setq ymd (format "%04d-%02d-%02d" year (my-time-mon-to-int mon) day))
(setq ymd (concat (my-time-mon-to-month mon) " "
(int-to-string day) ", "
(int-to-string year))))
(if (not at-time)
ymd
(setq hour (string-to-int (my-match-string 4 str)))
(setq min (my-match-string 5 str))
(if (match-beginning 9)
(setq tmzn (concat " " (my-match-string 9 str))))
(if (< hour 12)
(setq ampm "AM")
(setq ampm "PM")
(setq hour (- hour 12)))
(if (= hour 0)
(setq hour 12))
(concat ymd " at " (int-to-string hour) ":" min ampm tmzn)))))
(defun my-simplify-822from (str)
"Simplify `From' in RFC 822 message."
(let (name addr)
(if (string-match "\\([^@<> \n\t]+@[^@<> \n\t]+\\)" str)
(setq addr (my-trim-spc (my-match-string 1 str) 'simplify)))
(if (string-match "\\(.*\\)<[^@<> \n\t]+@[^@<> \n\t]+>" str)
(progn
(setq name (my-match-string 1 str))
;; remove non-ascii comment
(if (string-match "([^)]*[^\000-\177][^)]*)" name)
(setq name (replace-match "" nil t name)))
(setq name (my-trim-spc name 'simplify))))
(if (and (or (= (length name) 0) (string-match "[^\000-\177]" name))
(string-match
"<?[^@<> \n\t]+@[^@<> \n\t]+>?[ \n\t]*(\\([^)]+\\))" str))
(setq name (my-trim-spc (my-match-string 1 str) 'simplify)))
(if (and (or (= (length name) 0) (string-match "[^\000-\177]" name))
(string-match
"(\\([^)]+\\))[ \n\t]*<[^@<> \n\t]+@[^@<> \n\t]+>" str))
(setq name (my-trim-spc (my-match-string 1 str) 'simplify)))
(if (or (= (length name) 0) (string-match "[^\000-\177]" name))
addr
(my-trim-spc (concat name " <" addr ">") 'simplify))))
(defun my-trim-spc (str &optional simplify)
"Trimming white spaces."
(if (string-match "^[ \n\t]+" str)
(setq str (replace-match "" nil t str)))
(if (string-match "[ \n\t]+$" str)
(setq str (replace-match "" nil t str)))
(if (not simplify)
()
(while (string-match "[\n\t]+" str)
(setq str (replace-match " " nil t str)))
(while (string-match " +" str)
(setq str (replace-match " " nil t str))))
str)
(if (fboundp 'match-string-no-properties)
(defalias 'my-match-string 'match-string-no-properties)
(defalias 'my-match-string 'match-string))
----
--
Tatsuya Kinoshita
Reply to: