home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1993 #2 / Image.iso / wp / ew12b.zip / FILES1.ZIP / BEGINEND.PAS < prev    next >
Pascal/Delphi Source File  |  1993-07-03  |  8KB  |  259 lines
  1. {************************************************}
  2. {                                                }
  3. { E! for Windows                                 }
  4. { (c) - Patrick Philippot - 1992-1993            }
  5. {                                                }
  6. { Sample Extension DLL - version 1.1             }
  7. {                                                }
  8. { This DLL implements an extension to the        }
  9. { Check Brace function. The original function    }
  10. { doesn't take into account the BEGIN/END,       }
  11. { CASE/END or REPEAT/UNTIL pairs of the Pascal   }
  12. { language. If loaded, this DLL will extend the  }
  13. { search and find the above matching pairs.      }
  14. {                                                }
  15. {************************************************}
  16.  
  17. (*
  18. To use this DLL simply load it from the user menu or add its name to the
  19. list of autoloaded Extension DLLs by using the Autoload dialog box from
  20. the User Menu of EW. That's all. This extension cannot be executed because
  21. it only adds a hook to the CheckBrace function and exports no EWExecute
  22. function.
  23.  
  24. BEGINEND will check if the standard CheckBrace function failed and will try
  25. to find a BEGIN/END, CASE/END or REPEAT/UNTIL pair. BEGINEND will fail if the
  26. word at the cursor position doesn't belong to that list.
  27.  
  28. Once BEGINEND has been loaded, Ctrl H (default assignment) will trigger the
  29. CheckBrace function and pass along control to BEGINEND in case of failure.
  30.  
  31. BEGINEND works in both directions. If you set the cursor under BEGIN, CASE or
  32. REPEAT, it will search forward for END or UNTIL, otherwise if you set the
  33. cursor under UNTIL or END, it will look backward for a matching BEGIN, CASE
  34. or REPEAT.
  35.  
  36. Of course, nested pairs are ignored as well as keywords enclosed within
  37. comment braces.
  38.  
  39. BEGINEND uses the FuncExitHook provided by the EW API and some other API
  40. services giving information about the current Editor.
  41. *)
  42.  
  43. {$I compdir.inc}
  44. {$C MOVEABLE PRELOAD DISCARDABLE}
  45.  
  46. library BeginEnd;
  47.  
  48. uses WinTypes, EWApiImp, Strings;
  49.  
  50. {$I ewuser.inc}
  51.  
  52. var
  53.   SaveExit  : Pointer;
  54.   BufIndex,
  55.   LineIndex,
  56.   MaxIndex  : integer;
  57.   Len       : word;
  58.  
  59.  
  60. function SearchMatchingItem : boolean;
  61.  
  62. type
  63.   longrec = record
  64.     LoW, HiW : integer;
  65.   end;
  66.  
  67. const
  68.   MAXLEN = 255;
  69.  
  70. var
  71.   newch,
  72.   ch            : char;
  73.   CommentLevel  : integer;
  74.   XYPos         : longint;
  75.   PairCount     : word;
  76.   Linebuffer    : array[0..MAXLEN] of char;
  77.   bForward,
  78.   bDone         : boolean;
  79.  
  80.   function GetChar : char;
  81.  {-Retrieve characters from the text flow}
  82.   begin
  83.     if bForward then begin
  84.       Inc(BufIndex);
  85.       if BufIndex >= Len then begin
  86.         Inc(LineIndex);
  87.         if LineIndex <= MaxIndex then begin
  88.           while StrUpper(StrCopy(LineBuffer, EwGetLineAt(LineIndex)))[0] = #0 do begin
  89.             Inc(LineIndex);
  90.             if LineIndex > Maxindex then begin
  91.               GetChar := #0;
  92.               Exit;
  93.             end;
  94.           end;
  95.           Len := StrLen(LineBuffer);
  96.           BufIndex := 0;
  97.         end else begin
  98.           GetChar := #0;
  99.           Exit;
  100.         end;
  101.       end;
  102.     end else begin
  103.       Dec(BufIndex);
  104.       if BufIndex < 0 then begin
  105.         Dec(LineIndex);
  106.         if LineIndex >= 0 then begin
  107.           while StrUpper(StrCopy(LineBuffer, EwGetLineAt(LineIndex)))[0] = #0 do begin
  108.             Dec(LineIndex);
  109.             if LineIndex < 0 then begin
  110.               GetChar := #0;
  111.               Exit;
  112.             end;
  113.           end;
  114.           Len := StrLen(LineBuffer);
  115.           BufIndex := Pred(Len);
  116.         end else begin
  117.           GetChar := #0;
  118.           Exit;
  119.         end;
  120.       end;
  121.     end;
  122.     GetChar := LineBuffer[BufIndex];
  123.   end;
  124.  
  125.   function MatchPattern(ch : char) : boolean;
  126.  {-Verify if the word beginning at the cursor position match a list member}
  127.   var
  128.     MatchStr : array[0..6] of char;
  129.     MatchEnd : word;
  130.     P        : PChar;
  131.   const
  132.     Delimiters : set of char =
  133.       ['.', ' ', ',', ';', ':', '\', '/', '(', ')', '{', '}', '[', ']', '-'];
  134.   begin
  135.     MatchPattern := false;
  136.     if CommentLevel <> 0 then
  137.       Exit;
  138.     case ch of
  139.       'B' : StrCopy(MatchStr, 'BEGIN');
  140.       'R' : StrCopy(MatchStr, 'REPEAT');
  141.       'U' : StrCopy(MatchStr, 'UNTIL');
  142.       'C' : StrCopy(MatchStr, 'CASE');
  143.       'E' : StrCopy(MatchStr, 'END');
  144.     end;
  145.     MatchEnd := StrLen(MatchStr) + BufIndex;
  146.     P := StrPos(LineBuffer + BufIndex, MatchStr);
  147.     MatchPattern :=
  148.       (P <> nil)
  149.       and
  150.       (P - LineBuffer = BufIndex)
  151.       and
  152.       ((BufIndex = 0) or (LineBuffer[Pred(BufIndex)] in [' ', ';']))
  153.       and
  154.       ((MatchEnd = Len) or ((MatchEnd < Len) and (LineBuffer[MatchEnd] in Delimiters)));
  155.   end;
  156.  
  157. begin
  158.  {-Get current cursor position}
  159.   XYPos := EWGetCaretPos;
  160.   BufIndex := longrec(XYPos).LoW;
  161.   LineIndex := longrec(XYPos).HiW;
  162.  {-Get number of lines in current Editor}
  163.   MaxIndex := Pred(EWGetLineCount);
  164.  {-Get the current line}
  165.   StrUpper(StrCopy(LineBuffer, EwGetLineAt(LineIndex)));
  166.  {-Initialize search data}
  167.   Len := StrLen(LineBuffer);
  168.   CommentLevel := 0;
  169.   bDone := false;
  170.   bForward := Upcase(LineBuffer[BufIndex]) in ['B', 'C', 'R'];
  171.   if bForward then
  172.     Dec(BufIndex)
  173.   else
  174.     Inc(BufIndex);
  175.   SearchMatchingItem := false;
  176.   if not MatchPattern(GetChar) then
  177.     Exit
  178.   else
  179.     PairCount := 1;
  180.   repeat
  181.    {-Read character from text stream and update search variables}
  182.     ch := Upcase(GetChar);
  183.     case ch of
  184.       '{' : Inc(CommentLevel);
  185.       '}' : Dec(CommentLevel);
  186.       '(' : if bForward and (GetChar = '*') then
  187.               Inc(CommentLevel);
  188.       ')' : if not bForward and (GetChar = '*') then
  189.               Inc(CommentLevel);
  190.       '*' : begin
  191.               newch := GetChar;
  192.               if (bForward and (newch = ')')
  193.               or (not bForward and (newch = '('))) then
  194.                 Dec(CommentLevel)
  195.             end;
  196.       'B',
  197.       'R',
  198.       'C' : if MatchPattern(ch) then
  199.               if bForward then
  200.                 Inc(PairCount)
  201.               else
  202.                 Dec(PairCount);
  203.       'U',
  204.       'E' : if MatchPattern(ch) then
  205.               if bForward then
  206.                 Dec(PairCount)
  207.               else
  208.                 Inc(PairCount);
  209.     end;
  210.     if PairCount = 0 then begin
  211.    {-Nesting level returned to 0. A matching sequence has been found}
  212.       SearchMatchingItem := true;
  213.       EWGotoXY(BufIndex, LineIndex);
  214.       bDone := true;
  215.     end;
  216.   until bDone or (ch = #0);
  217.  {-See comments in FunctionExitHook}
  218.   if not bDone then
  219.     EWWriteMessage('No matching sequence found')
  220.   else
  221.     EWWriteMessage(''); {-Clear previous error messages}
  222.   SearchMatchingItem := bDone;
  223. end;
  224.  
  225. function FuncExitHook(command : word; pRetCode : PInteger) : integer; export;
  226. {-Check whether the CheckBrace function succeeded.}
  227. { If not, call SearchMatchingItem}
  228. begin
  229.   FuncExitHook := 0;
  230.  {-Although the present version of the EW API doesn't check the return code}
  231.  { from the FuncExitHook functions, it is good practice to set this value  }
  232.  { to 0.}
  233.   if (command = ew_CheckBrace) and (pRetcode^ <> 0) then
  234.     if SearchMatchingItem then
  235.       pRetcode^ := 0 {-Success. Overwrite error code returned by CheckBrace}
  236.     else
  237.       pRetcode^ := ewerr_EXTFAILED; {-Unique exit code signaling that the}
  238.                                     { extension function failed.}
  239.   {-You may also leave pRetcode^ unchanged and let EW display its usual }
  240.   { message. In that case EW would issue no message at all, so it's pre-}
  241.   { ferable to handle this ourselves.}
  242.  
  243. end;
  244.  
  245. procedure LibExit; far;
  246. begin
  247.   EWRemoveHook(EWHook_FunctionExit, @FuncExitHook);
  248.   ExitProc := SaveExit;
  249. end;
  250.  
  251. exports
  252.   FuncExitHook   index 1;
  253.  
  254. begin
  255.   EWSetHook(EWHook_FunctionExit, @FuncExitHook);
  256.   SaveExit := ExitProc;
  257.   ExitProc := @LibExit;
  258. end.
  259.