* lisp/progmodes/pascal.el: Declare `ind' as dyn-bound.

Fixes: debbugs:10264

1 files changed, 1088 insertions, 0 deletions

diff --git a/test/indent/pascal.pas b/test/indent/pascal.pas
new file mode 100644
index 00000000000..07a21f23c3c
--- /dev/null
+++ b/test/indent/pascal.pas
@@ -0,0 +1,1088 @@
+{ GPC demo program for the CRT unit.
+
+Copyright (C) 1999-2006 Free Software Foundation, Inc.
+
+Author: Frank Heckenbach <frank@pascal.gnu.de>
+
+This program is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public License as
+published by the Free Software Foundation, version 2.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT 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
+along with this program; see the file COPYING. If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.
+
+As a special exception, if you incorporate even large parts of the
+code of this demo program into another program with substantially
+different functionality, this does not cause the other program to
+be covered by the GNU General Public License. This exception does
+not however invalidate any other reasons why it might be covered
+by the GNU General Public License. }
+
+{$gnu-pascal,I+}
+
+program CRTDemo;
+
+uses GPC, CRT;
+
+type
+   TFrameChars = array [1 .. 8] of Char;
+   TSimulateBlockCursorKind = (bc_None, bc_Blink, bc_Static);
+
+const
+   SingleFrame: TFrameChars = (chCornerTLS, chLineHS, chCornerTRS, chLineVS, chLineVS, chCornerBLS, chLineHS, chCornerBRS);
+   DoubleFrame: TFrameChars = (chCornerTLD, chLineHD, chCornerTRD, chLineVD, chLineVD, chCornerBLD, chLineHD, chCornerBRD);
+
+var
+   ScrollState: Boolean = True;
+   SimulateBlockCursorKind: TSimulateBlockCursorKind = bc_None;
+   CursorShape: TCursorShape = CursorNormal;
+   MainPanel: TPanel;
+   OrigScreenSize: TPoint;
+
+procedure FrameWin (const Title: String; const Frame: TFrameChars; TitleInverse: Boolean);
+var
+   w, h, y, Color: Integer;
+   Attr: TTextAttr;
+begin
+   HideCursor;
+   SetPCCharSet (True);
+   ClrScr;
+   w := GetXMax;
+   h := GetYMax;
+   WriteCharAt (1, 1, 1,     Frame[1], TextAttr);
+   WriteCharAt (2, 1, w - 2, Frame[2], TextAttr);
+   WriteCharAt (w, 1, 1,     Frame[3], TextAttr);
+   for y := 2 to h - 1 do
+   begin
+      WriteCharAt (1, y, 1, Frame[4], TextAttr);
+      WriteCharAt (w, y, 1, Frame[5], TextAttr)
+   end;
+   WriteCharAt (1, h, 1,     Frame[6], TextAttr);
+   WriteCharAt (2, h, w - 2, Frame[7], TextAttr);
+   WriteCharAt (w, h, 1,     Frame[8], TextAttr);
+   SetPCCharSet (False);
+   Attr := TextAttr;
+   if TitleInverse then
+   begin
+      Color := GetTextColor;
+      TextColor (GetTextBackground);
+      TextBackground (Color)
+   end;
+   WriteStrAt ((w - Length (Title)) div 2 + 1, 1, Title, TextAttr);
+   TextAttr := Attr
+end;
+
+function GetKey (TimeOut: Integer) = Key: TKey; forward;
+
+procedure ClosePopUpWindow;
+begin
+   PanelDelete (GetActivePanel);
+   PanelDelete (GetActivePanel)
+end;
+
+function PopUpConfirm (XSize, YSize: Integer; const Msg: String): Boolean;
+var
+   ax, ay: Integer;
+   Key: TKey;
+   SSize: TPoint;
+begin
+   repeat
+      SSize := ScreenSize;
+      ax := (SSize.x - XSize - 4) div 2 + 1;
+      ay := (SSize.y - YSize - 4) div 2 + 1;
+      PanelNew (ax, ay, ax + XSize + 3, ay + YSize + 1, False);
+      TextBackground (Black);
+      TextColor (Yellow);
+      SetControlChars (True);
+      FrameWin ('', DoubleFrame, False);
+      NormalCursor;
+      PanelNew (ax + 2, ay + 1, ax + XSize + 2, ay + YSize, False);
+      ClrScr;
+      Write (Msg);
+      Key := GetKey (-1);
+      if Key = kbScreenSizeChanged then ClosePopUpWindow
+      until Key <> kbScreenSizeChanged;
+   PopUpConfirm := not (Key in [kbEsc, kbAltEsc])
+end;
+
+procedure MainDraw;
+begin
+   WriteLn ('3, F3 : Open a window');
+   WriteLn ('4, F4 : Close window');
+   WriteLn ('5, F5 : Previous window');
+   WriteLn ('6, F6 : Next window');
+   WriteLn ('7, F7 : Move window');
+   WriteLn ('8, F8 : Resize window');
+   Write   ('q, Esc: Quit')
+end;
+
+procedure StatusDraw;
+const
+   YesNo: array [Boolean] of String [3] = ('No', 'Yes');
+   SimulateBlockCursorIDs: array [TSimulateBlockCursorKind] of String [8] = ('Off', 'Blinking', 'Static');
+   CursorShapeIDs: array [TCursorShape] of String [7] = ('Ignored', 'Hidden', 'Normal', 'Fat', 'Block');
+var
+   SSize: TPoint;
+begin
+   WriteLn ('You can change some of the following');
+   WriteLn ('settings  by pressing the key  shown');
+   WriteLn ('in parentheses. Naturally, color and');
+   WriteLn ('changing the cursor  shape or screen');
+   WriteLn ('size does not work on all terminals.');
+   WriteLn;
+   WriteLn ('XCurses version:          ', YesNo[XCRT]);
+   WriteLn ('CRTSavePreviousScreen:    ', YesNo[CRTSavePreviousScreenWorks]);
+   WriteLn ('(M)onochrome:             ', YesNo[IsMonochrome]);
+   SSize := ScreenSize;
+   WriteLn ('Screen (C)olumns:         ', SSize.x);
+   WriteLn ('Screen (L)ines:           ', SSize.y);
+   WriteLn ('(R)estore screen size');
+   WriteLn ('(B)reak checking:         ', YesNo[CheckBreak]);
+   WriteLn ('(S)crolling:              ', YesNo[ScrollState]);
+   WriteLn ('S(i)mulated block cursor: ', SimulateBlockCursorIDs[SimulateBlockCursorKind]);
+   Write   ('C(u)rsor shape:           ', CursorShapeIDs[CursorShape]);
+   GotoXY (36, WhereY)
+end;
+
+procedure RedrawAll; forward;
+procedure CheckScreenSize; forward;
+
+procedure StatusKey (Key: TKey);
+var SSize, NewSize: TPoint;
+begin
+   case LoCase (Key2Char (Key)) of
+     'm': begin
+        SetMonochrome (not IsMonochrome);
+        RedrawAll
+     end;
+     'c': begin
+        SSize := ScreenSize;
+        if SSize.x > 40 then
+           NewSize.x := 40
+        else
+           NewSize.x := 80;
+        if SSize.y > 25 then
+           NewSize.y := 50
+        else
+           NewSize.y := 25;
+        SetScreenSize (NewSize.x, NewSize.y);
+        CheckScreenSize
+     end;
+     'l': begin
+        SSize := ScreenSize;
+        if SSize.x > 40 then
+           NewSize.x := 80
+        else
+           NewSize.x := 40;
+        if SSize.y > 25 then
+           NewSize.y := 25
+        else
+           NewSize.y := 50;
+        SetScreenSize (NewSize.x, NewSize.y);
+        CheckScreenSize
+     end;
+     'r': begin
+        SetScreenSize (OrigScreenSize.x, OrigScreenSize.y);
+        CheckScreenSize
+     end;
+     'b': CheckBreak := not CheckBreak;
+     's': ScrollState := not ScrollState;
+     'i': if SimulateBlockCursorKind = High (SimulateBlockCursorKind) then
+        SimulateBlockCursorKind := Low (SimulateBlockCursorKind)
+     else
+        Inc (SimulateBlockCursorKind);
+     'u': case CursorShape of
+       CursorNormal: CursorShape := CursorBlock;
+       CursorFat,
+       CursorBlock : CursorShape := CursorHidden;
+     else          CursorShape := CursorNormal
+     end;
+   end;
+   ClrScr;
+   StatusDraw
+end;
+
+procedure TextAttrDemo;
+var f, b, y, x1, y1, x2, y2, Fill, n1, n2, n3: Integer;
+begin
+   GetWindow (x1, y1, x2, y2);
+   Window (x1 - 1, y1, x2, y2);
+   TextColor (White);
+   TextBackground (Blue);
+   ClrScr;
+   SetScroll (False);
+   Fill := GetXMax - 32;
+   for y := 1 to GetYMax do
+   begin
+      GotoXY (1, y);
+      b := (y - 1) mod 16;
+      n1 := 0;
+      for f := 0 to 15 do
+      begin
+         TextAttr := f + 16 * b;
+         n2 := (Fill * (1 + 2 * f) + 16) div 32;
+         n3 := (Fill * (2 + 2 * f) + 16) div 32;
+         Write ('' : n2 - n1, NumericBaseDigitsUpper[b], NumericBaseDigitsUpper[f], '' : n3 - n2);
+         n1 := n3
+      end
+   end
+end;
+
+procedure CharSetDemo (UsePCCharSet: Boolean);
+var h, l, y, x1, y1, x2, y2, Fill, n1, n2: Integer;
+begin
+   GetWindow (x1, y1, x2, y2);
+   Window (x1 - 1, y1, x2, y2);
+   ClrScr;
+   SetScroll (False);
+   SetPCCharSet (UsePCCharSet);
+   SetControlChars (False);
+   Fill := GetXMax - 35;
+   for y := 1 to GetYMax do
+   begin
+      GotoXY (1, y);
+      h := (y - 2) mod 16;
+      n1 := (Fill + 9) div 18;
+      if y = 1 then
+         Write ('' : 3 + n1)
+      else
+         Write (16 * h : 3 + n1);
+      for l := 0 to 15 do
+      begin
+         n2 := (Fill * (2 + l) + 9) div 18;
+         if y = 1 then
+            Write ('' : n2 - n1, l : 2)
+         else
+            Write ('' : n2 - n1 + 1, Chr (16 * h + l));
+         n1 := n2
+      end
+   end
+end;
+
+procedure NormalCharSetDemo;
+begin
+   CharSetDemo (False)
+end;
+
+procedure PCCharSetDemo;
+begin
+   CharSetDemo (True)
+end;
+
+procedure FKeyDemoDraw;
+var x1, y1, x2, y2: Integer;
+begin
+   GetWindow (x1, y1, x2, y2);
+   Window (x1, y1, x2 - 1, y2);
+   ClrScr;
+   SetScroll (False);
+   WriteLn ('You can type the following keys');
+   WriteLn ('(function keys if present on the');
+   WriteLn ('terminal, letters as alternatives):');
+   GotoXY (1, 4);
+   WriteLn ('S, Left     : left (wrap-around)');
+   WriteLn ('D, Right    : right (wrap-around)');
+   WriteLn ('E, Up       : up (wrap-around)');
+   WriteLn ('X, Down     : down (wrap-around)');
+   WriteLn ('A, Home     : go to first column');
+   WriteLn ('F, End      : go to last column');
+   WriteLn ('R, Page Up  : go to first line');
+   WriteLn ('C, Page Down: go to last line');
+   WriteLn ('Y, Ctrl-PgUp: first column and line');
+   GotoXY (1, 13);
+   WriteLn ('B, Ctrl-PgDn: last column and line');
+   WriteLn ('Z, Ctrl-Home: clear screen');
+   WriteLn ('N, Ctrl-End : clear to end of line');
+   WriteLn ('V, Insert   : insert a line');
+   WriteLn ('T, Delete   : delete a line');
+   WriteLn ('#           : beep');
+   WriteLn ('*           : flash');
+   WriteLn ('Tab, Enter, Backspace, other');
+   WriteLn ('  normal characters: write text')
+end;
+
+procedure FKeyDemoKey (Key: TKey);
+const TabSize = 8;
+var
+   ch: Char;
+   NewX: Integer;
+begin
+   case LoCaseKey (Key) of
+     Ord ('s'), kbLeft    : if WhereX = 1 then GotoXY (GetXMax, WhereY) else GotoXY (WhereX - 1, WhereY);
+     Ord ('d'), kbRight   : if WhereX = GetXMax then GotoXY (1, WhereY) else GotoXY (WhereX + 1, WhereY);
+     Ord ('e'), kbUp      : if WhereY = 1 then GotoXY (WhereX, GetYMax) else GotoXY (WhereX, WhereY - 1);
+     Ord ('x'), kbDown    : if WhereY = GetYMax then GotoXY (WhereX, 1) else GotoXY (WhereX, WhereY + 1);
+     Ord ('a'), kbHome    : Write (chCR);
+     Ord ('f'), kbEnd     : GotoXY (GetXMax, WhereY);
+     Ord ('r'), kbPgUp    : GotoXY (WhereX, 1);
+     Ord ('c'), kbPgDn    : GotoXY (WhereX, GetYMax);
+     Ord ('y'), kbCtrlPgUp: GotoXY (1, 1);
+     Ord ('b'), kbCtrlPgDn: GotoXY (GetXMax, GetYMax);
+     Ord ('z'), kbCtrlHome: ClrScr;
+     Ord ('n'), kbCtrlEnd : ClrEOL;
+     Ord ('v'), kbIns     : InsLine;
+     Ord ('t'), kbDel     : DelLine;
+     Ord ('#')            : Beep;
+     Ord ('*')            : Flash;
+     kbTab                : begin
+                               NewX := ((WhereX - 1) div TabSize + 1) * TabSize + 1;
+                               if NewX <= GetXMax then GotoXY (NewX, WhereY) else WriteLn
+                            end;
+     kbCR                 : WriteLn;
+     kbBkSp               : Write (chBkSp, ' ', chBkSp);
+   else                   ch := Key2Char (Key);
+     if ch <> #0 then Write (ch)
+   end
+end;
+
+procedure KeyDemoDraw;
+begin
+   WriteLn ('Press some keys ...')
+end;
+
+procedure KeyDemoKey (Key: TKey);
+var ch: Char;
+begin
+   ch := Key2Char (Key);
+   if ch <> #0 then
+   begin
+      Write ('Normal key');
+      if IsPrintable (ch) then Write (' `', ch, '''');
+      WriteLn (', ASCII #', Ord (ch))
+   end
+   else
+      WriteLn ('Special key ', Ord (Key2Scan (Key)))
+end;
+
+procedure IOSelectPeriodical;
+var
+   CurrentTime: TimeStamp;
+   s: String (8);
+   i: Integer;
+begin
+   GetTimeStamp (CurrentTime);
+   with CurrentTime do
+      WriteStr (s, Hour : 2, ':', Minute : 2, ':', Second : 2);
+   for i := 1 to Length (s) do
+      if s[i] = ' ' then s[i] := '0';
+   GotoXY (1, 12);
+   Write ('The time is: ', s)
+end;
+
+procedure IOSelectDraw;
+begin
+   WriteLn ('IOSelect is a way to handle I/O from');
+   WriteLn ('or to several places simultaneously,');
+   WriteLn ('without  having  to use  threads  or');
+   WriteLn ('signal/interrupt  handlers  or waste');
+   WriteLn ('CPU time with busy waiting.');
+   WriteLn;
+   WriteLn ('This demo  shows how  IOSelect works');
+   WriteLn ('in connection with CRT.  It displays');
+   WriteLn ('a clock,  but still  reacts  to user');
+   WriteLn ('input immediately.');
+   IOSelectPeriodical
+end;
+
+procedure ModifierPeriodical;
+const
+   Pressed: array [Boolean] of String [8] = ('Released', 'Pressed');
+   ModifierNames: array [1 .. 7] of record
+                     Modifier: Integer;
+                     Name: String (17)
+                  end =
+   ((shLeftShift,  'Left Shift'),
+    (shRightShift, 'Right Shift'),
+    (shLeftCtrl,   'Left Control'),
+    (shRightCtrl,  'Right Control'),
+    (shAlt,        'Alt (left)'),
+    (shAltGr,      'AltGr (right Alt)'),
+    (shExtra,      'Extra'));
+var
+   ShiftState, i: Integer;
+begin
+   ShiftState := GetShiftState;
+   for i := 1 to 7 do
+      with ModifierNames[i] do
+      begin
+         GotoXY (1, 4 + i);
+         ClrEOL;
+         Write (Name, ':');
+         GotoXY (20, WhereY);
+         Write (Pressed[(ShiftState and Modifier) <> 0])
+      end
+end;
+
+procedure ModifierDraw;
+begin
+   WriteLn ('Modifier keys (NOTE: only');
+   WriteLn ('available on some systems;');
+   WriteLn ('X11: only after key press):');
+   ModifierPeriodical
+end;
+
+procedure ChecksDraw;
+begin
+   WriteLn ('(O)S shell');
+   WriteLn ('OS shell with (C)learing');
+   WriteLn ('(R)efresh check');
+   Write   ('(S)ound check')
+end;
+
+procedure ChecksKey (Key: TKey);
+var
+   i, j: Integer;
+   WasteTime: Real; attribute (volatile);
+
+   procedure DoOSShell;
+   var
+      Result: Integer;
+      Shell: TString;
+   begin
+      Shell := GetShellPath (Null);
+      {$I-}
+      Result := Execute (Shell);
+      {$I+}
+      if (InOutRes <> 0) or (Result <> 0) then
+      begin
+         ClrScr;
+         if InOutRes <> 0 then
+            WriteLn (GetIOErrorMessage, ' while trying to execute `', Shell, '''.')
+         else
+            WriteLn ('`', Shell, ''' returned status ', Result, '.');
+         Write ('Any key to continue.');
+         BlockCursor;
+         Discard (GetKey (-1))
+      end
+   end;
+
+begin
+   case LoCase (Key2Char (Key)) of
+     'o': begin
+        if PopUpConfirm (36, 12, 'You will now get an OS shell. Unless' + NewLine +
+                         'CRTDemo is running  in its own (GUI)' + NewLine +
+                         'window,  the shell  will run  on the' + NewLine +
+                         'same screen as CRTDemo  which is not' + NewLine +
+                         'cleared before the shell is started.' + NewLine +
+                         'If possible, the screen contents are' + NewLine +
+                         'restored to the state before CRTDemo' + NewLine +
+                         'was started. After leaving the shell' + NewLine +
+                         'in the usual way (usually  by enter-' + NewLine +
+                         'ing  `exit''), you will  get back to' + NewLine +
+                         'the demo.  <ESC> to abort, any other' + NewLine +
+                         'key to start.') then
+        begin
+           RestoreTerminal (True);
+           DoOSShell
+        end;
+        ClosePopUpWindow
+     end;
+     'c': begin
+        if PopUpConfirm (36, 9, 'You will now get an OS shell. Unless' + NewLine +
+                         'CRTDemo is running in  its own (GUI)' + NewLine +
+                         'window, the screen  will be cleared,' + NewLine +
+                         'and the cursor will be  moved to the' + NewLine +
+                         'top  before  the  shell  is started.' + NewLine +
+                         'After leaving the shell in the usual' + NewLine +
+                         'way  (usually  by entering  `exit''),' + NewLine +
+                         'you will get back to the demo. <ESC>' + NewLine +
+                         'to abort, any other key to start.') then
+        begin
+           RestoreTerminalClearCRT;
+           DoOSShell
+        end;
+        ClosePopUpWindow
+     end;
+     'r': begin
+        if PopUpConfirm (36, 11, 'The program will  now get  busy with' + NewLine +
+                         'some  dummy  computations.  However,' + NewLine +
+                         'CRT output in  the form of dots will' + NewLine +
+                         'still appear continuously one by one' + NewLine +
+                         '(rather than the  whole line at once' + NewLine +
+                         'in the end). While running, the test' + NewLine +
+                         'cannot  be  interrupted.   <ESC>  to' + NewLine +
+                         'abort, any other key to start.') then
+        begin
+           SetCRTUpdate (UpdateRegularly);
+           BlockCursor;
+           WriteLn;
+           WriteLn;
+           for i := 1 to GetXMax - 2 do
+           begin
+              Write ('.');
+              for j := 1 to 400000 do WasteTime := Random
+           end;
+           SetCRTUpdate (UpdateInput);
+           WriteLn;
+           Write ('Press any key.');
+           Discard (GetKey (-1))
+        end;
+        ClosePopUpWindow
+     end;
+     's': begin
+        if PopUpConfirm (32, 4, 'You will now hear some sounds if' + NewLine +
+                         'supported  (otherwise there will' + NewLine +
+                         'just be a short pause). <ESC> to' + NewLine +
+                         'abort, any other key to start.') then
+        begin
+           BlockCursor;
+           for i := 0 to 7 do
+           begin
+              Sound (Round (440 * 2 ** (Round (i * 12 / 7 + 0.3) / 12)));
+              if GetKey (400000) in [kbEsc, kbAltEsc] then Break
+           end;
+           NoSound
+        end;
+        ClosePopUpWindow
+     end;
+   end
+end;
+
+type
+   PWindowList = ^TWindowList;
+   TWindowList = record
+                    Next, Prev: PWindowList;
+                    Panel, FramePanel: TPanel;
+                    WindowType: Integer;
+                    x1, y1, xs, ys: Integer;
+                    State: (ws_None, ws_Moving, ws_Resizing);
+                 end;
+
+TKeyProc = procedure (Key: TKey);
+TProcedure = procedure;
+
+const
+   MenuNameLength = 16;
+   WindowTypes: array [0 .. 9] of record
+                   DrawProc,
+                   PeriodicalProc: procedure;
+                   KeyProc       : TKeyProc;
+                   Name          : String (MenuNameLength);
+                   Color,
+                   Background,
+                   MinSizeX,
+                   MinSizeY,
+                   PrefSizeX,
+                   PrefSizeY     : Integer;
+                   RedrawAlways,
+                   WantCursor    : Boolean
+                                   end =
+((MainDraw         , nil               , nil        , 'CRT Demo'        , LightGreen, Blue     , 26,  7,  0,  0, False, False),
+ (StatusDraw       , nil               , StatusKey  , 'Status'          , White     , Red      , 38, 16,  0,  0, True,  True),
+ (TextAttrDemo     , nil               , nil        , 'Text Attributes' , White     , Blue     , 32, 16, 64, 16, False, False),
+ (NormalCharSetDemo, nil               , nil        , 'Character Set'   , Black     , Green    , 35, 17, 53, 17, False, False),
+ (PCCharSetDemo    , nil               , nil        , 'PC Character Set', Black     , Brown    , 35, 17, 53, 17, False, False),
+ (KeyDemoDraw      , nil               , KeyDemoKey , 'Keys'            , Blue      , LightGray, 29,  5, -1, -1, False, True),
+ (FKeyDemoDraw     , nil               , FKeyDemoKey, 'Function Keys'   , Blue      , LightGray, 37, 22, -1, -1, False, True),
+ (ModifierDraw     , ModifierPeriodical, nil        , 'Modifier Keys'   , Black     , Cyan     , 29, 11,  0,  0, True,  False),
+ (IOSelectDraw     , IOSelectPeriodical, nil        , 'IOSelect Demo'   , White     , Magenta  , 38, 12,  0,  0, False, False),
+ (ChecksDraw       , nil               , ChecksKey  , 'Various Checks'  , Black     , Red      , 26,  4,  0,  0, False, False));
+
+MenuMax = High (WindowTypes);
+MenuXSize = MenuNameLength + 4;
+MenuYSize = MenuMax + 2;
+
+var
+   WindowList: PWindowList = nil;
+
+   procedure RedrawFrame (p: PWindowList);
+   begin
+      with p^, WindowTypes[WindowType] do
+      begin
+         PanelActivate (FramePanel);
+         Window (x1, y1, x1 + xs - 1, y1 + ys - 1);
+         ClrScr;
+         case State of
+           ws_None    : if p = WindowList then
+              FrameWin (' ' + Name + ' ', DoubleFrame, True)
+           else
+              FrameWin (' ' + Name + ' ', SingleFrame, False);
+           ws_Moving  : FrameWin (' Move Window ', SingleFrame, True);
+           ws_Resizing: FrameWin (' Resize Window ', SingleFrame, True);
+         end
+      end
+   end;
+
+   procedure DrawWindow (p: PWindowList);
+   begin
+      with p^, WindowTypes[WindowType] do
+      begin
+         RedrawFrame (p);
+         PanelActivate (Panel);
+         Window (x1 + 2, y1 + 1, x1 + xs - 2, y1 + ys - 2);
+         ClrScr;
+         DrawProc
+      end
+   end;
+
+   procedure RedrawAll;
+   var
+      LastPanel: TPanel;
+      p: PWindowList;
+      x2, y2: Integer;
+   begin
+      LastPanel := GetActivePanel;
+      PanelActivate (MainPanel);
+      TextBackground (Blue);
+      ClrScr;
+      p := WindowList;
+      if p <> nil then
+         repeat
+            with p^ do
+            begin
+               PanelActivate (FramePanel);
+               GetWindow (x1, y1, x2, y2);  { updated automatically by CRT }
+               xs := x2 - x1 + 1;
+               ys := y2 - y1 + 1
+            end;
+            DrawWindow (p);
+            p := p^.Next
+         until p = WindowList;
+      PanelActivate (LastPanel)
+   end;
+
+   procedure CheckScreenSize;
+   var
+      LastPanel: TPanel;
+      MinScreenSizeX, MinScreenSizeY, i: Integer;
+      SSize: TPoint;
+   begin
+      LastPanel := GetActivePanel;
+      PanelActivate (MainPanel);
+      HideCursor;
+      MinScreenSizeX := MenuXSize;
+      MinScreenSizeY := MenuYSize;
+      for i := Low (WindowTypes) to High (WindowTypes) do
+         with WindowTypes[i] do
+         begin
+            MinScreenSizeX := Max (MinScreenSizeX, MinSizeX + 2);
+            MinScreenSizeY := Max (MinScreenSizeY, MinSizeY + 2)
+         end;
+      SSize := ScreenSize;
+      Window (1, 1, SSize.x, SSize.y);
+      if (SSize.x < MinScreenSizeX) or (SSize.y < MinScreenSizeY) then
+      begin
+         NormVideo;
+         ClrScr;
+         RestoreTerminal (True);
+         WriteLn (StdErr, 'Sorry, your screen is too small for this demo (', SSize.x, 'x', SSize.y, ').');
+         WriteLn (StdErr, 'You need at least ', MinScreenSizeX, 'x', MinScreenSizeY, ' characters.');
+         Halt (2)
+      end;
+      PanelActivate (LastPanel);
+      RedrawAll
+   end;
+
+   procedure Die; attribute (noreturn);
+   begin
+      NoSound;
+      RestoreTerminalClearCRT;
+      WriteLn (StdErr, 'You''re trying to kill me. Since I have break checking turned off,');
+      WriteLn (StdErr, 'I''m not dying, but I''ll do you a favour and terminate now.');
+      Halt (3)
+   end;
+
+   function GetKey (TimeOut: Integer) = Key: TKey;
+   var
+      NeedSelect, SelectValue: Integer;
+      SimulateBlockCursorCurrent: TSimulateBlockCursorKind;
+      SelectInput: array [1 .. 1] of PAnyFile = (@Input);
+      NextSelectTime: MicroSecondTimeType = 0; attribute (static);
+      TimeOutTime: MicroSecondTimeType;
+      LastPanel: TPanel;
+      p: PWindowList;
+   begin
+      LastPanel := GetActivePanel;
+      if TimeOut < 0 then
+         TimeOutTime := High (TimeOutTime)
+      else
+         TimeOutTime := GetMicroSecondTime + TimeOut;
+      NeedSelect := 0;
+      if TimeOut >= 0 then
+         Inc (NeedSelect);
+      SimulateBlockCursorCurrent := SimulateBlockCursorKind;
+      if SimulateBlockCursorCurrent <> bc_None then
+         Inc (NeedSelect);
+      p := WindowList;
+      repeat
+         if @WindowTypes[p^.WindowType].PeriodicalProc <> nil then
+            Inc (NeedSelect);
+         p := p^.Next
+      until p = WindowList;
+      p := WindowList;
+      repeat
+         with p^, WindowTypes[WindowType] do
+            if RedrawAlways then
+            begin
+               PanelActivate (Panel);
+               ClrScr;
+               DrawProc
+            end;
+         p := p^.Next
+      until p = WindowList;
+      if NeedSelect <> 0 then
+         repeat
+            CRTUpdate;
+            SelectValue := IOSelectRead (SelectInput, Max (0, Min (NextSelectTime, TimeOutTime) - GetMicroSecondTime));
+            if SelectValue = 0 then
+            begin
+               case SimulateBlockCursorCurrent of
+                 bc_None  : ;
+                 bc_Blink : SimulateBlockCursor;
+                 bc_Static: begin
+                    SimulateBlockCursor;
+                    SimulateBlockCursorCurrent := bc_None;
+                    Dec (NeedSelect)
+                 end
+               end;
+               NextSelectTime := GetMicroSecondTime + 120000;
+               p := WindowList;
+               repeat
+                  with p^, WindowTypes[WindowType] do
+                     if @PeriodicalProc <> nil then
+                     begin
+                        PanelActivate (Panel);
+                        PeriodicalProc
+                     end;
+                  p := p^.Next
+               until p = WindowList
+            end;
+         until (NeedSelect = 0) or (SelectValue <> 0) or ((TimeOut >= 0) and (GetMicroSecondTime >= TimeOutTime));
+      if NeedSelect = 0 then
+         SelectValue := 1;
+      if SelectValue = 0 then
+         Key := 0
+      else
+         Key := ReadKeyWord;
+      if SimulateBlockCursorKind <> bc_None then
+         SimulateBlockCursorOff;
+      if IsDeadlySignal (Key) then Die;
+      if Key = kbScreenSizeChanged then CheckScreenSize;
+      PanelActivate (LastPanel)
+   end;
+
+   function Menu = n: Integer;
+   var
+      i, ax, ay: Integer;
+      Key: TKey;
+      Done: Boolean;
+      SSize: TPoint;
+   begin
+      n := 1;
+      repeat
+         SSize := ScreenSize;
+         ax := (SSize.x - MenuXSize) div 2 + 1;
+         ay := (SSize.y - MenuYSize) div 2 + 1;
+         PanelNew (ax, ay, ax + MenuXSize - 1, ay + MenuYSize - 1, False);
+         SetControlChars (True);
+         TextColor (Blue);
+         TextBackground (LightGray);
+         FrameWin (' Select Window ', DoubleFrame, True);
+         IgnoreCursor;
+         PanelNew (ax + 1, ay + 1, ax + MenuXSize - 2, ay + MenuYSize - 2, False);
+         ClrScr;
+         TextColor (Black);
+         SetScroll (False);
+         Done := False;
+         repeat
+            for i := 1 to MenuMax do
+            begin
+               GotoXY (1, i);
+               if i = n then
+                  TextBackground (Green)
+               else
+                  TextBackground (LightGray);
+               ClrEOL;
+               Write (' ', WindowTypes[i].Name);
+               ChangeTextAttr (2, i, 1, Red + $10 * GetTextBackground)
+            end;
+            Key := GetKey (-1);
+            case LoCaseKey (Key) of
+              kbUp                  : if n = 1 then n := MenuMax else Dec (n);
+              kbDown                : if n = MenuMax then n := 1 else Inc (n);
+              kbHome,
+              kbPgUp,
+              kbCtrlPgUp,
+              kbCtrlHome            : n := 1;
+              kbEnd,
+              kbPgDn,
+              kbCtrlPgDn,
+              kbCtrlEnd             : n := MenuMax;
+              kbCR                  : Done := True;
+              kbEsc, kbAltEsc       : begin
+                 n := -1;
+                 Done := True
+              end;
+              Ord ('a') .. Ord ('z'): begin
+                 i := MenuMax;
+                 while (i > 0) and (LoCase (Key2Char (Key)) <> LoCase (WindowTypes[i].Name[1])) do Dec (i);
+                 if i > 0 then
+                 begin
+                    n := i;
+                    Done := True
+                 end
+              end;
+            end
+         until Done or (Key = kbScreenSizeChanged);
+         ClosePopUpWindow
+      until Key <> kbScreenSizeChanged
+   end;
+
+   procedure NewWindow (WindowType, ax, ay: Integer);
+   var
+      p, LastWindow: PWindowList;
+      MaxX1, MaxY1: Integer;
+      SSize: TPoint;
+   begin
+      New (p);
+      if WindowList = nil then
+      begin
+         p^.Prev := p;
+         p^.Next := p
+      end
+      else
+      begin
+         p^.Prev := WindowList;
+         p^.Next := WindowList^.Next;
+         p^.Prev^.Next := p;
+         p^.Next^.Prev := p;
+      end;
+      p^.WindowType := WindowType;
+      with p^, WindowTypes[WindowType] do
+      begin
+         SSize := ScreenSize;
+         if PrefSizeX > 0 then xs := PrefSizeX else xs := MinSizeX;
+         if PrefSizeY > 0 then ys := PrefSizeY else ys := MinSizeY;
+         xs := Min (xs + 2, SSize.x);
+         ys := Min (ys + 2, SSize.y);
+         MaxX1 := SSize.x - xs + 1;
+         MaxY1 := SSize.y - ys + 1;
+         if ax = 0 then x1 := Random (MaxX1) + 1 else x1 := Min (ax, MaxX1);
+         if ay = 0 then y1 := Random (MaxY1) + 1 else y1 := Min (ay, MaxY1);
+         if (ax = 0) and (PrefSizeX < 0) then Inc (xs, Random (SSize.x - x1 - xs + 2));
+         if (ax = 0) and (PrefSizeY < 0) then Inc (ys, Random (SSize.y - y1 - ys + 2));
+         State := ws_None;
+         PanelNew (1, 1, 1, 1, False);
+         FramePanel := GetActivePanel;
+         SetControlChars (True);
+         TextColor (Color);
+         TextBackground (Background);
+         PanelNew (1, 1, 1, 1, False);
+         SetPCCharSet (False);
+         Panel := GetActivePanel;
+      end;
+      LastWindow := WindowList;
+      WindowList := p;
+      if LastWindow <> nil then RedrawFrame (LastWindow);
+      DrawWindow (p)
+   end;
+
+   procedure OpenWindow;
+   var WindowType: Integer;
+   begin
+      WindowType := Menu;
+      if WindowType >= 0 then NewWindow (WindowType, 0, 0)
+   end;
+
+   procedure NextWindow;
+   var LastWindow: PWindowList;
+   begin
+      LastWindow := WindowList;
+      WindowList := WindowList^.Next;
+      PanelTop (WindowList^.FramePanel);
+      PanelTop (WindowList^.Panel);
+      RedrawFrame (LastWindow);
+      RedrawFrame (WindowList)
+   end;
+
+   procedure PreviousWindow;
+   var LastWindow: PWindowList;
+   begin
+      PanelMoveAbove (WindowList^.Panel, MainPanel);
+      PanelMoveAbove (WindowList^.FramePanel, MainPanel);
+      LastWindow := WindowList;
+      WindowList := WindowList^.Prev;
+      RedrawFrame (LastWindow);
+      RedrawFrame (WindowList)
+   end;
+
+   procedure CloseWindow;
+   var p: PWindowList;
+   begin
+      if WindowList^.WindowType <> 0 then
+      begin
+         p := WindowList;
+         NextWindow;
+         PanelDelete (p^.FramePanel);
+         PanelDelete (p^.Panel);
+         p^.Next^.Prev := p^.Prev;
+         p^.Prev^.Next := p^.Next;
+         Dispose (p)
+      end
+   end;
+
+   procedure MoveWindow;
+   var
+      Done, Changed: Boolean;
+      SSize: TPoint;
+   begin
+      with WindowList^ do
+      begin
+         Done := False;
+         Changed := True;
+         State := ws_Moving;
+         repeat
+            if Changed then DrawWindow (WindowList);
+            Changed := True;
+            case LoCaseKey (GetKey (-1)) of
+              Ord ('s'), kbLeft    : if x1 > 1 then Dec (x1);
+              Ord ('d'), kbRight   : if x1 + xs - 1 < ScreenSize.x then Inc (x1);
+              Ord ('e'), kbUp      : if y1 > 1 then Dec (y1);
+              Ord ('x'), kbDown    : if y1 + ys - 1 < ScreenSize.y then Inc (y1);
+              Ord ('a'), kbHome    : x1 := 1;
+              Ord ('f'), kbEnd     : x1 := ScreenSize.x - xs + 1;
+              Ord ('r'), kbPgUp    : y1 := 1;
+              Ord ('c'), kbPgDn    : y1 := ScreenSize.y - ys + 1;
+              Ord ('y'), kbCtrlPgUp: begin
+                 x1 := 1;
+                 y1 := 1
+              end;
+              Ord ('b'), kbCtrlPgDn: begin
+                 SSize := ScreenSize;
+                 x1 := SSize.x - xs + 1;
+                 y1 := SSize.y - ys + 1
+              end;
+              kbCR,
+              kbEsc, kbAltEsc      : Done := True;
+            else                   Changed := False
+            end
+         until Done;
+         State := ws_None;
+         DrawWindow (WindowList)
+      end
+   end;
+
+   procedure ResizeWindow;
+   var
+      Done, Changed: Boolean;
+      SSize: TPoint;
+   begin
+      with WindowList^, WindowTypes[WindowType] do
+      begin
+         Done := False;
+         Changed := True;
+         State := ws_Resizing;
+         repeat
+            if Changed then DrawWindow (WindowList);
+            Changed := True;
+            case LoCaseKey (GetKey (-1)) of
+              Ord ('s'), kbLeft    : if xs > MinSizeX + 2 then Dec (xs);
+              Ord ('d'), kbRight   : if x1 + xs - 1 < ScreenSize.x then Inc (xs);
+              Ord ('e'), kbUp      : if ys > MinSizeY + 2 then Dec (ys);
+              Ord ('x'), kbDown    : if y1 + ys - 1 < ScreenSize.y then Inc (ys);
+              Ord ('a'), kbHome    : xs := MinSizeX + 2;
+              Ord ('f'), kbEnd     : xs := ScreenSize.x - x1 + 1;
+              Ord ('r'), kbPgUp    : ys := MinSizeY + 2;
+              Ord ('c'), kbPgDn    : ys := ScreenSize.y - y1 + 1;
+              Ord ('y'), kbCtrlPgUp: begin
+                 xs := MinSizeX + 2;
+                 ys := MinSizeY + 2
+              end;
+              Ord ('b'), kbCtrlPgDn: begin
+                 SSize := ScreenSize;
+                 xs := SSize.x - x1 + 1;
+                 ys := SSize.y - y1 + 1
+              end;
+              kbCR,
+              kbEsc, kbAltEsc      : Done := True;
+            else                   Changed := False
+            end
+         until Done;
+         State := ws_None;
+         DrawWindow (WindowList)
+      end
+   end;
+
+   procedure ActivateCursor;
+   begin
+      with WindowList^, WindowTypes[WindowType] do
+      begin
+         PanelActivate (Panel);
+         if WantCursor then
+            SetCursorShape (CursorShape)
+         else
+            HideCursor
+      end;
+      SetScroll (ScrollState)
+   end;
+
+var
+   Key: TKey;
+   ScreenShot, Done: Boolean;
+
+begin
+   ScreenShot := ParamStr (1) = '--screenshot';
+   if ParamCount <> Ord (ScreenShot) then
+   begin
+      RestoreTerminal (True);
+      WriteLn (StdErr, ParamStr (0), ': invalid argument `', ParamStr (Ord (ScreenShot) + 1), '''');
+      Halt (1)
+   end;
+   CRTSavePreviousScreen (True);
+   SetCRTUpdate (UpdateInput);
+   MainPanel := GetActivePanel;
+   CheckScreenSize;
+   OrigScreenSize := ScreenSize;
+   if ScreenShot then
+   begin
+      CursorShape := CursorBlock;
+      NewWindow (6,      1,      1);
+      NewWindow (2,      1, MaxInt);
+      NewWindow (8, MaxInt,      1);
+      NewWindow (5,      1,     27);
+      KeyDemoKey (Ord ('f'));
+      KeyDemoKey (246);
+      KeyDemoKey (kbDown);
+      NewWindow (3, MaxInt,     13);
+      NewWindow (4, MaxInt,     31);
+      NewWindow (7, MaxInt, MaxInt);
+      NewWindow (9, MaxInt,     33);
+      NewWindow (0,      1,      2);
+      NewWindow (1,      1,     14);
+      ActivateCursor;
+      OpenWindow
+   end
+   else
+      NewWindow (0, 3, 2);
+   Done := False;
+   repeat
+      ActivateCursor;
+      Key := GetKey (-1);
+      case LoCaseKey (Key) of
+        Ord ('3'), kbF3 : OpenWindow;
+        Ord ('4'), kbF4 : CloseWindow;
+        Ord ('5'), kbF5 : PreviousWindow;
+        Ord ('6'), kbF6 : NextWindow;
+        Ord ('7'), kbF7 : MoveWindow;
+        Ord ('8'), kbF8 : ResizeWindow;
+        Ord ('q'), kbEsc,
+        kbAltEsc:         Done := True;
+      else
+         if WindowList <> nil then
+            with WindowList^, WindowTypes[WindowType] do
+               if @KeyProc <> nil then
+               begin
+                  TextColor (Color);
+                  TextBackground (Background);
+                  KeyProc (Key)
+               end
+      end
+   until Done
+end.