Bugs and simplifications

maranget · Jul 3, 2012 · c358e2d · c358e2d
1 parent 1f1476d
commit c358e2d
Show file tree

Hide file tree

Showing 8 changed files with 42 additions and 320 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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 *)