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:
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:
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;
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:
SynHighlighterHL7.pas
unit found below to your synedit project source folder.SynHighlighterHL7.pas
to your project and to the Uses
clause.TSynEdit
or TSynMemo
component to a formCode:
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.