summaryrefslogtreecommitdiff
path: root/src/fns.c
diff options
context:
space:
mode:
authorLars Ingebrigtsen <larsi@gnus.org>2020-12-11 14:40:20 +0100
committerLars Ingebrigtsen <larsi@gnus.org>2020-12-11 14:40:20 +0100
commitaa7e5ce651b1872180e8da94ac80fbc25e33eec0 (patch)
treed7a50705c11b9257683743857ea479b2d0739d1c /src/fns.c
parent9d598ef93cbebe59f1d3a91f4fda35d3e00f36a9 (diff)
downloademacs-aa7e5ce651b1872180e8da94ac80fbc25e33eec0.tar.gz
Add new function `object-intervals'
* doc/lispref/text.texi (Examining Properties): Document it. * src/fns.c (Fobject_intervals): New defun. (collect_interval): New function.
Diffstat (limited to 'src/fns.c')
-rw-r--r--src/fns.c35
1 files changed, 35 insertions, 0 deletions
diff --git a/src/fns.c b/src/fns.c
index e9b6a96f344..a0c4a1fbf1a 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -5573,6 +5573,40 @@ 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.
+
+Altering this copy does not change the layout of the text properties
+in OBJECT. */)
+ (register Lisp_Object object)
+{
+ Lisp_Object collector = Fcons (Qnil, Qnil);
+ INTERVAL intervals;
+
+ if (STRINGP (object))
+ intervals = string_intervals (object);
+ else if (BUFFERP (object))
+ intervals = buffer_intervals (XBUFFER (object));
+ else
+ wrong_type_argument (Qbuffer_or_string_p, object);
+
+ if (! intervals)
+ return Qnil;
+
+ traverse_intervals (intervals, 0, collect_interval, collector);
+ return CDR (collector);
+}
void
@@ -5614,6 +5648,7 @@ syms_of_fns (void)
defsubr (&Smaphash);
defsubr (&Sdefine_hash_table_test);
defsubr (&Sstring_search);
+ defsubr (&Sobject_intervals);
/* Crypto and hashing stuff. */
DEFSYM (Qiv_auto, "iv-auto");