Add a edit_integer widget.

_oasis

@@ -231,6 +231,13 @@ Executable "editor"
   MainIs: editor.ml
   BuildDepends: lambda-term
 
+Executable "editint"
+  Path: examples
+  Install: false
+  CompiledObject: best
+  MainIs: editint.ml
+  BuildDepends: lambda-term
+
 # +-------------------------------------------------------------------+
 # | Utils                                                             |
 # +-------------------------------------------------------------------+

examples/editint.ml

@@ -0,0 +1,66 @@
+(*
+ * editint.ml
+ * ---------
+ * Copyright : (c) 2016, Andy Ray <andy.ray@ujamjar.com>
+ * Licence   : BSD3
+ *
+ * This file is a part of Lambda-Term.
+ *)
+
+open CamomileLibraryDyn.Camomile
+open Lwt
+
+let main () =
+  let waiter, wakener = wait () in
+
+  let vbox = new LTerm_widget.vbox in
+  let frame = new LTerm_widget.frame in
+  let edit = new LTerm_edit.edit_integer (*~positive:true*) () in
+  let exit = new LTerm_widget.button "exit" in
+  let label = new LTerm_widget.label "" in
+  let hbox = new LTerm_widget.hbox in
+  let incr = new LTerm_widget.button "incr" in
+  let decr = new LTerm_widget.button "decr" in
+  frame#set edit;
+  hbox#add ~expand:false decr;
+  hbox#add frame;
+  hbox#add ~expand:false incr;
+  vbox#add ~expand:false hbox;
+  vbox#add label;
+  vbox#add ~expand:false exit;
+
+  let set_value f = 
+    let x = 
+      match edit#value with
+      | None -> 0
+      | Some x -> x
+    in
+    edit#set_value (f x)
+  in
+  let set_label () = 
+    match edit#value with 
+    | None -> label#set_text "none"
+    | Some(x) -> label#set_text (string_of_int x)
+  in
+  incr#on_click (fun () -> set_value ((+)1); set_label ());
+  decr#on_click (fun () -> set_value ((+)(-1)); set_label ());
+
+  let open LTerm_key in
+  edit#on_event 
+    (function LTerm_event.Key { code=Enter } -> set_label (); true
+            | _ -> false);
+  vbox#on_event 
+    (function LTerm_event.Key { code=Escape } -> wakeup wakener (); true
+            | _ -> false);
+  exit#on_click (wakeup wakener);
+
+  Lazy.force LTerm.stdout
+  >>= fun term ->
+  LTerm.enable_mouse term
+  >>= fun () ->
+  Lwt.finalize
+    (fun () -> LTerm_widget.run term vbox waiter)
+    (fun () -> LTerm.disable_mouse term)
+
+let () = Lwt_main.run (main ())
+

lambda-termrc

@@ -12,6 +12,7 @@ slider.focused.foreground: lyellow
 slider.focused.background: blue
 slider.barstyle: filled
 slider.track: true
+edit_integer.underline: true
 !
 ! For monochrome experience comment out the resources above and uncomment two
 ! following lines:

src/lTerm_edit.ml

@@ -27,6 +27,7 @@ type action =
   | Set_macro_counter
   | Add_macro_counter
   | Custom of (unit -> unit)
+  | Custom_skip of (unit -> bool)
 
 let doc_of_action = function
   | Zed action -> Zed_edit.doc_of_action action
@@ -38,6 +39,7 @@ let doc_of_action = function
   | Set_macro_counter -> "sets the value of the macro counter."
   | Add_macro_counter -> "adds a value to the macro counter."
   | Custom _ -> "programmer defined action."
