Synedit syntax-highlighter for HL7 v2.x messages - delphi

Question

I am looking at contributing to the Delphi SynEdit project with a syntax-highlighter for the Health Level 7 (HL7) v2 messaging Standard. I have no experience of creating a highlighter from scratch and there are two quirks that I have stumbled upon that differ from existing highlighters:
Fixed position keywords - first three characters of every line
Delimiters are defined in the begining of the message
Is there anyone out there who has any SynEdit experice with HL7 or similar syntaxes e.g. Edifact, X12?
Prototype
I've created a crude prototype using the OnPaintTransient event-handler which in fact works better than I anticipated :-) Basically it does the following:
Highlight each Segment ID navy-blue - first three characters on ever line. No checking done if the value is a valid segment.
Highlight all field delimiters grey - defined as the fourth character in MSH segment
Highlight all other delimiters blue - defined in the field called
Encoding Characters, which is the first field after the MSH segment ID.
The delimiter values used in the MSH segment are the delimiter values used throughout the entire message.
skip highlighting if underlying text is selected - looks prettier in my implementation.
Below is a screen-dump of the results when inserting the example message found at Wikipedia http://en.wikipedia.org/wiki/Health_Level_7 into a TSynMemo component.
Code OnPaintTransient
procedure TFormMain.SynMemoMsgPaintTransient(Sender: TObject; Canvas: TCanvas;
TransientType: TTransientType);
var
i, j: Integer;
DP: TDisplayCoord;
SelStartCoord, SelEndCoord, BC : TBufferCoord;
Pt: TPoint;
FieldDelimiter : char; // MSH|
Delimiters : string; // All message delimiters (including field delimiter)
IsSelected : boolean;
begin
//Avoid drawing twice - Only enter if TransientType = ttAfter.
if TransientType = ttBefore then exit;
//Exit if no text
if SynMemoMsg.Lines.Count = 0 then exit;
//Exit if message does not start with MSH (Message header segment)
if not AnsiStartsText('MSH', SynMemoMsg.Lines[0]) then exit;
//Get the message's delimiters specified as the characters directly after MSH
FieldDelimiter := Copy(SynMemoMsg.Lines[0], 4, 1)[1];
Delimiters := Copy(SynMemoMsg.Lines[0], 4, 5);
//Find out if any text is selected by the user - we will exclude this text from highlighting
SelStartCoord := SynMemoMsg.CharIndexToRowCol(SynMemoMsg.SelStart);
SelEndCoord := SynMemoMsg.CharIndexToRowCol(SynMemoMsg.SelEnd);
//parse evry visible line
for i := SynMemoMsg.TopLine to ((SynMemoMsg.TopLine + SynMemoMsg.LinesInWindow )-1) do
begin
//Highlight Segment ID, i.e. in this implementation the first 3 chars in each line
BC.Char := 1;
BC.Line := i;
//If whole line is selected then continue to next line without highlighting current
if (SelStartCoord.Line < BC.Line) and (SelEndCoord.Line > BC.Line) then continue;
DP := SynMemoMsg.BufferToDisplayPos(BC);
Pt := SynMemoMsg.RowColumnToPixels(DP);
if ((SelStartCoord.Line = BC.Line) and (SelStartCoord.Char > 3))
or ((SelStartCoord.Line <> BC.Line) and (SelEndCoord.Line <> BC.Line))
or (SynMemoMsg.SelLength = 0) then
begin
Canvas.Font.Color := clNavy;
Canvas.Font.Style := [fsBold];
Canvas.TextOut (Pt.X - 1, Pt.Y, Copy(SynMemoMsg.Lines[i - 1], 1, 3)); //Move the Bold text one pixel left to get space i.e. Pt.X - 1)
end;
//Highlight Delimiters - parse each charachter and check if delimiter and not selected
for j := 4 to Length(SynMemoMsg.Lines[i - 1]) do
begin
if IsDelimiter(Delimiters, SynMemoMsg.Lines[i - 1], j) then
begin
BC.Char := j;
BC.Line := i;
//Don't highlight delimiter if selected
if (SynMemoMsg.SelLength > 0) and ((SelStartCoord.Line = BC.Line)or (SelEndCoord.Line = BC.Line)) then
begin
if (SelStartCoord.Line = BC.Line) and (SelEndCoord.Line = BC.Line) then
IsSelected := (SelStartCoord.Char <= BC.Char) and (SelEndCoord.Char > BC.Char)
else if (SelStartCoord.Line = BC.Line) then
IsSelected := SelStartCoord.Char <= BC.Char
else if (SelEndCoord.Line = BC.Line) then
IsSelected := SelEndCoord.Char > BC.Char;
end
else
IsSelected := false;
if not IsSelected then begin
DP := SynMemoMsg.BufferToDisplayPos(BC);
Pt := SynMemoMsg.RowColumnToPixels(DP);
if FieldDelimiter = SynMemoMsg.Lines[i - 1][j] then
Canvas.Font.Color := clGray
else
Canvas.Font.Color := clBlue;
Canvas.TextOut (Pt.X, Pt.Y, Copy(SynMemoMsg.Lines[i - 1], j, 1));
end;
end;
end;
end;
end;

