Liren Large Software Subsidy 16/16.iso/w/w048/2.ddi/MSSRC.ARC/MSDIR.PAS

Pascal/Delphi Source File | 1987-12-21 | 17.8 KB | 575 lines

{                            MSDIR.PAS
                               MS 4.0
                Copyright (c) 1985, 87 by Borland International, Inc.         }

{$I msdirect.inc}

unit MsDir;
  {-Handle directory picking for MicroStar}

interface

uses
  Crt,                       {Basic video operations - standard unit}
  Dos,                       {DOS interface - standard unit}
  Errors,                    {Runtime error handler}
  MsVars,                    {Global types and declarations}
  MsScrn1,                   {Fast screen writing routines}
  MsString,                  {String primitives}
  MsPtrOp,                   {Pointer primitives}
  EscSeq,                    {Returns text string for extended scan codes}
  MsCmds,                    {Maps keystrokes to commands}
  Int24,                     {DOS critical error handler}
  Message,                   {Message system}
  MsUser,                    {User keyboard input, line edit, error report, help}
  MsMemOp,                   {Text buffer allocation and deallocation}
  MsBack,                    {Background processes}
  MsScrn2,                   {Editor screen updating}
  MsMenu;                    {Popup menus}

function EdPickdir(Mask : Filepath;
                   Msgno : Integer;
                   Attr : Byte;
                   ReturnFile : Boolean) : Filepath;
  {-Return a file name, or just browse, via a popup directory}

  {==========================================================================}

implementation

const
  AbsMaxFiles = 500;         {Absolute maximum number of files displayed in a directory}

type
  FileArray = array[1..AbsMaxFiles] of Filename; {Array used for sorting file directories}
  FileArrayPtr = ^FileArray;

