# HG changeset patch
# User Adam Chlipala <adamc@hcoop.net>
# Date 1224182428 14400
# Node ID 226c977faa9c9483013ce40d4d6eb2452d75f66f
# Parent  b6be1679258485d471c10b92ac6fd46e6a861b4d
Crud indented properly, except for <xml>...</xml> outside parens and sig/struct

diff -r b6be16792584 -r 226c977faa9c src/elisp/urweb-mode.el
--- a/src/elisp/urweb-mode.el	Thu Oct 16 14:17:55 2008 -0400
+++ b/src/elisp/urweb-mode.el	Thu Oct 16 14:40:28 2008 -0400
@@ -452,33 +452,17 @@
 	  (1+ (current-column))
 	nil))))
 
-(defun urweb-begun-xml ()
-  "Check if this is the first new line in a new <xml>...</xml> section"
+(defun urweb-empty-line ()
   (save-excursion
+    (beginning-of-line)
     (let ((start-pos (point)))
-      (previous-line 1)
-      (search-forward "<xml>" start-pos t))))
+      (end-of-line)
+      (not (re-search-backward "[^\n \t]" start-pos t)))))
 
-(defun urweb-new-tags ()
-  "Decide if the previous line of XML introduced unclosed tags"
-  (save-excursion
-    (let ((start-pos (point))
-          (depth 0)
-          (done nil))
-      (previous-line 1)
-      (beginning-of-line)
-      (while (and (not done) (search-forward "<" start-pos t))
-        (if (looking-at "/")
-          (if (search-forward ">" start-pos t)
-              (when (> depth 0) (decf depth))
-            (setq done t))
-          (if (search-forward ">" start-pos t)
-              (if (not (save-excursion (backward-char 2) (looking-at "/")))
-                  (incf depth))
-            (setq done t))))
-      (and (not done) (> depth 0)))))
+(defun urweb-seek-back ()
+  (while (urweb-empty-line) (previous-line 1)))
 
-(defun skip-matching-braces ()
+(defun urweb-skip-matching-braces ()
   "Skip backwards past matching brace pairs, to calculate XML indentation after quoted Ur code"
   (beginning-of-line)
   (let ((start-pos (point))
@@ -497,13 +481,36 @@
        ((looking-at "{")
         (decf depth)))))))
 
