This file is indexed.

/usr/share/ada/adainclude/texttools/controls.ads is in libtexttools5-dev 2.1.0-8.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below.

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
------------------------------------------------------------------------------
-- CONTROLS - Texttools control (widget) definitions                        --
--                                                                          --
-- Developed by Ken O. Burtch                                               --
------------------------------------------------------------------------------
--                                                                          --
--              Copyright (C) 1999-2007 PegaSoft Canada                     --
--                                                                          --
-- This is free software;  you can  redistribute it  and/or modify it under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 2,  or (at your option) any later ver- --
-- sion.  This is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
-- for  more details.  You should have  received  a copy of the GNU General --
-- Public License  distributed with this;  see file COPYING.  If not, write --
-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
-- MA 02111-1307, USA.                                                      --
--                                                                          --
-- As a special exception,  if other files  instantiate  generics from this --
-- unit, or you link  this unit with other files  to produce an executable, --
-- this  unit  does not  by itself cause  the resulting  executable  to  be --
-- covered  by the  GNU  General  Public  License.  This exception does not --
-- however invalidate  any other reasons why  the executable file  might be --
-- covered by the  GNU Public License.                                      --
--                                                                          --
-- This is maintained at http://www.pegasoft.ca/tt.html                     --
--                                                                          --
------------------------------------------------------------------------------

with common; use common;
  pragma Elaborate( common ); -- remind Ada that Common elaborates first
with strings; use strings;
with userio;  use userio;
with Ada.Finalization;
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;

package controls is

-- For Source Edit Lists

type aSourceLanguage is ( unknownLanguage, Ada_Language, C, CPP, Java, Bush,
    Perl, PHP, HTML, Shell );
pragma convention(C, aSourceLanguage);

--  LANGUAGE DATA
--
-- This record contains all the information for a language, such as lists
-- of keywords and functions as used by TIA.
--
-- The data is stored in linked lists sorted by language and alphabetic bins
--
-- Some of the data is compressed to save memory.
------------------------------------------------------------------------------

type stringPtr is access all string;

type packedStringPtr is access all packed_string;

type ACommentStyle is (None, AdaStyle, ShellStyle, CStyle, HTMLStyle, PHPStyle);
pragma convention( C, ACommentStyle );

subtype aBinIndex is character range '@'..'Z';

type functionData;
type functionDataPtr is access functionData;
type functionData is record
     functionName : stringPtr;
     functionInfo : packedStringPtr;
     functionProto: packedstringPtr;
     next         : functionDataPtr;
