(std11-atom-regexp): Modify to match non-top atom.

(std11-analyze-spaces): Add new argument `start'; return (<parsed
result> . <end position>) instead of (<parsed result> . <rest
string>).
(std11-analyze-special): Likewise.
(std11-analyze-atom): Likewise.
(std11-analyze-quoted-string): Likewise.
(std11-analyze-domain-literal): Likewise.
(std11-analyze-comment): Likewise.
(std11-lexical-analyze): Add new optional argument `start'.

diff --git a/std11.el b/std11.el
index 3d9c802..b9d6817 100644 (file)
--- a/std11.el
+++ b/std11.el
@@ -272,43 +272,47 @@ If BOUNDARY is not nil, it is used as message header separator."
 ;;   (eval-when-compile (concat "[" std11-space-char-list "]+")))
 (defconst std11-atom-regexp
   (eval-when-compile
-    (concat "^[^" std11-special-char-list std11-space-char-list "]+")))
+    (concat "[^" std11-special-char-list std11-space-char-list "]+")))
 
-(defun std11-analyze-spaces (string)
-  (if (and (string-match
-           (eval-when-compile (concat "[" std11-space-char-list "]+"))
-           string)
-          (= (match-beginning 0) 0))
+(defun std11-analyze-spaces (string start)
+  (if (and (string-match (eval-when-compile
+                          (concat "[" std11-space-char-list "]+"))
+                        string start)
+          (= (match-beginning 0) start))
       (let ((end (match-end 0)))
-       (cons (cons 'spaces (substring string 0 end))
-             (substring string end)
-             ))))
-
-(defun std11-analyze-special (str)
-  (if (and (> (length str) 0)
-          (memq (aref str 0) std11-special-char-list))
-      (cons (cons 'specials (substring str 0 1))
-           (substring str 1)
-           )))
-
-(defun std11-analyze-atom (str)
-  (if (string-match std11-atom-regexp str)
+       (cons (cons 'spaces (substring string start end))
+             ;;(substring string end)
+             end)
+       )))
+
+(defun std11-analyze-special (string start)
+  (if (and (> (length string) start)
+          (memq (aref string start) std11-special-char-list))
+      (cons (cons 'specials (substring string start (1+ start)))
+           ;;(substring string 1)
+           (1+ start))
+    ))
+
+(defun std11-analyze-atom (string start)
+  (if (and (string-match std11-atom-regexp string start)
+          (= (match-beginning 0) start))
       (let ((end (match-end 0)))
-       (cons (cons 'atom (substring str 0 end))
-             (substring str end)
-             ))))
+       (cons (cons 'atom (substring string start end))
+             ;;(substring string end)
+             end)
+       )))
 
-(defun std11-check-enclosure (str open close &optional recursive from)
-  (let ((len (length str))
+(defun std11-check-enclosure (string open close &optional recursive from)
+  (let ((len (length string))
        (i (or from 0))
        )
     (if (and (> len i)
-            (eq (aref str i) open))
+            (eq (aref string i) open))
        (let (p chr)
          (setq i (1+ i))
          (catch 'tag
            (while (< i len)
-             (setq chr (aref str i))
+             (setq chr (aref string i))
              (cond ((eq chr ?\\)
                     (setq i (1+ i))
                     (if (>= i len)
@@ -322,7 +326,7 @@ If BOUNDARY is not nil, it is used as message header separator."
                    ((eq chr open)
                     (if (and recursive
                              (setq p (std11-check-enclosure
-                                      str open close recursive i))
+                                      string open close recursive i))
                              )
                         (setq i p)
                       (throw 'tag nil)
@@ -332,43 +336,49 @@ If BOUNDARY is not nil, it is used as message header separator."
                     ))
              ))))))
 
-(defun std11-analyze-quoted-string (str)
-  (let ((p (std11-check-enclosure str ?\" ?\")))
+(defun std11-analyze-quoted-string (string start)
+  (let ((p (std11-check-enclosure string ?\" ?\" nil start)))
     (if p
-       (cons (cons 'quoted-string (substring str 1 (1- p)))
-             (substring str p))
+       (cons (cons 'quoted-string (substring string (1+ start) (1- p)))
+             ;;(substring string p))
+             p)
       )))
 
-(defun std11-analyze-domain-literal (str)
-  (let ((p (std11-check-enclosure str ?\[ ?\])))
+(defun std11-analyze-domain-literal (string start)
+  (let ((p (std11-check-enclosure string ?\[ ?\] nil start)))
     (if p
-       (cons (cons 'domain-literal (substring str 1 (1- p)))
-             (substring str p))
+       (cons (cons 'domain-literal (substring string (1+ start) (1- p)))
+             ;;(substring string p))
+             p)
       )))
 
-(defun std11-analyze-comment (str)
-  (let ((p (std11-check-enclosure str ?\( ?\) t)))
+(defun std11-analyze-comment (string start)
+  (let ((p (std11-check-enclosure string ?\( ?\) t start)))
     (if p
-       (cons (cons 'comment (substring str 1 (1- p)))
-             (substring str p))
+       (cons (cons 'comment (substring string (1+ start) (1- p)))
+             ;;(substring string p))
+             p)
       )))
 
 ;;;###autoload
-(defun std11-lexical-analyze (string)
+(defun std11-lexical-analyze (string &optional start)
   "Analyze STRING as lexical tokens of STD 11."
-  (let (dest ret)
-    (while (not (string-equal string ""))
+  (or start
+      (setq start 0))
+  (let ((len (length string))
+       dest ret)
+    (while (< start len)
       (setq ret
-           (or (std11-analyze-quoted-string string)
-               (std11-analyze-domain-literal string)
-               (std11-analyze-comment string)
-               (std11-analyze-spaces string)
-               (std11-analyze-special string)
-               (std11-analyze-atom string)
-               '((error) . "")
+           (or (std11-analyze-quoted-string string start)
+               (std11-analyze-domain-literal string start)
+               (std11-analyze-comment string start)
+               (std11-analyze-spaces string start)
+               (std11-analyze-special string start)
+               (std11-analyze-atom string start)
+               (cons '(error) (1+ len))
                ))
-      (setq dest (cons (car ret) dest))
-      (setq string (cdr ret))
+      (setq dest (cons (car ret) dest)
+           start (cdr ret))
       )
     (nreverse dest)
     ))