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