ew-quote.el

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