2 * ----------------------------------------------------------------------
10 (**********************************************************************)
11 (* The box class represents formatted text *)
12 (**********************************************************************)
14 class type formatted_text =
16 method output : int -> int -> out_channel -> unit
17 (* output initial_indent indent ch:
18 * 'initial_indent' is how far the first line should be indented;
19 * 'indent' how far the rest. 'ch' is the channel on which the lines
23 method multiline : bool
24 (* whether the box occupies multiple lines *)
26 method width_of_last_line : int
27 (* returns the width of the last line *)
34 | Box of formatted_text
39 let rec compute tl r =
45 compute tl' (r + String.length s)
48 compute tl' (b # width_of_last_line)
50 compute tl' (r + b # width_of_last_line)
53 compute (List.rev tl) 0
57 class box the_initial_width the_width =
60 (* The 'initial_width' is the width that is available on the first
61 * line of output; the 'width' is the width that is available in the
65 val initial_width = the_initial_width
70 val mutable space_added = false
71 val mutable linefeed_added = false
72 val mutable is_first_line = true
73 val mutable lines = []
74 (* lines in reverse order (first line = last element) *)
75 val mutable current_line = []
76 (* not member of 'lines'; again reverse order *)
77 val mutable current_indent = 0
80 if not space_added then begin
82 linefeed_added <- true;
83 current_line <- Text " " :: current_line
88 linefeed_added <- true
91 if not linefeed_added then begin
92 linefeed_added <- true;
93 if not space_added then
94 current_line <- Text " " :: current_line
97 method ignore_linefeed =
98 linefeed_added <- true
101 lines <- current_line :: lines;
104 linefeed_added <- true;
105 is_first_line <- false;
109 (* first try to add 's' to 'current_line' *)
110 let current_line' = Text s :: current_line in
112 if is_first_line then initial_width else width in
113 if textwidth current_line' + current_indent <= current_width then begin
114 (* ok, the line does not become too long *)
115 current_line <- current_line';
116 space_added <- false;
117 linefeed_added <- false
120 (* The line would be too long. *)
121 lines <- current_line :: lines;
122 current_line <- [Text s];
123 space_added <- false;
124 linefeed_added <- false;
125 is_first_line <- false;
130 current_line <- Box b :: current_line;
131 space_added <- false;
132 linefeed_added <- false;
135 method width_of_last_line =
136 textwidth current_line + current_indent
139 method available_width =
141 if is_first_line then initial_width else width in
142 current_width - textwidth current_line - current_indent
150 | Box b -> b # multiline)
153 method output initial_indent indent ch =
156 (current_line :: lines) in
157 let rec out_lines cur_indent ll =
161 output_string ch (String.make cur_indent ' ');
167 b # output 0 indent ch
171 output_string ch "\n";
174 out_lines initial_indent eff_lines
179 class listitem_box listmark indent totalwidth =
180 let initial_newline = String.length listmark >= indent in
182 inherit box totalwidth (totalwidth - indent) as super
184 val extra_indent = indent
187 self # add_word listmark;
188 if initial_newline then
191 current_line <- Text (String.make (indent - String.length listmark) ' ')
194 linefeed_added <- true;
198 method output initial_indent indent ch =
199 super # output initial_indent (indent + extra_indent) ch
204 (**********************************************************************)
206 (**********************************************************************)
209 class type footnote_printer =
211 method footnote_to_box : store_type -> box -> unit
216 method alloc_footnote : footnote_printer -> int
217 method print_footnotes : box -> unit
225 val mutable footnotes = ( [] : (int * footnote_printer) list )
226 val mutable next_footnote_number = 1
228 method alloc_footnote n =
229 let number = next_footnote_number in
230 next_footnote_number <- number+1;
231 footnotes <- footnotes @ [ number, n ];
234 method print_footnotes (b : box) =
235 if footnotes <> [] then begin
238 let w = b # available_width in
239 b # add_word (String.make (w/3) '-');
244 n # footnote_to_box (self : #store_type :> store_type) b)
253 (**********************************************************************)
254 (* The extension objects *)
255 (**********************************************************************)
258 class virtual shared =
261 (* --- default_ext --- *)
263 val mutable node = (None : shared node option)
274 (* --- virtual --- *)
276 method virtual to_box : store -> box -> unit
278 * formats the element using box 'b'
288 val white_space_re = Str.regexp "[ \t]+\\|\n"
290 method to_box store b =
291 let s = self # node # data in
292 let splitted = Str.full_split white_space_re s in
310 method to_box store b =
312 (fun n -> n # extension # to_box store b)
313 (self # node # sub_nodes)
322 method to_box store b =
324 match self # node # attribute "title" with
328 let w = b # available_width in
329 let line = String.make (w-1) '*' in
337 (* process main content: *)
339 (fun n -> n # extension # to_box store b)
340 (self # node # sub_nodes);
341 (* now process footnotes *)
342 store # print_footnotes b;
349 class section the_tag =
355 method to_box store b =
356 let sub_nodes = self # node # sub_nodes in
358 title_node :: rest ->
360 let w = b # available_width in
361 let line = String.make (w-1) tag in
364 b # add_word (title_node # data);
370 n # extension # to_box store b)
377 class sect1 = section '=';;
378 class sect2 = section '-';;
379 class sect3 = section ':';;
386 method to_box store b =
388 match self # node # parent # node_type with
389 T_element "li" -> true
390 | T_element _ -> false
393 if not within_list then
395 let w = b # available_width in
396 let b' = new box w w in
399 (fun n -> n # extension # to_box store b')
400 (self # node # sub_nodes);
401 b # add_box (b' :> formatted_text);
411 method to_box store b =
413 let w = b # available_width in
414 let b' = new listitem_box "-" 3 w in
417 (fun n -> n # extension # to_box store b')
418 (self # node # sub_nodes);
419 b # add_box (b' :> formatted_text);
428 method to_box store b =
430 let w = b # available_width in
431 let b' = new box w w in
433 let data = self # node # data in
435 let l = String.length data in
436 let rec add s i column =
437 (* this is very ineffective but comprehensive: *)
441 let n = 8 - (column mod 8) in
442 add (s ^ String.make n ' ') (i+1) (column + n)
448 add (s ^ String.make 1 c) (i+1) (column + 1)
450 if s <> "" then begin
456 b # add_box (b' :> formatted_text);
466 method to_box store b =
476 val mutable footnote_number = 0
478 method to_box store b =
480 store # alloc_footnote (self : #shared :> footnote_printer) in
481 footnote_number <- number;
483 b # add_word ("[" ^ string_of_int number ^ "]");
485 method footnote_to_box store b =
486 let w = b # available_width in
487 let n = "[" ^ string_of_int footnote_number ^ "]" in
488 let b' = new listitem_box n 6 w in
491 (fun n -> n # extension # to_box store b')
492 (self # node # sub_nodes);
493 b # add_box (b' :> formatted_text);
505 val mutable footnote_number = 0
506 val mutable a_href = ""
508 method to_box store b =
510 match self # node # attribute "href" with
511 Value v -> "see " ^ v
512 | Valuelist _ -> assert false
514 begin match self # node # attribute "readmeref" with
515 Value v -> "see file " ^ v
516 | Valuelist _ -> assert false
523 (fun n -> n # extension # to_box store b)
524 (self # node # sub_nodes);
525 if href <> "" then begin
527 store # alloc_footnote (self : #shared :> footnote_printer) in
528 footnote_number <- number;
530 b # add_word ("[" ^ string_of_int number ^ "]");
533 method footnote_to_box store b =
534 if a_href <> "" then begin
535 let w = b # available_width in
536 let n = "[" ^ string_of_int footnote_number ^ "]" in
537 let b' = new listitem_box n 6 w in
539 b' # add_word a_href;
540 b # add_box (b' :> formatted_text);
547 (**********************************************************************)
553 ~data_exemplar:(new data_impl (new only_data))
554 ~default_element_exemplar:(new element_impl (new no_markup))
556 [ "readme", (new element_impl (new readme));
557 "sect1", (new element_impl (new sect1));
558 "sect2", (new element_impl (new sect2));
559 "sect3", (new element_impl (new sect3));
560 "title", (new element_impl (new no_markup));
561 "p", (new element_impl (new p));
562 "br", (new element_impl (new br));
563 "code", (new element_impl (new code));
564 "em", (new element_impl (new no_markup));
565 "ul", (new element_impl (new no_markup));
566 "li", (new element_impl (new li));
567 "footnote", (new element_impl (new footnote : #shared :> shared));
568 "a", (new element_impl (new a : #shared :> shared));
576 (* ======================================================================
580 * Revision 1.1 2000/11/17 09:57:31 lpadovan
583 * Revision 1.5 2000/08/22 14:34:25 gerd
584 * Using make_spec_from_alist instead of make_spec_from_mapping.
586 * Revision 1.4 2000/08/18 21:15:25 gerd
587 * Minor updates because of PXP API changes.
589 * Revision 1.3 2000/07/08 17:58:17 gerd
590 * Updated because of PXP API changes.
592 * Revision 1.2 2000/06/04 20:25:38 gerd
593 * Updates because of renamed PXP modules.
595 * Revision 1.1 1999/08/22 22:29:32 gerd