Category : Word Processors
Archive   : AE170.ZIP
Filename : AE4.PAS

UNIT AE4 ;

{$R-}
{$B-}
{$I-}
{$S+}
{$V-}

INTERFACE

USES Crt, Dos, Printer, AE0, AE1, AE2, AE3 ;

FUNCTION CopyBlock : BOOLEAN ;
PROCEDURE DeleteBlock ;
FUNCTION InsertBlock : BOOLEAN ;
PROCEDURE PrintBlock (Buffer : WsBufptr ; BlockStart, BlockEnd : WORD ) ;
PROCEDURE InsertFile (Filename : PathStr; P : Position) ;
PROCEDURE LoadFile (Filename : PathStr) ;
PROCEDURE GetFileFromList (VAR Name : PathStr) ;
PROCEDURE InsertSpaces (VAR P : Position ; NrOfSpaces : WORD) ;
PROCEDURE InsertCRLF (VAR P : Position) ;
PROCEDURE RedrawScreen ;
PROCEDURE AlterSetup ;
PROCEDURE FormatParagraph (VAR P : position) ;

IMPLEMENTATION

{-----------------------------------------------------------------------------}
{ Copies the block in the current workspace to the paste buffer. If no block }
{ is indicated or if the block is too large for the paste buffer, an error }
{ message is given, and the function result will be False. }
{-----------------------------------------------------------------------------}

FUNCTION CopyBlock : BOOLEAN ;

VAR Result : BOOLEAN ;

BEGIN
Result := FALSE ;
WITH CurrentWs DO
BEGIN
IF (MARK > 0)
THEN BEGIN
IF MARK < CurPos.Index
THEN BEGIN
IF (CurPos.Index - MARK) > PasteBufSize
THEN ErrorMessage (4)
ELSE BEGIN
PasteBufferSize := CurPos.Index - MARK ;
MOVE (Buffer^ [MARK], PasteBuffer^ [1],
PasteBufferSize) ;
Result := TRUE ;
END ;
END
ELSE BEGIN
IF (MARK - CurPos.Index) > PasteBufSize
THEN ErrorMessage (4)
ELSE BEGIN
PasteBufferSize := MARK - CurPos.Index ;
MOVE (Buffer^ [CurPos.Index], PasteBuffer^ [1],
PasteBufferSize) ;
Result := TRUE ;
END ;
END ;
END
ELSE ErrorMessage (5) ;
END ; { of with }
CopyBlock := Result ;
END ;

{-----------------------------------------------------------------------------}
{ Deletes the block from the current workspace. }
{-----------------------------------------------------------------------------}

PROCEDURE DeleteBlock ;

VAR OldCurPosIndex : WORD ;

BEGIN
WITH CurrentWs DO
BEGIN
IF MARK > 0
THEN BEGIN
IF MARK < CurPos.Index
THEN BEGIN
{ if Mark is before CurPos: exchange positions }
OldCurPosIndex := CurPos.Index ;
SkipUp (CurPos, OldCurPosIndex - MARK) ;
MARK := OldCurPosIndex ;
END ;
Shrink (CurPos.Index, MARK - CurPos.Index) ;
MARK := 0 ;
END ;
END ;
END ;

{-----------------------------------------------------------------------------}
{ Inserts the contents of the paste buffer into the current workspace at }
{ position CurPos. If successful, Mark will be pointing to the end of the }
{ inserted block, and CurPos to the start. Function result indicates success. }
{-----------------------------------------------------------------------------}

FUNCTION InsertBlock : BOOLEAN ;

BEGIN
WITH CurrentWs DO
BEGIN
IF Grow (CurPos.Index, PasteBufferSize)
THEN BEGIN
MOVE (PasteBuffer^ [1], Buffer^ [CurPos.Index], PasteBufferSize) ;
InsertBlock := TRUE
END
ELSE InsertBlock := FALSE;
END ; { of with }
END ;

{-----------------------------------------------------------------------------}
{ Dumps a block (indicated by BlockStart and BlockEnd) to the printer. }
{ If enabled by Setup, form feeds, left and top margins and page numbers }
{ are added. }
{-----------------------------------------------------------------------------}

PROCEDURE PrintBlock (Buffer : WsBufptr ; BlockStart, BlockEnd : WORD ) ;

