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