ew-quote.el

   1 ;;; quoted encoded word library
   2
   3 (require 'ew-var)
   4 (require 'ew-util)
   5 (require 'ew-line)
   6 (provide 'ew-quote)
   7
   8 ;; This library provides functions operating strings embedding
   9 ;; unencodable encoded words.
  10
  11 ;;;type   embedded-pattern     denoted-pattern
  12 ;; Type-0 =?(QQQ)*A?B?C?=      =?(Q)*A?B?C?=
  13 ;; Type-1 =?(QQQ)*QA?B?C?=     Decode =?(Q)*A?B?C?= as encoded-word
  14 ;; Type-2 =?(QQQ)*QQA?B?C?=    =?(Q)*A?B?C?
  15
  16 ;; Q : quoting character '+'.
  17 ;; A : token. But it does not start with quoting character.
  18 ;; B : token.
  19 ;; C : encoded-text.
  20
  21 (eval-and-compile
  22   (defconst ew-quoting-char ?+))
  23 (defconst ew-quoting-chars-regexp
  24   (eval-when-compile
  25     (concat (regexp-quote (char-to-string ew-quoting-char)) "*")))
  26
  27 (defconst ew-type2-regexp
  28   (eval-when-compile
  29     (require 'ew-var)
  30     (concat (regexp-quote "=?")
  31             "\\(" ew-token-regexp "\\)"
  32             (regexp-quote "?")
  33             "\\(" ew-token-regexp "\\)"
  34             (regexp-quote "?")
  35             "\\(" ew-encoded-text-regexp "\\)"
  36             (regexp-quote "?")
  37             "\\'")))
  38
  39 ;;;
  40
  41 (defun ew-quoting-char-seq (num)
  42   (make-string num ew-quoting-char))
  43
  44 (defun ew-quote (str)
  45   (ew-quote-concat str))
  46
  47 (defun ew-concat (&rest args)
  48   (apply 'ew-quote-concat (mapcar 'list args)))
  49
  50 (defun ew-quote-concat (&rest args)
  51   (let (result raws tmp)
  52     (while args
  53       (setq tmp (car args))
  54       (cond
  55        ((stringp tmp)
  56         ;; raw string
  57         (setq raws (cons tmp raws)))
  58        ((listp tmp)
  59         ;; quoted encoded word embedding strings
  60         (let (str start eword-start charset-start quoting-end eword-end l q r)
  61           (while tmp
  62             (setq str (car tmp)
  63                   start 0)
  64             (while (string-match ew-encoded-word-regexp str start)
  65               (setq eword-start (match-beginning 0)
  66                     charset-start (match-beginning 1)
  67                     eword-end (match-end 0))
  68               (string-match ew-quoting-chars-regexp str charset-start)
  69               (setq quoting-end (match-end 0)
  70                     l (- quoting-end charset-start)
  71                     q (/ l 3)
  72                     r (% l 3))
  73               (cond
  74                ((= r 0) ; Type-0
  75                 (setq raws
  76                       (ew-rcons*
  77                        raws
  78                        (substring str start charset-start)
  79                        (ew-quoting-char-seq q)
  80                        (substring str quoting-end eword-end))))
  81                ((= r 2) ; Type-2
  82                 (setq raws
  83                       (ew-rcons*
  84                        raws
  85                        (substring str start charset-start)
  86                        (ew-quoting-char-seq q)
  87                        (substring str quoting-end (1- eword-end)))))
  88                ((= r 1) ; Type-1
  89                 (setq raws
  90                       (ew-rcons*
  91                        raws
  92                        (substring str start eword-start))
  93                       result
  94                       (ew-rcons*
  95                        result
  96                        (ew-quote-sole (apply 'concat (nreverse raws)) t)
  97                        (substring str eword-start eword-end))
  98                       raws ())))
  99               (setq start eword-end))
 100             (setq raws (ew-rcons* raws (substring str start))
 101                   tmp (cdr tmp)))))
 102        (t
 103         (error "ew-quote-concat: %s" tmp)))
 104       (setq args (cdr args)))
 105     (setq result
 106           (ew-rcons*
 107            result
 108            (ew-quote-sole (apply 'concat (nreverse raws)) nil)))
 109     (apply 'concat (nreverse result))))
 110
 111 (defun ew-quote-sole (str gen-type2)
 112   (let (result (start 0) charset-start quoting-end eword-end l)
 113     (while (string-match ew-encoded-word-regexp str start)
 114       (setq charset-start (match-beginning 1)
 115             eword-end (match-end 0))
 116       (string-match ew-quoting-chars-regexp str charset-start)
 117       (setq quoting-end (match-end 0)
 118             l (* (- quoting-end charset-start) 3)
 119             result
 120             (ew-rcons*
 121              result
 122              (substring str start charset-start)
 123              (ew-quoting-char-seq l)
 124              (substring str quoting-end eword-end))
 125             start eword-end))
 126     (if (and gen-type2
 127              (string-match ew-type2-regexp str start))
 128         (progn
 129           (setq charset-start (match-beginning 1)
 130                 eword-end (match-end 0))
 131           (string-match ew-quoting-chars-regexp str charset-start)
 132           (setq quoting-end (match-end 0)
 133                 l (* (- quoting-end charset-start) 3)
 134                 result
 135                 (ew-rcons*
 136                  result
 137                  (substring str start charset-start)
 138                  (ew-quoting-char-seq (+ l 2))
 139                  (substring str quoting-end eword-end)
 140                  "=")))
 141       (setq result (ew-rcons* result (substring str start))))
 142     (apply 'concat (nreverse result))))
 143
 144 (defun ew-quote-eword (charset encoding encoded-text)
 145   (string-match ew-quoting-chars-regexp charset)
 146   (concat
 147    "=?+" ; Type-1
 148    (ew-quoting-char-seq (* (- (match-end 0) (match-beginning 0)) 3))
 149    (substring charset (match-end 0))
 150    "?"
 151    encoding
 152    "?"
 153    encoded-text
 154    "?="))
 155
 156 (defun ew-encode-crlf (str)
 157   (if ew-remove-bare-crlf
 158       (ew-crlf-line-convert str nil nil (lambda (nl) ""))
 159     (let ((sstart 0)
 160           (mstart 0)
 161           (end (length str)) result ms me)
 162       (while (string-match "\\(\r\n\\)+" str mstart)
 163         (setq ms (match-beginning 0)
 164               me (match-end 0))
 165         (setq mstart me)
 166         (when (and (< me end)
 167                    (member (aref str me) '(?\t ?\ )))
 168           (setq me (- me 2)))
 169         (when (< ms me)
 170           (setq result (ew-rcons* result
 171                                   (substring str sstart ms)
 172                                   "=?+US-ASCII?Q?")
 173                 sstart me)
 174           (while (< ms me)
 175             (setq result (ew-rcons* result "=0D=0A")
 176                   ms (+ ms 2)))
 177           (setq result (ew-rcons* result "?="))))
 178       (when (< sstart end)
 179         (setq result (ew-rcons* result
 180                                 (substring str sstart))))
 181       (apply 'concat (nreverse result)))))
 182
 183 '(
 184 (ew-quote-concat "aaa=?A?B?C?=ccc") ;"aaa=?A?B?C?=ccc"
 185 (ew-quote-concat "aaa=?+A?B?C?=ccc") ;"aaa=?+++A?B?C?=ccc"
 186 (ew-quote-concat '("aaa=?A?B?C?=ccc")) ;"aaa=?A?B?C?=ccc"
 187 (ew-quote-concat '("aaa=?+++A?B?C?=ccc")) ;"aaa=?+++A?B?C?=ccc"
 188 (ew-quote-concat "aaa=?+A?B" "?C?=ccc") ;"aaa=?+++A?B?C?=ccc"
 189 (ew-quote-concat "a=?+A?B?C?" '("=?+US-ASCII?Q?z?=")) ;"a=?+++++A?B?C?==?+US-ASCII?Q?z?="
 190 (ew-quote-concat "a=?+A?B?C?=?+D?E?F?" '("=?+US-ASCII?Q?z?=")) ;"a=?+++A?B?C?=?+D?E?F?=?+US-ASCII?Q?z?="
 191 (ew-quote-concat "a=?+A?B?C?=?+D?E?F?=?+G?H?I?" '("=?+US-ASCII?Q?z?=")) ;"a=?+++A?B?C?=?+D?E?F?=?+++++G?H?I?==?+US-ASCII?Q?z?="
 192 (ew-quote-concat '("a=?++A?B?C?==?+++A?B?C?=c")) ;"a=?A?B?C?=?+A?B?C?=c"
 193 )