synhighlighterhp48.pas

SynEditStudio delphi 代码编辑器

  s: string;
begin
  i := Run;
  EndOfToken;
  s := Copy(fLine, i, run - i);
  if fRange = rsAsm then
    if FAsmKeyWords.Find(s) <> nil then
      if (s = '!RPL') or (s = 'ENDCODE') then begin
        fRange := rsRpl;
        result := tkAsmKey;
      end
      else
        result := tkAsmKey
    else if fLine[i] <> '*' then
      result := tkAsm
    else
      result := tkAsmKey
  else if FRplKeyWords.Find(s) <> nil then
    if (s = 'CODEM') or (s = 'ASSEMBLEM') then begin
      fRange := rsAsm;
      result := tkAsmKey;
    end
    else if (s = 'CODE') or (s = 'ASSEMBLE') then begin
      fRange := rssAsm1;
      result := tksAsmKey;
    end
    else
      result := tkRplKey
  else
    result := tkRpl;
end;

function TSynHP48Syn.GetTokenFromRange: TtkTokenKind;
begin
  case frange of
    rsAsm: result := tkAsm;
    rssAsm1: result := tksAsmKey;
    rssAsm2: result := tksAsm;
    rssAsm3: result := tksAsmComment;
    rsRpl: result := tkRpl;
    rsComRpl: result := tkRplComment;
    rsComAsm1, rsComAsm2: result := tkAsmComment;
  else
    result := tkNull;
  end;
end;

function TSynHP48Syn.NullProc: TtkTokenKind;
begin
  Result := tkNull;
  fEol := True;
end;

