ew-scan-m.el

   1 (require 'lex)
   2 (require 'automata)
   3 (require 'ew-data)
   4 (require 'ew-parse)
   5 (provide 'ew-scan-m)
   6
   7 (defmacro ew-scan-mime (scan col str)
   8   `(let ((res (ew-make-anchor col str))
   9          (mode 'token)
  10          (p 0)
  11          (q (length str))
  12          r
  13          type
  14          nest)
  15      (while (< p q)
  16        (setq r p)
  17        (cond
  18         ((eq mode 'token)
  19          (setq
  20           type
  21           (,scan
  22            str p q
  23            ([" \t"] 'ew:wsp)
  24            (?< 'ew:lt)
  25            (?> 'ew:gt)
  26            (?@ 'ew:at)
  27            (?, 'ew:comma)
  28            (?\; 'ew:semicolon)
  29            (?: 'ew:colon)
  30            (?/ 'ew:slash)
  31            (?? 'ew:question)
  32            (?= 'ew:equal)
  33            ((?\r ?\n [" \t"]) 'ew:fold)
  34            ((?\r ?\n [^ " \t"])
  35             (setq p q) 'ew:*err*)
  36            ((+ [(?a ?z) (?A ?Z) (?0 ?9) "!#$%&'*+-.^_`{|}~" non-ascii])
  37             'ew:token)
  38            (?\" (setq mode 'quoted-string) 'ew:qs-begin)
  39            (?\[ (setq mode 'domain-literal) 'ew:dl-begin)
  40            (?\( (setq mode 'comment
  41                       nest 1)
  42                 'ew:cm-begin)
  43            (() (setq p q) 'ew:*err*)))
  44          (ew-add-frag res r p type))
  45         ((eq mode 'quoted-string)
  46          (setq
  47           type
  48           (,scan
  49            str p q
  50            (?\" (setq mode 'token) 'ew:qs-end)
  51            ((?\\ ?\r ?\n [" \t"]) 'ew:qs-qfold)
  52            ((?\\ ?\r ?\n [^ " \t"])
  53             (setq p q) 'ew:*err*)
  54            (((* [^ "\"\\ \t\r"])
  55              (* (+ ?\r) [^ "\"\\ \t\r\n"] (* [^ "\"\\ \t\r"]))
  56              (* ?\r)
  57              (?\r ?\n [" \t"]))
  58             (when (< r (- p 3))
  59               (ew-add-frag res r (- p 3) 'ew:qs-texts)
  60               (setq r (- p 3)))
  61             'ew:qs-fold)
  62            (((* [^ "\"\\ \t\r"])
  63              (* (+ ?\r) [^ "\"\\ \t\r\n"] (* [^ "\"\\ \t\r"]))
  64              (* ?\r)
  65              (?\r ?\n [^ " \t"]))
  66             (when (< r (- p 3))
  67               (ew-add-frag res r (- p 3) 'ew:qs-texts)
  68               (setq r (- p 3)))
  69             (setq p q) 'ew:*err*)
  70            ((?\\ (any))
  71             'ew:qs-qpair)
  72            ([" \t"]
  73             'ew:qs-wsp)
  74            (((* [^ "\"\\ \t\r"])
  75              (* (+ ?\r) [^ "\"\\ \t\r\n"] (* [^ "\"\\ \t\r"]))
  76              (* ?\r))
  77             (if (< r p)
  78                 'ew:qs-texts
  79               (progn (setq p q) 'ew:*err*)))))
  80          (ew-add-frag res r p type))
  81         ((eq mode 'domain-literal)
  82          (setq
  83           type
  84           (,scan
  85            str p q
  86            (?\] (setq mode 'token) 'ew:dl-end)
  87            ((?\\ ?\r ?\n [" \t"])
  88             'ew:dl-qfold)
  89            ((?\\ ?\r ?\n [^ " \t"])
  90             (setq p q) 'ew:*err*)
  91            (((* [^ "[]\\ \t\r"])
  92              (* (+ ?\r) [^ "[]\\ \t\r\n"] (* [^ "[]\\ \t\r"]))
  93              (* ?\r)
  94              (?\r ?\n [" \t"]))
  95             (when (< r (- p 3))
  96               (ew-add-frag res r (- p 3) 'ew:dl-texts)
  97               (setq r (- p 3)))
  98             'ew:dl-fold)
  99            (((* [^ "[]\\ \t\r"])
 100              (* (+ ?\r) [^ "[]\\ \t\r\n"] (* [^ "[]\\ \t\r"]))
 101              (* ?\r)
 102              (?\r ?\n [^ " \t"]))
 103             (when (< r (- p 3))
 104               (ew-add-frag res r (- p 3) 'ew:dl-texts)
 105               (setq r (- p 3)))
 106             (setq p q) 'ew:*err*)
 107            ((?\\ (any))
 108             'ew:dl-qpair)
 109            ([" \t"]
 110             'ew:dl-wsp)
 111            (((* [^ "[]\\ \t\r"])
 112              (* (+ ?\r) [^ "[]\\ \t\r\n"] (* [^ "[]\\ \t\r"]))
 113              (* ?\r))
 114             (if (< r p)
 115                 'ew:dl-texts
 116               (progn (setq p q) 'ew:*err*)))))
 117          (ew-add-frag res r p type))
 118         ((eq mode 'comment)
 119          (setq
 120           type
 121           (,scan
 122            str p q
 123            (?\( (setq nest (1+ nest)) 'ew:cm-nested-begin)
 124            (?\) (setq nest (1- nest))
 125                 (if (zerop nest)
 126                     (progn (setq mode 'token) 'ew:cm-end)
 127                   'ew:cm-nested-end))
 128            ((?\\ ?\r ?\n [" \t"])
 129             'ew:cm-qfold)
 130            ((?\\ ?\r ?\n [^ " \t"])
 131             (setq p q) 'ew:*err*)
 132            (((* [^ "()\\ \t\r"])
 133              (* (+ ?\r) [^ "()\\ \t\r\n"] (* [^ "()\\ \t\r"]))
 134              (* ?\r)
 135              (?\r ?\n [" \t"]))
 136             (when (< r (- p 3))
 137               (ew-add-frag res r (- p 3) 'ew:cm-texts)
 138               (setq r (- p 3)))
 139             'ew:cm-fold)
 140            (((* [^ "()\\ \t\r"])
 141              (* (+ ?\r) [^ "()\\ \t\r\n"] (* [^ "()\\ \t\r"]))
 142              (* ?\r)
 143              (?\r ?\n [^ " \t"]))
 144             (when (< r (- p 3))
 145               (ew-add-frag res r (- p 3) 'ew:cm-texts)
 146               (setq r (- p 3)))
 147             (setq p q) 'ew:*err*)
 148            ((?\\ (any))
 149             'ew:cm-qpair)
 150            ([" \t"]
 151             'ew:cm-wsp)
 152            (((* [^ "()\\ \t\r"])
 153              (* (+ ?\r) [^ "()\\ \t\r\n"] (* [^ "()\\ \t\r"]))
 154              (* ?\r))
 155             (if (< r p)
 156                 'ew:cm-texts
 157               (progn (setq p q) 'ew:*err*)))))
 158          (ew-add-frag res r p type))))
 159      (ew-terminate res)
 160      res))
 161
 162 (defun ew-scan-unibyte-mime (col str)
 163   (ew-scan-mime lex-scan-unibyte col str))
 164 (defun ew-scan-multibyte-mime (col str)
 165   (ew-scan-mime lex-scan-multibyte col str))
 166
 167 '(
 168 (npp
 169  (mapcar
 170   (lambda (frag) (cons (get frag 'type) (symbol-name frag)))
 171   (ew-frag-list
 172    (ew-scan-unibyte-mime
 173     0 " text/vnd.latex-z; charset=ISO-2022-JP"))))
 174 )