end record;
type functionArray is array( aBinIndex'range ) of functionDataptr;

type keywordData;
type keywordDataPtr is access keywordData;
type keywordData is record
     keywordName  : stringPtr;
     keywordInfo  : packedStringPtr;
     keywordProto : packedstringPtr;
       next         : keywordDataPtr;
end record;
type keywordArray is array( aBinIndex'range ) of keywordDataptr;

type languageDataRecord is record
     caseSensitive : boolean := false;
     commentStyle  : aCommentStyle;
     functionCount : natural := 0;
     functionBin   : functionArray;
     keywordCount  : natural := 0;
     keywordBin    : keywordArray;
end record;

type languageDataArray is array( aSourcelanguage'range ) of
     languageDataRecord;
type languageDataPtr is access all languageDataArray;

procedure init( languageData : in out languageDataArray );
function in_bin( s : string ) return aBinIndex;
function findFunctionData( languageData : languageDataArray; funcLang : aSourceLanguage; s : string ) return functionDataPtr;
function findKeywordData( languageData : languageDataArray; funcLang : aSourceLanguage; s : string ) return keywordDataPtr;

---> Housekeeping

procedure StartupControls;
procedure IdleControls( IdlePeriod : in Duration );
procedure ShutdownControls;

---> Window Control Definitions
--
-- A control is an object in a window that performs input/output.
-- RootControl is the elementary pseudo-control.  All controls
-- inherit a frame, internal cursor location, a hot key, and a status.
-- There is also a NeedsRedrawing flag which indicates if the control
-- dirty.
--
-- Controls must support the following subprograms:
-- 1. a Hear procedure which handles input and determines how
--    the dialog manager should respond (go to next control, etc.).
-- 2. a Draw procedure to draw the control.  (Draw should take into
--    account the NeedsRedrawing flag, need not save colour/styles.)
-- 3. an Init procedure to setup the frame, hot key (if any) and to
--    initialize any defaults. (the constructor)
-- 4. Encode/Decode to save control info to a file.
-- 5. SetStatus for activating the control, etc.
-- 6. a Clear procedure to shutdown the control (and deallocate any
--    memory). (the destructor)
--
-- All controls inherit:
-- 1. an Invalid procedure to force a control to be redrawn (usually
--    when obscured by an overlapping window).
-- 2. GetStatus to return the control's status.
-- 3. a NeedsRedrawing function to reutnr the NeedsRedrawing flag.
-- 4. Free, the unchecked deallocation procedure.
-- ...and a few others.  See RootControl below.
--
-- Dialog Actions:
--   None - Remain on this control
--   Next - Go to next control
--   Back - Go to control before this one
--   ScanNext - Forward to next control with key as hotkey
--          (the usual result for a key with no meaning for control)
--   Up    - move up to next control
--   Down  - move down to next control
--   Left  - move left to next control
--   Right - move right to next control
--   Complete - this control completes a dialog (simple buttons)
--   FollowLink - follow the link; open a new subwindow
--   Fix Family - turn off/redraw the radio button's family members

type ADialogAction is (None, Next, Back, ScanNext, Up, Down, Left, Right,
     Complete, FollowLink, FixFamily);
pragma convention( C, ADialogAction );

-- Control Status:
--   Off       - control will never be selected
--   Standby   - control not currently selected
--   On        - control selected and is accepting input

type AControlStatus is (Off, Standby, On);

---> Control Numbers
--
-- Maximum number of controls is AControlNumber'Last; 0 = no control #

type AControlNumber is new short_integer range 0..63;

---> Control Definitions
--
-- RootControl, the elementary pseudo-control
--
-- GetHotKey - return hot key for this control (or NullKey)
-- SetInfo - set info bar text for this control
-- GetInfo - return same
-- HasInfo - true if info bar text was assigned

type RootControl is abstract tagged private;
type AControlPtr is access all RootControl'class;

procedure Init( c : in out RootControl; left,top,right,bottom : integer;
          HotKey : character );
procedure Finalize( c : in out RootControl );
procedure Hear( c : in out RootControl; i : AnInputRecord; d : in out
          ADialogAction );
procedure Move( c : in out RootControl'class; dx, dy : integer );
procedure Resize( c : in out RootControl; dleft, dtop, dright, dbottom : integer);
procedure Draw( c : in out RootControl );
procedure SetStatus( c : in out RootControl; status : AControlStatus);
function  GetStatus( c : in RootControl'class ) return AControlStatus;
function  Encode( c : in RootControl ) return EncodedString;
procedure Decode( estr : in out EncodedString; c : in out RootControl );

procedure Invalid( c : in out RootControl'class );
function  NeedsRedrawing( c : RootControl'class ) return boolean;
          pragma Inline( NeedsRedrawing );
function  GetHotKey( c : in RootControl'class ) return character;
          pragma Inline( GetHotKey );
procedure SetInfo( c : in out RootControl'class; text : in string );
function  GetInfo( c : in RootControl'class ) return String;
function  HasInfo( c : in RootControl'class ) return boolean;
procedure GetStickyness( c : in RootControl'class; left, top, right, bottom
  : in out boolean );
procedure SetStickyness( c : in out RootControl'class; left, top, right, bottom
  : boolean );
function  InControl( c : in RootControl'class; x, y : integer ) return boolean;
function  GetFrame( c : in RootControl'class ) return ARect;
procedure Scrollable( c : in out RootControl'class; b : boolean );
function  CanScroll( c : in RootControl'class ) return boolean;
procedure Free( cp : in out AControlPtr );

---> General Classes
--
-- All controls fall into one of two classes:
--
-- Iconic Controls: controls that represent information or another
--                  (auto) window (if a link is provided)
--                  (eg. a picture, a static line)
--
-- Gnat 2.03 bug: Compiler overlaps link with first variable in
-- derived class, so links don't work!
--
-- Window Controls: controls that change the environment of the current
--                  window; controls whose value can be edited/changed
--                  (eg. a checkbox, an edit list )
--

Type ANullControl is new RootControl with private;

type AnIconicControl is new RootControl with private;
type AnIconicControlPtr is access all AnIconicControl'class;

procedure Init( c : in out AnIconicControl; left, top,
  right, bottom : integer; HotKey : character );
procedure Finalize( c : in out AnIconicControl );
procedure Draw( c : in out AnIconicControl );
-- Hear is inherited.
procedure SetStatus( c : in out AnIconicControl; status : AControlStatus );
procedure Resize( c : in out AnIconicControl; dleft, dtop, dright,
  dbottom : integer );
function Encode( c : in AnIconicControl ) return EncodedString;
procedure Decode( estr : in out EncodedString; c : in out AnIconicControl );

procedure SetLink( c : in out AnIconicControl'class; link : in String );
function  GetLink( c : in AnIconicControl'class ) return String;
procedure SetCloseBeforeFollow( c : in out AnIconicControl'class;
   close : boolean := true );
function  GetCloseBeforeFollow( c : in AnIconicControl'class ) return boolean;

type AWindowControl is new RootControl with private;
type AWindowControlPtr is access all AWindowControl'class;

procedure Init( c : in out AWindowControl; left, top,
  right, bottom : integer; HotKey : character );
procedure Finalize( c : in out AWindowControl );
procedure Draw( c : in out AWindowControl );
-- Hear is inherited.
procedure SetStatus( c : in out AWindowControl; status : AControlStatus );
procedure Resize( c : in out AWindowControl; dleft, dtop, dright, dbottom
   : integer );
function Encode( c : in AWindowControl ) return EncodedString;
procedure Decode( estr : in out EncodedString; c : in out AWindowControl );

---> Thermometers
--
-- SetMax - indicated the value associated with 100%
-- GetMax - return same
-- SetValue - set the thermometer value (0..Max)
-- GetValue - return same

type AThermometer is new AWindowControl with private;

procedure Init( c : in out AThermometer; left,top,right,bottom : integer;
                HotKey : character := NullKey );
procedure Finalize( c : in out AThermometer );
procedure Hear( c : in out AThermometer; i : AnInputRecord; d : in out ADialogAction);
procedure Draw( c : in out AThermometer );
procedure Resize( c : in out AThermometer; dleft, dtop, dright, dbottom :
  integer );
procedure SetStatus( c : in out AThermometer; status : AControlStatus);
function  Encode( c : in AThermometer ) return EncodedString;
procedure Decode( estr : in out EncodedString; c : in out AThermometer );

function  GetMax( c : in AThermometer ) return integer;
function  GetValue( c : in AThermometer ) return integer;
procedure SetMax( c : in out AThermometer; max : in integer );
procedure SetValue( c : in out AThermometer; value : in Integer );


---> Scroll Bars
--
-- SetMax   - set the value associated with the end of the bar
-- GetMax   - return same
-- SetThumb - set the position of the thumb (0...Max)
-- GetThumb - return same
-- SetOwner - indicate the list control associated with this bar
-- GetOwner - return same

type AScrollBar is new AWindowControl with private;

procedure Init( c : in out AScrollBar; left,top,right,bottom : integer;
                  HotKey : character := NullKey );
procedure Finalize( c : in out AScrollBar );
procedure Hear( c : in out AScrollBar; i:AnInputRecord; d : in out ADialogAction);
procedure Draw( c : in out AScrollBar );
procedure Resize( c : in out AScrollBar; dleft, dtop, dright, dbottom :
  integer );
procedure SetStatus( c : in out AScrollBar; status : AControlStatus);
function  Encode( c : in AScrollBar ) return EncodedString;
procedure Decode( estr : in out EncodedString ; c : in out AScrollBar );

function  GetMax( c : in AScrollBar ) return integer;
function  GetThumb( c : in AScrollBar ) return integer;
procedure SetMax( c : in out AScrollBar; max : in integer );
procedure SetThumb( c : in out AScrollBar; thumb : in integer );
procedure SetOwner( c : in out AScrollBar; owner : AControlNumber );
function  GetOwner( c : in AScrollBar ) return AControlNumber;


---> Static Lines
--
-- SetText - set the text of the line
-- GetText - return the text of the line
-- SetStyle - set the print text of the line
-- GetStyle - return the print text of the line

type AStaticLine is new AnIconicControl with private;
procedure Init( c : in out AStaticLine; left,top,right,bottom : integer;
                HotKey : character := NullKey );
procedure Finalize( c : in out AStaticLine );
procedure Hear( c : in out AStaticLine; i:AnInputRecord; d:in out ADialogAction );
procedure Draw( c : in out AStaticLine );
procedure Resize( c : in out AStaticLine; dleft, dtop, dright, dbottom :
  integer );
procedure SetStatus( c : in out AStaticLine; status : AControlStatus);
function  Encode( c : in AStaticLine ) return EncodedString;
procedure Decode( estr : in out EncodedString; c : in out AStaticLine );

function  GetText( c : in AStaticLine ) return String;
procedure SetText( c : in out AStaticLine; text : in string );
function  GetStyle( c : in AStaticLine ) return ATextStyle;
procedure SetStyle( c : in out AStaticLine; style : ATextStyle );
function  GetColour( c : in AStaticLine ) return APenColourName;
procedure SetColour( c : in out AStaticLine; colour : APenColourName );


---> Edit Lines, elementary edit line
--
-- SetText - set the text of the edit line
-- GetText - return the text of the edit line
-- SetAdvanceMode - enable/disable auto advance when line is full
-- GetAdvanceMode - return auto advance setting

type AnEditLine is new AWindowControl with private; -- should be a class
type SomeEditLine is access all AnEditLine'class;

procedure Finalize( c : in out AnEditLine'class );
procedure Init( c : in out AnEditLine; left,top,right,bottom : integer;
                Max : natural := 0; HotKey : character := NullKey );
procedure Hear( c : in out AnEditLine; i : AnInputRecord; d : in out ADialogAction );
procedure Draw( c : in out AnEditLine );
procedure Resize( c : in out AnEditLine'class; dleft, dtop, dright, dbottom :
  integer );
procedure SetStatus( c : in out AnEditLine; status : AControlStatus);
function  Encode( c : in AnEditLine ) return EncodedString;
procedure Decode( estr : in out EncodedString; c : in out AnEditLine );

function  GetText( c : in AnEditLine'class ) return String;
procedure SetText( c : in out AnEditLine'class; text : in String);
function  GetAdvanceMode( c : in AnEditLine'class ) return boolean;
procedure SetAdvanceMode( c : in out AnEditLine'class; mode : boolean );
function  GetBlindMode( c : in AnEditLine'class ) return boolean;
procedure SetBlindMode( c : in out AnEditLine'class; mode : boolean );
function  GetMaxLength( c : in AnEditLine'class ) return integer;
procedure SetMaxLength( c : in out AnEditLine'class; MaxLength : integer );

---> Integer Edit Lines
--

type AnIntegerEditLine is new AnEditLine with private;

procedure Init( c : in out AnIntegerEditLine; left,top,right,bottom : integer;
                Max : natural := 0; HotKey : character := NullKey );
procedure Hear( c : in out AnIntegerEditLine; i : AnInputRecord;
                d : in out ADialogAction );
procedure Draw( c : in out AnIntegerEditLine );
procedure SetStatus( c : in out AnIntegerEditLine; status : AControlStatus);
function  Encode( c : in AnIntegerEditLine ) return EncodedString;
procedure Decode( estr : in out EncodedString; c : in out AnIntegerEditLine );

procedure SetValue( c : in out AnIntegerEditLine; value : integer );
function  GetValue( c : in AnIntegerEditLine ) return integer;

---> Long Integer Edit Lines
--

type ALongIntEditLine is new AnEditLine with private;

procedure Init( c : in out ALongIntEditLine;
                left,top,right,bottom : integer; Max : natural := 0;
                HotKey : character := NullKey );
procedure Hear( c : in out ALongIntEditLine; i : AnInputRecord;
                d : in out ADialogAction );
procedure Draw( c : in out ALongIntEditLine );
procedure SetStatus( c : in out ALongIntEditLine; status : AControlStatus);
function  Encode( c : in ALongIntEditLine ) return EncodedString;
procedure Decode( estr : in out EncodedString; c : in out ALongIntEditLine );

procedure SetValue( c : in out ALongIntEditLine; value : in long_integer );
function  GetValue( c : in ALongIntEditLine ) return long_integer;

---> Float Edit Lines
--

type AFloatEditLine is new AnEditLine with private;

procedure Init( c : in out AFloatEditLine; left,top,right,bottom : integer;
                Max : natural := 0; HotKey : character := NullKey );
procedure Hear( c : in out AFloatEditLine; i : AnInputRecord;
                d : in out ADialogAction );
procedure Draw( c : in out AFloatEditLine );
procedure SetStatus( c : in out AFloatEditLine; status : AControlStatus);
--  function  Encode( c : in AFloatEditLine ) return EncodedString;
--  procedure Decode( estr : in out EncodedString; c : in out AFloatEditLine );

procedure SetValue( c : in out AFloatEditLine; value : float );
function  GetValue( c : in AFloatEditLine ) return float;

---> Check Boxes
--
-- SetText - set the button's message
-- GetText - return the button's message
-- SetCheck - check/uncheck the button
-- GetCheck - return the button's check

type ACheckBox is new AWindowControl with private;

procedure Init( c : in out ACheckBox; left,top,right,bottom : integer;
                HotKey : character := NullKey );
procedure Finalize( c : in out ACheckBox );
procedure Hear( c : in out ACheckBox; i : AnInputRecord; d : in out ADialogAction );
procedure Draw( c : in out ACheckBox );
procedure Resize( c : in out ACheckBox; dleft, dtop, dright, dbottom :
  integer );
procedure SetStatus( c : in out ACheckBox; status : AControlStatus);
function  Encode( c : in ACheckBox ) return EncodedString;
procedure Decode( estr : in out EncodedString; c : in out ACheckBox );

function  GetText( c : in ACheckBox ) return String;
function  GetCheck( c : in ACheckBox ) return boolean;
procedure SetText( c : in out ACheckBox; text : in String);
procedure SetCheck( c : in out ACheckBox; checked : boolean );


---> Radio Buttons
--
-- GetText - return the button's message
-- SetText - set the button's message
-- SetCheck - check/uncheck the radio button
-- GetCheck - return the button's check
-- GetFamily - the the family number of the radio button

type ARadioButton is new AWindowControl with private;

procedure Init( c : in out ARadioButton; left,top,right,bottom : integer;
                family : integer := 0; HotKey : character := NullKey );
procedure Finalize( c : in out ARadioButton );
procedure Hear( c : in out ARadioButton; i : AnInputRecord; d : in out ADialogAction );
procedure Draw( c : in out ARadioButton );
procedure Resize( c : in out ARadioButton; dleft, dtop, dright, dbottom :
  integer );
procedure SetStatus( c : in out ARadioButton; status : AControlStatus);
function  Encode( c : in ARadioButton ) return EncodedString;
procedure Decode( estr : in out EncodedString; c : in out ARadioButton );

function  GetText( c : in ARadioButton ) return String;
function  GetCheck( c : in ARadioButton ) return boolean;
function  GetFamily( c : in ARadioButton ) return integer;
procedure SetText( c : in out ARadioButton; text : in String );
procedure SetCheck( c : in out ARadioButton; checked : boolean );


---> Simple Buttons
--
-- SetText - set the button's message
-- GetText - return the button's message

type ASimpleButton is new AWindowControl with private;

procedure Init( c : in out ASimpleButton; left,top,right,bottom : integer;
                HotKey : character := NullKey );
procedure Finalize( c : in out ASimpleButton );
procedure Hear( c : in out ASimpleButton; i : AnInputRecord; d : in out ADialogAction );
procedure Draw( c : in out ASimpleButton );
procedure Resize( c : in out ASimpleButton; dleft, dtop, dright, dbottom :
  integer );
procedure SetStatus( c : in out ASimpleButton; status : AControlStatus);
function  Encode( c : in ASimpleButton ) return EncodedString;
procedure Decode( estr : in out EncodedString; c : in out ASimpleButton );

function  GetText( c : in ASimpleButton ) return String;
procedure SetText( c : in out ASimpleButton; text : in String );
function  GetInstant( c : in ASimpleButton ) return boolean;
procedure SetInstant( c : in out ASimpleButton; instant : boolean := true );
function  GetColour( c : in ASimpleButton ) return APenColourName;
procedure SetColour( c : in out ASimpleButton; colour : APenColourName );

---> Window Buttons
--
-- SetText - set the button's message
-- GetText - return the button's message
-- SetLink - set the path to the window associated with this button
-- GetLink - return the window path

type AWindowButton is new AnIconicControl with private;

procedure Init( c : in out AWindowButton; left, top, right, bottom : integer;
                HotKey : character := NullKey );
procedure Finalize( c : in out AWindowButton );
procedure Hear( c : in out AWindowButton; i : AnInputRecord; d : in out
                ADialogAction );
procedure Draw( c : in out AWindowButton );
procedure Resize( c : in out AWindowButton; dleft, dtop, dright, dbottom :
  integer );
procedure SetStatus( c : in out AWindowButton; status : AControlStatus);
function  Encode( c : in AWindowButton ) return EncodedString;
procedure Decode( estr : in out EncodedString; c : in out AWindowButton );

procedure SetText( c : in out AWindowButton; text : in String );
function  GetText( c : in AWindowButton ) return String;
function  GetInstant( c : in AWindowButton ) return boolean;
procedure SetInstant( c : in out AWindowButton; instant : boolean := true );
procedure SetControlHit( c : in out AWindowButton; chit : AControlNumber );
function  GetControlHit( c : in AWindowButton ) return AControlNumber;

---> Rectangles
--
-- SetColours - set the foreground and background colours
-- GetColours - return the foreground and background colours

type ARectangle is new AnIconicControl with private;

procedure Init( c : in out ARectangle; left,top,right,bottom : integer;
                HotKey : character := NullKey );
procedure Finalize( c : in out ARectangle );
procedure Hear( c : in out ARectangle; i : AnInputRecord; d : in out
              ADialogAction );
procedure Draw( c : in out ARectangle );
procedure Resize( c : in out ARectangle; dleft, dtop, dright, dbottom :
  integer );
procedure SetStatus( c : in out ARectangle; status : AControlStatus);
function  Encode( c : in ARectangle ) return EncodedString;
procedure Decode( estr : in out EncodedString; c : in out ARectangle );

procedure SetColours( c : in out ARectangle;
   FrameColour, BackColour : APenColourName );
procedure GetColours( c : in ARectangle;
   FrameColour, BackColour : in out APenColourName );
procedure SetText (C : in out ARectangle; Text : in String );
function  GetText (C : in ARectangle) return String;


---> Lines
--
-- SetColour - select the colour of the line
-- GetColour - return the colour of the line
-- SetDrawDir - DownRight => line is drawn from top-left to bottom-right
--    of the control frame, else bottom-left to top-right.
-- GetDrawDir - return the drawing direction

type ALine is new AnIconicControl with private;

procedure Init( c : in out ALine'class; left, top, right, bottom : integer;
                HotKey : character := NullKey );
procedure Finalize( c : in out ALine'class );
procedure Hear( c : in out ALine'class; i : AnInputRecord; d : in out ADialogAction);
procedure Draw( c : in out ALine );
procedure Resize( c : in out ALine'class; dleft, dtop, dright, dbottom : integer );
procedure SetStatus( c : in out ALine'class; status : AControlStatus);
function  Encode( c : in ALine'class ) return EncodedString;
procedure Decode( estr : in out EncodedString; c : in out ALine'class );

procedure SetColour( c : in out ALine'class; Colour : APenColourName );
function  GetColour( c : in ALine'class ) return APenColourName;
procedure SetDrawDir( c : in out ALine; DownRight : boolean );
function  GetDrawDir( c : in ALine ) return boolean;

-- Section Separators
--
-- On Graphics Displays, centered in drawing grid appropriately

type AnHorizontalSep is new ALine with private;
procedure Draw( c : in out AnHorizontalSep );

type AVerticalSep is new ALine with private;
procedure Draw( c : in out AVerticalSep );

---> Static Lists, the elementary static list
--
-- Is the list the belongs to the control a pointer to a list, or
-- a copy of a list supplied by the programmer?  A pointer makes it
-- handy to read the list, but offers no protection against failure
-- to inform the control to update.  I'll compromise here: SetList
-- COPIES and GetList returns a pointer.
--
-- that it can't be copied by assignment.
-- SetList - install the text to display in the box
-- SetOrigin - change top line being displayed
-- GetList - return the list of text
-- GetOrigin - return the origin
-- GetCurrent - return line the cursor is on
-- GetPosition - return the position on the line
-- SetCursor - move the cursor to a specific place
-- GetLength - return number of lines
-- JustifyText - format text to fit within specified width
-- WrapText - wrap long lines
-- SetScrollBar - set the scroll bar (or thermometer) to be associated
--   with this list control
-- GetScrollBar - return the associated scroll bar (or 0)

type AStaticList is new AWindowControl with private;
type SomeListControl is access all AStaticList'class;

procedure Init( c : in out AStaticList; left,top,right,bottom : integer;
                HotKey : character := NullKey );
procedure Finalize( c : in out AStaticList );
procedure Hear( c : in out AStaticList; i : AnInputRecord; d : in out ADialogAction);
procedure Draw( c : in out AStaticList );
procedure Resize( c : in out AStaticList'class; dleft, dtop, dright, dbottom : integer );
procedure SetStatus( c : in out AStaticList'class; status : AControlStatus);
function  Encode( c : in AStaticList'class ) return EncodedString;
procedure Decode( estr : in out EncodedString; c : in out AStaticList'class );

procedure SetList( c : in out AStaticList'class; list : in out StrList.Vector );
procedure SetOrigin( c : in out AStaticList'class; origin : Natural);
function  GetList( c : in AStaticList'class ) return StrList.Vector;
function  GetOrigin( c : in AStaticList'class ) return Natural;
function  GetCurrent( c : in AStaticList'class ) return Natural ;
function  GetLength( c : in AStaticList'class ) return Natural;
function  GetPositionY( c : in AStaticList'class ) return integer;
procedure JustifyText( c : in out AStaticList;
                       width : integer;
                       startingAt : Natural := 0 );
procedure WrapText( c : in out AStaticList );
procedure MoveCursor( c : in out AStaticList'class; dx : integer;
   dy : integer );
procedure SetScrollBar( c : in out AStaticList'class; bar : AControlNumber );
function  GetScrollBar( c : in AStaticList'class ) return AControlNumber;
function CopyLine (c : in AStaticList'Class) return String;
-- copy line at current position
procedure PasteLine( c : in out AStaticList'class; text : in string );
procedure ReplaceLine( c : in out AStaticList'class; text : in string );

procedure FindText( c : in out AStaticList'class; str2find : in String;
               Backwards, IsRegExp : boolean := false );
-- IsRegexp is actually ignored.
procedure ReplaceText( c : in out AStaticList'class; str2find,
   str2repl : in String; Backwards, IsRegExp : boolean := false );
-- IsRegExp is assumed false, since no regexp support is implemented.
procedure SetFindPhrase( c : in out AStaticList'class; phrase : in string );

procedure SetMark( c : in out AStaticList'class; mark : integer );
function  GetMark( c : in AStaticList'class ) return integer;
-- mark position.  Use -1 to denote no mark set.

procedure CopyLines( c : in out AStaticList'class; mark2 : integer;
  Lines : in out StrList.Vector );
-- copy lines between mark2 and mark set with SetMark
procedure PasteLines( c : in out AStaticList'class; Lines :
   in out StrList.Vector );

---> Check Lists
--
-- SetChecks - install list of check boxes
-- GetChecks - return pointer to list of checks

type ACheckList is new AStaticList with private;

procedure Init( c : in out ACheckList; left,top,right,bottom : integer;
                HotKey : character := NullKey );
procedure Finalize( c : in out ACheckList );
procedure Hear( c : in out ACheckList; i : AnInputRecord; d : in out ADialogAction);
procedure Draw( c : in out ACheckList );

procedure SetChecks( c : in out ACheckList; checks : in out BooleanList.Vector );
function  GetChecks( c : in ACheckList ) return BooleanList.Vector;


---> Radio Lists
--
-- SetChecks - install list of radio button checks + first to check
-- GetChecks - return a pointer to the list of checks
-- GetCheck  - return the number of the item checked

type ARadioList is new AStaticList with private;

procedure Init( c : in out ARadioList; left,top,right,bottom : integer;
                HotKey : character := NullKey );
procedure Finalize( c : in out ARadioList );
procedure Hear( c : in out ARadioList; i : AnInputRecord; d : in out ADialogAction);
procedure Draw( c : in out ARadioList );

procedure SetChecks( c : in out ARadioList; checks : in out BooleanList.Vector;
          Default : Natural := 1 );
function  GetChecks( c : in ARadioList ) return BooleanList.Vector;
function  GetCheck( c : in ARadioList ) return Natural;


---> Edit Lists
--
-- GetPosition - get horizontal position of cursor (left side = 1)
-- SetCursor - move the cursor to a specific position in the text

type AnEditList is new AStaticList with private;
procedure Init( c : in out AnEditList; left,top,right,bottom : integer;
                HotKey : character := NullKey );
procedure Finalize( c : in out AnEditList );
procedure Hear( c : in out AnEditList; i : AnInputRecord;
   d : in out ADialogAction);
procedure Draw( c : in out AnEditList );

function  GetPosition( c : in AnEditList'class ) return integer;
procedure SetCursor( c : in out AnEditList'class; x : integer;
                     y : Natural);

procedure JustifyText( c : in out AnEditList;
                       width : integer;
                       startingAt : Natural := 0 );
procedure Touch( c : in out AnEditList'class );
-- set touch flag to true
procedure ClearTouch( c : in out AnEditList'class );
-- set touch flag to false
function  WasTouched( c : AnEditList'class ) return boolean;
-- true if Touch or received input.  Used for saving

---> SOURCE EDIT LIST
--
-- For displaying source code with hilighted keywords.  Provided for TIA.

type ASourceEditList is new AnEditList with private;

procedure Init( c : in out ASourceEditList; left,top,right,bottom : integer;
                HotKey : character := NullKey );
procedure Finalize( c : in out ASourceEditList );
procedure Hear( c : in out ASourceEditList; i : AnInputRecord;
   d : in out ADialogAction);
procedure Draw( c : in out ASourceEditList );

procedure JustifyText( c : in out ASourceEditList;
                       width : integer;
                       startingAt : Natural := 0 );

procedure SetHTMLTagsStyle( c : in out ASourceEditList; hilight : boolean );
-- choose to hilight html tags or not
procedure SetLanguageData( c : in out ASourceEditList; p : languageDataPtr );
procedure SetKeywordHilight( c : in out ASourceEditList; pcn : aPenColourName );
procedure SetFunctionHilight( c : in out ASourceEditList; pcn : aPenColourName );
procedure SetSourceLanguage( c : in out ASourceEditList; l : ASourceLanguage );

----> UNFINISHED CONTROLS

type AnHTMLBox is new AStaticList with private;

---> Pictures
--
-- Bit-mapped pictures.  They can double as traditional icons using the
-- text description as the icon caption.  APicture is a collection of
-- simple pictures optimized at different resolutions.

type ASimplePicture is new AnIconicControl with private;

type APicture is new ASimplePicture with private;

---> Scalable pictures
--
-- Traditional "draw" object composed of scalable geometric objects, like
-- lines, circles, rectangles, etc.

type ASketch is new AnIconicControl with private;

---> Animations
--
-- A collection of objects to be displayed through a sequence of states.
-- The objects can't be edited, hence an animation is iconic.

type AnAnimation is new AnIconicControl with private;

type ATreeList is new AStaticList with private; --dummy

PRIVATE

type RootControl is new Ada.Finalization.Controlled with record
     Frame       : ARect;          -- frame surrounding control
     Status      : AControlStatus; -- Off / Standby / On
     Name        : unbounded_string;   -- name of the control
     StickLeft   : boolean;    -- frame.left should adhere to window's left
     StickTop    : boolean;    -- frame.top  should adhere to window's top
     StickRight  : boolean;    -- frame.right should adhere to w's right
     StickBottom : boolean;    -- frame.top should adhere to w's bottom
     CursorX     : integer;    -- cursor location
     CursorY     : integer;
     Scrollable  : boolean;    -- true if ScrollWindow should ignore
     NeedsRedrawing : boolean; -- true if needs redrawing
     HotKey      : character;  -- key to jump to this item (else NullKey)
     HasInfo     : boolean;    -- true if text is valid for info bar
     InfoText    : Unbounded_String;     -- string to show in info bar if hilighted
end record;

type ANullControl is new RootControl with null record;

type AnIconicControl is new RootControl with record
     link              : Unbounded_String;  -- link to another system-controlled window
     CloseBeforeFollow : boolean; -- close before following link
end record;

type AWindowControl is new RootControl with null record;

type AThermometer is new AWindowControl with record
     Max   : integer;   -- ranges 0..max
     Value : integer; -- current value
end record;

type AScrollBar is new AWindowControl with record
     Max   : integer;   -- ranges 0..Max
     thumb : integer;   -- current position
     Owner : AControlNumber; -- related control (for window manager)
     -- optimizations for text screen
     DirtyThumb : boolean;   -- true if only thumb needs redrawing
     OldThumb   : integer;   -- old drawing position for thumb
end record;

type AStaticLine is new AnIconicControl with record
     Text   : Unbounded_String;      -- text in the static line
     Style  : ATextStyle;  -- the style of text (default normal)
     Colour : APenColourName;  -- colour of text
end record;

type AnEditLine is new AWindowControl with record -- should be a class
     Text : Unbounded_String;         -- text in the edit line
     Max  : natural;        -- maximum number of characters (not impl. yet)
     Origin : natural;      -- offset for display if text is wider than box
     AdvanceMode : boolean; -- auto-advance with last character?
     BlindMode : boolean;   -- true for blind text (eg. password entry)
     MaxLength : integer;   -- maximum number of characters
     -- optimzations for text screen
     DirtyText   : boolean; -- if only text right of cursor needs drawing
end record;

type AnIntegerEditLine is new AnEditLine with record
     value : integer;
end record;

type ALongIntEditLine is new AnEditLine with record
     value : long_integer;
end record;

type AFloatEditLine is new AnEditLine with record
     value : float;
end record;

type ACheckBox is new AWindowControl with record
     Text : Unbounded_String;     -- message of the button
     Checked : boolean; -- true if button's checked
     HotPos : natural;
end record;

type ARadioButton is new AWindowControl with record
     Text : Unbounded_String;     -- title
     Checked : boolean; -- true if button is "on"
     Family  : integer; -- a number to associate families
     HotPos  : natural;
end record;

type ASimpleButton is new AWindowControl with record
     Text   : Unbounded_String;  -- message of the button
     Instant: boolean; -- true if an instant selection on ScanNext
     HotPos : natural; -- position of hot key character
     Colour : APenColourName;
end record;

type AWindowButton is new AnIconicControl with record
     Text   : Unbounded_String;  -- message of the button
     Instant: boolean; -- true if an instant selection on ScanNext
     HotPos : natural; -- position of hot key character
     chit : AControlNumber; -- what was hit
end record;

type ARectangle is new AnIconicControl with record
     FrameColour : APenColourName; -- colour of the frame
     BackColour  : APenColourName; -- colour of the background
     Text        : unbounded_string;
end record;

type ALine is new AnIconicControl with record
     Colour     : APenColourName; -- colour of the line
     DownRight  : boolean;    -- true if line goes from top-left to b-r
end record;

type AnHorizontalSep is new ALine with null record;

type AVerticalSep is new ALine with null record;

type AStaticList is new AWindowControl with record
     List       : aliased StrList.Vector;  -- list of text
     Origin     : Natural;    -- line # at top of box
     ScrollBar  : AControlNumber;           -- reference value for window manager
     Mark       : integer;             -- as set by set mark
     FindPhrase : Unbounded_String := Null_Unbounded_String;     -- for hilighting purposes
end record;

type ACheckList is new AStaticList with record
     Checks : BooleanList.Vector;             -- list of selections (if any)
end record;

type ARadioList is new AStaticList with record
     Checks : BooleanList.Vector;             -- list of selections (if any)
     LastCheck : integer;              -- last selection (else 0)
end record;

type AnEditList is new AStaticList with record
     DirtyLine : boolean;                   -- if current line is dirty
     Touched   : boolean := false;          -- true if received input
     ForwardCharSearchMode : boolean := false; -- true if in mode
end record;

type ASourceEditList is new AnEditList with record
     KeywordList  : StrList.Vector;
     HTMLTagStyle : boolean := false;       -- true if hilighted
     InsertedLines : integer;          -- active insert block
     InsertedFirst : Natural; -- start of active insert block
                                            -- (if insertedLines /= 0)
     sourceLanguage : aSourceLanguage := unknownLanguage;
     keywordHilight : aPenColourName := yellow;
     functionHilight : aPenColourName := purple;
     languageData : languageDataPtr := null;
end record;

----> UNFINISHED CONTROLS

type AnHTMLBox is new AStaticList with record
   null;
end record;

type ASimplePicture is new AnIconicControl with record
     pic  : APictureID; -- ID of the picture
     path : unbounded_string;     -- path of the picture
     text : unbounded_string;     -- description (if can't be displayed)
end record;

type APicture is new ASimplePicture with record
     null; -- to be defined
end record;

type ASketch is new AnIconicControl with record
     null;
end Record;

type AnAnimation is new AnIconicControl with record
     X, Y : integer;             -- actually, redundant with control pos'n
     XVector, YVector : integer; -- motion offset information
     Enabled : boolean;          -- actually, redundant with status
     Visible : boolean;          -- actually, redundant with status
     Index : short_integer;      -- frame index
     AniStatus : short_integer;  -- grammer status
     --Stack  : AnAnimationStack;  -- the animation grammar
end record;

type ATreeList is new AStaticList with null record; --dummy

end controls;