function TSynHP48Syn.SpaceProc: TtkTokenKind;
begin
  inc(Run);
  while (Run <= Length(FLine)) and (FLine[Run] in [#1..#32]) do
    inc(Run);
  result := GetTokenFromRange;
end;

function TSynHP48Syn.Next1: TtkTokenKind;
begin
  fTokenPos := Run;
  if Run > Length(fLine) then
    result := NullProc
  else if fRange = rsComRpl then
    result := RplComProc
  else if fRange = rsComAsm1 then
    result := AsmComProc(')')
  else if fRange = rsComAsm2 then
    result := AsmComProc('/')
  else if frange = rssasm1 then
    result := SasmProc1
  else if frange = rssasm2 then
    result := sasmproc2
  else if frange = rssasm3 then
    result := sasmproc3
  else if fLine[Run] in [#1..#32] then
    result := SpaceProc
  else if fLine[Run] = '(' then
    result := ParOpenProc
  else if fLine[Run] = '%' then
    result := PersentProc
  else if fLine[Run] = '/' then
    result := SlashProc
  else if (run = 1) and (fRange = rsRpl) and (fLine[1] = '*') then
    result := StarProc
  else
    result := IdentProc;
end;

procedure TSynHP48Syn.Next2(tkk: TtkTokenKind);
begin
  fTockenKind := tkk;
end;

procedure TSynHP48Syn.Next;
begin
  Next2(Next1);
end;

function TSynHP48Syn.GetEol: Boolean;
begin
  Result := fEol;
end;

function TSynHP48Syn.GetToken: string;
var
  Len: LongInt;
  a: PChar;
begin
  a := @(fLine[fTokenPos]);
  Len := Run - fTokenPos;
  SetString(Result, a, Len);
end;

function TSynHP48Syn.GetTokenPos: Integer;
begin
  Result := fTokenPos - 1;
end;

function TSynHP48Syn.GetRange: Pointer;
begin
  Result := Pointer(fRange);
end;

procedure TSynHP48Syn.SetRange(Value: Pointer);
begin
  fRange := TRangeState(Value);
end;

procedure TSynHP48Syn.ResetRange;
begin
  fRange := BaseRange;
end;

function TSynHP48Syn.GetAttrib(Index: integer): TSynHighlighterAttributes;
begin
  Result := Attribs[TtkTokenKind(Index)];
end;

procedure TSynHP48Syn.SetAttrib(Index: integer; Value: TSynHighlighterAttributes);
begin
  Attribs[TtkTokenKind(Index)].Assign(Value);
end;

procedure TSynHP48Syn.EndOfToken;
begin
  while (Run <= Length(fLine)) and (FLine[Run] > ' ') do
    Inc(Run);
end;

{$IFNDEF SYN_CLX}
function TSynHP48Syn.LoadFromRegistry(RootKey: HKEY; Key: string): boolean;
var
  r: TBetterRegistry;
begin
  r := TBetterRegistry.Create;
  try
    r.RootKey := RootKey;
    if r.OpenKeyReadOnly(Key) then begin
      if r.ValueExists('AsmKeyWordList')
        then AsmKeywords.Text := r.ReadString('AsmKeyWordList');
      if r.ValueExists('RplKeyWordList')
        then RplKeywords.Text := r.ReadString('RplKeyWordList');
      Result := inherited LoadFromRegistry(RootKey, Key);
    end
    else
      Result := false;
  finally r.Free;
  end;
end;

function TSynHP48Syn.SaveToRegistry(RootKey: HKEY; Key: string): boolean;
var
  r: TBetterRegistry;
begin
  r := TBetterRegistry.Create;
  try
    r.RootKey := RootKey;
    if r.OpenKey(Key, true) then begin
      Result := true;
      r.WriteString('AsmKeyWordList', AsmKeywords.Text);
      r.WriteString('RplKeyWordList', RplKeywords.Text);
      Result := inherited SaveToRegistry(RootKey, Key);
    end
    else
      Result := false;
  finally r.Free;
  end;
end;
{$ENDIF}

procedure TSynHP48Syn.Assign(Source: TPersistent);
var
  i: TtkTokenKind;
begin
  if Source is TSynHP48Syn then begin
    for i := Low(Attribs) to High(Attribs) do begin
      Attribs[i].Background := TSynHP48Syn(source).Attribs[i].Background;
      Attribs[i].Foreground := TSynHP48Syn(source).Attribs[i].Foreground;
      Attribs[i].Style := TSynHP48Syn(source).Attribs[i].Style;
    end;
    AsmKeyWords.Text := TSynHP48Syn(source).AsmKeyWords.Text;
    RplKeyWords.Text := TSynHP48Syn(source).RplKeyWords.Text;
  end
  else
    inherited Assign(Source);
end;

function TSynHP48Syn.GetAttribCount: integer;
begin
  Result := Ord(High(Attribs)) - Ord(Low(Attribs)) + 1;
end;

function TSynHP48Syn.GetAttribute(idx: integer): TSynHighlighterAttributes;
begin // sorted by name
  if (idx <= Ord(High(TtkTokenKind))) then
    Result := Attribs[TtkTokenKind(idx)]
  else
    Result := nil;
end;

function TSynHP48Syn.IsFilterStored: Boolean;
begin
  Result := fDefaultFilter <> SYNS_FilterHP48;
end;

class function TSynHP48Syn.GetLanguageName: string;
begin
  Result := SYNS_LangHP48;
end;

procedure TSynHP48Syn.SetHighLightChange;
var
  i: TtkTokenKind;
begin
  for i := Low(Attribs) to High(Attribs) do begin
    Attribs[i].OnChange := DefHighLightChange;
    Attribs[i].InternalSaveDefaultValues;
  end;
end;

function TSynHP48Syn.SasmProc1: TtkTokenKind;
var
  i: integer;
  s: string;
begin
  Result := tksAsmKey;
  if run > Length(fLine) then
    exit;
  if FLine[Run] = '*' then begin
    frange := rssasm3;
    result := tksAsmComment;
    exit;
  end;
  if FLine[Run] >= ' ' then begin
    i := run;
    while (run <= Length(fLine)) and (FLine[run] > ' ') do
      inc(run);
    s := Copy(fLine, i, run - i);
    if (s = 'RPL') or (s = 'ENDCODE') then begin
      frange := rsRpl;
      exit;
    end;
  end;
  while (run <= Length(fLine)) and (FLine[run] <= ' ') and (FLine[run] <> #10) do
    inc(run);
  if run <= Length(fLine) then
    frange := rssasm2
  else
    frange := rssasm1;
end;

function TSynHP48Syn.SasmProc2: TtkTokenKind;
var
  i: integer;
  s: string;
begin
  Result := tksAsm;
  while (run <= Length(fLine)) and (FLine[run] <= ' ') and (fline[run] <> #10) do
    inc(run);
  if run > 30 then begin
    frange := rssasm3;
    exit;
  end;
  i := run;
  while (run <= Length(fLine)) and (FLine[run] > ' ') do
    inc(run);
  s := Copy(fLine, i, run - i);
  if (s = 'ENDCODE') or (s = 'RPL') then begin
    frange := rsRpl;
    result := tksAsmKey;
  end
  else begin
    if FSAsmNoField.Find(s) = nil then begin
      while (run <= Length(fLine)) and (FLine[run] <= ' ') and (FLine[run] <> #10) do
        inc(run);
      while (run <= Length(fLine)) and (FLine[run] > ' ') do
        inc(run);
      while (run <= Length(fLine)) and (FLine[run] <= ' ') and (FLine[run] <> #10) do
        inc(run);
    end;
    if run <= Length(fLine) then
      frange := rssasm3
    else
      frange := rssasm1;
  end;
end;

function TSynHP48Syn.SasmProc3: TtkTokenKind;
begin
  Result := tksAsmComment;
  while (run <= Length(fLine)) and (FLine[run] <> #10) do
    inc(run);
  if run <= Length(fLine) then inc(run);
  frange := rssasm1;
end;

function TSynHP48Syn.GetTokenAttribute: TSynHighlighterAttributes;
begin
  Result := GetAttrib(Ord(fTockenKind));
end;

function TSynHP48Syn.GetTokenKind: integer;
begin
  Result := Ord(fTockenKind);
end;

function TSynHP48Syn.GetDefaultAttribute(Index: integer): TSynHighlighterAttributes;
begin
  Result := nil;
end;

{$IFNDEF SYN_CPPB_1}
initialization
  RegisterPlaceableHighlighter(TSynHP48Syn);
{$ENDIF}
end.