+ Implements XPath function id() + test. Running the test is another story, however, because it requires parsing FilterExpr+'/'+RelativeLocationPath, which is currently not implemented.

git-svn-id: trunk@13106 -

packages/fcl-xml/src/xmlutils.pp

@@ -30,6 +30,7 @@ function IsXmlNmTokens(const Value: WideString; Xml11: Boolean = False): Boolean
 function IsValidXmlEncoding(const Value: WideString): Boolean;
 function Xml11NamePages: PByteArray;
 procedure NormalizeSpaces(var Value: WideString);
+function IsXmlWhiteSpace(c: WideChar): Boolean;
 function Hash(InitValue: LongWord; Key: PWideChar; KeyLen: Integer): LongWord;
 { beware, works in ASCII range only }
 function WStrLIComp(S1, S2: PWideChar; Len: Integer): Integer;
@@ -277,6 +278,11 @@ begin
   end;
 end;
 
+function IsXmlWhiteSpace(c: WideChar): Boolean;
+begin
+  Result := (c = #32) or (c = #9) or (c = #10) or (c = #13);
+end;
+
 function WStrLIComp(S1, S2: PWideChar; Len: Integer): Integer;
 var
   counter: Integer;

packages/fcl-xml/src/xpath.pp

@@ -2388,10 +2388,59 @@ begin
 end;
 
 function TXPathEnvironment.xpId(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
+var
+  i: Integer;
+  ResultSet: TNodeSet;
+  TheArg: TXPathVariable;
+  doc: TDOMDocument;
+
+  procedure AddId(ns: TNodeSet; const s: DOMString);
+  var
+    Head, Tail, L: Integer;
+    Token: DOMString;
+    Element: TDOMNode;
+  begin
+    Head := 1;
+    L := Length(s);
+    while (Head <= L) and IsXmlWhiteSpace(s[Head]) do
+      Inc(Head);
+
+    while Head <= L do
+    begin
+      Tail := Head;
+      while (Tail <= L) and not IsXmlWhiteSpace(s[Tail]) do
+        Inc(Tail);
+      SetString(Token, @s[Head], Tail - Head);
+      Element := doc.GetElementById(Token);
+      if Assigned(Element) then
+        ns.Add(Element);
+
+      Head := Tail;
+      while IsXmlWhiteSpace(s[Head]) do
+        Inc(Head);
+    end;
+  end;
+
 begin
   if Args.Count <> 1 then
     EvaluationError(SEvalInvalidArgCount);
-  EvaluationError(SEvalFunctionNotImplementedYet, ['id']); // !!!
+  // TODO: probably have doc as member of Context
+  if Context.ContextNode.NodeType = DOCUMENT_NODE then
+    doc := TDOMDocument(Context.ContextNode)
+  else
+    doc := Context.ContextNode.OwnerDocument;
+
+  ResultSet := TNodeSet.Create;
+  TheArg := TXPathVariable(Args[0]);
+  if TheArg is TXPathNodeSetVariable then
+  begin
+    with TheArg.AsNodeSet do
+      for i := 0 to Count-1 do
+        AddId(ResultSet, NodeToText(TDOMNode(Items[i])));
+  end
+  else
+    AddId(ResultSet, TheArg.AsText);
+  Result := TXPathNodeSetVariable.Create(ResultSet);
 end;
 
 function TXPathEnvironment.xpLocalName(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;

packages/fcl-xml/tests/xpathts.pp

@@ -403,7 +403,19 @@ const
   '<para id="4" xml:lang="en-us">en-us</para>'+
   '</doc>';
 
-  FunctionTests: array[0..49] of TTestRec = (
+  id04='<!DOCTYPE t04 ['+
+  '<!ELEMENT t04 (a*)>'+
+  '<!ELEMENT a EMPTY>'+
+  '<!ATTLIST a  id ID #REQUIRED>'+
+  ']>'+
+  '<t04>'+
+  '<a id="a"/>'+
+  '<a id="b"/>'+
+  '<a id="c"/>'+
+  '<a id="d"/>'+
+  '</t04>';
+
+  FunctionTests: array[0..50] of TTestRec = (
   // last()
   // position()
   // count()
@@ -435,6 +447,8 @@ const
     (data: expr01; expr: 'string(para[@id="4" and lang("en")])'; rt: rtString; s: 'en-us'),  // expression03
     (data: expr01; expr: 'string(div/para[lang("en")])'; rt: rtString; s: 'en'),             // expression04
     (data: expr01; expr: 'string(para[@id="3" and lang("en")])'; rt: rtString; s: 'EN'),     // expression05
+    
+    (data: id04; expr: 'id("c")/@id'; rt: rtString; s: 'c'),  // idkey04
 
     (expr: 'number("1.5")';   rt: rtNumber; n: 1.5),
     (expr: 'number("abc")';   rt: rtNumber; n: NaN),