VAR Counter, IndexCounter, LineCounter, PageCounter, LinesPerPage : WORD ;
DummyKey : WORD ;
AbortPrint : BOOLEAN ;

BEGIN
{ LinesPerPage contains number of text lines on a page }
LinesPerPage := Config.Setup.PageLength ;
IF Config.Setup.PrintPagenrs THEN DEC (LinesPerPage, 2) ;
Message ('Printing. Press any key to interrupt') ;
AbortPrint := FALSE ;
IndexCounter := BlockStart ;
PageCounter := 1 ;
{ write top margin of first page }
FOR Counter := 1 TO Config.Setup.TopMargin DO
WRITELN (Lst) ;
LineCounter := Config.Setup.TopMargin + 1 ;
{ write left margin of first line }
WRITE (Lst, '' : Config.Setup.LeftMargin) ;
REPEAT IF Buffer^ [IndexCounter] <> FF
THEN WRITE (Lst, Buffer^ [IndexCounter]) ;
IF Buffer^ [IndexCounter] = LF
THEN BEGIN
INC (LineCounter) ;
{ write left margin of new line }
WRITE (Lst, '' : Config.Setup.LeftMargin) ;
END ;
IF ( (LineCounter > LinesPerPage) AND (Config.Setup.PageLength > 0) ) OR
(Buffer^ [IndexCounter] = FF)
THEN BEGIN
{ end current page and start new one }
IF Config.Setup.PrintPagenrs
THEN BEGIN
{ print page number if desired }
WHILE LineCounter <= (LinesPerPage + 2) DO
BEGIN
WRITELN (Lst) ;
INC (LineCounter) ;
END ;
WRITE (Lst, '' : Config.Setup.LeftMargin,
'Pag ', PageCounter : 2) ;
END ;
WRITE (Lst, FF) ;
INC (PageCounter) ;
{ skip top margin }
FOR Counter := 1 TO Config.Setup.TopMargin DO
WRITELN (Lst) ;
LineCounter := Config.Setup.TopMargin + 1 ;
{ write left margin of first line }
WRITE (Lst, '' : Config.Setup.LeftMargin) ;
END ;
INC (IndexCounter) ;
CheckDiskError ;
AbortPrint := (DiskError <> 0) ;
IF KEYPRESSED
THEN BEGIN
ClearKeyBuffer ;
{ ask for confirmation }
AbortPrint := Answer ('Abort printing?') ;
IF NOT AbortPrint
THEN Message ('Printing. Press any key to interrupt') ;
END ;
UNTIL (IndexCounter > BlockEnd) OR AbortPrint ;
IF (Config.Setup.PrintPagenrs) AND (NOT KEYPRESSED)
THEN BEGIN
{ end last page: move to end of page and print page number }
FOR Counter := LineCounter TO (LinesPerPage + 1) DO
WRITELN (Lst) ;
WRITE (Lst, 'Pag ', PageCounter : 2) ;
WRITE (Lst, FF) ;
CheckDiskError ;
END ;
IF AbortPrint
THEN Message ('Printing aborted')
ELSE Message ('Printing completed') ;
END ;

{-----------------------------------------------------------------------------}
{ Inserts the file into the current workspace at position P. }
{-----------------------------------------------------------------------------}

PROCEDURE InsertFile (Filename : PathStr ; P : Position) ;

VAR F : FILE ;
Size, BytesToRead, AvailableSpace : LONGINT ;
BytesRead : WORD ;
Counter : WORD ;

BEGIN
ASSIGN (F, Filename) ;
RESET (F, 1) ;
CheckDiskError ;
IF (DiskError = 0)
THEN BEGIN
Size := FILESIZE (F) ;
WITH CurrentWs DO
BEGIN
BytesToRead := Size ;
AvailableSpace := WsBufSize - BufferSize ;
IF BytesToRead > AvailableSpace
THEN BytesToRead := AvailableSpace ;
IF Grow (P.Index, BytesToRead)
THEN BEGIN
Message ('Reading file ' + Filename + ' ...') ;
BLOCKREAD (F, Buffer^ [P.Index], BytesToRead, BytesRead) ;
CheckDiskError ;
MARK := P.Index + BytesRead ;
{ check for EndOfFile char }
IF (Buffer^ [P.Index+BytesRead-1] = EF)
THEN BEGIN
{ always delete if it is last char read }
Shrink (P.Index+BytesRead-1, 1) ;
Dec (BytesRead) ;
END ;
{ check for other }
Counter := P.Index ;
WHILE (Buffer^ [Counter] <> EF) AND
(Counter < (P.Index+BytesRead)) DO
INC (Counter) ;
{ delete stuff after EOF char }
IF (Counter < (P.Index+BytesRead)) AND
(Answer ('Unexpected end-of-file encountered. ' +
'Truncate file?'))
THEN Shrink (Counter,
BytesRead - (Counter - P.Index) ) ;
Message ('') ;
END ; { of if }
IF Size > BytesToRead
THEN { warning: file too large to load completely }
ErrorMessage (7) ;
CLOSE (F) ;
END ; { of with }
END ; { of if }
END ; { of procedure }

