]> matita.cs.unibo.it Git - helm.git/blobdiff - helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/applications/browser/lexical.ml
This commit was manufactured by cvs2svn to create branch
[helm.git] / helm / DEVEL / lablgtk / lablgtk_20001129-0.1.0 / applications / browser / lexical.ml
diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/applications/browser/lexical.ml b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/applications/browser/lexical.ml
deleted file mode 100644 (file)
index 9acb9c0..0000000
+++ /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