cgit.sxemacs.org Git - packages/blob - xemacs-packages/mew/mew/mew-encode.el

   1 ;;; mew-encode.el --- MIME syntax encoder for Mew
   2
   3 ;; Author:  Kazu Yamamoto <Kazu@Mew.org>
   4 ;; Created: Oct  2, 1996
   5 ;; Revised: Aug 30, 1999
   6
   7 ;;; Code:
   8
   9 (defconst mew-encode-version "mew-encode.el version 0.23")
  10
  11 (require 'mew)
  12
  13 (defvar mew-prog-mime-encode-switch
  14   (list (cons mew-b64 '("-b"))
  15         (cons mew-qp  '("-q"))
  16         (cons mew-xg  '("-g"))))
  17
  18 (defvar mew-prog-mime-encode-text-switch
  19   (list (cons mew-b64 '("-b" "-t"))
  20         (cons mew-qp  '("-q"))
  21         (cons mew-xg  '("-g" "-t"))))
  22
  23 (defvar mew-encode-multipart-encrypted-switch
  24   '(("application/pgp-encrypted" . mew-pgp-encrypt)))
  25
  26 (defvar mew-encode-multipart-signed-switch
  27   '(("application/pgp-signature" . mew-pgp-sign)))
  28
  29 ;;;
  30 ;;; Making a header
  31 ;;;
  32
  33 (defun mew-draft-remove-illegal-null-lines ()
  34   (if (mew-header-end)
  35       (save-excursion
  36         (save-restriction
  37           (goto-char (mew-header-end))
  38           (if (not (bolp)) (insert "\n"))
  39           (narrow-to-region (point-min) (1- (mew-header-end)))
  40           (goto-char (point-min))
  41           (mew-elet
  42            (while (re-search-forward "^$" nil t)
  43              (delete-char 1)))))))
  44
  45 (defun mew-draft-ask-subject ()
  46   (if (and mew-ask-subject
  47            (not (mew-header-existp mew-subj:)))
  48       ;; value is null or Subject: doesn't exsit
  49       (save-excursion
  50         (goto-char (point-min))
  51         (if (re-search-forward (concat "^\\(" mew-subj: "\\)[ \t]*$")
  52                                (1- (mew-header-end)) t)
  53             (progn
  54               (replace-match "\\1 ")
  55               (insert (read-string (concat mew-subj: " "))))))))
  56
  57 (defun mew-draft-ask-newsgroups ()
  58   (if (and mew-ask-newsgroups
  59            (mew-header-existp mew-newsgroups:))
  60       (if (y-or-n-p "Do you want to post to NetNews? ")
  61           ()
  62         (mew-header-delete-lines (list mew-newsgroups:)))))
  63
  64 (defun mew-encode-canonicalize-address-region (BEG END fields)
  65   (let ((case-fold-search t)
  66         (regex (mew-make-field-regex fields))
  67         start vals val addrs addr ret insl ins prefix suffix)
  68     (save-excursion
  69       (save-restriction
  70         (narrow-to-region BEG END)
  71         (goto-char (point-min))
  72         (while (re-search-forward regex nil t)
  73           (setq start (match-end 0))
  74           (forward-line)
  75           (while (looking-at mew-lwsp)
  76             (delete-backward-char 1)
  77             (forward-line))
  78           (setq val (mew-buffer-substring start (1- (point))))
  79           (delete-region start (1- (point)))
  80           (backward-char 1)
  81           ;;
  82           (setq vals (mapcar (function mew-chop) (mew-split val ?, ?: ?\;)))
  83           (while vals
  84             (setq val (car vals))
  85             (setq vals (cdr vals))
  86             (setq ins nil addrs nil)
  87             (cond
  88              ((string-match "^\\([^:]+:\\)\\([^;]+\\);$" val)
  89               (setq prefix (mew-match 1 val))
  90               (setq addr (mew-match 2 val))
  91               (setq addr (mapcar (function mew-chop) (mew-split addr ?,)))
  92               (while addr
  93                 (setq addrs
  94                       (nconc addrs (mew-addrstr-expand-alias (car addr))))
  95                 (setq addr (cdr addr)))
  96               (setq ins (mapconcat (function identity) addrs ","))
  97               (setq ins (list (concat prefix ins ";"))))
  98              ((and (setq addr (mew-addrstr-parse-address val))
  99                    (string-match (concat "\\(.*<\\)" (regexp-quote addr) "\\(>.*\\)")
 100                                  val))
 101               (setq prefix (mew-match 1 val))
 102               (setq suffix (mew-match 2 val))
 103               (setq addr (mew-addrstr-append-domain addr))
 104               (setq addrs (list addr))
 105               (setq ins (list (concat prefix addr suffix))))
 106              (t
 107               (setq addrs (mew-addrstr-expand-alias val))
 108               (setq ins (copy-sequence addrs))))
 109             (setq insl (nconc insl ins))
 110             (setq ret (nconc ret addrs)))
 111           (insert " " (mapconcat (function identity) insl ", "))
 112           (setq insl nil)
 113           (forward-line))))
 114     ret))
 115
 116 (defun mew-draft-make-header (&optional addsep)
 117   (if (mew-header-existp mew-mv:)
 118       ()
 119     (goto-char (mew-header-end))
 120     (mew-header-insert mew-mv: mew-mv:-num))
 121   (mew-header-encode-region (point-min) (mew-header-end))
 122   (if addsep ;; reedit
 123       (progn
 124         ;; To:
 125         ;; Content-*
 126         ;; ---
 127         (mew-header-clear) ;; mew-header-p returns nil
 128         ;; To:
 129         ;; Content-*
 130         (insert "\n"))
 131     ;; To:
 132     ;; ----
 133     ;; Content-*
 134     (mew-header-clear) ;; mew-header-p returns nil
 135     ;; To:
 136     ;; Content-*
 137     )
 138   (mew-header-goto-end)
 139   (mew-highlight-header-region (point-min) (point))
 140   (set-window-start (get-buffer-window (current-buffer)) (point-min))
 141   (mew-draft-toolbar-update))
 142
 143 ;;;
 144 ;;; Making a message
 145 ;;;
 146
 147 (defun mew-draft-make-message (&optional privacy)
 148   "Make a MIME message. Guess charsets, convert the directory structure
 149 to multipart, and so on."
 150   (interactive)
 151   (widen)
 152   (run-hooks 'mew-make-message-hook)
 153   (if (not (mew-header-p))
 154       (progn
 155         (ding)
 156         (message "Already made!"))
 157     (condition-case nil
 158         (let (multip type receivers)
 159           (mew-draft-remove-illegal-null-lines)
 160           (mew-draft-ask-subject)
 161           (mew-draft-ask-newsgroups)
 162           (if mew-config-insert-when-composed
 163               (mew-draft-insert-config))
 164           (goto-char (mew-header-end))
 165           (forward-line) ;; necessary for PGP
 166           (setq receivers (mew-encode-canonicalize-address-region
 167                            (point-min) (point) mew-destination:-list))
 168           (message "Making a MIME letter ...")
 169           (if (mew-header-existp mew-ct:) ;; re-editing multipart
 170               (progn
 171                 (mew-draft-make-backup 'single)
 172                 (mew-draft-make-header 'addsep))
 173             (if (not (mew-attach-p))
 174                 (setq mew-encode-syntax (mew-encode-syntax-single "text-file"))
 175               (mew-attach-clear)
 176               (if (mew-attach-valid-p)
 177                   (setq multip t)
 178                 (setq mew-encode-syntax (mew-encode-syntax-single "text-file"))
 179                 ))
 180             (mew-draft-make-backup (not multip))
 181             ;; save syntax before setting privacy
 182             (if (or (mew-syntax-get-privacy mew-encode-syntax) ;; specified
 183                     (and (null privacy) mew-draft-privacy-error)) ;; bypass
 184                 ()
 185               (cond
 186                (privacy
 187                 (setq type privacy))
 188                (mew-draft-protect-privacy-type
 189                 (setq type mew-draft-protect-privacy-type))
 190                ((and mew-protect-privacy-encrypted mew-draft-encrypted-p)
 191                 (setq type mew-protect-privacy-encrypted-type))
 192                (mew-protect-privacy-always
 193                 (setq type mew-protect-privacy-always-type)))
 194               (mew-syntax-set-privacy
 195                mew-encode-syntax
 196                (nth 1 (assoc type mew-privacy-database)))
 197               ;; receivers are ignored when signing
 198               (mew-syntax-set-decrypters mew-encode-syntax receivers))
 199             (let ((mew-inherit-signer (mew-get-my-address)))
 200               (if multip
 201                   (mew-draft-make-multi)
 202                 (mew-draft-make-single)))
 203             (mew-draft-make-header))
 204           (save-buffer)
 205           (setq mew-encode-syntax nil) ;; for undo
 206           (setq buffer-undo-list nil)
 207           (message "Making a MIME letter ... done"))
 208       (mew-draft-undo)))) ;; may not work due to timing
 209
 210 ;;;
 211 ;;; Making singlepart
 212 ;;;
 213
 214 (defun mew-draft-make-single ()
 215   (goto-char (mew-header-end)) ;; due to illegal null lines in the header
 216   (forward-line)
 217   (mew-encode-singlepart mew-encode-syntax nil nil t))
 218
 219 (defun mew-encode-mime-body (ctl cte file)
 220   ;; If file is 't', target is buffered.
 221   ;; text should be buffered
 222   ;;    - specified charset is a rare case
 223   ;;    - copy overhead may be small
 224   (let* ((ct (mew-syntax-get-value ctl 'cap))
 225          (textp (string-match "^Text/" ct))
 226          (charset (if textp (mew-syntax-get-param ctl "charset")))
 227          (linebasep
 228           (or textp
 229               (mew-member-case-equal ct mew-mime-content-type-text-list)))
 230          (switch (if linebasep
 231                      mew-prog-mime-encode-text-switch
 232                    mew-prog-mime-encode-switch))
 233          (beg (point))
 234          opt file1)
 235     (cond
 236      (textp
 237       (if (and (stringp file) (file-readable-p file))
 238           (mew-frwlet
 239            (or (mew-charset-to-cs charset) mew-cs-infile) mew-cs-dummy
 240            (insert-file-contents file)))
 241       (mew-charset-sanity-check beg (point-max))
 242       (setq charset (or charset
 243                         (mew-charset-guess-region beg (point-max))
 244                         mew-us-ascii))
 245       (setq cte (or cte (mew-charset-to-cte charset) mew-b64))
 246       (cond
 247        ((mew-case-equal cte mew-7bit)) ;; stay with internal
 248        ((and (mew-case-equal cte mew-b64) (fboundp 'base64-encode-region))
 249         (mew-cs-encode-region beg (point-max) (mew-charset-to-cs charset))
 250         (goto-char beg)
 251         (while (search-forward "\n" nil t) (replace-match "\r\n"))
 252         (base64-encode-region beg (point-max))
 253         (goto-char (point-max))
 254         (insert "\n"))
 255        ((mew-which mew-prog-mime-decode exec-path)
 256         (setq opt (cdr (mew-assoc-case-equal cte switch 0)))
 257         (if (null opt)
 258             (error (concat "Unknown CTE: " cte))
 259           (setq file1 (mew-make-temp-name))
 260           (mew-frwlet
 261            mew-cs-dummy (mew-charset-to-cs charset)
 262            (write-region beg (point-max) file1 nil 'no-msg))
 263           (delete-region beg (point-max))
 264           (mew-piolet
 265            mew-cs-text-for-read mew-cs-dummy
 266            (apply (function call-process) mew-prog-mime-encode
 267                   file1 t nil opt))
 268           (if (file-exists-p file1) (delete-file file1))))
 269        (t
 270         (error (concat mew-prog-mime-encode " doesn't exist")))))
 271      (t
 272       ;; non-text
 273       (cond
 274        ((null cte)
 275         (setq cte mew-7bit)
 276         (mew-frwlet
 277          (if linebasep
 278              (if (mew-case-equal ct mew-ct-msg)
 279                  mew-cs-rfc822-trans
 280                mew-cs-text-for-read)
 281            mew-cs-binary)
 282          mew-cs-dummy
 283          (insert-file-contents file)))
 284        ((and (mew-case-equal cte mew-b64) (fboundp 'base64-encode-region))
 285         (mew-frwlet
 286          (if linebasep mew-cs-text-for-read mew-cs-binary)
 287          mew-cs-dummy
 288          (insert-file-contents file))
 289         (if linebasep
 290             (progn
 291               (goto-char beg)
 292               (while (search-forward "\n" nil t) (replace-match "\r\n"))))
 293         (base64-encode-region beg (point-max))
 294         (goto-char (point-max))
 295         (insert "\n"))
 296        ((mew-which mew-prog-mime-decode exec-path)
 297         (setq opt (cdr (mew-assoc-case-equal cte switch 0)))
 298         (if (null opt)
 299             (error (concat "Unknown CTE: " cte))
 300           (mew-piolet
 301            mew-cs-text-for-read mew-cs-dummy
 302            (apply (function call-process) mew-prog-mime-encode
 303                   file t nil opt))))
 304        (t
 305         (error (concat mew-prog-mime-encode " doesn't exist"))))))
 306     (list (if charset (list "charset" charset)) cte)))
 307
 308 (defun mew-encode-singlepart (syntax &optional path depth buffered)
 309   ;; path is nil if called make-single or security multipart
 310   ;; buffered is t if called make-single
 311   (let* ((file (expand-file-name (mew-syntax-get-file syntax) path))
 312          (ctl (mew-syntax-get-ct syntax))
 313          (ct (mew-syntax-get-value ctl 'cap))
 314          (cte (mew-syntax-get-cte syntax))
 315          (cd (mew-syntax-get-cd syntax))
 316          (cdpl (mew-syntax-get-cdp syntax))
 317          (privacy (mew-syntax-get-privacy syntax))
 318          (beg (point))
 319          charset-cte charset bodybeg)
 320     (setq charset-cte (mew-encode-mime-body ctl cte (or buffered file)))
 321     (goto-char beg)
 322     (setq charset (nth 0 charset-cte))
 323     (setq cte (nth 1 charset-cte))
 324     (if charset
 325         (progn
 326           (setq ctl (mew-syntax-get-params ctl))
 327           (setq ctl (mew-delete (car charset) ctl))
 328           (setq ctl (cons ct (cons charset ctl)))))
 329     (mew-header-insert mew-ct: ctl)
 330     (mew-header-insert mew-cte: cte)
 331     (and cd (mew-header-insert mew-cd: cd))
 332     (and cdpl (mew-header-insert mew-cdp: cdpl))
 333     (insert "\n")
 334     ;; header "\n" (cur) [text]
 335     (setq bodybeg (point))
 336     (goto-char (point-max))
 337     (if (and (equal ct mew-ct-msg) mew-field-delete-for-forwarding)
 338         (save-restriction
 339           (narrow-to-region bodybeg (point-max))
 340           (mew-header-delete-lines mew-field-delete-common)
 341           (mew-header-delete-lines mew-field-delete-for-forwarding)))
 342     (if privacy
 343         (mew-encode-security-multipart
 344          beg privacy depth (mew-syntax-get-decrypters syntax)))
 345     (goto-char (point-max))))
 346
 347 ;;;
 348 ;;; Making multipart
 349 ;;;
 350
 351 (defun mew-draft-make-multi ()
 352   ;; delete delimiter
 353   (goto-char (mew-header-end)) ;; due to illegal null lines in the header
 354   (forward-line)
 355   (let ((beg (point))
 356         (syntax mew-encode-syntax)
 357         (path (mew-expand-folder mew-draft-mime-folder))
 358         buffered)
 359     ;; Just after the header
 360     (save-excursion
 361       ;; See if a cover page is empty or not
 362       (while (and (looking-at "^$") (not (eobp)))
 363         (forward-line))
 364       (if (not (eobp))
 365           ;; The cover page exists.
 366           (setq buffered t)
 367         ;; The cover page doesn't exist.
 368         ;; Remove the cover page entry from the syntax.
 369         (setq syntax (mew-syntax-remove-entry syntax '(1)))
 370         (delete-region beg (point-max))))
 371     (mew-encode-multipart syntax path 0 buffered)))
 372
 373 (defvar mew-default-boundary "--%s(%s_%s)--")
 374
 375 (defun mew-boundary-get (&optional string)
 376   (if (null string) (setq string "Next_Part"))
 377   (format mew-default-boundary
 378           string
 379           (mew-replace-character (current-time-string) 32 ?_)
 380           (mew-random-string)))
 381
 382 (defun mew-encode-multipart (syntax path depth &optional buffered)
 383   (let* ((boundary
 384           (mew-boundary-get ;; 0 is nil for Next_Part
 385            (if (> depth 0) (format "BOUNDARY%s" (int-to-string depth)))))
 386          (fullname (expand-file-name (mew-syntax-get-file syntax) path))
 387          (ctl (mew-syntax-get-ct syntax))
 388          (ct (mew-syntax-get-value ctl 'cap))
 389          (cte (mew-syntax-get-cte syntax))
 390          (cd (mew-syntax-get-cd syntax))
 391          (privacy (mew-syntax-get-privacy syntax))
 392          (len (length syntax))
 393          (cnt mew-syntax-magic)
 394          (beg (point)))
 395     (mew-header-insert mew-ct: (list ct (list "boundary" boundary)))
 396     (mew-header-insert mew-cte: (or cte mew-7bit))
 397     (and cd (mew-header-insert mew-cd: cd))
 398     (while (< cnt len)
 399       (insert (concat "\n--" boundary "\n"))
 400       (if (mew-syntax-multipart-p (aref syntax cnt))
 401           (mew-encode-multipart (aref syntax cnt) fullname (1+ depth))
 402         (mew-encode-singlepart
 403          (aref syntax cnt) fullname (1+ depth)
 404          (if (equal cnt mew-syntax-magic) buffered nil)))
 405       (setq cnt (1+ cnt)))
 406     (insert (concat "\n--" boundary "--\n"))
 407     (if privacy
 408         (mew-encode-security-multipart
 409          beg privacy depth (mew-syntax-get-decrypters syntax)))
 410     (goto-char (point-max))))
 411
 412 ;;;
 413 ;;; Privacy services
 414 ;;;
 415
 416 (defun mew-encode-security-multipart (beg privacy depth decrypters)
 417   (save-restriction
 418     (narrow-to-region beg (point-max))
 419     (let (protocol ct)
 420       (while privacy
 421         (goto-char (point-min))
 422         (setq ct (nth 0 (car privacy)))
 423         (setq protocol (nth 1 (car privacy)))
 424         (setq privacy (cdr privacy))
 425         (cond
 426          ((mew-case-equal mew-ct-mle ct)
 427           (mew-encode-multipart-encrypted ct protocol depth decrypters))
 428          ((mew-case-equal mew-ct-mls ct)
 429           (mew-encode-multipart-signed ct protocol depth)))))))
 430
 431 (defun mew-security-multipart-boundary (depth)
 432    (if depth
 433        (mew-boundary-get (format "Security_Multipart%s" (int-to-string depth)))
 434      (mew-boundary-get "Security_Multipart")))
 435
 436 (defun mew-save-transfer-form (beg end retain)
 437   ;; called in the narrowed region
 438   (let ((sbeg beg) (send end) (draft-buf (current-buffer)) file)
 439     (if retain
 440         (progn
 441           (mew-set-buffer-tmp)
 442           ;; tmp buffer
 443           (insert-buffer-substring draft-buf beg end)
 444           (setq sbeg (point-min) send (point-max))))
 445     (if mew-cs-7bit-crlf
 446         ()
 447       (goto-char sbeg) ;; just in case
 448       (while (search-forward "\n" nil t) (replace-match "\r\n" nil t))
 449       (setq send (point-max)))
 450     (setq file (mew-make-temp-name))
 451     (mew-frwlet
 452      mew-cs-dummy mew-cs-7bit-crlf
 453      (write-region sbeg send file nil 'no-msg))
 454     (if retain
 455         (mew-erase-buffer)
 456       (delete-region sbeg send))
 457     (set-buffer draft-buf)
 458     file)) ;; return value
 459
 460 (defun mew-encode-multipart-encrypted (ct protocol depth decrypters)
 461   ;; called in the narrowed region
 462   (let* ((boundary (mew-security-multipart-boundary depth))
 463          (switch mew-encode-multipart-encrypted-switch) ;; save length
 464          (func (cdr (mew-assoc-case-equal protocol switch 0)))
 465         file1 file2 file3 cte2 cte3 fc error)
 466     (setq decrypters (cons mew-inherit-signer decrypters))
 467     ;; Write the part converting line breaks.
 468     (setq file1 (mew-save-transfer-form (point-min) (point-max) nil))
 469     ;; The narrowed region stores nothing
 470     ;; Call the protocol function
 471     (condition-case nil
 472         (setq fc (funcall func file1 decrypters))
 473       (error
 474        (if (file-exists-p file1) (delete-file file1))
 475        (error "unknown error for %s. Check %s, anyway"
 476               mew-ct-mle mew-temp-dir)))
 477     (setq file2 (nth 0 fc) cte2 (nth 1 fc) file3 (nth 2 fc) cte3 (nth 3 fc))
 478     (setq error (nth 4 fc))
 479     (if error
 480         (progn
 481           (if (file-exists-p file1) (delete-file file1))
 482           (if (file-exists-p file2) (delete-file file2))
 483           (if (file-exists-p file3) (delete-file file3))
 484           (mew-draft-undo)
 485           (setq mew-draft-privacy-error t)
 486           (error error))
 487       ;; Create multipart content-header
 488       (mew-header-insert mew-ct: (list ct
 489                                        (list "protocol" protocol)
 490                                        (list "boundary" boundary)))
 491       (insert (format "\n--%s\n" boundary))
 492       ;; Insert control keys
 493       (mew-encode-singlepart
 494        (mew-encode-syntax-single file2 (list protocol) cte2))
 495       (insert (format "\n--%s\n" boundary))
 496       ;; Insert encrpted body
 497       (mew-encode-singlepart
 498        (mew-encode-syntax-single file3 mew-type-apo cte3))
 499       (insert (format "\n--%s--\n" boundary))
 500       ;; Throw away the garbage
 501       (if (file-exists-p file1) (delete-file file1))
 502       (if (file-exists-p file2) (delete-file file2))
 503       (if (file-exists-p file3) (delete-file file3)))))
 504
 505 (defun mew-encode-multipart-signed (ct protocol depth)
 506   ;; called in the narrowed region
 507   (let* ((boundary (mew-security-multipart-boundary depth))
 508          (switch mew-encode-multipart-signed-switch);; save length
 509          (func (cdr (mew-assoc-case-equal protocol switch 0)))
 510          file1 file2 micalg cte2 fmc error)
 511     (setq file1 (mew-save-transfer-form (point-min) (point-max) 'retain))
 512     ;; The narrowed region still the ORIGINAL part (i.e. line breaks are LF)
 513     ;; Call the protocol function
 514     (condition-case nil
 515         (setq fmc (funcall func file1))
 516       (error
 517        (if (file-exists-p file1) (delete-file file1))
 518        (error "unknown error for %s. Check %s, anyway"
 519               mew-ct-mls mew-temp-dir)))
 520     (setq file2 (nth 0 fmc) cte2 (nth 1 fmc) micalg (nth 2 fmc))
 521     (setq error (nth 3 fmc))
 522     (if error
 523         (progn
 524           (if (file-exists-p file1) (delete-file file1))
 525           (if (file-exists-p file2) (delete-file file2))
 526           (mew-draft-undo)
 527           (setq mew-draft-privacy-error t)
 528           (error error))
 529       (goto-char (point-min))
 530       ;; Before the signed part
 531       ;; Create multipart content-header
 532       (mew-header-insert mew-ct: (list ct
 533                                        (list "protocol" protocol)
 534                                        (list "micalg" micalg)
 535                                        (list "boundary" boundary)))
 536       (insert (format "\n--%s\n" boundary))
 537       (goto-char (point-max))
 538       ;; After the sigend part
 539       (insert (format "\n--%s\n" boundary))
 540       (mew-encode-singlepart
 541        (mew-encode-syntax-single file2 (list protocol) cte2))
 542       (insert (format "\n--%s--\n" boundary))
 543       ;; Throw away the garbage
 544       (if (file-exists-p file1) (delete-file file1))
 545       (if (file-exists-p file2) (delete-file file2)))))
 546
 547 ;;;
 548 ;;; backup and undo
 549 ;;;
 550
 551 (defun mew-draft-make-backup (&optional single)
 552   ;; back up the draft and its syntax
 553   (let* ((attachdir (mew-attachdir))
 554          (backup-file (expand-file-name mew-draft-backup-file attachdir))
 555          (syntax-file (expand-file-name mew-draft-syntax-file attachdir))
 556          (syntax mew-encode-syntax)) ;; mew-encode-syntax is buffer local
 557     (if (not (file-exists-p attachdir)) (mew-make-directory attachdir)) ;;for single part
 558     (mew-frwlet
 559      mew-cs-dummy mew-cs-draft
 560      (write-region (point-min) (point-max) backup-file nil 'no-msg))
 561     (if (not single)
 562         (save-excursion
 563           (mew-set-buffer-tmp)
 564           (prin1 syntax (current-buffer)) ;; different buffer, so use syntax
 565           (terpri (current-buffer))
 566           (mew-frwlet
 567            mew-cs-dummy mew-cs-draft
 568            (write-region (point-min) (point-max) syntax-file nil 'no-msg))))))
 569
 570 (defun mew-draft-undo ()
 571   "Get back to the draft before making MIME message."
 572   (interactive)
 573   (mew-elet
 574    (let* ((attachdir (mew-attachdir))
 575           (backup-file (expand-file-name mew-draft-backup-file attachdir))
 576           (syntax-file (expand-file-name mew-draft-syntax-file attachdir))
 577           (syntax nil))
 578      (if (not (file-exists-p backup-file))
 579          (message "Can't undo")
 580        (mew-erase-buffer)
 581        (mew-frwlet
 582         mew-cs-draft mew-cs-dummy
 583         (insert-file-contents backup-file))
 584        (delete-file backup-file)
 585        ;;
 586        (mew-header-clear) ;; erase the old header separator
 587        (mew-header-prepared)
 588        (if (not (file-exists-p syntax-file))
 589            () ;; single
 590          (save-excursion
 591            (mew-frwlet
 592             mew-cs-draft mew-cs-dummy
 593             (find-file-read-only syntax-file))
 594            (goto-char (point-min))
 595            (setq syntax (read (current-buffer)))
 596            (kill-buffer (current-buffer)))
 597          (setq mew-encode-syntax syntax) ;; buffer local
 598          (mew-draft-prepare-attachments)
 599          (delete-file syntax-file))
 600        (mew-draft-toolbar-update)
 601        (setq buffer-undo-list nil)))))
 602
 603 (provide 'mew-encode)
 604
 605 ;;; Copyright Notice:
 606
 607 ;; Copyright (C) 1996, 1997, 1998, 1999 Mew developing team.
 608 ;; All rights reserved.
 609
 610 ;; Redistribution and use in source and binary forms, with or without
 611 ;; modification, are permitted provided that the following conditions
 612 ;; are met:
 613 ;;
 614 ;; 1. Redistributions of source code must retain the above copyright
 615 ;;    notice, this list of conditions and the following disclaimer.
 616 ;; 2. Redistributions in binary form must reproduce the above copyright
 617 ;;    notice, this list of conditions and the following disclaimer in the
 618 ;;    documentation and/or other materials provided with the distribution.
 619 ;; 3. Neither the name of the team nor the names of its contributors
 620 ;;    may be used to endorse or promote products derived from this software
 621 ;;    without specific prior written permission.
 622 ;;
 623 ;; THIS SOFTWARE IS PROVIDED BY THE TEAM AND CONTRIBUTORS ``AS IS'' AND
 624 ;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
 625 ;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
 626 ;; PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE TEAM OR CONTRIBUTORS BE
 627 ;; LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
 628 ;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
 629 ;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
 630 ;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
 631 ;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
 632 ;; OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
 633 ;; IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 634
 635 ;;; mew-encode.el ends here