qprint.el

   1 ;;;
   2 ;;; $Id$
   3 ;;;
   4
   5 (require 'tl-num)
   6
   7 ;;; @ Quoted-Printable (Q-encode) encoder/decoder
   8 ;;;
   9
  10 (defun quoted-printable-quote-char (chr)
  11   (concat "="
  12           (char-to-string (number-to-hex-char (ash chr -4)))
  13           (char-to-string (number-to-hex-char (logand chr 15)))
  14           ))
  15
  16 (defun quoted-printable-encode-string-for-body (str)
  17   (mapconcat (function
  18               (lambda (chr)
  19                 (cond ((or (< chr 32) (< 126 chr) (eq chr ?=))
  20                        (quoted-printable-quote-char chr)
  21                        )
  22                       (t (char-to-string chr))
  23                       )))
  24              str ""))
  25
  26 (defun quoted-printable-encode-string-for-text (str)
  27   (mapconcat (function
  28               (lambda (chr)
  29                 (cond ((eq chr 32) "_")
  30                       ((or (< chr 32) (< 126 chr) (eq chr ?=))
  31                        (quoted-printable-quote-char chr)
  32                        )
  33                       (t (char-to-string chr))
  34                       )))
  35              str ""))
  36
  37 (defun quoted-printable-encode-string-for-comment (str)
  38   (mapconcat (function
  39               (lambda (chr)
  40                 (cond ((eq chr 32) "_")
  41                       ((or (< chr 32) (< 126 chr)
  42                            (memq chr '(?= ?\( ?\) ?\\))
  43                            )
  44                        (quoted-printable-quote-char chr)
  45                        )
  46                       (t (char-to-string chr))
  47                       )))
  48              str ""))
  49
  50 (defun quoted-printable-encode-string-for-phrase (str)
  51   (mapconcat (function
  52               (lambda (chr)
  53                 (cond ((or (and (<= ?A chr)(<= chr ?Z))
  54                            (and (<= ?a chr)(<= chr ?z))
  55                            (and (<= ?0 chr)(<= chr ?9))
  56                            (memq chr '(?! ?* ?+ ?- ?/))
  57                            )
  58                        (char-to-string chr)
  59                        )
  60                       (t (quoted-printable-quote-char chr))
  61                       )))
  62              str ""))
  63
  64 (defun quoted-printable-encode-string (str &optional mode)
  65   (cond ((eq mode 'text)
  66          (quoted-printable-encode-string-for-text str)
  67          )
  68         ((eq mode 'comment)
  69          (quoted-printable-encode-string-for-comment str)
  70          )
  71         ((eq mode 'phrase)
  72          (quoted-printable-encode-string-for-phrase str)
  73          )
  74         (t (quoted-printable-encode-string-for-body str))
  75         ))
  76
  77 (defun quoted-printable-decode-string-for-body (str)
  78   (let (q h l)
  79     (mapconcat (function
  80                 (lambda (chr)
  81                   (cond ((eq chr ?=)
  82                          (setq q t)
  83                          "")
  84                         (q (setq h (hex-char-to-number chr))
  85                            (setq q nil)
  86                            "")
  87                         (h (setq l (hex-char-to-number chr))
  88                            (prog1
  89                                (char-to-string (logior (ash h 4) l))
  90                              (setq h nil)
  91                              )
  92                            )
  93                         (t (char-to-string chr))
  94                         )))
  95                str "")))
  96
  97 (defun quoted-printable-decode-string-for-header (str)
  98   (let (q h l)
  99     (mapconcat (function
 100                 (lambda (chr)
 101                   (cond ((eq chr ?_) " ")
 102                         ((eq chr ?=)
 103                          (setq q t)
 104                          "")
 105                         (q (setq h (hex-char-to-number chr))
 106                            (setq q nil)
 107                            "")
 108                         (h (setq l (hex-char-to-number chr))
 109                            (prog1
 110                                (char-to-string (logior (ash h 4) l))
 111                              (setq h nil)
 112                              )
 113                            )
 114                         (t (char-to-string chr))
 115                         )))
 116                str "")))
 117
 118 (defun quoted-printable-decode-string (str &optional mode)
 119   (if (eq mode 'header)
 120       (quoted-printable-decode-string-for-header str)
 121     (quoted-printable-decode-string-for-body str)
 122     ))
 123
 124
 125 ;;; @ etc
 126 ;;;
 127
 128 (defun quoted-printable-encoded-length (string &optional mode)
 129   (let ((l 0)(i 0)(len (length string)) chr)
 130     (while (< i len)
 131       (setq chr (elt string i))
 132       (if (string-match "[A-Za-z0-9!*+/=_---]" (char-to-string chr))
 133           (setq l (+ l 1))
 134         (setq l (+ l 3))
 135         )
 136       (setq i (+ i 1)) )
 137     l))
 138
 139 (provide 'qprint)