X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=ew-scan-m.el;h=d8dbf85456558e09f957f24f3d288c1599a64325;hb=3c07ee018fb2fa3178e4eef483aee0326a2a52a6;hp=963a9e1a5a13e30943fb71d2157083c38b0d9e88;hpb=02131d141680f10cbd54eebf4b3fa726b0dea7a3;p=elisp%2Fflim.git

diff --git a/ew-scan-m.el b/ew-scan-m.el
index 963a9e1..d8dbf85 100644
--- a/ew-scan-m.el
+++ b/ew-scan-m.el
@@ -10,130 +10,152 @@
 	 (p 0)
 	 (q (length str))
 	 r
+	 type
 	 nest)
      (while (< p q)
        (setq r p)
        (cond
 	((eq mode 'token)
-	 (,scan
-	  str p q
-	  ([" \t"] (ew-add-frag res r p 'ew:wsp-tok))
-	  (?< (ew-add-token res r p 'ew:lt-tok))
-	  (?> (ew-add-token res r p 'ew:gt-tok))
-	  (?@ (ew-add-token res r p 'ew:at-tok))
-	  (?, (ew-add-token res r p 'ew:comma-tok))
-	  (?\; (ew-add-token res r p 'ew:semicolon-tok))
-	  (?: (ew-add-token res r p 'ew:colon-tok))
-	  (?/ (ew-add-token res r p 'ew:slash-tok))
-	  (?? (ew-add-token res r p 'ew:question-tok))
-	  (?= (ew-add-token res r p 'ew:equal-tok))
-	  ((?\r ?\n [" \t"])
-	   (ew-add-frag res r p 'ew:fold-tok))
-	  ((?\r ?\n [^ " \t"])
-	   (ew-add-frag res r (setq p q) 'ew:err-tok))
-	  ((+ [(?a ?z) (?A ?Z) (?0 ?9) "!#$%&'*+-.^_`{|}~" non-ascii])
-	   (ew-add-token res r p 'ew:token-tok))
-	  (?\" (ew-add-open res r p 'ew:qs-begin-tok)
-	       (setq mode 'quoted-string))
-	  (?\[ (ew-add-open res r p 'ew:dl-begin-tok)
-	       (setq mode 'domain-literal))
-	  (?\( (ew-add-open res r p 'ew:cm-begin-tok)
-	       (setq mode 'comment
-		     nest 1))
-	  (() (ew-add-frag res r q 'ew:err-tok) (setq p q))))
+	 (setq
+	  type
+	  (,scan
+	   str p q
+	   ([" \t"] 'ew:wsp)
+	   (?< 'ew:lt)
+	   (?> 'ew:gt)
+	   (?@ 'ew:at)
+	   (?, 'ew:comma)
+	   (?\; 'ew:semicolon)
+	   (?: 'ew:colon)
+	   (?/ 'ew:slash)
+	   (?? 'ew:question)
+	   (?= 'ew:equal)
+	   ((?\r ?\n [" \t"]) 'ew:fold)
+	   ((?\r ?\n [^ " \t"])
+	    (setq p q) 'ew:*err*)
+	   ((+ [(?a ?z) (?A ?Z) (?0 ?9) "!#$%&'*+-.^_`{|}~" non-ascii])
+	    'ew:token)
+	   (?\" (setq mode 'quoted-string) 'ew:qs-begin)
+	   (?\[ (setq mode 'domain-literal) 'ew:dl-begin)
+	   (?\( (setq mode 'comment
+		      nest 1)
+		'ew:cm-begin)
+	   (() (setq p q) 'ew:*err*)))
+	 (ew-add-frag res r p type))
 	((eq mode 'quoted-string)
-	 (,scan
-	  str p q
-	  (?\" (ew-add-close-token res r p 'ew:qs-end-tok)
-	       (setq mode 'token))
-	  ((?\\ ?\r ?\n [" \t"])
-	   (ew-add-frag res r p 'ew:qs-qfold-tok))
-	  ((?\\ ?\r ?\n [^ " \t"])
-	   (ew-add-frag res r (setq p q) 'ew:err-tok))
-	  (((* [^ "\"\\ \t\r"]) (* (+ ?\r) [^ "\"\\ \t\r\n"] (* [^ "\"\\ \t\r"])) (* ?\r)
-	    (?\r ?\n [" \t"]))
-	   (when (< r (- p 3))
-	     (ew-add-frag res r (- p 3) 'ew:qs-texts-tok)
-	     (setq r (- p 3)))
-	   (ew-add-frag res r p 'ew:qs-fold-tok))
-	  (((* [^ "\"\\ \t\r"]) (* (+ ?\r) [^ "\"\\ \t\r\n"] (* [^ "\"\\ \t\r"])) (* ?\r)
-	    (?\r ?\n [^ " \t"]))
-	   (when (< r (- p 3))
-	     (ew-add-frag res r (- p 3) 'ew:qs-texts-tok)
-	     (setq r (- p 3)))
-	   (ew-add-frag res r (setq p q) 'ew:err-tok))
-	  ((?\\ (any))
-	   (ew-add-frag res r p 'ew:qs-qpair-tok))
-	  ([" \t"]
-	   (ew-add-frag res r p 'ew:qs-wsp-tok))
-	  (((* [^ "\"\\ \t\r"]) (* (+ ?\r) [^ "\"\\ \t\r\n"] (* [^ "\"\\ \t\r"])) (* ?\r))
-	   (if (< r p)
-	       (ew-add-frag res r p 'ew:qs-texts-tok)
-	     (ew-add-frag res r (setq p q) 'ew:err-tok)))))
+	 (setq
+	  type
+	  (,scan
+	   str p q
+	   (?\" (setq mode 'token) 'ew:qs-end)
+	   ((?\\ ?\r ?\n [" \t"]) 'ew:qs-qfold)
+	   ((?\\ ?\r ?\n [^ " \t"])
+	    (setq p q) 'ew:*err*)
+	   (((* [^ "\"\\ \t\r"])
+	     (* (+ ?\r) [^ "\"\\ \t\r\n"] (* [^ "\"\\ \t\r"]))
+	     (* ?\r)
+	     (?\r ?\n [" \t"]))
+	    (when (< r (- p 3))
+	      (ew-add-frag res r (- p 3) 'ew:qs-texts)
+	      (setq r (- p 3)))
+	    'ew:qs-fold)
+	   (((* [^ "\"\\ \t\r"])
+	     (* (+ ?\r) [^ "\"\\ \t\r\n"] (* [^ "\"\\ \t\r"]))
+	     (* ?\r)
+	     (?\r ?\n [^ " \t"]))
+	    (when (< r (- p 3))
+	      (ew-add-frag res r (- p 3) 'ew:qs-texts)
+	      (setq r (- p 3)))
+	    (setq p q) 'ew:*err*)
+	   ((?\\ (any))
+	    'ew:qs-qpair)
+	   ([" \t"]
+	    'ew:qs-wsp)
+	   (((* [^ "\"\\ \t\r"])
+	     (* (+ ?\r) [^ "\"\\ \t\r\n"] (* [^ "\"\\ \t\r"]))
+	     (* ?\r))
+	    (if (< r p)
+		'ew:qs-texts
+	      (progn (setq p q) 'ew:*err*)))))
+	 (ew-add-frag res r p type))
 	((eq mode 'domain-literal)
-	 (,scan
-	  str p q
-	  (?\] (ew-add-close-token res r p 'ew:dl-end-tok)
-	       (setq mode 'token))
-	  ((?\\ ?\r ?\n [" \t"])
-	   (ew-add-frag res r p 'ew:dl-qfold-tok))
-	  ((?\\ ?\r ?\n [^ " \t"])
-	   (ew-add-frag res r (setq p q) 'ew:err-tok))
-	  (((* [^ "[]\\ \t\r"]) (* (+ ?\r) [^ "[]\\ \t\r\n"] (* [^ "[]\\ \t\r"])) (* ?\r)
-	    (?\r ?\n [" \t"]))
-	   (when (< r (- p 3))
-	     (ew-add-frag res r (- p 3) 'ew:dl-texts-tok)
-	     (setq r (- p 3)))
-	   (ew-add-frag res r p 'ew:dl-fold-tok))
-	  (((* [^ "[]\\ \t\r"]) (* (+ ?\r) [^ "[]\\ \t\r\n"] (* [^ "[]\\ \t\r"])) (* ?\r)
-	    (?\r ?\n [^ " \t"]))
-	   (when (< r (- p 3))
-	     (ew-add-frag res r (- p 3) 'ew:dl-texts-tok)
-	     (setq r (- p 3)))
-	   (ew-add-frag res r (setq p q) 'ew:err-tok))
-	  ((?\\ (any))
-	   (ew-add-frag res r p 'ew:dl-qpair-tok))
-	  ([" \t"]
-	   (ew-add-frag res r p 'ew:dl-wsp-tok))
-	  (((* [^ "[]\\ \t\r"]) (* (+ ?\r) [^ "[]\\ \t\r\n"] (* [^ "[]\\ \t\r"])) (* ?\r))
-	   (if (< r p)
-	       (ew-add-frag res r p 'ew:dl-texts-tok)
-	     (ew-add-frag res r (setq p q) 'ew:err-tok)))))
+	 (setq
+	  type
+	  (,scan
+	   str p q
+	   (?\] (setq mode 'token) 'ew:dl-end)
+	   ((?\\ ?\r ?\n [" \t"])
+	    'ew:dl-qfold)
+	   ((?\\ ?\r ?\n [^ " \t"])
+	    (setq p q) 'ew:*err*)
+	   (((* [^ "[]\\ \t\r"])
+	     (* (+ ?\r) [^ "[]\\ \t\r\n"] (* [^ "[]\\ \t\r"]))
+	     (* ?\r)
+	     (?\r ?\n [" \t"]))
+	    (when (< r (- p 3))
+	      (ew-add-frag res r (- p 3) 'ew:dl-texts)
+	      (setq r (- p 3)))
+	    'ew:dl-fold)
+	   (((* [^ "[]\\ \t\r"])
+	     (* (+ ?\r) [^ "[]\\ \t\r\n"] (* [^ "[]\\ \t\r"]))
+	     (* ?\r)
+	     (?\r ?\n [^ " \t"]))
+	    (when (< r (- p 3))
+	      (ew-add-frag res r (- p 3) 'ew:dl-texts)
+	      (setq r (- p 3)))
+	    (setq p q) 'ew:*err*)
+	   ((?\\ (any))
+	    'ew:dl-qpair)
+	   ([" \t"]
+	    'ew:dl-wsp)
+	   (((* [^ "[]\\ \t\r"])
+	     (* (+ ?\r) [^ "[]\\ \t\r\n"] (* [^ "[]\\ \t\r"]))
+	     (* ?\r))
+	    (if (< r p)
+		'ew:dl-texts
+	      (progn (setq p q) 'ew:*err*)))))
+	 (ew-add-frag res r p type))
 	((eq mode 'comment)
-	 (,scan
-	  str p q
-	  (?\( (ew-add-open res r p 'ew:cm-nested-begin-tok)
-	       (setq nest (1+ nest)))
-	  (?\) (setq nest (1- nest))
-	       (if (zerop nest)
-		   (progn
-		     (ew-add-close res r p 'ew:cm-end-tok)
-		     (setq mode 'token))
-		 (ew-add-close res r p 'ew:cm-nested-end-tok)))
-	  ((?\\ ?\r ?\n [" \t"])
-	   (ew-add-frag res r p 'ew:cm-qfold-tok))
-	  ((?\\ ?\r ?\n [^ " \t"])
-	   (ew-add-frag res r (setq p q) 'ew:err-tok))
-	  (((* [^ "()\\ \t\r"]) (* (+ ?\r) [^ "()\\ \t\r\n"] (* [^ "()\\ \t\r"])) (* ?\r)
-	    (?\r ?\n [" \t"]))
-	   (when (< r (- p 3))
-	     (ew-add-frag res r (- p 3) 'ew:cm-texts-tok)
-	     (setq r (- p 3)))
-	   (ew-add-frag res r p 'ew:cm-fold-tok))
-	  (((* [^ "()\\ \t\r"]) (* (+ ?\r) [^ "()\\ \t\r\n"] (* [^ "()\\ \t\r"])) (* ?\r)
-	    (?\r ?\n [^ " \t"]))
-	   (when (< r (- p 3))
-	     (ew-add-frag res r (- p 3) 'ew:cm-texts-tok)
-	     (setq r (- p 3)))
-	   (ew-add-frag res r (setq p q) 'ew:err-tok))
-	  ((?\\ (any))
-	   (ew-add-frag res r p 'ew:cm-qpair-tok))
-	  ([" \t"]
-	   (ew-add-frag res r p 'ew:cm-wsp-tok))
-	  (((* [^ "()\\ \t\r"]) (* (+ ?\r) [^ "()\\ \t\r\n"] (* [^ "()\\ \t\r"])) (* ?\r))
-	   (if (< r p)
-	       (ew-add-frag res r p 'ew:cm-texts-tok)
-	     (ew-add-frag res r (setq p q) 'ew:err-tok)))))))
+	 (setq
+	  type
+	  (,scan
+	   str p q
+	   (?\( (setq nest (1+ nest)) 'ew:cm-nested-begin)
+	   (?\) (setq nest (1- nest))
+		(if (zerop nest)
+		    (progn (setq mode 'token) 'ew:cm-end)
+		  'ew:cm-nested-end))
+	   ((?\\ ?\r ?\n [" \t"])
+	    'ew:cm-qfold)
+	   ((?\\ ?\r ?\n [^ " \t"])
+	    (setq p q) 'ew:*err*)
+	   (((* [^ "()\\ \t\r"])
+	     (* (+ ?\r) [^ "()\\ \t\r\n"] (* [^ "()\\ \t\r"]))
+	     (* ?\r)
+	     (?\r ?\n [" \t"]))
+	    (when (< r (- p 3))
+	      (ew-add-frag res r (- p 3) 'ew:cm-texts)
+	      (setq r (- p 3)))
+	    'ew:cm-fold)
+	   (((* [^ "()\\ \t\r"])
+	     (* (+ ?\r) [^ "()\\ \t\r\n"] (* [^ "()\\ \t\r"]))
+	     (* ?\r)
+	     (?\r ?\n [^ " \t"]))
+	    (when (< r (- p 3))
+	      (ew-add-frag res r (- p 3) 'ew:cm-texts)
+	      (setq r (- p 3)))
+	    (setq p q) 'ew:*err*)
+	   ((?\\ (any))
+	    'ew:cm-qpair)
+	   ([" \t"]
+	    'ew:cm-wsp)
+	   (((* [^ "()\\ \t\r"])
+	     (* (+ ?\r) [^ "()\\ \t\r\n"] (* [^ "()\\ \t\r"]))
+	     (* ?\r))
+	    (if (< r p)
+		'ew:cm-texts
+	      (progn (setq p q) 'ew:*err*)))))
+	 (ew-add-frag res r p type))))
      (ew-terminate res)
      res))