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