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