[Mew-dist 14827] Join the "Message/Partial"

[Hideyuki SHIRAI ( 白井秀行 )]

最近、Message/Partial なメールが来ないので安心していたら、来てし
まいました。

ちからづく & multi byte の扱いってわかんない ^^;、なのですが、と
りあえず実装してみました。

# IM から後退した点 => '@' はちゃんとついていないといけない。

また、mew-scan-form-type () に

     ((string-match "Message/Partial"     ct) "P")

を入れて貰えるとわかりやすいのでありがたいです。

-- はじまり --
(defun mew-summary-join ()
  "Concat Message/Partial fragments marked with '@' to an original
message."
  (interactive)
  (mew-summary-multi-msgs
   (let* ((case-fold-search t)
	  (fld-msgs FLD-MSG-LIST)
	  (total (length fld-msgs))
	  (partnums (make-vector total nil))
	  (size (* mew-header-reasonable-size 2))
	  (buf (get-buffer-create " *mew join*"))
	  fld msgs num ct id pos pos1 halist header)
     (setq fld (car (car fld-msgs)))
     (while fld-msgs
       (setq msgs (cons (cdr (car fld-msgs)) msgs))
       (setq fld-msgs (cdr fld-msgs)))
     ;; get sequential number
     (save-excursion
       (set-buffer buf)
       (buffer-disable-undo)
       (while msgs
	 (erase-buffer)
	 (mew-insert-message
	  fld (car msgs) mew-cs-text-for-read size)
	 (setq ct (mew-header-get-value mew-ct:))
	 (if (not ct)
	     (error "Join error (no Content-type).")
	   (if (and (string-match "^message/partial" ct)
		    (string-match "number=\\([1-9][0-9]*\\)" ct))
	       (progn
		 (setq num (1- (string-to-int (mew-match 1 ct))))
		 (if (< total num)
		     (error "Join error (marked ignore)."))
		 (aset partnums num (car msgs))
		 (if (and (string-match "total=\\([1-9][0-9]*\\)" ct)
			  (= total (string-to-int (mew-match 1 ct))))
		     ()
		   (error "Join error (total ignore)."))
		 (if (string-match "id=\"\\([^\"]+\\)\"" ct)
		     (if (not id)
			 (setq id (mew-match 1 ct))
		       (if (not (string= id (mew-match 1 ct)))
			   (error "Join error (id ignore).")))))
	     (error "Join error (content-type ignore).")))
	 (setq msgs (cdr msgs)))
       ;; join messages
       (erase-buffer)
       (setq num 0)
       (while (< num total)
	 (goto-char (point-max))
	 (setq pos (point))
	 (mew-insert-message fld (aref partnums num)
			     mew-cs-text-for-read nil)
	 (if (not (= num 0))
	     (save-restriction
	       (narrow-to-region pos (point-max))
	       (mew-header-goto-end)
	       (forward-line)
	       (delete-region (point-min) (point)))
	   ;; first part
	   (mew-header-goto-end)
	   (if (not (re-search-forward "^[^ \t]" nil t))
	       (error "Join error (message ignore).")
	     (save-restriction
	       ;; rfc2046 (5.2.2.1.  Message Fragmentation and Reassembly)
	       (narrow-to-region (point) (point-max))
	       (goto-char (point-min))
	       (while (looking-at
		       (concat "^\\(Content-[^:]+\\|Subject\\|"
			       "Message-ID\\|Encrypted\\|MIME-Version\\): *"))
		 (setq pos (point))
		 (setq pos1 (match-end 0))
		 (setq header (concat (mew-buffer-substring pos (match-end 1)) ":"))
		 (forward-line)
		 (mew-header-goto-next)
		 (setq halist (cons (cons header (mew-buffer-substring pos1 (point)))
				    halist))
		 (delete-region pos (point))))
	     (mew-header-goto-end)
	     (save-restriction
	       (narrow-to-region (point-min) (point))
	       (while halist
		 (setq header (car halist))
		 (goto-char (point-min))
		 (if (not (re-search-forward
			   (concat "^" (regexp-quote (car header))) nil 'end))
		     (insert (car header) " " (cdr header))
		   (setq pos (match-beginning 0))
		   (forward-line)
		   (mew-header-goto-next)
		   (delete-region pos (point))
		   (insert (car header) " " (cdr header)))
		 (setq halist (cdr halist))))))
	 (goto-char (point-max))
	 (while (looking-at "^$") (forward-char -1) (delete-char 1))
	 (insert "\n")
	 (setq num (1+ num)))
       (setq fld (mew-input-folder fld))
       (mew-frwlet
	mew-cs-text-for-read mew-cs-text-for-write
	(write-region
	 (point-min) (point-max)
	 (mew-expand-folder fld (mew-folder-new-message fld 'num-only))
	 nil 'nomsg))
       (kill-buffer (current-buffer))
       (mew-touch-folder fld))
     (if (y-or-n-p (format "Join finish. Goto %s ? " fld))
	 (mew-summary-goto-folder nil fld)))))
-- おしまい --

## と、トリガをかければ、もっときれいな join が出てくるだろうと
## いう作戦 ^^;;;

-- 
白井秀行 (mailto:shirai at example.com)