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 ;; [tomo:2002-11-05] The following code is a quick-fix for emacsen
 181 ;; which is not depended on the Mule model.  We should redesign
 182 ;; `eword-encode-split-string' to avoid to depend on the Mule model.
 183 (if (featurep 'utf-2000)
 184 ;; for CHISE Architecture
 185 (defun tm-eword::words-to-ruled-words (wl &optional mode)
 186   (let (mcs)
 187     (mapcar (function
 188              (lambda (word)
 189                (setq mcs (detect-mime-charset-string (cdr word)))
 190                (make-ew-rword
 191                 (cdr word)
 192                 mcs
 193                 (cdr (or (assq mcs mime-header-charset-encoding-alist)
 194                          (cons mcs mime-header-default-charset-encoding)))
 195                 mode)
 196                ))
 197             wl)))
 198
 199 ;; for legacy Mule
 200 (defun tm-eword::words-to-ruled-words (wl &optional mode)
 201   (mapcar (function
 202            (lambda (word)
 203              (let ((ret (ew-find-charset-rule (car word))))
 204                (make-ew-rword (cdr word) (car ret)(nth 1 ret) mode)
 205                )))
 206           wl))
 207 )
 208
 209 (defun ew-space-process (seq)
 210   (let (prev a ac b c cc)
 211     (while seq
 212       (setq b (car seq))
 213       (setq seq (cdr seq))
 214       (setq c (car seq))
 215       (setq cc (ew-rword-charset c))
 216       (if (and (null (ew-rword-charset b))
 217                (not (eq (ew-rword-type b) 'special)))
 218           (progn
 219             (setq a (car prev))
 220             (setq ac (ew-rword-charset a))
 221             (if (and (ew-rword-encoding a)
 222                      (ew-rword-encoding c))
 223                 (cond ((eq ac cc)
 224                        (setq prev (cons
 225                                    (cons (concat (car a)(car b)(car c))
 226                                          (cdr a))
 227                                    (cdr prev)
 228                                    ))
 229                        (setq seq (cdr seq))
 230                        )
 231                       (t
 232                        (setq prev (cons
 233                                    (cons (concat (car a)(car b))
 234                                          (cdr a))
 235                                    (cdr prev)
 236                                    ))
 237                        ))
 238               (setq prev (cons b prev))
 239               ))
 240         (setq prev (cons b prev))
 241         ))
 242     (reverse prev)
 243     ))
 244
 245 (defun eword-encode-split-string (str &optional mode)
 246   (ew-space-process
 247    (tm-eword::words-to-ruled-words
 248     (eword-encode-charset-words-to-words
 249      (eword-encode-divide-into-charset-words str))
 250     mode)))
 251
 252
 253 ;;; @ length
 254 ;;;
 255
 256 (defun tm-eword::encoded-word-length (rword)
 257   (let ((string   (ew-rword-text     rword))
 258         (charset  (ew-rword-charset  rword))
 259         (encoding (ew-rword-encoding rword))
 260         ret)
 261     (setq ret
 262           (cond ((string-equal encoding "B")
 263                  (setq string (encode-mime-charset-string string charset))
 264                  (base64-encoded-length string)
 265                  )
 266                 ((string-equal encoding "Q")
 267                  (setq string (encode-mime-charset-string string charset))
 268                  (Q-encoded-text-length string (ew-rword-type rword))
 269                  )))
 270     (if ret
 271         (cons (+ 7 (length (symbol-name charset)) ret) string)
 272       )))
 273
 274
 275 ;;; @ encode-string
 276 ;;;
 277
 278 (defun ew-encode-rword-1 (column rwl &optional must-output)
 279   (catch 'can-not-output
 280     (let* ((rword (car rwl))
 281            (ret (tm-eword::encoded-word-length rword))
 282            string len)
 283       (if (null ret)
 284           (cond ((and (setq string (car rword))
 285                       (or (<= (setq len (+ (length string) column)) 76)
 286                           (<= column 1))
 287                       )
 288                  (setq rwl (cdr rwl))
 289                  )
 290                 ((memq (aref string 0) '(?  ?\t))
 291                  (setq string (concat "\n" string)
 292                        len (length string)
 293                        rwl (cdr rwl))
 294                  )
 295                 (must-output
 296                  (setq string "\n "
 297                        len 1)
 298                  )
 299                 (t
 300                  (throw 'can-not-output nil)
 301                  ))
 302         (cond ((and (setq len (car ret))
 303                     (<= (+ column len) 76)
 304                     )
 305                (setq string
 306                      (eword-encode-text
 307                       (ew-rword-charset rword)
 308                       (ew-rword-encoding rword)
 309                       (cdr ret)
 310                       (ew-rword-type rword)
 311                       ))
 312                (setq len (+ (length string) column))
 313                (setq rwl (cdr rwl))
 314                )
 315               (t
 316                (setq string (car rword))
 317                (let* ((p 0) np
 318                       (str "") nstr)
 319                  (while (and (< p len)
 320                              (progn
 321                                (setq np (1+ p))
 322                                ;;(setq np (char-next-index (sref string p) p))
 323                                (setq nstr (substring string 0 np))
 324                                (setq ret (tm-eword::encoded-word-length
 325                                           (cons nstr (cdr rword))
 326                                           ))
 327                                (setq nstr (cdr ret))
 328                                (setq len (+ (car ret) column))
 329                                (<= len 76)
 330                                ))
 331                    (setq str nstr
 332                          p np))
 333                  (if (string-equal str "")
 334                      (if must-output
 335                          (setq string "\n "
 336                                len 1)
 337                        (throw 'can-not-output nil))
 338                    (setq rwl (cons (cons (substring string p) (cdr rword))
 339                                    (cdr rwl)))
 340                    (setq string
 341                          (eword-encode-text
 342                           (ew-rword-charset rword)
 343                           (ew-rword-encoding rword)
 344                           str
 345                           (ew-rword-type rword)))
 346                    (setq len (+ (length string) column))
 347                    )
 348                  )))
 349         )
 350       (list string len rwl)
 351       )))
 352
 353 (defun eword-encode-rword-list (column rwl)
 354   (let (ret dest str ew-f pew-f folded-points)
 355     (while rwl
 356       (setq ew-f (nth 2 (car rwl)))
 357       (if (and pew-f ew-f)
 358           (setq rwl (cons '(" ") rwl)
 359                 pew-f nil)
 360         (setq pew-f ew-f)
 361         )
 362       (if (null (setq ret (ew-encode-rword-1 column rwl)))
 363           (let ((i (1- (length dest)))
 364                 c s r-dest r-column)
 365             (catch 'success
 366               (while (catch 'found
 367                        (while (>= i 0)
 368                          (cond ((memq (setq c (aref dest i)) '(?  ?\t))
 369                                 (if (memq i folded-points)
 370                                     (throw 'found nil)
 371                                   (setq folded-points (cons i folded-points))
 372                                   (throw 'found i))
 373                                 )
 374                                ((eq c ?\n)
 375                                 (throw 'found nil)
 376                                 ))
 377                          (setq i (1- i))))
 378                 (setq s (substring dest i)
 379                       r-column (length s)
 380                       r-dest (concat (substring dest 0 i) "\n" s))
 381                 (when (setq ret (ew-encode-rword-1 r-column rwl))
 382                   (setq dest r-dest
 383                         column r-column)
 384                   (throw 'success t)
 385                   ))
 386               (setq ret (ew-encode-rword-1 column rwl 'must-output))
 387               )))
 388       (setq str (car ret))
 389       (setq dest (concat dest str))
 390       (setq column (nth 1 ret)
 391             rwl (nth 2 ret))
 392       )
 393     (list dest column)
 394     ))
 395
 396
 397 ;;; @ converter
 398 ;;;
 399
 400 (defun eword-encode-phrase-to-rword-list (phrase)
 401   (let (token type dest str)
 402     (while phrase
 403       (setq token (car phrase))
 404       (setq type (car token))
 405       (cond ((eq type 'quoted-string)
 406              (setq str (concat "\"" (cdr token) "\""))
 407              (setq dest
 408                    (append dest
 409                            (list
 410                             (let ((ret (ew-find-charset-rule
 411                                         (find-charset-string str))))
 412                               (make-ew-rword
 413                                str (car ret)(nth 1 ret) 'phrase)
 414                               )
 415                             )))
 416              )
 417             ((eq type 'comment)
 418              (setq dest
 419                    (append dest
 420                            '(("(" nil nil special))
 421                            (tm-eword::words-to-ruled-words
 422                             (eword-encode-charset-words-to-words
 423                              (eword-encode-divide-into-charset-words
 424                               (cdr token)))
 425                             'comment)
 426                            '((")" nil nil special))
 427                            ))
 428              )
 429             (t
 430              (setq dest
 431                    (append dest
 432                            (tm-eword::words-to-ruled-words
 433                             (eword-encode-charset-words-to-words
 434                              (eword-encode-divide-into-charset-words
 435                               (cdr token))
 436                              ) 'phrase)))
 437              ))
 438       (setq phrase (cdr phrase))
 439       )
 440     (ew-space-process dest)
 441     ))
 442
 443 (defun eword-encode-addr-seq-to-rword-list (seq)
 444   (let (dest pname)
 445     (while seq
 446       (let* ((token (car seq))
 447              (name (car token))
 448              )
 449         (cond ((eq name 'spaces)
 450                (setq dest (nconc dest (list (list (cdr token) nil nil))))
 451                )
 452               ((eq name 'comment)
 453                (setq dest
 454                      (nconc
 455                       dest
 456                       (list (list "(" nil nil))
 457                       (eword-encode-split-string (cdr token) 'comment)
 458                       (list (list ")" nil nil))
 459                       ))
 460                )
 461               ((eq name 'quoted-string)
 462                (setq dest
 463                      (nconc
 464                       dest
 465                       (list
 466                        (list (concat "\"" (cdr token) "\"") nil nil)
 467                        )))
 468                )
 469               (t
 470                (setq dest
 471                      (if (or (eq pname 'spaces)
 472                              (eq pname 'comment))
 473                          (nconc dest (list (list (cdr token) nil nil)))
 474                        (nconc (nreverse (cdr (reverse dest)))
 475                               ;; (butlast dest)
 476                               (list
 477                                (list (concat (car (car (last dest)))
 478                                              (cdr token))
 479                                      nil nil)))))
 480                ))
 481         (setq seq (cdr seq)
 482               pname name))
 483       )
 484     dest))
 485
 486 (defun eword-encode-phrase-route-addr-to-rword-list (phrase-route-addr)
 487   (if (eq (car phrase-route-addr) 'phrase-route-addr)
 488       (let ((phrase (nth 1 phrase-route-addr))
 489             (route (nth 2 phrase-route-addr))
 490             dest)
 491         ;; (if (eq (car (car phrase)) 'spaces)
 492         ;;     (setq phrase (cdr phrase))
 493         ;;   )
 494         (setq dest (eword-encode-phrase-to-rword-list phrase))
 495         (if dest
 496             (setq dest (append dest '((" " nil nil))))
 497           )
 498         (append
 499          dest
 500          (eword-encode-addr-seq-to-rword-list
 501           (append '((specials . "<"))
 502                   route
 503                   '((specials . ">"))))
 504          ))))
 505
 506 (defun eword-encode-addr-spec-to-rword-list (addr-spec)
 507   (if (eq (car addr-spec) 'addr-spec)
 508       (eword-encode-addr-seq-to-rword-list (cdr addr-spec))
 509     ))
 510
 511 (defun eword-encode-mailbox-to-rword-list (mbox)
 512   (let ((addr (nth 1 mbox))
 513         (comment (nth 2 mbox))
 514         dest)
 515     (setq dest (or (eword-encode-phrase-route-addr-to-rword-list addr)
 516                    (eword-encode-addr-spec-to-rword-list addr)
 517                    ))
 518     (if comment
 519         (setq dest
 520               (append dest
 521                       '((" " nil nil)
 522                         ("(" nil nil))
 523                       (eword-encode-split-string comment 'comment)
 524                       (list '(")" nil nil))
 525                       )))
 526     dest))
 527
 528 (defsubst eword-encode-mailboxes-to-rword-list (mboxes)
 529   (let ((dest (eword-encode-mailbox-to-rword-list (car mboxes))))
 530     (if dest
 531         (while (setq mboxes (cdr mboxes))
 532           (setq dest
 533                 (nconc dest
 534                        (list '("," nil nil))
 535                        (eword-encode-mailbox-to-rword-list
 536                         (car mboxes))))))
 537     dest))
 538
 539 (defsubst eword-encode-address-to-rword-list (address)
 540   (cond
 541    ((eq (car address) 'mailbox)
 542     (eword-encode-mailbox-to-rword-list address))
 543    ((eq (car address) 'group)
 544     (nconc
 545      (eword-encode-phrase-to-rword-list (nth 1 address))
 546      (list (list ":" nil nil))
 547      (eword-encode-mailboxes-to-rword-list (nth 2 address))
 548      (list (list ";" nil nil))))))
 549
 550 (defsubst eword-encode-addresses-to-rword-list (addresses)
 551   (let ((dest (eword-encode-address-to-rword-list (car addresses))))
 552     (if dest
 553         (while (setq addresses (cdr addresses))
 554           (setq dest
 555                 (nconc dest
 556                        (list '("," nil nil))
 557                        ;; (list '(" " nil nil))
 558                        (eword-encode-address-to-rword-list (car addresses))))))
 559     dest))
 560
 561 (defsubst eword-encode-msg-id-to-rword-list (msg-id)
 562   (list
 563    (list
 564     (concat "<"
 565             (caar (eword-encode-addr-seq-to-rword-list (cdr msg-id)))
 566             ">")
 567     nil nil)))
 568
 569 (defsubst eword-encode-in-reply-to-to-rword-list (in-reply-to)
 570   (let (dest)
 571     (while in-reply-to
 572       (setq dest
 573             (append dest
 574                     (let ((elt (car in-reply-to)))
 575                       (if (eq (car elt) 'phrase)
 576                           (eword-encode-phrase-to-rword-list (cdr elt))
 577                         (eword-encode-msg-id-to-rword-list elt)
 578                         ))))
 579       (setq in-reply-to (cdr in-reply-to)))
 580     dest))
 581
 582
 583 ;;; @ application interfaces
 584 ;;;
 585
 586 (defvar eword-encode-default-start-column 10
 587   "Default start column if it is omitted.")
 588
 589 (defun eword-encode-string (string &optional column mode)
 590   "Encode STRING as encoded-words, and return the result.
 591 Optional argument COLUMN is start-position of the field.
 592 Optional argument MODE allows `text', `comment', `phrase' or nil.
 593 Default value is `phrase'."
 594   (car (eword-encode-rword-list
 595         (or column eword-encode-default-start-column)
 596         (eword-encode-split-string string mode))))
 597
 598 (defun eword-encode-address-list (string &optional column)
 599   "Encode header field STRING as list of address, and return the result.
 600 Optional argument COLUMN is start-position of the field."
 601   (car (eword-encode-rword-list
 602         (or column eword-encode-default-start-column)
 603         (eword-encode-addresses-to-rword-list
 604          (std11-parse-addresses-string string))
 605         )))
 606
 607 (defun eword-encode-in-reply-to (string &optional column)
 608   "Encode header field STRING as In-Reply-To field, and return the result.
 609 Optional argument COLUMN is start-position of the field."
 610   (car (eword-encode-rword-list
 611         (or column 13)
 612         (eword-encode-in-reply-to-to-rword-list
 613          (std11-parse-msg-ids-string string)))))
 614
 615 (defun eword-encode-structured-field-body (string &optional column)
 616   "Encode header field STRING as structured field, and return the result.
 617 Optional argument COLUMN is start-position of the field."
 618   (car (eword-encode-rword-list
 619         (or column eword-encode-default-start-column)
 620         (eword-encode-addr-seq-to-rword-list (std11-lexical-analyze string))
 621         )))
 622
 623 (defun eword-encode-unstructured-field-body (string &optional column)
 624   "Encode header field STRING as unstructured field, and return the result.
 625 Optional argument COLUMN is start-position of the field."
 626   (car (eword-encode-rword-list
 627         (or column eword-encode-default-start-column)
 628         (eword-encode-split-string string 'text))))
 629
 630 ;;;###autoload
 631 (defun mime-encode-field-body (field-body field-name)
 632   "Encode FIELD-BODY as FIELD-NAME, and return the result.
 633 A lexical token includes non-ASCII character is encoded as MIME
 634 encoded-word.  ASCII token is not encoded."
 635   (setq field-body (std11-unfold-string field-body))
 636   (if (string= field-body "")
 637       ""
 638     (let ((method-alist mime-header-encode-method-alist)
 639           start ret)
 640       (if (symbolp field-name)
 641           (setq start (1+ (length (symbol-name field-name))))
 642         (setq start (1+ (length field-name))
 643               field-name (intern (capitalize field-name))))
 644       (while (car method-alist)
 645         (if (or (not (cdr (car method-alist)))
 646                 (memq field-name
 647                       (cdr (car method-alist))))
 648             (progn
 649               (setq ret
 650                     (apply (caar method-alist) (list field-body start)))
 651               (setq method-alist nil)))
 652         (setq method-alist (cdr method-alist)))
 653       ret)))
 654 (defalias 'eword-encode-field-body 'mime-encode-field-body)
 655 (make-obsolete 'eword-encode-field-body 'mime-encode-field-body)
 656
 657 (defun eword-in-subject-p ()
 658   (let ((str (std11-field-body "Subject")))
 659     (if (and str (string-match eword-encoded-word-regexp str))
 660         str)))
 661 (make-obsolete 'eword-in-subject-p "Don't use it.")
 662
 663 (defsubst eword-find-field-encoding-method (field-name)
 664   (setq field-name (downcase field-name))
 665   (let ((alist mime-field-encoding-method-alist))
 666     (catch 'found
 667       (while alist
 668         (let* ((pair (car alist))
 669                (str (car pair)))
 670           (if (and (stringp str)
 671                    (string= field-name (downcase str)))
 672               (throw 'found (cdr pair))
 673             ))
 674         (setq alist (cdr alist)))
 675       (cdr (assq t mime-field-encoding-method-alist))
 676       )))
 677
 678 ;;;###autoload
 679 (defun mime-encode-header-in-buffer (&optional code-conversion)
 680   "Encode header fields to network representation, such as MIME encoded-word.
 681
 682 It refer variable `mime-field-encoding-method-alist'."
 683   (interactive "*")
 684   (save-excursion
 685     (save-restriction
 686       (std11-narrow-to-header mail-header-separator)
 687       (goto-char (point-min))
 688       (let ((default-cs (mime-charset-to-coding-system default-mime-charset))
 689             bbeg end field-name)
 690         (while (re-search-forward
 691                 (concat "\\(" std11-field-head-regexp "\\)" " ?")
 692                 nil t)
 693           (setq bbeg (match-end 0)
 694                 field-name (buffer-substring (match-beginning 0) (1- (match-end 1)))
 695                 end (std11-field-end))
 696           (and (delq 'ascii (find-charset-region bbeg end))
 697                (let ((method (eword-find-field-encoding-method
 698                               (downcase field-name))))
 699                  (cond ((eq method 'mime)
 700                         (let* ((field-body
 701                                 (buffer-substring-no-properties bbeg end))
 702                                (encoded-body
 703                                 (mime-encode-field-body
 704                                  field-body field-name)))
 705                           (if (not encoded-body)
 706                               (error "Cannot encode %s:%s"
 707                                      field-name field-body)
 708                             (delete-region bbeg end)
 709                             (insert encoded-body))))
 710                        (code-conversion
 711                         (let ((cs
 712                                (or (mime-charset-to-coding-system
 713                                     method)
 714                                    default-cs)))
 715                           (encode-coding-region bbeg end cs)
 716                           )))
 717                  ))
 718           ))
 719       )))
 720 (defalias 'eword-encode-header 'mime-encode-header-in-buffer)
 721 (make-obsolete 'eword-encode-header 'mime-encode-header-in-buffer)
 722
 723
 724 ;;; @ end
 725 ;;;
 726
 727 (provide 'eword-encode)
 728
 729 ;;; eword-encode.el ends here