var
  Fname : FileArrayPtr;      {Pointer to sorted array of filenames}
  Frec : SearchRec;          {File record returned by DOS unit}


  procedure EdWriteEntry(var W : WindowRec; Num : Integer; Row, Attr : Byte);
    {-Write one directory entry to the screen}

  begin                      {EdWriteEntry}
    with W do
      EdFastWrite(EdPadEntry(Fname^[Num], XSize-2), YPosn+Row, Succ(XPosn), Attr);
  end;                       {EdWriteEntry}

  procedure EdDrawFullPage(var W : WindowRec; Num, Lines : Integer);
    {-Draw one full window full of entries, starting at entry num}
  var
    I : Integer;

  begin                      {EdDrawFullPage}
    for I := 1 to Lines do
      EdWriteEntry(W, Pred(Num+I), I, ScreenAttr[MnColor]);
  end;                       {EdDrawFullPage}

  procedure EdShowUpDownArrows(var W : WindowRec; Num, MinRow, MaxRow : Integer);
    {-Indicate that other entries are off ends of menu}
  var
    Ch : Char;

  begin                      {EdShowUpDownArrows}
    with W do begin
      if Num > MinRow then
        {More words are above top of window}
        Ch := ^X
      else
        Ch := Blank;
      EdFastWrite(Ch, Pred(YPosn+YSize), XPosn+XSize-13, ScreenAttr[MfColor]);
      if Num < MaxRow then
        {More words are below bottom of window}
        Ch := ^Y
      else
        Ch := Blank;
      EdFastWrite(Ch, Pred(YPosn+YSize), XPosn+XSize-12, ScreenAttr[MfColor]);
    end;
  end;                       {EdShowUpDownArrows}

  function EdPickDirectory(var W : WindowRec;
                           TotalFiles : Integer;
                           Mask : Filepath) : Filepath;
    {-Browse and return full Filepath of selected file}
  var
    OldNum, Num : Integer;
    Row, Lines, Newrow : Byte;
    Ch : Char;
    Quitting : Boolean;

    function EdFullFilepath(Mask : Filepath; Fname : Filename) : Filepath;
      {-Return a Filepath combining mask and fname}

    begin                    {EdFullFilepath}
      {Avoid attachment of default extension}
      if Pos(Period, Fname) = 0 then
        Fname := Fname+Period;
      if EdHasWildCards(Mask) then
        {Remove trailing wildcard}
        while not(EdDosPathDelim(Mask[Length(Mask)])) do
          Dec(Mask[0]);
      EdFullFilepath := EdAddTrailingBackslash(Mask)+Fname;
    end;                     {EdFullFilepath}

    procedure EdScanFiles(MatchChar : Char; var Num : Integer);
      {-Scan through the file list until the name matches or exceeds the match string}

    begin                    {EdScanFiles}
      if Fname^[Num] [1] < MatchChar then
        {Scan forward}
        while (Num < TotalFiles) and (Fname^[Num] [1] < MatchChar) do
          Inc(Num)
      else if Fname^[Num] [1] > MatchChar then
        {Scan backward}
        while (Num > 1) and (Fname^[Num] [1] > MatchChar) do
          Dec(Num);
    end;                     {EdScanFiles}

  begin                      {EdPickDirectory}
    with W do begin

      if TotalFiles <= 0 then begin

        {Display message and wait for <Esc>}
        for Num := 1 to 3 do
          EdFastWrite(EdGetMessage(30+Num), YPosn+Num, XPosn+2, ScreenAttr[MnColor]);
        repeat
          Ch := EdGetAnyChar;
        until Abortcmd or (Ch = #27);
        {Clear keyboard buffer}
        EdClearBuffer;
        EdPickDirectory := '';

      end else begin

        Lines := YSize-2;
        Num := 1;
        Row := 1;
        EdDrawFullPage(W, Num, Lines);
        Quitting := False;

        repeat

          {Highlight the selected entry}
          EdWriteEntry(W, Num, Row, ScreenAttr[MsColor]);

          if TotalFiles > Lines then
            {Indicate that other entries are off ends of menus}
            EdShowUpDownArrows(W, Num, Row, TotalFiles+Row-Lines);

          Ch := EdGetCursorCommand(DirCmdSet);
          case Ch of

            ^M :             {Select}
              Quitting := True;

            ^[ :             {Escape}
              begin
                Num := 0;
                Quitting := True;
              end;

            '0'..'9', 'A'..'Z',
            '!', '#'..')', '-',
            '@', '^'..'`', '{',
            '}', '~' :       {Scan for character}
              begin
                OldNum := Num;
                EdScanFiles(Ch, Num);
                if Num <> OldNum then begin
                  Newrow := Row+Num-OldNum;
                  if Newrow > Lines then begin
                    {Off bottom of list}
                    if Lines <= (TotalFiles-Num) then begin
                      Row := 1;
                      EdDrawFullPage(W, Num, Lines);
                    end else begin
                      EdDrawFullPage(W, Succ(TotalFiles-Lines), Lines);
                      Row := Lines-(TotalFiles-Num);
                    end;
                  end else if Newrow < 1 then begin
                    {Off top of list}
                    Row := 1;
                    EdDrawFullPage(W, Num, Lines);
                  end else begin
                    {On current screen}
                    EdWriteEntry(W, OldNum, Row, ScreenAttr[MnColor]);
                    Row := Newrow;
                  end;
                end;
              end;

            ^E :             {Scroll up}
              if Num > 1 then begin
                EdWriteEntry(W, Num, Row, ScreenAttr[MnColor]);
                Dec(Num);
                if Row = 1 then begin
                  GoToXY(1, 1);
                  InsLine;
                end else
                  Dec(Row);
              end else if Lines >= TotalFiles then begin
                {Wrap to end}
                Num := TotalFiles;
                Row := TotalFiles;
                EdDrawFullPage(W, Succ(Num-Row), Lines);
              end;

            ^X :             {Scroll down}
              if Num < TotalFiles then begin
                EdWriteEntry(W, Num, Row, ScreenAttr[MnColor]);
                Inc(Num);
                if Row >= Lines then begin
                  GoToXY(1, 1);
                  DelLine;
                  Row := Lines;
                end else
                  Inc(Row);
              end else if Lines >= TotalFiles then begin
                {Wrap to begin}
                Num := 1;
                Row := 1;
                EdDrawFullPage(W, Num, Lines);
              end;

            ^R :             {Page up}
              if Num > 1 then begin
                if Num > Lines then
                  Num := Num-Lines
                else
                  Num := 1;
                Row := 1;
                EdDrawFullPage(W, Num, Lines);
              end;

            ^C :             {Page down}
              if Num < TotalFiles then begin
                Num := Num+Lines;
                if Num > TotalFiles then
                  Num := TotalFiles;
                Row := Lines;
                EdDrawFullPage(W, Succ(Num-Row), Lines);
              end;

            ^T :             {Top of list}
              if Num > 1 then begin
                Num := 1;
                Row := 1;
                EdDrawFullPage(W, Num, Lines);
              end;

            ^B :             {Bottom of list}
              if Num < TotalFiles then begin
                Num := TotalFiles;
                Row := Lines;
                EdDrawFullPage(W, Succ(Num-Row), Lines);
              end;

          end;
        until Abortcmd or Quitting;

        if Abortcmd or (Num = 0) then
          EdPickDirectory := ''
        else
          EdPickDirectory := EdFullFilepath(Mask, Fname^[Num]);

      end;
    end;
  end;                       {EdPickDirectory}

  procedure EdBrowseDirectory(var W : WindowRec;
                              TotalFiles : Integer);
    {-Browse file directory}
  var
    LastNum, Num : Integer;
    Lines : Byte;
    Ch : Char;
    Quitting : Boolean;

  begin                      {EdBrowseDirectory}
    with W do begin

      if TotalFiles <= 0 then begin

        for Num := 1 to 3 do
          EdFastWrite(EdGetMessage(30+Num), YPosn+Num, XPosn+2, ScreenAttr[MnColor]);
        repeat
          Ch := EdGetAnyChar;
        until Abortcmd or (Ch = #27);
        EdClearBuffer;

      end else begin

        Lines := YSize-2;
        Num := 1;
        LastNum := Succ(TotalFiles-Lines);
        EdDrawFullPage(W, Num, Lines);
        Quitting := False;

        repeat

          if TotalFiles > Lines then
            {Indicate that other entries are off ends of menu}
            EdShowUpDownArrows(W, Num, 1, LastNum);

          case EdGetCursorCommand(DirCmdSet) of

            ^M, ^[ :         {Select, Escape}
              Quitting := True;

            ^E :             {Scroll up}
              if Num > 1 then begin
                Dec(Num);
                GoToXY(1, 1);
                InsLine;
                EdWriteEntry(W, Num, 1, ScreenAttr[MnColor]);
              end;

            ^X :             {Scroll down}
              if Num < LastNum then begin
                Inc(Num);
                GoToXY(1, 1);
                DelLine;
                EdWriteEntry(W, Pred(Num+Lines), Lines, ScreenAttr[MnColor]);
              end;

            ^R :             {Page up}
              if Num > 1 then begin
                if Num > Lines then
                  Num := Num-Lines
                else
                  Num := 1;
                EdDrawFullPage(W, Num, Lines);
              end;

            ^C :             {Page down}
              if Num < LastNum then begin
                Num := Num+Lines;
                if Num > LastNum then
                  Num := LastNum;
                EdDrawFullPage(W, Num, Lines);
              end;

            ^T :             {Top of list}
              if Num > 1 then begin
                Num := 1;
                EdDrawFullPage(W, Num, Lines);
              end;

            ^B :             {Bottom of list}
              if Num < LastNum then begin
                Num := LastNum;
                EdDrawFullPage(W, Num, Lines);
              end;

          end;
        until Abortcmd or Quitting;

      end;
    end;
  end;                       {EdBrowseDirectory}

  function EdPickdir(Mask : Filepath;
                     Msgno : Integer;
                     Attr : Byte;
                     ReturnFile : Boolean) : Filepath;
    {-Return a file name, or just browse, via a popup directory}
  label
    ExitPoint;
  const
    FilesPerPage = 17;
  var
    MaxFiles, TotalFiles : Integer;
    Wid, Len : Byte;
    UsePopup : Boolean;
    Title : VarString;
    W : WindowRec;

    function EdGetFileOK(GetFirst : Boolean;
                         Mask : Filepath;
                         Attr : Byte;
                         var TotalFiles : Integer) : Boolean;
      {-Read entry in DOS directory}

    begin                    {EdGetFileOK}

      {Call the DOS unit to get the directory entry}
      if GetFirst then
        findfirst(Mask, Attr, Frec)
      else
        findnext(Frec);

      if hi(EdINT24Result) <> 0 then begin
        {DOS critical error}
        EdGetFileOK := False;
        TotalFiles := 0;
        EdErrormsg(128);
      end else if (doserror <> 0) or (TotalFiles >= MaxFiles) then
        {No more files}
        EdGetFileOK := False
      else begin
        {Filter directories vs. normal files}
        if (Frec.Attr and 16) = (Attr and 16) then begin
          Inc(TotalFiles);
          Fname^[TotalFiles] := Frec.name;
        end;
        EdGetFileOK := True;
      end;
    end;                     {EdGetFileOK}

    procedure EdGetDirectory(Mask : Filepath;
                             Attr : Byte;
                             var TotalFiles : Integer);
      {-Return a sorted array filled with files matching mask}

      procedure EdSortDirectory(TotalFiles : Integer);
        {-Shellsort the directory entries}
      var
        Offset, I, J, K : Integer;
        InOrder : Boolean;
        Tmp : Filename;

        function EdSortKeyLess(var F1, F2 : Filename) : Boolean;
          {-Compare the sort keys for f1 and f2}
          {Replace function for other sort orders}

        begin                {EdSortkeyLess}
          EdSortKeyLess := (F1 < F2);
        end;                 {EdSortKeyLess}

      begin                  {EdSortDirectory}
        Offset := TotalFiles;
        while Offset > 1 do begin
          Offset := Offset shr 1;
          repeat
            InOrder := True;
            K := TotalFiles-Offset;
            for J := 1 to K do begin
              I := J+Offset;
              if EdSortKeyLess(Fname^[I], Fname^[J]) then begin
                {Swap names}
                Tmp := Fname^[J];
                Fname^[J] := Fname^[I];
                Fname^[I] := Tmp;
                InOrder := False;
              end;
            end;
          until InOrder;
        end;
      end;                   {EdSortDirectory}

    begin                    {EdGetDirectory}

      {Initialize}
      TotalFiles := 0;

      {Read the directory}
      if EdGetFileOK(True, Mask, Attr, TotalFiles) then
        repeat
        until not(EdGetFileOK(False, Mask, Attr, TotalFiles));

      {Sort the directory}
      if TotalFiles > 0 then
        EdSortDirectory(TotalFiles);

    end;                     {EdGetDirectory}

  begin                      {EdPickDir}

    EdPickdir := '';

    {Allocate space for array of files, as many as will fit}
    if MaxAvail > AbsMaxFiles*SizeOf(Filename) then
      MaxFiles := AbsMaxFiles
    else begin
      MaxFiles := MaxAvail div SizeOf(Filename);
      if MaxFiles < 2 then begin
        EdErrormsg(35);
        Exit;
      end;
    end;
    if EdMemAvail(MaxFiles*SizeOf(Filename), FreeListTemp) then
      GetMem(Fname, MaxFiles*SizeOf(Filename))
    else begin
      EdErrormsg(35);
      Exit;
    end;

    {See if popup display is required}
    UsePopup := (Length(Mask) = 0) or EdHasWildCards(Mask);

    if (Attr = 0) and not(UsePopup) then begin
      {See if a subdirectory name is specified}
      TotalFiles := 0;
      if EdGetFileOK(True, EdAddTrailingBackslash(Mask)+'*.*', 0, TotalFiles) then begin
        Mask := EdAddTrailingBackslash(Mask);
        UsePopup := True;
      end;
      if Goterror then
        goto ExitPoint;
    end;

    if not(ReturnFile) or UsePopup then begin

      {Prompt to use the pick function}
      EdEraseMenuHelp;
      EdWritePromptLine(EdGetMessage(Msgno));

      {Add default wildcard}
      if EdDosPathDelim(Mask[Length(Mask)]) then
        Mask := Mask+'*.*';

      {Read directory}
      EdGetDirectory(Mask, Attr, TotalFiles);
      if Goterror then
        goto ExitPoint;

      {Set up a new window for the directory display}
      Title := Blank+Mask+Blank;
      Wid := Length(Title)+2;
      if Wid < 16 then
        Wid := 16;
      if TotalFiles <= 0 then
        Len := 3
      else if TotalFiles < FilesPerPage then
        Len := TotalFiles
      else
        Len := FilesPerPage;
      EdSaveTextWindow(Border, Title, 20, 6, 20+Wid, 7+Len, W);

      if TotalFiles > FilesPerPage then
        {Indicate that more files are available}
        with W do begin
          Title := EdGetMessage(263);
          EdFastWrite(Title, Pred(YPosn+YSize), XPosn+XSize-14, ScreenAttr[MfColor]);
        end;

      if ReturnFile then
        {Browse directory and return the selected file name}
        EdPickdir := EdPickDirectory(W, TotalFiles, Mask)
      else begin
        {Scroll through the directory}
        EdPickdir := '';
        EdBrowseDirectory(W, TotalFiles);
      end;

      {Restore screen}
      EdRestoreTextWindow(W);
      if EdPtrIsNil(CurrMenu) then
        EdShowMenuHelp;
      EdZapPromptLine;

    end else
      {Return the input filename}
      EdPickdir := Mask;

ExitPoint:
    {Deallocate space for array of files}
    FreeMem(Fname, MaxFiles*SizeOf(Filename));

  end;                       {EdPickDir}

end.