X-Git-Url: http://matita.cs.unibo.it/gitweb/?p=helm.git;a=blobdiff_plain;f=helm%2FDEVEL%2Flablgtk%2Flablgtk_20000829-0.1.0%2Fapplications%2Fbrowser%2Flexical.ml;fp=helm%2FDEVEL%2Flablgtk%2Flablgtk_20000829-0.1.0%2Fapplications%2Fbrowser%2Flexical.ml;h=0000000000000000000000000000000000000000;hp=9acb9c06068905567ee92e4553b0e528e7d812ee;hb=3ef089a4c58fbe429dd539af6215991ecbe11ee2;hpb=1c7fb836e2af4f2f3d18afd0396701f2094265ff diff --git a/helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/applications/browser/lexical.ml b/helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/applications/browser/lexical.ml deleted file mode 100644 index 9acb9c060..000000000 --- a/helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/applications/browser/lexical.ml +++ /dev/null @@ -1,155 +0,0 @@ -(* $Id$ *) - -open Parser - -type tags = [`none|`control|`define|`structure|`char|`infix|`label|`uident] - -let colors : (tags * GDraw.color) list Lazy.t = - lazy - (List.map ~f:(fun (tag,col) -> tag, `COLOR (GDraw.color (`NAME col))) - [ `control, "blue"; - `define, "forestgreen"; - `structure, "purple"; - `char, "gray40"; - `infix, "indianred4"; - `label, "brown"; - `uident, "midnightblue"; - `none, "black" ]) - -let tag ?(start=0) ?stop:pend (tw : GEdit.text) = - let pend = Gaux.default tw#length ~opt:pend in - let colors = Lazy.force colors in - tw#freeze (); - let position = tw#position - and text = tw#get_chars ~start ~stop:pend in - let replace ~start:pstart ~stop:pend ~tag = - if pend > pstart then begin - tw#delete_text ~start:(start+pstart) ~stop:(start+pend); - tw#set_point (start+pstart); - tw#insert ~foreground:(List.assoc tag colors) - (String.sub text ~pos:pstart ~len:(pend-pstart)); - end - and next_lf = ref (-1) in - let colorize ~start:rstart ~stop:rend ~tag = - let rstart = ref rstart in - while !rstart < rend do - if !next_lf < !rstart then begin - try next_lf := String.index_from text !rstart '\n' - with Not_found -> next_lf := pend-start - end; - replace ~start:!rstart ~stop:(min !next_lf rend) ~tag; - rstart := !next_lf + 1 - done - in - let buffer = Lexing.from_string text - and last = ref (EOF, 0, 0) - and last_pos = ref 0 in - try - while true do - let token = Lexer.token buffer - and start = Lexing.lexeme_start buffer - and stop = Lexing.lexeme_end buffer in - let tag = - match token with - AMPERAMPER - | AMPERSAND - | BARBAR - | DO | DONE - | DOWNTO - | ELSE - | FOR - | IF - | LAZY - | MATCH - | OR - | THEN - | TO - | TRY - | WHEN - | WHILE - | WITH - -> `control - | AND - | AS - | BAR - | CLASS - | CONSTRAINT - | EXCEPTION - | EXTERNAL - | FUN - | FUNCTION - | FUNCTOR - | IN - | INHERIT - | INITIALIZER - | LET - | METHOD - | MODULE - | MUTABLE - | NEW - | OF - | PARSER - | PRIVATE - | REC - | TYPE - | VAL - | VIRTUAL - -> `define - | BEGIN - | END - | INCLUDE - | OBJECT - | OPEN - | SIG - | STRUCT - -> `structure - | CHAR _ - | STRING _ - -> `char - | BACKQUOTE - | INFIXOP1 _ - | INFIXOP2 _ - | INFIXOP3 _ - | INFIXOP4 _ - | PREFIXOP _ - | QUESTION2 - | SHARP - -> `infix - | LABEL _ - | OPTLABEL _ - | QUESTION - | TILDE - -> `label - | UIDENT _ -> `uident - | LIDENT _ -> - begin match !last with - (QUESTION | TILDE), _, _ -> `label - | _ -> `none - end - | COLON -> - begin match !last with - LIDENT _, lstart, lstop when lstop = start -> - colorize ~tag:`none ~start:!last_pos ~stop:lstart; - colorize ~tag:`label ~start:lstart ~stop; - last_pos := stop; - `none - | _ -> `none - end - | EOF -> raise End_of_file - | _ -> `none - in - if tag <> `none then begin - colorize ~tag:`none ~start:!last_pos ~stop:start; - colorize ~tag ~start ~stop; - last_pos := stop - end; - last := (token, start, stop) - done - with exn -> - colorize ~tag:`none ~start:!last_pos ~stop:(pend-start); - tw#thaw (); - tw#set_position position; - tw#set_point position; - match exn with - End_of_file | Lexer.Error _ -> () - | _ -> raise exn