Artifact [dc40445bdd]
Not logged in

Artifact dc40445bdd5200d3e11fff9ed31a04f7e9b93cae:


     1
     2
     3
     4
     5
     6
     7
     8
     9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
   100
   101
   102
   103
   104
   105
   106
   107
   108
   109
   110
   111
   112
   113
   114
   115
   116
   117
   118
   119
   120
   121
   122
   123
   124
   125
   126
   127
   128
   129
   130
   131
   132
   133
   134
   135
   136
   137
   138
   139
   140
   141
   142
   143
   144
   145
   146
   147
   148
   149
   150
   151
   152
   153
   154
   155
   156
   157
   158
   159
   160
   161
   162
   163
   164
   165
   166
   167
   168
   169
   170
   171
   172
   173
   174
   175
   176
   177
   178
   179
   180
   181
   182
   183
   184
   185
   186
   187
   188
   189
   190
   191
   192
   193
   194
   195
   196
   197
   198
   199
   200
   201
   202
   203
   204
   205
   206
   207
   208
   209
   210
   211
   212
   213
   214
   215
   216
   217
   218
   219
   220
   221
   222
   223
   224
   225
   226
   227
   228
   229
   230
   231
   232
   233
   234
   235
   236
   237
   238
   239
   240
   241
   242
   243
   244
   245
   246
   247
   248
   249
   250
   251
   252
   253
   254
   255
   256
   257
   258
   259
   260
   261
   262
   263
   264
   265
   266
   267
   268
   269
   270
   271
   272
   273
   274
   275
   276
   277
   278
   279
   280
   281
   282
   283
   284
   285
   286
   287
   288
   289
   290
   291
   292
   293
   294
   295
   296
   297
   298
   299
   300
   301
   302
   303
   304
   305
   306
   307
   308
   309
   310
   311
   312
   313
   314
   315
   316
   317
   318
   319
   320
   321
   322
   323
   324
   325
   326
   327
   328
   329
   330
   331
   332
   333
   334
   335
   336
   337
   338
   339
   340
   341
   342
   343
   344
   345
   346
   347
   348
   349
   350
   351
   352
   353
   354
   355
   356
   357
   358
   359
   360
   361
unit U_HTMLTagFinder;

interface
  uses
    NppSimpleObjects;

  procedure FindMatchingTag(ASelect: boolean = False; AContentsOnly: Boolean = False);

////////////////////////////////////////////////////////////////////////////////////////////////////
implementation

uses
  SysUtils, Windows, Classes,
//  L_DebugLogger,
  NppPluginConstants, NppScintillaConstants;

type
  TDirectionEnum = (dirBackward = -1, dirNone = 0, dirForward = 1, dirUnknown = 2);

const
  scPTitle: PChar = '(X|HT)MLTag Plugin';
  ncHighlightTimeout = 1000;
  scSelfClosingTags: array[0..12] of string = ('AREA', 'BASE', 'BASEFONT', 'BR', 'COL', 'FRAME',
                                                'HR', 'IMG', 'INPUT', 'ISINDEX', 'LINK', 'META',
                                                'PARAM');


{ ------------------------------------------------------------------------------------------------ }
function ExtractTagName(AView: TActiveDocument;
                        out ATagName: string;
                        out AOpening, AClosing: boolean;
                        APosition: integer = -1): TTextRange;
var
  {Tag, }TagEnd: TTextRange;
  i: Integer;
  StartIndex: integer;
  EndIndex: integer;
  {InnerLevel: integer;}
  ClosureFound: boolean;
  ExtraChar: char;
begin
  ATagName := '';

  if (APosition < 0) then begin
    if (AView.CurrentPosition <= AView.Selection.Anchor) then begin
      APosition := AView.CurrentPosition + 1;
    end else begin
      APosition := AView.CurrentPosition;
    end;
  end;
  Result := AView.Find('<', 0, APosition, 0);
  if Result = nil then begin
