diff --git a/CHANGES b/CHANGES index a88fa022..5a12ee33 100644 --- a/CHANGES +++ b/CHANGES @@ -1,3 +1,6 @@ + - Simplified html.mli, text.mli and info.mli by including outManager + signature + - Corrected installer bug (lstlang?.sty not installed !!) - Buffers with underlying rope structure (use our own) version 1.10+17 - Testing svn based release script diff --git a/html.mli b/html.mli index c9dab047..793575bd 100644 --- a/html.mli +++ b/html.mli @@ -8,106 +8,4 @@ (* Automatique. Distributed only by permission. *) (* *) (***********************************************************************) -open Lexstate -exception Error of string -type block -val set_out : Out.t -> unit -val stop : unit -> unit -val restart : unit -> unit -val is_empty : unit -> bool - -val get_fontsize : unit -> int -val nostyle : unit -> unit -val clearstyle : unit -> unit -val open_mod : Element.text -> unit -val erase_mods : Element.text list -> unit -val has_mod : Element.text -> bool -val forget_par : unit -> int option -val close_par : unit -> bool -val open_par : unit -> unit -val par : int option -> unit -val open_block : string -> string -> unit -val close_block : string -> unit -val force_block : string -> string -> unit -val close_flow : string -> unit -val insert_block : string -> string -> unit -val insert_attr : string -> string -> unit - -val open_maths : bool -> unit -val close_maths : bool -> unit -val open_display_varg : string -> unit -val open_display : unit -> unit -val close_display : unit -> unit -val item_display : unit -> unit -val force_item_display : unit -> unit -val erase_display : unit -> unit -val standard_sup_sub : - (string arg -> unit) -> (unit -> unit) -> string arg -> string arg -> bool -> unit -val limit_sup_sub : - (string arg -> unit) -> (unit -> unit) -> string arg -> string arg -> bool -> unit -val int_sup_sub : - bool -> int -> - (string arg -> unit) -> (unit -> unit) -> string arg -> string arg -> bool -> unit -val addvsize : int -> unit -val over : Lexing.lexbuf -> unit -val left : string -> (int -> unit) -> (int -> unit) -> unit -val right : string -> (int -> unit) -> int - -val set_dcount : string -> unit -val item : string-> unit -val nitem : string-> unit -val ditem : (string -> unit) -> string -> string -> string -> unit -val erase_block : string -> unit -val open_group : string -> unit -val open_aftergroup : (string -> string) -> unit -val close_group : unit -> unit -val put : string -> unit -val put_char : char -> unit -val put_unicode : OutUnicode.unichar -> unit -val flush_out : unit -> unit -val skip_line : unit -> unit - -val loc_name : string -> unit - -val open_chan : out_channel -> unit -val close_chan : unit -> unit -val to_string : (unit -> unit) -> string -val to_style : (unit -> unit) -> Element.text list -val get_current_output : unit -> string - -val finalize : bool -> unit - -val horizontal_line : string -> Length.t -> Length.t -> unit -val put_separator : unit -> unit -val unskip : unit -> unit -val put_tag : string -> unit -val put_nbsp : unit -> unit -val put_open_group : unit -> unit -val put_close_group : unit -> unit -val put_in_math : string -> unit - -val open_table : bool -> string -> unit -val new_row : unit -> unit -val open_cell : Tabular.format -> int -> int -> unit -val erase_cell : unit -> unit -val close_cell : string -> unit -val do_close_cell : unit -> unit -val open_cell_group : unit -> unit -val close_cell_group : unit -> unit -val erase_cell_group : unit -> unit -val close_row : unit -> unit -val erase_row : unit -> unit -val close_table : unit -> unit -val make_border : string -> unit -val make_inside : string -> bool -> unit -val make_hline : int -> bool -> unit - -val infomenu : string -> unit -val infonode : string -> string -> string -> unit -val infoextranode : string -> string -> string -> unit - -val image : string -> string -> unit - -type saved -val check : unit -> saved -val hot : saved -> unit +include OutManager.S diff --git a/info.mli b/info.mli index 5410cb17..793575bd 100644 --- a/info.mli +++ b/info.mli @@ -8,107 +8,4 @@ (* Automatique. Distributed only by permission. *) (* *) (***********************************************************************) - -open Lexstate -exception Error of string -type block -val set_out : Out.t -> unit -val stop : unit -> unit -val restart : unit -> unit -val is_empty : unit -> bool - -val get_fontsize : unit -> int -val nostyle : unit -> unit -val clearstyle : unit -> unit -val open_mod : Element.text -> unit -val erase_mods : Element.text list -> unit -val has_mod : Element.text -> bool - val forget_par : unit -> int option - val close_par : unit -> bool - val open_par : unit -> unit - val par : int option -> unit - val open_block : string -> string -> unit - val close_block : string -> unit - val force_block : string -> string -> unit - val close_flow : string -> unit - val insert_block : string -> string -> unit - val insert_attr : string -> string -> unit - - val open_maths : bool -> unit - val close_maths : bool -> unit - val open_display_varg : string -> unit - val open_display : unit -> unit - val close_display : unit -> unit - val item_display : unit -> unit - val force_item_display : unit -> unit - val erase_display : unit -> unit - val standard_sup_sub : - (string arg -> unit) -> (unit -> unit) -> string arg -> string arg -> bool -> unit - val limit_sup_sub : - (string arg -> unit) -> (unit -> unit) -> string arg -> string arg -> bool -> unit - val int_sup_sub : - bool -> int -> - (string arg -> unit) -> (unit -> unit) -> string arg -> string arg -> bool -> unit - val addvsize : int -> unit - val over : Lexing.lexbuf -> unit - val left : string -> (int -> unit) -> (int -> unit) -> unit - val right : string -> (int -> unit) -> int - - val set_dcount : string -> unit - val item : string-> unit - val nitem : string-> unit - val ditem : (string -> unit) -> string -> string -> string -> unit - val erase_block : string -> unit - val open_group : string -> unit - val open_aftergroup : (string -> string) -> unit - val close_group : unit -> unit - val put : string -> unit - val put_char : char -> unit - val put_unicode : OutUnicode.unichar -> unit - val flush_out : unit -> unit - val skip_line : unit -> unit - - val loc_name : string -> unit - - val open_chan : out_channel -> unit - val close_chan : unit -> unit - val to_string : (unit -> unit) -> string - val to_style : (unit -> unit) -> Element.text list - val get_current_output : unit -> string - - val finalize : bool -> unit - - val horizontal_line : string -> Length.t -> Length.t -> unit - val put_separator : unit -> unit - val unskip : unit -> unit - val put_tag : string -> unit - val put_nbsp : unit -> unit - val put_open_group : unit -> unit - val put_close_group : unit -> unit - val put_in_math : string -> unit - - val open_table : bool -> string -> unit - val new_row : unit -> unit - val open_cell : Tabular.format -> int -> int -> unit - val erase_cell : unit -> unit - val close_cell : string -> unit - val do_close_cell : unit -> unit - val open_cell_group : unit -> unit - val close_cell_group : unit -> unit - val erase_cell_group : unit -> unit - val close_row : unit -> unit - val erase_row : unit -> unit - val close_table : unit -> unit - val make_border : string -> unit - val make_inside : string -> bool -> unit - val make_hline : int -> bool -> unit - - val infomenu : string -> unit - val infonode : string -> string -> string -> unit - val infoextranode : string -> string -> string -> unit - - val image : string -> string -> unit - - type saved - val check : unit -> saved - val hot : saved -> unit +include OutManager.S diff --git a/libs.def b/libs.def index 96f77125..a50b082f 100644 --- a/libs.def +++ b/libs.def @@ -1,4 +1,4 @@ -ALLLIB= alltt.hva amsmath.hva articlecommon.hva babel.hva bookcommon.hva booktabs.hva comment.hva compat.hva hyperref.hva ifthen.hva index.hva iso-symb.hva keyval.hva latexcommon.hva listings.hva lstlang1.hva lstlang2.hva lstlang3.hva makeidx.hva mathop.hva moreverb.hva multibib.hva multind.hva natbib-common.hva packages.hva plain.hva program.hva spaces.hva supertabular.hva underscore.hva url.hva verbatim.hva french-common.hva german-common.hva english.hva czech.hva ragged2e.hva chapterbib.hva deepcut.hva figcut.hva longtable.hva eurosym.hva isolatin1.hva textcomp.hva chngcntr.hva ifpdf.hva theorem.hva xspace.hva latexsym.hva iso-html.hva iso-text.hva winstyles.hva winfonts.hva epsfig.hva inputenc.hva thai.hva import.hva hanging.hva +ALLLIB= alltt.hva amsmath.hva articlecommon.hva babel.hva bookcommon.hva booktabs.hva comment.hva compat.hva hyperref.hva ifthen.hva index.hva iso-symb.hva keyval.hva latexcommon.hva listings.hva lstlang1.hva lstlang2.hva lstlang3.hva makeidx.hva mathop.hva moreverb.hva multibib.hva multind.hva natbib-common.hva packages.hva plain.hva program.hva spaces.hva supertabular.hva underscore.hva url.hva verbatim.hva french-common.hva german-common.hva english.hva czech.hva ragged2e.hva chapterbib.hva deepcut.hva figcut.hva longtable.hva eurosym.hva isolatin1.hva textcomp.hva chngcntr.hva ifpdf.hva theorem.hva xspace.hva latexsym.hva iso-html.hva iso-text.hva winstyles.hva winfonts.hva epsfig.hva inputenc.hva thai.hva import.hva hanging.hva lstlang1.sty lstlang2.sty lstlang3.sty HTMLLIB= amssymb.hva amsfonts.hva article.hva austrian.hva book.hva color.hva colortbl.hva commongraphic.hva fancysection.hva fancyvrb.hva french.hva german.hva graphics.hva graphicx.hva hevea.hva common-math.hva mathpartir.hva natbib.hva png.hva gif.hva report.hva seminar.hva sword.hva symb-eng.hva symb-ent.hva symb-fra.hva symb-mathml.hva symb-text.hva urlhref.hva xypic.hva TEXTLIB=article.hva book.hva color.hva colortbl.hva fancysection.hva hevea.hva report.hva seminar.hva french.hva austrian.hva german.hva natbib.hva INFOLIB=article.hva book.hva hevea.hva report.hva seminar.hva diff --git a/out.ml b/out.ml index 254bdd85..1b478bda 100644 --- a/out.ml +++ b/out.ml @@ -107,6 +107,10 @@ let as_string r = S.to_string r let to_string = function | Rope r -> + if !verbose > 2 && S.length !r > 256 then begin + eprintf "Rope to string:\n" ; + S.debug stderr !r + end ; let s = as_string !r in r := S.empty ; s diff --git a/simpleRope.ml b/simpleRope.ml index 411d4771..e51b279e 100644 --- a/simpleRope.ml +++ b/simpleRope.ml @@ -9,6 +9,8 @@ (* *) (***********************************************************************) +open Printf + (**********) (* Basics *) (**********) @@ -123,6 +125,19 @@ let rec output chan = function | Str s -> output_string chan s | App (t1,t2,_) -> output chan t1 ; output chan t2 +let rec debug_rec indent chan = function + | Str s -> + fprintf chan "%s%a\n" indent output_string s + | App (t1,t2,_) -> + let indent2 = indent ^ " " in + fprintf chan "%s<\n" indent ; + debug_rec indent2 chan t1 ; + debug_rec indent2 chan t2 ; + fprintf chan "%s>\n" indent ; + () + +let debug = debug_rec "" + (*************) (* To string *) (*************) @@ -186,23 +201,30 @@ let erase t pred = do_rec t (* Attempt: build lexbuff *) -(* -type buff = { rope : t ; pos : int } + +type buff = { rope : t ; mutable pos : int } let rec blit t src buff dst len = match t with -| Str s -> String.blit s src buff dst len +| Str s -> + String.blit s src buff dst len ; + len | App (t1,t2,_) -> let n1 = length t1 in if src >= n1 then blit t2 (src-n1) buff dst len - if src < len && n1 <= len then + else if n1 <= len then blit t1 src buff dst len else begin - blit t1 0 buff dst n1 ; - blit t2 + let m1 = blit t1 src buff dst (n1-src) in + let m2 = blit t2 0 buff (dst+m1) (len-m1) in + m1+m2 end + let fill_buff b s n = + let m = blit b.rope b.pos s 0 n in + b.pos <- b.pos + m ; + m + + -let to_lexbuf t -*) diff --git a/simpleRope.mli b/simpleRope.mli index 81d4545a..e5ca3a01 100644 --- a/simpleRope.mli +++ b/simpleRope.mli @@ -29,6 +29,7 @@ val iter_range : (char -> unit) -> t -> int -> int -> unit (* Translations *) val output : out_channel -> t -> unit +val debug : out_channel -> t -> unit val to_string : t -> string (* Index function *) diff --git a/text.mli b/text.mli index 3eac82fc..793575bd 100644 --- a/text.mli +++ b/text.mli @@ -8,107 +8,4 @@ (* Automatique. Distributed only by permission. *) (* *) (***********************************************************************) - -open Lexstate -exception Error of string -type block -val set_out : Out.t -> unit -val stop : unit -> unit -val restart : unit -> unit -val is_empty : unit -> bool - -val get_fontsize : unit -> int -val nostyle : unit -> unit -val clearstyle : unit -> unit -val open_mod : Element.text -> unit -val erase_mods : Element.text list -> unit -val has_mod : Element.text -> bool -val forget_par : unit -> int option -val close_par : unit -> bool -val open_par : unit -> unit -val par : int option -> unit -val open_block : string -> string -> unit -val close_block : string -> unit -val force_block : string -> string -> unit -val close_flow : string -> unit -val insert_block : string -> string -> unit -val insert_attr : string -> string -> unit - -val open_maths : bool -> unit -val close_maths : bool -> unit -val open_display_varg : string -> unit -val open_display : unit -> unit -val close_display : unit -> unit -val item_display : unit -> unit -val force_item_display : unit -> unit -val erase_display : unit -> unit -val standard_sup_sub : - (string arg -> unit) -> (unit -> unit) -> string arg -> string arg -> bool -> unit -val limit_sup_sub : - (string arg -> unit) -> (unit -> unit) -> string arg -> string arg -> bool -> unit -val int_sup_sub : - bool -> int -> - (string arg -> unit) -> (unit -> unit) -> string arg -> string arg -> bool -> unit -val addvsize : int -> unit -val over : Lexing.lexbuf -> unit -val left : string -> (int -> unit) -> (int -> unit) -> unit -val right : string -> (int -> unit) -> int - -val set_dcount : string -> unit -val item : string-> unit -val nitem : string-> unit -val ditem : (string -> unit) -> string -> string -> string -> unit -val erase_block : string -> unit -val open_group : string -> unit -val open_aftergroup : (string -> string) -> unit -val close_group : unit -> unit -val put : string -> unit -val put_char : char -> unit -val put_unicode : OutUnicode.unichar -> unit -val flush_out : unit -> unit -val skip_line : unit -> unit - -val loc_name : string -> unit - -val open_chan : out_channel -> unit -val close_chan : unit -> unit -val to_string : (unit -> unit) -> string -val to_style : (unit -> unit) -> Element.text list -val get_current_output : unit -> string - -val finalize : bool -> unit - -val horizontal_line : string -> Length.t -> Length.t -> unit -val put_separator : unit -> unit -val unskip : unit -> unit -val put_tag : string -> unit -val put_nbsp : unit -> unit -val put_open_group : unit -> unit -val put_close_group : unit -> unit -val put_in_math : string -> unit - -val open_table : bool -> string -> unit -val new_row : unit -> unit -val open_cell : Tabular.format -> int -> int -> unit -val erase_cell : unit -> unit -val close_cell : string -> unit -val do_close_cell : unit -> unit -val open_cell_group : unit -> unit -val close_cell_group : unit -> unit -val erase_cell_group : unit -> unit -val close_row : unit -> unit -val erase_row : unit -> unit -val close_table : unit -> unit -val make_border : string -> unit -val make_inside : string -> bool -> unit -val make_hline : int -> bool -> unit - -val infomenu : string -> unit -val infonode : string -> string -> string -> unit -val infoextranode : string -> string -> string -> unit - -val image : string -> string -> unit - -type saved -val check : unit -> saved -val hot : saved -> unit +include OutManager.S