eword-decode.el

   1 ;;; eword-decode.el --- RFC 2047 based encoded-word decoder for GNU Emacs
   2
   3 ;; Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc.
   4
   5 ;; Author: ENAMI Tsugutomo <enami@sys.ptg.sony.co.jp>
   6 ;;         MORIOKA Tomohiko <morioka@jaist.ac.jp>
   7 ;;         Tanaka Akira <akr@jaist.ac.jp>
   8 ;; Maintainer: Tanaka Akira <akr@jaist.ac.jp>
   9 ;; Created: 1995/10/03
  10 ;; Original: 1992/07/20 ENAMI Tsugutomo's `mime.el'.
  11 ;;      Renamed: 1993/06/03 to tiny-mime.el
  12 ;;      Renamed: 1995/10/03 from tiny-mime.el (split off encoder)
  13 ;;      Renamed: 1997/02/22 from tm-ew-d.el
  14 ;; Keywords: encoded-word, MIME, multilingual, header, mail, news
  15
  16 ;; This file is part of FLAM (Faithful Library About MIME).
  17
  18 ;; This program is free software; you can redistribute it and/or
  19 ;; modify it under the terms of the GNU General Public License as
  20 ;; published by the Free Software Foundation; either version 2, or (at
  21 ;; your option) any later version.
  22
  23 ;; This program is distributed in the hope that it will be useful, but
  24 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  25 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  26 ;; General Public License for more details.
  27
  28 ;; You should have received a copy of the GNU General Public License
  29 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  30 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  31 ;; Boston, MA 02111-1307, USA.
  32
  33 ;;; Code:
  34
  35 (require 'std11)
  36 (require 'mel)
  37 (require 'mime-def)
  38
  39 (require 'ew-dec)
  40
  41 (defgroup eword-decode nil
  42   "Encoded-word decoding"
  43   :group 'mime)
  44
  45 ;;; TEST
  46
  47 (defvar rotate-memo nil)
  48 (defmacro rotate-memo (var val)
  49   `(when rotate-memo
  50      (unless (boundp ',var) (setq ,var ()))
  51      (setq ,var (cons ,val ,var))
  52      (let ((tmp (last ,var (- (length ,var) 100))))
  53        (when tmp (setcdr tmp nil)))
  54      ,var))
  55
  56 ;;; @ variables
  57 ;;;
  58
  59 (defcustom eword-decode-sticked-encoded-word nil
  60   "*If non-nil, decode encoded-words sticked on atoms,
  61 other encoded-words, etc.
  62 however this behaviour violates RFC2047."
  63   :group 'eword-decode
  64   :type 'boolean)
  65
  66 (defcustom eword-decode-quoted-encoded-word nil
  67   "*If non-nil, decode encoded-words in quoted-string
  68 however this behaviour violates RFC2047."
  69   :group 'eword-decode
  70   :type 'boolean)
  71
  72
  73 ;;; @ MIME encoded-word definition
  74 ;;;
  75
  76 (defconst eword-encoded-word-prefix-regexp
  77   (concat (regexp-quote "=?")
  78           "\\(" mime-charset-regexp "\\)"
  79           (regexp-quote "?")
  80           "\\(B\\|Q\\)"
  81           (regexp-quote "?")))
  82 (defconst eword-encoded-word-suffix-regexp
  83   (regexp-quote "?="))
  84
  85 (defconst eword-encoded-text-in-unstructured-regexp "[!->@-~]+")
  86 (defconst eword-encoded-word-in-unstructured-regexp
  87   (concat eword-encoded-word-prefix-regexp
  88           "\\(" eword-encoded-text-in-unstructured-regexp "\\)"
  89           eword-encoded-word-suffix-regexp))
  90 (defconst eword-after-encoded-word-in-unstructured-regexp "\\([ \t]\\|$\\)")
  91
  92 (defconst eword-encoded-text-in-phrase-regexp "[-A-Za-z0-9!*+/=_]+")
  93 (defconst eword-encoded-word-in-phrase-regexp
  94   (concat eword-encoded-word-prefix-regexp
  95           "\\(" eword-encoded-text-in-phrase-regexp "\\)"
  96           eword-encoded-word-suffix-regexp))
  97 (defconst eword-after-encoded-word-in-phrase-regexp "\\([ \t]\\|$\\)")
  98
  99 (defconst eword-encoded-text-in-comment-regexp "[]!-'*->@-[^-~]+")
 100 (defconst eword-encoded-word-in-comment-regexp
 101   (concat eword-encoded-word-prefix-regexp
 102           "\\(" eword-encoded-text-in-comment-regexp "\\)"
 103           eword-encoded-word-suffix-regexp))
 104 (defconst eword-after-encoded-word-in-comment-regexp "\\([ \t()\\\\]\\|$\\)")
 105
 106 (defconst eword-encoded-text-in-quoted-string-regexp "[]!#->@-[^-~]+")
 107 (defconst eword-encoded-word-in-quoted-string-regexp
 108   (concat eword-encoded-word-prefix-regexp
 109           "\\(" eword-encoded-text-in-quoted-string-regexp "\\)"
 110           eword-encoded-word-suffix-regexp))
 111 (defconst eword-after-encoded-word-in-quoted-string-regexp "\\([ \t\"\\\\]\\|$\\)")
 112
 113 ; obsolete
 114 (defconst eword-encoded-text-regexp eword-encoded-text-in-unstructured-regexp)
 115 (defconst eword-encoded-word-regexp eword-encoded-word-in-unstructured-regexp)
 116
 117
 118 ;;; @ internal utilities
 119 ;;;
 120
 121 (defun eword-decode-first-encoded-words (string
 122                                          eword-regexp
 123                                          after-regexp
 124                                          &optional must-unfold)
 125   "Decode MIME encoded-words in beginning of STRING.
 126
 127 EWORD-REGEXP is the regexp that matches a encoded-word.
 128 Usual value is
 129 eword-encoded-word-in-unstructured-regexp,
 130 eword-encoded-text-in-phrase-regexp,
 131 eword-encoded-word-in-comment-regexp or
 132 eword-encoded-word-in-quoted-string-regexp.
 133
 134 AFTER-REGEXP is the regexp that matches a after encoded-word.
 135 Usual value is
 136 eword-after-encoded-word-in-unstructured-regexp,
 137 eword-after-encoded-text-in-phrase-regexp,
 138 eword-after-encoded-word-in-comment-regexp or
 139 eword-after-encoded-word-in-quoted-string-regexp.
 140
 141 If beginning of STRING matches EWORD-REGEXP with AFTER-REGEXP,
 142 returns a cons cell of decoded string(sequence of characters) and
 143 the rest(sequence of octets).
 144
 145 If beginning of STRING does not matches EWORD-REGEXP and AFTER-REGEXP,
 146 returns nil.
 147
 148 If an encoded-word is broken or your emacs implementation can not
 149 decode the charset included in it, it is returned in decoded part
 150 as encoded-word form.
 151
 152 If MUST-UNFOLD is non-nil, it unfolds and eliminates line-breaks even
 153 if there are in decoded encoded-words (generated by bad manner MUA
 154 such as a version of Net$cape)."
 155   (if eword-decode-sticked-encoded-word (setq after-regexp ""))
 156   (let* ((between-ewords-regexp
 157            (if eword-decode-sticked-encoded-word
 158              "\\(\n?[ \t]\\)*"
 159              "\\(\n?[ \t]\\)+"))
 160          (between-ewords-eword-after-regexp
 161            (concat "\\`\\(" between-ewords-regexp "\\)"
 162                       "\\(" eword-regexp "\\)"
 163                       after-regexp))
 164          (eword-after-regexp
 165            (concat "\\`\\(" eword-regexp "\\)" after-regexp))
 166          (src string)   ; sequence of octets.
 167          (dst ""))      ; sequence of characters.
 168     (if (string-match eword-after-regexp src)
 169       (let* (p
 170              (q (match-end 1))
 171              (ew (substring src 0 q))
 172              (dw (eword-decode-encoded-word ew must-unfold)))
 173         (setq dst (concat dst dw)
 174               src (substring src q))
 175         (if (not (string= ew dw))
 176           (progn
 177             (while
 178               (and
 179                 (string-match between-ewords-eword-after-regexp src)
 180                 (progn
 181                   (setq p (match-end 1)
 182                         q (match-end 3)
 183                         ew (substring src p q)
 184                         dw (eword-decode-encoded-word ew must-unfold))
 185                   (if (string= ew dw)
 186                     (progn
 187                       (setq dst (concat dst (substring src 0 q))
 188                             src (substring src q))
 189                       nil)
 190                     t)))
 191               (setq dst (concat dst dw)
 192                     src (substring src q)))))
 193         (cons dst src))
 194       nil)))
 195
 196 (defun eword-decode-entire-string (string
 197                                    eword-regexp
 198                                    after-regexp
 199                                    safe-regexp
 200                                    escape ; ?\\ or nil.
 201                                    delimiters ; list of chars.
 202                                    chars-must-be-quote
 203                                    must-unfold
 204                                    code-conversion)
 205   (if (and code-conversion
 206            (not (mime-charset-to-coding-system code-conversion)))
 207       (setq code-conversion default-mime-charset))
 208   (let ((equal-safe-regexp (concat "\\`=?" safe-regexp))
 209         (dst "")
 210         (buf "")
 211         (src string)
 212         (ew-enable t))
 213     (while (< 0 (length src))
 214       (let ((ch (aref src 0))
 215             (decoded (and
 216                         ew-enable
 217                         (eword-decode-first-encoded-words src
 218                           eword-regexp after-regexp must-unfold))))
 219         (if (and (not (string= buf ""))
 220                  (or decoded (memq ch delimiters)))
 221           (setq dst (concat dst
 222                       (std11-wrap-as-quoted-pairs
 223                         (decode-mime-charset-string buf code-conversion)
 224                         chars-must-be-quote))
 225                 buf ""))
 226         (cond
 227           (decoded
 228             (setq dst (concat dst
 229                         (std11-wrap-as-quoted-pairs
 230                           (car decoded)
 231                           chars-must-be-quote))
 232                   src (cdr decoded)))
 233           ((memq ch delimiters)
 234             (setq dst (concat dst (list ch))
 235                   src (substring src 1)
 236                   ew-enable t))
 237           ((eq ch escape)
 238             (setq buf (concat buf (list (aref src 1)))
 239                   src (substring src 2)
 240                   ew-enable t))
 241           ((string-match "\\`[ \t\n]+" src)
 242             (setq buf (concat buf (substring src 0 (match-end 0)))
 243                   src (substring src (match-end 0))
 244                   ew-enable t))
 245           ((and (string-match equal-safe-regexp src)
 246                 (< 0 (match-end 0)))
 247             (setq buf (concat buf (substring src 0 (match-end 0)))
 248                   src (substring src (match-end 0))
 249                   ew-enable eword-decode-sticked-encoded-word))
 250           (t (error "something wrong")))))
 251     (if (not (string= buf ""))
 252       (setq dst (concat dst
 253                   (std11-wrap-as-quoted-pairs
 254                     (decode-mime-charset-string buf code-conversion)
 255                     chars-must-be-quote))))
 256     dst))
 257
 258
 259 ;;; @ for string
 260 ;;;
 261
 262 (defun eword-decode-unstructured (string code-conversion &optional must-unfold)
 263   (eword-decode-entire-string
 264     string
 265     eword-encoded-word-in-unstructured-regexp
 266     eword-after-encoded-word-in-unstructured-regexp
 267     "[^ \t\n=]*"
 268     nil
 269     nil
 270     nil
 271     must-unfold
 272     code-conversion))
 273
 274 (defun eword-decode-comment (string code-conversion &optional must-unfold)
 275   (eword-decode-entire-string
 276     string
 277     eword-encoded-word-in-comment-regexp
 278     eword-after-encoded-word-in-comment-regexp
 279     "[^ \t\n()\\\\=]*"
 280     ?\\
 281     '(?\( ?\))
 282     '(?\( ?\) ?\\ ?\r ?\n)
 283     must-unfold
 284     code-conversion))
 285
 286 (defun eword-decode-quoted-string (string code-conversion &optional must-unfold)
 287   (eword-decode-entire-string
 288     string
 289     eword-encoded-word-in-quoted-string-regexp
 290     eword-after-encoded-word-in-quoted-string-regexp
 291     "[^ \t\n\"\\\\=]*"
 292     ?\\
 293     '(?\")
 294     '(?\" ?\\ ?\r ?\n)
 295     must-unfold
 296     code-conversion))
 297
 298 (defun eword-decode-string (string &optional must-unfold code-conversion)
 299   "Decode MIME encoded-words in STRING.
 300
 301 STRING is unfolded before decoding.
 302
 303 If an encoded-word is broken or your emacs implementation can not
 304 decode the charset included in it, it is not decoded.
 305
 306 If MUST-UNFOLD is non-nil, it unfolds and eliminates line-breaks even
 307 if there are in decoded encoded-words (generated by bad manner MUA
 308 such as a version of Net$cape).
 309
 310 If CODE-CONVERSION is nil, it decodes only encoded-words.  If it is
 311 mime-charset, it decodes non-ASCII bit patterns as the mime-charset.
 312 Otherwise it decodes non-ASCII bit patterns as the
 313 default-mime-charset."
 314   (eword-decode-unstructured
 315     (std11-unfold-string string)
 316     code-conversion
 317     must-unfold))
 318
 319
 320 ;;; @ for region
 321 ;;;
 322
 323 (defun eword-decode-region (start end &optional unfolding must-unfold
 324                                                 code-conversion)
 325   "Decode MIME encoded-words in region between START and END.
 326
 327 If UNFOLDING is not nil, it unfolds before decoding.
 328
 329 If MUST-UNFOLD is non-nil, it unfolds and eliminates line-breaks even
 330 if there are in decoded encoded-words (generated by bad manner MUA
 331 such as a version of Net$cape).
 332
 333 If CODE-CONVERSION is nil, it decodes only encoded-words.  If it is
 334 mime-charset, it decodes non-ASCII bit patterns as the mime-charset.
 335 Otherwise it decodes non-ASCII bit patterns as the
 336 default-mime-charset."
 337   (interactive "*r")
 338   (rotate-memo args-eword-decode-region
 339                (list start end (buffer-substring start end) unfolding must-unfold code-conversion))
 340   (save-excursion
 341     (save-restriction
 342       (narrow-to-region start end)
 343       (if unfolding
 344           (eword-decode-unfold)
 345         )
 346       (let ((str (eword-decode-unstructured
 347                    (buffer-substring (point-min) (point-max))
 348                    code-conversion
 349                    must-unfold)))
 350         (delete-region (point-min) (point-max))
 351         (insert str)))))
 352
 353
 354 ;;; @ for message header
 355 ;;;
 356
 357 (defcustom eword-decode-ignored-field-list
 358   '(Newsgroups Path Lines Nntp-Posting-Host Received Message-Id Date)
 359   "*List of field-names to be ignored when decoding.
 360 Each field name must be symbol."
 361   :group 'eword-decode
 362   :type '(repeat symbol))
 363
 364 (defcustom eword-decode-structured-field-list
 365   '(Reply-To Resent-Reply-To From Resent-From Sender Resent-Sender
 366              To Resent-To Cc Resent-Cc Bcc Resent-Bcc Dcc
 367              Mail-Followup-To
 368              Mime-Version Content-Type Content-Transfer-Encoding
 369              Content-Disposition User-Agent)
 370   "*List of field-names to decode as structured field.
 371 Each field name must be symbol."
 372   :group 'eword-decode
 373   :type '(repeat symbol))
 374
 375 (defun eword-decode-header (&optional code-conversion separator)
 376   "Decode MIME encoded-words in header fields.
 377 If CODE-CONVERSION is nil, it decodes only encoded-words.  If it is
 378 mime-charset, it decodes non-ASCII bit patterns as the mime-charset.
 379 Otherwise it decodes non-ASCII bit patterns as the
 380 default-mime-charset.
 381 If SEPARATOR is not nil, it is used as header separator."
 382   (interactive "*")
 383   (rotate-memo args-eword-decode-header (list code-conversion))
 384   (unless code-conversion
 385     (message "eword-decode-header is called without code-conversion")
 386     (sit-for 2))
 387   (if (and code-conversion
 388            (not (mime-charset-to-coding-system code-conversion)))
 389       (setq code-conversion default-mime-charset))
 390   (save-excursion
 391     (save-restriction
 392       (std11-narrow-to-header separator)
 393       (rotate-memo args-h-eword-decode-header (buffer-substring (point-min) (point-max)))
 394       (if code-conversion
 395           (let (beg p end field-name field-body decoded)
 396             (goto-char (point-min))
 397             (while (re-search-forward std11-field-head-regexp nil t)
 398               (setq beg (match-beginning 0)
 399                     p (match-end 0)
 400                     field-name (buffer-substring beg (1- p))
 401                     end (std11-field-end)
 402                     field-body (ew-lf-crlf-to-crlf
 403                                 (buffer-substring p end))
 404                     decoded (ew-decode-field
 405                              field-name field-body))
 406               (unless (equal field-body decoded)
 407                 (setq decoded (ew-crlf-refold
 408                                decoded
 409                                (1+ (string-width field-name))
 410                                fill-column)))
 411               (delete-region p end)
 412               (insert (ew-crlf-to-lf decoded))
 413               (add-text-properties beg (min (1+ (point)) (point-max))
 414                                    (list 'original-field-name field-name
 415                                          'original-field-body field-body))
 416               ))
 417         (eword-decode-region (point-min) (point-max) t nil nil)
 418         ))))
 419
 420 (defun eword-decode-unfold ()
 421   (goto-char (point-min))
 422   (let (field beg end)
 423     (while (re-search-forward std11-field-head-regexp nil t)
 424       (setq beg (match-beginning 0)
 425             end (std11-field-end))
 426       (setq field (buffer-substring beg end))
 427       (if (string-match eword-encoded-word-regexp field)
 428           (save-restriction
 429             (narrow-to-region (goto-char beg) end)
 430             (while (re-search-forward "\n\\([ \t]\\)" nil t)
 431               (replace-match (match-string 1))
 432               )
 433             (goto-char (point-max))
 434             ))
 435       )))
 436
 437
 438 ;;; @ encoded-word decoder
 439 ;;;
 440
 441 (defvar eword-decode-encoded-word-error-handler
 442   'eword-decode-encoded-word-default-error-handler)
 443
 444 (defvar eword-warning-face nil
 445   "Face used for invalid encoded-word.")
 446
 447 (defun eword-decode-encoded-word-default-error-handler (word signal)
 448   (and (add-text-properties 0 (length word)
 449                             (and eword-warning-face
 450                                  (list 'face eword-warning-face))
 451                             word)
 452        word))
 453
 454 (defun eword-decode-encoded-word (word &optional must-unfold)
 455   "Decode WORD if it is an encoded-word.
 456
 457 If your emacs implementation can not decode the charset of WORD, it
 458 returns WORD.  Similarly the encoded-word is broken, it returns WORD.
 459
 460 If MUST-UNFOLD is non-nil, it unfolds and eliminates line-breaks even
 461 if there are in decoded encoded-word (generated by bad manner MUA such
 462 as a version of Net$cape)."
 463   (or (if (string-match eword-encoded-word-regexp word)
 464           (let ((charset
 465                  (substring word (match-beginning 1) (match-end 1))
 466                  )
 467                 (encoding
 468                  (upcase
 469                   (substring word (match-beginning 2) (match-end 2))
 470                   ))
 471                 (text
 472                  (substring word (match-beginning 3) (match-end 3))
 473                  ))
 474             (condition-case err
 475                 (eword-decode-encoded-text charset encoding text must-unfold)
 476               (error
 477                (funcall eword-decode-encoded-word-error-handler word err)
 478                ))
 479             ))
 480       word))
 481
 482
 483 ;;; @ encoded-text decoder
 484 ;;;
 485
 486 (defun eword-decode-encoded-text (charset encoding string
 487                                           &optional must-unfold)
 488   "Decode STRING as an encoded-text.
 489
 490 If your emacs implementation can not decode CHARSET, it returns nil.
 491
 492 If ENCODING is not \"B\" or \"Q\", it occurs error.
 493 So you should write error-handling code if you don't want break by errors.
 494
 495 If MUST-UNFOLD is non-nil, it unfolds and eliminates line-breaks even
 496 if there are in decoded encoded-text (generated by bad manner MUA such
 497 as a version of Net$cape)."
 498   (let ((cs (mime-charset-to-coding-system charset)))
 499     (if cs
 500         (let ((dest (encoded-text-decode-string string encoding)))
 501           (when dest
 502             (setq dest (decode-mime-charset-string dest charset))
 503             (if must-unfold
 504                 (mapconcat (function
 505                             (lambda (chr)
 506                               (cond ((eq chr ?\n) "")
 507                                     ((eq chr ?\t) " ")
 508                                     (t (char-to-string chr)))
 509                               ))
 510                            (std11-unfold-string dest)
 511                            "")
 512               dest))))))
 513
 514
 515 ;;; @ lexical analyze
 516 ;;;
 517
 518 (defvar eword-lexical-analyze-cache nil)
 519 (defvar eword-lexical-analyze-cache-max 299
 520   "*Max position of eword-lexical-analyze-cache.
 521 It is max size of eword-lexical-analyze-cache - 1.")
 522
 523 (defcustom eword-lexical-analyzers
 524   '(eword-analyze-quoted-string
 525     eword-analyze-domain-literal
 526     eword-analyze-comment
 527     eword-analyze-spaces
 528     eword-analyze-special
 529     eword-analyze-encoded-word
 530     eword-analyze-atom)
 531   "*List of functions to return result of lexical analyze.
 532 Each function must have two arguments: STRING and MUST-UNFOLD.
 533 STRING is the target string to be analyzed.
 534 If MUST-UNFOLD is not nil, each function must unfold and eliminate
 535 bare-CR and bare-LF from the result even if they are included in
 536 content of the encoded-word.
 537 Each function must return nil if it can not analyze STRING as its
 538 format.
 539
 540 Previous function is preferred to next function.  If a function
 541 returns nil, next function is used.  Otherwise the return value will
 542 be the result."
 543   :group 'eword-decode
 544   :type '(repeat function))
 545
 546 (defun eword-analyze-quoted-string (string &optional must-unfold)
 547   (let ((p (std11-check-enclosure string ?\" ?\")))
 548     (if p
 549         (cons (cons 'quoted-string
 550                     (if eword-decode-quoted-encoded-word
 551                         (eword-decode-quoted-string
 552                           (substring string 0 p)
 553                           default-mime-charset)
 554                       (std11-wrap-as-quoted-string
 555                        (decode-mime-charset-string
 556                         (std11-strip-quoted-pair (substring string 1 (1- p)))
 557                         default-mime-charset))))
 558               (substring string p)))
 559     ))
 560
 561 (defun eword-analyze-domain-literal (string &optional must-unfold)
 562   (std11-analyze-domain-literal string))
 563
 564 (defun eword-analyze-comment (string &optional must-unfold)
 565   (let ((len (length string)))
 566     (if (and (< 0 len) (eq (aref string 0) ?\())
 567         (let ((p 0))
 568           (while (and p (< p len) (eq (aref string p) ?\())
 569             (setq p (std11-check-enclosure string ?\( ?\) t p)))
 570           (setq p (or p len))
 571           (cons (cons 'comment
 572                       (eword-decode-comment
 573                         (std11-unfold-string (substring string 0 p))
 574                         default-mime-charset))
 575                 (substring string p)))
 576       nil)))
 577
 578 (defun eword-analyze-spaces (string &optional must-unfold)
 579   (std11-analyze-spaces string))
 580
 581 (defun eword-analyze-special (string &optional must-unfold)
 582   (std11-analyze-special string))
 583
 584 (defun eword-analyze-encoded-word (string &optional must-unfold)
 585   (let ((decoded (eword-decode-first-encoded-words
 586                   string
 587                   eword-encoded-word-in-phrase-regexp
 588                   eword-after-encoded-word-in-phrase-regexp
 589                   must-unfold)))
 590     (if decoded
 591         (let ((s (car decoded)))
 592           (while (or (string-match std11-atom-regexp s)
 593                      (string-match std11-spaces-regexp s))
 594             (setq s (substring s (match-end 0))))
 595           (if (= (length s) 0)
 596               (cons (cons 'atom (car decoded)) (cdr decoded))
 597             (cons (cons 'quoted-string
 598                         (std11-wrap-as-quoted-string (car decoded)))
 599                   (cdr decoded)))))))
 600
 601 (defun eword-analyze-atom (string &optional must-unfold)
 602   (if (let ((enable-multibyte-characters nil))
 603         (string-match std11-atom-regexp string))
 604       (let ((end (match-end 0)))
 605         (if (and eword-decode-sticked-encoded-word
 606                  (string-match eword-encoded-word-in-phrase-regexp
 607                                (substring string 0 end))
 608                  (< 0 (match-beginning 0)))
 609             (setq end (match-beginning 0)))
 610         (cons (cons 'atom (decode-mime-charset-string
 611                            (substring string 0 end)
 612                            default-mime-charset))
 613               (substring string end)
 614               ))))
 615
 616 (defun eword-lexical-analyze-internal (string must-unfold)
 617   (let ((last 'eword-analyze-spaces)
 618         dest ret)
 619     (while (not (string-equal string ""))
 620       (setq ret
 621             (let ((rest eword-lexical-analyzers)
 622                   func r)
 623               (while (and (setq func (car rest))
 624                           (or
 625                            (and
 626                             (not eword-decode-sticked-encoded-word)
 627                             (not (eq last 'eword-analyze-spaces))
 628                             (eq func 'eword-analyze-encoded-word))
 629                            (null (setq r (funcall func string must-unfold))))
 630                           )
 631                 (setq rest (cdr rest)))
 632               (setq last func)
 633               (or r `((error . ,string) . ""))
 634               ))
 635       (setq dest (cons (car ret) dest))
 636       (setq string (cdr ret))
 637       )
 638     (nreverse dest)
 639     ))
 640
 641 (defun eword-lexical-analyze (string &optional must-unfold)
 642   "Return lexical analyzed list corresponding STRING.
 643 It is like std11-lexical-analyze, but it decodes non us-ascii
 644 characters encoded as encoded-words or invalid \"raw\" format.
 645 \"Raw\" non us-ascii characters are regarded as variable
 646 `default-mime-charset'."
 647   (let* ((str (copy-sequence string))
 648          (key (cons str (cons default-mime-charset must-unfold)))
 649          ret)
 650     (set-text-properties 0 (length str) nil str)
 651     (if (setq ret (assoc key eword-lexical-analyze-cache))
 652         (cdr ret)
 653       (setq ret (eword-lexical-analyze-internal str must-unfold))
 654       (setq eword-lexical-analyze-cache
 655             (cons (cons key ret)
 656                   (last eword-lexical-analyze-cache
 657                         eword-lexical-analyze-cache-max)))
 658       ret)))
 659
 660 (defun eword-decode-token (token)
 661   (cdr token))
 662
 663 (defun eword-decode-and-fold-structured-field
 664   (string start-column &optional max-column must-unfold)
 665   "Decode and fold (fill) STRING as structured field body.
 666 It decodes non us-ascii characters in FULL-NAME encoded as
 667 encoded-words or invalid \"raw\" string.  \"Raw\" non us-ascii
 668 characters are regarded as variable `default-mime-charset'.
 669
 670 If an encoded-word is broken or your emacs implementation can not
 671 decode the charset included in it, it is not decoded.
 672
 673 If MAX-COLUMN is omitted, `fill-column' is used.
 674
 675 If MUST-UNFOLD is non-nil, it unfolds and eliminates line-breaks even
 676 if there are in decoded encoded-words (generated by bad manner MUA
 677 such as a version of Net$cape)."
 678   (rotate-memo args-eword-decode-and-fold-structured-field
 679                (list string start-column max-column must-unfold))
 680   (or max-column
 681       (setq max-column fill-column))
 682   (let* ((field-name (make-string (1- start-column) ?X))
 683          (field-body (ew-lf-crlf-to-crlf string))
 684          (ew-decode-field-default-syntax '(ew-scan-unibyte-std11))
 685          (decoded (ew-decode-field field-name field-body)))
 686     (unless (equal field-body decoded)
 687       (setq decoded (ew-crlf-refold decoded start-column max-column)))
 688     (ew-crlf-to-lf decoded)))
 689
 690 (defun eword-decode-and-unfold-structured-field (string)
 691   "Decode and unfold STRING as structured field body.
 692 It decodes non us-ascii characters in FULL-NAME encoded as
 693 encoded-words or invalid \"raw\" string.  \"Raw\" non us-ascii
 694 characters are regarded as variable `default-mime-charset'.
 695
 696 If an encoded-word is broken or your emacs implementation can not
 697 decode the charset included in it, it is not decoded."
 698   (rotate-memo args-eword-decode-and-unfold-structured-field (list string))
 699   (let* ((ew-decode-field-default-syntax '(ew-scan-unibyte-std11))
 700          (decoded (ew-decode-field "" (ew-lf-crlf-to-crlf string))))
 701     (ew-crlf-to-lf (ew-crlf-unfold decoded))))
 702
 703 (defun eword-decode-structured-field-body (string &optional must-unfold
 704                                                   start-column max-column)
 705   "Decode non us-ascii characters in STRING as structured field body.
 706 STRING is unfolded before decoding.
 707
 708 It decodes non us-ascii characters in FULL-NAME encoded as
 709 encoded-words or invalid \"raw\" string.  \"Raw\" non us-ascii
 710 characters are regarded as variable `default-mime-charset'.
 711
 712 If an encoded-word is broken or your emacs implementation can not
 713 decode the charset included in it, it is not decoded.
 714
 715 If MUST-UNFOLD is non-nil, it unfolds and eliminates line-breaks even
 716 if there are in decoded encoded-words (generated by bad manner MUA
 717 such as a version of Net$cape)."
 718   (rotate-memo args-eword-decode-structured-field-body
 719                (list string must-unfold start-column max-column))
 720   (if start-column
 721       ;; fold with max-column
 722       (eword-decode-and-fold-structured-field
 723        string start-column max-column must-unfold)
 724     ;; Don't fold
 725     (let* ((ew-decode-field-default-syntax '(ew-scan-unibyte-std11))
 726            (decoded (ew-decode-field "" (ew-lf-crlf-to-crlf string))))
 727       (ew-crlf-to-lf decoded))))
 728
 729 (defun eword-decode-unstructured-field-body (string &optional must-unfold)
 730   "Decode non us-ascii characters in STRING as unstructured field body.
 731 STRING is unfolded before decoding.
 732
 733 It decodes non us-ascii characters in FULL-NAME encoded as
 734 encoded-words or invalid \"raw\" string.  \"Raw\" non us-ascii
 735 characters are regarded as variable `default-mime-charset'.
 736
 737 If an encoded-word is broken or your emacs implementation can not
 738 decode the charset included in it, it is not decoded.
 739
 740 If MUST-UNFOLD is non-nil, it unfolds and eliminates line-breaks even
 741 if there are in decoded encoded-words (generated by bad manner MUA
 742 such as a version of Net$cape)."
 743   (rotate-memo args-eword-decode-unstructured-field-body
 744                (list string must-unfold))
 745   (let ((decoded (ew-decode-field "" (ew-lf-crlf-to-crlf string))))
 746     (ew-crlf-to-lf (ew-crlf-unfold decoded))))
 747
 748 (defun eword-extract-address-components (string)
 749   "Extract full name and canonical address from STRING.
 750 Returns a list of the form (FULL-NAME CANONICAL-ADDRESS).
 751 If no name can be extracted, FULL-NAME will be nil.
 752 It decodes non us-ascii characters in FULL-NAME encoded as
 753 encoded-words or invalid \"raw\" string.  \"Raw\" non us-ascii
 754 characters are regarded as variable `default-mime-charset'."
 755   (rotate-memo args-eword-extract-address-components (list string))
 756   (let* ((structure (car (std11-parse-address
 757                           (eword-lexical-analyze
 758                            (std11-unfold-string string) 'must-unfold))))
 759          (phrase  (std11-full-name-string structure))
 760          (address (std11-address-string structure))
 761          )
 762     (list phrase address)
 763     ))
 764
 765
 766 ;;; @ end
 767 ;;;
 768
 769 (provide 'eword-decode)
 770
 771 ;;; eword-decode.el ends here