home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 9 / CD_ASCQ_09_1193.iso / news / 557 / anedit / ae4.pas < prev    next >
Pascal/Delphi Source File  |  1993-03-24  |  38KB  |  900 lines
  1. UNIT AE4 ;
  2.  
  3. {$R-}
  4. {$B-}
  5. {$I-}
  6. {$S+}
  7. {$V-}
  8.  
  9. INTERFACE
  10.  
  11. USES Crt, Dos, Printer, AE0, AE1, AE2, AE3 ;
  12.  
  13. FUNCTION CopyBlock : BOOLEAN ;
  14. PROCEDURE DeleteBlock ;
  15. FUNCTION InsertBlock : BOOLEAN ;
  16. PROCEDURE PrintBlock (Buffer : WsBufptr ; BlockStart, BlockEnd : WORD ) ;
  17. PROCEDURE InsertFile (Filename : PathStr; P : Position) ;
  18. PROCEDURE LoadFile (Filename : PathStr) ;
  19. PROCEDURE GetFileFromList (VAR Name : PathStr) ;
  20. PROCEDURE InsertSpaces (VAR P : Position ; NrOfSpaces : WORD) ;
  21. PROCEDURE InsertCRLF (VAR P : Position) ;
  22. PROCEDURE RedrawScreen ;
  23. PROCEDURE AlterSetup ;
  24. PROCEDURE FormatParagraph (VAR P : position) ;
  25.  
  26. IMPLEMENTATION
  27.  
  28. {-----------------------------------------------------------------------------}
  29. { Copies the block in the current workspace to the paste buffer. If no block  }
  30. { is indicated or if the block is too large for the paste buffer, an error    }
  31. { message is given, and the function result will be False.                    }
  32. {-----------------------------------------------------------------------------}
  33.  
  34. FUNCTION CopyBlock : BOOLEAN ;
  35.  
  36. VAR Result : BOOLEAN ;
  37.  
  38. BEGIN
  39. Result := FALSE ;
  40. WITH CurrentWs DO
  41.      BEGIN
  42.      IF (MARK > 0)
  43.         THEN BEGIN
  44.              IF MARK < CurPos.Index
  45.                 THEN BEGIN
  46.                      IF (CurPos.Index - MARK) > PasteBufSize
  47.                         THEN ErrorMessage (4)
  48.                         ELSE BEGIN
  49.                              PasteBufferSize := CurPos.Index - MARK ;
  50.                              MOVE (Buffer^ [MARK], PasteBuffer^ [1],
  51.                                    PasteBufferSize) ;
  52.                              Result := TRUE ;
  53.                              END ;
  54.                      END
  55.                 ELSE BEGIN
  56.                      IF (MARK - CurPos.Index) > PasteBufSize
  57.                         THEN ErrorMessage (4)
  58.                         ELSE BEGIN
  59.                              PasteBufferSize := MARK - CurPos.Index ;
  60.                              MOVE (Buffer^ [CurPos.Index], PasteBuffer^ [1],
  61.                                    PasteBufferSize) ;
  62.                              Result := TRUE ;
  63.                              END ;
  64.                      END ;
  65.              END
  66.         ELSE ErrorMessage (5) ;
  67.      END ; { of with }
  68. CopyBlock := Result ;
  69. END ;
  70.  
  71. {-----------------------------------------------------------------------------}
  72. { Deletes the block from the current workspace.                               }
  73. {-----------------------------------------------------------------------------}
  74.  
  75. PROCEDURE DeleteBlock ;
  76.  
  77. VAR OldCurPosIndex : WORD ;
  78.  
  79. BEGIN
  80. WITH CurrentWs DO
  81.      BEGIN
  82.      IF MARK > 0
  83.         THEN BEGIN
  84.              IF MARK < CurPos.Index
  85.                 THEN BEGIN
  86.                      { if Mark is before CurPos: exchange positions }
  87.                      OldCurPosIndex := CurPos.Index ;
  88.                      SkipUp (CurPos, OldCurPosIndex - MARK) ;
  89.                      MARK := OldCurPosIndex ;
  90.                      END ;
  91.              Shrink (CurPos.Index, MARK - CurPos.Index) ;
  92.              MARK := 0 ;
  93.              END ;
  94.      END ;
  95. END ;
  96.  
  97. {-----------------------------------------------------------------------------}
  98. { Inserts the contents of the paste buffer into the current workspace at      }
  99. { position CurPos. If successful, Mark will be pointing to the end of the     }
  100. { inserted block, and CurPos to the start. Function result indicates success. }
  101. {-----------------------------------------------------------------------------}
  102.  
  103. FUNCTION InsertBlock : BOOLEAN ;
  104.  
  105. BEGIN
  106. WITH CurrentWs DO
  107.      BEGIN
  108.      IF Grow (CurPos.Index, PasteBufferSize)
  109.         THEN BEGIN
  110.              MOVE (PasteBuffer^ [1], Buffer^ [CurPos.Index], PasteBufferSize) ;
  111.              InsertBlock := TRUE
  112.              END
  113.         ELSE InsertBlock := FALSE;
  114.      END ; { of with }
  115. END ;
  116.  
  117. {-----------------------------------------------------------------------------}
  118. { Dumps a block (indicated by BlockStart and BlockEnd) to the printer.        }
  119. { If enabled by Setup, form feeds, left and top margins and page numbers      }
  120. { are added.                                                                  }
  121. {-----------------------------------------------------------------------------}
  122.  
  123. PROCEDURE PrintBlock (Buffer : WsBufptr ; BlockStart, BlockEnd : WORD ) ;
  124.  
  125. VAR Counter, IndexCounter, LineCounter, PageCounter, LinesPerPage : WORD ;
  126.     DummyKey : WORD ;
  127.     AbortPrint : BOOLEAN ;
  128.  
  129. BEGIN
  130. { LinesPerPage contains number of text lines on a page }
  131. LinesPerPage := Config.Setup.PageLength ;
  132. IF Config.Setup.PrintPagenrs THEN DEC (LinesPerPage, 2) ;
  133. Message ('Printing. Press any key to interrupt') ;
  134. AbortPrint := FALSE ;
  135. IndexCounter := BlockStart ;
  136. PageCounter := 1 ;
  137. { write top margin of first page }
  138. FOR Counter := 1 TO Config.Setup.TopMargin DO
  139.     WRITELN (Lst) ;
  140. LineCounter := Config.Setup.TopMargin + 1 ;
  141. { write left margin of first line }
  142. WRITE (Lst, '' : Config.Setup.LeftMargin) ;
  143. REPEAT IF Buffer^ [IndexCounter] <> FF 
  144.           THEN WRITE (Lst, Buffer^ [IndexCounter]) ;
  145.        IF Buffer^ [IndexCounter] = LF
  146.           THEN BEGIN
  147.                INC (LineCounter) ;
  148.                { write left margin of new line }
  149.                WRITE (Lst, '' : Config.Setup.LeftMargin) ;
  150.                END ;
  151.        IF ( (LineCounter > LinesPerPage) AND (Config.Setup.PageLength > 0) ) OR
  152.           (Buffer^ [IndexCounter] = FF)
  153.           THEN BEGIN
  154.                { end current page and start new one }
  155.                IF Config.Setup.PrintPagenrs
  156.                   THEN BEGIN
  157.                        { print page number if desired }
  158.                        WHILE LineCounter <= (LinesPerPage + 2) DO
  159.                              BEGIN
  160.                              WRITELN (Lst) ;
  161.                              INC (LineCounter) ;
  162.                              END ;
  163.                        WRITE (Lst, '' : Config.Setup.LeftMargin,
  164.                                   'Pag ', PageCounter : 2) ;
  165.                        END ;
  166.                WRITE (Lst, FF) ;
  167.                INC (PageCounter) ;
  168.                { skip top margin }
  169.                FOR Counter := 1 TO Config.Setup.TopMargin DO
  170.                    WRITELN (Lst) ;
  171.                LineCounter := Config.Setup.TopMargin + 1 ;
  172.                { write left margin of first line }
  173.                WRITE (Lst, '' : Config.Setup.LeftMargin) ;
  174.                END ;
  175.        INC (IndexCounter) ;
  176.        CheckDiskError ;
  177.        AbortPrint := (DiskError <> 0) ;
  178.        IF KEYPRESSED
  179.           THEN BEGIN
  180.                ClearKeyBuffer ;
  181.                { ask for confirmation }
  182.                AbortPrint := Answer ('Abort printing?') ;
  183.                IF NOT AbortPrint
  184.                   THEN Message ('Printing. Press any key to interrupt') ;
  185.                END ;
  186. UNTIL (IndexCounter > BlockEnd) OR AbortPrint ;
  187. IF (Config.Setup.PrintPagenrs) AND (NOT KEYPRESSED)
  188.    THEN BEGIN
  189.         { end last page: move to end of page and print page number }
  190.         FOR Counter := LineCounter TO (LinesPerPage + 1) DO
  191.             WRITELN (Lst) ;
  192.         WRITE (Lst, 'Pag ', PageCounter : 2) ;
  193.         WRITE (Lst, FF) ;
  194.         CheckDiskError ;
  195.         END ;
  196. IF AbortPrint
  197.    THEN Message ('Printing aborted')
  198.    ELSE Message ('Printing completed') ;
  199. END ;
  200.  
  201. {-----------------------------------------------------------------------------}
  202. { Inserts the file <Filename> into the current workspace at position P.       }
  203. {-----------------------------------------------------------------------------}
  204.  
  205. PROCEDURE InsertFile (Filename : PathStr ; P : Position) ;
  206.  
  207. VAR F : FILE ;
  208.     Size, BytesToRead, AvailableSpace : LONGINT ;
  209.     BytesRead : WORD ;
  210.     Counter : WORD ;
  211.  
  212. BEGIN
  213. ASSIGN (F, Filename) ;
  214. RESET (F, 1) ;
  215. CheckDiskError ;
  216. IF (DiskError = 0)
  217.    THEN BEGIN
  218.         Size := FILESIZE (F) ;
  219.         WITH CurrentWs DO
  220.              BEGIN
  221.              BytesToRead := Size ;
  222.              AvailableSpace := WsBufSize - BufferSize ;
  223.              IF BytesToRead > AvailableSpace
  224.                 THEN BytesToRead := AvailableSpace ;
  225.              IF Grow (P.Index, BytesToRead)
  226.                 THEN BEGIN
  227.                      Message ('Reading file ' + Filename + ' ...') ;
  228.                      BLOCKREAD (F, Buffer^ [P.Index], BytesToRead, BytesRead) ;
  229.                      CheckDiskError ;
  230.                      MARK := P.Index + BytesRead ;
  231.                      { check for EndOfFile char }
  232.                      IF (Buffer^ [P.Index+BytesRead-1] = EF)
  233.                         THEN BEGIN
  234.                              { always delete if it is last char read }
  235.                              Shrink (P.Index+BytesRead-1, 1) ;
  236.                              Dec (BytesRead) ;
  237.                              END ;
  238.                      { check for other }
  239.                      Counter := P.Index ;
  240.                      WHILE (Buffer^ [Counter] <> EF) AND
  241.                            (Counter < (P.Index+BytesRead)) DO
  242.                            INC (Counter) ;
  243.                      { delete stuff after EOF char }
  244.                      IF (Counter < (P.Index+BytesRead)) AND
  245.                         (Answer ('Unexpected end-of-file encountered. ' +
  246.                                  'Truncate file?'))
  247.                         THEN Shrink (Counter,
  248.                                      BytesRead - (Counter - P.Index) ) ;
  249.                      Message ('') ;
  250.                      END ; { of if }
  251.              IF Size > BytesToRead
  252.                 THEN { warning: file too large to load completely }
  253.                      ErrorMessage (7) ;
  254.              CLOSE (F) ;
  255.              END ; { of with }
  256.         END ; { of if }
  257. END ; { of procedure }
  258.  
  259. {-----------------------------------------------------------------------------}
  260. { Loads the file <Filename> into the current workspace, resetting all         }
  261. { variables involved. If <Filename> is empty, then no file is loaded.         }
  262. {-----------------------------------------------------------------------------}
  263.  
  264. PROCEDURE LoadFile (Filename : PathStr) ;
  265.  
  266. BEGIN
  267. ClearCurrentWs ;
  268. IF LENGTH (FileName) > 0
  269.    THEN WITH CurrentWs DO
  270.              BEGIN
  271.              Name := FExpand (Filename) ;
  272.              InsertFile (Name, CurPos) ;
  273.              MARK := Inactive ;
  274.              ChangesMade := FALSE ;
  275.              END ;
  276. Workspace [CurrentWsnr] := CurrentWs ;
  277. END ;
  278.  
  279. {-----------------------------------------------------------------------------}
  280. { Displays a list with files, from which the user                             }
  281. { can then make a choice, using the cursor and Return keys.                   }
  282. { Cursor shape and position and screen contents are saved, and                }
  283. { restored on exit.                                                           }
  284. {-----------------------------------------------------------------------------}
  285.  
  286. PROCEDURE GetFileFromList (VAR Name : PathStr) ;
  287.  
  288. VAR OldXpos, OldYpos, OldCursorType, Counter : BYTE ;
  289.     OldAttr, NormAttr, SelectAttr : BYTE ;
  290.     OldDisplayContents : ScreenBlockPtr ;
  291.     SelectKey : WORD ;
  292.     FileList : ARRAY [1..MaxFileListLength] OF FilenameStr ;
  293.     FirstVisibleFile, SelectedFile, FileListLength : BYTE ;
  294.     SR : SearchRec ;
  295.     Mask : FilenameStr ;
  296.     Dir, OldCurrentDir : DirStr ;
  297.     Fname : NameStr ;
  298.     Fext : ExtStr ;
  299.  
  300. BEGIN
  301. GETDIR (0, OldCurrentDir) ;
  302. { split pathname into directory and mask }
  303. FSplit (FExpand (Name), Dir, Fname, Fext) ;
  304. Mask := Fname + Fext ;
  305. IF LENGTH (Dir) > 3
  306.    THEN DELETE (Dir, LENGTH (Dir), 1) ;
  307. CHDIR (Dir) ;
  308. CheckDiskError ;
  309. { save old screen settings }
  310. OldXpos := WHEREX ;
  311. OldYpos := WHEREY ;
  312. OldCursorType := GetCursor ;
  313. OldAttr := TextAttr ;
  314. { new screen settings }
  315. SetCursor (Inactive) ;
  316. NormAttr := ScreenColorArray [Config.Setup.ScreenColors].NormAttr ;
  317. SelectAttr := ScreenColorArray [Config.Setup.ScreenColors].BlockAttr ;
  318. TextAttr := NormAttr ;
  319. { save old screen contents and draw frame for file list }
  320. SaveArea (60, 2, 75, 23, OldDisplayContents) ;
  321. PutFrame (60, 2, 75, 23, Quasi3DFrame) ;
  322. ClearArea (61, 3, 74, 22) ;
  323. REPEAT Counter := 1 ;
  324.        Message ('Searching ...') ;
  325.        { build file list }
  326.        FINDFIRST (Mask, ReadOnly + Archive, SR) ;
  327.        WHILE (DosError = 0) AND (Counter < (MaxFileListLength - 1) ) DO
  328.              BEGIN
  329.              FileList [Counter] := SR.Name ;
  330.              FINDNEXT (SR) ;
  331.              INC (Counter) ;
  332.              END ;
  333.        { add directories }
  334.        FINDFIRST ('*.*', Directory, SR) ;
  335.        WHILE (DosError = 0) AND (Counter <= MaxFileListLength) DO
  336.              BEGIN
  337.              IF ( (SR.Attr AND Directory) <> 0) AND
  338.                 (SR.Name <> '.')
  339.                 THEN BEGIN
  340.                      FileList [Counter] := '»' + SR.Name ;
  341.                      INC (Counter) ;
  342.                      END ;
  343.              FINDNEXT (SR) ;
  344.              END ;
  345.        Message ('Select file with ,,PgUp, PgDn keys, or ' +
  346.                 'press first letter; Enter to load') ;
  347.        FileListLength := Counter - 1 ;
  348.        FirstVisibleFile := 1 ;
  349.        SelectedFile := 1 ;
  350.        REPEAT IF FirstVisibleFile > SelectedFile
  351.                  THEN FirstVisibleFile := SelectedFile ;
  352.               IF (SelectedFile - FirstVisibleFile) > 19
  353.                  THEN FirstVisibleFile := SelectedFile - 19 ;
  354.               FOR Counter := FirstVisibleFile TO (FirstVisibleFile + 19) DO
  355.                   BEGIN
  356.                   IF Counter = SelectedFile
  357.                      THEN TextAttr := SelectAttr
  358.                      ELSE TextAttr := NormAttr ;
  359.                   GOTOXY (61, Counter - FirstVisibleFile + 3) ;
  360.                   IF Counter <= FileListLength
  361.                      THEN WRITE (' ', FileList [Counter],
  362.                                  ' ' : (13 - LENGTH (FileList [Counter]) ) )
  363.                      ELSE WRITE (' ' : 14) ;
  364.                   END ;
  365.               SelectKey := ReadKeyNr ;
  366.               CASE SelectKey OF
  367.                    328 : { up    } IF SelectedFile > 1
  368.                                       THEN DEC (SelectedFile) ;
  369.                    336 : { down  } IF SelectedFile < FileListLength
  370.                                       THEN INC (SelectedFile) ;
  371.                    329 : { PgUp  } IF SelectedFile > 19
  372.                                       THEN DEC (SelectedFile, 19)
  373.                                       ELSE SelectedFile := 1 ;
  374.                    337 : { PgDn  } IF SelectedFile < (FileListLength - 19)
  375.                                       THEN INC (SelectedFile, 19)
  376.                                       ELSE SelectedFile := FileListLength ;
  377.                    388 : { ^PgUp } SelectedFile := 1 ;
  378.                    374 : { ^PgDn } SelectedFile := FileListLength ;
  379.                    32..127   : BEGIN
  380.                                { select by pressing first letter of name }
  381.                                Counter := SelectedFile + 1 ;
  382.                                WHILE (NOT ( (FileList [Counter] [1] =
  383.                                             UPCASE (CHR (SelectKey) ) ) OR
  384.                                            ( (FileList [Counter] [1] = '»') AND
  385.                                             (FileList [Counter] [2] =
  386.                                              UPCASE (CHR (SelectKey) ) ) ) ) )
  387.                                      AND
  388.                                      (Counter <= FileListLength)
  389.                                      DO INC (Counter) ;
  390.                                IF Counter <= FileListLength
  391.                                   THEN SelectedFile := Counter ;
  392.                                END ;
  393.                    ReturnKey : ;
  394.                    EscapeKey : EscPressed := TRUE ;
  395.                    ELSE        WarningBeep ; { invalid key }
  396.                    END ; { of case }
  397.        UNTIL (SelectKey = ReturnKey) OR EscPressed ;
  398.        IF (SelectKey = ReturnKey) AND (FileList [SelectedFile] [1] = '»')
  399.           THEN CHDIR (COPY (FileList [SelectedFile], 2, 8) ) ;
  400. UNTIL (FileList [SelectedFile] [1] <> '»') OR EscPressed ;
  401. { restore screen }
  402. Message ('') ;
  403. RestoreArea (60, 2, 75, 23, OldDisplayContents) ;
  404. TextAttr := OldAttr ;
  405. GOTOXY (OldXpos, OldYpos) ;
  406. SetCursor (OldCursorType) ;
  407. { construct full pathname from filename + directory }
  408. IF NOT EscPressed
  409.    THEN { change wildcarded name into name of selected file }
  410.         BEGIN
  411.         GETDIR (0, Dir) ;
  412.         IF Dir [LENGTH (Dir) ] <> '\' THEN Dir := Dir + '\' ;
  413.         Name := Dir + FileList [SelectedFile] ;
  414.         END ;
  415. CHDIR (OldCurrentDir) ;
  416. END ;
  417.  
  418. {-----------------------------------------------------------------------------}
  419. { Insert a number of spaces into the current workspace at position P.         }
  420. { On exit, P will point to the position right after the last space.           }
  421. {-----------------------------------------------------------------------------}
  422.  
  423. PROCEDURE InsertSpaces (VAR P : Position ; NrOfSpaces : WORD) ;
  424.  
  425. BEGIN
  426. WITH CurrentWs DO
  427.      BEGIN
  428.      IF Grow (P.Index, NrOfSpaces)
  429.         THEN BEGIN
  430.              FILLCHAR (Buffer^ [P.Index], NrOfSpaces, ' ') ;
  431.              INC (P.Index, NrOfSpaces) ;
  432.              INC (P.Colnr, NrOfSpaces) ;
  433.              END
  434.      END ; { of with }
  435. END ;
  436.  
  437. {-----------------------------------------------------------------------------}
  438. { Insert a carriage return - line feed pair into the current workspace at     }
  439. { position P. If autoindent is on, the left margin of the current line is     }
  440. { determined, and the same number of spaces inserted at the beginning of the  }
  441. { new line.                                                                   }
  442. {-----------------------------------------------------------------------------}
  443.  
  444. PROCEDURE InsertCRLF (VAR P : Position) ;
  445.  
  446. VAR Counter, LM : WORD ;
  447.  
  448. BEGIN
  449. WITH CurrentWs DO
  450.      BEGIN
  451.      LM := LeftMargin (P) ;
  452.      IF Grow (P.Index, 2)
  453.         THEN BEGIN
  454.              Buffer^ [P.Index] := CR ;
  455.              Buffer^ [P.Index + 1] := LF ;
  456.              INC (P.Index, 2) ;
  457.              INC (P.Linenr) ;
  458.              P.Colnr := 1 ;
  459.              IF Config.Setup.AutoIndent
  460.                 THEN InsertSpaces (P, LM - 1) ;
  461.              END ;
  462.      END ; { of with }
  463. END ;
  464.  
  465. {-----------------------------------------------------------------------------}
  466. { Redraws the entire screen, including the status line                        }
  467. {-----------------------------------------------------------------------------}
  468.  
  469. PROCEDURE RedrawScreen ;
  470.  
  471. VAR LineCounter             : BYTE ;
  472.     IndexCounter, ColCounter : WORD ;
  473.     BlockStart, BlockStop    : WORD ;
  474.     NormAttr, BlockAttr      : BYTE ;
  475.     ScreenChar              : ScreenElement ;
  476.     ScreenCharPtr           : ScreenElementPtr ;
  477.     LastScreenCol           : WORD ;
  478.     SpacesToInsert          : WORD ;
  479.     CursorY                 : BYTE ;
  480.     StatusLine              : STRING [ColsOnScreen] ;
  481.     TempStr                 : STRING [5] ;
  482.     FileName                : STRING ;
  483.  
  484. BEGIN
  485. WITH CurrentWs DO
  486.      BEGIN
  487.      { check if FirstVisibleLine needs to be adapted }
  488.      IF (FirstVisibleLine.Linenr > CurPos.Linenr)
  489.         THEN
  490.           BEGIN
  491.           { line number of CurPos is too low }
  492.           FirstVisibleLine := CurPos ;
  493.           Home (FirstVisibleLine) ;
  494.           END ;
  495.      IF ( (FirstVisibleLine.Linenr + NrOfTextLines) <= CurPos.Linenr)
  496.         THEN
  497.           BEGIN
  498.           { line number of CurPos is too high }
  499.           IF ( (FirstVisibleLine.Linenr + 2 * NrOfTextLines) <= CurPos.Linenr)
  500.              THEN
  501.                BEGIN
  502.                { difference is more than 1 screen }
  503.                FirstVisibleLine := CurPos ;
  504.                REPEAT
  505.                  LineUp (FirstVisibleLine) ;
  506.                UNTIL ( (FirstVisibleLine.Linenr + NrOfTextLines) =
  507.                       (CurPos.Linenr + 1) ) ;
  508.                END
  509.              ELSE
  510.                BEGIN
  511.                { difference is less than 1 screen }
  512.                WHILE ( (FirstVisibleLine.Linenr + NrOfTextLines) <=
  513.                       CurPos.Linenr) DO
  514.                      BEGIN
  515.                      LineDown (FirstVisibleLine) ;
  516.                      END ;
  517.                END ;
  518.           END ;
  519.      { adapt FirstScreenCol if necessary }
  520.      IF FirstScreenCol > CurPos.Colnr
  521.         THEN { cursor is before FirstScreenCol }
  522.              FirstScreenCol := CurPos.Colnr ;
  523.      IF (FirstScreenCol + ColsOnScreen) <= CurPos.Colnr
  524.         THEN { cursor is more than 1 screenwidth after FirstScreenCol }
  525.              FirstScreenCol := CurPos.Colnr - ColsOnScreen + 1 ;
  526.      { determine line on screen where cursor must be put }
  527.      CursorY := CurPos.Linenr - FirstVisibleLine.Linenr + 1 ;
  528.      { set index of first and last characters to be displayed as part of block }
  529.      IF (MARK <> Inactive)
  530.         THEN
  531.           BEGIN
  532.           IF MARK < CurPos.Index
  533.              THEN
  534.                BEGIN
  535.                BlockStart := MARK ;
  536.                BlockStop := CurPos.Index ;
  537.                END
  538.              ELSE
  539.                BEGIN
  540.                BlockStart := CurPos.Index ;
  541.                BlockStop := MARK ;
  542.                END
  543.           END
  544.         ELSE
  545.           BEGIN
  546.           { do not show a block on the screen }
  547.           BlockStart := $FFFF ;
  548.           BlockStop := 0 ;
  549.           END ;
  550.      { Initialize working variables: }
  551.      { ScreenCharPtr starts at top of screen }
  552.      ScreenCharPtr := ScreenElementPtr (DisplayPtr) ;
  553.      { NormAttr contains attribute of normal characters on screen }
  554.      NormAttr := ScreenColorArray [Config.Setup.ScreenColors].NormAttr ;
  555.      { BlockAttr contains attribute of characters in block }
  556.      BlockAttr := ScreenColorArray [Config.Setup.ScreenColors].BlockAttr ;
  557.      { IndexCounter contains index of next character to be displayed }
  558.      IndexCounter := FirstVisibleLine.Index ;
  559.      { LastScreenCol contains number of last column on screen }
  560.      LastScreenCol := FirstScreenCol + ColsOnScreen - 1 ;
  561.      { write text lines to screen }
  562.      FOR LineCounter := 1 TO NrOfTextLines DO
  563.          BEGIN
  564.          { initialise attribute of characters on screen }
  565.          IF (IndexCounter >= BlockStart) AND (IndexCounter < BlockStop)
  566.             THEN ScreenChar.Attribute := BlockAttr
  567.             ELSE ScreenChar.Attribute := NormAttr ;
  568.          { SpacesToInsert counts extra spaces, shown because of CR,LF,EF }
  569.          SpacesToInsert := 0 ;
  570.          { write line only if no key in buffer or if on current line }
  571.          IF (Config.Setup.FastRedraw) AND
  572.             (KEYPRESSED) AND
  573.             ( (LineCounter > CursorY) OR
  574.              (LineCounter < (CursorY - 2) ) )
  575.             THEN { skip writing this line }
  576.                  INC (ScreenCharPtr.OFS, 2 * ColsOnScreen)
  577.             ELSE FOR ColCounter := 1 TO LastScreenCol DO
  578.                      BEGIN
  579.                      { check if at end of buffer }
  580.                      IF IndexCounter = BufferSize
  581.                         THEN SpacesToInsert := LastScreenCol ;
  582.                      IF SpacesToInsert > 0
  583.                         THEN BEGIN
  584.                              ScreenChar.Contents := ' ' ;
  585.                              END
  586.                         ELSE BEGIN
  587.                              { change attribute if necessary }
  588.                              IF IndexCounter = BlockStart
  589.                                 THEN ScreenChar.Attribute := BlockAttr ;
  590.                              IF IndexCounter = BlockStop
  591.                                 THEN ScreenChar.Attribute := NormAttr ;
  592.                              ScreenChar.Contents := Buffer^ [IndexCounter] ;
  593.                              CASE ScreenChar.Contents OF
  594.                                   ' ' : IF Config.Setup.DotsForSpaces
  595.                                            THEN ScreenChar.contents := #250 ;
  596.                                   CR  : IF Buffer^ [IndexCounter + 1] = LF
  597.                                            THEN BEGIN
  598.                                                 ScreenChar.contents := ' ' ;
  599.                                                 SpacesToInsert :=
  600.                                                              LastScreenCol ;
  601.                                                END ;
  602.                                   LF  : BEGIN
  603.                                         ScreenChar.contents := ' ' ;
  604.                                         SpacesToInsert := LastScreenCol ;
  605.                                         END ;
  606.                                   END ; { of case }
  607.                              END ;
  608.                      IF ColCounter >= FirstScreenCol
  609.                         THEN BEGIN
  610.                              { write ScreenChar to screen }
  611.                              ScreenCharPtr.Ref^ := ScreenChar ;
  612.                              INC (ScreenCharPtr.OFS, 2) ;
  613.                              END ;
  614.                      IF SpacesToInsert = 0
  615.                         THEN INC (IndexCounter)
  616.                         ELSE DEC (SpacesToInsert) ;
  617.                      END ; { of for }
  618.          { skip to next line }
  619.          IF IndexCounter < BufferSize THEN
  620.             REPEAT INC (IndexCounter) ;
  621.             UNTIL (Buffer^ [IndexCounter - 1] = LF) OR
  622.                   (IndexCounter = BufferSize) ;
  623.          END ; { of for }
  624.      { status line: }
  625.      IF MessageRead
  626.         THEN
  627.           BEGIN
  628.           { prepare status line }
  629.           StatusLine := BasicStatusLine ;
  630.           StatusLine [1] := CHR (64 + CurrentWsnr) ;
  631.           TempStr := WordToString (CurPos.Linenr, 0) ;
  632.           MOVE (TempStr [1], StatusLine [6], LENGTH (TempStr) ) ;
  633.           TempStr := WordToString (CurPos.Colnr, 0) ;
  634.           MOVE (TempStr [1], StatusLine [14], LENGTH (TempStr) ) ;
  635.           IF ChangesMade
  636.              THEN StatusLine [20] := '*' ;
  637.           IF LENGTH (Name) <= 34
  638.              THEN MOVE (Name [1], StatusLine [22], LENGTH (Name) )
  639.              ELSE BEGIN
  640.                   { select last part of file name and prepend with '«' }
  641.                   FileName := COPY (Name, LENGTH (Name) - 34 + 2, 33) ;
  642.                   DELETE (FileName, 1, POS ('\', FileName) ) ;
  643.                   FileName := '«' + FileName ;
  644.                   MOVE (FileName [1], StatusLine [22], LENGTH (FileName) ) ;
  645.                   END ;
  646.           IF Config.Setup.WordWrapLength <> Inactive
  647.              THEN MOVE (Status_Wrap [1], StatusLine [57], 4) ;
  648.           IF Config.Setup.Insertmode
  649.              THEN MOVE (Status_Ins [1], StatusLine [62], 3) ;
  650.           IF Config.Setup.AutoIndent
  651.              THEN MOVE (Status_Indent [1], StatusLine [66], 6) ;
  652.           IF MacroDefining <> Inactive
  653.              THEN MOVE (Status_Def [1], StatusLine [73], 3) ;
  654.           TempStr := WordToString (LONGINT (CurPos.Index) * 100 DIV BufferSize,
  655.                                    3) ;
  656.           MOVE (TempStr [1], StatusLine [77], 3) ;
  657.           { show status line on screen }
  658.           SetBottomline (StatusLine) ;
  659.           END ;
  660.      { set position of cursor }
  661.      CursorTo (CurPos.Colnr - FirstScreenCol + 1, CursorY) ;
  662.      END ; { of with }
  663. END ; { of procedure }
  664.  
  665. {-----------------------------------------------------------------------------}
  666. { Choose a set option that can be on or of                                    }
  667. {-----------------------------------------------------------------------------}
  668.  
  669. PROCEDURE ChooseOnOff (VAR B : BOOLEAN ; Prompt : STRING) ;
  670.  
  671. VAR Choices : STRING[7] ;
  672.  
  673. BEGIN
  674. IF B
  675.    THEN Choices := 'On  oFf'
  676.    ELSE Choices := 'oFf On' ;
  677. CASE Choose (Choices, Prompt) OF
  678.      'O' : B := TRUE ;
  679.      'F' : B := FALSE ;
  680.      END ;
  681. END ;
  682.  
  683. {-----------------------------------------------------------------------------}
  684. { Interactive change of the setup                                             }
  685. {-----------------------------------------------------------------------------}
  686.  
  687. PROCEDURE AlterSetup ;
  688.  
  689. VAR Choices : STRING ;
  690.     ConfigFile : FILE OF ConfigBlock ;
  691.     SetupDir : DirStr ;
  692.  
  693. BEGIN
  694. WITH Config.Setup DO
  695.   BEGIN
  696.   CASE Choose ('Display  Environment  File  Printer  Save-setup','Setup: ') OF
  697.       'D' : CASE Choose ('Colors  cursorType  Fastredraw Dots-for-spaces','Display: ') OF
  698.               'C' : BEGIN
  699.                     IF ColorCard
  700.                        THEN BEGIN
  701.                             IF ScreenColors = NrOfColorSettings
  702.                                THEN Screencolors := 1
  703.                                ELSE INC (ScreenColors) ;
  704.                             END
  705.                        ELSE BEGIN
  706.                             IF ScreenColors = 1
  707.                                THEN Screencolors := 2
  708.                                ELSE Screencolors := 1 ;
  709.                             END ;
  710.                     TextAttr := ScreenColorArray [ScreenColors].NormAttr ;
  711.                     END ;
  712.               'T' : BEGIN
  713.                     IF Cursortype = NrOfCursorTypes
  714.                        THEN Cursortype := 1
  715.                        ELSE INC (Cursortype) ;
  716.                     SetCursor (CursorType) ;
  717.                     END ;
  718.               'F' : ChooseOnOff (FastRedraw,'Fast screen redraw: ') ;
  719.               'D' : ChooseOnOff (DotsForSpaces,
  720.                                  'Display spaces as small dots: ') ;
  721.               END ; { of case }
  722.       'E' : CASE Choose ('Keyclick  Bell  Wordwrap  Tabs  Autoindent  Insert',
  723.                          'Environment: ') OF
  724.               'K' : ChooseOnOff (Keyclick, 'Key click: ') ;
  725.               'B' : ChooseOnOff (SoundBell,
  726.                                  'Sound bell on errors and warnings: ') ;
  727.               'W' : CASE Choose ('Linelength  Automatic','Word wrap: ') OF
  728.                       'L' : EnterWord (WordWrapLength,
  729.                              'Line length for word wrap (0 = off): ', 0, 255) ;
  730.                       'A' : ChooseOnOff (AutoWrap, 'Automatic wordwrap: ') ;
  731.                       END ; { of case }
  732.               'T' : Enterword (TabSpacing, 'Tab spacing (0 = align): ', 0, 255) ;
  733.               'A' : ChooseOnOff (AutoIndent, 'Auto indent: ') ;
  734.               'I' : ChooseOnOff (InsertMode, 'Insert mode: ')
  735.               END ; { of case }
  736.       'F' : CASE Choose ('Exit-auto-save  Interval-auto-save  Backup-files  Workfile',
  737.                          'Filing: ') OF
  738.               'E' : ChooseOnOff (SaveOnExit,
  739.                                  'Save changed files on exiting AE: ') ;
  740.               'I' : EnterWord (SaveInterval,
  741.                                'Interval for auto-save in minutes (0 = off): ',
  742.                                 0, 1000) ;
  743.               'B' : ChooseOnOff (MakeBAKfile, 'Make .BAK file when saving: ') ;
  744.               'W' : ChooseOnOff (SaveWork, 'Save workspace on exit: ') ;
  745.               END ; { of case }
  746.       'P' : CASE Choose ('Page-length  Left-margin  Top-margin  page-Numbers',
  747.                          'Printer: ') OF
  748.               'P' : EnterWord (PageLength,
  749.                                'Lines per page for paged prints (0 = off): ',
  750.                                0, 1000) ;
  751.               'L' : EnterWord (LeftMargin, 'Left margin: ', 0, 240) ;
  752.               'T' : EnterWord (TopMargin, 'Top margin: ', 0, 1000) ;
  753.               'N' : ChooseOnOff (PrintPagenrs, 'Print page numbers: ') ;
  754.               END ; { of case }
  755.       'S' : BEGIN
  756.             GETDIR (0,SetupDir) ;
  757.             EnterString (SetupDir, NIL, 'Save setup in directory: ',
  758.                          67, TRUE, TRUE) ;
  759.             IF NOT EscPressed
  760.                THEN
  761.                  BEGIN
  762.                  ASSIGN (ConfigFile, SetupDir+'\'+ConfigFilename) ;
  763.                  REWRITE (ConfigFile) ;
  764.                  WRITE (ConfigFile, Config) ;
  765.                  CheckDiskerror ;
  766.                  CLOSE (ConfigFile) ;
  767.                  IF DiskError = 0
  768.                     THEN Message (Copy('Setup saved as '+SetupDir+'\'+
  769.                                   ConfigFilename, 1, 80)) ;
  770.                  END ;
  771.             END ;
  772.       END ; { of case }
  773.   END ; { of with }
  774. END ;
  775.  
  776. {-----------------------------------------------------------------------------}
  777. { Formats text, starting from position P until the next empty line            }
  778. {-----------------------------------------------------------------------------}
  779.  
  780. PROCEDURE FormatParagraph (VAR P : position) ;
  781.  
  782. VAR Index2, Index3 : WORD ;
  783.     FreeSpace : WORD ;
  784.     Margin : WORD ;
  785.     Ready : BOOLEAN ;
  786.     LFsseen : WORD ;
  787.     Counter : WORD ;
  788.  
  789. BEGIN
  790. WITH CurrentWs DO
  791.      BEGIN
  792.      { advance P to the end of this word, to avoid deleting the left margin }
  793.      { (delimited by a space, CR, LF or EF) }
  794.      LFsseen := 0 ;
  795.      WHILE (Buffer^[P.Index] IN WordDelimiters) AND
  796.            (P.Index < BufferSize) DO
  797.            BEGIN
  798.            IF Buffer^[P.Index] = LF
  799.               THEN BEGIN
  800.                    INC (P.Linenr) ;
  801.                    INC (LFsseen) ;
  802.                    P.Colnr := 1 ;
  803.                    END
  804.               ELSE INC (P.Colnr) ;
  805.            INC (P.Index) ;
  806.            END ;
  807.      WHILE (NOT (Buffer^[P.Index] IN WordDelimiters)) AND
  808.            (P.Index < BufferSize) DO
  809.            BEGIN
  810.            INC (P.Colnr) ;
  811.            INC (P.Index) ;
  812.            END ;
  813.      { calculate left margin }
  814.      IF Config.Setup.AutoIndent
  815.         THEN Margin := LeftMargin (P)
  816.         ELSE Margin := 1 ;
  817.      { move rest of text to back of buffer }
  818.      FreeSpace := WsBufSize-BufferSize ;
  819.      IF Grow (P.Index, FreeSpace)
  820.         THEN BEGIN
  821.              { set Index2 and Index3 to start of rest of text }
  822.              Index2 := P.Index + FreeSpace ;
  823.              Index3 := Index2 ;
  824.              Ready := (LFsseen > 0) ;
  825.              WHILE NOT Ready DO
  826.                    BEGIN
  827.                    { advance Index2 to start of next word, }
  828.                    { counting linefeeds skipped }
  829.                    LFsseen := 0 ;
  830.                    WHILE (Buffer^[Index2] IN WordDelimiters) AND
  831.                          (Index2 < BufferSize) DO
  832.                          BEGIN
  833.                          IF Buffer^[Index2] = LF
  834.                             THEN INC (LFsseen) ;
  835.                          INC (Index2) ;
  836.                          END ;
  837.                    Ready := (LFsseen > 1) OR (Index2 >= BufferSize) ;
  838.                    IF NOT Ready
  839.                       THEN BEGIN
  840.                            { advance Index3 to the end of the word }
  841.                            Index3 := Index2 ;
  842.                            WHILE (NOT (Buffer^[Index3] IN WordDelimiters)) AND
  843.                                  (Index3 < BufferSize) DO
  844.                                  INC (Index3) ;
  845.                            { test if adding word would make line too long }
  846.                            IF P.Colnr + (Index3-Index2) >
  847.                               Config.Setup.WordWrapLength
  848.                               THEN BEGIN
  849.                                    { break line after P (if enough room) }
  850.                                    IF (P.Index-Index2) >= (Margin + 1)
  851.                                       THEN BEGIN
  852.                                            Buffer^[P.Index] := CR ;
  853.                                            Buffer^[P.Index+1] := LF ;
  854.                                            FOR Counter := 1 TO (Margin-1) DO
  855.                                                Buffer^[P.Index+1+Counter] :=
  856.                                                                         ' ' ;
  857.                                            INC (P.Index, Margin+1) ;
  858.                                            P.Colnr := Margin ;
  859.                                            INC (P.Linenr) ;
  860.                                            END
  861.                                       ELSE BEGIN
  862.                                            { not enough room to do formatting }
  863.                                            ErrorMessage (1) ;
  864.                                            Ready := TRUE ;
  865.                                            END ;
  866.                                    END
  867.                               ELSE BEGIN
  868.                                    { put 1 space after P (if enough room) }
  869.                                    IF (P.Index-Index2) >= 1
  870.                                       THEN BEGIN
  871.                                            Buffer^[P.Index] := ' ' ;
  872.                                            INC (P.Index) ;
  873.                                            INC (P.Colnr) ;
  874.                                            END
  875.                                       ELSE BEGIN
  876.                                            { not enough room to do formatting }
  877.                                            ErrorMessage (1) ;
  878.                                            Ready := TRUE ;
  879.                                            END ;
  880.                                    END ;
  881.                            { move word between Index2 and Index3 to P }
  882.                            MOVE (Buffer^[Index2], Buffer^[P.Index],
  883.                                  (Index3-Index2)) ;
  884.                            { adjust P }
  885.                            INC (P.Index, Index3-Index2) ;
  886.                            INC (P.Colnr, Index3-Index2) ;
  887.                            { advance Index2 }
  888.                            Index2 := Index3 ;
  889.                            END ; { of if }
  890.                    END ; { of while }
  891.              { move remainder of text back, to just after formatted block }
  892.              Shrink (P.Index, Index3-P.Index) ;
  893.              END ; { of if }
  894.      END ; { of with }
  895. END ;
  896.  
  897. {-----------------------------------------------------------------------------}
  898.  
  899. END.
  900.