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'.

1 files changed, 34 insertions, 9 deletions

diff --git a/src/fns.c b/src/fns.c
index 1758148ff2d..41429c8863d 100644
--- 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);