eword-decode.el

   1 ;;; eword-decode.el --- RFC 2047 based encoded-word decoder for GNU Emacs
   2
   3 ;; Copyright (C) 1995,1996,1997 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 ;; Version: $Revision: 0.8 $
  14 ;; Keywords: encoded-word, MIME, multilingual, header, mail, news
  15
  16 ;; This file is part of SEMI (SEMI is Emacs MIME Interfaces).
  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
  40 ;;; @ version
  41 ;;;
  42
  43 (defconst eword-decode-RCS-ID
  44   "$Id: eword-decode.el,v 0.8 1997-02-24 09:04:48 tmorioka Exp $")
  45 (defconst eword-decode-version (get-version-string eword-decode-RCS-ID))
  46
  47
  48 ;;; @ MIME encoded-word definition
  49 ;;;
  50
  51 (defconst eword-encoded-text-regexp "[!->@-~]+")
  52 (defconst eword-encoded-word-regexp
  53   (concat (regexp-quote "=?")
  54           "\\("
  55           mime-charset-regexp
  56           "\\)"
  57           (regexp-quote "?")
  58           "\\(B\\|Q\\)"
  59           (regexp-quote "?")
  60           "\\("
  61           eword-encoded-text-regexp
  62           "\\)"
  63           (regexp-quote "?=")))
  64
  65
  66 ;;; @@ Base64
  67 ;;;
  68
  69 (defconst base64-token-regexp "[A-Za-z0-9+/]")
  70 (defconst base64-token-padding-regexp "[A-Za-z0-9+/=]")
  71
  72 (defconst eword-B-encoded-text-regexp
  73   (concat "\\(\\("
  74           base64-token-regexp
  75           base64-token-regexp
  76           base64-token-regexp
  77           base64-token-regexp
  78           "\\)*"
  79           base64-token-regexp
  80           base64-token-regexp
  81           base64-token-padding-regexp
  82           base64-token-padding-regexp
  83           "\\)"))
  84
  85 ;; (defconst eword-B-encoding-and-encoded-text-regexp
  86 ;;   (concat "\\(B\\)\\?" eword-B-encoded-text-regexp))
  87
  88
  89 ;;; @@ Quoted-Printable
  90 ;;;
  91
  92 (defconst quoted-printable-hex-chars "0123456789ABCDEF")
  93 (defconst quoted-printable-octet-regexp
  94   (concat "=[" quoted-printable-hex-chars
  95           "][" quoted-printable-hex-chars "]"))
  96
  97 (defconst eword-Q-encoded-text-regexp
  98   (concat "\\([^=?]\\|" quoted-printable-octet-regexp "\\)+"))
  99 ;; (defconst eword-Q-encoding-and-encoded-text-regexp
 100 ;;   (concat "\\(Q\\)\\?" eword-Q-encoded-text-regexp))
 101
 102
 103 ;;; @ for string
 104 ;;;
 105
 106 (defun eword-decode-string (string &optional must-unfold)
 107   "Decode MIME encoded-words in STRING.
 108
 109 STRING is unfolded before decoding.
 110
 111 If an encoded-word is broken or your emacs implementation can not
 112 decode the charset included in it, it is not decoded.
 113
 114 If MUST-UNFOLD is non-nil, it unfolds and eliminates line-breaks even
 115 if there are in decoded encoded-words (generated by bad manner MUA
 116 such as a version of Net$cape)."
 117   (setq string (std11-unfold-string string))
 118   (let ((dest "")(ew nil)
 119         beg end)
 120     (while (and (string-match eword-encoded-word-regexp string)
 121                 (setq beg (match-beginning 0)
 122                       end (match-end 0))
 123                 )
 124       (if (> beg 0)
 125           (if (not
 126                (and (eq ew t)
 127                     (string-match "^[ \t]+$" (substring string 0 beg))
 128                     ))
 129               (setq dest (concat dest (substring string 0 beg)))
 130             )
 131         )
 132       (setq dest
 133             (concat dest
 134                     (eword-decode-encoded-word
 135                      (substring string beg end) must-unfold)
 136                     ))
 137       (setq string (substring string end))
 138       (setq ew t)
 139       )
 140     (concat dest string)
 141     ))
 142
 143
 144 ;;; @ for region
 145 ;;;
 146
 147 (defun eword-decode-region (start end &optional unfolding must-unfold)
 148   "Decode MIME encoded-words in region between START and END.
 149
 150 If UNFOLDING is not nil, it unfolds before decoding.
 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   (interactive "*r")
 156   (save-excursion
 157     (save-restriction
 158       (narrow-to-region start end)
 159       (if unfolding
 160           (eword-decode-unfold)
 161         )
 162       (goto-char (point-min))
 163       (while (re-search-forward (concat "\\(" eword-encoded-word-regexp "\\)"
 164                                         "\\(\n?[ \t]\\)+"
 165                                         "\\(" eword-encoded-word-regexp "\\)")
 166                                 nil t)
 167         (replace-match "\\1\\6")
 168         (goto-char (point-min))
 169         )
 170       (let (charset encoding text)
 171         (while (re-search-forward eword-encoded-word-regexp nil t)
 172           (insert (eword-decode-encoded-word
 173                    (prog1
 174                        (buffer-substring (match-beginning 0) (match-end 0))
 175                      (delete-region (match-beginning 0) (match-end 0))
 176                      ) must-unfold))
 177           ))
 178       )))
 179
 180
 181 ;;; @ for message header
 182 ;;;
 183
 184 (defun eword-decode-header (&optional separator)
 185   "Decode MIME encoded-words in header fields.
 186 If SEPARATOR is not nil, it is used as header separator."
 187   (interactive "*")
 188   (save-excursion
 189     (save-restriction
 190       (std11-narrow-to-header separator)
 191       (eword-decode-region (point-min) (point-max) t)
 192       )))
 193
 194 (defun eword-decode-unfold ()
 195   (goto-char (point-min))
 196   (let (field beg end)
 197     (while (re-search-forward std11-field-head-regexp nil t)
 198       (setq beg (match-beginning 0)
 199             end (std11-field-end))
 200       (setq field (buffer-substring beg end))
 201       (if (string-match eword-encoded-word-regexp field)
 202           (save-restriction
 203             (narrow-to-region (goto-char beg) end)
 204             (while (re-search-forward "\n\\([ \t]\\)" nil t)
 205               (replace-match (match-string 1))
 206               )
 207             (goto-char (point-max))
 208             ))
 209       )))
 210
 211
 212 ;;; @ encoded-word decoder
 213 ;;;
 214
 215 (defun eword-decode-encoded-word (word &optional must-unfold)
 216   "Decode WORD if it is an encoded-word.
 217
 218 If your emacs implementation can not decode the charset of WORD, it
 219 returns WORD.  Similarly the encoded-word is broken, it returns WORD.
 220
 221 If MUST-UNFOLD is non-nil, it unfolds and eliminates line-breaks even
 222 if there are in decoded encoded-word (generated by bad manner MUA such
 223 as a version of Net$cape)."
 224   (or (if (string-match eword-encoded-word-regexp word)
 225           (let ((charset
 226                  (substring word (match-beginning 1) (match-end 1))
 227                  )
 228                 (encoding
 229                  (upcase
 230                   (substring word (match-beginning 2) (match-end 2))
 231                   ))
 232                 (text
 233                  (substring word (match-beginning 3) (match-end 3))
 234                  ))
 235             (condition-case err
 236                 (eword-decode-encoded-text charset encoding text must-unfold)
 237               (error
 238                (and (tl:add-text-properties 0 (length word)
 239                                             (and tm:warning-face
 240                                                  (list 'face tm:warning-face))
 241                                             word)
 242                     word)))
 243             ))
 244       word))
 245
 246
 247 ;;; @ encoded-text decoder
 248 ;;;
 249
 250 (defun eword-decode-encoded-text (charset encoding string
 251                                           &optional must-unfold)
 252   "Decode STRING as an encoded-text.
 253
 254 If your emacs implementation can not decode CHARSET, it returns nil.
 255
 256 If ENCODING is not \"B\" or \"Q\", it occurs error.
 257 So you should write error-handling code if you don't want break by errors.
 258
 259 If MUST-UNFOLD is non-nil, it unfolds and eliminates line-breaks even
 260 if there are in decoded encoded-text (generated by bad manner MUA such
 261 as a version of Net$cape)."
 262   (let ((cs (mime-charset-to-coding-system charset)))
 263     (if cs
 264         (let ((dest
 265                (cond
 266                 ((string-equal "B" encoding)
 267                  (if (and (string-match eword-B-encoded-text-regexp string)
 268                           (string-equal string (match-string 0 string)))
 269                      (base64-decode-string string)
 270                    (error "Invalid encoded-text %s" string)))
 271                 ((string-equal "Q" encoding)
 272                  (if (and (string-match eword-Q-encoded-text-regexp string)
 273                           (string-equal string (match-string 0 string)))
 274                      (q-encoding-decode-string string)
 275                    (error "Invalid encoded-text %s" string)))
 276                 (t
 277                  (error "Invalid encoding %s" encoding)
 278                  )))
 279               )
 280           (if dest
 281               (progn
 282                 (setq dest (decode-coding-string dest cs))
 283                 (if must-unfold
 284                     (mapconcat (function
 285                                 (lambda (chr)
 286                                   (cond
 287                                    ((eq chr ?\n) "")
 288                                    ((eq chr ?\t) " ")
 289                                    (t (char-to-string chr)))
 290                                   ))
 291                                (std11-unfold-string dest)
 292                                "")
 293                   dest)
 294                 ))))))
 295
 296
 297 ;;; @ end
 298 ;;;
 299
 300 (provide 'eword-decode)
 301
 302 ;;; eword-decode.el ends here