mel-q.el

   1 ;;; mel-q.el --- Quoted-Printable encoder/decoder.
   2
   3 ;; Copyright (C) 1995,1996,1997,1998,1999 Free Software Foundation, Inc.
   4
   5 ;; Author: MORIOKA Tomohiko <tomo@m17n.org>
   6 ;; Created: 1995/6/25
   7 ;; Keywords: MIME, Quoted-Printable, Q-encoding
   8
   9 ;; This file is part of FLIM (Faithful Library about Internet Message).
  10
  11 ;; This program is free software; you can redistribute it and/or
  12 ;; modify it under the terms of the GNU General Public License as
  13 ;; published by the Free Software Foundation; either version 2, or (at
  14 ;; your option) any later version.
  15
  16 ;; This program is distributed in the hope that it will be useful, but
  17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  19 ;; General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with this program; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  24 ;; Boston, MA 02111-1307, USA.
  25
  26 ;;; Code:
  27
  28 (require 'mime-def)
  29 (require 'path-util)
  30
  31
  32 ;;; @ Quoted-Printable encoder
  33 ;;;
  34
  35 (defsubst quoted-printable-quote-char (character)
  36   (concat
  37    "="
  38    (char-to-string (aref quoted-printable-hex-chars (ash character -4)))
  39    (char-to-string (aref quoted-printable-hex-chars (logand character 15)))))
  40
  41 (defun quoted-printable-internal-encode-region (start end)
  42   (save-excursion
  43     (save-restriction
  44       (narrow-to-region (goto-char start) end)
  45       (let ((col 0)
  46             chr)
  47         (while (not (eobp))
  48           (cond
  49            ((>= col 75)                 ; soft line break.
  50             (insert "=\n")
  51             (setq col 0))
  52            ((eolp)                      ; end of line.
  53             (forward-char)
  54             (setq col 0))
  55            (t
  56             (setq chr (char-after (point)))
  57             (cond
  58              ((and (memq chr '(?  ?\t)) ; encode WSP char before CRLF.
  59                    (eq (char-after (1+ (point))) ?\n))
  60               (forward-char)
  61               (insert "=\n")
  62               (forward-char)
  63               (setq col 0))
  64              ((and (bolp)               ; "^From " is not safe.
  65                    (eq chr                        ?F)
  66                    (eq (char-after (1+  (point))) ?r)
  67                    (eq (char-after (+ 2 (point))) ?o)
  68                    (eq (char-after (+ 3 (point))) ?m)
  69                    (eq (char-after (+ 4 (point))) ? ))
  70               (delete-region (point)(1+ (point)))
  71               (insert "=46")            ; moved to ?r.
  72               (forward-char 4)          ; skip "rom ".
  73               (setq col 7))
  74              ((or (= chr ?\t)           ; skip safe char.
  75                   (and (<= 32 chr)(/= chr ?=)(< chr 127)))
  76               (forward-char)
  77               (setq col (1+ col)))
  78              ((>= col 73)               ; soft line break.
  79               (insert "=\n")
  80               (setq col 0))
  81              (t                         ; encode unsafe char.
  82               (delete-region (point)(1+ (point)))
  83               ;; (insert (quoted-printable-quote-char chr))
  84               (insert
  85                ?=
  86                (aref quoted-printable-hex-chars (ash chr -4))
  87                (aref quoted-printable-hex-chars (logand chr 15)))
  88               (setq col (+ col 3)))))))))))
  89
  90
  91 (defvar quoted-printable-external-encoder '("mmencode" "-q")
  92   "*list of quoted-printable encoder program name and its arguments.")
  93
  94 (defun quoted-printable-external-encode-region (start end)
  95   (save-excursion
  96     (save-restriction
  97       (narrow-to-region start end)
  98       (as-binary-process
  99        (apply (function call-process-region)
 100               start end (car quoted-printable-external-encoder)
 101               t t nil
 102               (cdr quoted-printable-external-encoder)))
 103       ;; for OS/2
 104       ;;   regularize line break code
 105       (goto-char (point-min))
 106       (while (re-search-forward "\r$" nil t)
 107         (replace-match "")))))
 108
 109
 110 (defvar quoted-printable-internal-encoding-limit
 111   (if (and (featurep 'xemacs)(featurep 'mule))
 112       0
 113     (require 'path-util)
 114     (if (exec-installed-p "mmencode")
 115         1000
 116       ;; XXX: Fix this message, or simply remove it.
 117       ;; (message "Don't found external encoder for Quoted-Printable!")
 118       nil))
 119   "*limit size to use internal quoted-printable encoder.
 120 If size of input to encode is larger than this limit,
 121 external encoder is called.")
 122
 123 (defun quoted-printable-encode-region (start end)
 124   "Encode current region by quoted-printable.
 125 START and END are buffer positions.
 126 This function calls internal quoted-printable encoder if size of
 127 region is smaller than `quoted-printable-internal-encoding-limit',
 128 otherwise it calls external quoted-printable encoder specified by
 129 `quoted-printable-external-encoder'.  In this case, you must install
 130 the program (maybe mmencode included in metamail or XEmacs package)."
 131   (interactive "*r")
 132   (if (and quoted-printable-internal-encoding-limit
 133            (> (- end start) quoted-printable-internal-encoding-limit))
 134       (quoted-printable-external-encode-region start end)
 135     (quoted-printable-internal-encode-region start end)))
 136
 137 (defun quoted-printable-encode-string (string)
 138   "Encode STRING to quoted-printable, and return the result."
 139   (with-temp-buffer
 140     (insert string)
 141     (quoted-printable-encode-region (point-min)(point-max))
 142     (buffer-string)))
 143
 144
 145 (mel-define-method-function
 146  (mime-encode-string string (nil "quoted-printable"))
 147  'quoted-printable-encode-string)
 148
 149 (mel-define-method-function
 150  (mime-encode-region start end (nil "quoted-printable"))
 151  'quoted-printable-encode-region)
 152
 153 (mel-define-method mime-insert-encoded-file (filename (nil "quoted-printable"))
 154   "Encode contents of file FILENAME to quoted-printable, and insert the result.
 155 It calls external quoted-printable encoder specified by
 156 `quoted-printable-external-encoder'.  So you must install the program
 157 \(maybe mmencode included in metamail or XEmacs package)."
 158   (interactive "*fInsert encoded file: ")
 159   (apply (function call-process)
 160          (car quoted-printable-external-encoder)
 161          filename t nil
 162          (cdr quoted-printable-external-encoder)))
 163
 164
 165 ;;; @ Quoted-Printable decoder
 166 ;;;
 167
 168 (defsubst quoted-printable-hex-char-to-num (chr)
 169   (cond ((<= ?a chr) (+ (- chr ?a) 10))
 170         ((<= ?A chr) (+ (- chr ?A) 10))
 171         ((<= ?0 chr) (- chr ?0))
 172         ))
 173
 174 (defun quoted-printable-internal-decode-region (start end)
 175   (save-excursion
 176     (save-restriction
 177       (narrow-to-region start end)
 178       (goto-char (point-min))
 179       (while (search-forward "=" nil t)
 180         (cond
 181          ((eolp)
 182           ;; unfold soft line break.
 183           (delete-region (1- (point))(1+ (point))))
 184          ((and (memq (char-after (point))
 185                      (eval-when-compile
 186                        ;; XXX: should provide char-list instead.
 187                        (string-to-char-list quoted-printable-hex-chars)))
 188                (memq (char-after (1+ (point)))
 189                      (eval-when-compile
 190                        ;; XXX: should provide char-list instead.
 191                        (string-to-char-list quoted-printable-hex-chars))))
 192           ;; encoded char.
 193           (insert
 194            (prog1
 195                (logior
 196                 (ash (quoted-printable-hex-char-to-num (char-after (point))) 4)
 197                 (quoted-printable-hex-char-to-num (char-after (1+ (point)))))
 198              (delete-region (1- (point))(+ 2 (point))))))
 199          (t
 200           ;; invalid encoding.
 201           ))))))
 202
 203 (defvar quoted-printable-external-decoder '("mmencode" "-q" "-u")
 204   "*list of quoted-printable decoder program name and its arguments.")
 205
 206 (defun quoted-printable-external-decode-region (start end)
 207   (save-excursion
 208     (as-binary-process
 209      (apply (function call-process-region)
 210             start end (car quoted-printable-external-decoder)
 211             t t nil
 212             (cdr quoted-printable-external-decoder)))))
 213
 214
 215 (defvar quoted-printable-internal-decoding-limit nil
 216   "*limit size to use internal quoted-printable decoder.
 217 If size of input to decode is larger than this limit,
 218 external decoder is called.")
 219
 220 (defun quoted-printable-decode-region (start end)
 221   "Decode current region by quoted-printable.
 222 START and END are buffer positions.
 223 This function calls internal quoted-printable decoder if size of
 224 region is smaller than `quoted-printable-internal-decoding-limit',
 225 otherwise it calls external quoted-printable decoder specified by
 226 `quoted-printable-external-decoder'.  In this case, you must install
 227 the program (maybe mmencode included in metamail or XEmacs package)."
 228   (interactive "*r")
 229   (if (and quoted-printable-internal-decoding-limit
 230            (> (- end start) quoted-printable-internal-decoding-limit))
 231       (quoted-printable-external-decode-region start end)
 232     (quoted-printable-internal-decode-region start end)))
 233
 234 (defun quoted-printable-decode-string (string)
 235   "Decode STRING which is encoded in quoted-printable, and return the result."
 236   (with-temp-buffer
 237     (insert string)
 238     (quoted-printable-decode-region (point-min)(point-max))
 239     (buffer-string)))
 240
 241
 242 (mel-define-method-function
 243  (mime-decode-string string (nil "quoted-printable"))
 244  'quoted-printable-decode-string)
 245
 246 (mel-define-method-function
 247  (mime-decode-region start end (nil "quoted-printable"))
 248  'quoted-printable-decode-region)
 249
 250
 251 (defvar quoted-printable-external-decoder-option-to-specify-file '("-o")
 252   "*list of options of quoted-printable decoder program to specify file.")
 253
 254 (mel-define-method mime-write-decoded-region (start end filename
 255                                                     (nil "quoted-printable"))
 256   "Decode and write current region encoded by quoted-printable into FILENAME.
 257 START and END are buffer positions."
 258   (interactive "*r\nFWrite decoded region to file: ")
 259   (as-binary-process
 260    (apply (function call-process-region)
 261           start end (car quoted-printable-external-decoder)
 262           nil nil nil
 263           (append (cdr quoted-printable-external-decoder)
 264                   quoted-printable-external-decoder-option-to-specify-file
 265                   (list filename)))))
 266
 267 \f
 268 ;;; @ Q-encoding encode/decode string
 269 ;;;
 270
 271 (defconst q-encoding-special-chars-alist
 272   '((text       ?= ?? ?_)
 273     (comment    ?= ?? ?_ ?\( ?\) ?\\)
 274     (phrase     ?= ?? ?_ ?\( ?\) ?\\ ?\" ?# ?$ ?% ?& ?' ?, ?. ?/
 275                 ?: ?\; ?< ?> ?@ ?\[ ?\] ?^ ?` ?{ ?| ?} ?~)
 276     ))
 277
 278 (defun q-encoding-encode-string (string &optional mode)
 279   "Encode STRING to Q-encoding of encoded-word, and return the result.
 280 MODE allows `text', `comment', `phrase' or nil.  Default value is
 281 `phrase'."
 282   (let ((specials (cdr (or (assq mode q-encoding-special-chars-alist)
 283                            (assq 'phrase q-encoding-special-chars-alist)))))
 284     (mapconcat (function
 285                 (lambda (chr)
 286                   (cond ((eq chr ? ) "_")
 287                         ((or (< chr 32) (< 126 chr)
 288                              (memq chr specials))
 289                          (quoted-printable-quote-char chr))
 290                         (t
 291                          (char-to-string chr)))))
 292                string "")))
 293
 294 (defun q-encoding-decode-string (string)
 295   "Decode STRING which is encoded in Q-encoding and return the result."
 296   (let (q h l)
 297     (mapconcat (function
 298                 (lambda (chr)
 299                   (cond ((eq chr ?_) " ")
 300                         ((eq chr ?=)
 301                          (setq q t)
 302                          "")
 303                         (q (setq h (quoted-printable-hex-char-to-num chr))
 304                            (setq q nil)
 305                            "")
 306                         (h (setq l (quoted-printable-hex-char-to-num chr))
 307                            (prog1
 308                                (char-to-string (logior (ash h 4) l))
 309                              (setq h nil)))
 310                         (t (char-to-string chr)))))
 311                string "")))
 312
 313 (mel-define-method-function (encoded-text-encode-string string (nil "Q"))
 314                             'q-encoding-encode-string)
 315
 316 (mel-define-method encoded-text-decode-string (string (nil "Q"))
 317   (if (string-match (eval-when-compile
 318                       (concat "\\`" Q-encoded-text-regexp "\\'"))
 319                     string)
 320       (q-encoding-decode-string string)
 321     (error "Invalid encoded-text %s" string)))
 322
 323
 324 ;;; @ end
 325 ;;;
 326
 327 (provide 'mel-q)
 328
 329 ;;; mel-q.el ends here.