From d5a8cfefbe505950eabdf70d319c43a95e5099c4 Mon Sep 17 00:00:00 2001
From: Alexander Kahl <e-user@fsfe.org>
Date: Mon, 31 Jan 2011 21:17:15 +0100
Subject: [PATCH] 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 | 10 +++++-----
 src/m4-parser.lisp  | 17 ++++++++++++-----
 src/m4-util.lisp    |  9 ++++++---
 3 files changed, 23 insertions(+), 13 deletions(-)

diff --git a/src/m4-builtin.lisp b/src/m4-builtin.lisp
index a82d636..6e99c7e 100644
--- a/src/m4-builtin.lisp
+++ b/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'")
            "")))
diff --git a/src/m4-parser.lisp b/src/m4-parser.lisp
index f4dbd8c..5bf689e 100644
--- a/src/m4-parser.lisp
+++ b/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)
diff --git a/src/m4-util.lisp b/src/m4-util.lisp
index a7c3814..991caf0 100644
--- a/src/m4-util.lisp
+++ b/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*)