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