# HG changeset patch
# User Adam Chlipala <adamc@hcoop.net>
# Date 1224187258 14400
# Node ID 782ef3ad8c28ab728bea40d513292cdfbc2d7a57
# Parent  4f75cc2e1373e42950412ed4cea8dd2353121f94
Crud auto-indented correctly

diff -r 4f75cc2e1373 -r 782ef3ad8c28 src/elisp/urweb-mode.el
--- a/src/elisp/urweb-mode.el	Thu Oct 16 14:52:50 2008 -0400
+++ b/src/elisp/urweb-mode.el	Thu Oct 16 16:00:58 2008 -0400
@@ -676,7 +676,7 @@
   "Find the indentation for the SYM we're `looking-at'.
 If indentation is delegated, point will move to the start of the parent.
 Optional argument STYLE is currently ignored."
-  (assert (equal sym (save-excursion (urweb-forward-sym))))
+;;(assert (equal sym (save-excursion (urweb-forward-sym))))
   (save-excursion
     (let ((delegate (and (not (equal sym "end")) (assoc sym urweb-close-paren)))
 	  (head-sym sym))
diff -r 4f75cc2e1373 -r 782ef3ad8c28 src/elisp/urweb-move.el
--- a/src/elisp/urweb-move.el	Thu Oct 16 14:52:50 2008 -0400
+++ b/src/elisp/urweb-move.el	Thu Oct 16 16:00:58 2008 -0400
@@ -182,6 +182,7 @@
   (or (/= 0 (skip-syntax-forward "'w_"))
       (/= 0 (skip-syntax-forward ".'"))))
 (defun urweb-forward-sym ()
+  (interactive)
   (let ((sym (urweb-move-read (urweb-forward-sym-1))))
     (cond
      ((equal "op" sym)
@@ -206,22 +207,33 @@
   (or (/= 0 (skip-syntax-backward ".'"))
       (/= 0 (skip-syntax-backward "'w_"))))
 (defun urweb-backward-sym ()
+  (interactive)
   (let ((sym (urweb-move-read (urweb-backward-sym-1))))
-    (when sym
-      ;; FIXME: what should we do if `sym' = "op" ?
-      (let ((point (point)))
-	(urweb-backward-spaces)
-	(if (equal "op" (urweb-move-read (urweb-backward-sym-1)))
-	    (concat "op " sym)
-	  (goto-char point)
-	  (cond
-	   ((string= sym "=") (if (urweb-poly-equal-p) "=" "d="))
-	   ((string= sym "of") (if (urweb-nested-of-p) "of" "=of"))
-	   ;; ((string= sym "datatype")
-	   ;;  (save-excursion (urweb-backward-spaces)
-	   ;; 		    (if (eq (preceding-char) ?=) "=datatype" sym)))
-	   (t sym)))))))
-    
+    (let ((result
+           (when sym
+             ;; FIXME: what should we do if `sym' = "op" ?
+             (let ((point (point)))
+               (urweb-backward-spaces)
+               (if (equal "op" (urweb-move-read (urweb-backward-sym-1)))
+                   (concat "op " sym)
+                 (goto-char point)
+                 (cond
+                  ((string= sym "=") (if (urweb-poly-equal-p) "=" "d="))
+                  ((string= sym "of") (if (urweb-nested-of-p) "of" "=of"))
+                  ;; ((string= sym "datatype")
+                  ;;  (save-excursion (urweb-backward-spaces)
+                  ;; 		    (if (eq (preceding-char) ?=) "=datatype" sym)))
+                  (t sym)))))))
+      (if (looking-at ">")
+          (substring result 1 nil)
+        result))))
+;;       (if (save-excursion (backward-char 5) (looking-at "</xml>"))
+;;           (progn
+;;             (backward-char 5)
+;;             (urweb-tag-matcher)
+;;             (backward-char)
+;;             (urweb-backward-sym))
+;;         result))))
 
 (defun urweb-tag-matcher ()
   "Seek back to a matching opener tag"
@@ -243,35 +255,42 @@
   "Move one sexp backward if possible, or one char else.
 Returns t if the move indeed moved through one sexp and nil if not.
 PREC is the precedence currently looked for."
-  (let ((parse-sexp-lookup-properties t)
-	(parse-sexp-ignore-comments t))
-    (urweb-backward-spaces)
-    (let* ((op (urweb-backward-sym))
-	   (op-prec (urweb-op-prec op 'back))
-	   match)
-      (cond
-       ((not op)
-	(let ((point (point)))
-	  (ignore-errors (let ((forward-sexp-function nil)) (backward-sexp 1)))
-	  (if (/= point (point)) t (ignore-errors (backward-char 1)) nil)))
-       ;; stop as soon as precedence is smaller than `prec'
-       ((and prec op-prec (>= prec op-prec)) nil)
-       ;; special rules for nested constructs like if..then..else
-       ((and (or (not prec) (and prec op-prec))
-	     (setq match (second (assoc op urweb-close-paren))))
-	(urweb-find-match-backward (concat "\\<" op "\\>") match))
-       ;; don't back over open-parens
-       ((assoc op urweb-open-paren) nil)
-       ;; infix ops precedence
-       ((and prec op-prec) (< prec op-prec))
-       ;; [ prec = nil ]  a new operator, let's skip the sexps until the next
-       (op-prec (while (urweb-move-if (urweb-backward-sexp op-prec))) t)
-       ;; special symbols indicating we're getting out of a nesting level
-       ((string-match urweb-sexp-head-symbols-re op) nil)
-       ;; if the op was not alphanum, then we still have to do the backward-sexp
-       ;; 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))
+  (let ((result (let ((parse-sexp-lookup-properties t)
+                      (parse-sexp-ignore-comments t))
+                  (urweb-backward-spaces)
+                  (let* ((op (urweb-backward-sym))
+                         (op-prec (urweb-op-prec op 'back))
+                         match)
+                  (cond
+                   ((not op)
+                    (let ((point (point)))
+                      (ignore-errors (let ((forward-sexp-function nil)) (backward-sexp 1)))
+                      (if (/= point (point)) t (ignore-errors (backward-char 1)) nil)))
+                   ;; stop as soon as precedence is smaller than `prec'
+                   ((and prec op-prec (>= prec op-prec)) nil)
+                   ;; special rules for nested constructs like if..then..else
+                   ((and (or (not prec) (and prec op-prec))
+                         (setq match (second (assoc op urweb-close-paren))))
+                    (urweb-find-match-backward (concat "\\<" op "\\>") match))
+                   ;; don't back over open-parens
+                   ((assoc op urweb-open-paren) nil)
+                   ;; infix ops precedence
+                   ((and prec op-prec) (< prec op-prec))
+                   ;; [ prec = nil ]  a new operator, let's skip the sexps until the next
+                   (op-prec (while (urweb-move-if (urweb-backward-sexp op-prec))) t)
+                   ;; special symbols indicating we're getting out of a nesting level
+                   ((string-match urweb-sexp-head-symbols-re op) nil)
+                   ;; if the op was not alphanum, then we still have to do the backward-sexp
+                   ;; this reproduces the usual backward-sexp, but it might be bogus
+                   ;; in this case since !@$% is a perfectly fine symbol
+                   (t t))))))
+    (if (save-excursion (backward-char 5) (looking-at "</xml>"))
+      (progn
+        (backward-char 5)
+        (urweb-tag-matcher)
+        (backward-char)
+        (urweb-backward-sexp prec))
+      result)))
 
 (defun urweb-forward-sexp (prec)
   "Moves one sexp forward if possible, or one char else.
@@ -340,8 +359,8 @@
 ;;(defun urweb-forward-thing ()
 ;;  (if (= ?w (char-syntax (char-after))) (forward-word 1) (forward-char 1)))
 
-(defun urweb-backward-arg () (urweb-backward-sexp 1000))
-(defun urweb-forward-arg () (urweb-forward-sexp 1000))
+(defun urweb-backward-arg () (interactive) (urweb-backward-sexp 1000))
+(defun urweb-forward-arg () (interactive) (urweb-forward-sexp 1000))
 
 
 (provide 'urweb-move)
diff -r 4f75cc2e1373 -r 782ef3ad8c28 tests/crud.ur
--- a/tests/crud.ur	Thu Oct 16 14:52:50 2008 -0400
+++ b/tests/crud.ur	Thu Oct 16 16:00:58 2008 -0400
@@ -12,9 +12,9 @@
             name : colMeta (t, string) =
     {Nam = name,
      Show = txt _,
-     Widget = fn nm :: Name => (<xml><textbox{nm}/></xml>),
+     Widget = fn nm :: Name => <xml><textbox{nm}/></xml>,
      WidgetPopulated = fn (nm :: Name) n =>
-                          (<xml><textbox{nm} value={show _ n}/></xml>),
+                          <xml><textbox{nm} value={show _ n}/></xml>,
      Parse = readError _,
      Inject = _}
 
@@ -24,9 +24,9 @@
 
 fun bool name = {Nam = name,
                  Show = txt _,
-                 Widget = fn nm :: Name => (<xml><checkbox{nm}/></xml>),
+                 Widget = fn nm :: Name => <xml><checkbox{nm}/></xml>,
                  WidgetPopulated = fn (nm :: Name) b =>
-                                      (<xml><checkbox{nm} checked={b}/></xml>),
+                                      <xml><checkbox{nm} checked={b}/></xml>,
                  Parse = fn x => x,
                  Inject = _}
 
diff -r 4f75cc2e1373 -r 782ef3ad8c28 tests/crud.urs
--- a/tests/crud.urs	Thu Oct 16 14:52:50 2008 -0400
+++ b/tests/crud.urs	Thu Oct 16 16:00:58 2008 -0400
@@ -3,7 +3,7 @@
                   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],
+                                    -> 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)} => $(mapT2T colMeta cols)