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