{-----------------------------------------------------------------------------}
{ Loads the file into the current workspace, resetting all }
{ variables involved. If is empty, then no file is loaded. }
{-----------------------------------------------------------------------------}

PROCEDURE LoadFile (Filename : PathStr) ;

BEGIN
ClearCurrentWs ;
IF LENGTH (FileName) > 0
THEN WITH CurrentWs DO
BEGIN
Name := FExpand (Filename) ;
InsertFile (Name, CurPos) ;
MARK := Inactive ;
ChangesMade := FALSE ;
END ;
Workspace [CurrentWsnr] := CurrentWs ;
END ;

{-----------------------------------------------------------------------------}
{ Displays a list with files, from which the user }
{ can then make a choice, using the cursor and Return keys. }
{ Cursor shape and position and screen contents are saved, and }
{ restored on exit. }
{-----------------------------------------------------------------------------}

PROCEDURE GetFileFromList (VAR Name : PathStr) ;

VAR OldXpos, OldYpos, OldCursorType, Counter : BYTE ;
OldAttr, NormAttr, SelectAttr : BYTE ;
OldDisplayContents : ScreenBlockPtr ;
SelectKey : WORD ;
FileList : ARRAY [1..MaxFileListLength] OF FilenameStr ;
FirstVisibleFile, SelectedFile, FileListLength : BYTE ;
SR : SearchRec ;
Mask : FilenameStr ;
Dir, OldCurrentDir : DirStr ;
Fname : NameStr ;
Fext : ExtStr ;

