Merge branch 'upstream' into dfsg_clean20150520+dfsg

15 files changed, 68 insertions, 17 deletions

diff --git a/.hgignore b/.hgignore
index c3272f05..20e290b8 100644
--- a/.hgignore
+++ b/.hgignore
@@ -34,6 +34,7 @@ demo/more/out/*.html
 demo/more/demo.*
 
 doc/*.html
+doc/*.out
 
 *.sql
 *mlmon.out
diff --git a/CHANGELOG b/CHANGELOG
index e4eae28e..838da410 100644
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -1,4 +1,18 @@
 ========
+20150520
+========
+
+- Change default behavior of client-side GUI event handlers:
+  By default, events are now passed to handlers on parent DOM nodes as well,
+  just like in normal JavaScript.
+  Call [preventDefault] or [stopPropagation] to tweak that behavior.
+  WARNING: This change may break backward compatibility!
+- URIs specified with 'file' .urp directive are implicitly allowed to be referenced.
+- New HTML tags: <fieldset>, <legend>
+- New urweb-mode Emacs command: 'urweb-close-matching-tag'
+- Bug fixes
+
+========
 20150412
 ========
 
diff --git a/configure.ac b/configure.ac
index 13e1eebc..89620c40 100644
--- a/configure.ac
+++ b/configure.ac
@@ -1,4 +1,4 @@
-AC_INIT([urweb], [20150412])
+AC_INIT([urweb], [20150520])
 WORKING_VERSION=0
 AC_USE_SYSTEM_EXTENSIONS
 
diff --git a/doc/manual.tex b/doc/manual.tex
index ad23d638..1ff3f7aa 100644
--- a/doc/manual.tex
+++ b/doc/manual.tex
@@ -9,6 +9,8 @@
 \newcommand{\rcut}{\; \texttt{-{}-} \;}
 \newcommand{\rcutM}{\; \texttt{-{}-{}-} \;}
 
+\usepackage{hyperref}
+
 \begin{document}
 
 \title{The Ur/Web Manual}
diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs
index 28384c2c..56c8d767 100644
--- a/lib/ur/basis.urs
+++ b/lib/ur/basis.urs
@@ -1028,6 +1028,9 @@ val image : ctx ::: {Unit} -> use ::: {Type}
 
 val label : bodyTag ([For = id, Accesskey = string] ++ tableAttrs)
 
+val fieldset : bodyTag boxAttrs
+val legend : bodyTag boxAttrs
+
 
 (*** AJAX-oriented widgets *)
 
diff --git a/src/c/static.c b/src/c/static.c
index 8f35a2d4..c8fd5bc7 100644
--- a/src/c/static.c
+++ b/src/c/static.c
@@ -16,6 +16,10 @@ static void log_(void *data, const char *fmt, ...) {
 
 static uw_loggers loggers = {NULL, log_, log_};
 
+static char *get_header(void *data, const char *h) {
+  return NULL;
+}
+
 int main(int argc, char *argv[]) {
   uw_context ctx;
   failure_kind fk;
@@ -27,6 +31,7 @@ int main(int argc, char *argv[]) {
  
   ctx = uw_init(0, &loggers);
   uw_set_app(ctx, &uw_application);
+  uw_set_headers(ctx, get_header, NULL);
   uw_initialize(ctx);
 
   while (1) {
diff --git a/src/c/urweb.c b/src/c/urweb.c
index 7ad58e1d..1e49dae0 100644
--- a/src/c/urweb.c
+++ b/src/c/urweb.c
@@ -4220,7 +4220,10 @@ void uw_check_deadline(uw_context ctx) {
 size_t uw_database_max = SIZE_MAX;
 
 uw_Basis_int uw_Basis_naughtyDebug(uw_context ctx, uw_Basis_string s) {
-  fprintf(stderr, "%s\n", s);
+  if (ctx->loggers->log_debug)
+    ctx->loggers->log_debug(ctx->loggers->logger_data, "%s\n", s);
+  else
+    fprintf(stderr, "%s\n", s);
   return 0;
 }
 
diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index b3b12fe8..9c456863 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -3665,8 +3665,7 @@ fun p_sql env (ds, _) =
                                                             let
                                                                 val t = sql_type_in env t
                                                             in
-                                                                box [string "uw_",
-                                                                     string (CharVector.map Char.toLower x),
+                                                                box [string (Settings.mangleSql (CharVector.map Char.toLower x)),
                                                                      space,
                                                                      string (#p_sql_type (Settings.currentDbms ()) t),
                                                                      case t of
diff --git a/src/compiler.sml b/src/compiler.sml
index 388cc7d2..8f6d1fad 100644
--- a/src/compiler.sml
+++ b/src/compiler.sml
@@ -875,7 +875,8 @@ fun parseUrp' accLibs fname =
                                      (case String.fields Char.isSpace arg of
                                           [uri, fname] => (Settings.setFilePath thisPath;
                                                            Settings.addFile {Uri = uri,
-                                                                             LoadFromFilename = fname})
+                                                                             LoadFromFilename = fname};
+                                                           url := {action = Settings.Allow, kind = Settings.Exact, pattern = uri} :: !url)
                                         | _ => ErrorMsg.error "Bad 'file' arguments")
 
                                    | _ => ErrorMsg.error ("Unrecognized command '" ^ cmd ^ "'");
diff --git a/src/elisp/urweb-defs.el b/src/elisp/urweb-defs.el
index 8054d829..1b21cba0 100644
--- a/src/elisp/urweb-defs.el
+++ b/src/elisp/urweb-defs.el
@@ -108,7 +108,7 @@ notion of \"the end of an outline\".")
                  "datatype" "type" "open" "include"
                  urweb-module-head-syms
                  "con" "map" "where" "extern" "constraint" "constraints"
-                 "table" "sequence" "class" "cookie" "task" "policy")
+                 "table" "sequence" "class" "cookie" "style" "task" "policy")
   "Symbols starting an sexp.")
 
 ;; (defconst urweb-not-arg-start-re
@@ -135,7 +135,7 @@ notion of \"the end of an outline\".")
      (("case" "datatype" "if" "then" "else"
        "let" "open" "sig" "struct" "type" "val"
        "con" "constraint" "table" "sequence" "class" "cookie"
-       "task" "policy")))))
+       "style" "task" "policy")))))
 
 (defconst urweb-starters-indent-after
   (urweb-syms-re "let" "in" "struct" "sig")
@@ -190,7 +190,7 @@ for all symbols and in all lines starting with the given symbol."
 	  '("datatype" "fun"
 	    "open" "type" "val" "and"
 	    "con" "constraint" "table" "sequence" "class" "cookie"
-            "task" "policy"))
+            "style" "task" "policy"))
   "The starters of new expressions.")
 
 (defconst urweb-exptrail-syms
diff --git a/src/elisp/urweb-mode.el b/src/elisp/urweb-mode.el
index fb9d18b5..5eb36bc4 100644
--- a/src/elisp/urweb-mode.el
+++ b/src/elisp/urweb-mode.el
@@ -179,11 +179,11 @@ See doc for the variable `urweb-mode-info'."
         (let ((xml-tag (length (or (match-string 3) "")))
               (ch (match-string 2)))
          (cond
-          ((equal ch ?\{)
+          ((equal ch "{")
            (if (> depth 0)
                (decf depth)
              (setq finished t)))
-          ((equal ch ?\})
+          ((equal ch "}")
            (incf depth))
           ((= xml-tag 3)
            (if (> depth 0)
@@ -194,14 +194,14 @@ See doc for the variable `urweb-mode-info'."
           ((= xml-tag 4)
            (incf depth))
 
-          ((equal ch ?-)
+          ((equal ch "-")
            (if (looking-at "->")
                (setq finished (= depth 0))))
 
           ((and (= depth 0)
                 (not (looking-at "<xml")) ;; ignore <xml/>
-                (eq font-lock-tag-face
-                    (get-text-property (point) 'face)))
+                (let ((face (get-text-property (point) 'face)))
+                  (funcall (if (listp face) #'member #'equal) 'font-lock-tag-face face)))
            ;; previous code was highlighted as tag, seems we are in xml
            (progn
              (setq answer t)
@@ -401,6 +401,7 @@ This mode runs `urweb-mode-hook' just before exiting.
   (unless (boundp 'skeleton-positions) (set (make-local-variable '@) nil))
 
   (local-set-key (kbd "C-c C-c") 'compile)
+  (local-set-key (kbd "C-c /") 'urweb-close-matching-tag)
 
   (urweb-mode-variables))
 
@@ -542,6 +543,16 @@ If anyone has a good algorithm for this..."
     (beginning-of-line)
     (current-indentation)))
 
+(defun urweb-close-matching-tag ()
+  "Insert a closing XML tag for whatever tag is open at the point."
+  (interactive)
+  (assert (urweb-in-xml))
+  (save-excursion
+   (urweb-tag-matcher)
+   (re-search-forward "<\\([^ ={/>]+\\)" nil t))
+  (let ((tag (match-string-no-properties 1)))
+    (insert "</" tag ">")))
+
 (defconst urweb-sql-main-starters
   '("SQL" "SELECT" "INSERT" "UPDATE" "DELETE" "FROM" "SELECT1" "WHERE"))
 
diff --git a/src/monoize.sml b/src/monoize.sml
index 59c5d2ea..bac82f55 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -3402,7 +3402,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                                                                        strH s',
                                                                        (L'.EStrcat (
                                                                         (L'.EJavaScript (L'.Attribute, e), loc),
-                                                                        strH ");return false'"), loc)),
+                                                                        strH ")'"), loc)),
                                                                        loc)), loc),
                                                          fm)
                                                     end
@@ -4682,8 +4682,8 @@ fun monoize env file =
                                      (L'.EDml (str
                                                    (foldl (fn ((x, _), s) =>
                                                               s ^ ", " ^ Settings.mangleSql x ^ " = NULL")
-                                                          ("UPDATE uw_"
-                                                           ^ tab
+                                                          ("UPDATE "
+                                                           ^ Settings.mangleSql tab
                                                            ^ " SET "
                                                            ^ Settings.mangleSql x
                                                                       ^ " = NULL")
diff --git a/src/settings.sml b/src/settings.sml
index b61759c1..cd2de8a9 100644
--- a/src/settings.sml
+++ b/src/settings.sml
@@ -876,7 +876,7 @@ fun setFilePath path = filePath := path
 
 fun addFile {Uri, LoadFromFilename} =
     let
-        val path = OS.Path.mkAbsolute {relativeTo = !filePath, path = LoadFromFilename}
+        val path = OS.Path.concat (!filePath, LoadFromFilename)
     in
         case SM.find (!files, Uri) of
             SOME (path', _) =>
diff --git a/tests/nomangle.ur b/tests/nomangle.ur
new file mode 100644
index 00000000..b853a690
--- /dev/null
+++ b/tests/nomangle.ur
@@ -0,0 +1,7 @@
+table foo : { Bar : int, Baz : string }
+  PRIMARY KEY Baz
+
+fun main () : transaction page =
+    rs <- queryX1 (SELECT foo.Bar FROM foo WHERE foo.Baz = 'Hi')
+          (fn r => <xml>{[r.Bar]}</xml>);
+    return <xml><body>{rs}</body></xml>
diff --git a/tests/nomangle.urp b/tests/nomangle.urp
new file mode 100644
index 00000000..7fab4b03
--- /dev/null
+++ b/tests/nomangle.urp
@@ -0,0 +1,5 @@
+database dbname=test
+noMangleSql
+sql nomangle.sql
+
+nomangle