+(defun urweb-new-tags ()
+  "Decide if the previous line of XML introduced unclosed tags"
+  (save-excursion
+    (let ((start-pos (point))
+          (depth 0)
+          (done nil))
+      (previous-line 1)
+      (urweb-seek-back)
+      (urweb-skip-matching-braces)
+      (urweb-seek-back)
+      (beginning-of-line)
+      (while (and (not done) (search-forward "<" start-pos t))
+        (if (looking-at "/")
+          (if (search-forward ">" start-pos t)
+              (when (> depth 0) (decf depth))
+            (setq done t))
+          (if (search-forward ">" start-pos t)
+              (if (not (save-excursion (backward-char 2) (looking-at "/")))
+                  (incf depth))
+            (setq done t))))
+      (and (not done) (> depth 0)))))
+
 (defun urweb-tag-matching-indent ()
   "Seek back to a matching opener tag and get its line's indent"
   (save-excursion
+    (end-of-line)
+    (search-backward "</" nil t)
     (urweb-tag-matcher)
-    (if (looking-at "<xml")
-        (+ (current-indentation) 2)
-      (current-indentation))))
+    (beginning-of-line)
+    (current-indentation)))
 
 (defun urweb-calculate-indentation ()
   (save-excursion
@@ -527,14 +534,13 @@
         (and (urweb-in-xml)
              (let ((prev-indent (save-excursion
                                   (previous-line 1)
-                                  (skip-matching-braces)
-                                  (re-search-backward "^[^\n]" nil t)
+                                  (urweb-seek-back)
+                                  (urweb-skip-matching-braces)
+                                  (urweb-seek-back)
                                   (current-indentation))))
                (cond
                 ((looking-at "</")
                  (urweb-tag-matching-indent))
-                ((urweb-begun-xml)
-                 (+ prev-indent 4))
                 ((urweb-new-tags)
                  (+ prev-indent 2))
                 (t
diff -r b6be16792584 -r 226c977faa9c src/elisp/urweb-move.el
--- a/src/elisp/urweb-move.el	Thu Oct 16 14:17:55 2008 -0400
+++ b/src/elisp/urweb-move.el	Thu Oct 16 14:40:28 2008 -0400
@@ -75,7 +75,7 @@
      (("AND" "OR") . 1)
      ((">=" "<>" "<=" "=") . 4)
      (("+" "-" "^") . 6)
-     (("/" "*" "%") . 7)
+     (("*" "%") . 7)
      (("NOT") 9)))
   "Alist of Ur/Web infix operators and their precedence.")
 
@@ -250,12 +250,6 @@
 	   (op-prec (urweb-op-prec op 'back))
 	   match)
       (cond
-        ((save-excursion (backward-char 5)
-                         (looking-at "</xml>"))
-         (backward-char 6)
-         (urweb-tag-matcher)
-         (backward-char 1)
-         (urweb-backward-sexp prec))
        ((not op)
 	(let ((point (point)))
 	  (ignore-errors (let ((forward-sexp-function nil)) (backward-sexp 1)))
@@ -278,11 +272,6 @@
        ;; this reproduces the usual backward-sexp, but it might be bogus
        ;; in this case since !@$% is a perfectly fine symbol
        (t t))))) ;(or (string-match "\\sw" op) (urweb-backward-sexp prec))
-;;   (when (save-excursion (backward-char 5) (looking-at "</xml>"))
-;;     (backward-char 5)
-;;     (urweb-tag-matcher)
-;;     (backward-char)
-;;     (urweb-backward-sexp prec)))
 
 (defun urweb-forward-sexp (prec)
   "Moves one sexp forward if possible, or one char else.
diff -r b6be16792584 -r 226c977faa9c tests/crud.ur
--- a/tests/crud.ur	Thu Oct 16 14:17:55 2008 -0400
+++ b/tests/crud.ur	Thu Oct 16 14:40:28 2008 -0400
@@ -1,11 +1,11 @@
 con colMeta = fn t_formT :: (Type * Type) => {
-        Nam : string,
-        Show : t_formT.1 -> xbody,
-        Widget : nm :: Name -> xml form [] [nm = t_formT.2],
-        WidgetPopulated : nm :: Name -> t_formT.1 -> xml form [] [nm = t_formT.2],
-        Parse : t_formT.2 -> t_formT.1,
-        Inject : sql_injectable t_formT.1
-}
+                 Nam : string,
+                 Show : t_formT.1 -> xbody,
+                 Widget : nm :: Name -> xml form [] [nm = t_formT.2],
+                 WidgetPopulated : nm :: Name -> t_formT.1 -> xml form [] [nm = t_formT.2],
+                 Parse : t_formT.2 -> t_formT.1,
+                 Inject : sql_injectable t_formT.1
+                 }
 con colsMeta = fn cols :: {(Type * Type)} => $(Top.mapT2T colMeta cols)
 
 fun default (t ::: Type) (sh : show t) (rd : read t) (inj : sql_injectable t)
@@ -15,7 +15,7 @@
      Widget = fn nm :: Name => (<xml><textbox{nm}/></xml>),
      WidgetPopulated = fn (nm :: Name) n =>
                           (<xml><textbox{nm} value={show _ n}/></xml>),
-     Parse = readError _,e
+     Parse = readError _,
      Inject = _}
 
 val int = default _ _ _
@@ -31,14 +31,14 @@
                  Inject = _}
 
 functor Make(M : sig
-        con cols :: {(Type * Type)}
-        constraint [Id] ~ cols
-        val tab : sql_table ([Id = int] ++ mapT2T fstTT cols)
+con cols :: {(Type * Type)}
+constraint [Id] ~ cols
+val tab : sql_table ([Id = int] ++ mapT2T fstTT cols)
 
-        val title : string
+val title : string
 
-        val cols : colsMeta cols
-end) = struct
+val cols : colsMeta cols
+             end) = struct
 
 open constraints M
 val tab = M.tab
@@ -64,10 +64,13 @@
     () <- 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)]
+                                                         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))
+                                 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>
@@ -79,18 +82,18 @@
     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}
+        {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}/>
+        <submit action={save id}/>
       </form></body></xml>
 
 fun delete (id : int) =
@@ -100,59 +103,61 @@
     </body></xml>
 
 fun confirm (id : int) = return <xml><body>
-    <p>Are you sure you want to delete ID #{txt _ id}?</p>
+  <p>Are you sure you want to delete ID #{txt _ id}?</p>
 
-    <p><a link={delete id}>I was born sure!</a></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>);
+                     <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>
 
-    <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>
+      <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>
+                    [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>
+      <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>
+                 <xml/>
+                 [M.cols] M.cols}
+        
+        <submit action={create}/>
+      </form>
     </body></xml>
 
 end