;;; 
;;; tm-partial.el
;;; 
;;; Grabbing all MIME "message/partial"s.
;;; by Yasuo OKABE @ Kyoto University 1994
;;; modified by MORIOKA Tomohiko
;;;         and Shuhei KOBAYASHI <shuhei@cmpt01.phys.tohoku.ac.jp>

;; original file is 
;;  gif.el written by Art Mellor @ Cayman Systems, Inc. 1991

;;; $Id: tm-partial.el,v 3.1 1995/03/26 17:13:20 morioka Exp $

(require 'tm-view)

;; This regular expression controls what types of subject lines can be
;; parsed. Currently handles lines like:
;;	foo [1/3]
;;	foo (1/3)
;;	foo 1/3
;;	foo [1 of 3]
;;	foo (1 of 3)
;;	foo 1 of 3
;;	foo1 of 3

(defvar mime/gp:subject-start-regexp "[ \t]*\\(v[0-9]+i[0-9]+:[ \t]+\\)?")

(defvar mime/gp:subject-end-regexp
  "\\([[(]?\\)\\([0-9]+\\)\\(/\\| [oO][fF] \\)\\([0-9]+\\)\\([])]?\\)[ \t]*$")

;; display Article at the cursor in Subject buffer.
(defun mime/gp:display-article ()
  (save-excursion   
    (cond
     ((eq target 'gnus4)
      (gnus-summary-display-article (gnus-summary-article-number))
      )
     ((eq target 'mh-e)
      (mh-show)
      )
     ((eq target 'vm)
      (let ((vm-follow-summary-cursor t))
        (vm-follow-summary-cursor)
        (vm-select-folder-buffer)
        (vm-check-for-killed-summary)
        (vm-error-if-folder-empty)
        (vm-display (current-buffer) t '(tm-vm/view-message)
                    '(tm-vm/view-mesage reading-message))
        (vm-widen-page)
        (goto-char (point-max))
        (widen)
        (narrow-to-region (point) (vm-start-of (car vm-message-pointer)))
        (goto-char (point-min))
	))
     (t (error "Fatal. Unsupported mode")))))

(defun mime/decode-message/grab-partials (beg end cal)
  (interactive)
  (let* ((id (cdr (assoc "id" cal)))
	 (number (cdr (assoc "number" cal)))
	 (total (cdr (assoc "total" cal)))
	 (buffer (generate-new-buffer id))
	 (mother mime::article/preview-buffer)
	 target
	 subject-buf
	 (article-buf (buffer-name (current-buffer)))
	 (subject-id nil)
	 (part-num 1)
	 (part-missing nil))
    (cond ((eq major-mode 'gnus-article-mode)
	   (setq subject-buf gnus-summary-buffer)
	   (setq target 'gnus4)
	   )
	  ((eq major-mode 'mh-show-mode)
	   (string-match "^show-\\(.+\\)$" article-buf)
	   (setq subject-buf
		 (substring article-buf (match-beginning 1) (match-end 1)))
	   (setq target 'mh-e)
	   )
          ((eq major-mode 'vm-mode)
           (setq subject-buf vm-summary-buffer)
           (setq target 'vm)
	   )
          (t (error "%s is not supported. Sorry." major-mode)))
    
    (if (and (eq beg (point-min)) (eq end (point-max)))
	(save-excursion
	  (goto-char (point-min))
	  (re-search-forward "^$")
	  (let ((delim (match-beginning 0)))
	    (goto-char (point-min))
	    (if (re-search-forward "^[Ss]ubject:.*$" delim t)
		(let ((tail (match-end 0)))
		  (beginning-of-line)
		  (re-search-forward (concat "^[Ss]ubject:" mime/gp:subject-start-regexp) tail t)
		  (let ((start (point)))
		    (if (and (re-search-forward mime/gp:subject-end-regexp tail t)
			     (eq (string-to-int number)
				 (string-to-int (buffer-substring (match-beginning 2) (match-end 2))))
			     (eq (string-to-int total)
				 (string-to-int (buffer-substring (match-beginning 4) (match-end 4)))))
			(setq subject-id (buffer-substring start (match-end 1)))
		      (setq part-missing (string-to-int number)))))
	      (setq part-missing t))))
      (setq part-missing t))

    ;; if you can't parse the subject line, try simple decoding method
    (if (or part-missing
	    (not (y-or-n-p "Merge partials?")))
	(progn
	  (kill-buffer buffer)
	  (mime/decode-message/partial-region beg end cal))
      (progn 
	(set-buffer subject-buf)
	(setq part-missing (mime/gp:part-missing-p subject-id (string-to-int total)))
	(if part-missing
	    (progn
	      (kill-buffer buffer)
	      (error "Couldn't find part %d" part-missing)))
	(save-excursion
	  (while (<= part-num (string-to-int total))
	    (goto-char (point-min))
	    (message "Grabbing part %d of %d" part-num (string-to-int total))
	    (re-search-forward
		      (concat (regexp-quote subject-id) "0*"
			      (int-to-string part-num)) nil t)
	    (mime/gp:display-article)
	    (save-excursion
	      (set-buffer article-buf)
	      (goto-char (point-min))
	      (re-search-forward "^$")
	      (let ((delimit (point)))
		(goto-char (point-min))
		(if (not
		     (and
		      (re-search-forward
		       "^[Cc]ontent-[Tt]ype:[ \t]*message/partial;" delimit t)
		      (re-search-forward
		       (concat "[ \t]+id=[ \t]*\""
                               (regexp-quote id) "\";") delimit)
		      (re-search-forward
		       (concat "[ \t]+number=[ \t]*"
                               (int-to-string part-num) ";") delimit)))
		    (progn
		      (kill-buffer buffer)
		      (error "Couldn't find part %d" part-num)))
		(append-to-buffer buffer (+ delimit 1) (point-max))))
	    (setq part-num (+ part-num 1))))
	(mime/gp:display-article)
	(save-excursion
	  (set-buffer article-buf)
	  ;; (make-variable-buffer-local 'mime/content-list)
	  ;; (setq mime/content-list (mime/parse-contents))
	  (make-variable-buffer-local 'mime::article/content-info)
	  (setq mime::article/content-info (mime-viewer/parse))
  	  )
	(delete-other-windows)
	(switch-to-buffer buffer)
	(goto-char (point-min))
	(setq major-mode 'mime/show-message-mode)
	(mime/viewer-mode mother)
	(pop-to-buffer (current-buffer))
	))))

;; Check if all the parts are there
(defun mime/gp:part-missing-p (subject-string num-parts)
  (save-excursion
    (let ((part-num 1)
	  (cant-find nil))

      (while (and (<= part-num num-parts) (not cant-find))
	(goto-char (point-min))
	;; If the parts are numbered 01/10, then chop off the leading 0
	(if (not (re-search-forward
		  (concat (regexp-quote subject-id) "0*" 
			  (int-to-string part-num))
		  nil t))
	    (setq cant-find part-num)
	  (progn
	    (message "Found part %d of %d." part-num num-parts)
	    (setq part-num (+ part-num 1)))))
      cant-find)))


;;; @ set up
;;;

(set-atype 'mime/content-decoding-condition
	   '((type . "message/partial")
	     (method . mime/decode-message/grab-partials)
	     (major-mode . gnus-article-mode)
	     ))

(set-atype 'mime/content-decoding-condition
	   '((type . "message/partial")
	     (method . mime/decode-message/grab-partials)
	     (major-mode . mh-show-mode)
	     ))

(set-atype 'mime/content-decoding-condition
	   '((type . "message/partial")
	     (method . mime/decode-message/grab-partials)
	     (major-mode . vm-mode)
 	     ))

(provide 'tm-partial)