[Mew-dist 04185] Re: Filename from CT:

[Shun-ichi GOTO]

後藤＠太陽計測です

>>>>> From: Kazu Yamamoto (山本和彦) <Kazu at example.com>
> 残念ながらこのパッチは採用できません。

ということなので、本体に対するパッチではなく
個人使用のための、（はやりの？）寄生型としてこんなのいかがでしょうか。

先のパッチと同様、CT: name= を使ったりするためのものですが、
今回はmewオリジナル本体へのパッチ＆コンパイルは不要です。

mew-decode-mime-headerにとりつき、必要ならば Content-Disposition: を
でっち上げて、mewをだまします。

1. CT: name= を見てくれます
2. B/Q-Encされたものならデコードします。
3. 生JISでも受け入れます。
4. 指定すればCD:をファイル名にも使えます。(option)


各個人の責任において、お使いください。
(あくまで un-official & out-of-RFC な動作なのでね）

--- Regards,
 Shun-ichi Goto  <gotoh at example.com>
   R&D Group, TAIYO Corp., Tokyo, JAPAN

-------------- next part --------------
;;; -*- Emacs-Lisp -*-
;; mew-fake-cdp -- Un-official attachment filename support.
;;

;; Create: 98/3/13
;; Author: Shun-ichi GOTO <gotoh at example.com>
;;
;; $Revision: 1.3 $

;; *********************************************************
;; ******* NOTE: THESE ARE OUT OF RFC SPECIFICATION. *******
;; *******       USE THIS WITH YOUR OWN RISK.        *******
;; *********************************************************

;; To use mew-fake-cdp.el, put followings in your .emacs
;;
;; (autoload 'mew-fake-cdp-setup "mew-fake-cdp")
;; (add-hook 'mew-init-hook 'mew-fake-cdp-setup)
;;

(require 'mew-decode)

(defvar mew-fake-cdp-use-cd nil
  "*Use Content-Description: as filename")

(defvar mew-fake-cdp-use-ct t
  "*Use Content-Type: name=xxx as filename")

(defvar mew-fake-cdp-remove-space nil
  "*Remove space/TAB characters in filename string")

(defun mew-fake-cdp-setup ()
  "Setup to use mew-fake-cdp package"
  (let (sym)
    (if (not (featurep 'mew))
	;; reserve later setup
	(eval-after-load "mew" 'mew-fake-cdp-setup)
      ;; setup now
      (setq sym (intern "org:mew-decode-mime-header"))
      (if (fboundp sym)
	  ()				;nothing to do
	(fset sym (symbol-function 'mew-decode-mime-header))
	(fset 'mew-decode-mime-header 
	      (symbol-function 'mew-fake-cdp-decode-mime-header))
	))))


(defun mew-fake-cdp-decode-mime-header (&optional dct)
  "Altanative function of mew-mew-decode-mime-header 
to support un-official attachment filename extraction.

This package provides:
 1. Make CDP: entry if CDP: is not specified and
    name= parameter of CT: is specified.
 2. Accept B/Q-Decoded filename. (like MIMEed Subject: header)
 3. Accept raw JIS filename string. (assume iso-2022-jp-2)
 4. Use Content-Description: as filename (optional)

NOTE: THESE ARE OUT OF RFC SPECIFICATION.
      USE THIS WITH YOUR OWN RISK.
"
  (let* ((syntax (org:mew-decode-mime-header dct))
	 (ctl (mew-syntax-get-ct syntax))
	 (cdpl (mew-syntax-get-cdp syntax))
	 (cd (mew-syntax-get-cd syntax))
	 filename
	 )
    ;; 1. use CDP: filename=
    ;; 2. use CT: name=
    ;; 3. use CD: (optional)
    (setq filename (or (and cdpl
			    (mew-syntax-get-member cdpl "filename"))
		       (and mew-fake-cdp-use-ct ctl 
			    (mew-syntax-get-member ctl "name"))
		       (and mew-fake-cdp-use-cd
			    cd)))
    (if (null filename)
	()				;nothing to do
      ;; Kanji conversion from B/Q-Enc. and raw-JIS
      (save-excursion
	(let ((buf (get-buffer-create " *mew-fake-cdp*")))
	  ;; in work-buffer...
	  (set-buffer buf)
	  (erase-buffer)
	  (insert filename)
	  ;; raw JIS conversion
	  (mew-cs-decode-region (point-min) (point-max) mew-cs-7bit)
	  ;; MIME decode
	  (mew-header-decode-address)
	  ;; remove spaces
	  (goto-char 1)
	  (if  mew-fake-cdp-remove-space
	      (while (re-search-forward "[ \t]+" nil t) (replace-match "")))
	  ;; get kanji filename from work-buffer
	  (setq filename (buffer-substring (point-min) (point-max)))
	  (kill-buffer buf)))
      ;; Fake CDP: entry
      (if (null cdpl)
	  ;; newly make
	  (setq cdpl (list "attachment"
			   (format "filename=%s" filename)))
	(if (mew-syntax-get-member cdpl "filename")
	    ;; replace
	    (setq cdpl (mapcar
			(lambda (x)
			  (let ((case-fold-search t))
			    (if (string-match "^filename=" x)
				(concat "filename=" filename)
			      x)))
			cdpl))
	  ;; add
	  (setq cdpl (append cdpl (list (concat "filename=" filename))))
	  ))
      (mew-syntax-set-cdp syntax cdpl)
      )
    ;; return
    syntax)) 

(provide 'mew-fake-cdp)

;;;
;;; end of mew-fake-cdp.el
;;;