Introduce `sxhash-equal-including-properties'.

	* src/fns.c (collect_interval): Move it upwards.
	(Fsxhash_equal_including_properties): New function.
	(syms_of_fns): Register `sxhash-equal-including-properties'.
	* etc/NEWS: Add 'sxhash-equal-including-properties'.

diff --git a/etc/NEWS b/etc/NEWS
index fb0ec90fea82eb703726395d60cd4f5160b48185..6928cbc429f880af669caa080d1b909fb5735ee0 100644 (file)
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -2579,6 +2579,11 @@ the Emacs Lisp reference manual for background.
 \f
 * Lisp Changes in Emacs 28.1
 
++++
+** New function 'sxhash-equal-including-properties'.
+This is identical to 'sxhash-equal' but accounting also for string
+properties.
+
 +++
 ** 'unlock-buffer' displays warnings instead of signaling.
 Instead of signaling 'file-error' conditions for file system level

diff --git a/src/fns.c b/src/fns.c
index 1758148ff2d711908f716d67f538be1d5ed947c3..41429c8863d543e06e8109c1aab3f37d5f5ba5e5 100644 (file)
--- a/src/fns.c
+++ b/src/fns.c
@@ -4492,6 +4492,15 @@ check_mutable_hash_table (Lisp_Object obj, struct Lisp_Hash_Table *h)
   eassert (!PURE_P (h));
 }
 
+static void
+collect_interval (INTERVAL interval, Lisp_Object collector)
+{
+  nconc2 (collector,
+         list1(list3 (make_fixnum (interval->position),
+                      make_fixnum (interval->position + LENGTH (interval)),
+                      interval->plist)));
+}
+
 /* Put an entry into hash table H that associates KEY with VALUE.
    HASH is a previously computed hash code of KEY.
    Value is the index of the entry in H matching KEY.  */
@@ -4949,6 +4958,30 @@ Hash codes are not guaranteed to be preserved across Emacs sessions.  */)
   return hashfn_equal (obj, NULL);
 }
 
+DEFUN ("sxhash-equal-including-properties", Fsxhash_equal_including_properties,
+       Ssxhash_equal_including_properties, 1, 1, 0,
+       doc: /* Return an integer hash code for OBJ suitable for
+`equal-including-properties'.
+If (sxhash-equal-including-properties A B), then
+(= (sxhash-equal-including-properties A) (sxhash-equal-including-properties B)).
+
+Hash codes are not guaranteed to be preserved across Emacs sessions.  */)
+  (Lisp_Object obj)
+{
+  if (STRINGP (obj))
+    {
+      Lisp_Object collector = Fcons (Qnil, Qnil);
+      traverse_intervals (string_intervals (obj), 0, collect_interval,
+                         collector);
+      return
+       make_ufixnum (
+         SXHASH_REDUCE (sxhash_combine (sxhash (obj),
+                                        sxhash (CDR (collector)))));
+    }
+
+  return hashfn_equal (obj, NULL);
+}
+
 DEFUN ("make-hash-table", Fmake_hash_table, Smake_hash_table, 0, MANY, 0,
        doc: /* Create and return a new hash table.
 
@@ -5832,15 +5865,6 @@ Case is always significant and text properties are ignored. */)
   return make_int (string_byte_to_char (haystack, res - SSDATA (haystack)));
 }
 
-static void
-collect_interval (INTERVAL interval, Lisp_Object collector)
-{
-  nconc2 (collector,
-         list1(list3 (make_fixnum (interval->position),
-                      make_fixnum (interval->position + LENGTH (interval)),
-                      interval->plist)));
-}
-
 DEFUN ("object-intervals", Fobject_intervals, Sobject_intervals, 1, 1, 0,
        doc: /* Return a copy of the text properties of OBJECT.
 OBJECT must be a buffer or a string.
@@ -5922,6 +5946,7 @@ syms_of_fns (void)
   defsubr (&Ssxhash_eq);
   defsubr (&Ssxhash_eql);
   defsubr (&Ssxhash_equal);
+  defsubr (&Ssxhash_equal_including_properties);
   defsubr (&Smake_hash_table);
   defsubr (&Scopy_hash_table);
   defsubr (&Shash_table_count);