;;;
;;; cmail-mime.el --- mime-MUA for cmail
;;;
;;; Author:    Hiroki Tukahara <asuka@ba2.so-net.or.jp>
;;;            MORIOKA Tomohiko <morioka@jaist.ac.jp>
;;;            Shuhei KOBAYASHI <shuhei-k@jaist.ac.jp>
;;; Modified:  maeda shugo <shugo@po.aianet.ne.jp>
;;;            Kazuhiro Ohta <ohta@ele.cst.nihon-u.ac.jp>
;;;            Toshihiko Ueki <toshi@he.kobelcosys.co.jp>
;;;
;;; Code:

;;; @ require modules
;;;
(eval-and-compile
  (cond ((featurep 'semi-setup)
	 (require 'mime-view)
	 (require 'mime-edit))
	((featurep 'tm-setup)
	 (require 'tm-view)
	 (require 'tm-edit))))

;(require 'cmail)

;;; @ aliases for the compatibility
;;;

(if (featurep 'semi-setup)
    (defalias-maybe 'eword-decode-header 'mime-decode-header-in-buffer)
  (defalias 'mime-view-mode 'mime/viewer-mode)
  (defalias 'turn-on-mime-edit 'mime/editor-mode)
  (defalias 'eword-decode-region 'mime-eword/decode-region)
  (defalias 'eword-decode-header 'mime/decode-message-header)
  (defalias 'mime-edit-insert-message 'mime-editor/insert-message))

;;; @ variables
;;;

(defvar cmail-mime-automatic-preview t
  "*Non-nil ならば、automatic MIME preview をする.")
(defvar cmail-mime-decode-message-header cmail-mime-decode
  "*Non-nil ならば、非 automatic MIME preview 時にもヘッダの decode をする.")

(defvar cmail-mime-view-message nil)

(setq cmail-content-filter-function 'cmail-mime-content-filter)

;;; @ automatic MIME preview
;;;

(defun cmail-mime-toggle-automatic-preview (arg)
  (interactive "P")
  (setq cmail-mime-automatic-preview
        (or arg (not cmail-mime-automatic-preview)))
  (cmail-show-contents (cmail-get-page-number-from-summary)))

(defun cmail-mime-content-filter ()
  (if (or cmail-mime-view-message
          (and cmail-mime-automatic-preview
               (cmail-get-field-values "MIME-Version")))
      (progn
        ;; do automatic MIME preview.
	(save-window-excursion
	  (if (functionp 'mime-view-buffer)
	      (mime-view-buffer (current-buffer) *cmail-mail-buffer)
	    (mime-view-mode nil nil nil (current-buffer) *cmail-mail-buffer))
	  (goto-char (point-min))
	  (setq mode-name "Readmail MIME")
	  (make-local-variable 'truncate-partial-width-windows)
	  (setq truncate-partial-width-windows nil)
	  (use-local-map (copy-keymap (current-local-map)))
	  (local-set-key "s" 'cmail-go-summary)
	  (local-set-key "g" 'cmail-summary-get-newmail)
	  (local-set-key "w" 'widen)
	  (local-set-key "r" 'cmail-refer-article)
	  (local-set-key "\M-f" 'cmail-visit-folder)
	  (run-hooks 'cmail-show-contents-hook))
	(cmail-select-buffer *cmail-mail-buffer))
    ;; don't preview.
    (cmail-default-content-filter)
    (cmail-mime-decode-message-header)))

(defun cmail-mime-content-header-filter ()
  (goto-char (point-min))
  (setq *cmail-have-all-headers (or (and (boundp 'all-headers) all-headers)
				    *cmail-show-all-headers))
  (or *cmail-have-all-headers (cmail-ignore-headers))
  (if (featurep 'tm-setup)
      (decode-mime-charset-region (point-min) (point-max)
				  default-mime-charset))
  (eword-decode-header))

(defun cmail-mime-header-presentation-method (entity situation)
  (if (functionp 'mime-insert-header)
      (progn
	(setq *cmail-have-all-headers
	      (or (and (boundp 'all-headers) all-headers)
		  *cmail-show-all-headers))
	(if *cmail-have-all-headers
	    (mime-insert-header entity)
	  (mime-insert-header entity
			      (list cmail-ignored-headers)
			      (list cmail-always-shown-headers))
	  ))
    (cmail-insert-buffer-substring (mime-entity-buffer entity)
				   (mime-entity-header-start entity)
				   (mime-entity-header-end entity))
    (cmail-mime-content-header-filter)))

(cond ((featurep 'semi-setup)
       (set-alist 'mime-view-content-header-filter-alist
		  'cmail-folder-mode
		  (function cmail-mime-content-header-filter))
       (set-alist 'mime-header-presentation-method-alist
		  'cmail-folder-mode
		  (function cmail-mime-header-presentation-method))
       (set-alist 'mime-text-decoder-alist
		  'cmail-folder-mode
		  (function mime-text-decode-buffer))
       (set-alist 'mime-raw-representation-type-alist 
		  'cmail-folder-mode 'binary))
      ((featurep 'tm-setup)
       (set-alist 'mime-viewer/content-header-filter-alist
		  'cmail-folder-mode
		  (function cmail-mime-content-header-filter))
       (set-alist 'mime-viewer/code-converter-alist
		  'cmail-folder-mode
		  (function mime-charset/decode-buffer))))

;;; @ MIME body players
;;;

(defun cmail-mime-view-message ()
  "MIME decode and play this message."
  (interactive)
  (let ((cmail-mime-view-message t))
    (cmail-show-contents (cmail-get-page-number-from-summary)))
  (pop-to-buffer *cmail-mail-buffer))

(defun cmail-mime-quit-view-message ()
  "Quit MIME-viewer and go back to **cmail-summary**.
This function is called by `mime-view-quit' (when using SEMI)
or `mime-viewer/quit' (when using TM) command via
`mime-view-quitting-method-alist' (when using SEMI) or
`mime-viewer/quitting-method-alist' (when using TM)."
  (setq cmail-mime-view-message nil)
  (cmail-go-summary)
  (if (null cmail-always-display-folders)
      (delete-other-windows))
  (cmail-show-contents (cmail-get-page-number-from-summary)))

(if (featurep 'semi-setup)
	(progn
    (set-alist 'mime-preview-quitting-method-alist
	       'cmail-folder-mode
	       'cmail-mime-quit-view-message)
	(set-alist 'mime-preview-following-method-alist
	       'cmail-folder-mode
		   '(lambda (buffer)
			  (set-buffer buffer)
			  (cmail-mail-compose nil nil nil '(16)))))
  (set-alist 'mime-viewer/quitting-method-alist
	     'cmail-folder-mode
	     'cmail-mime-quit-view-message)
  (set-alist 'mime-viewer/following-method-alist
			 'cmail-folder-mode
			 '(lambda (buffer)
				(set-buffer buffer)
				(cmail-mail-compose nil nil nil '(16)))))

;;; @ MIME header decoder
;;;

(defun cmail-mime-toggle-header-decoder (arg)
  "Toggle MIME header processing."
  (interactive "P")
  (setq cmail-mime-decode-message-header
        (or arg (not cmail-mime-decode-message-header)))
  (cmail-show-contents (cmail-get-page-number-from-summary)))

(defun cmail-mime-decode-message-header ()
  (let ((buffer-read-only nil))
    (if cmail-mime-decode-message-header
	(eword-decode-header))
    (set-buffer-modified-p nil)))

;;; @ mail inserter
;;;

(defun cmail-mime-insert-message (&optional message)
  (if (= *cmail-current-page 0)
      (error "no mail selected.")
    (let ((beg (1- (point))))
      (cmail-insert-message *cmail-current-page)
      (invisible-region beg (point-max)))))

(if (featurep 'tm-setup)
	nil
  (set-alist 'mime-edit-message-inserter-alist
	     'cmail-mail-mode
	     (function cmail-mime-insert-message))
  (set-alist 'mime-edit-mail-inserter-alist
	     'cmail-mail-mode
	     (function cmail-mime-insert-message)))

(defun cmail-mime-insert-forward-message ()
  (mime-edit-insert-message))

;; outgoing mail setup
(defun cmail-mime-mail-setup ()
  "reply/forward copied-in header needs to be decoded at the time of
mail budffer setup. This function will be called from mail setup
hook."
  (if *cmail-mime-mail-setup-decode-header-p
      (eword-decode-header t mail-header-separator))
  ;; cursor position hack when no address is set for To: field.  It
  ;; seems that eword-decode-header changes marker position, so
  ;; neither marker nor save-excursion works to restore cursor
  ;; position.  Here just look at space at end of the line, assumes it
  ;; is at To: header so just advance cursor position by one charctor.
  (if (looking-at " $") (forward-char 1)))

;;; @ set up
;;;

(if (featurep 'tm-setup)
	(progn
    (add-hook 'cmail-mail-hook
	      (lambda ()
		(or mime/editor-mode-flag
		    (turn-on-mime-edit))
		(eword-decode-header)))
	(defadvice cmail-mail (around mime-edit-cmail-mode activate)
	  (put 'mime/editor-mode-flag 'permanent-local (ad-get-arg 6))
	  ad-do-it))
  (add-hook 'cmail-mail-hook
	    (lambda ()
	      (or mime-edit-mode-flag
		  (turn-on-mime-edit))))
  (defadvice cmail-mail (around mime-edit-cmail-mode activate)
	(put 'mime-edit-mode-flag 'permanent-local (ad-get-arg 6))
	ad-do-it)
  (call-after-loaded
   'mail-mime-setup
   (lambda ()
     (add-hook 'mail-setup-hook 'cmail-mime-mail-setup)
     (delq 'eword-decode-header mail-setup-hook))))

(add-hook 'cmail-get-headers-hook
	  (function eword-decode-header))

(let ((map cmail-summary-mode-map))
  (define-key map "\C-ct"    'cmail-mime-toggle-header-decoder)
  (define-key map "\C-c\C-t" 'cmail-mime-toggle-automatic-preview)
  (define-key map "!"        'cmail-mime-view-message))

;;; @ for tm-edit
;;;

(cond ((featurep 'semi-setup)
       (setq mime-edit-split-message-sender-alist
	     (cons (cons 'cmail-mail-mode
			 (cdr (assoc 'mail-mode
				     mime-edit-split-message-sender-alist)))
		   mime-edit-split-message-sender-alist))
       (setq mime-setup-signature-key-alist
	     (cons (cons 'cmail-mail-mode
			 (cdr (assoc 'mail-mode
				     mime-setup-signature-key-alist)))
		   mime-setup-signature-key-alist)))
      ((featurep 'tm-setup)
       (call-after-loaded
	'tm-edit
	(function
	 (lambda ()
	   (set-alist 'mime-editor/split-message-sender-alist
		      'cmail-mail-mode (function
					(lambda ()
					  (interactive)
					  (funcall send-mail-function))))
	   (set-alist 'mime-setup-signature-key-alist
		      'cmail-mail-mode "\C-c\C-w")
	   (set-alist 'mime-editor/message-inserter-alist
		      'cmail-mail-mode (function cmail-mime-insert-message))
	   (set-alist 'mime-editor/mail-inserter-alist
		      'cmail-mail-mode (function cmail-mime-insert-message))
	   (set-alist 'mime-editor/message-default-sender-alist
		      'cmail-mail-mode (function cmail-send-and-exit)))))))

;; send/burst message digest
;; (requires lunatic version of flim)
(eval-when-compile '(require 'static))
(require 'path-util)
(static-if (not (module-installed-p 'mmbuffer))
    (defun cmail-mime-burst-internal (page folder)
      "cmail-mime-burst-internal needs lunaitc version of flim."
      (if (null page) 0))
  (require 'mmbuffer)
  (require 'mime)
  (defun cmail-mime-burst-internal (page folder)
    "If page is nil, it is called within \`cmail-burst-internal\', and
retuns a number of bursted mime part."
    (when page
      (cmail-get-folder)
      (cmail-n-page page))
    (let* ((entity (apply 'luna-make-entity
			  'mime-buffer-entity
			  (`(:location
			     (,(current-buffer))
			     (,@(if page
				    (list :header-start (point)
					  :body-end (cmail-page-max))))))))
	   (children (mime-entity-children entity))
	   (num 0)
	   content-type)
      (save-excursion
	(dolist (entity children)
	  (setq content-type (mime-entity-content-type-internal entity))
	  (when (and (eq (mime-content-type-primary-type content-type)
			 'message)
		     (eq (mime-content-type-subtype content-type)
			 'rfc822))
	    (set-buffer (get-buffer-create *cmail-arrived-mail-buffer))
	    (widen)
	    (erase-buffer)
	    (mime-insert-entity-body entity)
	    (insert *cmail-borderline)
	    (cmail-append-mail-to-folder (current-buffer) folder)
	    (setq num (1+ num)))))
      (if (null page) num
	(set-buffer *cmail-summary-buffer)
	(and cmail-delete-after-bursting
	     (null (cmail-virtual-folder-p folder))
	     (save-excursion
	       (cmail-get-folder)
	       (setq *cmail-deleted t))
	     (cmail-put-mark page "D" "D")))))
  ); static-if

(eval-when-compile '(require 'cl))
(defun cmail-send-mime-digest-internal (msgs mbuf)
  ;; mark されていない時はフォルダ全体
  (if msgs
      (progn
	(set-buffer mbuf)
	(dolist (*cmail-current-page msgs)
	  (cmail-mime-insert-forward-message)))
    (let (*cmail-current-page)
      (set-buffer *cmail-summary-buffer)
      (goto-char (point-min))
      (while (not (eobp))
	(setq *cmail-current-page (cmail-get-page-number-from-summary))
	(with-current-buffer mbuf
	  (cmail-mime-insert-forward-message))
	(forward-line)))))

(provide 'cmail-mime)

;;; cmail-mime.el ends here.
