sourceformat.pas

DelphiDoc is a program for automatic generation of documentation on a Delphi-Project. At the momen

{  JADD - Just Another DelphiDoc: Documentation from Delphi Source Code

Copyright (C) 2004-2008   Gerold Veith

This file is part of JADD - Just Another DelphiDoc.

DelphiDoc is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License version 3 as
published by the Free Software Foundation.

DelphiDoc is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program.  If not, see <http://www.gnu.org/licenses/>.
}


unit SourceFormat;

{Contains some simple types, constants and functions to simpler highlight text.
 Used by the components to show pascal code with syntax highlighting. }

interface

uses
{$IFNDEF LINUX}
     Graphics,
{$ELSE}
     QGraphics,
{$ENDIF}
     UPascalConsts, UBaseIdents;



     //state of a position in a text
type TTextState = (
                   tsNormal,            //normal text in the source code
                   tsString,            //inside a string
                   tsCommentToLineEnd,  //in a comment //...
                   tsCommentCurly,      //in a comment {...}
                   tsCommentBraceStar); //in a comment (*...*)

      //all states of comments
const tsAllComments = [tsCommentToLineEnd, tsCommentCurly, tsCommentBraceStar];

      //characters of words
const WordChars = IdentifierChars;




//Returns whether the word is a keyword or directive and should be written in
//bold.
function IsKeyWord(Word: String): Boolean;

//Returns the state the text is in at its end.
function SkipString(S: String; StartState: TCommentType): TTextState;

//Returns the text token by token with the state of the token.
function GetTextOfOneState(var Text: String; var State: TTextState): String;


//Draws a text of one state.
procedure DrawTextInState(Canvas: TCanvas; X, Y: Integer;
                          Text: String; State: TTextState; Selected: Boolean);



implementation

uses SysUtils;


      //the words to write bold (reserved words and directives)
const KeyWords: array[0..73] of String =
                    ('and', 'array', 'as', 'asm', 'at',
                     'automated', 'begin', 'case', 'class', 'const',
                     'constructor', 'destructor', 'dispinterface', 'div', 'do',
                     'downto', 'else', 'end', 'except', 'exports',
                     'file', 'finalization', 'finally', 'for', 'function',
                     'goto', 'if', 'implementation', 'in', 'inherited',
                     'initialization', 'inline', 'interface', 'is', 'label',
                     'library', 'message', 'mod', 'nil', 'not',
                     'object', 'of', 'on', 'or', 'out',
                     'overload', 'packed', 'private', 'procedure', 'program',
                     'property', 'protected', 'public', 'published', 'raise',
                     'record', 'repeat', 'resourcestring', 'set', 'shl',
                     'shr', 'string', 'then', 'threadvar', 'to',
                     'try', 'type', 'unit', 'until', 'uses',
                     'var', 'while', 'with', 'xor');




{Returns whether the word is a keyword or directive and should be written in
 bold.
~param Word the word to check if it is a keyword or directive
~result whether the word is a keyword or directive }
function IsKeyWord(Word: String): Boolean;
var      l, r, m :Integer;         //left-, right-, middle-indices
         cmp     :Integer;         //result of string-compare
begin
 Word := LowerCase(Word);
 l := low(KeyWords);               //search whole list
 r := high(KeyWords);
 repeat
   m := (l + r) div 2;               //get the index in the middle
   //compare word with the item in the middle
   cmp := CompareStr(Word, KeyWords[m]);
   if cmp > 0 then                   //resume search in the correct half
    l := m + 1
   else
    r := m - 1;
 until (l > r) or (cmp = 0);       //until word has been found or not
 Result := cmp = 0;                //return if the word is a keyword
end;


{Returns the state the text is in at its end.
~param S          the text to check for the state
~param StartState the state the text starts in
~result the state at the end of the text }
function SkipString(S: String; StartState: TCommentType): TTextState;
var      i         :Integer;                  //index in the text
         c         :Char;                     //a character in the text
begin
 case StartState of                           //translate the state
// lsNone:      Result := tsNormal;
   ctCurly:     Result := tsCommentCurly;
   ctBraceStar: Result := tsCommentBraceStar;
 else
  Result := tsNormal;
 end;

 //until the end of the text has been reached
 while S <> '' do
  begin
   case Result of                               //handle its by its state
     tsNormal:           begin                  //normal text
                          c := S[1];              //get the first character
                          Delete(S, 1, 1);        //and remove it
                          if c = '{' then         //change state if neccessary
                           Result := tsCommentCurly
                          else
                           if c = '''' then
                            Result := tsString
                           else
                            if S <> '' then
                             if (c = '/') and (S[1] = '/') then
                              begin
                               Result := tsCommentToLineEnd;
                               Delete(S, 1, 1);
                              end
                             else
                              if (c = '(') and (S[1] = '*') then
                               begin
                                Result := tsCommentBraceStar;
                                Delete(S, 1, 1);
                               end
                         end;
     tsString:           begin                  //inside a string
                          i := pos('''', S);      //search for its end
                          if i = 0 then           //goes beyond the text?
                           S := ''                  //finish with this state
                          else
                           begin
                            Delete(S, 1, i);        //delete the string
                            Result := tsNormal;     //and back to normal text
                           end;
                         end;
     tsCommentToLineEnd:                        //comment to the end of line
                         S := '';                 //whole line is a comment
                                                  //keep comment state
     tsCommentCurly:     begin                  //inside a {} comment
                          i := pos('}', S);       //search for its end
                          if i = 0 then           //goes beyond the text?
                           S := ''                  //finish with this state
                          else
                           begin
                            Delete(S, 1, i);        //delete the comment
                            Result := tsNormal;     //and back to normal text
                           end;
                         end;
     tsCommentBraceStar: begin                  //inside a (**) comment
                          i := pos('*)', S);      //search for its end
                          if i = 0 then           //goes beyond the text?
                           S := ''                  //finish with this state
                          else
                           begin
                            Delete(S, 1, i + 1);    //delete the comment
                            Result := tsNormal;     //and back to normal text
                           end;
                         end;
   end; //case Result
  end; //while S <> ''
end;


{Returns the text token by token with the state of the token.
~param Text  the text to extract tokens from
~param State the kind of the token
~result the token/text in the state }
function GetTextOfOneState(var Text: String; var State: TTextState): String;

 {Returns the text inside current the state. }
 procedure GetStateText;
 var       S           :String;    //text to extract the text in the state from
           i           :Integer;   //index inside the text
 begin
  S := Text;                        //get the text
  case State of                     //extract depending on the state
    tsString:           begin         //in a string
                         repeat         //extract the string until a single "'"
                           i := pos('''', S);       //find the next "'"
                           if i = 0 then            //not found?
                            begin
                             Result := Result + S;    //return all the text
                             S := ''                  //no text left
                            end
                           else
                            begin                     //return the text up to it
                             Result := Result + copy(S, 1, i);