//    DebugWrite('ExtractTagName', 'No start tag found before given position!');
    Result := AView.Find('<', 0, APosition);
    if Result = nil then begin
      ATagName := '';
      Exit;
    end;
  end;

  // Keep track of intermediate '<' and '>' levels, to accomodate <?PHP?> and <%ASP%> tags
  {InnerLevel := 0;}

  // TODO: search for '<' as well as '>';
  // - if '<' is before '>', then InnerLevel := InnerLevel + 1;
  // - else (if '>' is before '<', then)
  //   - if InnerLevel > 0 then InnerLevel := InnerLevel - 1;
  //   - else TagEnd has been found

  //DebugWrite('ExtractTagName', Format('Start of tag: (%d-%d): "%s"', [Tag.Start, Tag.&End, Tag.Text]));
  TagEnd := AView.Find('>', 0, Result.EndPos + 1);
  if TagEnd = nil then begin
    ATagName := '';
    Exit;
  end else begin
    //DebugWrite('ExtractTagName', Format('End of tag: (%d-%d): "%s"', [TagEnd.Start, TagEnd.&End, TagEnd.Text]));
    Result.EndPos := TagEnd.EndPos;
    FreeAndNil(TagEnd);
  end;

  // Determine the tag name, and whether it's an opening and/or closing tag
  AOpening := True;
  AClosing := False;
  ClosureFound := False;
  StartIndex := 0;
  EndIndex := 0;
  ATagName := Result.Text;
  ExtraChar := #0;
  for i := 2 to Length(ATagName) - 1 do begin
    if StartIndex = 0 then begin
      case ATagName[i] of
        '/': begin
          AOpening := False;
          AClosing := True;
        end;
        '0'..'9', 'A'..'Z', 'a'..'z', '-', '_', '.', ':': begin
          StartIndex := i;
        end;
      end;
    end else if EndIndex = 0 then begin
{$IFDEF UNICODE}
      if not CharInSet(ATagName[i], ['0'..'9', 'A'..'Z', 'a'..'z', '-', '_', '.', ':', ExtraChar]) then begin
{$ELSE}
      if not (ATagName[i] in ['0'..'9', 'A'..'Z', 'a'..'z', '-', '_', '.', ':', ExtraChar]) then begin
{$ENDIF}
        EndIndex := i - 1;
        if AClosing = True then begin
          break;
        end;
      end;
    end else begin
      if ATagName[i] = '/' then begin
        ClosureFound := True;
{$IFDEF UNICODE}
      end else if ClosureFound and not CharInSet(ATagName[i], [' ', #9, #13, #10]) then begin
{$ELSE}
      end else if ClosureFound and not (ATagName[i] in [' ', #9, #13, #10]) then begin
{$ENDIF}
        ClosureFound := False;
      end;
    end;
    //DebugWrite('ExtractTagName', Format('%d=%s; opens=%d,closes=%d; start=%d,end=%d', [i, ATagName[i], integer(AOpening), integer(AClosing or ClosureFound), StartIndex, EndIndex]));
  end;
  AClosing := AClosing or ClosureFound;
  if EndIndex = 0 then
    ATagName := Copy(ATagName, StartIndex, Length(ATagName) - StartIndex)
  else
    ATagName := Copy(ATagName, StartIndex, EndIndex - StartIndex + 1);
end;

{ ------------------------------------------------------------------------------------------------ }
procedure FindMatchingTag(ASelect: boolean = False; AContentsOnly: Boolean = False);
var
  npp: TApplication;
  doc: TActiveDocument;

  Tags: TStringList;
  Tag, NextTag, MatchingTag, Target: TTextRange;
  TagName: string;
  TagOpens, TagCloses: boolean;

  Direction: TDirectionEnum;
  IsXML: boolean;
  DisposeOfTag: boolean;
  i: integer;
  Found: TTextRange;

  // ---------------------------------------------------------------------------------------------
  procedure TagEncountered(ProcessDirection: TDirectionEnum; Prefix: Char);
  begin
    TagName := Prefix + TagName;

    if Tags.Count = 0 then begin
      Tags.AddObject(TagName, Tag);
      DisposeOfTag := False;
      Direction := ProcessDirection;
    end else if (IsXML and SameStr(Copy(TagName, 2), Copy(Tags.Strings[0], 2)))
                or ((not IsXML) and SameText(Copy(TagName, 2), Copy(Tags.Strings[0], 2))) then begin
      if Direction = ProcessDirection then begin
        Tags.AddObject(TagName, Tag);
        DisposeOfTag := False;
      end else begin
        if Tags.Count > 1 then begin
          Tags.Objects[Tags.Count - 1].Free;
          Tags.Delete(Tags.Count - 1);
        end else begin
          MatchingTag := Tag;
          Tags.AddObject(TagName, Tag);
          DisposeOfTag := False;
        end;
      end;
    end;
  end;
  // ---------------------------------------------------------------------------------------------
begin
  npp := GetApplication();
  doc := npp.ActiveDocument;

  IsXML := (doc.Language = L_XML);

  Tags := TStringList.Create;
  MatchingTag := nil;
  NextTag := nil;
  Direction := dirUnknown;
  try
    try
      repeat
        DisposeOfTag := True;
        if not Assigned(NextTag) then begin
          // The first time, begin at the document's current position
          Tag := ExtractTagName(doc, TagName, TagOpens, TagCloses);
        end else begin
          Tag := ExtractTagName(doc, TagName, TagOpens, TagCloses, NextTag.StartPos + 1);
          FreeAndNil(NextTag);
        end;
        if Assigned(Tag) then begin

          // If we're in HTML mode, check for any of the HTML 4 empty tags -- they're really self-closing
          if (not IsXML) and TagOpens and (not TagCloses) then begin
            for i := Low(scSelfClosingTags) to High(scSelfClosingTags) do begin
              if SameText(TagName, scSelfClosingTags[i]) then begin
                TagCloses := True;
                Break;
              end;
            end;
          end;

//          DebugWrite('FindMatchingTag', Format('Found TTextRange(%d, %d, "%s"): opens=%d, closes=%d', [Tag.StartPos, Tag.EndPos, Tag.Text, integer(TagOpens), integer(TagCloses)]));

          if TagOpens and TagCloses then begin // A self-closing tag
            TagName := '*' + TagName;

            if Tags.Count = 0 then begin
              MatchingTag := Tag;
              Tags.AddObject(TagName, Tag);
              DisposeOfTag := False;
              Direction := dirNone;
            end;

          end else if TagOpens then begin // An opening tag
            TagEncountered(dirForward, '+');

          end else if TagCloses then begin // A closing tag
            TagEncountered(dirBackward, '-');

          end else begin // A tag that doesn't open and doesn't close?!? This should never happen
            TagName := TagName + Format('[opening=%d,closing=%d]', [integer(TagOpens), integer(TagCloses)]);
//            DebugWrite('FindMatchingTag', Format('%s (%d-%d): "%s"', [TagName, Tag.StartPos, Tag.EndPos, Tag.Text]));
            Assert(False, 'This tag doesn''t open, and doesn''t close either!?! ' + TagName);
            MessageBeep(MB_ICONERROR);

          end{if TagOpens and/or TagCloses};

//          DebugWrite('FindMatchingTag', Format('Processed TTextRange(%d, %d, "%s")', [Tag.StartPos, Tag.EndPos, Tag.Text]));

        end{if Assigned(Tag)};


        // Find the next tag in the search direction
        case Direction of
          dirForward: begin
            // look forward for corresponding closing tag
            NextTag := doc.Find('<[^%\?]', SCFIND_REGEXP or SCFIND_POSIX, Tag.EndPos);
            if Assigned(NextTag) then
              NextTag.EndPos := NextTag.EndPos - 1;
          end;
          dirBackward: begin
            // look backward for corresponding opening tag
            NextTag := doc.Find('[^%\?]>', SCFIND_REGEXP or SCFIND_POSIX, Tag.StartPos, 0);
            if Assigned(NextTag) then
              NextTag.StartPos := NextTag.StartPos + 1;
          end;
          else begin
            //dirUnknown: ;
            //dirNone: ;
            NextTag := nil;
          end;
        end;

        if DisposeOfTag then begin
          FreeAndNil(Tag);
        end;
      until (NextTag = nil) or (MatchingTag <> nil);

      Tags.LineBreak := #9;
//      DebugWrite('FindMatchingTag:Done looking', Format('Tags.Count = %d (%s)', [Tags.Count, Tags.Text]));
      if Assigned(MatchingTag) then begin
//        DebugWrite('FindMatchingTag:Marking', Format('MatchingTag = TTextRange(%d, %d, "%s")', [MatchingTag.StartPos, MatchingTag.EndPos, MatchingTag.Text]));
        if Tags.Count = 2 then begin
          Tag := TTextRange(Tags.Objects[0]);
          if ASelect then begin
            if Tag.StartPos < MatchingTag.StartPos then begin
              if AContentsOnly then begin
                Target := doc.GetRange(Tag.EndPos, MatchingTag.StartPos);
              end else begin
                Target := doc.GetRange(Tag.StartPos, MatchingTag.EndPos);
              end;
            end else begin
              if AContentsOnly then begin
                Target := doc.GetRange(MatchingTag.EndPos, Tag.StartPos);
              end else begin
                Target := doc.GetRange(MatchingTag.StartPos, Tag.EndPos);
              end;
            end;
            try
              if AContentsOnly and True then begin // TODO: make optional, read setting from .ini ([MatchTag] SkipWhitespace=1)
                // Leave out whitespace at begin
                Found := doc.Find('[^ \r\n\t]', SCFIND_REGEXP or SCFIND_POSIX, Target.StartPos, Target.EndPos);
                if Assigned(Found) then begin
                  try
                    Target.StartPos := Found.StartPos;
                  finally
                    Found.Free;
                  end;
                end;
                // Also leave out whitespace at end
                Found := doc.Find('[^ \r\n\t]', SCFIND_REGEXP or SCFIND_POSIX, Target.EndPos, Target.StartPos);
                if Assigned(Found) then begin
                  try
                    Target.EndPos := Found.EndPos;
                  finally
                    Found.Free;
                  end;
                end;
              end;
              Target.Select;
            finally
              Target.Free;
            end;
          end else begin
//            DebugWrite('FindMatchingTag:Marking', Format('CurrentTag = TTextRange(%d, %d, "%s")', [Tag.StartPos, Tag.EndPos, Tag.Text]));
            MatchingTag.Select;
            {$IFNDEF NPP_UNICODE} // NPP Unicode has always done this itself
            // TODO: only if NPP has version < 5.0
            Tag.Mark(STYLE_BRACELIGHT, 255, ncHighlightTimeout);
            MatchingTag.Mark(STYLE_BRACELIGHT, 255, ncHighlightTimeout);
            {$ENDIF}
          end;
        end else begin
          if ASelect then begin
            MatchingTag.Select;
          end else begin
            MatchingTag.Select;
            {$IFNDEF NPP_UNICODE} // NPP Unicode has always done this itself
            // TODO: only if NPP has version < 5.0
            MatchingTag.Mark(STYLE_BRACELIGHT, 255, ncHighlightTimeout);
            {$ENDIF}
          end;
        end;
      end else if Tags.Count > 0 then begin
        MessageBeep(MB_ICONWARNING);
        Tag := TTextRange(Tags.Objects[0]);
        if ASelect then begin
          Tag.Select;
        end;
        Tag.Mark(STYLE_BRACEBAD, 255, ncHighlightTimeout);
      end else begin
        MessageBeep(MB_ICONWARNING);
      end;

    except
      on E: Exception do begin
        MessageBeep(MB_ICONERROR);
//        DebugWrite('FindMatchingTag:Exception', Format('%s: "%s"', [E.ClassName, E.Message]));
      end;
    end;
  finally
    while Tags.Count > 0 do begin
      Tag := TTextRange(Tags.Objects[0]);
//      DebugWrite('FindMatchingTag:Cleanup', Format('Tags["%s"] = TTextRange(%d, %d, "%s")', [Tags.Strings[0], Tag.StartPos, Tag.EndPos, Tag.Text]));
      Tags.Objects[0].Free;
      Tags.Delete(0);
    end;
    FreeAndNil(Tags);
  end;

  //MessageBox(npp.WindowHandle, PChar('Current tag: ' + TagName), scPTitle, MB_ICONINFORMATION);
end;

end.