diff options
| -rw-r--r-- | lib/js/urweb.js | 2 | ||||
| -rw-r--r-- | lib/ur/basis.urs | 2 | ||||
| -rw-r--r-- | lib/ur/json.ur | 2 | ||||
| -rw-r--r-- | lib/ur/list.ur | 17 | ||||
| -rw-r--r-- | lib/ur/list.urs | 2 | ||||
| -rw-r--r-- | src/elab_env.sml | 5 | ||||
| -rw-r--r-- | tests/mouseEvent.ur | 2 |
7 files changed, 26 insertions, 6 deletions
diff --git a/lib/js/urweb.js b/lib/js/urweb.js index 99b45ec9..ff4c7b7e 100644 --- a/lib/js/urweb.js +++ b/lib/js/urweb.js @@ -553,6 +553,8 @@ function uw_mouseEvent() { _ScreenY : firstGood(ev.screenY, 0), _ClientX : firstGood(ev.clientX, 0), _ClientY : firstGood(ev.clientY, 0), + _OffsetX : firstGood(ev.offsetX, 0), + _OffsetY : firstGood(ev.offsetY, 0), _CtrlKey : firstGood(ev.ctrlKey, false), _ShiftKey : firstGood(ev.shiftKey, false), _AltKey : firstGood(ev.altKey, false), diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs index 66cc0e50..3b67946f 100644 --- a/lib/ur/basis.urs +++ b/lib/ur/basis.urs @@ -830,7 +830,7 @@ val meta : unit -> tag [Nam = meta, Content = string, Id = id] head [] [] [] datatype mouseButton = Left | Right | Middle -type mouseEvent = { ScreenX : int, ScreenY : int, ClientX : int, ClientY : int, +type mouseEvent = { ScreenX : int, ScreenY : int, ClientX : int, ClientY : int, OffsetX : int, OffsetY : int, CtrlKey : bool, ShiftKey : bool, AltKey : bool, MetaKey : bool, Button : mouseButton } diff --git a/lib/ur/json.ur b/lib/ur/json.ur index 817ec16e..589e81b0 100644 --- a/lib/ur/json.ur +++ b/lib/ur/json.ur @@ -51,7 +51,6 @@ fun escape s = | #"\r" => "\\r" | #"\t" => "\\t" | #"\"" => "\\\"" - | #"\'" => "\\\'" | #"\\" => "\\\\" | #"/" => "\\/" | x => String.str ch @@ -101,7 +100,6 @@ fun unescape s = | #"r" => "\r" | #"t" => "\t" | #"\"" => "\"" - | #"\'" => "\'" | #"\\" => "\\" | #"/" => "/" | x => error <xml>JSON unescape: Bad escape char: {[x]}</xml>) diff --git a/lib/ur/list.ur b/lib/ur/list.ur index 95d6fbc8..d28d2868 100644 --- a/lib/ur/list.ur +++ b/lib/ur/list.ur @@ -319,7 +319,7 @@ fun filterM [m] (_ : monad m) [a] (p : a -> m bool) = filterM' [] end -fun all [m] f = +fun all [a] f = let fun all' ls = case ls of @@ -329,6 +329,21 @@ fun all [m] f = all' end +fun allM [m] (_ : monad m) [a] f = + let + fun all' ls = + case ls of + [] => return True + | x :: ls => + b <- f x; + if b then + all' ls + else + return False + in + all' + end + fun app [m] (_ : monad m) [a] f = let fun app' ls = diff --git a/lib/ur/list.urs b/lib/ur/list.urs index fe730152..f4593dda 100644 --- a/lib/ur/list.urs +++ b/lib/ur/list.urs @@ -66,6 +66,8 @@ val search : a ::: Type -> b ::: Type -> (a -> option b) -> t a -> option b val all : a ::: Type -> (a -> bool) -> t a -> bool +val allM : m ::: (Type -> Type) -> monad m -> a ::: Type -> (a -> m bool) -> t a -> m bool + val app : m ::: (Type -> Type) -> monad m -> a ::: Type -> (a -> m unit) -> t a -> m unit diff --git a/src/elab_env.sml b/src/elab_env.sml index 0474bf7c..a2097aa9 100644 --- a/src/elab_env.sml +++ b/src/elab_env.sml @@ -493,10 +493,11 @@ fun class_name_in (c, _) = case c of CNamed n => SOME (ClNamed n) | CModProj x => SOME (ClProj x) + | CAbs (_, _, c') => class_head_in c' | CUnif (_, _, _, _, ref (Known c)) => class_name_in c | _ => NONE -fun isClass (env : env) c = +and isClass (env : env) c = let fun find NONE = false | find (SOME c) = Option.isSome (CM.find (#classes env, c)) @@ -504,7 +505,7 @@ fun isClass (env : env) c = find (class_name_in c) end -fun class_head_in c = +and class_head_in c = case #1 c of CApp (f, _) => class_head_in f | CUnif (_, _, _, _, ref (Known c)) => class_head_in c diff --git a/tests/mouseEvent.ur b/tests/mouseEvent.ur index 2192e0b0..32a67806 100644 --- a/tests/mouseEvent.ur +++ b/tests/mouseEvent.ur @@ -8,6 +8,8 @@ fun main () : transaction page = return <xml><body> ^ "\nScreenY = " ^ show ev.ScreenY ^ "\nClientX = " ^ show ev.ClientX ^ "\nClientY = " ^ show ev.ClientY + ^ "\nOffsetX = " ^ show ev.OffsetX + ^ "\nOffsetY = " ^ show ev.OffsetY ^ "\nCtrlKey = " ^ show ev.CtrlKey ^ "\nShiftKey = " ^ show ev.ShiftKey ^ "\nAltKey = " ^ show ev.AltKey |