(defvar my-wl-plucker-build-command "/usr/local/bin/plucker-build") (defvar my-wl-plucker-home-directory "~/.plucker") (defvar my-wl-plucker-default-options '("--stayonhost" "--category" "wl-message")) (modify-coding-system-alist 'process my-wl-plucker-build-command '(shift_jis . shift_jis)) (defun my-wl-plucker-summary-plucker-message () (interactive) (let* ((message (wl-summary-message-string t)) (dir (if (fboundp 'temp-directory) (temp-directory) temporary-file-directory)) (temp-name (concat (make-temp-name (expand-file-name (concat (user-login-name) "-wl") (expand-file-name dir))) ".html")) (output (my-wl-plucker-make-time-string (current-time))) v decoder subject options xref case-fold-search) (setq output (concat my-wl-plucker-home-directory (unless (eq (aref my-wl-plucker-home-directory (1- (length my-wl-plucker-home-directory))) ?/) "/") "wl-plucker-" output)) (unwind-protect (progn (with-temp-buffer (insert message) (setq subject (buffer-substring-no-properties (progn (mail-position-on-field "Subject") (point)) (progn (re-search-backward ": ") (match-end 0)))) (setq decoder (mime-find-field-decoder 'Subject 'plain)) (setq subject (if (and subject decoder) (funcall decoder subject) subject)) (setq options (list "-N" subject)) (setq xref (buffer-substring-no-properties (progn (mail-position-on-field "Xref") (point)) (progn (re-search-backward ": ") (match-end 0)))) (goto-char (point-min)) (re-search-forward "^$" nil t nil) (re-search-forward "^" nil t nil) (delete-region (point-min) (match-beginning 0)) (when (and xref (not (string= xref "")) (re-search-forward "<\/body>" nil t nil)) (goto-char (match-beginning 0)) (forward-char -1) (insert "URL: " xref "\n")) (re-search-forward "^<\/html>" nil t nil) (delete-region (point-max) (point)) (write-region-as-binary (point-min) (point-max) temp-name nil 'symbol)) (setq options (nconc (list "-H" temp-name "-f" (expand-file-name output)) options)) (setq options (nconc options my-wl-plucker-default-options)) (setq options (delq nil options)) (setq v (apply 'call-process my-wl-plucker-build-command nil nil (get-buffer-create " *my WL error*") options)) (if (eq v 0) (message "Wrote %s.db" output) (pop-to-buffer " *my WL error*"))) (condition-case nil (delete-file temp-name) (error nil))))) (defun my-wl-plucker-make-time-string (time-list) (let* ((string (current-time-string time-list)) (year (substring string 22)) (time (concat (substring string 11 13) (substring string 14 16) (substring string 17 19))) (month (substring string 4 7)) (day (string-to-number (substring string 8 10))) (month-alist '(("Jan" . 1) ("Feb" . 2) ("Mar" . 3) ("Apr" . 4) ("May" . 5) ("Jun" . 6) ("Jul" . 7) ("Aug" . 8) ("Sep" . 9) ("Oct" . 10) ("Nov" . 11) ("Dec" . 12)))) (setq month (cdr (assoc month month-alist))) (format "%s%02d%02d%s" year month day time))) (define-key wl-summary-mode-map "\M-p" 'my-wl-plucker-summary-plucker-message)