changeset 367:28d3d7210687

Improving indentation of XML after antiquote
author Adam Chlipala <adamc@hcoop.net>
date Thu, 16 Oct 2008 13:30:40 -0400
parents 3004f8843e36
children b6be16792584
files lib/top.ur src/elisp/urweb-mode.el tests/crud.ur
diffstat 3 files changed, 118 insertions(+), 97 deletions(-) [+]
line wrap: on
line diff
--- a/lib/top.ur	Thu Oct 16 13:17:09 2008 -0400
+++ b/lib/top.ur	Thu Oct 16 13:30:40 2008 -0400
@@ -34,10 +34,10 @@
              (fn _ => i)
 
 fun foldT2R (tf :: (Type * Type) -> Type) (tr :: {(Type * Type)} -> Type)
-        (f : nm :: Name -> t :: (Type * Type) -> rest :: {(Type * Type)}
-             -> fn [[nm] ~ rest] =>
-                   tf t -> tr rest -> tr ([nm = t] ++ rest))
-        (i : tr []) =
+            (f : nm :: Name -> t :: (Type * Type) -> rest :: {(Type * Type)}
+                 -> fn [[nm] ~ rest] =>
+                       tf t -> tr rest -> tr ([nm = t] ++ rest))
+            (i : tr []) =
     fold [fn r :: {(Type * Type)} => $(mapT2T tf r) -> tr r]
              (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
                               (acc : _ -> tr rest) [[nm] ~ rest] r =>
@@ -45,10 +45,10 @@
              (fn _ => i)
 
 fun foldTR2 (tf1 :: Type -> Type) (tf2 :: Type -> Type) (tr :: {Type} -> Type)
-        (f : nm :: Name -> t :: Type -> rest :: {Type}
-             -> fn [[nm] ~ rest] =>
-                   tf1 t -> tf2 t -> tr rest -> tr ([nm = t] ++ rest))
-        (i : tr []) =
+            (f : nm :: Name -> t :: Type -> rest :: {Type}
+                 -> fn [[nm] ~ rest] =>
+                       tf1 t -> tf2 t -> tr rest -> tr ([nm = t] ++ rest))
+            (i : tr []) =
     fold [fn r :: {Type} => $(mapTT tf1 r) -> $(mapTT tf2 r) -> tr r]
              (fn (nm :: Name) (t :: Type) (rest :: {Type})
                               (acc : _ -> _ -> tr rest) [[nm] ~ rest] r1 r2 =>
--- a/src/elisp/urweb-mode.el	Thu Oct 16 13:17:09 2008 -0400
+++ b/src/elisp/urweb-mode.el	Thu Oct 16 13:30:40 2008 -0400
@@ -478,6 +478,25 @@
             (setq done t))))
       (and (not done) (> depth 0)))))
 
