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 | ------------------------------------------------------------------------------
-- Language Server Protocol --
-- --
-- Copyright (C) 2021, AdaCore --
-- --
-- This is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. This software is distributed in the hope that it will be useful, --
-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- --
-- TABILITY 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 distributed with this software; see file --
-- COPYING3. If not, go to http://www.gnu.org/licenses for a complete copy --
-- of the license. --
------------------------------------------------------------------------------
with Ada.Characters.Handling;
with Ada.Strings.UTF_Encoding;
with Ada.Unchecked_Deallocation;
with VSS.Strings; use VSS.Strings;
with VSS.Strings.Conversions;
package body LSP.Search.Full_Text is
-----------
-- Build --
-----------
function Build
(Pattern : VSS.Strings.Virtual_String;
Case_Sensitive : Boolean := False;
Whole_Word : Boolean := False;
Negate : Boolean := False)
return Search_Pattern'Class
is
BM : constant Boyer_Moore_Pattern_Access :=
new GNATCOLL.Boyer_Moore.Pattern;
begin
Compile
(BM.all,
VSS.Strings.Conversions.To_UTF_8_String (Pattern),
Case_Sensitive => Case_Sensitive);
return Full_Text_Search'
(Ada.Finalization.Limited_Controlled with
Boyer => BM,
Text => Pattern,
Case_Sensitive => Case_Sensitive,
Negate => Negate,
Whole_Word => Whole_Word,
Kind => LSP.Messages.Full_Text);
end Build;
--------------
-- Finalize --
--------------
overriding procedure Finalize (Self : in out Full_Text_Search) is
procedure Unchecked_Free is new Ada.Unchecked_Deallocation
(GNATCOLL.Boyer_Moore.Pattern, Boyer_Moore_Pattern_Access);
begin
GNATCOLL.Boyer_Moore.Free (Self.Boyer.all);
Unchecked_Free (Self.Boyer);
Finalize (Search_Pattern (Self));
end Finalize;
-----------
-- Match --
-----------
overriding function Match
(Self : Full_Text_Search;
Text : VSS.Strings.Virtual_String)
return Boolean
is
Index : Integer;
T : constant Ada.Strings.UTF_Encoding.UTF_8_String :=
VSS.Strings.Conversions.To_UTF_8_String (Text);
S : Integer := T'First;
F : constant Integer := T'Last;
function Is_Word_Delimiter (C : Character) return Boolean;
function Is_Word_Delimiter (C : Character) return Boolean is
begin
return not (Ada.Characters.Handling.Is_Alphanumeric (C)
or else C = '_');
end Is_Word_Delimiter;
begin
loop
Index := GNATCOLL.Boyer_Moore.Search
(Self.Boyer.all, T (S .. F));
exit when not Self.Whole_Word
or else Index = -1
or else Index > T'Last
or else
-- Check we have word delimiters on either sides
((Index = T'First
or else Is_Word_Delimiter (T (Index - 1)))
and then
(Index = T'Last - T'Length + 1
or else Is_Word_Delimiter (T (Index + T'Length))));
S := Index + 1;
end loop;
if Index = -1 then
return Self.Negate;
else
return not Self.Negate;
end if;
end Match;
end LSP.Search.Full_Text;
|