master e51a98b 1/2: Add a new function 'string-search'

[Lars Ingebrigtsen]

branch: master
commit e51a98b0c2d35648c2d054486f7ba5869e24e4cf
Author: Lars Ingebrigtsen <larsi@gnus.org>
Commit: Lars Ingebrigtsen <larsi@gnus.org>

    Add a new function 'string-search'
    
    * doc/lispref/strings.texi (Text Comparison): Document it.
    * src/fns.c (Fstring_search): New function.
---
 doc/lispref/strings.texi |  8 ++++++++
 etc/NEWS                 |  5 +++++
 src/fns.c                | 46 ++++++++++++++++++++++++++++++++++++++++++++++
 test/src/fns-tests.el    | 23 +++++++++++++++++++++++
 4 files changed, 82 insertions(+)

diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi
index 8de6255..6eb3d6f 100644
--- a/doc/lispref/strings.texi
+++ b/doc/lispref/strings.texi
@@ -656,6 +656,14 @@ optional argument @var{ignore-case} is non-@code{nil}, the 
comparison
 ignores case differences.
 @end defun
 
+@defun string-search needle haystack &optional start-pos
+Return the position of the first instance of @var{needle} in
+@var{haystack}, both of which are strings.  If @var{start-pos} is
+non-@code{nil}, start searching from that position in @var{needle}.
+This function only considers the characters in the strings when doing
+the comparison; text properties are ignored.
+@end defun
+
 @defun compare-strings string1 start1 end1 string2 start2 end2 &optional 
ignore-case
 This function compares a specified part of @var{string1} with a
 specified part of @var{string2}.  The specified part of @var{string1}
diff --git a/etc/NEWS b/etc/NEWS
index 13a022d..6bedd03 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1416,6 +1416,11 @@ ledit.el, lmenu.el, lucid.el and old-whitespace.el.
 * Lisp Changes in Emacs 28.1
 
 +++
+*** New function 'string-search'.
+This function takes two string parameters and returns the position of
+the first instance of the first string in the latter.
+
++++
 *** New function 'process-lines-ignore-status'.
 This is like 'process-lines', but does not signal an error if the
 return status is non-zero.  'process-lines-handling-status' has also
diff --git a/src/fns.c b/src/fns.c
index a3b8d6e..3927e43 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -5454,6 +5454,51 @@ It should not be used for anything security-related.  See
   return make_digest_string (digest, SHA1_DIGEST_SIZE);
 }
 
+DEFUN ("string-search", Fstring_search, Sstring_search, 2, 3, 0,
+       doc: /* Search for the string NEEDLE in the string HAYSTACK.
+The return value is the position of the first instance of NEEDLE in
+HAYSTACK.
+
+The optional START-POS argument says where to start searching in
+HAYSTACK.  If not given, start at the beginning. */)
+  (register Lisp_Object needle, Lisp_Object haystack, Lisp_Object start_pos)
+{
+  ptrdiff_t start_byte = 0, haybytes;
+  char *res = NULL, *haystart;
+
+  CHECK_STRING (needle);
+  CHECK_STRING (haystack);
+
+  if (!NILP (start_pos))
+    {
+      CHECK_FIXNUM (start_pos);
+      start_byte = string_char_to_byte (haystack, XFIXNUM (start_pos));
+    }
+
+  haystart = SSDATA (haystack) + start_byte;
+  haybytes = SBYTES (haystack) - start_byte;
+
+  if (STRING_MULTIBYTE (haystack) == STRING_MULTIBYTE (needle))
+    res = memmem (haystart, haybytes,
+                 SSDATA (needle), SBYTES (needle));
+  else if (STRING_MULTIBYTE (haystack) && !STRING_MULTIBYTE (needle))
+    {
+      Lisp_Object multi_needle = string_to_multibyte (needle);
+      res = memmem (haystart, haybytes,
+                   SSDATA (multi_needle), SBYTES (multi_needle));
+    }
+  else if (!STRING_MULTIBYTE (haystack) && STRING_MULTIBYTE (needle))
+    {
+      Lisp_Object uni_needle = Fstring_as_unibyte (needle);
+      res = memmem (haystart, haybytes,
+                   SSDATA (uni_needle), SBYTES (uni_needle));
+    }
+
+  if (! res)
+    return Qnil;
+
+  return make_int (string_byte_to_char (haystack, res - SSDATA (haystack)));
+}
 
 
 void
@@ -5494,6 +5539,7 @@ syms_of_fns (void)
   defsubr (&Sremhash);
   defsubr (&Smaphash);
   defsubr (&Sdefine_hash_table_test);
+  defsubr (&Sstring_search);
 
   /* Crypto and hashing stuff.  */
   DEFSYM (Qiv_auto, "iv-auto");
diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el
index b9a7d29..8c2b130 100644
--- a/test/src/fns-tests.el
+++ b/test/src/fns-tests.el
@@ -901,3 +901,26 @@
     (should (equal (delete t [nil t]) [nil]))
     (should (equal (delete 1 v1) (vector)))
     (should (equal (delete 2 v1) v1))))
+
+(ert-deftest string-search ()
+  (should (equal (string-search "zot" "foobarzot") 6))
+  (should (equal (string-search "foo" "foobarzot") 0))
+  (should (not (string-search "fooz" "foobarzot")))
+  (should (not (string-search "zot" "foobarzo")))
+
+  (should (equal
+           (string-search (make-string 2 130)
+                         (concat "helló" (make-string 5 130 t) "bár"))
+           5))
+  (should (equal
+           (string-search (make-string 2 127)
+                         (concat "helló" (make-string 5 127 t) "bár"))
+           5))
+
+  (should (equal (string-search "\377" "a\377ø") 1))
+  (should (equal (string-search "\377" "a\377a") 1))
+
+  (should (not (string-search (make-string 1 255) "a\377ø")))
+  (should (not (string-search (make-string 1 255) "a\377a")))
+
+  (should (equal (string-search "fóo" "zotfóo") 3)))