+(defun skip-matching-braces ()
+  "Skip backwards past matching brace pairs, to calculate XML indentation after quoted Ur code"
+  (beginning-of-line)
+  (let ((start-pos (point))
+        (depth 0))
+    (end-of-line)
+    (while (re-search-backward "[{}]" start-pos t)
+      (cond
+       ((looking-at "}")
+        (incf depth))
+       ((looking-at "{")
+        (decf depth))))
+    (while (and (> depth 0) (re-search-backward "[{}]" nil t)
+      (cond
+       ((looking-at "}")
+        (incf depth))
+       ((looking-at "{")
+        (decf depth)))))))
+
 (defun urweb-tag-matching-indent ()
   "Seek back to a matching opener tag and get its line's indent"
   (save-excursion
@@ -520,7 +539,7 @@
         (and (urweb-in-xml)
              (let ((prev-indent (save-excursion
                                   (previous-line 1)
-                                  (end-of-line 1)
+                                  (skip-matching-braces)
                                   (re-search-backward "^[^\n]" nil t)
                                   (current-indentation))))
                (cond
--- a/tests/crud.ur	Thu Oct 16 13:17:09 2008 -0400
+++ b/tests/crud.ur	Thu Oct 16 13:30:40 2008 -0400
@@ -46,111 +46,113 @@
 sequence seq
 
 fun create (inputs : $(mapT2T sndTT M.cols)) =
-        id <- nextval seq;
-        () <- dml (insert tab (foldT2R2 [sndTT] [colMeta]
-                [fn cols => $(mapT2T (fn t :: (Type * Type) =>
-                        sql_exp [] [] [] t.1) cols)]
-                (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
-                                 [[nm] ~ rest] =>
-                 fn input col acc => acc with nm = sql_inject col.Inject (col.Parse input))
-                {} [M.cols] inputs M.cols
-                with #Id = (SQL {id})));
-        return <xml><body>
-                Inserted with ID {txt _ id}.
-        </body></xml>
+    id <- nextval seq;
+    () <- dml (insert tab
+                      (foldT2R2 [sndTT] [colMeta]
+                                [fn cols => $(mapT2T (fn t :: (Type * Type) =>
+                                                         sql_exp [] [] [] t.1) cols)]
+                                (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
+                                                 [[nm] ~ rest] =>
+                                 fn input col acc => acc with nm = sql_inject col.Inject (col.Parse input))
+                                {} [M.cols] inputs M.cols
+                       with #Id = (SQL {id})));
+    return <xml><body>
+      Inserted with ID {txt _ id}.
+    </body></xml>
 
 fun save (id : int) (inputs : $(mapT2T sndTT M.cols)) =
-        () <- dml (update [mapT2T fstTT M.cols] (foldT2R2 [sndTT] [colMeta]
-                [fn cols => $(mapT2T (fn t :: (Type * Type) =>
-                        sql_exp [T = [Id = int] ++ mapT2T fstTT M.cols] [] [] t.1) cols)]
-                (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
-                                 [[nm] ~ rest] =>
-                 fn input col acc => acc with nm = sql_inject col.Inject (col.Parse input))
-                {} [M.cols] inputs M.cols)
-                tab (WHERE T.Id = {id}));
-        return <xml><body>
-                Saved!
-        </body></xml>
+    () <- dml (update [mapT2T fstTT M.cols]
+                      (foldT2R2 [sndTT] [colMeta]
+                                [fn cols => $(mapT2T (fn t :: (Type * Type) =>
+                                                         sql_exp [T = [Id = int] ++ mapT2T fstTT M.cols] [] [] t.1) cols)]
+                                (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
+                                                 [[nm] ~ rest] =>
+                                 fn input col acc => acc with nm = sql_inject col.Inject (col.Parse input))
+                                {} [M.cols] inputs M.cols)
+                      tab (WHERE T.Id = {id}));
+    return <xml><body>
+      Saved!
+    </body></xml>
 
 fun update (id : int) =
-        fso <- oneOrNoRows (SELECT tab.{{mapT2T fstTT M.cols}} FROM tab WHERE tab.Id = {id});
-        case fso : (Basis.option {Tab : $(mapT2T fstTT M.cols)}) of
-          None => return <xml><body>Not found!</body></xml>
-        | Some fs => return <xml><body><form>
-                {foldT2R2 [fstTT] [colMeta] [fn cols :: {(Type * Type)} => xml form [] (mapT2T sndTT cols)]
-                        (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
-                                         [[nm] ~ rest] (v : t.1) (col : colMeta t)
-                                         (acc : xml form [] (mapT2T sndTT rest)) =>
-                            <xml>
-                              <li> {cdata col.Nam}: {col.WidgetPopulated [nm] v}</li>
-                              {useMore acc}
-                            </xml>)
-                        <xml/>
-                        [M.cols] fs.Tab M.cols}
+    fso <- oneOrNoRows (SELECT tab.{{mapT2T fstTT M.cols}} FROM tab WHERE tab.Id = {id});
+    case fso : (Basis.option {Tab : $(mapT2T fstTT M.cols)}) of
+        None => return <xml><body>Not found!</body></xml>
+      | Some fs => return <xml><body><form>
+          {foldT2R2 [fstTT] [colMeta] [fn cols :: {(Type * Type)} => xml form [] (mapT2T sndTT cols)]
+                    (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
+                                     [[nm] ~ rest] (v : t.1) (col : colMeta t)
+                                     (acc : xml form [] (mapT2T sndTT rest)) =>
+                        <xml>
+                          <li> {cdata col.Nam}: {col.WidgetPopulated [nm] v}</li>
+                          {useMore acc}
+                          </xml>)
+                    <xml/>
+                    [M.cols] fs.Tab M.cols}
 
-                <submit action={save id}/>
-        </form></body></xml>
+                    <submit action={save id}/>
+      </form></body></xml>
 
 fun delete (id : int) =
-        () <- dml (DELETE FROM tab WHERE Id = {id});
-        return <xml><body>
-                The deed is done.
-        </body></xml>
+    () <- dml (DELETE FROM tab WHERE Id = {id});
+    return <xml><body>
+        The deed is done.
+    </body></xml>
 
 fun confirm (id : int) = return <xml><body>
-        <p>Are you sure you want to delete ID #{txt _ id}?</p>
- 
-        <p><a link={delete id}>I was born sure!</a></p>
+    <p>Are you sure you want to delete ID #{txt _ id}?</p>
+
+    <p><a link={delete id}>I was born sure!</a></p>
 </body></xml>
 
 fun main () =
-        rows <- queryX (SELECT * FROM tab AS T)
-                (fn (fs : {T : $([Id = int] ++ mapT2T fstTT M.cols)}) => <xml>
-                        <tr>
-                                <td>{txt _ fs.T.Id}</td>
-                                {foldT2RX2 [fstTT] [colMeta] [tr]
-                                        (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
-                                                [[nm] ~ rest] v col => <xml>
-                                                        <td>{col.Show v}</td>
-                                                </xml>)
-                                        [M.cols] (fs.T -- #Id) M.cols}
-                                <td><a link={update fs.T.Id}>[Update]</a> <a link={confirm fs.T.Id}>[Delete]</a></td>
-                        </tr>
-                </xml>);
-        return <xml><head>
-                <title>{cdata M.title}</title>
+    rows <- queryX (SELECT * FROM tab AS T)
+                   (fn (fs : {T : $([Id = int] ++ mapT2T fstTT M.cols)}) => <xml>
+                       <tr>
+                         <td>{txt _ fs.T.Id}</td>
+                         {foldT2RX2 [fstTT] [colMeta] [tr]
+                                    (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
+                                                     [[nm] ~ rest] v col => <xml>
+                                                         <td>{col.Show v}</td>
+                                                       </xml>)
+                                    [M.cols] (fs.T -- #Id) M.cols}
+                         <td><a link={update fs.T.Id}>[Update]</a> <a link={confirm fs.T.Id}>[Delete]</a></td>
+                       </tr>
+                     </xml>);
+    return <xml><head>
+      <title>{cdata M.title}</title>
 
-                </head><body>
+    </head><body>
 
-                <h1>{cdata M.title}</h1>
+    <h1>{cdata M.title}</h1>
 
-                <table border={1}>
-                <tr>
-                        <th>ID</th>
-                        {foldT2RX [colMeta] [tr]
-                                (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
-                                        [[nm] ~ rest] col => <xml>
-                                                <th>{cdata col.Nam}</th>
-                                        </xml>)
-                                [M.cols] M.cols}
-                </tr>
-                {rows}
-                </table>
+    <table border={1}>
+      <tr>
+        <th>ID</th>
+        {foldT2RX [colMeta] [tr]
+                  (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
+                                   [[nm] ~ rest] col => <xml>
+                                       <th>{cdata col.Nam}</th>
+                                     </xml>)
+                  [M.cols] M.cols}
+      </tr>
+      {rows}
+    </table>
 
-                <br/>
+    <br/>
 
-                <form>
-                        {foldT2R [colMeta] [fn cols :: {(Type * Type)} => xml form [] (mapT2T sndTT cols)]
-                                (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
-                                        [[nm] ~ rest] (col : colMeta t) (acc : xml form [] (mapT2T sndTT rest)) => <xml>
-                                                <li> {cdata col.Nam}: {col.Widget [nm]}</li>
-                                                {useMore acc}
-                                        </xml>)
-                                <xml/>
-                                [M.cols] M.cols}
+    <form>
+      {foldT2R [colMeta] [fn cols :: {(Type * Type)} => xml form [] (mapT2T sndTT cols)]
+               (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
+                                [[nm] ~ rest] (col : colMeta t) (acc : xml form [] (mapT2T sndTT rest)) => <xml>
+                                    <li> {cdata col.Nam}: {col.Widget [nm]}</li>
+                                    {useMore acc}
+                                  </xml>)
+       <xml/>
+           [M.cols] M.cols}
 
-                        <submit action={create}/>
-                </form>
-        </body></xml>
+           <submit action={create}/>
+    </form>
+    </body></xml>
 
 end