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