BEGIN
GETDIR (0, OldCurrentDir) ;
{ split pathname into directory and mask }
FSplit (FExpand (Name), Dir, Fname, Fext) ;
Mask := Fname + Fext ;
IF LENGTH (Dir) > 3
THEN DELETE (Dir, LENGTH (Dir), 1) ;
CHDIR (Dir) ;
CheckDiskError ;
{ save old screen settings }
OldXpos := WHEREX ;
OldYpos := WHEREY ;
OldCursorType := GetCursor ;
OldAttr := TextAttr ;
{ new screen settings }
SetCursor (Inactive) ;
NormAttr := ScreenColorArray [Config.Setup.ScreenColors].NormAttr ;
SelectAttr := ScreenColorArray [Config.Setup.ScreenColors].BlockAttr ;
TextAttr := NormAttr ;
{ save old screen contents and draw frame for file list }
SaveArea (60, 2, 75, 23, OldDisplayContents) ;
PutFrame (60, 2, 75, 23, Quasi3DFrame) ;
ClearArea (61, 3, 74, 22) ;
REPEAT Counter := 1 ;
Message ('Searching ...') ;
{ build file list }
FINDFIRST (Mask, ReadOnly + Archive, SR) ;
WHILE (DosError = 0) AND (Counter < (MaxFileListLength - 1) ) DO
BEGIN
FileList [Counter] := SR.Name ;
FINDNEXT (SR) ;
INC (Counter) ;
END ;
{ add directories }
FINDFIRST ('*.*', Directory, SR) ;
WHILE (DosError = 0) AND (Counter <= MaxFileListLength) DO
BEGIN
IF ( (SR.Attr AND Directory) <> 0) AND
(SR.Name <> '.')
THEN BEGIN
FileList [Counter] := '¯' + SR.Name ;
INC (Counter) ;
END ;
FINDNEXT (SR) ;
END ;
Message ('Select file with ,,PgUp, PgDn keys, or ' +
'press first letter; Enter to load') ;
FileListLength := Counter - 1 ;
FirstVisibleFile := 1 ;
SelectedFile := 1 ;
REPEAT IF FirstVisibleFile > SelectedFile
THEN FirstVisibleFile := SelectedFile ;
IF (SelectedFile - FirstVisibleFile) > 19
THEN FirstVisibleFile := SelectedFile - 19 ;
FOR Counter := FirstVisibleFile TO (FirstVisibleFile + 19) DO
BEGIN
IF Counter = SelectedFile
THEN TextAttr := SelectAttr
ELSE TextAttr := NormAttr ;
GOTOXY (61, Counter - FirstVisibleFile + 3) ;
IF Counter <= FileListLength
THEN WRITE (' ', FileList [Counter],
' ' : (13 - LENGTH (FileList [Counter]) ) )
ELSE WRITE (' ' : 14) ;
END ;
SelectKey := ReadKeyNr ;
CASE SelectKey OF
328 : { up } IF SelectedFile > 1
THEN DEC (SelectedFile) ;
336 : { down } IF SelectedFile < FileListLength
THEN INC (SelectedFile) ;
329 : { PgUp } IF SelectedFile > 19
THEN DEC (SelectedFile, 19)
ELSE SelectedFile := 1 ;
337 : { PgDn } IF SelectedFile < (FileListLength - 19)
THEN INC (SelectedFile, 19)
ELSE SelectedFile := FileListLength ;
388 : { ^PgUp } SelectedFile := 1 ;
374 : { ^PgDn } SelectedFile := FileListLength ;
32..127 : BEGIN
{ select by pressing first letter of name }
Counter := SelectedFile + 1 ;
WHILE (NOT ( (FileList [Counter] [1] =
UPCASE (CHR (SelectKey) ) ) OR
( (FileList [Counter] [1] = '¯') AND
(FileList [Counter] [2] =
UPCASE (CHR (SelectKey) ) ) ) ) )
AND
(Counter <= FileListLength)
DO INC (Counter) ;
IF Counter <= FileListLength
THEN SelectedFile := Counter ;
END ;
ReturnKey : ;
EscapeKey : EscPressed := TRUE ;
ELSE WarningBeep ; { invalid key }
END ; { of case }
UNTIL (SelectKey = ReturnKey) OR EscPressed ;
IF (SelectKey = ReturnKey) AND (FileList [SelectedFile] [1] = '¯')
THEN CHDIR (COPY (FileList [SelectedFile], 2, 8) ) ;
UNTIL (FileList [SelectedFile] [1] <> '¯') OR EscPressed ;
{ restore screen }
Message ('') ;
RestoreArea (60, 2, 75, 23, OldDisplayContents) ;
TextAttr := OldAttr ;
GOTOXY (OldXpos, OldYpos) ;
SetCursor (OldCursorType) ;
{ construct full pathname from filename + directory }
IF NOT EscPressed
THEN { change wildcarded name into name of selected file }
BEGIN
GETDIR (0, Dir) ;
IF Dir [LENGTH (Dir) ] <> '\' THEN Dir := Dir + '\' ;
Name := Dir + FileList [SelectedFile] ;
END ;
CHDIR (OldCurrentDir) ;
END ;

{-----------------------------------------------------------------------------}
{ Insert a number of spaces into the current workspace at position P. }
{ On exit, P will point to the position right after the last space. }
{-----------------------------------------------------------------------------}

PROCEDURE InsertSpaces (VAR P : Position ; NrOfSpaces : WORD) ;

BEGIN
WITH CurrentWs DO
BEGIN
IF Grow (P.Index, NrOfSpaces)
THEN BEGIN
FILLCHAR (Buffer^ [P.Index], NrOfSpaces, ' ') ;
INC (P.Index, NrOfSpaces) ;
INC (P.Colnr, NrOfSpaces) ;
END
END ; { of with }
END ;

{-----------------------------------------------------------------------------}
{ Insert a carriage return - line feed pair into the current workspace at }
{ position P. If autoindent is on, the left margin of the current line is }
{ determined, and the same number of spaces inserted at the beginning of the }
{ new line. }
{-----------------------------------------------------------------------------}

PROCEDURE InsertCRLF (VAR P : Position) ;

VAR Counter, LM : WORD ;

