Boxquote-footnote-fup2-and-xpost-warning

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;

// 1.: Add X-Post & FUp2 indication
// 2.: Footnote Support
// 3.: BoxQuote Support
//     Example:
//        box_o:
//        Box-Title
//        -
//        aslkdjl aksdj lkajsd lkjalsdkj lakj sadalksjd
//        lkqjlakjasl dlakjsd lkjaslkdj laksjdlk ajsldkj
//        lkaj sdlkjalskjd lkajsd lkjaldskj lkajsdl kjas
//        -
//
// If you use Footnotes in BoxQuotes, you have to put an <<
// (ConstRewrapToLine) at the end of your boxquoted text.
// Otherwise, your BoxQuote will be destroyed.

const
   //
   // Add X-Post & FUp2 indication:
   //    configure your preferred Messages here:
   //
   MessageXPost = 'X'+#39+'Posted to:';    // X-Post-Prefix
   MessageFup2  = 'F'+#39+'Up2:';          // FUp2-Prefix

   //
   // Footnote-Support:
   //    configure your settings here:
   //
   ConstFootnoteHead            = true;
   ConstFootnoteHeadTxt         = 'Footnotes:';
   ConstFootnoteHeadUnderline   = '=';
   ConstEmptyLine               = false;
   ConstStartupFootnote         = '#fn#';
   ConstEndFootnote             = '##';
   ConstReWrapEdge              = 73;
   ConstMultiLine               = '%%';
   ConstRewrapToLine            = '<<';
   ConstComments                = '//';
   ConstEmptyLineBeforeFootnote = false;

   //
   // BoxQuote-Support:
   //    configure your settings here:
   //
   StartLine_close_box = 'box:';
   StartLine_open_box  = 'box_o:';
   Separator           = '-';


   // --------------------------------------------------------------- //
   // ----  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;


//
// Introduction for XPost/Fup2-Message
// change message as you want to
//
procedure XPost_and_FUp2_Information(
   var   Message : TStringlist;
   const IsEmail : Boolean
);

var
   FUP2, XPost, Header       : Boolean;
   i, SigLine                : Integer;
   s, Fup2Group, XPostGroups : String;

begin
   // if IsEmail then exit;                // unREM if not for Emails
   FUP2    := false;
   XPost   := false;
   Header  := true;
   SigLine := 0;

   for i := 0 to Message.count-1 do begin
      s := message.strings[i];
      if s = '' then header := false;      // scan only headers
      if header = true then begin
         if Pos( 'Followup-To:', s ) > 0 then begin
            FUP2 := true;
            Fup2Group := Copy( s, 13, Length(s)-12 );
            // WriteToLog(MessageFup2+Fup2Group,1);
         end;
         if Pos( 'Newsgroups:', s ) > 0 then begin
            if Pos( ',', s ) > 0 then begin
               XPost := true;
               XPostGroups := Copy( s, 12, Length(s)-11 );
               // WriteToLog(MessageXPost+XPostGroups,1);
            end;
         end;
      end
      else begin
         if s = '-- ' then SigLine := i;
      end;
      //  WriteToLog( 'Analysierte Zeile: '+s, 1 );
   end;
   if FUP2 or XPost then Message.Add( '' );
   if FUP2 then begin
      if Sigline = 0
         then Message.Add( MessageFup2+Fup2Group )
         else Message.Insert( Sigline, MessageFup2+Fup2Group );
   end;
   if XPost then begin
      if Sigline = 0
         then Message.Add( MessageXPost+XPostGroups )
         else Message.Insert( Sigline, MessageXPost+XPostGroups );
   end;
   if FUP2 or XPost then begin
      if Sigline = 0
         then Message.Add( '' )
         else Message.Insert( SigLine, '' );
   end;
end;  // procedure XPost_and_FUp2_Information()


//
// 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()


//
// 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()


//
// our "local main"  ;o)
//
function OnBeforeSendingMessage(
   var   Message    : TStringlist;
   const Servername : String;
   const IsEmail    : Boolean
) : Boolean;

begin
   result := doFootNoteNew( Message );
   if Message.count < 500 then BoxQuote( Message );
   XPost_and_FUp2_Information( Message, IsEmail );
end;  // function OnBeforeSendingMessage()


begin
end.


René Fischer