~ubuntu-branches/ubuntu/lucid/mew-beta/lucid

;;; mew-encode.el --- MIME syntax encoder for Mew

;; Author:  Kazu Yamamoto <Kazu@Mew.org>

;; Created: Oct  2, 1996

;;; Code:

(require 'mew)

(defvar mew-prog-mime-encode-switch

  `((,mew-b64 "-b")

    (,mew-qp  "-q")

    (,mew-xg  "-g")))

(defvar mew-prog-mime-encode-text-switch

  `((,mew-b64 "-b" "-t")

    (,mew-qp  "-q")

    (,mew-xg  "-g""-t")))

(defun mew-prog-mime-encode-get-opt (cte switch)

  (cdr (mew-assoc-case-equal cte switch 0)))

(defvar mew-encode-multipart-encrypted-switch

  `((,mew-ct-pge mew-pgp-encrypt)))

(defvar mew-encode-multipart-signed-switch

  `((,mew-ct-pgs mew-pgp-sign mew-pgp-canonicalize)

    (,mew-ct-sms mew-smime-detach-sign)))

;;

(defun mew-encode-get-security-func (proto switch)

  (nth 1 (mew-assoc-case-equal proto switch 0)))

(defun mew-encode-get-canonicalize-func (proto switch)

  (nth 2 (mew-assoc-case-equal proto switch 0)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;

;;; MIME encoder

;;;

(defun mew-encode-error (error-msg)

  (mew-tinfo-set-encode-err error-msg)

  (error ""))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;

;;; RFC 2822 comments

;;;

;; RFC 2822 defines the limitations of the number of fields.

;;

;; * Overriding

;;    Date: (exactly once)

;;    Message-Id:

;;

;; * Put multiple fields to a single field

;;    From: (exactly once)

;;    Reply-To:

;;    To:

;;    Cc:

;;

;; * Error and undo

;;    Sender: (if exist, exactly one address)

;;

;;    In-Reply-To:

;;    References:

;;    Subject:

;;

(defconst mew-multiple-field-error-list

  (list mew-subj: mew-in-reply-to: mew-references:))

(defconst mew-multiple-field-combine-list

  (list mew-from: mew-reply-to: mew-to: mew-cc:))

(defun mew-header-count-field (field)

  (let ((case-fold-search t)

	(regex (format "^%s" field))

	(i 0))

    (goto-char (point-min))

    (while (re-search-forward regex nil t)

      (setq i (1+ i))

      (forward-line))

    i))

(defun mew-header-combine-field (field)

  (let ((case-fold-search t)

	(regex (format "^%s" field))

	beg med here value)

    (goto-char (point-min))

    (when (re-search-forward regex nil t)

      (forward-line)

      (mew-header-goto-next)

      (setq here (1- (point)))

      (while (re-search-forward regex nil t)

	(setq beg (match-beginning 0))

	(setq med (match-end 0))

	(forward-line)

	(mew-header-goto-next)

	(setq value (mew-buffer-substring med (1- (point))))

	(delete-region beg (point))

	(save-excursion

	  (goto-char here)

	  (insert ",\n\t" value)

	  (setq here (point)))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;

;;; Header sanity check

;;;

(defun mew-encode-remove-invalid-fields ()

  (when (mew-header-end)

    (save-excursion

      (save-restriction

	(narrow-to-region (point-min) (mew-header-end))

	(dolist (field mew-multiple-field-error-list)

	  (if (> (mew-header-count-field field) 1)

	      (mew-encode-error (format "Multiple %s!" field))))

	(mapcar 'mew-header-combine-field mew-multiple-field-combine-list)))))

(defun mew-encode-ask-subject ()

  (when (and mew-ask-subject (not (mew-header-existp mew-subj:)))

    ;; Subject: does not exist

    (let ((subj (read-string (concat mew-subj: " "))))

      (mew-header-replace-value mew-subj: subj))))

(defun mew-encode-fcc-folder-check (fld)

  (let ((folder (mew-canonicalize-folder fld)))

    (when (and mew-ask-fcc

	       (mew-folder-localp folder)

	       (not (file-directory-p (mew-expand-folder folder))))

      (if (y-or-n-p (format "%s does not exist. Create it? " folder))

	  (mew-local-folder-check folder)

	(mew-encode-error "Edit Fcc:")))

    folder))

(defun mew-encode-ask-fcc (resentp)

  (let* ((target (if resentp mew-resent-fcc: mew-fcc:))

	 (folders (mew-header-get-value target)))

    (when folders

      (mapcar

       'mew-encode-fcc-folder-check

       (mew-addrstr-parse-value-list2 folders)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;

;;; To:, Cc:

;;;

(defvar mew-draft-append-domain-p t)

(defun mew-draft-append-domain (addr)

  (if (string-match "@" addr)

      addr

    (if mew-draft-append-domain-p

	(concat addr "@" (mew-mail-domain (mew-tinfo-get-case)))

      (throw 'jump addr))))

(defun mew-encode-canonicalize-address (resentp)

  (catch 'jump

    (let ((case-fold-search t)

	  (regex (mew-make-field-regex

		  (if resentp mew-resent-dest:-list mew-destination:-list)))

	  key start vals val addrs addr ret insl ins prefix suffix)

      (save-excursion

	(save-restriction

	  (narrow-to-region (point-min) (mew-header-end))

	  (goto-char (point-min))

	  (while (re-search-forward regex nil t)

	    (setq key (match-string 1))

	    (setq start (match-end 0))

	    (forward-line)

	    (while (looking-at mew-lwsp)

	      (delete-backward-char 1)

	      (forward-line))

	    (setq val (mew-buffer-substring start (1- (point))))

	    (delete-region start (1- (point)))

	    (backward-char 1)

	    ;; single quote is allowed for local-part

	    (setq vals (mapcar 'mew-chop (mew-split-quoted val ?, ?: ?\; 'no-single)))

	    (dolist (val vals)

	      (setq ins nil addrs nil)

	      (cond

	       ;; phrase:addr1,addr2;

	       ((string-match "[^:]+:[^;]+;" val)

		(let ((mew-alias-expand-prefix nil))

		  (setq addrs (mew-alias-expand val mew-addrbook-alist 0))

		  (setq addrs (mapcar 'mew-draft-append-domain addrs))

		  (setq ins (list (concat mew-alias-expand-prefix ":;")))))

	       ;; Name <addr>

	       ((and (setq addr (mew-addrstr-parse-address val))

		     (string-match (concat "\\(.*<\\)" (regexp-quote addr) "\\(>.*\\)")

				   val))

		(setq prefix (match-string 1 val))

		(setq suffix (match-string 2 val))

		(setq addr (mew-draft-append-domain addr))

		(setq addrs (list addr))

		(setq ins (list (concat prefix addr suffix))))

	       ;; addr

	       (t

		(let ((mew-alias-expand-prefix nil))

		  (setq addrs (mew-alias-expand val mew-addrbook-alist 0))

		  (setq addrs (mapcar 'mew-draft-append-domain addrs))

		  (if mew-alias-expand-prefix

		      (setq ins (list (concat mew-alias-expand-prefix ":;")))

		    (setq ins (copy-sequence addrs))))))

	      (setq insl (nconc insl ins))

	      (unless (string-match "bcc" key) ;; Removing Bcc:

		(setq ret (nconc ret addrs)))) ;; end of dolist

	    (insert " " (mapconcat 'identity insl ", "))

	    (setq insl nil)

	    (forward-line))))

      ret)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;

;;; Dcc:, Bcc:

;;;

(defun mew-encode-delete-dcc (resentp)

  (let* ((target (list (if resentp mew-resent-dcc: mew-dcc:)))

	 (dcc (mew-header-parse-address-list target)))

    ;; Dcc: is already contained in recipients.

    ;; So, just delete it.

    ;; Delete {Resent-,}Dcc: anyway.

    (mew-header-delete-lines (list mew-dcc: mew-resent-dcc:))

    dcc))

(defun mew-encode-delete-bcc (resentp)

  (let* ((target (list (if resentp mew-resent-bcc: mew-bcc:)))

	 (bcc (mew-header-parse-address-list target)))

    (mew-header-delete-lines (list mew-bcc: mew-resent-bcc:)) ;; anyway

    bcc))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;

;;; Message-Id:, Date:

;;;

(defun mew-encode-id-date (pnm msgid &optional resentp)

  (let ((time (current-time)))

    (cond

     (resentp

      (mew-header-delete-lines (list mew-resent-date: mew-resent-message-id:))

      (save-excursion

	(goto-char (point-min))

	(mew-header-insert mew-resent-date: (mew-time-ctz-to-rfc time))

	(mew-header-insert mew-resent-message-id: msgid)))

     (t

      (mew-header-delete-lines (list mew-date: mew-message-id:))

      (save-excursion

	(goto-char (point-min))

	(mew-header-insert mew-date: (mew-time-ctz-to-rfc time))

	(mew-header-insert mew-message-id: msgid))))

    (list msgid (mew-time-ctz-to-logtime time))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;

;;; From:, Sender:

;;;

(defun mew-encode-check-sender (resentp)

  (if (< 1 (length (mew-addrstr-parse-address-list

		    (mew-header-get-value

		     (if resentp mew-resent-sender: mew-sender:)))))

      (mew-encode-error "Sender: must contain one address!")))

(defun mew-encode-from (case resentp)

  (unless (mew-header-existp mew-from:)

    (let ((from (mew-from case)))

      (save-excursion

	(goto-char (point-min))

	(if resentp

	    (mew-header-insert mew-resent-from: from)

	  (mew-header-insert mew-from: from))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;

;;; Learning aliases

;;;

;; xxx Bcc: and/or Dcc:?

(defun mew-encode-learn-aliases (resentp)

  (if (and mew-use-auto-alias mew-addrbook-append-domain-p)

      ;; If mew-addrbook-append-domain-p is nil, automatic

      ;; short names would be conflicted to local users.

      (mapcar 'mew-addrbook-alias-add

	      (mew-header-parse-address-list

	       (if resentp

		   (list mew-resent-to: mew-resent-cc:)

		 (list mew-to: mew-cc:))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;

;;; Misc

;;;

(defun mew-encode-set-privacy (pnm privacy case)

  (unless (or (mew-syntax-get-privacy mew-encode-syntax) ;; specified

	      ;; encryption previously failed, so bypass.

	      (and (null privacy) (mew-tinfo-get-privacy-err)))

    (let (type)

      (cond

       (privacy

	(setq type privacy))

       ((mew-tinfo-get-privacy-type)

	(setq type (mew-tinfo-get-privacy-type)))

       ((and (mew-tinfo-get-encrypted-p) (mew-protect-privacy-encrypted case))

	(setq type (mew-protect-privacy-encrypted-type case)))

       ((mew-protect-privacy-always case)

	(setq type (mew-protect-privacy-always-type case))))

      (mew-syntax-set-privacy

       mew-encode-syntax

       (mew-pcdb-ct (mew-pcdb-by-service type)))

      ;; recipients are ignored when signing

      (mew-syntax-set-decrypters

       mew-encode-syntax (mew-smtp-get-recipients pnm)))))

(defun mew-encode-make-header (&optional addsep resentp)

  (unless (mew-header-existp mew-mv:)

    (goto-char (mew-header-end))

    (mew-header-insert mew-mv: mew-mv:-num))

  (mew-header-encode-region (point-min) (mew-header-end) resentp)

  (cond

   (addsep ;; reedit

    ;; To:

    ;; Content-*

    ;; ----

    (mew-header-clear) ;; mew-in-header-p() returns nil

    ;; To:

    ;; Content-*

    (insert "\n"))

   (t

    ;; To:

    ;; ----

    ;; Content-*

    (mew-header-clear) ;; mew-in-header-p returns nil

    ;; To:

    ;; Content-*

    ))

  (mew-header-goto-end)

  (mew-highlight-header-region (point-min) (point)))

(defun mew-encode-save-draft ()

  (mew-frwlet mew-cs-dummy mew-cs-text-for-write

    (write-region (point-min) (point-max) (buffer-file-name) nil 'no-msg)

    (clear-visited-file-modtime)

    (mew-delete-file buffer-auto-save-file-name)

    (set-buffer-modified-p nil)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;

;;; Encoding a message

;;;

(defun mew-smtp-encode (pnm case resentp fcc &optional privacy signer headerp)

  (let ((ret t))

    (if (mew-debug 'encode)

	(let ((debug-on-error t))

	  (mew-smtp-encode-message pnm case resentp fcc privacy signer headerp))

      (condition-case nil

	  (mew-smtp-encode-message pnm case resentp fcc privacy signer headerp)

	(error

	 (mew-encode-undo)

	 (message "%s" (mew-tinfo-get-encode-err))

	 (setq ret nil))

	(quit

	 (mew-encode-undo)

	 (message "quit")

	 (setq ret nil))))

    ret))

(defun mew-smtp-encode-message (pnm case resentp fcc &optional privacy signer headerp)

  (mew-set-buffer-multibyte t)

  (if (buffer-modified-p) (save-buffer)) ;; to make backup

  (widen)

  (let (multip recipients msgid logtime)

    (mew-smtp-set-raw-header

     pnm (mew-buffer-substring (point-min) (mew-header-end)))

    (unless headerp

      ;; Let's backup

      (if (mew-attach-p)

	  (progn

	    (setq multip t)

	    (mew-attach-clear))

	(unless mew-encode-syntax

	  (setq mew-encode-syntax

		(mew-encode-syntax-single "text.txt" (list mew-ct-txt)))))

      (mew-encode-make-backup))

    ;; Errors can be caused from here.

    (goto-char (point-min))

    (mew-encode-remove-invalid-fields)

    ;; Destination check

    (setq recipients (mew-encode-canonicalize-address resentp))

    ;; Bcc: is not included.

    (mew-smtp-set-recipients pnm recipients)

    (mew-smtp-set-orig-recipients pnm recipients)

    (cond

     ((null recipients)

      (mew-encode-error "No recipient!"))

     ((stringp recipients)

      (mew-encode-error (format "'%s' is not in the right form!" recipients))))

    ;; Header modifications which are not remained.

    (mew-header-delete-lines (list mew-fcc: mew-resent-fcc:)) ;; anyway

    (mew-encode-delete-dcc resentp)

    (mew-smtp-set-bcc pnm (mew-encode-delete-bcc resentp))

    (mew-smtp-set-fcc pnm fcc)

    ;;

    (mew-encode-check-sender resentp)

    (mew-encode-from case resentp)

    ;;

    (mew-set '(msgid logtime) (mew-encode-id-date pnm (mew-smtp-message-id case) resentp))

    (mew-smtp-set-msgid pnm msgid)

    (mew-smtp-set-logtime pnm logtime)

    ;;

    (goto-char (mew-header-end))

    (forward-line) ;; necessary for PGP

    ;;

    (message "Making a message...")

    ;; save syntax before setting privacy

    (unless headerp

      (mew-encode-set-privacy pnm privacy case)

      (let (mew-inherit-encode-pgp-signer

	    mew-inherit-encode-smime-signer)

	(setq mew-inherit-encode-pgp-signer

	      (or signer

		  (mew-pgp-signer (mew-tinfo-get-case))

		  (mew-get-my-address)))

	(setq mew-inherit-encode-smime-signer

	      (or signer

		  (mew-smime-signer (mew-tinfo-get-case))

		  (mew-get-my-address)))

	(goto-char (mew-header-end)) ;; due to invalid null lines in the header

	(forward-line)

	(if multip

	    (mew-encode-make-multi)

	  (mew-encode-make-single))))

    (mew-encode-make-header headerp resentp)

    ;; Learn aliases after no error occurred

    (mew-encode-learn-aliases resentp)

    (mew-encode-save-draft)

    (mew-overlay-delete-buffer)

    (message "Making a message...done")))

(defun mew-nntp2-encode (pnm case fcc &optional privacy signer headerp)

  (let ((ret t))

    (if (mew-debug 'encode)

	(let ((debug-on-error t))

	  (mew-nntp2-encode-message pnm case fcc privacy signer headerp))

      (condition-case nil

	  (mew-nntp2-encode-message pnm case fcc privacy signer headerp)

	(error

	 (mew-encode-undo)

	 (message "%s" (mew-tinfo-get-encode-err))

	 (setq ret nil))

	(quit

	 (mew-encode-undo)

	 (message "quit")

	 (setq ret nil))))

    ret))

(defun mew-nntp2-encode-message (pnm case fcc &optional privacy signer headerp)

  (mew-set-buffer-multibyte t)

  (if (buffer-modified-p) (save-buffer)) ;; to make backup

  (widen)

  (let (multip newsgroups msgid logtime)

    (mew-nntp2-set-raw-header

     pnm (mew-buffer-substring (point-min) (mew-header-end)))

    ;; Let's backup

    (unless headerp

      (if (mew-attach-p)

	  (progn

	    (setq multip t)

	    (mew-attach-clear))

	(setq mew-encode-syntax

	      (mew-encode-syntax-single "text.txt" (list mew-ct-txt))))

      (mew-encode-make-backup))

    ;; Errors can be caused from here.

    (goto-char (point-min))

    (mew-encode-remove-invalid-fields)

    ;; Newsgroups check

    (setq newsgroups (mew-header-get-value mew-newsgroups:))

    (mew-nntp2-set-newsgroups pnm newsgroups)

    (unless newsgroups (mew-encode-error "No newsgroups!"))

    ;; Header modifications which are not remained.

    (mew-header-delete-lines (list mew-fcc: mew-resent-fcc:)) ;; anyway

    (mew-nntp2-set-fcc pnm fcc)

    ;;

    (mew-encode-from case nil)

    ;;

    (mew-set '(msgid logtime) (mew-encode-id-date pnm (mew-nntp-message-id case)))

    (mew-nntp2-set-msgid pnm msgid)

    (mew-nntp2-set-logtime pnm logtime)

    ;;

    (goto-char (mew-header-end))

    (forward-line) ;; necessary for PGP

    ;;

    (message "Making a message...")

    ;; save syntax before setting privacy

    (unless headerp

      (mew-encode-set-privacy pnm privacy case)

      (let (mew-inherit-encode-pgp-signer

	    mew-inherit-encode-smime-signer)

	(setq mew-inherit-encode-pgp-signer

	      (or signer

		  (mew-pgp-signer (mew-tinfo-get-case))

		  (mew-get-my-address)))

	(setq mew-inherit-encode-smime-signer

	      (or signer

		  (mew-smime-signer (mew-tinfo-get-case))

		  (mew-get-my-address)))

	(goto-char (mew-header-end)) ;; due to invalid null lines in the header

	(forward-line)

	(if multip

	    (mew-encode-make-multi)

	  (mew-encode-make-single))))

    (mew-encode-make-header nil)

    (mew-encode-save-draft)

    (mew-overlay-delete-buffer)

    (message "Making a message...done")))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;

;;; Encoding singlepart

;;;

(defun mew-encode-make-single ()

  ;; Just after the header

  ;; Using Multipart/Signed if the body is a single part.

  (if (equal (mew-syntax-get-privacy mew-encode-syntax)

	     `((,mew-ct-smm ,mew-ct-smm-sig)))

      (mew-syntax-set-privacy mew-encode-syntax `((,mew-ct-mls ,mew-ct-sms))))

  (mew-encode-singlepart mew-encode-syntax nil nil t 'cover))

(defun mew-encode-charset-8bitp (charset)

  (let ((case-fold-search t))

    (if (or (mew-case-equal mew-us-ascii charset)

	    (string-match "^iso-2022" charset))

	nil

      t)))

(defun mew-encode-file-8bitp (file)

  (if (and (mew-which-exec mew-prog-8bit) (file-readable-p file))

      (eq (call-process mew-prog-8bit file nil nil "-8") 1)))

(defun mew-encode-limit-7bitp (privacy)

  ;; Only parts to be signed FIRST are limited to 7bit.

  (and privacy (mew-case-equal mew-ct-mls (car (car privacy)))))

(defvar mew-encode-max-line-length 990)

;; RFC 2822 defines 1000 but Sendmail uses 990

(defvar mew-ask-encoding t)

(defvar mew-default-encoding mew-b64)

(defun mew-encode-mime-body (ctl cte file no-encoding)

  ;; If file is 't', target is buffered.

  ;; text should be buffered

  ;; 	- specified charset is a rare case

  ;; 	- copy overhead may be small

  (let* ((ct (mew-syntax-get-value ctl 'cap))

         (textp (mew-ct-textp ct))

	 (charset (if textp (mew-syntax-get-param ctl "charset")))

	 (icharset (if textp (mew-syntax-get-param ctl "icharset")))

         (linebasep (or textp (mew-ct-linebasep ct)))

         (switch (if linebasep

                     mew-prog-mime-encode-text-switch

                   mew-prog-mime-encode-switch))

         (beg (point))

	 buffer cs opt last flowed delsp flowed-delsp)

    (if (and (stringp file)

	     (setq buffer (get-file-buffer file))

	     (buffer-modified-p buffer))

	(with-current-buffer buffer

	  (save-buffer)))

    (when textp

      (when (and (stringp file) (file-readable-p file))

	(when icharset

	  (setq cs (mew-charset-to-cs icharset))

	  (unless (mew-coding-system-p cs)

	    (mew-encode-error

	     (format "Unknown coding system %s in the body"

		     (symbol-name cs)))))

	(mew-frwlet (or cs mew-cs-autoconv) mew-cs-dummy

	  (mew-insert-file-contents file)))

      ;; A user may specify charset to convey JIS X 0201 Katakana.

      ;; So, we need to avoid the sanity check.

      (unless charset

	(if mew-use-charset-sanity-check

	    (mew-charset-sanity-check beg (point-max)))

	(setq charset (mew-charset-guess-region beg (point-max))))

      (setq cs (mew-charset-to-cs charset))

      (when (string= mew-ct-txt ct)

	(cond

	 ((mew-tinfo-get-flowed)

	  (setq flowed t)

	  (if (string= (mew-tinfo-get-flowed) "yes")

	      (setq delsp t)))

	 ((mew-tinfo-get-use-flowed)

	  (setq flowed-delsp (mew-encode-flowed beg (point-max) charset))

	  (mew-set '(flowed delsp) flowed-delsp))))

      (unless (mew-coding-system-p cs)

	(mew-encode-error

	 (format "Unknown coding system %s in the body" (symbol-name cs))))

      (mew-cs-encode-region beg (point-max) cs))

    ;; decide cte

    (cond

     (textp

      (cond

       ((and cte (or (mew-case-equal cte mew-b64) (mew-case-equal cte mew-qp)))

	;; user specified and in 7bit domain, so do nothing.

	)

       (t

	(if (or (null cte) (mew-case-equal cte mew-bin))

	    ;; retain the user-specified cte

	    (setq cte (mew-charset-to-cte charset)))

	(if (or (null cte) (mew-case-equal cte mew-bin))

	    ;; unknown charset

	    (setq cte mew-default-encoding))

	(cond

	 (no-encoding

	  (if (mew-encode-charset-8bitp charset)

	      (setq cte mew-8bit)

	    (setq cte mew-7bit)))

	 (mew-inherit-7bit

	  (if (mew-case-equal cte mew-8bit)

	      (setq cte mew-default-encoding)))

	 (mew-use-8bit

	  (if (mew-encode-charset-8bitp charset)

	      (setq cte mew-8bit))))

	(when (and (not no-encoding)

		   (or (mew-case-equal cte mew-7bit)

		       (mew-case-equal cte mew-8bit)))

	  (save-excursion

	    (goto-char beg)

	    (mew-set-buffer-multibyte nil)

	    (catch 'long-line

	      (while t

		(setq last (point))

		(if (/= (forward-line) 0) (end-of-line))

		(when (>= (- (point) last) mew-encode-max-line-length) ;; including LF

		  (if (not mew-ask-encoding)

		      (setq cte mew-default-encoding)

		    (setq cte (mew-input-encoding)))

		  (throw 'long-line nil))

		(if (eobp) (throw 'long-line nil))))

	    (mew-set-buffer-multibyte t))))))

     ((string= ct mew-ct-msg)

      (if (mew-encode-file-8bitp file)

	  (setq cte mew-8bit)

	(setq cte mew-7bit)))

     (t

      (if (and no-encoding cte (mew-case-equal cte mew-b64))

	  (setq cte mew-bin))

      ;; There are 7bit ascii bodies such as

      ;; application/pgp-encrypted and message/external-body.

      ;; If 7bit or 8bit, it should be linebase.

      (if (null cte) (setq cte mew-7bit))))

    (cond

     ((mew-case-equal cte mew-bin)

      (mew-frwlet mew-cs-binary mew-cs-dummy

	(mew-insert-file-contents file)))

     ((or (mew-case-equal cte mew-7bit) (mew-case-equal cte mew-8bit))

      ;; Certainly linebase here.

      (unless textp

	(mew-frwlet mew-cs-text-for-read mew-cs-dummy

	  (mew-insert-file-contents file)))

      (when (and (string= ct mew-ct-msg)

		 (or mew-inherit-7bit (not mew-use-8bit))

		 (mew-case-equal cte mew-8bit))

	(save-restriction

	  (setq cte mew-7bit)

	  (narrow-to-region beg (point-max))

	  (mew-convert-message))))

     ((and (mew-case-equal cte mew-b64) (fboundp 'base64-encode-region))

      (unless textp

	(mew-frwlet (if linebasep mew-cs-text-for-read mew-cs-binary) mew-cs-dummy

	  (mew-insert-file-contents file)))

      (when linebasep

	(goto-char beg)

	(mew-lf-to-crlf))

      (base64-encode-region beg (point-max))

      (goto-char (point-max))

      (insert "\n"))

     ((mew-which-exec mew-prog-mime-encode)

      (setq opt (mew-prog-mime-encode-get-opt cte switch))

      (if (null opt)

	  (mew-encode-error (concat "Unknown CTE: " cte))

	(when textp

	  (setq file (mew-make-temp-name))

	  (mew-frwlet mew-cs-dummy mew-cs-text-for-write

	    ;; NEVER use call-process-region for privacy reasons

	    (write-region beg (point-max) file nil 'no-msg))

	  (delete-region beg (point-max)))

	(mew-piolet mew-cs-text-for-read mew-cs-dummy

	  (apply 'call-process mew-prog-mime-encode file t nil opt))

	(if textp (mew-delete-file file))))

     (t

      (mew-encode-error (concat mew-prog-mime-encode " does not exist"))))

    (list cte charset flowed delsp)))

(defun mew-encode-no-mime-encoding (privacy)

  (let ((first (car privacy)))

    (and (listp first)

	 (or (string= (car first) mew-ct-mle)

	     (string= (car first) mew-ct-smm)))))

(defun mew-broken-name (cdpl)

  (let ((mew-encode-word-max-length 1000) ;; xxx

	(file (nth 1 (assoc "filename" cdpl)))

	name)

    (when (and file (string-match mew-regex-nonascii file))

      (setq name (car (mew-header-encode-string file)))

      ;; name must not be double-quoted here.

      ;; mew-heaer-insert will do this later

      (list "name" name))))

(defun mew-encode-flowed (beg end charset)

  "Encoding lines with RFC 3676"

  (let (flowed delsp column)

    (save-excursion

      (goto-char beg)

      (save-restriction

	(narrow-to-region beg end)

	(when (mew-encode-flowed-check)