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