Answer 1

Well I ended up making my own SynEdit syntax-highlighter for HL7 v2.x messaging.
It may not have all the bells and whistles but it’s a good start. My implementation uses Delphi XE3.
Usage:
Copy the SynHighlighterHL7.pas unit found below to your synedit project source folder.
Add SynHighlighterHL7.pas to your project and to the Uses clause.
Add a TSynEdit or TSynMemo component to a form
Add the following code to the form's OnCreate event handler:
Code:
fSynHL7Syn := TSynHL7Syn.Create(Self);
SynMemoMsg.Highlighter := fSynHL7Syn;
SynHighlighterHL7.pas unit:
unit SynHighlighterHL7;
{$I SynEdit.inc}
interface
uses
Classes,
Graphics,
StrUtils,
SynEditTypes,
SynEditHighlighter,
SynUnicode;
const
DEF_FIELD_DELIM = '|'; //Filed seperator
DEF_COMP_DELIM = '^'; //Component seperator
DEF_SUBCOMP_DELIM = '&'; //Sub-component seperator
DEF_ESC_DELIM = '\'; //Escape seperator
DEF_REP_DELIM = '~'; //Repetition seperator
type
TtkTokenKind = (tkSegmentID, tkFieldDelim, tkCompDelim, tkSubCompDelim,
tkEscDelim, tkRepDelim, tkText, tkSpace, tkNull, tkUnknown);
//Keeps track if we're in a message with properly defined delimiters
TRangeState = (rsUnknown, rsMshDelim, rsDefDelim);
type
TSynHL7Syn = class(TSynCustomHighlighter)
private
fRange : TRangeState;
fFieldDelim : char;
fCompDelim : char;
fSubCompDelim : char;
fEscDelim : char;
fRepDelim : char;
FTokenID: TtkTokenKind;
fSegmentIDAttri: TSynHighlighterAttributes;
fFieldDelimAttri: TSynHighlighterAttributes;
fCompDelimAttri: TSynHighlighterAttributes;
fSubCompDelimAttri: TSynHighlighterAttributes;
fEscDelimAttri: TSynHighlighterAttributes;
fRepDelimAttri: TSynHighlighterAttributes;
fUnknownAttri: TSynHighlighterAttributes;
fSpaceAttri : TSynHighlighterAttributes;
fTextAttri: TSynHighlighterAttributes;
procedure SegmentIDProc;
procedure UnknownProc;
procedure CRProc;
procedure TextProc;
procedure LFProc;
procedure NullProc;
procedure SpaceProc;
procedure FieldDelimProc;
procedure CompDelimProc;
procedure EscDelimProc;
procedure RepDelimProc;
procedure SubCompDelimProc;
procedure SetRangeState(const Line: string);
protected
function GetSampleSource: UnicodeString; override;
function IsFilterStored: Boolean; override;
public
function GetRange: Pointer; override;
procedure ResetRange; override;
procedure SetRange(Value: Pointer); override;
class function GetLanguageName: string; override;
class function GetFriendlyLanguageName: UnicodeString; override;
public
constructor Create(AOwner: TComponent); override;
function GetDefaultAttribute(Index: integer): TSynHighlighterAttributes;
override;
function GetEol: Boolean; override;
function GetTokenID: TtkTokenKind;
function GetTokenAttribute: TSynHighlighterAttributes; override;
function GetTokenKind: integer; override;
procedure Next; override;
published
property SegmentIDAttri: TSynHighlighterAttributes read fSegmentIDAttri
write fSegmentIDAttri;
property TextAttri: TSynHighlighterAttributes read fTextAttri
write fTextAttri;
end;
implementation
uses
SynEditStrConst;
constructor TSynHL7Syn.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
fCaseSensitive := true;
fSegmentIDAttri := TSynHighlighterAttributes.Create('Seg ID', 'Segment ID');
fSegmentIDAttri.Style := [fsBold];
fSegmentIDAttri.Foreground := clNavy;
AddAttribute(fSegmentIDAttri);
fFieldDelimAttri := TSynHighlighterAttributes.Create('Field Sep', 'Field Seperator (|)');
fFieldDelimAttri.Foreground := clGray;
AddAttribute(fFieldDelimAttri);
fCompDelimAttri := TSynHighlighterAttributes.Create('Comp Sep', 'Component Seperator (^)');
fCompDelimAttri.Foreground := clBlue;
AddAttribute(fCompDelimAttri);
fSubCompDelimAttri := TSynHighlighterAttributes.Create('Sub-Comp Sep', 'Sub-Component Seperator (&)');
fSubCompDelimAttri.Foreground := clBlue;
AddAttribute(fSubCompDelimAttri);
fRepDelimAttri := TSynHighlighterAttributes.Create('Rep Sep', 'Repeat Seperator (&)');
fRepDelimAttri.Foreground := clBlue;
AddAttribute(fRepDelimAttri);
fEscDelimAttri := TSynHighlighterAttributes.Create('Esc Sep', 'Escape Seperator (\)');
fEscDelimAttri.Style := [fsBold];
fEscDelimAttri.Foreground := clGreen;
AddAttribute(fEscDelimAttri);
fUnknownAttri := TSynHighlighterAttributes.Create('Unknown', 'Non HL7 message i.e arbitary text');
fUnknownAttri.Style := [fsItalic];
fUnknownAttri.Foreground := clRed;
AddAttribute(fUnknownAttri);
fTextAttri := TSynHighlighterAttributes.Create(SYNS_AttrText, SYNS_FriendlyAttrText);
AddAttribute(fTextAttri);
fSpaceAttri := TSynHighlighterAttributes.Create(SYNS_AttrSpace, SYNS_FriendlyAttrSpace);
AddAttribute(fSpaceAttri);
SetAttributesOnChange(DefHighlightChange);
fDefaultFilter := SYNS_FilterINI;
end; { Create }
procedure TSynHL7Syn.FieldDelimProc;
begin
inc(Run);
fTokenID := tkFieldDelim;
end;
procedure TSynHL7Syn.CompDelimProc;
begin
inc(Run);
fTokenID := tkCompDelim;
end;
procedure TSynHL7Syn.SubCompDelimProc;
begin
inc(Run);
fTokenID := tkSubCompDelim;
end;
procedure TSynHL7Syn.EscDelimProc;
begin
fTokenID := tkEscDelim;
//If current position is not the first MSH field then expand token untill
//closing Escape delimiter is found on current line
if not((Run = 6) and StartsStr('MSH', fLine)) then begin
inc(run);
while (FLine[Run] <> fEscDelim) and (FLine[Run] <> #0) do
inc(Run);
end;
if FLine[Run] <> #0 then
inc(Run);
end;
procedure TSynHL7Syn.RepDelimProc;
begin
inc(Run);
fTokenID := tkRepDelim;
end;
procedure TSynHL7Syn.SetRangeState(const Line : string);
function IsValidSegmentIDChar(c : char): Boolean;
begin
case c of
'A'..'Z', '0'..'9':
Result := True;
else
Result := False;
end;
end;
var SegID : string;
OK : boolean;
i : integer;
begin
//Decide if valid segment or arbitary text
if AnsiStartsStr('MSH', Line) and (Length(Line) > 8) then begin
fRange := rsMshDelim;
fFieldDelim := Line[4];
fCompDelim := Line[5];
fRepDelim := Line[6];
//If no escape characters are used in a message, this character may be omitted.
//However, it must be present if subcomponents are used in the message.
if Line[7] <> fFieldDelim then
fEscDelim := Line[7]
else
fEscDelim := DEF_ESC_DELIM;
//If there are no subcomponents in message then this seperator may not be present (use default then)
if Line[8] <> fFieldDelim then
fSubCompDelim := Line[8]
else
fEscDelim := DEF_SUBCOMP_DELIM;
end
else begin
SegID := Copy(FLine, run + 1, 3);
OK := Length(SegID) = 3;
for i := 1 to Length(SegID) do
OK := OK and IsValidSegmentIDChar(SegID[i]);
if OK then begin
case fRange of
rsUnknown : if (Copy(Line, 4, 1) = '|') then fRange := rsDefDelim;
rsMshDelim : if (Copy(Line, 4, 1) <> fFieldDelim) then fRange := rsUnknown;
rsDefDelim : if (Copy(Line, 4, 1) <> '|') then fRange := rsUnknown;
end;
end
else
fRange := rsUnknown;
end;
end;
procedure TSynHL7Syn.ResetRange;
begin
fRange:= rsUnknown;
end;
procedure TSynHL7Syn.SegmentIDProc;
function IsValidSegmentIDChar(c : char): Boolean;
begin
case c of
'A'..'Z', '0'..'9':
Result := True;
else
Result := False;
end;
end;
var OK : boolean;
SegID : String;
i : integer;
begin
// if it is not column 0-2 mark as tkText and get out of here
if Run > 0 then
begin
fTokenID := tkText;
inc(Run);
Exit;
end;
case fRange of
rsMshDelim, rsDefDelim : begin
fTokenID := tkSegmentID;
Run := 3;
end;
rsUnknown : begin
fTokenID := tkUnknown;
Inc(Run);
end;
end;
end;
procedure TSynHL7Syn.CRProc;
begin
fTokenID := tkSpace;
case FLine[Run + 1] of
#10: inc(Run, 2);
else inc(Run);
end;
end;
procedure TSynHL7Syn.TextProc;
function IsTextChar: Boolean;
begin
case fLine[Run] of
'a'..'z', 'A'..'Z', '0'..'9':
Result := True;
else
Result := False;
end;
end;
begin
if Run = 0 then
SegmentIDProc
else
begin
fTokenID := tkText;
inc(Run);
while FLine[Run] <> #0 do
if IsTextChar then
inc(Run)
else
break;
end;
end;
procedure TSynHL7Syn.UnknownProc;
begin
if Run = 0 then
Self.SetRangeState(fLine);
// this is column 0 ok it is a comment
fTokenID := tkUnknown;
inc(Run);
while FLine[Run] <> #0 do
case FLine[Run] of
#10: break;
#13: break;
else inc(Run);
end;
end;
procedure TSynHL7Syn.LFProc;
begin
fTokenID := tkSpace;
inc(Run);
end;
procedure TSynHL7Syn.SetRange(Value: Pointer);
begin
fRange := TRangeState(Value);
end;
procedure TSynHL7Syn.SpaceProc;
begin
inc(Run);
fTokenID := tkSpace;
while (FLine[Run] <= #32) and not IsLineEnd(Run) do inc(Run);
end;
procedure TSynHL7Syn.Next;
begin
//Decide range state by checking first char in line
fTokenPos := Run;
if Run = 0 then SetRangeState(fLine);
case fRange of
rsUnknown : case fLine[Run] of
#0: NullProc;
#10: LFProc;
#13: CRProc;
else
UnknownProc;
end;
rsMshDelim : begin
if fLine[Run] = Self.fFieldDelim then
FieldDelimProc
else if fLine[Run] = Self.fCompDelim then
CompDelimProc
else if fLine[Run] = Self.fSubCompDelim then
SubCompDelimProc
else if fLine[Run] = Self.fEscDelim then
EscDelimProc
else if fLine[Run] = Self.fRepDelim then
RepDelimProc
else begin
case fLine[Run] of
#0: NullProc;
#10: LFProc;
#13: CRProc;
#1..#9, #11, #12, #14..#32: SpaceProc;
else TextProc;
end;
end
end;
rsDefDelim : case fLine[Run] of
#0: NullProc;
#10: LFProc;
#13: CRProc;
#1..#9, #11, #12, #14..#32: SpaceProc;
DEF_FIELD_DELIM : FieldDelimProc;
DEF_COMP_DELIM : CompDelimProc;
DEF_SUBCOMP_DELIM : SubCompDelimProc;
DEF_ESC_DELIM : EscDelimProc;
DEF_REP_DELIM : RepDelimProc;
else TextProc;
end;
end;
inherited;
end;
procedure TSynHL7Syn.NullProc;
begin
fTokenID := tkNull;
inc(Run);
end;
function TSynHL7Syn.GetDefaultAttribute(Index: integer): TSynHighlighterAttributes;
begin
case Index of
SYN_ATTR_WHITESPACE: Result := fSpaceAttri;
else
Result := nil;
end;
end;
function TSynHL7Syn.GetEol: Boolean;
begin
Result := Run = fLineLen + 1;
end;
function TSynHL7Syn.GetTokenID: TtkTokenKind;
begin
Result := fTokenId;
end;
function TSynHL7Syn.GetTokenAttribute: TSynHighlighterAttributes;
begin
case fTokenID of
tkSegmentID: Result := fSegmentIDAttri;
tkFieldDelim: Result := fFieldDelimAttri;
tkCompDelim: Result := fCompDelimAttri;
tkSubCompDelim: Result := fSubCompDelimAttri;
tkRepDelim: Result := fRepDelimAttri;
tkEscDelim: Result := fEscDelimAttri;
tkText: Result := fTextAttri;
tkSpace: Result := fSpaceAttri;
tkUnknown: Result := fUnknownAttri;
else Result := nil;
end;
end;
function TSynHL7Syn.GetTokenKind: integer;
begin
Result := Ord(fTokenId);
end;
function TSynHL7Syn.IsFilterStored: Boolean;
begin
Result := fDefaultFilter <> SYNS_FilterINI;
end;
class function TSynHL7Syn.GetLanguageName: string;
begin
Result := SYNS_LangINI;
end;
function TSynHL7Syn.GetRange: Pointer;
begin
Result := Pointer(fRange);
end;
function TSynHL7Syn.GetSampleSource: UnicodeString;
begin
Result := 'MSH|^&\~|123|123'#13#10+
'PID|123|1234'
end;
{$IFNDEF SYN_CPPB_1}
class function TSynHL7Syn.GetFriendlyLanguageName: UnicodeString;
begin
Result := SYNS_FriendlyLangINI;
end;
initialization
RegisterPlaceableHighlighter(TSynHL7Syn);
{$ENDIF}
end.