+  | Custom_skip _ -> "programmer defined action."
 
 let actions = [
   Start_macro, "start-macro";
@@ -96,56 +98,115 @@ let bindings = ref Bindings.empty
 let bind seq actions = bindings := Bindings.add seq actions !bindings
 let unbind seq = bindings := Bindings.remove seq !bindings
 
-let () =
-  bind [{ control = false; meta = false; shift = false; code = Left }] [Zed Prev_char];
-  bind [{ control = false; meta = false; shift = false; code = Right }] [Zed Next_char];
-  bind [{ control = false; meta = false; shift = false; code = Up }] [Zed Prev_line];
-  bind [{ control = false; meta = false; shift = false; code = Down }] [Zed Next_line];
-  bind [{ control = false; meta = false; shift = false; code = Home }] [Zed Goto_bol];
-  bind [{ control = false; meta = false; shift = false; code = End }] [Zed Goto_eol];
-  bind [{ control = false; meta = false; shift = false; code = Insert }] [Zed Switch_erase_mode];
-  bind [{ control = false; meta = false; shift = false; code = Delete }] [Zed Delete_next_char];
-  bind [{ control = false; meta = false; shift = false; code = Enter }] [Zed Newline];
-  bind [{ control = true; meta = false; shift = false; code = Char(UChar.of_char ' ') }] [Zed Set_mark];
-  bind [{ control = true; meta = false; shift = false; code = Char(UChar.of_char 'a') }] [Zed Goto_bol];
-  bind [{ control = true; meta = false; shift = false; code = Char(UChar.of_char 'e') }] [Zed Goto_eol];
-  bind [{ control = true; meta = false; shift = false; code = Char(UChar.of_char 'd') }] [Zed Delete_next_char];
-  bind [{ control = true; meta = false; shift = false; code = Char(UChar.of_char 'h') }] [Zed Delete_prev_char];
-  bind [{ control = true; meta = false; shift = false; code = Char(UChar.of_char 'k') }] [Zed Kill_next_line];
-  bind [{ control = true; meta = false; shift = false; code = Char(UChar.of_char 'u') }] [Zed Kill_prev_line];
-  bind [{ control = true; meta = false; shift = false; code = Char(UChar.of_char 'n') }] [Zed Next_line];
-  bind [{ control = true; meta = false; shift = false; code = Char(UChar.of_char 'p') }] [Zed Prev_line];
-  bind [{ control = true; meta = false; shift = false; code = Char(UChar.of_char 'w') }] [Zed Kill];
-  bind [{ control = true; meta = false; shift = false; code = Char(UChar.of_char 'y') }] [Zed Yank];
-  bind [{ control = false; meta = false; shift = false; code = Backspace }] [Zed Delete_prev_char];
-  bind [{ control = false; meta = true; shift = false; code = Char(UChar.of_char 'w') }] [Zed Copy];
-  bind [{ control = false; meta = true; shift = false; code = Char(UChar.of_char 'c') }] [Zed Capitalize_word];
-  bind [{ control = false; meta = true; shift = false; code = Char(UChar.of_char 'l') }] [Zed Lowercase_word];
-  bind [{ control = false; meta = true; shift = false; code = Char(UChar.of_char 'u') }] [Zed Uppercase_word];
-  bind [{ control = false; meta = true; shift = false; code = Char(UChar.of_char 'b') }] [Zed Prev_word];
-  bind [{ control = false; meta = true; shift = false; code = Char(UChar.of_char 'f') }] [Zed Next_word];
-  bind [{ control = false; meta = true; shift = false; code = Right }] [Zed Next_word];
-  bind [{ control = false; meta = true; shift = false; code = Left }] [Zed Prev_word];
-  bind [{ control = true; meta = false; shift = false; code = Right }] [Zed Next_word];
-  bind [{ control = true; meta = false; shift = false; code = Left }] [Zed Prev_word];
-  bind [{ control = false; meta = true; shift = false; code = Backspace }] [Zed Kill_prev_word];
-  bind [{ control = false; meta = true; shift = false; code = Delete }] [Zed Kill_prev_word];
-  bind [{ control = true; meta = false; shift = false; code = Delete }] [Zed Kill_next_word];
-  bind [{ control = false; meta = true; shift = false; code = Char(UChar.of_char 'd') }] [Zed Kill_next_word];
-  bind [{ control = true; meta = false; shift = false; code = Char(UChar.of_char '_') }] [Zed Undo];
-  bind [{ control = true; meta = false; shift = false; code = Char(UChar.of_char 'x') }; { control = false; meta = false; shift = false; code = Char(UChar.of_char '(') }] [Start_macro];
-  bind [{ control = true; meta = false; shift = false; code = Char(UChar.of_char 'x') }; { control = false; meta = false; shift = false; code = Char(UChar.of_char ')') }] [Stop_macro];
-  bind [{ control = true; meta = false; shift = false; code = Char(UChar.of_char 'x') }; { control = false; meta = false; shift = false; code = Char(UChar.of_char 'e') }] [Play_macro];
-  bind [{ control = true; meta = false; shift = false; code = Char(UChar.of_char 'g') }] [Cancel_macro];
-  bind [{ control = true; meta = false; shift = false; code = Char(UChar.of_char 'x') };
-        { control = true; meta = false; shift = false; code = Char(UChar.of_char 'k') };
-        { control = false; meta = false; shift = false; code = Tab }] [Insert_macro_counter];
-  bind [{ control = true; meta = false; shift = false; code = Char(UChar.of_char 'x') };
-        { control = true; meta = false; shift = false; code = Char(UChar.of_char 'k') };
-        { control = true; meta = false; shift = false; code = Char(UChar.of_char 'a') }] [Add_macro_counter];
-  bind [{ control = true; meta = false; shift = false; code = Char(UChar.of_char 'x') };
-        { control = true; meta = false; shift = false; code = Char(UChar.of_char 'k') };
-        { control = true; meta = false; shift = false; code = Char(UChar.of_char 'c') }] [Set_macro_counter]
+type key_bindings = 
+  {
+    move_char : (LTerm_key.t list * action list) list; 
+    move_line : (LTerm_key.t list * action list) list; 
+    goto : (LTerm_key.t list * action list) list; 
+    erase_mode : (LTerm_key.t list * action list) list; 
+    newline : (LTerm_key.t list * action list) list; 
+    mark : (LTerm_key.t list * action list) list; 
+    delete_char : (LTerm_key.t list * action list) list;
+    kill_line : (LTerm_key.t list * action list) list; 
+    edit : (LTerm_key.t list * action list) list; 
+    case : (LTerm_key.t list * action list) list; 
+    move_word : (LTerm_key.t list * action list) list; 
+    kill_word : (LTerm_key.t list * action list) list; 
+    macro : (LTerm_key.t list * action list) list; 
+  }
+
+let key_bindings =
+  let control = true and meta = true in
+  let code ?(control=false) ?(meta=false) code = { control; meta; shift=false; code } in 
+  let char ?(control=false) ?(meta=false) char = { control; meta; shift=false; code=Char (UChar.of_char char) } in 
+  let move_char = [
+    [code          Left],      [Zed Prev_char];
+    [code          Right],     [Zed Next_char];
+  ] in
+  let move_line = [
+    [code          Up],        [Zed Prev_line];
+    [code          Down],      [Zed Next_line];
+    [char ~control 'n'],       [Zed Next_line];
+    [char ~control 'p'],       [Zed Prev_line];
+  ] in
+  let goto = [
+    [code          Home],      [Zed Goto_bol];
+    [code          End],       [Zed Goto_eol];
+    [char ~control 'a'],       [Zed Goto_bol];
+    [char ~control 'e'],       [Zed Goto_eol];
+  ] in
+  let erase_mode = [
+    [code          Insert],    [Zed Switch_erase_mode];
+  ] in
+  let newline = [
+    [code          Enter],     [Zed Newline];
+  ] in
+  let mark = [
+    [char ~control ' '],       [Zed Set_mark];
+  ] in
+  let delete_char = [
+    [char ~control 'd'],       [Zed Delete_next_char];
+    [char ~control 'h'],       [Zed Delete_prev_char];
+    [code          Backspace], [Zed Delete_prev_char];
+    [code          Delete],    [Zed Delete_next_char];
+  ] in
+  let kill_line = [
+    [char ~control 'k'],       [Zed Kill_next_line];
+    [char ~control 'u'],       [Zed Kill_prev_line];
+  ] in
+  let edit = [
+    [char ~control 'w'],       [Zed Kill];
+    [char ~control 'y'],       [Zed Yank];
+    [char ~meta    'w'],       [Zed Copy];
+    [char ~control '_'],       [Zed Undo];
+  ] in
+  let case = [
+    [char ~meta    'c'],       [Zed Capitalize_word];
+    [char ~meta    'l'],       [Zed Lowercase_word];
+    [char ~meta    'u'],       [Zed Uppercase_word];
+  ] in
+  let move_word = [
+    [char ~meta    'b'],       [Zed Prev_word];
+    [char ~meta    'f'],       [Zed Next_word];
+    [code ~meta    Right],     [Zed Next_word];
+    [code ~meta    Left],      [Zed Prev_word];
+    [code ~control Right],     [Zed Next_word];
+    [code ~control Left],      [Zed Prev_word];
+  ] in
+  let kill_word = [
+    [code ~meta    Backspace], [Zed Kill_prev_word];
+    [code ~meta    Delete],    [Zed Kill_prev_word];
+    [code ~control Delete],    [Zed Kill_next_word];
+    [char ~meta    'd'],       [Zed Kill_next_word];
+  ] in
+  let macro = [
+    [char ~control 'x'; 
+     char          '('],       [Start_macro];
+    [char ~control 'x'; 
+     char          ')'],       [Stop_macro];
+    [char ~control 'x'; 
+     char          'e'],       [Play_macro];
+    [char ~control 'g'],       [Cancel_macro];
+    [char ~control 'x';
+     char ~control 'k';
+     code          Tab],       [Insert_macro_counter];
+    [char ~control 'x';
+     char ~control 'k';
+     char ~control 'a'],       [Add_macro_counter];
+    [char ~control 'x';
+     char ~control 'k';
+     char ~control 'c'],       [Set_macro_counter];
+  ] in
+  { move_char; move_line; goto; erase_mode; newline; mark; delete_char;
+    kill_line; edit; case; move_word; kill_word; macro }
+
+let () = 
+  List.iter (List.iter (fun (seq,act) -> bind seq act))
+    [ key_bindings.move_char; key_bindings.move_line; key_bindings.goto; 
+      key_bindings.erase_mode; key_bindings.newline; key_bindings.mark; 
+      key_bindings.delete_char; key_bindings.kill_line; key_bindings.edit; 
+      key_bindings.case; key_bindings.move_word; key_bindings.kill_word; 
+      key_bindings.macro ]
 
 (* +-----------------------------------------------------------------+
    | Widgets                                                         |
@@ -169,10 +230,15 @@ class scrollable = object(self)
   method calculate_range page_size document_size = (document_size - page_size/2)
 end
 
-class edit ?(clipboard = clipboard) ?(macro = macro) () =
+class edit ?(rc="edit") ?(clipboard = clipboard) ?(macro = macro) ?global_bindings () =
   let locale, set_locale = S.create None in
+  let bindings () = 
+    match global_bindings with
+    | None -> !bindings
+    | Some(b) -> b
+  in
 object(self)
-  inherit LTerm_widget.t "edit" as super
+  inherit LTerm_widget.t rc as super
 
   val vscroll = new scrollable
   method vscroll = vscroll
@@ -252,6 +318,8 @@ object(self)
     vscroll#set_document_size (line_count+1);
     ()
 
+  method is_valid_char c = true
+
   initializer
     engine <- (
       Zed_edit.create
@@ -274,7 +342,7 @@ object(self)
                match resolver with
                | Some res -> res
                | None -> Bindings.resolver [ Bindings.pack (fun x -> x) local_bindings
-                                           ; Bindings.pack (fun x -> x) !bindings
+                                           ; Bindings.pack (fun x -> x) (bindings())
                                            ]
              in
              match Bindings.resolve key res with
@@ -285,6 +353,10 @@ object(self)
                          Zed_macro.add macro (Custom f);
                          f ();
                          exec actions
+                     | Custom_skip f :: actions ->
+                         Zed_macro.add macro (Custom_skip f); (* XXX not sure about recording this *)
+                         if not (f ()) then false 
+                         else exec actions
                      | Zed action :: actions ->
                          Zed_macro.add macro (Zed action);
                          Zed_edit.get_action action context;
@@ -319,8 +391,9 @@ object(self)
                    if resolver = None then
                      match key with
                        | { control = false; meta = false; shift = false; code = Char ch } ->
-                           Zed_edit.insert context (Zed_rope.singleton ch);
-                           true
+                           let b = self#is_valid_char ch in
+                           if b then Zed_edit.insert context (Zed_rope.singleton ch);
+                           b
                        | _ ->
                            false
                    else begin
@@ -496,3 +569,54 @@ object(self)
     let start_line = Zed_lines.line_index line_set start in
     Some { row = cursor_line - start_line; col = cursor_column - shift }
 end
+
+
+class edit_integer ?(positive=false) () = 
+  let bindings = 
+    List.fold_left
+      (List.fold_left (fun bindings (seq,act) -> Bindings.add seq act bindings))
+      Bindings.empty 
+      [ key_bindings.goto; 
+        key_bindings.erase_mode; key_bindings.mark; 
+        key_bindings.delete_char; key_bindings.edit; 
+        key_bindings.move_word; key_bindings.kill_word ]
+  in
+object(self)
+  inherit edit ~rc:"edit_integer" ~global_bindings:bindings() 
+
+  method size_request = { rows=1; cols=0 }
+
+  method is_valid_char c = 
+    let c = UChar.char_of c in
+    (c >= '0' && c <= '9') || (c == '-' && not positive)
+
+  method value = 
+    try Some(int_of_string @@ self#text)
+    with _ -> None
+
+  method set_value x = 
+    let ctx = self#context in
+    Zed_edit.goto_bot ctx; (* undo is a bit funny.  use remove instead? *)
+    Zed_edit.set_mark ctx;
+    Zed_edit.goto_eot ctx;
+    Zed_edit.kill ctx;
+    Zed_edit.insert self#context @@ Zed_rope.of_string @@ string_of_int x
+
+  (* customise Left/Right handling.  At the beginning/end of the buffer
+     skip the action so we can move focus *)
+  initializer
+    self#bind
+      [{ control=false; meta=false; shift=false; code=Left }]
+      [ Custom_skip (fun () ->
+        let ctx = self#context in
+        if Zed_edit.at_bot ctx then false
+        else (Zed_edit.get_action (Prev_char) ctx; true)) ];
+    self#bind
+      [{ control=false; meta=false; shift=false; code=Right}]
+      [ Custom_skip (fun () ->
+        let ctx = self#context in
+        if Zed_edit.at_eot ctx then false
+        else (Zed_edit.get_action (Next_char) ctx; true)) ]
+
+end
+

src/lTerm_edit.mli

@@ -29,6 +29,7 @@ type action =
   | Add_macro_counter
       (** Adds a value to the macro counter. *)
   | Custom of (unit -> unit)
+  | Custom_skip of (unit -> bool)
 
 val bindings : action list Zed_input.Make(LTerm_key).t ref
   (** Bindings. These bindings are used by {!LTerm_read_line} and by
@@ -67,8 +68,10 @@ val macro : action Zed_macro.t
   (** The global macro recorder. *)
 
 (** Class of edition widgets. If no clipboard is provided, then the
-    global one is used. *)
-class edit : ?clipboard : Zed_edit.clipboard -> ?macro : action Zed_macro.t -> unit -> object
+    global one is used.  [global_bindings] overrides the default bindings. *)
+class edit : 
+  ?rc : string -> ?clipboard : Zed_edit.clipboard -> ?macro : action Zed_macro.t -> 
+  ?global_bindings : action list Zed_input.Make(LTerm_key).t -> unit -> object
   inherit LTerm_widget.t
 
   method engine : edit Zed_edit.t
@@ -86,6 +89,9 @@ class edit : ?clipboard : Zed_edit.clipboard -> ?macro : action Zed_macro.t -> u
   method macro : action Zed_macro.t
     (** The macro recorder. *)
 
+  method is_valid_char : CamomileLibrary.UChar.t -> bool
+    (** Can character can be put into the editor. *)
+
   method text : string
     (** Shorthand for [Zed_rope.to_string (Zed_edit.text
         edit#engine)]. *)
@@ -106,3 +112,19 @@ class edit : ?clipboard : Zed_edit.clipboard -> ?macro : action Zed_macro.t -> u
   method vscroll : LTerm_widget.scrollable
 
 end
+
+(* Editor class for integer values.  
+ 
+ Responds to numeric characters, and ['-'] if [positive] is false. *)
+class edit_integer : ?positive:bool -> unit -> object
+  inherit edit
+
+  method value : int option
+    (* Get value from the editor.  Returns [None] if it cannot be converted
+       with [int_of_string] *)
+
+  method set_value : int -> unit
+    (* Set the value in the editor *)
+
+end
+