;;; mew-draft.el --- Draft mode for Mew

;; Author:  Kazu Yamamoto <Kazu@Mew.org>
;; Created: Oct  2, 1996
;; Revised: Oct 25, 1997

;;; Code:

(defconst mew-draft-version "mew-draft.el version 0.30")

(require 'mew)
(if mew-xemacs-p (require 'easymenu))

(defvar mew-draft-mode-map   nil)
(defvar mew-draft-header-map nil)
(defvar mew-draft-body-map   nil)

(defvar mew-draft-mode-syntax-table nil
  "*Syntax table used while in mew letter mode.")

(if mew-draft-mode-syntax-table
    ()
  (setq mew-draft-mode-syntax-table (make-syntax-table text-mode-syntax-table))
  (modify-syntax-entry ?% "." mew-draft-mode-syntax-table)
  )

(defvar mew-draft-mode-toolbar-menu
  '("Attachment Commands"
    ["Insert a File by Linking"
     mew-attach-link
     (mew-attach-not-line012-1)]
    ["Insert a File by Copying"
     mew-attach-copy
     (mew-attach-not-line012-1)]
    ["Insert Audio"
     mew-attach-audio
     (mew-attach-not-line012-1)]
    ["Insert an External Reference"
     mew-attach-external-body
     (mew-attach-not-line012-1)]
    ["Insert a Sub-Multipart"
     mew-attach-multipart
     (mew-attach-not-line012-1)] 
    ["Read a New File into a Buffer"
     mew-attach-find-mew-file
     (mew-attach-not-line012-1)]
    ["Insert PGP public keys"
     mew-attach-pgp-public-key
     (mew-attach-not-line012-1)]
    "----"
    ["Delete This Part"
     mew-attach-delete 
     (mew-attach-not-line012-1-dot)]
    "----"
    ["Describe This Part"
     mew-attach-description
     (mew-attach-not-line0-1-dot)]
    ["Specify A File Name"
     mew-attach-disposition
     (mew-attach-not-line012-1-dot)]
    ["Change the Type"
     mew-attach-type
     (mew-attach-not-line0-1-dot)]
    ["Encode with Gzip64"
     mew-attach-gzip64
     (mew-attach-not-line0-1-dot)]
    ["Encode with Base64"
     mew-attach-base64
     (mew-attach-not-line0-1-dot)]	 
    ["Encode with Quoted-Printable"
     mew-attach-quoted-printable
     (mew-attach-not-line0-1-dot)]
    ["Sign with PGP"
     mew-attach-pgp-sign
     (mew-attach-not-line0-1-dot)]
    ["Encrypt with PGP"
     mew-attach-pgp-enc 
     (mew-attach-not-line0-1-dot)]
    "----"
    ["Undo Encoding"
     mew-attach-undo
     (mew-attach-not-line0-1-dot)]
    "----"
    ["Read This File into a Buffer"
     mew-attach-find-file
     (mew-attach-not-line012-1-dot)]
    )
  )

(defvar mew-draft-mode-menu-spec
  (list
   "Mew/draft"
   ["Cite" mew-draft-cite t]
   ["Cite without Label"  mew-draft-yank t]
   ["Insert Config:"	  mew-draft-insert-config t]
   mew-draft-mode-toolbar-menu
   ["Make MIME Message"   mew-draft-make-message        t]
   ["Send Message"        mew-draft-send-letter         t]
   ["Prepare Attachments" mew-draft-prepare-attachments t]
   ["Insert Signature"    mew-draft-insert-signature    t]
   ["Kill Draft"          mew-draft-kill                t]
   "----"
   '("PGP"
     ["PGP Sign"              mew-pgp-sign-letter         (not (mew-attach-p))]
     ["PGP Encrypt"           mew-pgp-encrypt-letter      (not (mew-attach-p))]
     ["PGP Sign then Encrypt" mew-pgp-sign-encrypt-letter (not (mew-attach-p))]
     )
   '("FIB"
     ["FIB next item"     mew-fib-next-item     (not (mew-attach-p))]
     ["FIB previous item" mew-fib-previous-item (not (mew-attach-p))]
     ["FIB flush input"   mew-fib-flush-input   (not (mew-attach-p))]
     ["FIB fill default"  mew-fib-fill-default  (not (mew-attach-p))]
     ["FIB delete frame"  mew-fib-delete-frame  (not (mew-attach-p))]
     )
    )
  )

