home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / progm / tptools.zip / EDINST.ZIP / EDIKEY.INC < prev    next >
Text File  |  1987-12-21  |  32KB  |  957 lines
  1. {                          EDIKEY.INC
  2.                            EDINST 4.0
  3.              Copyright (c) 1985, 87 by Borland International, Inc.            }
  4.  
  5.   procedure KeyInstall;
  6.     {-install keyboard}
  7.   const
  8.     FirstRow = 4;
  9.     LastRow = 25;
  10.     PrimeCmdCol = 28;
  11.     PrimeMinCol = 31;
  12.     PrimeMaxCol = 52;
  13.     SecndCmdCol = 54;
  14.     SecndMinCol = 57;
  15.     SecndMaxCol = 79;
  16.  
  17.   const
  18.     MaxDisplay = 89;         {Number of editor commands displayed}
  19.  
  20.     EditPrompt : string[70] =
  21.     '-backspace  C-clear  R-restore  ┘-accept edit  <Scroll Lock> literal';
  22.     BrowsePrompt : string[67] =
  23.     '--scroll  PgUp-PgDn-page  ┘-modify  R-restore defaults  ESC-exit';
  24.  
  25.     OrderMap : array[1..MaxDisplay] of CommandType =
  26.     (
  27.  
  28.      CmdLeftChar,            {0. Left character}
  29.      CmdRightChar,           {1. Right character}
  30.      CmdLeftWord,            {2. Left lexeme}
  31.      CmdRightWord,           {3. Right lexeme}
  32.      CmdUpLine,              {4. Up line}
  33.      CmdDownLine,            {5. Down line}
  34.      CmdScrollUp,            {6. Scroll up}
  35.      CmdScrollDown,          {7. Scroll down}
  36.      CmdDownPage,            {8. Down page}
  37.      CmdUpPage,              {9. Up page}
  38.  
  39.      CmdNull,
  40.  
  41.      CmdWindowTopFile,       {10. Top of window}
  42.      CmdWindowBottomFile,    {11. Bottom of window}
  43.      CmdLeftLine,            {12. Cursor to left side}
  44.      CmdRightLine,           {13. Cursor to right side}
  45.      CmdTopScreen,           {14. Top of screen}
  46.      CmdBottomScreen,        {15. Bottom of screen}
  47.      CmdCpgotoln,            {18. Goto line n}
  48.      CmdGotoColumn,          {19. Goto column n}
  49.      CmdJumpLastPosition,    {21. Previous cursor position}
  50.  
  51.      CmdNull,
  52.  
  53.      CmdAbort,               {192. Abort current operation}
  54.      CmdUndo,                {22. Undo last deletion}
  55.      CmdRestoreCurrentLine,  {23. Restore line as on entry}
  56.      CmdTab,                 {24. Tab, either fixed or "smart"}
  57.      CmdInsertCtrlChar,      {25. Inserting control character into text}
  58.      CmdNewLine,             {26. New line in text buffer}
  59.      CmdInsertLine,          {27. Inserting line}
  60.      CmdDeleteRightChar,     {28. Delete current character}
  61.      CmdDeleteLeftChar,      {29. Delete left character}
  62.      CmdDeleteRightWord,     {30. Delete right lexeme}
  63.      CmdDeleteLineRight,     {31. Delete line right of cursor}
  64.      CmdDeleteLine,          {32. Delete line}
  65.  
  66.      CmdNull,
  67.  
  68.      CmdFind,                {34. Find pattern}
  69.      CmdFindReplace,         {35. Find and replace}
  70.      CmdFindNext,            {37. Find next}
  71.  
  72.      CmdNull,
  73.  
  74.      CmdAbandonFile,         {41. Abandon file}
  75.      CmdReadBlock,           {42. Read file into window}
  76.      CmdSaveFile,            {43. Save file}
  77.      CmdWriteBlock,          {44. Write block to file, not appending}
  78.      CmdSaveQuit,            {45. Save file and exit}
  79.      CmdWriteNamedFile,      {151. Save current window to another file}
  80.  
  81.      CmdNull,
  82.  
  83.      CmdAddWindow,           {46. Add second window with same or different file}
  84.      CmdSizeWindow,          {47. Resize current window}
  85.      CmdWindowDown,          {49. Switch windows}
  86.      CmdWindowUp,            {153. Move to previous window}
  87.  
  88.      CmdNull,
  89.  
  90.      CmdBlockBegin,          {52. Begin block}
  91.      CmdBlockEnd,            {53. End block}
  92.      CmdJumpTopOfBlock,      {54. Top of block}
  93.      CmdJumpBottomBlock,     {55. Bottom of block}
  94.      CmdBlockCopy,           {56. Copy block}
  95.      CmdBlockMove,           {57. Move block}
  96.      CmdBlockDelete,         {58. Delete block}
  97.      CmdBlockHide,           {59. Hide/display toggle block}
  98.      CmdBlockWord,           {60. Mark current word as block}
  99.  
  100.      CmdNull,
  101.  
  102.      CmdSetMarker0,          {62. Set marker}
  103.      CmdSetMarker1,
  104.      CmdSetMarker2,
  105.      CmdSetMarker3,
  106.      CmdSetMarker4,
  107.      CmdSetMarker5,
  108.      CmdSetMarker6,
  109.      CmdSetMarker7,
  110.      CmdSetMarker8,
  111.      CmdSetMarker9,
  112.      CmdJumpMarker0,         {Jump marker}
  113.      CmdJumpMarker1,
  114.      CmdJumpMarker2,
  115.      CmdJumpMarker3,
  116.      CmdJumpMarker4,
  117.      CmdJumpMarker5,
  118.      CmdJumpMarker6,
  119.      CmdJumpMarker7,
  120.      CmdJumpMarker8,
  121.      CmdJumpMarker9,
  122.      CmdToggleTextMarker,    {61. Toggle text marker display}
  123.  
  124.      CmdNull,                {193. No operation indicated}
  125.  
  126.      CmdLogDrive,            {127. Log drive or path}
  127.      CmdSysInfo,             {104. Show system information}
  128.      CmdShowMem,             {105. Show available memory}
  129.      CmdToggleInsert,        {106. Toggle insert mode}
  130.      CmdToggleAutoindent,    {107. Toggle autoindent mode}
  131.      CmdSetUndoLimit,        {133. Set default undo limit}
  132.      CmdGetDefaultExtension  {135. Get a new default file extension}
  133.      );
  134.  
  135.   var
  136.     Title : VarString;
  137.     Quitting : Boolean;
  138.     Wrote : Boolean;
  139.     CmdLen : Integer;
  140.     PackedCommands : PackedCommandList;
  141.     MinCmd : CommandType;
  142.     Ch : Char;
  143.     KeyOfs : LongInt;
  144.     CmdsRead : Integer;
  145.  
  146.     procedure InitializeScreen;
  147.       {-Set up for full screen key editor}
  148.     begin
  149.       ClrScr;
  150.       GoToXY(1, 1);
  151.       Title := CenterPad(' Installing: '+ProgName+' ', '═', 80);
  152.       Center(1, TiColor, Title);
  153.     end;
  154.  
  155.     function FindKeys(var PackedCommands : PackedCommandList;
  156.                       var KeyLen : Integer) : LongInt;
  157.       {-Read the command definitions into memory}
  158.     type
  159.       TempRec = record
  160.                   Len : Integer;
  161.                   PCList : PackedCommandList;
  162.                 end;
  163.     var
  164.       FO : LongInt;
  165.       TR : ^TempRec;
  166.     begin                    {FindKeys}
  167.       {allocate temporary workspace}
  168.       New(TR);
  169.       FillChar(TR^.PCList, SizeOf(PackedCommandList), 0);
  170.  
  171.       {search the work area}
  172.       FO := FindString(KIDstring, TR^, CmdListBytes+2);
  173.       if FO = 0 then
  174.         HaltError('Unable to locate keyboard installation area');
  175.  
  176.       {check the number of bytes in the command list}
  177.       if TR^.Len > CmdListBytes then
  178.         HaltError('Command list is too large. '+ProgName+' may be corrupted.');
  179.  
  180.       {get the command list}
  181.       KeyLen := TR^.Len;
  182.       PackedCommands := TR^.PCList;
  183.  
  184.       {release memory}
  185.       Dispose(TR);
  186.  
  187.       {return the offset of the command list}
  188.       FindKeys := FO+2;
  189.     end;                     {FindKeys}
  190.  
  191.     procedure InitializeCommands(var Commands : CommandList);
  192.       {-Initialize the titles of each command}
  193.     var
  194.       C : CommandType;
  195.  
  196.     begin                    {InitializeCommands}
  197.  
  198.       C := MinCmd;
  199.       while C <= CmdNull do begin
  200.         with Commands[C] do begin
  201.           with Main do begin
  202.             Keys := '';
  203.             Modified := False;
  204.             Conflict := False;
  205.             MinCol := PrimeMinCol;
  206.             MaxCol := PrimeMaxCol;
  207.           end;
  208.           with Alt do begin
  209.             Keys := '';
  210.             Modified := False;
  211.             Conflict := False;
  212.             MinCol := SecndMinCol;
  213.             MaxCol := SecndMaxCol;
  214.           end;
  215.           case C of
  216.             CmdLeftChar : Name := 'Character left';
  217.             CmdRightChar : Name := 'Character right';
  218.             CmdLeftWord : Name := 'Word left';
  219.             CmdRightWord : Name := 'Word right';
  220.             CmdUpLine : Name := 'Line up';
  221.             CmdDownLine : Name := 'Line down';
  222.             CmdScrollUp : Name := 'Scroll up';
  223.             CmdScrollDown : Name := 'Scroll down';
  224.             CmdDownPage : Name := 'Page down';
  225.             CmdUpPage : Name := 'Page up';
  226.  
  227.             CmdWindowTopFile : Name := 'Top of window';
  228.             CmdWindowBottomFile : Name := 'Bottom of window';
  229.             CmdLeftLine : Name := 'Cursor to left side';
  230.             CmdRightLine : Name := 'Cursor to right side';
  231.             CmdTopScreen : Name := 'Top of screen';
  232.             CmdBottomScreen : Name := 'Bottom of screen';
  233.             CmdCpgotoln : Name := 'Go to line';
  234.             CmdGotoColumn : Name := 'Go to column';
  235.             CmdJumpLastPosition : Name := 'Previous cursor position';
  236.  
  237.             CmdAbort : Name := 'Abort command (1 char)';
  238.             CmdUndo : Name := 'Undo last deletion';
  239.             CmdRestoreCurrentLine : Name := 'Restore line';
  240.             CmdTab : Name := 'Tab';
  241.             CmdInsertCtrlChar : Name := 'Insert control char';
  242.             CmdNewLine : Name := 'New line';
  243.             CmdInsertLine : Name := 'Insert line';
  244.             CmdDeleteRightChar : Name := 'Delete current character';
  245.             CmdDeleteLeftChar : Name := 'Delete left character';
  246.             CmdDeleteRightWord : Name := 'Delete right word';
  247.             CmdDeleteLineRight : Name := 'Delete line right';
  248.             CmdDeleteLine : Name := 'Delete line';
  249.  
  250.             CmdFind : Name := 'Find pattern';
  251.             CmdFindReplace : Name := 'Find and replace';
  252.             CmdFindNext : Name := 'Find next';
  253.  
  254.             CmdAbandonFile : Name := 'Abandon file';
  255.             CmdReadBlock : Name := 'Read file into window';
  256.             CmdSaveFile : Name := 'Save and continue edit';
  257.             CmdWriteBlock : Name := 'Write block to file';
  258.             CmdSaveQuit : Name := 'Save and exit to DOS';
  259.             CmdWriteNamedFile : Name := 'Save to file';
  260.  
  261.             CmdAddWindow : Name := 'Add window';
  262.             CmdSizeWindow : Name := 'Resize current window';
  263.             CmdWindowDown : Name := 'Next window';
  264.             CmdWindowUp : Name := 'Previous window';
  265.  
  266.             CmdBlockBegin : Name := 'Begin block';
  267.             CmdBlockEnd : Name := 'End block';
  268.             CmdJumpTopOfBlock : Name := 'Top of block';
  269.             CmdJumpBottomBlock : Name := 'Bottom of block';
  270.             CmdBlockCopy : Name := 'Copy block';
  271.             CmdBlockMove : Name := 'Move block';
  272.             CmdBlockDelete : Name := 'Delete block';
  273.             CmdBlockHide : Name := 'Toggle block display';
  274.             CmdBlockWord : Name := 'Mark current word';
  275.  
  276.             CmdSetMarker0 : Name := 'Set marker 0';
  277.             CmdSetMarker1 : Name := 'Set marker 1';
  278.             CmdSetMarker2 : Name := 'Set marker 2';
  279.             CmdSetMarker3 : Name := 'Set marker 3';
  280.             CmdSetMarker4 : Name := 'Set marker 4';
  281.             CmdSetMarker5 : Name := 'Set marker 5';
  282.             CmdSetMarker6 : Name := 'Set marker 6';
  283.             CmdSetMarker7 : Name := 'Set marker 7';
  284.             CmdSetMarker8 : Name := 'Set marker 8';
  285.             CmdSetMarker9 : Name := 'Set marker 9';
  286.             CmdJumpMarker0 : Name := 'Jump to marker 0';
  287.             CmdJumpMarker1 : Name := 'Jump to marker 1';
  288.             CmdJumpMarker2 : Name := 'Jump to marker 2';
  289.             CmdJumpMarker3 : Name := 'Jump to marker 3';
  290.             CmdJumpMarker4 : Name := 'Jump to marker 4';
  291.             CmdJumpMarker5 : Name := 'Jump to marker 5';
  292.             CmdJumpMarker6 : Name := 'Jump to marker 6';
  293.             CmdJumpMarker7 : Name := 'Jump to marker 7';
  294.             CmdJumpMarker8 : Name := 'Jump to marker 8';
  295.             CmdJumpMarker9 : Name := 'Jump to marker 9';
  296.             CmdToggleTextMarker : Name := 'Toggle marker display';
  297.  
  298.             CmdLogDrive : Name := 'Log drive/path';
  299.             CmdSysInfo : Name := 'Show editor version';
  300.             CmdShowMem : Name := 'Show available memory';
  301.             CmdToggleInsert : Name := 'Toggle insert mode';
  302.             CmdToggleAutoindent : Name := 'Toggle autoindent mode';
  303.             CmdSetUndoLimit : Name := 'Set undo limit';
  304.             CmdGetDefaultExtension : Name := 'Set default extension';
  305.  
  306.           end;
  307.         end;
  308.         C := Succ(C);
  309.       end;
  310.     end;                     {InitializeCommands}
  311.  
  312.     procedure ParsePackedCommands(var PackedCommands : PackedCommandList;
  313.                                   var Commands : CommandList);
  314.       {-fill in the structured command array from the packed buffer}
  315.     var
  316.       P, CmdLen : Integer;
  317.       C : CommandType;
  318.  
  319.       function InOrderMap(C : CommandType) : Boolean;
  320.         {-Return true if c is found in the displayed commands}
  321.       var
  322.         I : Integer;
  323.       begin                  {InOrderMap}
  324.         InOrderMap := False;
  325.         for I := 1 to MaxDisplay do
  326.           if C = OrderMap[I] then begin
  327.             InOrderMap := True;
  328.             Exit;
  329.           end;
  330.       end;                   {InOrderMap}
  331.  
  332.     begin                    {ParsePackedCommands}
  333.       P := 0;
  334.       CmdLen := Ord(PackedCommands[P]);
  335.       while CmdLen <> 0 do begin
  336.         C := CommandType(Ord(PackedCommands[Succ(P+CmdLen)]));
  337.         if InOrderMap(C) then
  338.           with Commands[C] do begin
  339.             if Main.Keys = '' then
  340.               {load the main command selection}
  341.               Move(PackedCommands[P], Main.Keys[0], Succ(CmdLen))
  342.             else if Alt.Keys = '' then
  343.               {load the alternate command selection}
  344.               Move(PackedCommands[P], Alt.Keys[0], Succ(CmdLen))
  345.             else begin
  346.               {both are full}
  347.               ClrEol(1, 1, LoColor);
  348.               EdFastWrite('Warning: more than 2 definitions for command '+Name, 1, 1, LoColor);
  349.             end;
  350.           end;
  351.         {move to next command group}
  352.         P := P+CmdLen+2;
  353.         CmdLen := Ord(PackedCommands[P]);
  354.       end;
  355.     end;                     {ParsePackedCommands}
  356.  
  357.     procedure DisplayKeys(TheColor, R : Byte; K : KeyRec);
  358.       {-display the stored keystrokes}
  359.     var
  360.       Txt, Dis : VarString;
  361.       Len : Byte;
  362.       TxtLen : Byte absolute Txt;
  363.  
  364.     begin                    {DisplayKeys}
  365.       with K do begin
  366.         Len := Succ(MaxCol-MinCol);
  367.         Txt := TextRepresentation(K);
  368.         Dis := Pad(Copy(Txt, 1, Len), Len);
  369.         EdFastWrite(Dis, R, MinCol, TheColor);
  370.         if TxtLen > Len then
  371.           GoToXY(MinCol+Len, R)
  372.         else
  373.           GoToXY(MinCol+Ord(Txt[0]), R);
  374.       end;
  375.     end;                     {DisplayKeys}
  376.  
  377.     procedure DisplayCommand(C : CommandType; R : Byte);
  378.       {-display a command and its keys}
  379.  
  380.     begin                    {DisplayCommand}
  381.       if C = CmdNull then
  382.         {Draw a separator bar}
  383.         Center(R, TiColor, '────────────────────────────────────────────────────────────────────────────────')
  384.       else
  385.         with Commands[C] do begin
  386.           ClrEol(1, R, TiColor);
  387.           EdFastWrite(Name, R, 1, TiColor);
  388.           EdFastWrite('P:', R, PrimeCmdCol, TiColor);
  389.           if Main.Conflict then
  390.             DisplayKeys(CfColor, R, Main)
  391.           else if Main.Modified then
  392.             DisplayKeys(ChColor, R, Main)
  393.           else
  394.             DisplayKeys(LoColor, R, Main);
  395.           EdFastWrite('S:', R, SecndCmdCol, TiColor);
  396.           if Alt.Conflict then
  397.             DisplayKeys(CfColor, R, Alt)
  398.           else if Alt.Modified then
  399.             DisplayKeys(ChColor, R, Alt)
  400.           else
  401.             DisplayKeys(LoColor, R, Alt);
  402.         end;
  403.     end;                     {DisplayCommand}
  404.  
  405.     function GetKeys(R : Byte; var K : KeyRec; var StopNow : Boolean) : Boolean;
  406.       {-edit a key sequence, default keys as input, keys also return result}
  407.       {-return true if keys were modified in the process}
  408.     const
  409.       ScrollMask = $10;
  410.     var
  411.       Quitting : Boolean;
  412.       Ch : Char;
  413.       Buf : KeyString;
  414.       ScrollLock, LastScroll : Byte;
  415.       KbFlag : Byte absolute $0040 : $0017;
  416.  
  417.     begin                    {GetKeys}
  418.       StopNow := False;
  419.       LastScroll := $FF;
  420.  
  421.       with K do begin
  422.         Buf := Keys;
  423.         Quitting := False;
  424.         repeat
  425.           DisplayKeys(EdColor, R, K);
  426.  
  427.           repeat
  428.             {Watch the scroll state while waiting for a keystroke}
  429.             ScrollLock := KbFlag and ScrollMask;
  430.             if ScrollLock <> LastScroll then begin
  431.               if ScrollLock <> 0 then
  432.                 EdFastWrite('Literal', 1, 70, LoColor)
  433.               else
  434.                 EdFastWrite('Command', 1, 70, LoColor);
  435.               LastScroll := ScrollLock;
  436.             end;
  437.           until KeyPressed;
  438.  
  439.           Ch := ReadKey;
  440.  
  441.           if ScrollLock <> 0 then begin
  442.             {literal mode}
  443.             if Ch = #0 then begin
  444.               Ch := ReadKey;
  445.               if Length(Keys) < Pred(KeyLength) then
  446.                 Keys := Keys+#0+Ch;
  447.             end else if Length(Keys) < KeyLength then
  448.               Keys := Keys+Ch;
  449.  
  450.           end else
  451.             {command mode}
  452.             case Upcase(Ch) of
  453.               #0 :
  454.                 begin
  455.                   Ch := ReadKey;
  456.                   if Length(Keys) < Pred(KeyLength) then
  457.                     Keys := Keys+#0+Ch;
  458.                 end;
  459.  
  460.               ^M :
  461.                 Quitting := True;
  462.  
  463.               ^H :           {backspace}
  464.                 if Length(Keys) > 0 then begin
  465.                   Delete(Keys, Length(Keys), 1);
  466.                   if (Length(Keys) > 0) and (Keys[Length(Keys)] = #0) then
  467.                     Delete(Keys, Length(Keys), 1);
  468.                 end;
  469.  
  470.               'C' :
  471.                 Keys := '';  {erase}
  472.  
  473.               'R' :
  474.                 Keys := Buf; {restore original}
  475.  
  476.               #32..#47,
  477.               #58..#126,
  478.               #128..#255 : {ignore regular characters} ;
  479.  
  480.               Escape :
  481.                 begin
  482.                   StopNow := True;
  483.                   Quitting := True;
  484.                 end;
  485.  
  486.             else
  487.               if Length(Keys) < KeyLength then
  488.                 Keys := Keys+Ch;
  489.             end;
  490.         until Quitting;
  491.         GetKeys := (Keys <> Buf);
  492.         EdFastWrite('═══════', 1, 70, TiColor);
  493.  
  494.       end;
  495.     end;                     {getkeys}
  496.  
  497.     procedure EditKeys(R : Byte; var K : KeyRec);
  498.       {-edit one key record}
  499.     var
  500.       StopNow : Boolean;
  501.  
  502.     begin                    {EditKeys}
  503.       Center(2, EdColor, EditPrompt);
  504.       with K do begin
  505.         Modified := GetKeys(R, K, StopNow);
  506.         if Modified then begin
  507.           DisplayKeys(ChColor, R, K);
  508.           Conflict := False;
  509.         end else if Conflict then
  510.           DisplayKeys(CfColor, R, K)
  511.         else
  512.           DisplayKeys(LoColor, R, K);
  513.       end;
  514.       Center(2, TiColor, BrowsePrompt);
  515.     end;                     {Editkeys}
  516.  
  517.     procedure DrawFullPage(CmdStart : Integer);
  518.       {-write a full page of commands, starting at cmdstart}
  519.     var
  520.       R : Byte;
  521.       C : Integer;
  522.  
  523.     begin                    {DrawFullPage}
  524.       R := FirstRow;
  525.       C := CmdStart;
  526.       while (R <= LastRow) and (C <= MaxDisplay) do begin
  527.         DisplayCommand(OrderMap[C], R);
  528.         R := Succ(R);
  529.         C := Succ(C);
  530.       end;
  531.     end;                     {DrawFullPage}
  532.  
  533.     procedure EditCommands;
  534.       {-Allow browsing and changing of command keys in range minc to maxc}
  535.     var
  536.       Quitting : Boolean;
  537.       OldTopC, TopC, CurC : Integer;
  538.       R, Curr : Byte;
  539.       CurCmd : CommandType;
  540.       K : KeyRec;
  541.       OnMain : Boolean;
  542.  
  543.     begin                    {EditCommands}
  544.       Center(2, TiColor, BrowsePrompt);
  545.       Center(3, TiColor, '════════════════════════════════════════════════════════════════════════════════');
  546.       TopC := 1;
  547.       CurC := 1;
  548.       Curr := FirstRow;
  549.       DrawFullPage(TopC);
  550.       OnMain := True;
  551.  
  552.       Quitting := False;
  553.       repeat
  554.  
  555.         {Handle display mapping}
  556.         CurCmd := OrderMap[CurC];
  557.  
  558.         if OnMain then
  559.           K := Commands[CurCmd].Main
  560.         else
  561.           K := Commands[CurCmd].Alt;
  562.  
  563.         GoToXY(K.MinCol, Curr);
  564.  
  565.         case GetCursorCommand of
  566.  
  567.           ^M :               {edit key}
  568.             if (CurCmd <> CmdNull) then begin
  569.               EditKeys(Curr, K);
  570.               if OnMain then
  571.                 Commands[CurCmd].Main := K
  572.               else
  573.                 Commands[CurCmd].Alt := K;
  574.             end;
  575.  
  576.           ^E, ^W :           {scroll up}
  577.             if CurC > 1 then begin
  578.               CurC := Pred(CurC);
  579.               if Curr = FirstRow then begin
  580.                 TopC := CurC;
  581.                 InsLine;
  582.                 DisplayCommand(OrderMap[CurC], FirstRow);
  583.               end else
  584.                 Curr := Pred(Curr);
  585.             end;
  586.  
  587.           ^X, ^Z :           {scroll down}
  588.             if CurC < MaxDisplay then begin
  589.               CurC := Succ(CurC);
  590.               if Curr >= LastRow then begin
  591.                 GoToXY(1, FirstRow);
  592.                 DelLine;
  593.                 DisplayCommand(OrderMap[CurC], LastRow);
  594.                 TopC := Succ(TopC);
  595.               end else
  596.                 Curr := Succ(Curr);
  597.             end;
  598.  
  599.           ^S :               {move to secondary}
  600.             OnMain := True;
  601.  
  602.           ^D :               {move to primary}
  603.             OnMain := False;
  604.  
  605.           ^R :               {page up}
  606.             if CurC > 1 then begin
  607.               OldTopC := TopC;
  608.               R := FirstRow;
  609.               while (CurC > 1) and (R < LastRow) do begin
  610.                 CurC := Pred(CurC);
  611.                 Curr := Pred(Curr);
  612.                 if Curr < FirstRow then begin
  613.                   TopC := CurC;
  614.                   Curr := FirstRow;
  615.                 end;
  616.                 R := Succ(R);
  617.               end;
  618.               if TopC <> OldTopC then
  619.                 DrawFullPage(TopC);
  620.             end;
  621.  
  622.           ^C :               {page down}
  623.             if CurC < MaxDisplay then begin
  624.               R := FirstRow;
  625.               OldTopC := TopC;
  626.               while (CurC < MaxDisplay) and (R < LastRow) do begin
  627.                 Curr := Succ(Curr);
  628.                 CurC := Succ(CurC);
  629.                 if Curr > LastRow then begin
  630.                   TopC := Succ(TopC);
  631.                   Curr := LastRow;
  632.                 end;
  633.                 R := Succ(R);
  634.               end;
  635.               if TopC <> OldTopC then
  636.                 DrawFullPage(TopC);
  637.             end;
  638.  
  639.           ^T :               {home}
  640.             if CurC > 1 then begin
  641.               CurC := 1;
  642.               TopC := 1;
  643.               Curr := FirstRow;
  644.               OnMain := True;
  645.               DrawFullPage(TopC);
  646.             end;
  647.  
  648.           ^B :               {end}
  649.             if CurC < MaxDisplay then begin
  650.               Curr := FirstRow;
  651.               CurC := MaxDisplay;
  652.               while Curr < LastRow do begin
  653.                 Curr := Succ(Curr);
  654.                 CurC := Pred(CurC);
  655.               end;
  656.               TopC := CurC;
  657.               DrawFullPage(TopC);
  658.               CurC := MaxDisplay;
  659.               OnMain := False;
  660.             end;
  661.  
  662.           'R' :              {restore all defaults}
  663.             begin
  664.               Commands := OrigCommands;
  665.               DrawFullPage(TopC);
  666.             end;
  667.  
  668.           Escape :           {done}
  669.             Quitting := True;
  670.  
  671.         end;
  672.       until Quitting;
  673.     end;                     {EditCommands}
  674.  
  675.     procedure FastInstallCommands;
  676.       {-Prompt for commands one by one}
  677.     var
  678.       C : Integer;
  679.       StopNow : Boolean;
  680.       Ch : Char;
  681.  
  682.       procedure PromptFor(var keyset : KeyRec);
  683.         {-get the new keyrec for main or alt}
  684.       var
  685.         K : KeyRec;
  686.  
  687.       begin                  {PromptFor}
  688.         K.Keys := '';
  689.         K.MinCol := WhereX;
  690.         K.MaxCol := WhereX+20;
  691.         if GetKeys(WhereY, K, StopNow) then
  692.           {new keystring returned}
  693.           with keyset do begin
  694.             Modified := True;
  695.             Conflict := False;
  696.             Keys := K.Keys;
  697.             DisplayKeys(ChColor, WhereY, K);
  698.         end else
  699.           {accepted default}
  700.           DisplayKeys(LoColor, WhereY, K);
  701.         WriteLn;
  702.       end;                   {PromptFor}
  703.  
  704.     begin                    {FastInstallCommands}
  705.       WriteLn;
  706.       WriteLn('Press <Enter> to accept default');
  707.       WriteLn('Press keys followed by <Enter> for new key sequence');
  708.       WriteLn('Press <Bksp> to back up one keystroke, C to Clear, R to Restore');
  709.       WriteLn('Press <ScrollLock> to toggle literal mode');
  710.       WriteLn('Press <Escape> to quit entering commands');
  711.       WriteLn('Random access editing is available when you are finished');
  712.       WriteLn;
  713.       C := 1;
  714.       StopNow := False;
  715.       while not(StopNow) and (C <= MaxDisplay) do begin
  716.         with Commands[OrderMap[C]] do begin
  717.           Write(Pad(Name, 26), '( Primary ): ', Pad(TextRepresentation(Main), 18), ' ');
  718.           PromptFor(Main);
  719.           if not(StopNow) then begin
  720.             Write(Pad(Name, 26), '(Secondary): ', Pad(TextRepresentation(Alt), 18), ' ');
  721.             PromptFor(Alt);
  722.           end;
  723.         end;
  724.         repeat
  725.           C := Succ(C);
  726.         until (C > MaxDisplay) or (OrderMap[C] <> CmdNull);
  727.       end;
  728.       WriteLn;
  729.       Write('Press a key to invoke full screen key editor ');
  730.       Ch := ReadKey;
  731.     end;                     {FastInstallCommands}
  732.  
  733.     function CheckCommands(var Commands : CommandList) : Boolean;
  734.       {-Return true if no duplicate commands are found, else complain}
  735.     var
  736.       FCmd, TCmd : CommandType;
  737.       Ok : Boolean;
  738.       Cnt : Integer;
  739.       CntStr : VarString;
  740.  
  741.       function Conflicting(FCmd, TCmd : CommandType) : Boolean;
  742.         {-return true, and set appropriate flags if any conflict}
  743.       var
  744.         FMain, Falt, TMain, TAlt : KeyString;
  745.         Ok : Boolean;
  746.  
  747.       begin                  {Conflicting}
  748.         Ok := True;
  749.         with Commands[FCmd] do begin
  750.           FMain := Main.Keys;
  751.           Falt := Alt.Keys;
  752.         end;
  753.         with Commands[TCmd] do begin
  754.           TMain := Main.Keys;
  755.           TAlt := Alt.Keys;
  756.         end;
  757.         if FMain <> '' then begin
  758.           if Pos(FMain, TMain) = 1 then begin
  759.             Ok := False;
  760.             Commands[FCmd].Main.Conflict := True;
  761.             Commands[TCmd].Main.Conflict := True;
  762.           end;
  763.           if Pos(FMain, TAlt) = 1 then begin
  764.             Ok := False;
  765.             Commands[FCmd].Main.Conflict := True;
  766.             Commands[TCmd].Alt.Conflict := True;
  767.           end;
  768.         end;
  769.         if TMain <> '' then begin
  770.           if Pos(TMain, FMain) = 1 then begin
  771.             Ok := False;
  772.             Commands[TCmd].Main.Conflict := True;
  773.             Commands[FCmd].Main.Conflict := True;
  774.           end;
  775.           if Pos(TMain, Falt) = 1 then begin
  776.             Ok := False;
  777.             Commands[TCmd].Main.Conflict := True;
  778.             Commands[FCmd].Alt.Conflict := True;
  779.           end;
  780.         end;
  781.         if TAlt <> '' then begin
  782.           if Pos(TAlt, FMain) = 1 then begin
  783.             Ok := False;
  784.             Commands[TCmd].Alt.Conflict := True;
  785.             Commands[FCmd].Main.Conflict := True;
  786.           end;
  787.           if Pos(TAlt, Falt) = 1 then begin
  788.             Ok := False;
  789.             Commands[TCmd].Alt.Conflict := True;
  790.             Commands[FCmd].Alt.Conflict := True;
  791.           end;
  792.         end;
  793.         if Falt <> '' then begin
  794.           if Pos(Falt, TMain) = 1 then begin
  795.             Ok := False;
  796.             Commands[FCmd].Alt.Conflict := True;
  797.             Commands[TCmd].Main.Conflict := True;
  798.           end;
  799.           if Pos(Falt, TAlt) = 1 then begin
  800.             Ok := False;
  801.             Commands[FCmd].Alt.Conflict := True;
  802.             Commands[TCmd].Alt.Conflict := True;
  803.           end;
  804.         end;
  805.         Conflicting := not(Ok);
  806.       end;                   {Conflicting}
  807.  
  808.     begin                    {CheckCommands}
  809.       {Provide some reassurance}
  810.       ClrEol(1, 1, LoColor);
  811.       EdFastWrite('Checking for conflicts....', 1, 1, LoColor);
  812.  
  813.       {Reset previous conflicts}
  814.       FCmd := MinCmd;
  815.       while FCmd <= CmdAbort do begin
  816.         with Commands[FCmd] do begin
  817.           Main.Conflict := False;
  818.           Alt.Conflict := False;
  819.         end;
  820.         FCmd := Succ(FCmd);
  821.       end;
  822.  
  823.       FCmd := MinCmd;
  824.       Ok := True;
  825.       Cnt := 0;
  826.  
  827.       while FCmd <= CmdAbort do begin
  828.         {Keep status going}
  829.         Cnt := Succ(Cnt);
  830.         Str(Cnt:4, CntStr);
  831.         EdFastWrite(CntStr, 1, 28, LoColor);
  832.  
  833.         {Don't waste space on duplicate commands}
  834.         with Commands[FCmd] do
  835.           if Main.Keys = Alt.Keys then begin
  836.             Alt.Keys := '';
  837.             Alt.Conflict := False;
  838.             Alt.Modified := False;
  839.           end;
  840.  
  841.         if Commands[FCmd].Main.Modified or Commands[FCmd].Alt.Modified then begin
  842.           {Now compare for conflicts}
  843.           TCmd := MinCmd;
  844.           while TCmd <= CmdAbort do begin
  845.             if (TCmd <> FCmd) then
  846.               if Conflicting(FCmd, TCmd) then
  847.                 Ok := False;
  848.             TCmd := Succ(TCmd);
  849.           end;
  850.         end;
  851.  
  852.         FCmd := Succ(FCmd);
  853.  
  854.       end;
  855.       ClrEol(1, 1, LoColor);
  856.       CheckCommands := Ok;
  857.     end;                     {CheckCommands}
  858.  
  859.     procedure PackCommands(var Commands : CommandList;
  860.                            var PackedCommands : PackedCommandList;
  861.                            var CmdLen : Integer);
  862.       {-Rebuild the packed command structure}
  863.     var
  864.       C : CommandType;
  865.       Len : Byte;
  866.  
  867.     begin                    {PackCommands}
  868.       CmdLen := 0;
  869.       FillChar(PackedCommands, SizeOf(PackedCommands), 0);
  870.       C := MinCmd;
  871.       while C <= CmdAbort do begin
  872.         with Commands[C] do begin
  873.           if Main.Keys <> '' then begin
  874.             Len := Ord(Main.Keys[0]);
  875.             Move(Main.Keys, PackedCommands[CmdLen], Succ(Len));
  876.             PackedCommands[Succ(CmdLen+Len)] := Chr(Ord(C));
  877.             CmdLen := CmdLen+Len+2;
  878.           end;
  879.           if Alt.Keys <> '' then begin
  880.             Len := Ord(Alt.Keys[0]);
  881.             Move(Alt.Keys, PackedCommands[CmdLen], Succ(Len));
  882.             PackedCommands[Succ(CmdLen+Len)] := Chr(Ord(C));
  883.             CmdLen := CmdLen+Len+2;
  884.           end;
  885.         end;
  886.         C := Succ(C);
  887.       end;
  888.       {Pad with zeros}
  889.       CmdLen := CmdLen+4;
  890.     end;                     {PackCommands}
  891.  
  892.   begin
  893.  
  894.     ClrScr;
  895.  
  896.     {command with the lowest ordinal}
  897.     MinCmd := CmdLeftChar;
  898.  
  899.     InitializeScreen;
  900.     GoToXY(1, 3);
  901.  
  902.     KeyOfs := FindKeys(PackedCommands, CmdsRead);
  903.  
  904.     InitializeCommands(Commands);
  905.     ParsePackedCommands(PackedCommands, Commands);
  906.     OrigCommands := Commands;
  907.  
  908.     if YesNo('Perform fast entry of fully reconfigured keyboard?', 'N') then
  909.       {Sequential installation}
  910.       FastInstallCommands;
  911.  
  912.     InitializeScreen;
  913.  
  914.     Quitting := False;
  915.     repeat
  916.  
  917.       {Random access editing}
  918.       EditCommands;
  919.       SetColor(LoColor);
  920.       ClrEol(1, 1, LoColor);
  921.       ClrEol(1, 2, LoColor);
  922.       GoToXY(1, 1);
  923.  
  924.       Ch := Getkey('W to install keyboard, Q to quit: ', 'WQ');
  925.       Write(Ch);
  926.       GoToXY(1, 1);
  927.       case Ch of
  928.         'W' :
  929.           begin
  930.             Wrote := True;
  931.             if CheckCommands(Commands) then
  932.               Quitting := True
  933.             else begin
  934.               ClrEol(1, 1, EdColor);
  935.               EdFastWrite('Command conflicts found and marked. Press a key to correct...', 1, 1, EdColor);
  936.               Ch := ReadKey;
  937.               Center(1, TiColor, Title);
  938.             end;
  939.           end;
  940.         'Q' :
  941.           begin
  942.             Wrote := False;
  943.             Quitting := True;
  944.           end;
  945.       end;
  946.     until Quitting;
  947.  
  948.     if Wrote then begin
  949.       ClrEol(1, 1, LoColor);
  950.       EdFastWrite('Updating '+ProgName+'...', 1, 1, LoColor);
  951.       PackCommands(Commands, PackedCommands, CmdLen);
  952.       if not ModifyDefaults(KeyOfs, PackedCommands, CmdsRead) then
  953.         HaltError('Error writing to keyboard installation area');
  954.     end;
  955.  
  956.   end;                       {KeyInstall}
  957.