mel-q.el

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