BEGIN
WITH CurrentWs DO
BEGIN
LM := LeftMargin (P) ;
IF Grow (P.Index, 2)
THEN BEGIN
Buffer^ [P.Index] := CR ;
Buffer^ [P.Index + 1] := LF ;
INC (P.Index, 2) ;
INC (P.Linenr) ;
P.Colnr := 1 ;
IF Config.Setup.AutoIndent
THEN InsertSpaces (P, LM - 1) ;
END ;
END ; { of with }
END ;

{-----------------------------------------------------------------------------}
{ Redraws the entire screen, including the status line }
{-----------------------------------------------------------------------------}

PROCEDURE RedrawScreen ;

VAR LineCounter : BYTE ;
IndexCounter, ColCounter : WORD ;
BlockStart, BlockStop : WORD ;
NormAttr, BlockAttr : BYTE ;
ScreenChar : ScreenElement ;
ScreenCharPtr : ScreenElementPtr ;
LastScreenCol : WORD ;
SpacesToInsert : WORD ;
CursorY : BYTE ;
StatusLine : STRING [ColsOnScreen] ;
TempStr : STRING [5] ;
FileName : STRING ;

BEGIN
WITH CurrentWs DO
BEGIN
{ check if FirstVisibleLine needs to be adapted }
IF (FirstVisibleLine.Linenr > CurPos.Linenr)
THEN
BEGIN
{ line number of CurPos is too low }
FirstVisibleLine := CurPos ;
Home (FirstVisibleLine) ;
END ;
IF ( (FirstVisibleLine.Linenr + NrOfTextLines) <= CurPos.Linenr)
THEN
BEGIN
{ line number of CurPos is too high }
IF ( (FirstVisibleLine.Linenr + 2 * NrOfTextLines) <= CurPos.Linenr)
THEN
BEGIN
{ difference is more than 1 screen }
FirstVisibleLine := CurPos ;
REPEAT
LineUp (FirstVisibleLine) ;
UNTIL ( (FirstVisibleLine.Linenr + NrOfTextLines) =
(CurPos.Linenr + 1) ) ;
END
ELSE
BEGIN
{ difference is less than 1 screen }
WHILE ( (FirstVisibleLine.Linenr + NrOfTextLines) <=
CurPos.Linenr) DO
BEGIN
LineDown (FirstVisibleLine) ;
END ;
END ;
END ;
{ adapt FirstScreenCol if necessary }
IF FirstScreenCol > CurPos.Colnr
THEN { cursor is before FirstScreenCol }
FirstScreenCol := CurPos.Colnr ;
IF (FirstScreenCol + ColsOnScreen) <= CurPos.Colnr
THEN { cursor is more than 1 screenwidth after FirstScreenCol }
FirstScreenCol := CurPos.Colnr - ColsOnScreen + 1 ;
{ determine line on screen where cursor must be put }
CursorY := CurPos.Linenr - FirstVisibleLine.Linenr + 1 ;
{ set index of first and last characters to be displayed as part of block }
IF (MARK <> Inactive)
THEN
BEGIN
IF MARK < CurPos.Index
THEN
BEGIN
BlockStart := MARK ;
BlockStop := CurPos.Index ;
END
ELSE
BEGIN
BlockStart := CurPos.Index ;
BlockStop := MARK ;
END
END
ELSE
BEGIN
{ do not show a block on the screen }
BlockStart := $FFFF ;
BlockStop := 0 ;
END ;
{ Initialize working variables: }
{ ScreenCharPtr starts at top of screen }
ScreenCharPtr := ScreenElementPtr (DisplayPtr) ;
{ NormAttr contains attribute of normal characters on screen }
NormAttr := ScreenColorArray [Config.Setup.ScreenColors].NormAttr ;
{ BlockAttr contains attribute of characters in block }
BlockAttr := ScreenColorArray [Config.Setup.ScreenColors].BlockAttr ;
{ IndexCounter contains index of next character to be displayed }
IndexCounter := FirstVisibleLine.Index ;
{ LastScreenCol contains number of last column on screen }
LastScreenCol := FirstScreenCol + ColsOnScreen - 1 ;
{ write text lines to screen }
FOR LineCounter := 1 TO NrOfTextLines DO
BEGIN
{ initialise attribute of characters on screen }
IF (IndexCounter >= BlockStart) AND (IndexCounter < BlockStop)
THEN ScreenChar.Attribute := BlockAttr
ELSE ScreenChar.Attribute := NormAttr ;
{ SpacesToInsert counts extra spaces, shown because of CR,LF,EF }
SpacesToInsert := 0 ;
{ write line only if no key in buffer or if on current line }
IF (Config.Setup.FastRedraw) AND
(KEYPRESSED) AND
( (LineCounter > CursorY) OR
(LineCounter < (CursorY - 2) ) )
THEN { skip writing this line }
INC (ScreenCharPtr.OFS, 2 * ColsOnScreen)
ELSE FOR ColCounter := 1 TO LastScreenCol DO
BEGIN
{ check if at end of buffer }
IF IndexCounter = BufferSize
THEN SpacesToInsert := LastScreenCol ;
IF SpacesToInsert > 0
THEN BEGIN
ScreenChar.Contents := ' ' ;
END
ELSE BEGIN
{ change attribute if necessary }
IF IndexCounter = BlockStart
THEN ScreenChar.Attribute := BlockAttr ;
IF IndexCounter = BlockStop
THEN ScreenChar.Attribute := NormAttr ;
ScreenChar.Contents := Buffer^ [IndexCounter] ;
CASE ScreenChar.Contents OF
' ' : IF Config.Setup.DotsForSpaces
THEN ScreenChar.contents := #250 ;
CR : IF Buffer^ [IndexCounter + 1] = LF
THEN BEGIN
ScreenChar.contents := ' ' ;
SpacesToInsert :=
LastScreenCol ;
END ;
LF : BEGIN
ScreenChar.contents := ' ' ;
SpacesToInsert := LastScreenCol ;
END ;
END ; { of case }
END ;
IF ColCounter >= FirstScreenCol
THEN BEGIN
{ write ScreenChar to screen }
ScreenCharPtr.Ref^ := ScreenChar ;
INC (ScreenCharPtr.OFS, 2) ;
END ;
IF SpacesToInsert = 0
THEN INC (IndexCounter)
ELSE DEC (SpacesToInsert) ;
END ; { of for }
{ skip to next line }
IF IndexCounter < BufferSize THEN
REPEAT INC (IndexCounter) ;
UNTIL (Buffer^ [IndexCounter - 1] = LF) OR
(IndexCounter = BufferSize) ;
END ; { of for }
{ status line: }
IF MessageRead
THEN
BEGIN
{ prepare status line }
StatusLine := BasicStatusLine ;
StatusLine [1] := CHR (64 + CurrentWsnr) ;
TempStr := WordToString (CurPos.Linenr, 0) ;
MOVE (TempStr [1], StatusLine [6], LENGTH (TempStr) ) ;
TempStr := WordToString (CurPos.Colnr, 0) ;
MOVE (TempStr [1], StatusLine [14], LENGTH (TempStr) ) ;
IF ChangesMade
THEN StatusLine [20] := '*' ;
IF LENGTH (Name) <= 34
THEN MOVE (Name [1], StatusLine [22], LENGTH (Name) )
ELSE BEGIN
{ select last part of file name and prepend with '®' }
FileName := COPY (Name, LENGTH (Name) - 34 + 2, 33) ;
DELETE (FileName, 1, POS ('\', FileName) ) ;
FileName := '®' + FileName ;
MOVE (FileName [1], StatusLine [22], LENGTH (FileName) ) ;
END ;
IF Config.Setup.WordWrapLength <> Inactive
THEN MOVE (Status_Wrap [1], StatusLine [57], 4) ;
IF Config.Setup.Insertmode
THEN MOVE (Status_Ins [1], StatusLine [62], 3) ;
IF Config.Setup.AutoIndent
THEN MOVE (Status_Indent [1], StatusLine [66], 6) ;
IF MacroDefining <> Inactive
THEN MOVE (Status_Def [1], StatusLine [73], 3) ;
TempStr := WordToString (LONGINT (CurPos.Index) * 100 DIV BufferSize,
3) ;
MOVE (TempStr [1], StatusLine [77], 3) ;
{ show status line on screen }
SetBottomline (StatusLine) ;
END ;
{ set position of cursor }
CursorTo (CurPos.Colnr - FirstScreenCol + 1, CursorY) ;
END ; { of with }
END ; { of procedure }

{-----------------------------------------------------------------------------}
{ Choose a set option that can be on or of }
{-----------------------------------------------------------------------------}

PROCEDURE ChooseOnOff (VAR B : BOOLEAN ; Prompt : STRING) ;

VAR Choices : STRING[7] ;

BEGIN
IF B
THEN Choices := 'On oFf'
ELSE Choices := 'oFf On' ;
CASE Choose (Choices, Prompt) OF
'O' : B := TRUE ;
'F' : B := FALSE ;
END ;
END ;

{-----------------------------------------------------------------------------}
{ Interactive change of the setup }
{-----------------------------------------------------------------------------}

PROCEDURE AlterSetup ;

VAR Choices : STRING ;
ConfigFile : FILE OF ConfigBlock ;
SetupDir : DirStr ;

BEGIN
WITH Config.Setup DO
BEGIN
CASE Choose ('Display Environment File Printer Save-setup','Setup: ') OF
'D' : CASE Choose ('Colors cursorType Fastredraw Dots-for-spaces','Display: ') OF
'C' : BEGIN
IF ColorCard
THEN BEGIN
IF ScreenColors = NrOfColorSettings
THEN Screencolors := 1
ELSE INC (ScreenColors) ;
END
ELSE BEGIN
IF ScreenColors = 1
THEN Screencolors := 2
ELSE Screencolors := 1 ;
END ;
TextAttr := ScreenColorArray [ScreenColors].NormAttr ;
END ;
'T' : BEGIN
IF Cursortype = NrOfCursorTypes
THEN Cursortype := 1
ELSE INC (Cursortype) ;
SetCursor (CursorType) ;
END ;
'F' : ChooseOnOff (FastRedraw,'Fast screen redraw: ') ;
'D' : ChooseOnOff (DotsForSpaces,
'Display spaces as small dots: ') ;
END ; { of case }
'E' : CASE Choose ('Keyclick Bell Wordwrap Tabs Autoindent Insert',
'Environment: ') OF
'K' : ChooseOnOff (Keyclick, 'Key click: ') ;
'B' : ChooseOnOff (SoundBell,
'Sound bell on errors and warnings: ') ;
'W' : CASE Choose ('Linelength Automatic','Word wrap: ') OF
'L' : EnterWord (WordWrapLength,
'Line length for word wrap (0 = off): ', 0, 255) ;
'A' : ChooseOnOff (AutoWrap, 'Automatic wordwrap: ') ;
END ; { of case }
'T' : Enterword (TabSpacing, 'Tab spacing (0 = align): ', 0, 255) ;
'A' : ChooseOnOff (AutoIndent, 'Auto indent: ') ;
'I' : ChooseOnOff (InsertMode, 'Insert mode: ')
END ; { of case }
'F' : CASE Choose ('Exit-auto-save Interval-auto-save Backup-files Workfile',
'Filing: ') OF
'E' : ChooseOnOff (SaveOnExit,
'Save changed files on exiting AE: ') ;
'I' : EnterWord (SaveInterval,
'Interval for auto-save in minutes (0 = off): ',
0, 1000) ;
'B' : ChooseOnOff (MakeBAKfile, 'Make .BAK file when saving: ') ;
'W' : ChooseOnOff (SaveWork, 'Save workspace on exit: ') ;
END ; { of case }
'P' : CASE Choose ('Page-length Left-margin Top-margin page-Numbers',
'Printer: ') OF
'P' : EnterWord (PageLength,
'Lines per page for paged prints (0 = off): ',
0, 1000) ;
'L' : EnterWord (LeftMargin, 'Left margin: ', 0, 240) ;
'T' : EnterWord (TopMargin, 'Top margin: ', 0, 1000) ;
'N' : ChooseOnOff (PrintPagenrs, 'Print page numbers: ') ;
END ; { of case }
'S' : BEGIN
GETDIR (0,SetupDir) ;
EnterString (SetupDir, NIL, 'Save setup in directory: ',
67, TRUE, TRUE) ;
IF NOT EscPressed
THEN
BEGIN
ASSIGN (ConfigFile, SetupDir+'\'+ConfigFilename) ;
REWRITE (ConfigFile) ;
WRITE (ConfigFile, Config) ;
CheckDiskerror ;
CLOSE (ConfigFile) ;
IF DiskError = 0
THEN Message (Copy('Setup saved as '+SetupDir+'\'+
ConfigFilename, 1, 80)) ;
END ;
END ;
END ; { of case }
END ; { of with }
END ;

{-----------------------------------------------------------------------------}
{ Formats text, starting from position P until the next empty line }
{-----------------------------------------------------------------------------}

PROCEDURE FormatParagraph (VAR P : position) ;

VAR Index2, Index3 : WORD ;
FreeSpace : WORD ;
Margin : WORD ;
Ready : BOOLEAN ;
LFsseen : WORD ;
Counter : WORD ;

BEGIN
WITH CurrentWs DO
BEGIN
{ advance P to the end of this word, to avoid deleting the left margin }
{ (delimited by a space, CR, LF or EF) }
LFsseen := 0 ;
WHILE (Buffer^[P.Index] IN WordDelimiters) AND
(P.Index < BufferSize) DO
BEGIN
IF Buffer^[P.Index] = LF
THEN BEGIN
INC (P.Linenr) ;
INC (LFsseen) ;
P.Colnr := 1 ;
END
ELSE INC (P.Colnr) ;
INC (P.Index) ;
END ;
WHILE (NOT (Buffer^[P.Index] IN WordDelimiters)) AND
(P.Index < BufferSize) DO
BEGIN
INC (P.Colnr) ;
INC (P.Index) ;
END ;
{ calculate left margin }
IF Config.Setup.AutoIndent
THEN Margin := LeftMargin (P)
ELSE Margin := 1 ;
{ move rest of text to back of buffer }
FreeSpace := WsBufSize-BufferSize ;
IF Grow (P.Index, FreeSpace)
THEN BEGIN
{ set Index2 and Index3 to start of rest of text }
Index2 := P.Index + FreeSpace ;
Index3 := Index2 ;
Ready := (LFsseen > 0) ;
WHILE NOT Ready DO
BEGIN
{ advance Index2 to start of next word, }
{ counting linefeeds skipped }
LFsseen := 0 ;
WHILE (Buffer^[Index2] IN WordDelimiters) AND
(Index2 < BufferSize) DO
BEGIN
IF Buffer^[Index2] = LF
THEN INC (LFsseen) ;
INC (Index2) ;
END ;
Ready := (LFsseen > 1) OR (Index2 >= BufferSize) ;
IF NOT Ready
THEN BEGIN
{ advance Index3 to the end of the word }
Index3 := Index2 ;
WHILE (NOT (Buffer^[Index3] IN WordDelimiters)) AND
(Index3 < BufferSize) DO
INC (Index3) ;
{ test if adding word would make line too long }
IF P.Colnr + (Index3-Index2) >
Config.Setup.WordWrapLength
THEN BEGIN
{ break line after P (if enough room) }
IF (P.Index-Index2) >= (Margin + 1)
THEN BEGIN
Buffer^[P.Index] := CR ;
Buffer^[P.Index+1] := LF ;
FOR Counter := 1 TO (Margin-1) DO
Buffer^[P.Index+1+Counter] :=
' ' ;
INC (P.Index, Margin+1) ;
P.Colnr := Margin ;
INC (P.Linenr) ;
END
ELSE BEGIN
{ not enough room to do formatting }
ErrorMessage (1) ;
Ready := TRUE ;
END ;
END
ELSE BEGIN
{ put 1 space after P (if enough room) }
IF (P.Index-Index2) >= 1
THEN BEGIN
Buffer^[P.Index] := ' ' ;
INC (P.Index) ;
INC (P.Colnr) ;
END
ELSE BEGIN
{ not enough room to do formatting }
ErrorMessage (1) ;
Ready := TRUE ;
END ;
END ;
{ move word between Index2 and Index3 to P }
MOVE (Buffer^[Index2], Buffer^[P.Index],
(Index3-Index2)) ;
{ adjust P }
INC (P.Index, Index3-Index2) ;
INC (P.Colnr, Index3-Index2) ;
{ advance Index2 }
Index2 := Index3 ;
END ; { of if }
END ; { of while }
{ move remainder of text back, to just after formatted block }
Shrink (P.Index, Index3-P.Index) ;
END ; { of if }
END ; { of with }
END ;

{-----------------------------------------------------------------------------}

END.