« back to all changes in this revision
Viewing changes to ad-printers.adb
- browse files at revision 1
- compare with another revision
- download diff
- download tarball
- view history from revision 1
- Committer: Bazaar Package Importer
- Author(s): Ludovic Brenta
- Date: 2004-02-14 13:22:40 UTC
- Revision ID: james.westby@ubuntu.com-20040214132240-cqumhiq1677pkvzo
Tags: upstream-4.0.2
Import upstream version 4.0.2
- files added:
- config
- doc
- simple_test
- xml
added
removed
ad-printers.adb
1
-------------------------------------------------------------------------------
2
--
3
-- This file is part of AdaBrowse.
4
--
5
-- <STRONG>Copyright (c) 2002 by Thomas Wolf.</STRONG>
6
-- <BLOCKQUOTE>
7
-- AdaBrowse is free software; you can redistribute it and/or modify it
8
-- under the terms of the GNU General Public License as published by the
9
-- Free Software Foundation; either version 2, or (at your option) any
10
-- later version. AdaBrowse is distributed in the hope that it will be
11
-- useful, but <EM>without any warranty</EM>; without even the implied
12
-- warranty of <EM>merchantability or fitness for a particular purpose.</EM>
13
-- See the GNU General Public License for more details. You should have
14
-- received a copy of the GNU General Public License with this distribution,
15
-- see file "<A HREF="GPL.txt">GPL.txt</A>". If not, write to the Free
16
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
17
-- USA.
18
-- </BLOCKQUOTE>
19
--
20
-- <DL><DT><STRONG>
21
-- Author:</STRONG><DD>
22
-- Thomas Wolf (TW)
23
-- <ADDRESS><A HREF="mailto:twolf@acm.org">twolf@acm.org</A></ADDRESS></DL>
24
--
25
-- <DL><DT><STRONG>
26
-- Purpose:</STRONG><DD>
27
-- Abstract root type for the various output producers (HTML, XML, DocBook,
28
-- and so on).</DL>
29
--
30
-- <!--
31
-- Revision History
32
--
33
-- 22-JUL-2002 TW Initial version.
34
-- 30-JUL-2003 TW Complete rewrite of the indexing stuff.
35
-- -->
36
-------------------------------------------------------------------------------
37
38
pragma License (GPL);
39
40
with Ada.Exceptions;
41
with Ada.Text_IO;
42
43
with Asis.Declarations;
44
with Asis.Elements;
45
with Asis.Text;
46
47
with AD.File_Ops;
48
with AD.Messages;
49
with AD.Syntax;
50
51
with Util.Files;
52
with Util.Pathes;
53
with Util.Strings;
54
55
package body AD.Printers is
56
57
use Asis.Declarations;
58
use Asis.Elements;
59
use Asis;
60
61
use Util.Strings;
62
63
----------------------------------------------------------------------------
64
65
function To_String
66
(Pos : in Asis2.Spans.Position;
67
Full : in Boolean)
68
return String
69
is
70
begin
71
if Full then
72
return Trim (Asis.Text.Line_Number'Image (Pos.Line)) &
73
'_' &
74
Trim (Asis.Text.Character_Position'Image (Pos.Column));
75
else
76
return Trim (Asis.Text.Line_Number'Image (Pos.Line));
77
end if;
78
end To_String;
79
80
----------------------------------------------------------------------------
81
82
procedure Set_Line_Only
83
is
84
begin
85
Full_Crossrefs := False;
86
AD.Messages.Warn
87
("-l option given: cross-references use only the line number.");
88
end Set_Line_Only;
89
90
----------------------------------------------------------------------------
91
92
function Get_Item_Kind
93
(Item : in Asis.Element)
94
return Item_Kind
95
is
96
function In_PO
97
(Decl : in Asis.Declaration)
98
return Boolean
99
is
100
Encl : Asis.Element := Decl;
101
begin
102
-- Loop until we either hit a nil element or a declaration.
103
loop
104
Encl := Enclosing_Element (Encl);
105
exit when Is_Nil (Encl);
106
case Declaration_Kind (Encl) is
107
when Not_A_Declaration =>
108
null;
109
when A_Protected_Type_Declaration |
110
A_Single_Protected_Declaration |
111
A_Task_Type_Declaration |
112
A_Single_Task_Declaration =>
113
return True;
114
when others =>
115
exit;
116
end case;
117
end loop;
118
return False;
119
end In_PO;
120
121
begin
122
case Declaration_Kind (Item) is
123
when Not_A_Declaration =>
124
-- It had better be a pragma! (What about rep clauses?)
125
-- We also have use clauses here...
126
case Element_Kind (Item) is
127
when Asis.A_Pragma =>
128
return AD.Printers.A_Pragma;
129
when Asis.A_Clause =>
130
case Clause_Kind (Item) is
131
when A_Use_Package_Clause =>
132
return A_Use_Clause;
133
when Asis.A_Use_Type_Clause =>
134
return AD.Printers.A_Use_Type_Clause;
135
when others =>
136
return Not_An_Item;
137
end case;
138
when others =>
139
return Not_An_Item;
140
end case;
141
142
when A_Procedure_Declaration =>
143
if In_PO (Item) then
144
return A_Protected_Procedure;
145
else
146
return A_Procedure;
147
end if;
148
149
when A_Function_Declaration =>
150
if In_PO (Item) then
151
return A_Protected_Function;
152
else
153
return A_Function;
154
end if;
155
156
when An_Entry_Declaration =>
157
return An_Entry;
158
159
when A_Package_Declaration =>
160
return A_Package;
161
162
when A_Generic_Package_Declaration =>
163
declare
164
Visible_Stuff : constant Declaration_List :=
165
Visible_Part_Declarative_Items (Item);
166
begin
167
if Visible_Stuff'Last < Visible_Stuff'First then
168
return A_Generic_Signature_Package;
169
else
170
return A_Generic_Package;
171
end if;
172
end;
173
174
when A_Generic_Procedure_Declaration =>
175
return A_Generic_Procedure;
176
177
when A_Generic_Function_Declaration =>
178
return A_Generic_Function;
179
180
when Asis.A_Package_Instantiation =>
181
return AD.Printers.A_Package_Instantiation;
182
183
when Asis.A_Procedure_Instantiation =>
184
return AD.Printers.A_Procedure_Instantiation;
185
186
when Asis.A_Function_Instantiation =>
187
return AD.Printers.A_Function_Instantiation;
188
189
when A_Package_Renaming_Declaration =>
190
return A_Package_Renaming;
191
192
when A_Procedure_Renaming_Declaration =>
193
return A_Procedure_Renaming;
194
195
when A_Function_Renaming_Declaration =>
196
return A_Function_Renaming;
197
198
when A_Generic_Package_Renaming_Declaration =>
199
return A_Generic_Package_Renaming;
200
201
when A_Generic_Procedure_Renaming_Declaration =>
202
return A_Generic_Procedure_Renaming;
203
204
when A_Generic_Function_Renaming_Declaration =>
205
return A_Generic_Function_Renaming;
206
207
when A_Task_Type_Declaration =>
208
return A_Task_Type;
209
210
when A_Single_Task_Declaration =>
211
return A_Task;
212
213
when A_Protected_Type_Declaration =>
214
return A_Protected_Type;
215
216
when A_Single_Protected_Declaration =>
217
return A_Protected_Object;
218
219
when A_Subtype_Declaration =>
220
return A_Subtype;
221
222
when An_Ordinary_Type_Declaration |
223
An_Incomplete_Type_Declaration |
224
A_Private_Type_Declaration |
225
A_Private_Extension_Declaration =>
226
return A_Type;
227
228
when A_Variable_Declaration =>
229
return A_Variable;
230
231
when A_Constant_Declaration |
232
An_Integer_Number_Declaration |
233
A_Real_Number_Declaration =>
234
return A_Constant;
235
236
when A_Deferred_Constant_Declaration =>
237
return A_Deferred_Constant;
238
239
when An_Object_Renaming_Declaration =>
240
return An_Object_Renaming;
241
242
when An_Exception_Renaming_Declaration =>
243
return An_Exception_Renaming;
244
245
when An_Exception_Declaration =>
246
return An_Exception;
247
248
when others =>
249
return Not_An_Item;
250
251
end case;
252
end Get_Item_Kind;
253
254
procedure Dump
255
(Self : access Printer'Class;
256
Line : in String)
257
is
258
259
Tmp : String (Line'First ..
260
Line'Last + AD.Syntax.Max_Keyword_Length + 1);
261
Last_Char : Character;
262
I : Positive;
263
Start : Natural;
264
Stop : Natural;
265
begin
266
-- 'Tmp' is a lower-case copy of 'Line' with extra padding characters at
267
-- the end. It serves to simplify 'Find_Keyword': it doesn't have to
268
-- worry about casing, and it can also ignore overflow problems.
269
for I in Line'Range loop
270
Tmp (I) := To_Lower (Line (I));
271
end loop;
272
for I in Line'Last + 1 .. Tmp'Last loop
273
Tmp (I) := ' ';
274
end loop;
275
Last_Char := ' ';
276
I := Line'First;
277
while I <= Line'Last loop
278
AD.Syntax.Find_Keyword
279
(Tmp (I .. Tmp'Last), Last_Char, Line'Last, Start, Stop);
280
if Start = 0 then
281
Write (Self, Line (I .. Line'Last));
282
return;
283
end if;
284
if Start > I then
285
Write (Self, Line (I .. Start - 1));
286
end if;
287
if Tmp (Start .. Stop) = "--" then
288
-- We have a comment!!
289
Write_Comment (Self, Line (Start .. Line'Last));
290
exit;
291
elsif Tmp (Start) = '"' or Tmp (Start) = ''' then
292
-- A string or character literal.
293
Write_Literal (Self, Line (Start .. Stop));
294
else
295
-- A real keyword. Write 'Tmp', not 'Line': this makes all
296
-- keywords lowercase for free!
297
Write_Keyword (Self, Tmp (Start .. Stop));
298
end if;
299
Last_Char := Tmp (Stop); I := Stop + 1;
300
end loop;
301
end Dump;
302
303
----------------------------------------------------------------------------
304
305
procedure Open_File
306
(Self : in out Real_Printer;
307
Mode : in AD.Options.File_Handling;
308
File_Name : in String;
309
Use_Default : in Boolean := True)
310
is
311
use type Ada.Text_IO.File_Access;
312
use type AD.Options.File_Handling;
313
314
procedure Open
315
(File : in out Ada.Text_IO.File_Type;
316
Name : in String)
317
is
318
procedure Open is
319
new Util.Files.Open_G
320
(Ada.Text_IO.File_Type, Ada.Text_IO.File_Mode,
321
Ada.Text_IO.Open, Ada.Text_IO.Create);
322
begin
323
if not AD.Options.Allow_Overwrite and then
324
AD.File_Ops.Exists (Name)
325
then
326
Ada.Exceptions.Raise_Exception
327
(Cannot_Overwrite'Identity,
328
"Mustn't write to file """ & Name & """.");
329
end if;
330
begin
331
Open (File, Ada.Text_IO.Out_File, Name);
332
exception
333
when others =>
334
Ada.Exceptions.Raise_Exception
335
(Open_Failed'Identity,
336
"Cannot write to file """ & Name & """.");
337
end;
338
end Open;
339
340
begin
341
if Self.F /= null then Close_File (Self); end if;
342
if Use_Default then
343
Try_Name :
344
declare
345
Name : constant String := AD.Options.Output_Name;
346
begin
347
if Name = "-" then
348
-- Output on stdout:
349
Self.F := Ada.Text_IO.Current_Output;
350
return;
351
end if;
352
if Name'Last >= Name'First and then
353
Mode = AD.Options.Single_File
354
then
355
-- Not stdout: first try 'Name', if that fails, try 'File_Name'
356
begin
357
Open (Self.File,
358
Util.Pathes.Replace_Extension
359
(Name, Get_Suffix (Real_Printer'Class (Self))));
360
exception
361
when E : others =>
362
if File_Name'Last >= File_Name'First then
363
AD.Messages.Warn
364
(Ada.Exceptions.Exception_Message (E));
365
else
366
raise;
367
end if;
368
end;
369
end if;
370
end Try_Name;
371
end if;
372
if not Ada.Text_IO.Is_Open (Self.File) then
373
-- Ok, it's not stdout, and either we have no name or we failed to
374
-- open file 'Name', or we're in multi-file mode: open a file
375
-- 'File_Name' in the specified directory.
376
if File_Name = "-" then
377
Self.F := Ada.Text_IO.Current_Output;
378
return;
379
end if;
380
if Util.Pathes.Path (File_Name) /= "" then
381
-- The given File_Name *does* have a path itself: use that!
382
Open
383
(Self.File,
384
Util.Pathes.Replace_Extension
385
(File_Name, Get_Suffix (Real_Printer'Class (Self))));
386
else
387
-- 'File_Name' is a simple file: prepend the default output
388
-- directory.
389
Open
390
(Self.File,
391
Util.Pathes.Concat
392
(AD.Options.Output_Directory,
393
Util.Pathes.Replace_Extension
394
(File_Name, Get_Suffix (Real_Printer'Class (Self)))));
395
end if;
396
end if;
397
-- Here, Self.File is open.
398
Self.F := Ada.Text_IO.File_Access'(Self.File'Unchecked_Access);
399
end Open_File;
400
401
function Is_Open
402
(Self : in Real_Printer)
403
return Boolean
404
is
405
use type Ada.Text_IO.File_Access;
406
begin
407
return Self.F /= null;
408
end Is_Open;
409
410
procedure Close_File
411
(Self : in out Real_Printer)
412
is
413
begin
414
if Ada.Text_IO.Is_Open (Self.File) then
415
Ada.Text_IO.Close (Self.File);
416
end if;
417
Self.F := null;
418
end Close_File;
419
420
procedure Put
421
(Self : access Real_Printer;
422
Ch : in Character)
423
is
424
begin
425
if Self.Use_Buffer then
426
Util.Text.Append (Self.Buffer, Ch);
427
else
428
Ada.Text_IO.Put (Self.F.all, Ch);
429
end if;
430
end Put;
431
432
procedure Put
433
(Self : access Real_Printer;
434
S : in String)
435
is
436
begin
437
if Self.Use_Buffer then
438
Util.Text.Append (Self.Buffer, S);
439
else
440
Ada.Text_IO.Put (Self.F.all, S);
441
end if;
442
end Put;
443
444
procedure Put_Line
445
(Self : access Real_Printer;
446
S : in String)
447
is
448
begin
449
Put_Line (Self.all, S);
450
end Put_Line;
451
452
procedure Put_Line
453
(Self : in out Real_Printer;
454
S : in String)
455
456
is
457
begin
458
if Self.Use_Buffer then
459
Util.Text.Append (Self.Buffer, S & ASCII.LF);
460
else
461
Ada.Text_IO.Put_Line (Self.F.all, S);
462
end if;
463
end Put_Line;
464
465
procedure New_Line
466
(Self : access Real_Printer;
467
N : in Positive := 1)
468
is
469
begin
470
if Self.Use_Buffer then
471
declare
472
Line_Feeds : constant String (1 .. N) := (others => ASCII.LF);
473
begin
474
Util.Text.Append (Self.Buffer, Line_Feeds);
475
end;
476
else
477
Ada.Text_IO.New_Line (Self.F.all, Ada.Text_IO.Positive_Count (N));
478
end if;
479
end New_Line;
480
481
procedure Finalize
482
(Self : in out Real_Printer)
483
is
484
begin
485
Close_File (Self);
486
exception
487
when others =>
488
null;
489
end Finalize;
490
491
----------------------------------------------------------------------------
492
493
function "+"
494
(Left, Right : in Printer_Ref)
495
return Printer_Ref
496
is
497
begin
498
if Left = null then
499
return Right;
500
elsif Right = null then
501
return Left;
502
else
503
declare
504
P : constant Printer_Ref := new Composer;
505
begin
506
Composer (P.all).Left := Left;
507
Composer (P.all).Right := Right;
508
return P;
509
end;
510
end if;
511
end "+";
512
513
----------------------------------------------------------------------------
514
515
function Is_Open
516
(Self : in Composer)
517
return Boolean
518
is
519
begin
520
return Is_Open (Self.Left.all) or else Is_Open (Self.Right.all);
521
end Is_Open;
522
523
procedure Finalize
524
(Self : in out Composer)
525
is
526
begin
527
if Self.Left /= null then
528
Free (Self.Left);
529
end if;
530
if Self.Right /= null then
531
Free (Self.Right);
532
end if;
533
-- A composer has no open files, so no need to close the output!
534
end Finalize;
535
536
procedure Open_Unit
537
(Self : access Composer;
538
Unit_Kind : in Item_Kind;
539
Unit_Name : in Wide_String;
540
Is_Private : in Boolean;
541
XRef : in AD.Crossrefs.Cross_Reference)
542
is
543
begin
544
Open_Unit (Self.Left, Unit_Kind, Unit_Name, Is_Private, XRef);
545
Self.Left_Open := Is_Open (Self.Left.all);
546
Open_Unit (Self.Right, Unit_Kind, Unit_Name, Is_Private, XRef);
547
Self.Right_Open := Is_Open (Self.Right.all);
548
end Open_Unit;
549
550
procedure Close_Unit
551
(Self : access Composer)
552
is
553
begin
554
if Self.Left_Open then
555
Close_Unit (Self.Left);
556
end if;
557
if Self.Right_Open then
558
Close_Unit (Self.Right);
559
end if;
560
end Close_Unit;
561
562
procedure Write_Comment
563
(Self : access Composer;
564
Lines : in Asis.Text.Line_List)
565
is
566
begin
567
if Self.Left_Open then
568
Write_Comment (Self.Left, Lines);
569
end if;
570
if Self.Right_Open then
571
Write_Comment (Self.Right, Lines);
572
end if;
573
end Write_Comment;
574
575
procedure Open_Section
576
(Self : access Composer;
577
Section : in Section_Type)
578
is
579
begin
580
if Self.Left_Open then
581
Open_Section (Self.Left, Section);
582
end if;
583
if Self.Right_Open then
584
Open_Section (Self.Right, Section);
585
end if;
586
end Open_Section;
587
588
procedure Close_Section
589
(Self : access Composer;
590
Section : in Section_Type)
591
is
592
begin
593
if Self.Left_Open then
594
Close_Section (Self.Left, Section);
595
end if;
596
if Self.Right_Open then
597
Close_Section (Self.Right, Section);
598
end if;
599
end Close_Section;
600
601
procedure Open_Item
602
(Self : access Composer;
603
XRef : in AD.Crossrefs.Cross_Reference;
604
Kind : in Item_Kind := Not_An_Item;
605
Name : in Wide_String := "")
606
is
607
begin
608
if Self.Left_Open then
609
Open_Item (Self.Left, XRef, Kind, Name);
610
end if;
611
if Self.Right_Open then
612
Open_Item (Self.Right, XRef, Kind, Name);
613
end if;
614
end Open_Item;
615
616
procedure Close_Item
617
(Self : access Composer;
618
Is_Last : in Boolean := False)
619
is
620
begin
621
if Self.Left_Open then
622
Close_Item (Self.Left, Is_Last);
623
end if;
624
if Self.Right_Open then
625
Close_Item (Self.Right, Is_Last);
626
end if;
627
end Close_Item;
628
629
procedure Other_Declaration
630
(Self : access Composer;
631
XRef : in AD.Crossrefs.Cross_Reference;
632
Text : in String)
633
is
634
begin
635
if Self.Left_Open then
636
Other_Declaration (Self.Left, XRef, Text);
637
end if;
638
if Self.Right_Open then
639
Other_Declaration (Self.Right, XRef, Text);
640
end if;
641
end Other_Declaration;
642
643
procedure Open_Container
644
(Self : access Composer;
645
XRef : in AD.Crossrefs.Cross_Reference;
646
Kind : in Item_Kind;
647
Name : in Wide_String := "")
648
is
649
begin
650
if Self.Left_Open then
651
Open_Container (Self.Left, XRef, Kind, Name);
652
end if;
653
if Self.Right_Open then
654
Open_Container (Self.Right, XRef, Kind, Name);
655
end if;
656
end Open_Container;
657
658
procedure Close_Container
659
(Self : access Composer;
660
Is_Last : in Boolean := False)
661
is
662
begin
663
if Self.Left_Open then
664
Close_Container (Self.Left, Is_Last);
665
end if;
666
if Self.Right_Open then
667
Close_Container (Self.Right, Is_Last);
668
end if;
669
end Close_Container;
670
671
procedure Add_Child
672
(Self : access Composer;
673
Kind : in Item_Kind;
674
Is_Private : in Boolean;
675
XRef : in AD.Crossrefs.Cross_Reference)
676
is
677
begin
678
if Self.Left_Open then
679
Add_Child (Self.Left, Kind, Is_Private, XRef);
680
end if;
681
if Self.Right_Open then
682
Add_Child (Self.Right, Kind, Is_Private, XRef);
683
end if;
684
end Add_Child;
685
686
procedure Add_Exception
687
(Self : access Composer;
688
XRef : in AD.Crossrefs.Cross_Reference)
689
is
690
begin
691
if Self.Left_Open then
692
Add_Exception (Self.Left, XRef);
693
end if;
694
if Self.Right_Open then
695
Add_Exception (Self.Right, XRef);
696
end if;
697
end Add_Exception;
698
699
procedure Type_Name
700
(Self : access Composer;
701
XRef : in AD.Crossrefs.Cross_Reference)
702
is
703
begin
704
if Self.Left_Open then
705
Type_Name (Self.Left, XRef);
706
end if;
707
if Self.Right_Open then
708
Type_Name (Self.Right, XRef);
709
end if;
710
end Type_Name;
711
712
procedure Type_Kind
713
(Self : access Composer;
714
Info : in String)
715
is
716
begin
717
if Self.Left_Open then
718
Type_Kind (Self.Left, Info);
719
end if;
720
if Self.Right_Open then
721
Type_Kind (Self.Right, Info);
722
end if;
723
end Type_Kind;
724
725
procedure Parent_Type
726
(Self : access Composer;
727
XRef : in AD.Crossrefs.Cross_Reference)
728
is
729
begin
730
if Self.Left_Open then
731
Parent_Type (Self.Left, XRef);
732
end if;
733
if Self.Right_Open then
734
Parent_Type (Self.Right, XRef);
735
end if;
736
end Parent_Type;
737
738
procedure Open_Operation_List
739
(Self : access Composer;
740
Kind : in Operation_Kind)
741
is
742
begin
743
if Self.Left_Open then
744
Open_Operation_List (Self.Left, Kind);
745
end if;
746
if Self.Right_Open then
747
Open_Operation_List (Self.Right, Kind);
748
end if;
749
end Open_Operation_List;
750
751
procedure Close_Operation_List
752
(Self : access Composer)
753
is
754
begin
755
if Self.Left_Open then
756
Close_Operation_List (Self.Left);
757
end if;
758
if Self.Right_Open then
759
Close_Operation_List (Self.Right);
760
end if;
761
end Close_Operation_List;
762
763
procedure Add_Type_Operation
764
(Self : access Composer;
765
XRef : in AD.Crossrefs.Cross_Reference)
766
is
767
begin
768
if Self.Left_Open then
769
Add_Type_Operation (Self.Left, XRef);
770
end if;
771
if Self.Right_Open then
772
Add_Type_Operation (Self.Right, XRef);
773
end if;
774
end Add_Type_Operation;
775
776
procedure Add_Private
777
(Self : access Composer;
778
For_Package : in Boolean)
779
is
780
begin
781
if Self.Left_Open then
782
Add_Private (Self.Left, For_Package);
783
end if;
784
if Self.Right_Open then
785
Add_Private (Self.Right, For_Package);
786
end if;
787
end Add_Private;
788
789
procedure Open_Anchor
790
(Self : access Composer;
791
XRef : in AD.Crossrefs.Cross_Reference)
792
is
793
begin
794
if Self.Left_Open then
795
Open_Anchor (Self.Left, XRef);
796
end if;
797
if Self.Right_Open then
798
Open_Anchor (Self.Right, XRef);
799
end if;
800
end Open_Anchor;
801
802
procedure Close_Anchor
803
(Self : access Composer)
804
is
805
begin
806
if Self.Left_Open then
807
Close_Anchor (Self.Left);
808
end if;
809
if Self.Right_Open then
810
Close_Anchor (Self.Right);
811
end if;
812
end Close_Anchor;
813
814
procedure Open_XRef
815
(Self : access Composer;
816
XRef : in AD.Crossrefs.Cross_Reference)
817
is
818
begin
819
if Self.Left_Open then
820
Open_XRef (Self.Left, XRef);
821
end if;
822
if Self.Right_Open then
823
Open_XRef (Self.Right, XRef);
824
end if;
825
end Open_XRef;
826
827
procedure Close_XRef
828
(Self : access Composer)
829
is
830
begin
831
if Self.Left_Open then
832
Close_XRef (Self.Left);
833
end if;
834
if Self.Right_Open then
835
Close_XRef (Self.Right);
836
end if;
837
end Close_XRef;
838
839
procedure Put_XRef
840
(Self : access Composer;
841
XRef : in AD.Crossrefs.Cross_Reference;
842
Code : in Boolean := True;
843
Is_Index : in Boolean := False)
844
is
845
begin
846
if Self.Left_Open then
847
Put_XRef (Self.Left, XRef, Code, Is_Index);
848
end if;
849
if Self.Right_Open then
850
Put_XRef (Self.Right, XRef, Code, Is_Index);
851
end if;
852
end Put_XRef;
853
854
procedure Inline_Error
855
(Self : access Composer;
856
Msg : in String)
857
is
858
begin
859
if Self.Left_Open then
860
Inline_Error (Self.Left, Msg);
861
end if;
862
if Self.Right_Open then
863
Inline_Error (Self.Right, Msg);
864
end if;
865
end Inline_Error;
866
867
----------------------------------------------------------------------------
868
-- Basic inline elements.
869
870
procedure Write_Keyword
871
(Self : access Composer;
872
S : in String)
873
is
874
begin
875
if Self.Left_Open then
876
Write_Keyword (Self.Left, S);
877
end if;
878
if Self.Right_Open then
879
Write_Keyword (Self.Right, S);
880
end if;
881
end Write_Keyword;
882
883
procedure Write_Literal
884
(Self : access Composer;
885
S : in String)
886
is
887
begin
888
if Self.Left_Open then
889
Write_Literal (Self.Left, S);
890
end if;
891
if Self.Right_Open then
892
Write_Literal (Self.Right, S);
893
end if;
894
end Write_Literal;
895
896
procedure Write_Attribute
897
(Self : access Composer;
898
S : in String)
899
is
900
begin
901
if Self.Left_Open then
902
Write_Attribute (Self.Left, S);
903
end if;
904
if Self.Right_Open then
905
Write_Attribute (Self.Right, S);
906
end if;
907
end Write_Attribute;
908
909
procedure Write_Comment
910
(Self : access Composer;
911
S : in String)
912
is
913
begin
914
if Self.Left_Open then
915
Write_Comment (Self.Left, S);
916
end if;
917
if Self.Right_Open then
918
Write_Comment (Self.Right, S);
919
end if;
920
end Write_Comment;
921
922
procedure Write
923
(Self : access Composer;
924
S : in String)
925
is
926
begin
927
if Self.Left_Open then
928
Write (Self.Left, S);
929
end if;
930
if Self.Right_Open then
931
Write (Self.Right, S);
932
end if;
933
end Write;
934
935
procedure Write_Plain
936
(Self : access Composer;
937
S : in String)
938
is
939
begin
940
if Self.Left_Open then
941
Write_Plain (Self.Left, S);
942
end if;
943
if Self.Right_Open then
944
Write_Plain (Self.Right, S);
945
end if;
946
end Write_Plain;
947
948
procedure Write_Code
949
(Self : access Composer;
950
S : in String)
951
is
952
begin
953
if Self.Left_Open then
954
Write_Code (Self.Left, S);
955
end if;
956
if Self.Right_Open then
957
Write_Code (Self.Right, S);
958
end if;
959
end Write_Code;
960
961
procedure New_Line
962
(Self : access Composer;
963
N : in Positive := 1)
964
is
965
begin
966
if Self.Left_Open then
967
New_Line (Self.Left, N);
968
end if;
969
if Self.Right_Open then
970
New_Line (Self.Right, N);
971
end if;
972
end New_Line;
973
974
procedure Open_Index
975
(Self : access Composer;
976
File_Name : in String;
977
Title : in String;
978
Present : in Ada.Strings.Maps.Character_Set)
979
is
980
begin
981
Open_Index (Self.Left, File_Name, Title, Present);
982
Self.Left_Open := Is_Open (Self.Left.all);
983
Open_Index (Self.Right, File_Name, Title, Present);
984
Self.Right_Open := Is_Open (Self.Right.all);
985
end Open_Index;
986
987
procedure Close_Index
988
(Self : access Composer)
989
is
990
begin
991
Close_Index (Self.Left);
992
Close_Index (Self.Right);
993
end Close_Index;
994
995
procedure XRef_Index
996
(Self : access Composer;
997
File_Name : in String;
998
Title : in String)
999
is
1000
begin
1001
if Self.Left_Open then
1002
XRef_Index (Self.Left, File_Name, Title);
1003
end if;
1004
if Self.Right_Open then
1005
XRef_Index (Self.Right, File_Name, Title);
1006
end if;
1007
end XRef_Index;
1008
1009
procedure Open_Char_Section
1010
(Self : access Composer;
1011
Char : in Character)
1012
is
1013
begin
1014
if Self.Left_Open then
1015
Open_Char_Section (Self.Left, Char);
1016
end if;
1017
if Self.Right_Open then
1018
Open_Char_Section (Self.Right, Char);
1019
end if;
1020
end Open_Char_Section;
1021
1022
procedure Close_Char_Section
1023
(Self : access Composer)
1024
is
1025
begin
1026
if Self.Left_Open then
1027
Close_Char_Section (Self.Left);
1028
end if;
1029
if Self.Right_Open then
1030
Close_Char_Section (Self.Right);
1031
end if;
1032
end Close_Char_Section;
1033
1034
procedure Open_Index_Structure
1035
(Self : access Composer)
1036
is
1037
begin
1038
if Self.Left_Open then
1039
Open_Index_Structure (Self.Left);
1040
end if;
1041
if Self.Right_Open then
1042
Open_Index_Structure (Self.Right);
1043
end if;
1044
end Open_Index_Structure;
1045
1046
procedure Close_Index_Structure
1047
(Self : access Composer)
1048
is
1049
begin
1050
if Self.Left_Open then
1051
Close_Index_Structure (Self.Left);
1052
end if;
1053
if Self.Right_Open then
1054
Close_Index_Structure (Self.Right);
1055
end if;
1056
end Close_Index_Structure;
1057
1058
procedure Open_Index_Item
1059
(Self : access Composer)
1060
is
1061
begin
1062
if Self.Left_Open then
1063
Open_Index_Item (Self.Left);
1064
end if;
1065
if Self.Right_Open then
1066
Open_Index_Item (Self.Right);
1067
end if;
1068
end Open_Index_Item;
1069
1070
procedure Close_Index_Item
1071
(Self : access Composer)
1072
is
1073
begin
1074
if Self.Left_Open then
1075
Close_Index_Item (Self.Left);
1076
end if;
1077
if Self.Right_Open then
1078
Close_Index_Item (Self.Right);
1079
end if;
1080
end Close_Index_Item;
1081
1082
end AD.Printers;
Loggerhead is a web-based interface for Breezy
Version: 2.0.1