mime/eword-encode.el

   1 ;;; eword-encode.el --- RFC 2047 based encoded-word encoder for GNU Emacs
   2
   3 ;; Copyright (C) 1995,1996,1997,1998,1999,2000 Free Software Foundation, Inc.
   4
   5 ;; Author: MORIOKA Tomohiko <tomo@m17n.org>
   6 ;; Keywords: encoded-word, MIME, multilingual, header, mail, news
   7
   8 ;; This file is part of FLIM (Faithful Library about Internet Message).
   9
  10 ;; This program is free software; you can redistribute it and/or
  11 ;; modify it under the terms of the GNU General Public License as
  12 ;; published by the Free Software Foundation; either version 2, or (at
  13 ;; your option) any later version.
  14
  15 ;; This program is distributed in the hope that it will be useful, but
  16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  18 ;; General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24
  25 ;;; Code:
  26
  27 (require 'mime-def)
  28 (require 'mel)
  29 (require 'std11)
  30 (require 'eword-decode)
  31
  32
  33 ;;; @ variables
  34 ;;;
  35
  36 ;; User options are defined in mime-def.el.
  37
  38 (defvar mime-header-charset-encoding-alist
  39   '((us-ascii           . nil)
  40     (iso-8859-1         . "Q")
  41     (iso-8859-2         . "Q")
  42     (iso-8859-3         . "Q")
  43     (iso-8859-4         . "Q")
  44     (iso-8859-5         . "Q")
  45     (koi8-r             . "Q")
  46     (iso-8859-7         . "Q")
  47     (iso-8859-8         . "Q")
  48     (iso-8859-9         . "Q")
  49     (iso-2022-jp        . "B")
  50     (iso-2022-jp-3      . "B")
  51     (iso-2022-kr        . "B")
  52     (gb2312             . "B")
  53     (cn-gb              . "B")
  54     (cn-gb-2312         . "B")
  55     (euc-kr             . "B")
  56     (tis-620            . "B")
  57     (iso-2022-jp-2      . "B")
  58     (iso-2022-int-1     . "B")
  59     (utf-8              . "B")
  60     ))
  61
  62 (defvar mime-header-default-charset-encoding "Q")
  63
  64 (defvar mime-header-encode-method-alist
  65   '((eword-encode-address-list
  66      . (Reply-To
  67         From Sender
  68         Resent-Reply-To Resent-From
  69         Resent-Sender To Resent-To
  70         Cc Resent-Cc Bcc Resent-Bcc
  71         Dcc))
  72     (eword-encode-in-reply-to . (In-Reply-To))
  73     (eword-encode-structured-field-body . (Mime-Version User-Agent))
  74     (eword-encode-unstructured-field-body)))
  75
  76 ;;; @ encoded-text encoder
  77 ;;;
  78
  79 (defun eword-encode-text (charset encoding string &optional mode)
  80   "Encode STRING as an encoded-word, and return the result.
  81 CHARSET is a symbol to indicate MIME charset of the encoded-word.
  82 ENCODING allows \"B\" or \"Q\".
  83 MODE is allows `text', `comment', `phrase' or nil.  Default value is
  84 `phrase'."
  85   (let ((text (encoded-text-encode-string string encoding mode)))
  86     (if text
  87         (concat "=?" (upcase (symbol-name charset)) "?"
  88                 encoding "?" text "?=")
  89       )))
  90
  91
  92 ;;; @ charset word
  93 ;;;
  94
  95 (defsubst eword-encode-char-type (character)
  96   (if (memq character '(?  ?\t ?\n))
  97       nil
  98     (char-charset character)
  99     ))
 100
 101 (defun eword-encode-divide-into-charset-words (string)
 102   (let ((len (length string))
 103         dest)
 104     (while (> len 0)
 105       (let* ((chr (aref string 0))
 106              ;; (chr (sref string 0))
 107              (charset (eword-encode-char-type chr))
 108              (i 1)
 109              ;; (i (char-length chr))
 110              )
 111         (while (and (< i len)
 112                     (setq chr (aref string i))
 113                     ;; (setq chr (sref string i))
 114                     (eq charset (eword-encode-char-type chr)))
 115           (setq i (1+ i))
 116           ;; (setq i (char-next-index chr i))
 117           )
 118         (setq dest (cons (cons charset (substring string 0 i)) dest)
 119               string (substring string i)
 120               len (- len i))))
 121     (nreverse dest)))
 122
 123
 124 ;;; @ word
 125 ;;;
 126
 127 (defun eword-encode-charset-words-to-words (charset-words)
 128   (let (dest)
 129     (while charset-words
 130       (let* ((charset-word (car charset-words))
 131              (charset (car charset-word))
 132              )
 133         (if charset
 134             (let ((charsets (list charset))
 135                   (str (cdr charset-word))
 136                   )
 137               (catch 'tag
 138                 (while (setq charset-words (cdr charset-words))
 139                   (setq charset-word (car charset-words)
 140                         charset (car charset-word))
 141                   (if (null charset)
 142                       (throw 'tag nil)
 143                     )
 144                   (or (memq charset charsets)
 145                       (setq charsets (cons charset charsets))
 146                       )
 147                   (setq str (concat str (cdr charset-word)))
 148                   ))
 149               (setq dest (cons (cons charsets str) dest))
 150               )
 151           (setq dest (cons charset-word dest)
 152                 charset-words (cdr charset-words)
 153                 ))))
 154     (nreverse dest)
 155     ))
 156
 157
 158 ;;; @ rule
 159 ;;;
 160
 161 (defmacro make-ew-rword (text charset encoding type)
 162   (` (list (, text)(, charset)(, encoding)(, type))))
 163 (defmacro ew-rword-text (rword)
 164   (` (car (, rword))))
 165 (defmacro ew-rword-charset (rword)
 166   (` (car (cdr (, rword)))))
 167 (defmacro ew-rword-encoding (rword)
 168   (` (car (cdr (cdr (, rword))))))
 169 (defmacro ew-rword-type (rword)
 170   (` (car (cdr (cdr (cdr (, rword)))))))
 171
 172 (defun ew-find-charset-rule (charsets)
 173   (if charsets
 174       (let* ((charset (find-mime-charset-by-charsets charsets))
 175              (encoding
 176               (cdr (or (assq charset mime-header-charset-encoding-alist)
 177                        (cons charset mime-header-default-charset-encoding)))))
 178         (list charset encoding))))
 179
 180 (defun tm-eword::words-to-ruled-words (wl &optional mode)
 181   (mapcar (function
 182            (lambda (word)
 183              (let ((ret (ew-find-charset-rule (car word))))
 184                (make-ew-rword (cdr word) (car ret)(nth 1 ret) mode)
 185                )))
 186           wl))
 187
 188 (defun ew-space-process (seq)
 189   (let (prev a ac b c cc)
 190     (while seq
 191       (setq b (car seq))
 192       (setq seq (cdr seq))
 193       (setq c (car seq))
 194       (setq cc (ew-rword-charset c))
 195       (if (and (null (ew-rword-charset b))
 196                (not (eq (ew-rword-type b) 'special)))
 197           (progn
 198             (setq a (car prev))
 199             (setq ac (ew-rword-charset a))
 200             (if (and (ew-rword-encoding a)
 201                      (ew-rword-encoding c))
 202                 (cond ((eq ac cc)
 203                        (setq prev (cons
 204                                    (cons (concat (car a)(car b)(car c))
 205                                          (cdr a))
 206                                    (cdr prev)
 207                                    ))
 208                        (setq seq (cdr seq))
 209                        )
 210                       (t
 211                        (setq prev (cons
 212                                    (cons (concat (car a)(car b))
 213                                          (cdr a))
 214                                    (cdr prev)
 215                                    ))
 216                        ))
 217               (setq prev (cons b prev))
 218               ))
 219         (setq prev (cons b prev))
 220         ))
 221     (reverse prev)
 222     ))
 223
 224 (defun eword-encode-split-string (str &optional mode)
 225   (ew-space-process
 226    (tm-eword::words-to-ruled-words
 227     (eword-encode-charset-words-to-words
 228      (eword-encode-divide-into-charset-words str))
 229     mode)))
 230
 231
 232 ;;; @ length
 233 ;;;
 234
 235 (defun tm-eword::encoded-word-length (rword)
 236   (let ((string   (ew-rword-text     rword))
 237         (charset  (ew-rword-charset  rword))
 238         (encoding (ew-rword-encoding rword))
 239         ret)
 240     (setq ret
 241           (cond ((string-equal encoding "B")
 242                  (setq string (encode-mime-charset-string string charset))
 243                  (base64-encoded-length string)
 244                  )
 245                 ((string-equal encoding "Q")
 246                  (setq string (encode-mime-charset-string string charset))
 247                  (Q-encoded-text-length string (ew-rword-type rword))
 248                  )))
 249     (if ret
 250         (cons (+ 7 (length (symbol-name charset)) ret) string)
 251       )))
 252
 253
 254 ;;; @ encode-string
 255 ;;;
 256
 257 (defun ew-encode-rword-1 (column rwl &optional must-output)
 258   (catch 'can-not-output
 259     (let* ((rword (car rwl))
 260            (ret (tm-eword::encoded-word-length rword))
 261            string len)
 262       (if (null ret)
 263           (cond ((and (setq string (car rword))
 264                       (or (<= (setq len (+ (length string) column)) 76)
 265                           (<= column 1))
 266                       )
 267                  (setq rwl (cdr rwl))
 268                  )
 269                 ((memq (aref string 0) '(?  ?\t))
 270                  (setq string (concat "\n" string)
 271                        len (length string)
 272                        rwl (cdr rwl))
 273                  )
 274                 (must-output
 275                  (setq string "\n "
 276                        len 1)
 277                  )
 278                 (t
 279                  (throw 'can-not-output nil)
 280                  ))
 281         (cond ((and (setq len (car ret))
 282                     (<= (+ column len) 76)
 283                     )
 284                (setq string
 285                      (eword-encode-text
 286                       (ew-rword-charset rword)
 287                       (ew-rword-encoding rword)
 288                       (cdr ret)
 289                       (ew-rword-type rword)
 290                       ))
 291                (setq len (+ (length string) column))
 292                (setq rwl (cdr rwl))
 293                )
 294               (t
 295                (setq string (car rword))
 296                (let* ((p 0) np
 297                       (str "") nstr)
 298                  (while (and (< p len)
 299                              (progn
 300                                (setq np (1+ p))
 301                                ;;(setq np (char-next-index (sref string p) p))
 302                                (setq nstr (substring string 0 np))
 303                                (setq ret (tm-eword::encoded-word-length
 304                                           (cons nstr (cdr rword))
 305                                           ))
 306                                (setq nstr (cdr ret))
 307                                (setq len (+ (car ret) column))
 308                                (<= len 76)
 309                                ))
 310                    (setq str nstr
 311                          p np))
 312                  (if (string-equal str "")
 313                      (if must-output
 314                          (setq string "\n "
 315                                len 1)
 316                        (throw 'can-not-output nil))
 317                    (setq rwl (cons (cons (substring string p) (cdr rword))
 318                                    (cdr rwl)))
 319                    (setq string
 320                          (eword-encode-text
 321                           (ew-rword-charset rword)
 322                           (ew-rword-encoding rword)
 323                           str
 324                           (ew-rword-type rword)))
 325                    (setq len (+ (length string) column))
 326                    )
 327                  )))
 328         )
 329       (list string len rwl)
 330       )))
 331
 332 (defun eword-encode-rword-list (column rwl)
 333   (let (ret dest str ew-f pew-f folded-points)
 334     (while rwl
 335       (setq ew-f (nth 2 (car rwl)))
 336       (if (and pew-f ew-f)
 337           (setq rwl (cons '(" ") rwl)
 338                 pew-f nil)
 339         (setq pew-f ew-f)
 340         )
 341       (if (null (setq ret (ew-encode-rword-1 column rwl)))
 342           (let ((i (1- (length dest)))
 343                 c s r-dest r-column)
 344             (catch 'success
 345               (while (catch 'found
 346                        (while (>= i 0)
 347                          (cond ((memq (setq c (aref dest i)) '(?  ?\t))
 348                                 (if (memq i folded-points)
 349                                     (throw 'found nil)
 350                                   (setq folded-points (cons i folded-points))
 351                                   (throw 'found i))
 352                                 )
 353                                ((eq c ?\n)
 354                                 (throw 'found nil)
 355                                 ))
 356                          (setq i (1- i))))
 357                 (setq s (substring dest i)
 358                       r-column (length s)
 359                       r-dest (concat (substring dest 0 i) "\n" s))
 360                 (when (setq ret (ew-encode-rword-1 r-column rwl))
 361                   (setq dest r-dest
 362                         column r-column)
 363                   (throw 'success t)
 364                   ))
 365               (setq ret (ew-encode-rword-1 column rwl 'must-output))
 366               )))
 367       (setq str (car ret))
 368       (setq dest (concat dest str))
 369       (setq column (nth 1 ret)
 370             rwl (nth 2 ret))
 371       )
 372     (list dest column)
 373     ))
 374
 375
 376 ;;; @ converter
 377 ;;;
 378
 379 (defun eword-encode-phrase-to-rword-list (phrase)
 380   (let (token type dest str)
 381     (while phrase
 382       (setq token (car phrase))
 383       (setq type (car token))
 384       (cond ((eq type 'quoted-string)
 385              (setq str (concat "\"" (cdr token) "\""))
 386              (setq dest
 387                    (append dest
 388                            (list
 389                             (let ((ret (ew-find-charset-rule
 390                                         (find-charset-string str))))
 391                               (make-ew-rword
 392                                str (car ret)(nth 1 ret) 'phrase)
 393                               )
 394                             )))
 395              )
 396             ((eq type 'comment)
 397              (setq dest
 398                    (append dest
 399                            '(("(" nil nil special))
 400                            (tm-eword::words-to-ruled-words
 401                             (eword-encode-charset-words-to-words
 402                              (eword-encode-divide-into-charset-words
 403                               (cdr token)))
 404                             'comment)
 405                            '((")" nil nil special))
 406                            ))
 407              )
 408             (t
 409              (setq dest
 410                    (append dest
 411                            (tm-eword::words-to-ruled-words
 412                             (eword-encode-charset-words-to-words
 413                              (eword-encode-divide-into-charset-words
 414                               (cdr token))
 415                              ) 'phrase)))
 416              ))
 417       (setq phrase (cdr phrase))
 418       )
 419     (ew-space-process dest)
 420     ))
 421
 422 (defun eword-encode-addr-seq-to-rword-list (seq)
 423   (let (dest pname)
 424     (while seq
 425       (let* ((token (car seq))
 426              (name (car token))
 427              )
 428         (cond ((eq name 'spaces)
 429                (setq dest (nconc dest (list (list (cdr token) nil nil))))
 430                )
 431               ((eq name 'comment)
 432                (setq dest
 433                      (nconc
 434                       dest
 435                       (list (list "(" nil nil))
 436                       (eword-encode-split-string (cdr token) 'comment)
 437                       (list (list ")" nil nil))
 438                       ))
 439                )
 440               ((eq name 'quoted-string)
 441                (setq dest
 442                      (nconc
 443                       dest
 444                       (list
 445                        (list (concat "\"" (cdr token) "\"") nil nil)
 446                        )))
 447                )
 448               (t
 449                (setq dest
 450                      (if (or (eq pname 'spaces)
 451                              (eq pname 'comment))
 452                          (nconc dest (list (list (cdr token) nil nil)))
 453                        (nconc (nreverse (cdr (reverse dest)))
 454                               ;; (butlast dest)
 455                               (list
 456                                (list (concat (car (car (last dest)))
 457                                              (cdr token))
 458                                      nil nil)))))
 459                ))
 460         (setq seq (cdr seq)
 461               pname name))
 462       )
 463     dest))
 464
 465 (defun eword-encode-phrase-route-addr-to-rword-list (phrase-route-addr)
 466   (if (eq (car phrase-route-addr) 'phrase-route-addr)
 467       (let ((phrase (nth 1 phrase-route-addr))
 468             (route (nth 2 phrase-route-addr))
 469             dest)
 470         ;; (if (eq (car (car phrase)) 'spaces)
 471         ;;     (setq phrase (cdr phrase))
 472         ;;   )
 473         (setq dest (eword-encode-phrase-to-rword-list phrase))
 474         (if dest
 475             (setq dest (append dest '((" " nil nil))))
 476           )
 477         (append
 478          dest
 479          (eword-encode-addr-seq-to-rword-list
 480           (append '((specials . "<"))
 481                   route
 482                   '((specials . ">"))))
 483          ))))
 484
 485 (defun eword-encode-addr-spec-to-rword-list (addr-spec)
 486   (if (eq (car addr-spec) 'addr-spec)
 487       (eword-encode-addr-seq-to-rword-list (cdr addr-spec))
 488     ))
 489
 490 (defun eword-encode-mailbox-to-rword-list (mbox)
 491   (let ((addr (nth 1 mbox))
 492         (comment (nth 2 mbox))
 493         dest)
 494     (setq dest (or (eword-encode-phrase-route-addr-to-rword-list addr)
 495                    (eword-encode-addr-spec-to-rword-list addr)
 496                    ))
 497     (if comment
 498         (setq dest
 499               (append dest
 500                       '((" " nil nil)
 501                         ("(" nil nil))
 502                       (eword-encode-split-string comment 'comment)
 503                       (list '(")" nil nil))
 504                       )))
 505     dest))
 506
 507 (defsubst eword-encode-mailboxes-to-rword-list (mboxes)
 508   (let ((dest (eword-encode-mailbox-to-rword-list (car mboxes))))
 509     (if dest
 510         (while (setq mboxes (cdr mboxes))
 511           (setq dest
 512                 (nconc dest
 513                        (list '("," nil nil))
 514                        (eword-encode-mailbox-to-rword-list
 515                         (car mboxes))))))
 516     dest))
 517
 518 (defsubst eword-encode-address-to-rword-list (address)
 519   (cond
 520    ((eq (car address) 'mailbox)
 521     (eword-encode-mailbox-to-rword-list address))
 522    ((eq (car address) 'group)
 523     (nconc
 524      (eword-encode-phrase-to-rword-list (nth 1 address))
 525      (list (list ":" nil nil))
 526      (eword-encode-mailboxes-to-rword-list (nth 2 address))
 527      (list (list ";" nil nil))))))
 528
 529 (defsubst eword-encode-addresses-to-rword-list (addresses)
 530   (let ((dest (eword-encode-address-to-rword-list (car addresses))))
 531     (if dest
 532         (while (setq addresses (cdr addresses))
 533           (setq dest
 534                 (nconc dest
 535                        (list '("," nil nil))
 536                        ;; (list '(" " nil nil))
 537                        (eword-encode-address-to-rword-list (car addresses))))))
 538     dest))
 539
 540 (defsubst eword-encode-msg-id-to-rword-list (msg-id)
 541   (list
 542    (list
 543     (concat "<"
 544             (caar (eword-encode-addr-seq-to-rword-list (cdr msg-id)))
 545             ">")
 546     nil nil)))
 547
 548 (defsubst eword-encode-in-reply-to-to-rword-list (in-reply-to)
 549   (let (dest)
 550     (while in-reply-to
 551       (setq dest
 552             (append dest
 553                     (let ((elt (car in-reply-to)))
 554                       (if (eq (car elt) 'phrase)
 555                           (eword-encode-phrase-to-rword-list (cdr elt))
 556                         (eword-encode-msg-id-to-rword-list elt)
 557                         ))))
 558       (setq in-reply-to (cdr in-reply-to)))
 559     dest))
 560
 561
 562 ;;; @ application interfaces
 563 ;;;
 564
 565 (defvar eword-encode-default-start-column 10
 566   "Default start column if it is omitted.")
 567
 568 (defun eword-encode-string (string &optional column mode)
 569   "Encode STRING as encoded-words, and return the result.
 570 Optional argument COLUMN is start-position of the field.
 571 Optional argument MODE allows `text', `comment', `phrase' or nil.
 572 Default value is `phrase'."
 573   (car (eword-encode-rword-list
 574         (or column eword-encode-default-start-column)
 575         (eword-encode-split-string string mode))))
 576
 577 (defun eword-encode-address-list (string &optional column)
 578   "Encode header field STRING as list of address, and return the result.
 579 Optional argument COLUMN is start-position of the field."
 580   (car (eword-encode-rword-list
 581         (or column eword-encode-default-start-column)
 582         (eword-encode-addresses-to-rword-list
 583          (std11-parse-addresses-string string))
 584         )))
 585
 586 (defun eword-encode-in-reply-to (string &optional column)
 587   "Encode header field STRING as In-Reply-To field, and return the result.
 588 Optional argument COLUMN is start-position of the field."
 589   (car (eword-encode-rword-list
 590         (or column 13)
 591         (eword-encode-in-reply-to-to-rword-list
 592          (std11-parse-msg-ids-string string)))))
 593
 594 (defun eword-encode-structured-field-body (string &optional column)
 595   "Encode header field STRING as structured field, and return the result.
 596 Optional argument COLUMN is start-position of the field."
 597   (car (eword-encode-rword-list
 598         (or column eword-encode-default-start-column)
 599         (eword-encode-addr-seq-to-rword-list (std11-lexical-analyze string))
 600         )))
 601
 602 (defun eword-encode-unstructured-field-body (string &optional column)
 603   "Encode header field STRING as unstructured field, and return the result.
 604 Optional argument COLUMN is start-position of the field."
 605   (car (eword-encode-rword-list
 606         (or column eword-encode-default-start-column)
 607         (eword-encode-split-string string 'text))))
 608
 609 ;;;###autoload
 610 (defun mime-encode-field-body (field-body field-name)
 611   "Encode FIELD-BODY as FIELD-NAME, and return the result.
 612 A lexical token includes non-ASCII character is encoded as MIME
 613 encoded-word.  ASCII token is not encoded."
 614   (setq field-body (std11-unfold-string field-body))
 615   (if (string= field-body "")
 616       ""
 617     (let ((method-alist mime-header-encode-method-alist)
 618           start ret)
 619       (if (symbolp field-name)
 620           (setq start (1+ (length (symbol-name field-name))))
 621         (setq start (1+ (length field-name))
 622               field-name (intern (capitalize field-name))))
 623       (while (car method-alist)
 624         (if (or (not (cdr (car method-alist)))
 625                 (memq field-name
 626                       (cdr (car method-alist))))
 627             (progn
 628               (setq ret
 629                     (apply (caar method-alist) (list field-body start)))
 630               (setq method-alist nil)))
 631         (setq method-alist (cdr method-alist)))
 632       ret)))
 633 (defalias 'eword-encode-field-body 'mime-encode-field-body)
 634 (make-obsolete 'eword-encode-field-body 'mime-encode-field-body)
 635
 636 (defun eword-in-subject-p ()
 637   (let ((str (std11-field-body "Subject")))
 638     (if (and str (string-match eword-encoded-word-regexp str))
 639         str)))
 640 (make-obsolete 'eword-in-subject-p "Don't use it.")
 641
 642 (defsubst eword-find-field-encoding-method (field-name)
 643   (setq field-name (downcase field-name))
 644   (let ((alist mime-field-encoding-method-alist))
 645     (catch 'found
 646       (while alist
 647         (let* ((pair (car alist))
 648                (str (car pair)))
 649           (if (and (stringp str)
 650                    (string= field-name (downcase str)))
 651               (throw 'found (cdr pair))
 652             ))
 653         (setq alist (cdr alist)))
 654       (cdr (assq t mime-field-encoding-method-alist))
 655       )))
 656
 657 ;;;###autoload
 658 (defun mime-encode-header-in-buffer (&optional code-conversion)
 659   "Encode header fields to network representation, such as MIME encoded-word.
 660
 661 It refer variable `mime-field-encoding-method-alist'."
 662   (interactive "*")
 663   (save-excursion
 664     (save-restriction
 665       (std11-narrow-to-header mail-header-separator)
 666       (goto-char (point-min))
 667       (let ((default-cs (mime-charset-to-coding-system default-mime-charset))
 668             bbeg end field-name)
 669         (while (re-search-forward std11-field-head-regexp nil t)
 670           (setq bbeg (match-end 0)
 671                 field-name (buffer-substring (match-beginning 0) (1- bbeg))
 672                 end (std11-field-end))
 673           (and (delq 'ascii (find-charset-region bbeg end))
 674                (let ((method (eword-find-field-encoding-method
 675                               (downcase field-name))))
 676                  (cond ((eq method 'mime)
 677                         (let* ((field-body
 678                                (buffer-substring-no-properties bbeg end))
 679                                (encoded-body
 680                                 (mime-encode-field-body
 681                                  field-body field-name)))
 682                           (if (not encoded-body)
 683                               (error "Cannot encode %s:%s"
 684                                      field-name field-body)
 685                             (delete-region bbeg end)
 686                             (insert encoded-body))))
 687                        (code-conversion
 688                         (let ((cs
 689                                (or (mime-charset-to-coding-system
 690                                     method)
 691                                    default-cs)))
 692                           (encode-coding-region bbeg end cs)
 693                           )))
 694                  ))
 695           ))
 696       )))
 697 (defalias 'eword-encode-header 'mime-encode-header-in-buffer)
 698 (make-obsolete 'eword-encode-header 'mime-encode-header-in-buffer)
 699
 700
 701 ;;; @ end
 702 ;;;
 703
 704 (provide 'eword-encode)
 705
 706 ;;; eword-encode.el ends here