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