aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--src/fns.c126
1 files changed, 126 insertions, 0 deletions
diff --git a/src/fns.c b/src/fns.c
index 8c895773115..cb5da8d969d 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -1236,6 +1236,65 @@ This function allows vectors as well as strings. */)
1236 return res; 1236 return res;
1237} 1237}
1238 1238
1239
1240DEFUN ("substring-no-properties", Fsubstring_no_properties, Ssubstring_no_properties, 1, 3, 0,
1241 doc: /* Return a substring of STRING, without text properties.
1242It starts at index FROM and ending before TO.
1243TO may be nil or omitted; then the substring runs to the end of STRING.
1244If FROM is nil or omitted, the substring starts at the beginning of STRING.
1245If FROM or TO is negative, it counts from the end.
1246
1247With one argument, just copy STRING without its properties. */)
1248 (string, from, to)
1249 Lisp_Object string;
1250 register Lisp_Object from, to;
1251{
1252 int size, size_byte;
1253 int from_char, to_char;
1254 int from_byte, to_byte;
1255
1256 CHECK_STRING (string);
1257
1258 size = XSTRING (string)->size;
1259 size_byte = STRING_BYTES (XSTRING (string));
1260
1261 if (NILP (from))
1262 from_char = from_byte = 0;
1263 else
1264 {
1265 CHECK_NUMBER (from);
1266 from_char = XINT (from);
1267 if (from_char < 0)
1268 from_char += size;
1269
1270 from_byte = string_char_to_byte (string, from_char);
1271 }
1272
1273 if (NILP (to))
1274 {
1275 to_char = size;
1276 to_byte = size_byte;
1277 }
1278 else
1279 {
1280 CHECK_NUMBER (to);
1281
1282 to_char = XINT (to);
1283 if (to_char < 0)
1284 to_char += size;
1285
1286 to_byte = string_char_to_byte (string, to_char);
1287 }
1288
1289 if (!(0 <= from_char && from_char <= to_char && to_char <= size))
1290 args_out_of_range_3 (string, make_number (from_char),
1291 make_number (to_char));
1292
1293 return make_specified_string (XSTRING (string)->data + from_byte,
1294 to_char - from_char, to_byte - from_byte,
1295 STRING_MULTIBYTE (string));
1296}
1297
1239/* Extract a substring of STRING, giving start and end positions 1298/* Extract a substring of STRING, giving start and end positions
1240 both in characters and in bytes. */ 1299 both in characters and in bytes. */
1241 1300
@@ -1941,7 +2000,71 @@ It can be retrieved with `(get SYMBOL PROPNAME)'. */)
1941 = Fplist_put (XSYMBOL (symbol)->plist, propname, value); 2000 = Fplist_put (XSYMBOL (symbol)->plist, propname, value);
1942 return value; 2001 return value;
1943} 2002}
2003
2004DEFUN ("lax-plist-get", Flax_plist_get, Slax_plist_get, 2, 2, 0,
2005 doc: /* Extract a value from a property list, comparing with `equal'.
2006PLIST is a property list, which is a list of the form
2007\(PROP1 VALUE1 PROP2 VALUE2...). This function returns the value
2008corresponding to the given PROP, or nil if PROP is not
2009one of the properties on the list. */)
2010 (plist, prop)
2011 Lisp_Object plist;
2012 Lisp_Object prop;
2013{
2014 Lisp_Object tail;
2015
2016 for (tail = plist;
2017 CONSP (tail) && CONSP (XCDR (tail));
2018 tail = XCDR (XCDR (tail)))
2019 {
2020 if (! NILP (Fequal (prop, XCAR (tail))))
2021 return XCAR (XCDR (tail));
2022
2023 QUIT;
2024 }
2025
2026 if (!NILP (tail))
2027 wrong_type_argument (Qlistp, prop);
2028
2029 return Qnil;
2030}
1944 2031
2032DEFUN ("lax-plist-put", Flax_plist_put, Slax_plist_put, 3, 3, 0,
2033 doc: /* Change value in PLIST of PROP to VAL, comparing with `equal'.
2034PLIST is a property list, which is a list of the form
2035\(PROP1 VALUE1 PROP2 VALUE2 ...). PROP is a symbol and VAL is any object.
2036If PROP is already a property on the list, its value is set to VAL,
2037otherwise the new PROP VAL pair is added. The new plist is returned;
2038use `(setq x (lax-plist-put x prop val))' to be sure to use the new value.
2039The PLIST is modified by side effects. */)
2040 (plist, prop, val)
2041 Lisp_Object plist;
2042 register Lisp_Object prop;
2043 Lisp_Object val;
2044{
2045 register Lisp_Object tail, prev;
2046 Lisp_Object newcell;
2047 prev = Qnil;
2048 for (tail = plist; CONSP (tail) && CONSP (XCDR (tail));
2049 tail = XCDR (XCDR (tail)))
2050 {
2051 if (! NILP (Fequal (prop, XCAR (tail))))
2052 {
2053 Fsetcar (XCDR (tail), val);
2054 return plist;
2055 }
2056
2057 prev = tail;
2058 QUIT;
2059 }
2060 newcell = Fcons (prop, Fcons (val, Qnil));
2061 if (NILP (prev))
2062 return newcell;
2063 else
2064 Fsetcdr (XCDR (prev), newcell);
2065 return plist;
2066}
2067
1945DEFUN ("equal", Fequal, Sequal, 2, 2, 0, 2068DEFUN ("equal", Fequal, Sequal, 2, 2, 0,
1946 doc: /* Return t if two Lisp objects have similar structure and contents. 2069 doc: /* Return t if two Lisp objects have similar structure and contents.
1947They must have the same data type. 2070They must have the same data type.
@@ -5352,6 +5475,7 @@ invoked by mouse clicks and mouse menu items. */);
5352 defsubr (&Sstring_as_unibyte); 5475 defsubr (&Sstring_as_unibyte);
5353 defsubr (&Scopy_alist); 5476 defsubr (&Scopy_alist);
5354 defsubr (&Ssubstring); 5477 defsubr (&Ssubstring);
5478 defsubr (&Ssubstring_no_properties);
5355 defsubr (&Snthcdr); 5479 defsubr (&Snthcdr);
5356 defsubr (&Snth); 5480 defsubr (&Snth);
5357 defsubr (&Selt); 5481 defsubr (&Selt);
@@ -5370,6 +5494,8 @@ invoked by mouse clicks and mouse menu items. */);
5370 defsubr (&Sget); 5494 defsubr (&Sget);
5371 defsubr (&Splist_put); 5495 defsubr (&Splist_put);
5372 defsubr (&Sput); 5496 defsubr (&Sput);
5497 defsubr (&Slax_plist_get);
5498 defsubr (&Slax_plist_put);
5373 defsubr (&Sequal); 5499 defsubr (&Sequal);
5374 defsubr (&Sfillarray); 5500 defsubr (&Sfillarray);
5375 defsubr (&Schar_table_subtype); 5501 defsubr (&Schar_table_subtype);