added nesting level handling

removed heredoc for regexp again
created common condition for m4 macro invocations
added wrapper stub for macro hooks

src/m4-builtin.lisp

@@ -116,8 +116,8 @@
          "")
         ((and (= 1 (length args))
               (m4-macro (car args) t)) ; builtin macro
-         (error 'macro-defn-invocation-condition
-                :macro (make-macro-token (m4-macro (car args) t) (car args))))
+         (signal 'macro-defn-invocation-condition
+                 :macro (make-macro-token (m4-macro (car args) t) (car args))))
         (t (macro-return
             (apply #'concatenate 'string            
                    (mapcar #'(lambda (name)
@@ -211,7 +211,7 @@
 ;; TODO traceon, traceoff, debugmode, debugfile
 
 (defm4macro "dnl" () (:arguments-only nil)
-  (error 'macro-dnl-invocation-condition))
+  (signal 'macro-dnl-invocation-condition))
 
 (defm4macro "changequote" (&optional (start "`") (end "'")) (:arguments-only nil)
   (prog1 ""
@@ -240,7 +240,7 @@
                                                     (read-sequence string stream)
                                                     string)))
                       (macro-invocation-condition (condition)
-                        (error condition))
+                        (signal condition))
                       (condition ()
                         (format nil "cannot open `~a': Permission denied" original-arg))))))
          (m4-include (path warnfn)
@@ -334,7 +334,7 @@
                (macro-return (subseq string start end))
              ""))
          (macro-invocation-condition (condition)
-           (error condition))
+           (signal condition))
          (condition ()
            (m4-warn "non-numeric argument to builtin `substr'")
            "")))

src/m4-parser.lisp

@@ -47,9 +47,13 @@
 (defun call-m4-macro (macro macro-name args lexer)
   (let ((*m4-parse-row* (lexer-row lexer))
         (*m4-parse-column* (lexer-column lexer)))
-    (if (not args)
-        (funcall macro macro-name nil)
-      (apply macro macro-name nil (split-merge args :separator)))))
+    (handler-case
+        (if (not args)
+            (funcall macro macro-name nil)
+            (apply macro macro-name nil (split-merge args :separator)))
+      (macro-condition (condition)
+        ; TODO
+        (signal condition)))))
 
 (defun m4-out (word)
   (with-m4-diversion-stream (out)
@@ -149,7 +153,9 @@
                (m4-warn "end of file treated as newline"))))))))
 
 (defun parse-m4-macro (lexer macro-name)
-  (let ((macro (m4-macro macro-name)))
+  (let ((macro (m4-macro macro-name))
+        (level *m4-nesting-level*)
+        (*m4-nesting-level* (1+ *m4-nesting-level*)))
     (if (not macro)
         macro-name
       (handler-case
@@ -202,11 +208,12 @@
          (*m4-quote-end* "'")
          (*m4-comment-start* "#")
          (*m4-comment-end* "\\n")
-         (*m4-macro-name* #>|>[_a-zA-Z]\w*|)
+         (*m4-macro-name* "[_a-zA-Z]\\w*")
          (*m4-wrap-stack* (list))
          (*m4-include-path* (append (reverse prepend-include-path) (list ".") include-path))
          (*m4-diversion* 0)
          (*m4-diversion-table* (make-m4-diversion-table output-stream))
+         (*m4-nesting-level* 0)
          (lexer (make-instance 'm4-input-stream
                                :stream input-stream
                                :rules '((*m4-comment-start* . :comment-start)

src/m4-util.lisp

@@ -21,13 +21,15 @@
 (defstruct (macro-token (:constructor make-macro-token (m4macro name)))
   m4macro name)
 
-(define-condition macro-invocation-condition (error)
+(define-condition macro-condition (error) ())
+
+(define-condition macro-invocation-condition (macro-condition)
   ((result :initarg :result
            :reader macro-invocation-result)))
 
-(define-condition macro-dnl-invocation-condition (error) ())
+(define-condition macro-dnl-invocation-condition (macro-condition) ())
 
-(define-condition macro-defn-invocation-condition (error)
+(define-condition macro-defn-invocation-condition (macro-condition)
   ((macro :initarg :macro
           :reader macro-defn-invocation-result)))
 
@@ -116,6 +118,7 @@ searched additionally passing ARGS."
 (defvar *m4-include-path*)
 (defvar *m4-diversion*)
 (defvar *m4-diversion-table*)
+(defvar *m4-nesting-level*)
 (defvar *m4-parse-row*)
 (defvar *m4-parse-column*)