(if mew-draft-mode-map
    ()
  (setq mew-draft-mode-map (make-sparse-keymap))
  (let ((begin ?\40) (end ?\177))
    (while (<= begin end)
      (define-key mew-draft-mode-map 
	(char-to-string begin) 'mew-draft-keyswitch)
      (setq begin (1+ begin))))
  (define-key mew-draft-mode-map "\C-n"     'mew-draft-keyswitch)
  (define-key mew-draft-mode-map "\C-p"     'mew-draft-keyswitch)
  (define-key mew-draft-mode-map "\C-f"     'mew-draft-keyswitch)
  (define-key mew-draft-mode-map "\C-b"     'mew-draft-keyswitch)
;  (define-key mew-draft-mode-map "\C-l"     'mew-draft-keyswitch)
  (define-key mew-draft-mode-map "\t"       'mew-draft-keyswitch)
  (define-key mew-draft-mode-map "\C-c\t"   'mew-draft-keyswitch)
  (define-key mew-draft-mode-map "\C-d"     'mew-draft-keyswitch)
  (define-key mew-draft-mode-map "\C-o"     'mew-draft-keyswitch)
  (define-key mew-draft-mode-map "\C-q"     'mew-draft-keyswitch)
  (define-key mew-draft-mode-map "\C-t"     'mew-draft-keyswitch)
  (define-key mew-draft-mode-map "\C-w"     'mew-draft-keyswitch)
  (define-key mew-draft-mode-map "\C-k"     'mew-draft-keyswitch)
  (define-key mew-draft-mode-map "\r"       'mew-draft-keyswitch)
  (define-key mew-draft-mode-map "\n"       'mew-draft-keyswitch)
  (define-key mew-draft-mode-map "\C-y"     'mew-draft-keyswitch)
  (define-key mew-draft-mode-map "\C-c\C-d" 'mew-draft-keyswitch) ;; xxx
  (define-key mew-draft-mode-map "\C-c\C-r" 'mew-draft-keyswitch) ;; xxx
  (define-key mew-draft-mode-map "\C-c\C-y" 'mew-draft-cite)
  (define-key mew-draft-mode-map "\C-c\C-t" 'mew-draft-yank)
  (define-key mew-draft-mode-map "\C-c\C-w" 'mew-draft-check-whom)
  (define-key mew-draft-mode-map "\C-c\C-m" 'mew-draft-make-message)
  (define-key mew-draft-mode-map "\C-c\C-u" 'mew-draft-undo)
  (define-key mew-draft-mode-map "\C-c\C-c" 'mew-draft-send-letter)
  (define-key mew-draft-mode-map "\C-c\C-s" 'mew-pgp-sign-letter)
  (define-key mew-draft-mode-map "\C-c\C-e" 'mew-pgp-encrypt-letter)
  (define-key mew-draft-mode-map "\C-c\C-b" 'mew-pgp-sign-encrypt-letter)
  (define-key mew-draft-mode-map "\C-c\C-q" 'mew-draft-kill)
  (define-key mew-draft-mode-map "\C-c\C-a" 'mew-draft-prepare-attachments)
  (define-key mew-draft-mode-map "\C-c\C-n" 'mew-fib-next-item)
  (define-key mew-draft-mode-map "\C-c\C-p" 'mew-fib-previous-item)
  (define-key mew-draft-mode-map "\C-c\C-l" 'mew-fib-flush-input)
  (define-key mew-draft-mode-map "\C-c\C-f" 'mew-fib-fill-default)
  (define-key mew-draft-mode-map "\C-c\C-k" 'mew-fib-delete-frame)
  (define-key mew-draft-mode-map "\C-c\C-o" 'mew-draft-insert-config)
  (define-key mew-draft-mode-map "\C-x\C-s" 'mew-save-buffer)
  (if mew-temacs-p
      (easy-menu-define
       mew-draft-mode-menu
       mew-draft-mode-map
       "Menu used in Draft mode."
       mew-draft-mode-menu-spec))
  )

(if mew-draft-header-map
    ()
  (setq mew-draft-header-map (make-sparse-keymap))
  (define-key mew-draft-header-map "\t"       'mew-draft-header-comp)
  (define-key mew-draft-header-map "\C-c\t"   'mew-draft-circular-comp)
  (define-key mew-draft-header-map "\C-c\C-d" 'mew-refile-delete-alias)
  (define-key mew-draft-header-map "\C-c\C-r" 'mew-refile-add-alias)
  (define-key mew-draft-header-map "\C-l"     'mew-draft-rehighlight)
  (if mew-use-bbdb
      (define-key mew-draft-header-map "\e\t" 'bbdb-complete-name))
  )

(if mew-draft-body-map
    ()
  (setq mew-draft-body-map (make-sparse-keymap))
  (define-key mew-draft-body-map "\t"     'tab-to-tab-stop)
  (define-key mew-draft-body-map "\C-c\t" 'mew-draft-insert-signature)
  (define-key mew-draft-body-map "\C-l"   'mew-draft-rehighlight)
  )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Draft mode
;;;

(defun mew-draft-mode ()
  "Major mode for composing a MIME message.
Key actions are different in each region: Header, Body, and Attachment.

To send a draft, type C-cC-m and C-cC-c.  To make multipart, type
C-cC-a, edit attachments, and type C-cC-m and C-cC-c.

*Whole buffer key assignment:

C-cC-y	Copy and paste a part of message from Message mode WITH
	citation prefix and label.
	1. Roughly speaking, it copies the body in Message mode. 
	   For example, if text/plain is displayed, the entire Message 
	   mode is copied. If message/rfc822 is displayed, the body 
	   without the header is copied.
	2. If called with 'C-u', the header is also copied if exists.
	3. If an Emacs mark exists, the target is the region between 
	   the mark and the cursor.
C-cC-t	Copy and paste a part of message from Message mode WITHOUT
	citation prefix and label.

C-cC-o	Insert the Config: field with 'mew-config-guess-alist'
	in the header.

C-cC-m	Make a MIME message. Charset guess, mapping directory structure 
	to multipart, and so on.
C-cC-c	Send this message. If you skipped 'C-cC-m', Content-Type: is added
	to header and you are asked, \"Content-Type: was automatically 
	added. Send this message? \". Type y or n. Mew sends the message 
	in background. So, when you exit Emacs, you may be asked, 
	\"Active processes exist; kill them and exit anyway? (yes or no)\".
	In this case, check if *mew watch* buffer exist. If so, never 
	exit Emacs because Mew is still sending the message.

C-uC-cC-c
	Send this message without killing the draft. This is convenient 
	to send messages to multiple people modifying

C-cC-a	Prepare an attachment region in the bottom of the draft.
	To compose a multipart message, you should execute this 
	command first.

C-cC-w	Display expanded address aliases in other window.

C-cC-u	Undo 'C-cC-m'.
C-cC-q	Kill this draft.

C-cC-s	Sign the single part draft with PGP. Input your passphrase.
C-cC-e	Encrypt the single part draft with PGP.
C-cC-b	Sign then encrypt the single part draft with PGP.
	Input your passphrase.

*Header region key assignment:

TAB	Complete field keys.
	Complete and expand email address aliases.
	Complete folder names.
C-cTAB	Complete your mail domain.


*Body region key assignment:

C-cTAB	Insert \"~/.signature\" on the cursor point.


*Attachments region Key assignment:

C-p	Go to the previous file in the current directory.
C-n	Go to the next file in the current directory.
C-f	Go to the first subdirectory.
C-b	Go to the parent directory.

c	Copy a file (via networks) on \".\".
	To copy a remote file, use the \"/[user@]hostname:/filepath\" syntax.
l	Link a file with a symbolic link on \".\".
d	Delete this file or this directory.
m	Create a subdirectory(i.e. multipart) on \".\".
f	Open this file into a buffer.
F	Open a new file into a buffer on \".\".
e	Input external-body on \".\".
a	Sampling voice and insert as audio file on \".\".
p	Extract the PGP key for the inputed user on \".\".
D	Input a description(Content-Description:).
P	Change the file name(Content-Disposition:).
T	Change the data type(Content-Type:).
C	Specify charset for a Text/* object.

B	Put the 'B' mark to encode with Base64.
Q	Put the 'Q' mark to encode with Quoted-Printable.
G	Put the 'G' mark to encode with Gzip64. This is applicable 
	only to Text/Plain and Application/Postscript since compression 
	is not effective other objects. For example, JPEG is already 
	compressed.
S	Put the 'PS' mark to sign with PGP.
E	Put the 'PE' mark to encrypt with PGP. 
	Input decryptors' addresses.
U	Unmark. The original mark appears.

* Fill blanks

Prepare ~/.mew-fib like;

	name:  Kazuhiko Yamamoto
	email: Kazu@Mew.org

If you receive a message like;

	Your name : |>name<|
	Your e-mail address: |>email<|

Type a (in Summary mode), C-cC-t, C-cC-f, and C-cC-k makes following
draft.

	Your name : Kazuhiko Yamamoto
	Your e-mail address: Kazu@Mew.org

In this way, mew-fil fills up items quoted like |> <| from .mew-fib.

C-cC-f	Fill |>item<| from .mew-fib.
C-cC-k	Delete all quotations, i.e. |> <|.
C-cC-n	Jump to the next fib item.
C-cC-p	Jump to the previous fib item.
C-cC-l	Flush input from .mew-fib.

Moreover, mew-fib supports aliases like;

	email: Kazu@Mew.org
	e-mail:

"
  (interactive)
  (make-local-variable 'paragraph-start)
  (setq paragraph-start (concat "^[ \t]*[-_][-_][-_]+$\\|" paragraph-start))
  (make-local-variable 'paragraph-separate)
  (setq paragraph-separate
        (concat "^[ \t]*[-_][-_][-_]+$\\|" paragraph-separate))
  (setq major-mode 'mew-draft-mode)
  (setq mode-name "Draft")
  (setq mode-line-buffer-identification mew-mode-line-id)
  (use-local-map mew-draft-mode-map)
  (set-syntax-table mew-draft-mode-syntax-table)
  (cd (expand-file-name mew-home))
  (run-hooks 'text-mode-hook 'mew-draft-mode-hook)
  (if mew-xemacs-p
      (progn
	(set-buffer-menubar current-menubar)
	(add-submenu nil mew-draft-mode-menu-spec)
	))
  (if mew-icon-p
      (set-specifier default-toolbar
		     (cons (current-buffer) mew-draft-toolbar)))
  (if (and auto-fill-function mew-temacs-p)
      (progn
	(make-local-variable 'auto-fill-function)
	(setq auto-fill-function (function mew-draft-auto-fill))
	))
  (mew-highlight-header-region
   (point-min) (marker-position mew-draft-buffer-header))
  )

(defun mew-draft-auto-fill ()
  (do-auto-fill)
  (if (mew-draft-in-header-p)
      (save-excursion
	(beginning-of-line)
	(if (not (looking-at "[^ \t]+:\\|[ \t]"))
	    (insert "\t"))
	)))

(defun mew-draft-rename (file)
  (if (string-match
       (format "^%s\\(.*\\)$" (file-name-as-directory mew-mail-path))
       file)
      (rename-buffer (concat "+" (mew-match 1 file)))
    ))

;; +draft/1 -> +draft/mime/1
;; This function is hard coding due to mew-draft-mime-folder, sigh...
(defun mew-draft-to-mime (draft)
  (concat (file-name-as-directory mew-draft-mime-folder)
	  (file-name-nondirectory draft))
  )

(defmacro mew-to-cc-magic ()
  (` (or (catch (quote match)
	   (car (mapcar 
		 (lambda (arg) (and (string-match arg c)
				    (throw (quote match) t)))
		 del)))
	 (string-match ":;" c))))

(defun mew-draft-header (&optional subject nl to cc newsgroups in-reply-to references)
;; to -- string or list
;; cc -- string or list
;; nl -- one empty line under "----", which is necessary if
;;      multipart region is prepared
  (let ((del (cons (concat "^" (regexp-quote (user-login-name)) "$")
		   (cons (concat "^" mew-mail-address "$")
			 mew-mail-address-list)))
	;; deleting list for Cc:
	(c nil)
	(cep nil)
	(tf to)) ;; to is used in last
    (goto-char (point-min))
    ;; Insert To: at first.
    ;; All addresses inserted on To: are appended to del.
    (cond
     ((null tf) (insert "To: \n"))
     ;; To: inputed from the mini-buffer.
     ((stringp tf)
      ;; Cc: is also string
      ;; We believe that user never specifies the same address of To: to Cc:
      ;; So, not add to to del.
      (mew-header-insert-here "To:" tf)) 
     ;; To: collected by reply
     ((listp tf)
      (insert (format "To: %s" (car tf)))
      (setq del (cons (concat "^" (regexp-quote (car tf)) "$") del))
      (while tf
	(setq c (car tf) tf (cdr tf))
	(if (mew-to-cc-magic)
	    ()
	  (insert (format ",\n\t%s" c))
	  (setq del (cons (concat "^" (regexp-quote c) "$") del))
	  ))
      (insert "\n"))
     )
    (cond
     ((null cc) ()) ; do nothing 
     ;; Cc: inputed from the mini-buffer.
     ((stringp cc)
      (mew-header-insert-here "Cc:" cc))
     ;; Cc: collected by reply.
     ((listp cc)
      ;; find the first Cc: value since this is preceding by Cc:
      (catch 'first
	(while cc
	  (setq c (car cc) cc (cdr cc))
	  (if (mew-to-cc-magic)
	      ()
	    (insert "Cc: ")
	    (insert c)
	    (setq del (cons (concat "^" (regexp-quote c) "$") del))
	    (setq cep t)
	    (throw 'first nil))
	  ))
      ;; insert the second or more Cc: preceding ",\n\t"
      (while cc
	(setq c (car cc) cc (cdr cc))
	(if (mew-to-cc-magic)
	    ()
	  (insert (format ",\n\t%s" c))
	  (setq del (cons (concat "^" (regexp-quote c) "$") del))
	  ))
	(if cep (insert "\n")))
     ))
  (and newsgroups (mew-header-insert-here "Newsgroups:" newsgroups))
  (and mew-cc   (mew-header-insert-here "Cc:" mew-cc))
  (mew-header-insert-here "Subject:" (if subject subject "")) ;; tricky
  (and mew-from (mew-header-insert-here "From:" mew-from))
  (and mew-fcc  (mew-header-insert-here "Fcc:" mew-fcc))
  (and mew-dcc  (mew-header-insert-here "Dcc:" mew-dcc))
  (and mew-reply-to (mew-header-insert-here "Reply-To:" mew-reply-to))
  ;; xxx date to in-reply-to ?
  (and in-reply-to (mew-header-insert-here 
		    "In-Reply-To:"
		    (if references
			(concat "Your message of \"" in-reply-to "\"\n\t" references)
		      (concat "Your message of \"" in-reply-to "\""))))
  (and references (mew-header-insert-here "References:" references))
  (if (and mew-x-face-file
	   (file-exists-p (expand-file-name mew-x-face-file)))
      (let ((xface))
	(save-excursion
	  (mew-set-buffer-tmp)
	  (insert-file-contents (expand-file-name mew-x-face-file))
	  (setq xface (mew-buffer-substring (point-min) (max (buffer-size) 1)))
	  )
	(mew-header-insert-here "X-Face:" xface)
	))
  (and mew-x-mailer (mew-header-insert-here "X-Mailer:" mew-x-mailer))
  (let ((halist mew-header-alist))
    (while halist
      (and (stringp (car (car halist))) (stringp (cdr (car halist)))
	   (mew-header-insert-here (car (car halist)) (cdr (car halist))))
      (setq halist (cdr halist)))
    )
  (mew-header-insert-here "Mime-Version:" mew-mv:-num)
  (if mew-config-insert-when-prepared
      (mew-draft-insert-config 'here))
  (insert mew-header-separator "\n")
  (mew-draft-refresh)
  (if nl 
      (save-excursion
	(re-search-forward mew-eoh2)
	(insert "\n")))
  (if to ;; there is no To:
      ()
    (goto-char (point-min))
    (end-of-line))
  )

(defun mew-draft-refresh ()
  "Refresh draft buffer"
  (interactive)
  (save-excursion
    (widen)
    (goto-char (point-min))
    (re-search-forward mew-eoh2)
    (beginning-of-line)
    (setq mew-draft-buffer-header (point-marker))
    )
  )

(defun mew-draft-send-letter (&optional arg)
  "Send this message. If you skipped 'C-cC-m', Content-Type: is added
to header and you are asked, \"Content-Type: was automatically 
added. Send this message? \". Type y or n. Mew sends the message 
in background. So, when you exit Emacs, you may be asked, 
\"Active processes exist; kill them and exit anyway? (yes or no)\".
In this case, check if *mew watch* buffer exist. If so, never 
exit Emacs because Mew is still sending the message."
  (interactive "P")
  (mew-draft-refresh)
  (if mew-ask-newsgroups
      (let ((existp nil))
	(save-restriction
	  (narrow-to-region (point-min)
			    (marker-position mew-draft-buffer-header))
	  (save-excursion
	    (goto-char (point-min))
	    (if (re-search-forward "^Newsgroups:" nil t)
		(setq existp t))
	    ))
	(if (and existp 
		 (not (y-or-n-p "Do you want to post to NetNews?")))
	    (mew-header-delete-lines '("Newsgroups:")))
	))
  (run-hooks 'mew-send-hook)
  (save-excursion
    (if (mew-header-get-value mew-ct:)
	(mew-draft-real-send-letter arg)
      (mew-draft-make-message)
      (condition-case nil
	  (if (or (not mew-ask-send)
		  (y-or-n-p (format "%s was automatically added. Send this message? " mew-ct:)))
	      (mew-draft-real-send-letter arg)
	    (mew-draft-undo))
	(quit
	 (mew-draft-undo)))
      )
    ))

(defun mew-draft-real-send-letter (&optional arg)
  (let* ((mimefolder (mew-draft-to-mime (buffer-name)))
	 (mimedir (mew-expand-folder mimefolder))
	 (msg (file-name-nondirectory (buffer-file-name)))
	 (process-connection-type mew-connection-type1)
	 delete keep)
    (set-buffer-modified-p t)		; Make sure buffer is written
    (mew-frwlet 
     mew-cs-noconv mew-cs-mime-trans
     (run-hooks 'mew-real-send-hook)
     (save-buffer)
     )
    (if arg
	;; leave the draft
	(setq keep "--preserve=on")
      (setq keep "--preserve=off")
      (kill-buffer (current-buffer))
      ;;
      (if (mew-current-get 'window)
	  (progn
	    (set-window-configuration (mew-current-get 'window))
	    (mew-current-set 'window nil))))
    (set-buffer (generate-new-buffer mew-buffer-watch))
    ;; watch buffer
    (setq mew-watch-buffer-process
	  (mew-im-start-process mew-prog-imput
				"Send"
				"-draftfolder" mew-draft-folder
				"-draftmessage" msg
				keep
				"-watch" "-verbose"))
    (mew-set-process-cs mew-watch-buffer-process
			mew-cs-noconv mew-cs-mime-trans)
    (set-process-sentinel mew-watch-buffer-process
			  'mew-watch-sentinel)
    (message "Sending a message in background")
    ;; keep +draft/mime/X alive if "C-u C-cC-c".
    (if (or arg (null (file-directory-p mimedir)))
	()
      (cond
       ((equal mew-mime-compose-folder-delete 'ask)
	(setq delete (y-or-n-p (format "%s exists. Remove it? " mimefolder))))
       ((equal mew-mime-compose-folder-delete 'delete)
	(setq delete t))
       ((equal mew-mime-compose-folder-delete 'retain)
	(setq delete nil))
       (t (setq delete (y-or-n-p (format "%s exists. Remove it? " mimefolder))))
       )
      (if (null delete )
	  (format "Folder %s remains" mimefolder)
	(mew-delete-directory-recursively mimedir))
      )
    ))

(defun mew-watch-sentinel (process event)
  (let ((cbuf (current-buffer)) (kbuf (process-buffer process)))
    (set-buffer kbuf)
    (goto-char (point-min))
    (if (null (re-search-forward (format "^%s: ERROR:" mew-prog-imput) nil t))
	(progn
	  (set-buffer cbuf)  ;; to avoid cursor-in-echo-area bug
	  (kill-buffer kbuf) ;; set-buffer before kill-buffer
	  )
      (ding)
      (message "Send failed")
      (beginning-of-line)
      (switch-to-buffer (process-buffer process))
      (local-set-key "\C-c\C-q" 'mew-kill-buffer)
      )
    ))

(defun mew-draft-yank (&optional arg)
  "Copy and paste a part of message from Message mode WITHOUT
citation prefix and label.
1. Roughly speaking, it copies the body in Message mode. For example,
   if text/plain is displayed, the entire Message mode is copied.
   If message/rfc822 is displayed, the body without the header is copied.
2. If called with 'C-u', the header is also copied if exists.
3. If an Emacs mark exists, the target is the region between the mark and 
   the cursor."
;; MUST take care of C-x C-x
;; MUST be able to cancel by C-x u
  (interactive "P")
  (if (or (mew-draft-in-header-p) (mew-draft-in-attach-p))
      (message "You cannot cite a message here.")
    (let (cite beg end)
      (save-excursion
	(set-buffer (mew-buffer-message))
	(save-restriction
	  (widen)
	  (cond
	   (arg 
	    (setq beg (point-min) end (point-max)))
	   ((mew-mark) 
	    (setq beg (region-beginning) end (region-end)))
	   ((equal mew-message-citation 'header)
	    ;; header exists in Message mode
	    (goto-char (point-min))
	    (re-search-forward mew-eoh2 nil t)
	    (forward-line)
	    (setq beg (point) end (point-max)))
	   (t
	    (setq beg (point-min) end (point-max)))
	   )
	  (setq cite (mew-buffer-substring beg end))
	  ))
      (push-mark (point) t t) ;; for C-x C-x
      (insert cite)
      )))

(defun mew-cite-strings-with-petname (lst mew-cite-fields)
  (let ((i 0)
	(l mew-cite-fields)
	(petname))
    (catch 'loop
      (while (car l)
	(if (string-equal "From:" (car l))
	    (throw 'loop i)
	  )
	(setq i (1+ i))
	(setq l (cdr l))
	)
      )
    (setq petname (cdr (mew-assoc-case-equal 
			(mew-header-extract-addr (nth i lst))
		  mew-petname-alist 0)))
    (if petname (setcar (nthcdr i lst) petname)))
  lst)

(defun mew-cite-strings ()
  (let ((fields (mapcar (function mew-header-get-value) mew-cite-fields)))
    (setq fields (mapcar (lambda (x) (or x "")) fields))
    (if mew-use-petname
	(setq fields (mew-cite-strings-with-petname fields mew-cite-fields))
      )
    (apply (function format) mew-cite-format fields)
    ))

(defun mew-draft-cite (&optional arg)
  "Copy and paste a part of message from Message mode WITH
citation prefix and label.
1. Roughly speaking, it copies the body in Message mode. For example,
   if text/plain is displayed, the entire Message mode is copied.
   If message/rfc822 is displayed, the body without the header is copied.
2. If called with 'C-u', the header is also copied if exists.
3. If an Emacs mark exists, the target is the region between the mark and 
   the cursor."
;; MUST take care of C-x C-x
;; MUST be able to cancel by C-x u
  (interactive "P")
  (if (or (mew-draft-in-header-p) (mew-draft-in-attach-p))
      (message "You cannot cite a message here.")
    (let ((nonmewbuf mew-message-citation-buffer) ;; buffer local, so copy here
	  cite beg end)
      (save-excursion
	;;
	;; extract the body without header
	;;
	(set-buffer (or nonmewbuf (mew-buffer-message)))
	(save-restriction
	  ;; first prepare "cite"
	  (widen)
	  (cond
	   ;; arg will be effect in mew-cite-original
	   ((mew-mark) 
	    (setq beg (region-beginning) end (region-end)))
	   ((equal mew-message-citation 'header)
	    ;; header exists in Message mode. Skip the header
	    ;; because we will concatenate it to cite later.
	    (goto-char (point-min))
	    (re-search-forward mew-eoh2 nil t)
	    (forward-line)
	    (setq beg (point) end (point-max)))
	   (t
	    (setq beg (point-min) end (point-max)))
	   )
	  (setq cite (mew-buffer-substring beg end))
	  )
	;;
	;; concat the header
	;;
	(set-buffer (or nonmewbuf
			;; header exists only in cache if multipart
			(mew-cache-hit (mew-current-get 'message))
			(mew-buffer-message)))
	(save-restriction
	  (widen)
	  (goto-char (point-min))
	  (re-search-forward mew-eoh2 nil t)
	  (setq cite (concat (mew-buffer-substring (point-min) (point)) 
			     "\n" cite))
	  ))
      ;; 
      ;; Draft mode, insert the header and the body.
      ;;
      (save-restriction
	;; this gets complicated due to supercite, please don't care
	(narrow-to-region (point)(point)) ;; for (goto-char (point-min))
	(insert cite)
	(push-mark (point) t t)
	(goto-char (point-min)))
      (cond
       (mew-cite-hook
	(run-hooks 'mew-cite-hook))
       (t (mew-cite-original arg))
       )
      (mew-highlight-body)
      )))

(defun mew-cite-original (&optional arg)
  (if (< (marker-position (mark-marker)) (point))
      (exchange-point-and-mark))
  (let ((beg (point)) (end (marker-position (mark-marker)))
        label prefix)
    (save-restriction
      (narrow-to-region beg end)
      (condition-case nil
          (setq label (mew-cite-strings))
        (error
	 (error "Syntax of mew-cite-format was changed. Read explanation of mew-cite-fields")))
      (if (null mew-cite-prefix-function)
          (setq prefix mew-cite-prefix)
        (setq prefix (funcall mew-cite-prefix-function)))
      (if mew-cite-prefix-confirmp
          (let ((ask (read-string 
                      (format "Prefix (\"%s\"): " prefix) "")))
            (if (not (string= ask "")) (setq prefix ask))))
      ;; C-u C-c C-y cites body with header.
      (if (eq arg nil) 
	  ;; header has been already cited. So, delete it.
	  (delete-region beg
			 (progn
			   (re-search-forward mew-eoh2 nil t)
			   (forward-line)
			   (point))))
      (insert label)
      (push-mark (point) t t) ;; for C-x C-x
      (and (bolp) (insert prefix))
      (while (equal 0 (forward-line))
	(or (equal (point) (point-max))
	    (insert prefix)))
      ) ;; restriction
    )
  )

(defun mew-draft-check-whom ()
  "Display expanded address aliases in other window."
   (interactive)
  (let* ((to-cc (mew-header-address-collect
		'("To:" "Cc:" "Bcc:" "Apparently-To:")))
	 (exp-to-cc (mew-header-expand-alias-list to-cc))
	 (buf (current-buffer)))
    (message "Checking recipients ... ")
    (get-buffer-create mew-buffer-whom)
    (switch-to-buffer-other-window mew-buffer-whom)
    (mew-erase-buffer)
    (mapcar (lambda (x) (insert (format "%s\n" x))) exp-to-cc) ;; xxx
    (mew-pop-to-buffer buf)
    (message "Checking recipients ... done")
    ))

(defun mew-draft-kill ()
  "Kill this draft."
  (interactive)
  (let* ((mimefolder (mew-draft-to-mime (buffer-name))) ;; buffer will kill
	 (mimedir (mew-expand-folder mimefolder))
	 (delete nil))
    (if (y-or-n-p "Kill draft message? ")
	(progn
	  (set-buffer-modified-p t) ;; for delete recovery file
	  (save-buffer)
	  (if (file-exists-p (buffer-file-name))
	      (delete-file (buffer-file-name)))
	  (set-buffer-modified-p nil)
	  (and (get-buffer (mew-draft-to-mime (buffer-name)))
	       (kill-buffer (mew-draft-to-mime (buffer-name))))
	  (kill-buffer (buffer-name))
	  (if (mew-current-get 'window)
	      (progn
		(set-window-configuration (mew-current-get 'window))
		(mew-current-set 'window nil)))
	  (message "Draft was killed")
	  (if (null (file-directory-p mimedir))
	      ()
	    (cond
	     ((equal mew-mime-compose-folder-delete 'ask)
	      (setq delete (y-or-n-p (format "%s exists. Remove it? " mimefolder))))
	     ((equal mew-mime-compose-folder-delete 'delete)
	      (setq delete t))
	     ((equal mew-mime-compose-folder-delete 'retain)
	      (setq delete nil))
	     (t
	      (setq delete (y-or-n-p (format "%s exists. Remove it? " mimefolder)))
	      )
	     )
	    (if (null delete)
		(format "Folder %s remains" mimefolder)
	      (mew-delete-directory-recursively mimedir))))
      (message "Draft was not killed"))
    ))

(defun mew-draft-insert-config (&optional here)
  "Insert the Config: header."
  (interactive)
  (let* ((config-cur (mew-header-get-value "Config:"))
	 (config-gus (mew-refile-guess-by-alist1 mew-config-guess-alist))
	 (config-new (if config-gus (mew-join "," config-gus))))
    (if (and mew-ask-config (not (interactive-p)))
	(setq config-new (mew-input-config config-new)))
    (if (and (interactive-p) (not config-new))
	(setq config-new ""))
    (if config-new
	(if (and config-cur
		 (or (string= config-cur config-new)
		     (not
		      (y-or-n-p
		       (format "Do you want to replace Config value with %s? "
			       config-new)))))
	    ()
	  (if here
	      (mew-header-insert-here "Config:" config-new)
	    (widen)
	    (push-mark (point) t t) ;; for C-x C-x
	    (mew-header-delete-lines '("Config:"))
	    (goto-char (point-min))
	    (re-search-forward mew-eoh2)
	    (beginning-of-line)
	    (mew-header-insert-here "Config:" config-new)
	    (mew-draft-refresh)
	    (forward-line -1)
	    (end-of-line))))))

(defun mew-draft-insert-signature ()
  (interactive)
  (let ((sigfile (expand-file-name mew-signature-file)))
    (if (not (file-exists-p sigfile))
	(message "No signature file %s" sigfile)
      (if (and (mew-attach-p) mew-signature-as-lastpart)
	  (progn
	    (goto-char (point-max))
	    (forward-line -2)
	    (mew-attach-forward)
	    (mew-attach-copy sigfile "Signature")
	    (mew-attach-disposition "") ;; nil is NG.
	    (mew-attach-description mew-signature-description)
	    )
	(if mew-signature-insert-last 
	    (if (null (mew-attach-p))
		(goto-char (point-max))
	      (goto-char (marker-position mew-draft-buffer-attach))
	      (forward-line -1)
	      (end-of-line)
	      (insert "\n")))
	(insert-file-contents sigfile)
	))
    ))

;;;
;;; Draft magic functions
;;;

(defun mew-draft-in-header-p ()
  (if (markerp mew-draft-buffer-header)
      (<= (point) (marker-position mew-draft-buffer-header))
    nil)
  )

(defun mew-draft-in-attach-p ()
  (if (markerp mew-draft-buffer-attach)
      (>= (point) (marker-position mew-draft-buffer-attach))
    nil)
  )

(defun mew-draft-keyswitch ()
  "A function to implement region key binding."
  (interactive)
  (let ((key (this-command-keys))
	command func len (i 0))
    (if (and mew-xemacs-p (= (length key) 0))
	(setq key (vector last-command-event)))
    (setq command (lookup-key (current-global-map) key))
    (if (numberp command)
	(setq len command
	      command (lookup-key (current-global-map)
				  (mew-subsequence key 0 len))
	      key (mew-subsequence key len)))
    (setq len (length key))
    (if (or (eq command 'universal-argument) (eq command 'digit-argument))
	(catch 'keyswitch
	  (while (and (or (eq command 'universal-argument)
			  (eq command 'digit-argument))
		      (let ((tmp (aref key i)))
			(if mew-xemacs-p (setq tmp (event-to-character tmp)))
			(and (<= ?0 tmp) (>= ?9 tmp))))
	    (setq i (1+ i)))
	  (while (< i len)
	    (if (eq 'mew-draft-keyswitch
		    (key-binding (char-to-string (aref key i))))
		(throw 'keyswitch (setq key (mew-subsequence key i))))
	    (setq i (1+ i))
	    )
	  ))
    (cond
     ((and (markerp mew-draft-buffer-attach) (mew-draft-in-attach-p))
      (setq func (lookup-key mew-draft-attach-map key)))
     ((and (markerp mew-draft-buffer-header) (mew-draft-in-header-p))
      (setq func (lookup-key mew-draft-header-map key)))
     (t 
      (setq func (lookup-key mew-draft-body-map key))
      )
     )
    (if (not (integerp func))
	()
      (setq key (mew-subsequence key 0 func))
      (setq func (lookup-key (current-global-map) key))
      (cond
       ((and (markerp mew-draft-buffer-attach) (mew-draft-in-attach-p))
	(setq func (lookup-key mew-draft-attach-map key)))
       ((and (markerp mew-draft-buffer-header) (mew-draft-in-header-p))
	(setq func (lookup-key mew-draft-header-map key)))
       (t 
	(setq func (lookup-key mew-draft-body-map key))
	)
       )
      )
    (if func
	()
      (setq func (lookup-key (current-global-map) key))
      (if (not (integerp func))
	  ()
	(setq key (mew-subsequence key 0 func))
	(setq func (lookup-key (current-global-map) key))
	)
      )
    (if func
	(while (keymapp func)
	  (if (vectorp key)
	      (setq key (vconcat key (read-event)))
	    (setq key (concat key (char-to-string (read-event)))))
	  (setq func (lookup-key (current-global-map) key))
	  )
      )
    (if (null func)
	(insert key) ;; just in case
      (setq this-command func)
      (run-hooks 'pre-command-hook)
      (call-interactively this-command))
    ))

(defun mew-draft-null-function ()
  (interactive)
  ())

;;
;; undo
;;

(defun mew-draft-undo ()
  "Undo 'C-cC-m'."
  (interactive)
  (let* ((path (mew-expand-folder (mew-draft-to-mime (buffer-name))))
	 (backup-file (expand-file-name mew-draft-backup-file path))
	 (syntax-file (expand-file-name mew-draft-syntax-file path))
	 (syntax nil))
    (if (not (file-exists-p backup-file))
	(message "Can't undo")
      (mew-erase-buffer)
      (insert-file-contents backup-file)
      (delete-file backup-file)
      ;;
      (mew-draft-refresh)
      (mew-highlight-header-region
       (point-min) (marker-position mew-draft-buffer-header))
      (goto-char (marker-position mew-draft-buffer-header))
      (if (not (file-exists-p syntax-file))
	  () ;; single
	(save-excursion
	  (find-file-read-only syntax-file)
	  (goto-char (point-min))
	  (setq syntax (read (current-buffer)))
	  (kill-buffer (current-buffer))
	  )
	(setq mew-encode-syntax syntax) ;; buffer local
	(mew-draft-prepare-attachments)
	(delete-file syntax-file)
	))
    ))

;;
;;
;;

(defun mew-save-buffer ()
  (interactive)
  (mew-frwlet mew-cs-noconv mew-cs-draft
    (save-buffer)))

(defun mew-draft-rehighlight (arg)
  (interactive "P")
  (mew-draft-refresh)
  (mew-highlight-header-region
   (point-min) (marker-position mew-draft-buffer-header))
  (mew-highlight-body)
  (recenter arg))

(defun mew-cite-prefix-username ()
  "A good candidate for mew-cite-prefix-function.
The citation style is \"from_address> \", e.g. \"kazu> \""
  (let ((addr (mew-header-extract-addr
	       (mew-header-get-value "From:")))
	petname prefix)
    (if (and mew-use-petname mew-petname-alist
	     (setq petname 
		   (cdr (mew-assoc-case-equal addr mew-petname-alist 0))))
	(setq prefix petname)
      (setq prefix (mew-header-delete-at addr)))
    (if mew-ask-cite-prefix
	(setq prefix (read-string "Citation prefix: " prefix)))
    (format "%s> " prefix)
    ))

(provide 'mew-draft)

;;; Copyright Notice:

;; Copyright (C) 1996, 1997, 1998 Mew developing team.
;; All rights reserved.

;; Redistribution and use in source and binary forms, with or without
;; modification, are permitted provided that the following conditions
;; are met:
;; 
;; 1. Redistributions of source code must retain the above copyright
;;    notice, this list of conditions and the following disclaimer.
;; 2. Redistributions in binary form must reproduce the above copyright
;;    notice, this list of conditions and the following disclaimer in the
;;    documentation and/or other materials provided with the distribution.
;; 3. All advertising materials mentioning features or use of this software
;;    must display the following acknowledgement:
;;       This product includes software developed by 
;;       Mew developing team and its contributors.
;; 4. Neither the name of the team nor the names of its contributors
;;    may be used to endorse or promote products derived from this software
;;    without specific prior written permission.
;; 
;; THIS SOFTWARE IS PROVIDED BY THE TEAM AND CONTRIBUTORS ``AS IS'' AND
;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
;; PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE TEAM OR CONTRIBUTORS BE
;; LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
;; OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
;; IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

;;; mew-draft.el ends here
