7 ;;; @ Quoted-Printable (Q-encode) encoder/decoder
10 (defun quoted-printable-quote-char (chr)
12 (char-to-string (number-to-hex-char (ash chr -4)))
13 (char-to-string (number-to-hex-char (logand chr 15)))
16 (defun quoted-printable-encode-string-for-body (str)
19 (cond ((or (< chr 32) (< 126 chr) (eq chr ?=))
20 (quoted-printable-quote-char chr)
22 (t (char-to-string chr))
26 (defun quoted-printable-encode-string-for-text (str)
29 (cond ((eq chr 32) "_")
30 ((or (< chr 32) (< 126 chr) (eq chr ?=))
31 (quoted-printable-quote-char chr)
33 (t (char-to-string chr))
37 (defun quoted-printable-encode-string-for-comment (str)
40 (cond ((eq chr 32) "_")
41 ((or (< chr 32) (< 126 chr)
42 (memq chr '(?= ?\( ?\) ?\\))
44 (quoted-printable-quote-char chr)
46 (t (char-to-string chr))
50 (defun quoted-printable-encode-string-for-phrase (str)
53 (cond ((or (and (<= ?A chr)(<= chr ?Z))
54 (and (<= ?a chr)(<= chr ?z))
55 (and (<= ?0 chr)(<= chr ?9))
56 (memq chr '(?! ?* ?+ ?- ?/))
60 (t (quoted-printable-quote-char chr))
64 (defun quoted-printable-encode-string (str &optional mode)
65 (cond ((eq mode 'text)
66 (quoted-printable-encode-string-for-text str)
69 (quoted-printable-encode-string-for-comment str)
72 (quoted-printable-encode-string-for-phrase str)
74 (t (quoted-printable-encode-string-for-body str))
77 (defun quoted-printable-decode-string-for-body (str)
84 (q (setq h (hex-char-to-number chr))
87 (h (setq l (hex-char-to-number chr))
89 (char-to-string (logior (ash h 4) l))
93 (t (char-to-string chr))
97 (defun quoted-printable-decode-string-for-header (str)
101 (cond ((eq chr ?_) " ")
105 (q (setq h (hex-char-to-number chr))
108 (h (setq l (hex-char-to-number chr))
110 (char-to-string (logior (ash h 4) l))
114 (t (char-to-string chr))
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)
128 (defun quoted-printable-encoded-length (string &optional mode)
129 (let ((l 0)(i 0)(len (length string)) chr)
131 (setq chr (elt string i))
132 (if (string-match "[A-Za-z0-9!*+/=_---]" (char-to-string chr))