ew-scan-s.el

   1 (require 'lex)
   2 (require 'automata)
   3 (require 'ew-data)
   4 (require 'ew-parse)
   5 (provide 'ew-scan-s)
   6
   7 (defmacro ew-scan-std11 (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-dot-tok))
  28           ((?\r ?\n [" \t"])
  29            (ew-add-frag res r p 'ew:raw-fold-tok))
  30           ((?\r ?\n [^ " \t"])
  31            (ew-add-frag res r (setq p q) 'ew:raw-err-tok))
  32           ((+ [(?a ?z) (?A ?Z) (?0 ?9) "!#$%&'*+-/=?^_`{|}~" non-ascii])
  33            (ew-add-token res r p 'ew:raw-atom-tok))
  34           (?\" (ew-add-open res r p 'ew:raw-qs-begin-tok)
  35                (setq mode 'quoted-string))
  36           (?\[ (ew-add-open res r p 'ew:raw-dl-begin-tok)
  37                (setq mode 'domain-literal))
  38           (?\( (ew-add-open res r p 'ew:raw-cm-begin-tok)
  39                (setq mode 'comment
  40                      nest 1))
  41           (() (ew-add-frag res r q 'ew:raw-err-tok) (setq p q))))
  42         ((eq mode 'quoted-string)
  43          (,scan
  44           str p q
  45           (?\" (ew-add-close-token res r p 'ew:raw-qs-end-tok)
  46                (setq mode 'token))
  47           ((?\\ ?\r ?\n [" \t"])
  48            (ew-add-frag res r p 'ew:raw-qs-qfold-tok))
  49           ((?\\ ?\r ?\n [^ " \t"])
  50            (ew-add-frag res r (setq p q) 'ew:raw-err-tok))
  51           (((* [^ "\"\\ \t\r"]) (* (+ ?\r) [^ "\"\\ \t\r\n"] (* [^ "\"\\ \t\r"])) (* ?\r)
  52             (?\r ?\n [" \t"]))
  53            (when (< r (- p 3))
  54              (ew-add-frag res r (- p 3) 'ew:raw-qs-texts-tok)
  55              (setq r (- p 3)))
  56            (ew-add-frag res r p 'ew:raw-qs-fold-tok))
  57           (((* [^ "\"\\ \t\r"]) (* (+ ?\r) [^ "\"\\ \t\r\n"] (* [^ "\"\\ \t\r"])) (* ?\r)
  58             (?\r ?\n [^ " \t"]))
  59            (when (< r (- p 3))
  60              (ew-add-frag res r (- p 3) 'ew:raw-qs-texts-tok)
  61              (setq r (- p 3)))
  62            (ew-add-frag res r (setq p q) 'ew:raw-err-tok))
  63           ((?\\ (any))
  64            (ew-add-frag res r p 'ew:raw-qs-qpair-tok))
  65           ([" \t"]
  66            (ew-add-frag res r p 'ew:raw-qs-wsp-tok))
  67           (((* [^ "\"\\ \t\r"]) (* (+ ?\r) [^ "\"\\ \t\r\n"] (* [^ "\"\\ \t\r"])) (* ?\r))
  68            (if (< r p)
  69                (ew-add-frag res r p 'ew:raw-qs-texts-tok)
  70              (ew-add-frag res r (setq p q) 'ew:raw-err-tok)))))
  71         ((eq mode 'domain-literal)
  72          (,scan
  73           str p q
  74           (?\] (ew-add-close-token res r p 'ew:raw-dl-end-tok)
  75                (setq mode 'token))
  76           ((?\\ ?\r ?\n [" \t"])
  77            (ew-add-frag res r p 'ew:raw-dl-qfold-tok))
  78           ((?\\ ?\r ?\n [^ " \t"])
  79            (ew-add-frag res r (setq p q) 'ew:raw-err-tok))
  80           (((* [^ "[]\\ \t\r"]) (* (+ ?\r) [^ "[]\\ \t\r\n"] (* [^ "[]\\ \t\r"])) (* ?\r)
  81             (?\r ?\n [" \t"]))
  82            (when (< r (- p 3))
  83              (ew-add-frag res r (- p 3) 'ew:raw-dl-texts-tok)
  84              (setq r (- p 3)))
  85            (ew-add-frag res r p 'ew:raw-dl-fold-tok))
  86           (((* [^ "[]\\ \t\r"]) (* (+ ?\r) [^ "[]\\ \t\r\n"] (* [^ "[]\\ \t\r"])) (* ?\r)
  87             (?\r ?\n [^ " \t"]))
  88            (when (< r (- p 3))
  89              (ew-add-frag res r (- p 3) 'ew:raw-dl-texts-tok)
  90              (setq r (- p 3)))
  91            (ew-add-frag res r (setq p q) 'ew:raw-err-tok))
  92           ((?\\ (any))
  93            (ew-add-frag res r p 'ew:raw-dl-qpair-tok))
  94           ([" \t"]
  95            (ew-add-frag res r p 'ew:raw-dl-wsp-tok))
  96           (((* [^ "[]\\ \t\r"]) (* (+ ?\r) [^ "[]\\ \t\r\n"] (* [^ "[]\\ \t\r"])) (* ?\r))
  97            (if (< r p)
  98                (ew-add-frag res r p 'ew:raw-dl-texts-tok)
  99              (ew-add-frag res r (setq p q) 'ew:raw-err-tok)))))
 100         ((eq mode 'comment)
 101          (,scan
 102           str p q
 103           (?\( (ew-add-open res r p 'ew:raw-cm-nested-begin-tok)
 104                (setq nest (1+ nest)))
 105           (?\) (setq nest (1- nest))
 106                (if (zerop nest)
 107                    (progn
 108                      (ew-add-close res r p 'ew:raw-cm-end-tok)
 109                      (setq mode 'token))
 110                  (ew-add-close res r p 'ew:raw-cm-nested-end-tok)))
 111           ((?\\ ?\r ?\n [" \t"])
 112            (ew-add-frag res r p 'ew:raw-cm-qfold-tok))
 113           ((?\\ ?\r ?\n [^ " \t"])
 114            (ew-add-frag res r (setq p q) 'ew:raw-err-tok))
 115           (((* [^ "()\\ \t\r"]) (* (+ ?\r) [^ "()\\ \t\r\n"] (* [^ "()\\ \t\r"])) (* ?\r)
 116             (?\r ?\n [" \t"]))
 117            (when (< r (- p 3))
 118              (ew-add-frag res r (- p 3) 'ew:raw-cm-texts-tok)
 119              (setq r (- p 3)))
 120            (ew-add-frag res r p 'ew:raw-cm-fold-tok))
 121           (((* [^ "()\\ \t\r"]) (* (+ ?\r) [^ "()\\ \t\r\n"] (* [^ "()\\ \t\r"])) (* ?\r)
 122             (?\r ?\n [^ " \t"]))
 123            (when (< r (- p 3))
 124              (ew-add-frag res r (- p 3) 'ew:raw-cm-texts-tok)
 125              (setq r (- p 3)))
 126            (ew-add-frag res r (setq p q) 'ew:raw-err-tok))
 127           ((?\\ (any))
 128            (ew-add-frag res r p 'ew:raw-cm-qpair-tok))
 129           ([" \t"]
 130            (ew-add-frag res r p 'ew:raw-cm-wsp-tok))
 131           (((* [^ "()\\ \t\r"]) (* (+ ?\r) [^ "()\\ \t\r\n"] (* [^ "()\\ \t\r"])) (* ?\r))
 132            (if (< r p)
 133                (ew-add-frag res r p 'ew:raw-cm-texts-tok)
 134              (ew-add-frag res r (setq p q) 'ew:raw-err-tok)))))))
 135      (ew-terminate res)
 136      res))
 137
 138 (defun ew-scan-unibyte-std11 (col str)
 139   (ew-scan-std11 lex-scan-unibyte col str))
 140 (defun ew-scan-multibyte-std11 (col str)
 141   (ew-scan-std11 lex-scan-multibyte col str))
 142
 143 '(
 144 (npp
 145  (mapcar
 146   'symbol-plist
 147   (ew-frag-list
 148    (ew-scan-unibyte-std11
 149     0 " Tanaka Akira <akr@jaist.ac.jp> (Tanaka Akira)"))))
 150
 151 (npp
 152  (mapcar
 153   (lambda (frag) (cons (get frag 'type) (symbol-name frag)))
 154   (ew-frag-list
 155    (ew-scan-unibyte-std11
 156     0 " Tanaka Akira <akr@jaist.ac.jp> (Tanaka Akira)"))))
 157 )