summaryrefslogtreecommitdiffstats
path: root/otherlibs/labltk/browser
diff options
context:
space:
mode:
Diffstat (limited to 'otherlibs/labltk/browser')
-rw-r--r--otherlibs/labltk/browser/.depend34
-rw-r--r--otherlibs/labltk/browser/editor.ml16
-rw-r--r--otherlibs/labltk/browser/fileselect.ml41
-rw-r--r--otherlibs/labltk/browser/jg_memo.ml28
-rw-r--r--otherlibs/labltk/browser/jg_memo.mli9
-rw-r--r--otherlibs/labltk/browser/lexical.ml1
-rw-r--r--otherlibs/labltk/browser/searchpos.ml6
-rw-r--r--otherlibs/labltk/browser/shell.ml12
-rw-r--r--otherlibs/labltk/browser/useunix.ml2
9 files changed, 75 insertions, 74 deletions
diff --git a/otherlibs/labltk/browser/.depend b/otherlibs/labltk/browser/.depend
index de782f073..a8ca9eec2 100644
--- a/otherlibs/labltk/browser/.depend
+++ b/otherlibs/labltk/browser/.depend
@@ -1,10 +1,10 @@
editor.cmo: fileselect.cmi jg_bind.cmi jg_button.cmo jg_menu.cmo \
jg_message.cmi jg_text.cmi jg_tk.cmo jg_toplevel.cmo lexical.cmi \
- list2.cmo mytypes.cmi searchid.cmi searchpos.cmi setpath.cmi shell.cmi \
+ mytypes.cmi searchid.cmi searchpos.cmi setpath.cmi shell.cmi \
typecheck.cmi viewer.cmi editor.cmi
editor.cmx: fileselect.cmx jg_bind.cmx jg_button.cmx jg_menu.cmx \
jg_message.cmx jg_text.cmx jg_tk.cmx jg_toplevel.cmx lexical.cmx \
- list2.cmx mytypes.cmi searchid.cmx searchpos.cmx setpath.cmx shell.cmx \
+ mytypes.cmi searchid.cmx searchpos.cmx setpath.cmx shell.cmx \
typecheck.cmx viewer.cmx editor.cmi
fileselect.cmo: jg_box.cmo jg_entry.cmo jg_memo.cmi jg_toplevel.cmo list2.cmo \
setpath.cmi useunix.cmi fileselect.cmi
@@ -38,29 +38,27 @@ main.cmx: editor.cmx jg_config.cmx searchid.cmx searchpos.cmx shell.cmx \
viewer.cmx
searchid.cmo: list2.cmo searchid.cmi
searchid.cmx: list2.cmx searchid.cmi
-searchpos.cmo: jg_bind.cmi jg_message.cmi jg_text.cmi jg_tk.cmo lexical.cmi \
- searchid.cmi searchpos.cmi
-searchpos.cmx: jg_bind.cmx jg_message.cmx jg_text.cmx jg_tk.cmx lexical.cmx \
- searchid.cmx searchpos.cmi
+searchpos.cmo: jg_bind.cmi jg_memo.cmi jg_message.cmi jg_text.cmi jg_tk.cmo \
+ lexical.cmi searchid.cmi searchpos.cmi
+searchpos.cmx: jg_bind.cmx jg_memo.cmx jg_message.cmx jg_text.cmx jg_tk.cmx \
+ lexical.cmx searchid.cmx searchpos.cmi
setpath.cmo: jg_bind.cmi jg_box.cmo jg_button.cmo jg_toplevel.cmo list2.cmo \
useunix.cmi setpath.cmi
setpath.cmx: jg_bind.cmx jg_box.cmx jg_button.cmx jg_toplevel.cmx list2.cmx \
useunix.cmx setpath.cmi
-shell.cmo: fileselect.cmi jg_menu.cmo jg_text.cmi jg_tk.cmo jg_toplevel.cmo \
- lexical.cmi list2.cmo shell.cmi
-shell.cmx: fileselect.cmx jg_menu.cmx jg_text.cmx jg_tk.cmx jg_toplevel.cmx \
- lexical.cmx list2.cmx shell.cmi
+shell.cmo: fileselect.cmi jg_memo.cmi jg_menu.cmo jg_text.cmi jg_tk.cmo \
+ jg_toplevel.cmo lexical.cmi list2.cmo shell.cmi
+shell.cmx: fileselect.cmx jg_memo.cmx jg_menu.cmx jg_text.cmx jg_tk.cmx \
+ jg_toplevel.cmx lexical.cmx list2.cmx shell.cmi
typecheck.cmo: jg_message.cmi jg_text.cmi jg_tk.cmo mytypes.cmi typecheck.cmi
typecheck.cmx: jg_message.cmx jg_text.cmx jg_tk.cmx mytypes.cmi typecheck.cmi
-useunix.cmo: list2.cmo useunix.cmi
-useunix.cmx: list2.cmx useunix.cmi
+useunix.cmo: useunix.cmi
+useunix.cmx: useunix.cmi
viewer.cmo: jg_bind.cmi jg_box.cmo jg_button.cmo jg_entry.cmo jg_menu.cmo \
- jg_message.cmi jg_multibox.cmi jg_tk.cmo jg_toplevel.cmo list2.cmo \
- mytypes.cmi searchid.cmi searchpos.cmi setpath.cmi shell.cmi useunix.cmi \
- viewer.cmi
+ jg_message.cmi jg_multibox.cmi jg_tk.cmo jg_toplevel.cmo mytypes.cmi \
+ searchid.cmi searchpos.cmi setpath.cmi shell.cmi useunix.cmi viewer.cmi
viewer.cmx: jg_bind.cmx jg_box.cmx jg_button.cmx jg_entry.cmx jg_menu.cmx \
- jg_message.cmx jg_multibox.cmx jg_tk.cmx jg_toplevel.cmx list2.cmx \
- mytypes.cmi searchid.cmx searchpos.cmx setpath.cmx shell.cmx useunix.cmx \
- viewer.cmi
+ jg_message.cmx jg_multibox.cmx jg_tk.cmx jg_toplevel.cmx mytypes.cmi \
+ searchid.cmx searchpos.cmx setpath.cmx shell.cmx useunix.cmx viewer.cmi
mytypes.cmi: shell.cmi
typecheck.cmi: mytypes.cmi
diff --git a/otherlibs/labltk/browser/editor.ml b/otherlibs/labltk/browser/editor.ml
index 1074fb14a..ed07b7ec4 100644
--- a/otherlibs/labltk/browser/editor.ml
+++ b/otherlibs/labltk/browser/editor.ml
@@ -234,19 +234,20 @@ let indent_line =
let ins = `Mark"insert" and reg = Str.regexp "[ \t]*" in
fun tw ->
let `Linechar(l,c) = Text.index tw index:(ins,[])
- and line = Text.get tw start:(ins,[`Linestart]) end:(ins,[]) in
+ and line = Text.get tw start:(ins,[`Linestart]) end:(ins,[`Lineend]) in
Str.string_match pat:reg line pos:0;
- if Str.match_end () < c then
- Text.insert tw index:(ins,[]) text:"\t"
- else let indent =
+ let len = Str.match_end () in
+ if len < c then Text.insert tw index:(ins,[]) text:"\t" else
+ let width = string_width (Str.matched_string line) in
+ Text.mark_set tw mark:"insert" index:(ins,[`Linestart;`Char len]);
+ let indent =
if l <= 1 then 2 else
let previous =
Text.get tw start:(ins,[`Line(-1);`Linestart])
end:(ins,[`Line(-1);`Lineend]) in
Str.string_match pat:reg previous pos:0;
let previous = Str.matched_string previous in
- let width = string_width line
- and width_previous = string_width previous in
+ let width_previous = string_width previous in
if width_previous <= width then 2 else width_previous - width
in
Text.insert tw index:(ins,[]) text:(String.make len:indent ' ')
@@ -488,6 +489,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], "s", self#save_file;
[`Alt], "x", (fun () -> send_phrase (List.hd windows));
[`Alt], "l", self#lex;
[`Alt], "t", self#typecheck ]
@@ -506,7 +508,7 @@ class editor :top :menus = object (self)
file_menu#add_command "Open File..." command:self#open_file;
file_menu#add_command "Reopen"
command:(fun () -> self#load_text [(List.hd windows).name]);
- file_menu#add_command "Save File" command:self#save_file;
+ file_menu#add_command "Save File" command:self#save_file accelerator:"M-s";
file_menu#add_command "Save As..." underline:5
command:begin fun () ->
let txt = List.hd windows in
diff --git a/otherlibs/labltk/browser/fileselect.ml b/otherlibs/labltk/browser/fileselect.ml
index cea020edb..ef6ce7bba 100644
--- a/otherlibs/labltk/browser/fileselect.ml
+++ b/otherlibs/labltk/browser/fileselect.ml
@@ -10,50 +10,43 @@ open Tk
(**** Memoized rexgexp *)
-let regexp = (new Jg_memo.c fun:Str.regexp)#get
+let (~) = Jg_memo.fast fun:Str.regexp
(************************************************************ Path name *)
let parse_filter src =
(* replace // by / *)
- let s = global_replace pat:(regexp "/+") with:"/" src in
+ let s = global_replace pat:~"/+" with:"/" src in
(* replace /./ by / *)
- let s = global_replace pat:(regexp "/\./") with:"/" s in
+ let s = global_replace pat:~"/\./" with:"/" s in
(* replace hoge/../ by "" *)
let s = global_replace s
- pat:(regexp "\([^/]\|[^\./][^/]\|[^/][^\./]\|[^/][^/]+\)/\.\./")
- with:"" in
+ pat:~"\([^/]\|[^\./][^/]\|[^/][^\./]\|[^/][^/]+\)/\.\./" with:"" in
(* replace hoge/..$ by *)
let s = global_replace s
- pat:(regexp "\([^/]\|[^\./][^/]\|[^/][^\./]\|[^/][^/]+\)/\.\.$")
- with:"" in
+ pat:~"\([^/]\|[^\./][^/]\|[^/][^\./]\|[^/][^/]+\)/\.\.$" with:"" in
(* replace ^/../../ by / *)
- let s = global_replace pat:(regexp "^\(/\.\.\)+/") with:"/" s in
- if string_match s pat:(regexp "^\([^\*?[]*/\)\(.*\)") pos:0 then
+ let s = global_replace pat:~"^\(/\.\.\)+/" with:"/" s in
+ if string_match s pat:~"^\([^\*?[]*/\)\(.*\)" pos:0 then
let dirs = matched_group 1 s
and ptrn = matched_group 2 s
in
dirs, ptrn
else "", s
-let fixpoint fun:f v =
- let v1 = ref v and v2 = ref (f v) in
- while !v1 <> !v2 do v1 := !v2; v2 := f !v2 done;
- !v1
+let rec fixpoint fun:f v =
+ let v' = f v in
+ if v = v' then v else fixpoint fun:f v'
let unix_regexp s =
- let s = Str.global_replace pat:(regexp "[$^.+]") with:"\\\\\\0" s in
- let s = Str.global_replace pat:(regexp "\\*") with:".*" s in
- let s = Str.global_replace pat:(regexp "\\?") with:".?" s in
+ let s = Str.global_replace pat:~"[$^.+]" with:"\\\\\\0" s in
+ let s = Str.global_replace pat:~"\\*" with:".*" s in
+ let s = Str.global_replace pat:~"\\?" with:".?" s in
let s =
- fixpoint s fun:
- begin fun s ->
- Str.global_replace s
- pat:(regexp "\\({.*\\),\\(.*}\\)")
- with:"\\1\\|\\2"
- end in
+ fixpoint s
+ fun:(Str.replace_first pat:~"\\({.*\\),\\(.*}\\)" with:"\\1\\|\\2") in
let s =
- Str.global_replace pat:(regexp "{\\(.*\\)}") with:"\\(\\1\\)" s in
+ Str.global_replace pat:~"{\\(.*\\)}" with:"\\(\\1\\)" s in
Str.regexp s
let exact_match s :pat =
@@ -104,7 +97,7 @@ let f :title action:proc ?(:dir = Unix.getcwd ())
let configure :filter =
let filter =
- if string_match pat:(regexp "^/.*") filter pos:0
+ if string_match pat:~"^/.*" filter pos:0
then filter
else !current_dir ^ "/" ^ filter
in
diff --git a/otherlibs/labltk/browser/jg_memo.ml b/otherlibs/labltk/browser/jg_memo.ml
index 43a5eb15b..0387b6398 100644
--- a/otherlibs/labltk/browser/jg_memo.ml
+++ b/otherlibs/labltk/browser/jg_memo.ml
@@ -1,17 +1,21 @@
(* $Id$ *)
-class ['a,'b] c fun:(f : 'a -> 'b) = object
- val hash = Hashtbl.create 7
- method get key =
- try Hashtbl.find hash :key
+type ('a, 'b) assoc_list =
+ Nil
+ | Cons of 'a * 'b * ('a, 'b) assoc_list
+
+let rec assq :key = function
+ Nil -> raise Not_found
+ | Cons (a, b, l) ->
+ if key == a then b else assq :key l
+
+let fast fun:f =
+ let memo = ref Nil in
+ fun key ->
+ try assq :key !memo
with Not_found ->
let data = f key in
- Hashtbl.add hash :key :data;
+ memo := Cons(key, data, !memo);
data
- method clear = Hashtbl.clear hash
- method reget key =
- Hashtbl.remove :key hash;
- let data = f key in
- Hashtbl.add hash :key :data;
- data
-end
+
+
diff --git a/otherlibs/labltk/browser/jg_memo.mli b/otherlibs/labltk/browser/jg_memo.mli
index 8d08111b1..3d5c33252 100644
--- a/otherlibs/labltk/browser/jg_memo.mli
+++ b/otherlibs/labltk/browser/jg_memo.mli
@@ -1,8 +1,5 @@
(* $Id$ *)
-class ['a, 'b] c : fun:('a -> 'b) -> object
- val hash : ('a, 'b) Hashtbl.t
- method clear : unit
- method get : 'a -> 'b
- method reget : 'a -> 'b
-end
+val fast : fun:('a -> 'b) -> 'a -> 'b
+(* "fast" memoizer: uses a List.assq like function *)
+(* Good for a smallish number of keys, phisically equal *)
diff --git a/otherlibs/labltk/browser/lexical.ml b/otherlibs/labltk/browser/lexical.ml
index 8c1209a66..ab0267efa 100644
--- a/otherlibs/labltk/browser/lexical.ml
+++ b/otherlibs/labltk/browser/lexical.ml
@@ -95,6 +95,7 @@ let tag ?(:start=tstart) ?(:end=tend) tw =
| SHARP
-> "infix"
| LABEL _
+ | LABELID _
| QUESTION
-> "label"
| UIDENT _ -> "uident"
diff --git a/otherlibs/labltk/browser/searchpos.ml b/otherlibs/labltk/browser/searchpos.ml
index 211332667..45df95474 100644
--- a/otherlibs/labltk/browser/searchpos.ml
+++ b/otherlibs/labltk/browser/searchpos.ml
@@ -13,6 +13,8 @@ open Searchid
(* auxiliary functions *)
+let (~) = Jg_memo.fast fun:Str.regexp
+
let lines_to_chars n in:s =
let l = String.length s in
let rec ltc n :pos =
@@ -453,7 +455,7 @@ and view_decl_menu lid :kind :env :parent =
Format.close_box (); Format.print_flush ();
Format.set_formatter_output_functions out:fo flush:ff;
Format.set_margin margin;
- let l = Str.split sep:(Str.regexp "\n") buf#get in
+ let l = Str.split sep:~"\n" buf#get in
let font =
let font =
Option.get Widget.default_toplevel name:"font" class:"Font" in
@@ -543,7 +545,7 @@ let view_type_menu kind :env :parent =
Format.close_box (); Format.print_flush ();
Format.set_formatter_output_functions out:fo flush:ff;
Format.set_margin margin;
- let l = Str.split sep:(Str.regexp "\n") buf#get in
+ let l = Str.split sep:~"\n" buf#get in
let font =
let font =
Option.get Widget.default_toplevel name:"font" class:"Font" in
diff --git a/otherlibs/labltk/browser/shell.ml b/otherlibs/labltk/browser/shell.ml
index 9dbe8a260..3369f9b39 100644
--- a/otherlibs/labltk/browser/shell.ml
+++ b/otherlibs/labltk/browser/shell.ml
@@ -3,6 +3,10 @@
open Tk
open Jg_tk
+(* Here again, memoize regexps *)
+
+let (~) = Jg_memo.fast fun:Str.regexp
+
(* Nice history class. May reuse *)
class ['a] history () = object
@@ -105,6 +109,7 @@ object (self)
end:(`Mark"insert",[]) in
h#add s;
Text.insert textw index:(`Mark"insert",[]) text:"\n";
+ Text.yview_index textw index:(`Mark"insert",[]);
self#send s;
self#send "\n"
method private paste ev =
@@ -162,11 +167,11 @@ let may_exec prog =
let f :prog :title =
let progargs =
- List.filter pred:((<>) "") (Str.split sep:(Str.regexp " ") prog) in
+ List.filter pred:((<>) "") (Str.split sep:~" " prog) in
if progargs = [] then () else
let prog = List.hd progargs in
let path = try Sys.getenv "PATH" with Not_found -> "/bin:/usr/bin" in
- let exec_path = Str.split sep:(Str.regexp":") path in
+ let exec_path = Str.split sep:~":" path in
let exists =
if not (Filename.is_implicit prog) then may_exec prog else
List.exists exec_path
@@ -185,10 +190,9 @@ let f :prog :title =
pack [sb] fill:`Y side:`Right;
pack [tw] fill:`Both expand:true side:`Left;
pack [frame] fill:`Both expand:true;
- let reg = Str.regexp "TERM=" in
let env = Array.map (Unix.environment ()) fun:
begin fun s ->
- if Str.string_match pat:reg s pos:0 then "TERM=dumb" else s
+ if Str.string_match pat:~"TERM=" s pos:0 then "TERM=dumb" else s
end in
let load_path =
List2.flat_map !Config.load_path fun:(fun dir -> ["-I"; dir]) in
diff --git a/otherlibs/labltk/browser/useunix.ml b/otherlibs/labltk/browser/useunix.ml
index c0b7e5966..33dd20f2b 100644
--- a/otherlibs/labltk/browser/useunix.ml
+++ b/otherlibs/labltk/browser/useunix.ml
@@ -17,7 +17,7 @@ let get_files_in_directory dir =
let is_directory name =
try
- (stat :name).st_kind = S_DIR
+ (stat name).st_kind = S_DIR
with _ -> false
let get_directories_in_files :path =
generated by cgit v1.2.3-70-g09d2 (git 2.46.0) at 2025-03-19 15:52:56 +0000