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