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