diff options
| -rw-r--r-- | otherlibs/labltk/Widgets.src | 4 | ||||
| -rw-r--r-- | otherlibs/labltk/browser/editor.ml | 68 | ||||
| -rw-r--r-- | otherlibs/labltk/browser/shell.ml | 6 | ||||
| -rw-r--r-- | otherlibs/labltk/builtin/builtini_index.ml | 28 |
4 files changed, 74 insertions, 32 deletions
diff --git a/otherlibs/labltk/Widgets.src b/otherlibs/labltk/Widgets.src index d20969dcf..aa0323737 100644 --- a/otherlibs/labltk/Widgets.src +++ b/otherlibs/labltk/Widgets.src @@ -1536,7 +1536,7 @@ widget text { option Wrap ["-wrap"; WrapMode] function (int,int,int,int) bbox [widget(text); "bbox"; index: TextIndex] - function (bool) compare [widget(text); "compare"; index: TextIndex; comparison: Comparison; index: TextIndex] + function (bool) compare [widget(text); "compare"; index: TextIndex; op: Comparison; index: TextIndex] function () configure [widget(text); "configure"; option(text) list] function (string) configure_get [widget(text); "configure"] function () debug [widget(text); "debug"; switch: bool] @@ -1563,7 +1563,7 @@ widget text { # Scan function () scan_mark [widget(text); "scan"; "mark"; x: int; y: int] function () scan_dragto [widget(text); "scan"; "dragto"; x: int; y: int] - function (Index(text) as "[>`Linechar int * int]") search [widget(text); "search"; switches: TextSearch list; "--"; pattern: string; start: TextIndex; ?end: [TextIndex]] + function (Index(text) as "[>`Linechar int * int]") search [widget(text); "search"; switches: TextSearch list; "--"; pattern: string; start: TextIndex; ?stop: [TextIndex]] function () see [widget(text); "see"; index: TextIndex] # Tags function () tag_add [widget(text); "tag"; "add"; tag: TextTag; start: TextIndex; end: TextIndex] diff --git a/otherlibs/labltk/browser/editor.ml b/otherlibs/labltk/browser/editor.ml index f99845eb3..2185bcb48 100644 --- a/otherlibs/labltk/browser/editor.ml +++ b/otherlibs/labltk/browser/editor.ml @@ -127,6 +127,72 @@ let send_region txt = sh#send";;\n" with _ -> () +open Parser + +let send_phrase txt = + if txt.shell = None then begin + match Shell.get_all () with [] -> () + | [sh] -> txt.shell <- Some sh + | l -> select_shell txt + end; + match txt.shell with None -> () + | Some (_,sh) -> + try + let i1,i2 = Text.tag_nextrange txt.tw tag:"sel" start:tstart in + let phrase = Text.get txt.tw start:(i1,[]) end:(i2,[]) in + sh#send phrase; + try + ignore(Str.search_forward phrase pat:(Str.regexp ";;") pos:0); + sh#send "\n" + with Not_found -> + sh#send ";;\n" + with Not_found | Protocol.TkError _ -> + let text = Text.get txt.tw start:tstart end:tend in + let buffer = Lexing.from_string text in + let start = ref 0 + and block_start = ref [] + and pend = ref (-1) + and after = ref false in + while !pend = -1 do + let token = Lexer.token buffer in + let pos = Lexing.lexeme_start buffer in + if not !after && + Text.compare txt.tw index:(tpos pos) op:`Gt + index:(`Mark"insert",[]) + then begin + after := true; + if !block_start <> [] then begin + start := List.hd !block_start; + block_start := [] + end + end; + let bol = (pos = 0) || text.[pos-1] = '\n' in + match token with + CLASS | EXTERNAL | EXCEPTION | FUNCTOR + | LET | MODULE | OPEN | TYPE | VAL | SHARP when bol -> + if !block_start = [] then + if !after then pend := pos else start := pos + else block_start := pos :: List.tl !block_start + | SEMISEMI -> + let pos' = Lexing.lexeme_end buffer in + if !block_start = [] then + if !after then pend := pos else start := pos' + else block_start := pos' :: List.tl !block_start + | BEGIN | OBJECT | STRUCT | SIG -> + block_start := Lexing.lexeme_end buffer :: !block_start + | END -> + if !block_start = [] then + if !after then pend := pos else () + else block_start := List.tl !block_start + | EOF -> + pend := pos + | _ -> + () + done; + let phrase = String.sub text pos:!start len:(!pend - !start) in + sh#send phrase; + sh#send ";;\n" + let search_pos_window txt :x :y = if txt.structure = [] & txt.psignature = [] then () else let `Linechar (l, c) = Text.index txt.tw index:(`Atxy(x,y), []) in @@ -431,7 +497,7 @@ class editor :top :menus = object (self) List.iter [ [`Control], "s", (fun () -> Jg_text.search_string current_tw); [`Control], "g", (fun () -> goto_line current_tw); - [`Alt], "x", (fun () -> send_region (List.hd windows)); + [`Alt], "x", (fun () -> send_phrase (List.hd windows)); [`Alt], "l", self#lex; [`Alt], "t", self#typecheck ] fun:begin fun (modi,key,act) -> diff --git a/otherlibs/labltk/browser/shell.ml b/otherlibs/labltk/browser/shell.ml index 98e33bbc4..9dbe8a260 100644 --- a/otherlibs/labltk/browser/shell.ml +++ b/otherlibs/labltk/browser/shell.ml @@ -97,12 +97,14 @@ object (self) if reading then reading <- false else Text.mark_set textw mark:"input" index:(`Mark"insert",[`Linestart;`Char 1]); + Text.mark_set textw mark:"insert"index:(`Mark"insert",[`Line 1]); self#lex start:(`Mark"input",[`Linestart]) (); let s = (* input is one character before real input *) Text.get textw start:(`Mark"input",[`Char 1]) end:(`Mark"insert",[]) in h#add s; + Text.insert textw index:(`Mark"insert",[]) text:"\n"; self#send s; self#send "\n" method private paste ev = @@ -116,7 +118,7 @@ object (self) let rec bindings = [ ([[],`KeyPress],[`Char],fun ev -> self#keypress ev.ev_Char); ([[],`KeyRelease],[`Char],fun ev -> self#keyrelease ev.ev_Char); - ([[],`KeyPressDetail"Return"],[],fun _ -> self#return); + (* [[],`KeyPressDetail"Return"],[],fun _ -> self#return; *) ([[],`ButtonPressDetail 2], [`MouseX; `MouseY], self#paste); ([[`Alt],`KeyPressDetail"p"],[],fun _ -> self#history `previous); ([[`Alt],`KeyPressDetail"n"],[],fun _ -> self#history `next); @@ -128,6 +130,8 @@ object (self) List.iter bindings fun:(fun (events,fields,f) -> bind textw :events action:(`Set(fields,f))); + bind textw events:[[],`KeyPressDetail"Return"] + action:(`Setbreakable([], fun _ -> self#return; break())); begin try List.iter [in1;err1] fun: begin fun fd -> diff --git a/otherlibs/labltk/builtin/builtini_index.ml b/otherlibs/labltk/builtin/builtini_index.ml index 30f6a4f34..b31e3e288 100644 --- a/otherlibs/labltk/builtin/builtini_index.ml +++ b/otherlibs/labltk/builtin/builtini_index.ml @@ -25,18 +25,6 @@ let cCAMLtoTKmenu_index = (cCAMLtoTKindex : menu_index -> tkArgs) let cCAMLtoTKtext_index = (cCAMLtoTKindex : text_index -> tkArgs) (* Assume returned values are only numerical and l.c *) -(* .menu index returns none if arg is none, but blast it *) - -let cTKtoCAMLindex s = - try - let p = String.index char:'.' s in - `Linechar (int_of_string (String.sub s pos:0 len:p), - int_of_string (String.sub s pos:(p+1) - len:(String.length s - p - 1))) - with - Not_found -> - try `Num (int_of_string s) - with _ -> raise (Invalid_argument ("TKtoCAMLindex: "^s)) let cTKtoCAMLtext_index s = try @@ -52,19 +40,3 @@ let cTKtoCAMLtext_index s = let cTKtoCAMLlistbox_index s = try `Num (int_of_string s) with _ -> raise (Invalid_argument ("TKtoCAMLlistbox_index: "^s)) - -(* -let cTKtoCAMLlinechar_index s = - try - let p = char_index '.' in:s in - (int_of_string (String.sub s pos:0 len:p), - int_of_string (String.sub s pos:(p+1) - len:(String.length s - p - 1))) - with - Not_found -> - raise (Invalid_argument ("TKtoCAMLlinechar_index: "^s)) - -let cTKtoCAMLnum_index s = - try int_of_string s - with _ -> raise (Invalid_argument ("TKtoCAMLnum_index: "^s)) -*) |