Boxquote-and-Footnotes
From 40tude Dialog Wiki
This script is a merged OnBeforeSending-Script, containing the following scripts:
Please read the introductions for every script linked above, to configure this merged script correctly. Otherwise it may not work!
For help on using boxquotes, have a look here and for help on making footnotes look here.
program OnBeforeSendingMessage;
const
//
// BoxQuote Support:
// configure your settings here:
//
StartLine_close_box = 'box:';
StartLine_open_box = 'box_o:';
Separator = '-';
//
// Footnote Support:
// configure your settings here:
//
ConstFootnoteHead = true;
ConstFootnoteHeadTxt = 'Footnotes:';
ConstFootnoteHeadUnderline = '=';
ConstEmptyLine = false;
ConstStartupFootnote = '#fn#';
ConstEndFootnote = '##';
ConstReWrapEdge = 73;
ConstMultiLine = '%%';
ConstRewrapToLine = '<<';
ConstComments = '//';
ConstEmptyLineBeforeFootnote = true;
// --------------------------------------------------------------- //
// ---- No user maintainable parts below this line -------------- //
// --------------------------------------------------------------- //
MaxInt = 2147483647;
//
// Flags to indicate the buttons contained in the message box:
//
MB_OK = 0; // 1 button: OK.
MB_OKCancel = 1; // 2 buttons: OK and Cancel.
MB_AbortRetryIgnore = 2; // 3 buttons: Abort, Retry, and Ignore.
MB_VbYesNoCancel = 3; // 3 buttons: Yes, No, and Cancel.
MB_YesNo = 4; // 2 buttons: Yes and No.
MB_RetryCancel = 5; // 2 buttons: Retry and Cancel.
//
// Flags to display an icon in the message box:
//
MB_IconCritical = 16; // stop-sign
MB_IconQuestion = 32; // question-mark
MB_IconExclamation = 48; // exclamation-point
MB_IconInformation = 64; // lowercase i in a circle
//
// BoxQuote Constants
//
bq1a=',';
bq1b='-';
bq1c='.';
bq2a='|';
bq2c='|';
bq3a=''+#39+'';
bq3b='-';
bq3c=''+#39+'';
LineWidthTop = 4;
LineWidthBottom = 4;
s_no_bq=0;
s_bq_title=1;
s_bq_content=2;
//
// program BoxQuote - Date: 2004/11/05
//
function StringReplaceM(
S : String;
OldPattern : String;
NewPattern : String;
replaceall : Boolean;
ignorecase : Boolean
) : String;
var
SearchStr : String;
Patt : String;
NewStr : String;
Offset : Integer;
begin
if IgnoreCase then begin
SearchStr := AnsiUpperCase( S );
Patt := AnsiUpperCase( OldPattern );
end
else begin
SearchStr := S;
Patt := OldPattern;
end;
NewStr := S;
Result := '';
while SearchStr <> '' do begin
Offset := AnsiPos(Patt, SearchStr);
if Offset = 0 then begin
result := result + NewStr;
break;
end;
result := result + Copy( NewStr, 1, Offset - 1 ) + NewPattern;
NewStr := Copy( NewStr, Offset + Length(OldPattern), MaxInt );
if not ReplaceAll then begin
Result := Result + NewStr;
break;
end;
SearchStr := Copy( SearchStr, Offset + Length(Patt), MaxInt );
end;
end; // function StringReplaceM()
function RepeatChar(
c : Char;
count : Integer
) : String;
var
i : Integer;
begin
if count < 0 then count := 0;
SetLength( result, count );
for i:=1 to count do result[i] := c;
end; // function RepeatChar()
function CountChars(
s : String;
c : Char
) : Integer;
var
i : Integer;
begin
result := 0;
for i := 1 to Length( s ) do if s[i] = c then result := result + 1;
end; // function CountChars()
procedure BoxQuote(
var Message : TStringlist
);
var
i, j, k : Integer;
state : Word;
bq_startline : Integer;
bq_title : String;
bq_content : String;
maxwidth : Integer;
sl : Tstringlist;
CloseBox : Boolean;
begin
state := s_no_bq;
i := 0;
bq_startline := -1;
while i <= message.count-1 do begin
case state of
s_no_bq: begin
if (message.strings[i] = StartLine_close_box)
or (message.strings[i] = StartLine_open_box)
then begin
if message.strings[i] = StartLine_close_box
then CloseBox := true
else CloseBox := false;
bq_startline := i;
bq_title := '';
bq_content := '';
maxwidth := 1;
state := s_bq_title;
end
end;
s_bq_title: begin
if message.strings[i] = Separator
then state := s_bq_content
else bq_title := trim( bq_title + ' ' + message.strings[i] );
end;
s_bq_content: begin
if message.strings[i]=Separator then begin
state:=s_no_bq;
if Length( '[' + bq_title + ']' ) > maxwidth
then maxwidth := Length( '[' + bq_title + ']' ) + 6;
//
// delete the raw BoxQuote
//
for j := bq_startline to i do message.delete( bq_startline );
//
// middle part
//
bq_content := stringreplacem( #13#10 + bq_content,
#13#10, #13#10 + bq2a + ' ',
true, false );
delete( bq_content, 1, 2 );
//
// first line
//
if bq_title <> ''
then bq_content := bq1a
+ RepeatChar( bq1b, LineWidthTop )
+ ' [' + bq_title + '] '
+ #13#10
+ bq_content
else bq_content := bq1a
+ RepeatChar( bq1b, LineWidthTop )
+ #13#10
+ bq_content;
//
// last line
//
bq_content := bq_content + #13#10 + bq3a + RepeatChar( bq3b, LineWidthBottom );
sl := Tstringlist.create;
try
sl.text := bq_content;
//
// close the box
//
if CloseBox then begin
for j:=0 to sl.count-1 do begin
k := maxwidth - length( sl.strings[j] );
if j=0
then sl.strings[j] := sl.strings[j] + repeatchar( bq1b,k + 3 ) + bq1c
else if j = sl.count-1
then sl.strings[j] := sl.strings[j] + repeatchar( bq3b,k + 3 ) + bq3c
else sl.strings[j] := sl.strings[j] + repeatchar(' ', k + 3) + bq2c;
end;
end;
message.insert( bq_startline, trim(sl.text) );
i := bq_startline;
finally
sl.free;
end;
end
else begin
if bq_content = ''
then bq_content := message.strings[i]
else bq_content := bq_content + #13#10 + message.strings[i];
if Length( message.strings[i] ) > maxwidth
then maxwidth := length( message.strings[i] );
end;
end;
end; // case
i := i + 1;
end;
end; // procedure BoxQuote()
//
// program Footnotes - Date: 2004/11/05
//
function MessageBox( hWnd : Cardinal; lpText, lpCaption : PChar; uType : longword ) : Integer;
external 'MessageBoxA@user32.dll stdcall';
function GetText(
var Txt : TStringlist;
var FoundLine : Integer;
var FoundPosi : Integer;
var CurrLine : Integer;
var CurrPosi : Integer
) : String; // Function by Mirko D. Walter
var
res : String;
i : Integer;
bposi : Integer;
begin
result :='';
res := '';
if FoundLine = CurrLine then begin
res := Copy( txt.strings[foundline], FoundPosi, CurrPosi - FoundPosi );
end
else begin
BPosi := FoundPosi;
for i := FoundLine to CurrLine do begin
if i < CurrLine then begin
res := Res + Trim( Copy(txt.strings[i], BPosi, MaxInt) ) + ' ';
BPosi := 0;
end
else begin
res := res + Copy( txt.strings[i], 1, CurrPosi-1 );
end;
end;
end;
//
// Multine-Special-Character?
//
BPosi := AnsiPos( ConstMultiLine, res );
if BPosi > 0 then begin
repeat
//
// if the following characters are #13#10
// then do no linebreak, simply remove
// 1234567890123
// ABCDEF%%gaga#
//
if Copy( res, BPosi + Length(ConstMultiLine), 2 ) = #13#10
then res := Copy( res, 1, BPosi - 1 )
+ #13#10
+ Trim( Copy(res, BPosi + Length(ConstMultiLine), MaxInt) )
else res := Copy( res, 1, BPosi - 1 )
+ #13#10
+ #13#10
+ Trim( Copy(res, BPosi + Length(ConstMultiLine), MaxInt) );
BPosi := AnsiPos( ConstMultiLine, res );
until BPosi <= 0;
res := Trim( res );
end;
result := Trim( res );
end; // function GetText()
function Rewrap_Str(
StrL : String;
WEdge : Integer;
FootNote : Boolean
) : String;
var
Space_Old : Integer;
Space_New : Integer;
i : Integer;
Space_Pos : Integer;
Break_L : Boolean;
begin
Space_Old := 1;
Space_New := 1;
Space_Pos := WEdge;
if Copy( StrL, Length(StrL), 1 ) <> ' '
then StrL := StrL + ' ';
if AnsiPos( ConstRewrapToLine, StrL ) > 0
then Delete( StrL, AnsiPos(ConstRewrapToLine, StrL), 2 );
for i:=1 to Length( StrL ) do begin
if (StrL[i] = ' ') and (i > 1) and (i < Length(StrL)) then begin
if StrL[i+1] = ' ' then begin // found double blank
if (StrL[i-1] <> '.') // it's perfectly fine to
and (StrL[i-1] <> '?') // have double blanks after
and (StrL[i-1] <> '!') // punctuation marks (at
and (StrL[i-1] <> ':') // least beyond sentence
and (StrL[i-1] <> ';') // delimiters).
then begin // but otherwise not!
Delete( StrL, i, 1 );
end;
end;
end;
end;
i := 0;
while i <= Length( StrL ) do begin
i := i + 1;
if (Copy(StrL, i, 1) = ' ')
or (Copy(StrL, i, 4) = (#13#10 + #13#10))
then begin
Break_L := false;
Space_Old := Space_New;
Space_New := i;
if Copy( StrL, i , 4 ) = (#13#10 + #13#10) then begin
Insert( ' ', StrL, i + 4 );
Break_L := true;
if Space_New < Space_Pos then begin
Space_Pos := i + 4 + WEdge;
Space_Old := i + 4;
Space_New := i + 4;
i := i + 4;
end;
end;
if (Space_New >= Space_Pos)
and (Space_old <= Space_Pos)
then begin
if (Space_New = Space_Pos)
and (Length(StrL) > Space_Pos)
then begin
if Footnote = false then begin
Delete( StrL, Space_New, 1 );
Insert( #13#10, StrL, Space_New );
Space_Pos := Space_New + WEdge + 1;
end
else begin
Insert( #13#10 + ' ', StrL, Space_New );
if Break_L then begin
Space_Pos := i + 4 + WEdge;
Space_Old := i + 4;
Space_New := i + 4;
i := i + 4;
end
else Space_Pos := Space_New + WEdge + 1;
i := i + 3;
end;
end
else begin
if Footnote = false then begin
if Length( StrL ) > Space_Pos then begin
Delete( StrL, Space_Old, 1 );
Insert( #13#10, StrL, Space_Old );
end;
Space_Pos := Space_Old + WEdge + 1;
if (Space_New >= Space_Pos)
and (Length(StrL) > Space_Pos)
then begin
Delete( StrL, Space_New + 1, 1 );
Insert( #13#10, StrL, Space_New + 1 );
Space_Pos := Space_New + WEdge + 2;
i := i + 1;
end;
end
else begin
if Space_Old > 5 then begin
if Length( StrL ) > Space_Pos
then Insert( #13#10 + ' ', StrL, Space_Old );
if Break_L then begin
Space_Pos := i + 4 + WEdge;
Space_Old := i + 4;
Space_New := i + 4;
i := i + 4;
end
else begin
Space_Pos := Space_Old + WEdge + 1;
if Space_New >= Space_Pos then begin
Insert( #13#10 + ' ', StrL, Space_New + 5 );
Space_Pos := Space_New + WEdge + 6;
end;
end;
i := i + 3;
end
else begin
Insert( #13#10 + ' ', StrL, Space_New );
Space_Pos := Space_New + WEdge + 1;
i := i + 3;
end;
end;
end;
i := i + 1;
end;
end;
end; // while
result := TrimRight( StrL );
end; // function Rewrap_Str()
function doFootNoteNew(
var Message : TStringlist
) : Boolean; // is message ok?
var
i : Integer;
Posi : Integer;
Mult_Posi : Integer;
FoundLine : Integer;
FoundPosi : Integer;
OLength : Integer;
RFoundPosi : Integer;
Rest : String;
FN_Temp : String;
FN : String;
FNR : Integer;
Skip : Boolean;
Sig : Boolean;
txt2 : String;
txt3 : String;
Temp_Str : String;
Add_txt3 : Boolean;
FootnoteStr : String;
zw : Integer;
begin
result := false;
if ConstFootnoteHead then begin
if Length( ConstFootnoteHeadUnderline ) = 1 then begin
for i := 1 to Length( ConstFootnoteHeadTxt ) do begin
FootnoteStr := FootnoteStr + ConstFootnoteHeadUnderline;
end;
end
else FootnoteStr := '';
end
else FootnoteStr := '';
i := -1;
posi := -1;
foundposi := -1;
rest := '';
fn := '';
sig := false;
fnr := 0;
txt2 := '';
txt3 := '';
Mult_Posi := -1;
Add_Txt3 := false;
FN_Temp := '';
Temp_Str := '';
while (i <= message.count-1) and (sig = false) do begin
if Rest = '' then begin
i := i + 1;
// ignore quotes and empty lines
Skip := true;
while Skip and (i <= message.count - 1) do begin
Skip := false;
if Sig then begin
txt2 := txt2 + message.strings[i] + #13#10;
i := i + 1;
Skip := true;
end
else begin
if Length( message.strings[i] ) > 0 then begin
if Copy( message.strings[i], 1, 1 ) = '>' then begin
txt2 := txt2 + message.strings[i] + #13#10;
i := i + 1;
Skip := true;
end;
if Length( message.strings[i] ) > 2 then begin
if Copy( message.strings[i], 1, 3 ) = '-- ' then begin
if Length( FN ) > 0 then begin
WriteToLog('FN: >' + FN + '<', 7);
if ConstEmptyLineBeforeFootnote = true then begin
txt2 := txt2 + #13#10 + FN;
end
else begin
txt2 := txt2 + FN;
end;
end;
Sig := true;
Skip := true;
end;
end;
end
else begin
txt2 := txt2 + message.strings[i] + #13#10;
i := i + 1;
Skip := true;
end;
end;
end;
if i > message.count-1 then break; // fix added by MM (Oct. 30th, 2003)
Rest := message.strings[i];
OLength := Length(Rest);
end;
if not Sig then begin
if FoundPosi > 0 then begin
Posi := AnsiPos( ConstEndFootNote, Rest );
if Posi > 0 then begin
Mult_Posi := AnsiPos( ConstStartupFootnote, Rest );
if (i + 1) = message.count
then Temp_Str := ''
else Temp_Str := message.strings[i + 1];
if (AnsiPos(ConstRewrapToLine, Rest) > 0)
or (Temp_Str = '')
or (Temp_Str = '-- ')
then begin
Add_Txt3 := false;
if Mult_Posi = 0 then begin
if AnsiPos( ConstRewrapToLine, Rest ) > 0
then txt3 := txt3
+ Copy( Rest, posi+Length(ConstEndFootnote),
AnsiPos(ConstRewrapToLine, Rest)+1 )
else txt3 := txt3
+ Copy( Rest, posi+Length(ConstEndFootnote), MaxInt );
end;
end
else Add_Txt3 := true;
zw := posi + olength - Length( rest );
FN_Temp := '[' + IntToStr(FNR) + '] '
+ GetText( message, FoundLine, FoundPosi, i, zw );
FN_Temp := Rewrap_Str( FN_Temp, ConstReWrapEdge, true );
if (FN = '')
and (FN_Temp <> '')
and (ConstFootnoteHead = true)
then begin
if FootnoteStr <> ''
then FN := ConstFootnoteHeadTxt + #13#10 + FootnoteStr + #13#10
else FN := ConstFootnoteHeadTxt + #13#10;
if ConstEmptyLine = true then FN := FN + #13#10;
end;
FN := FN + FN_Temp + #13#10;
// FN := FN
// + '[' + IntToStr(FNR) + '] '
// + GetText(message, FoundLine, FoundPosi, i, zw) + #13#10;
Rest := Copy( Rest,posi+Length(ConstEndFootnote), MaxInt );
If Rest = '' then Rest := ' '; //08.10.2004 !!
FoundPosi := -1;
Mult_Posi := -1;
end
else begin
Rest:='';
end;
end
else begin
// WriteToLog('R: ' + Rest, 7);
// 1. char = #, ignore this, could be a control character
if Copy( Rest + ' ', 1, Length(ConstComments) ) <> ConstComments then begin
Posi := AnsiPos(ConstStartupFootnote, Rest);
if Posi > 0 then begin
// WriteToLog('FN: ' + IntToStr(Posi), 7);
RFoundPosi := Posi + Length( ConstStartupFootnote );
FoundPosi := RFoundPosi + OLength - Length( Rest );
FoundLine := i;
FNR := FNR + 1;
// txt2 := txt2 + Copy( Rest, 1, Posi - 1 ) + '[' + IntToStr(FNR) + ']';
txt3 := txt3 + Copy( Rest, 1, Posi - 1 ) + '[' + IntToStr(FNR) + ']';
Rest := Copy( Rest, RFoundPosi, MaxInt ); // 08.10.2004 Trim entfernt
end
else begin
if FoundPosi = -1 then begin
if Add_Txt3 then txt3 := txt3 + Rest + ' ';
if (i + 1) = message.count
then Temp_Str := ''
else Temp_Str := message.strings[i + 1];
if ( (AnsiPos(ConstRewrapToLine, Rest) > 0)
or (Temp_Str = '') or (Temp_Str = '-- '))
and (txt3 <> '')
then begin
Add_Txt3 := false;
txt3 := Rewrap_Str( txt3, ConstReWrapEdge, false );
txt2 := txt2 + txt3;
txt3 := '';
Rest := '';
end;
if Add_Txt3 = false then txt2 := txt2 + Rest + #13#10;
Rest := '';
end;
end;
end
else begin
txt2 := txt2 + Rest + #13#10;
Rest := '';
end;
end;
end;
end;
if txt3 = '' then begin
result := true;
if Sig = false then begin
if Length( FN ) > 0 then begin
message.text := txt2 + #13#10 + FN;
end;
end
else message.text := txt2;
end
else begin
message.text := message.text;
result := false;
MessageBox( 0, 'End-Tag ''' + ConstEndFootnote + ''' of footnote not found!',
'Abort sending!', MB_OK or MB_IconExclamation );
end;
end; // function doFootNoteNew()
//
// Event OnBeforeSending
//
function OnBeforeSendingMessage(
var Message : TStringlist;
const Servername : String;
const IsEmail : Boolean
) : Boolean;
begin
result := doFootNoteNew( Message );
BoxQuote( Message );
end;
begin
end.
René Fischer