xemacs-beta: src/fns.c comparison

comparison src/fns.c @ 5039:f8ae1031c706

merge

author	Ben Wing <ben@xemacs.org>
date	Sat, 20 Feb 2010 19:04:55 -0600
parents	9624523604c5
children	c3d372419e09 b5df3737028a

comparison

equal deleted inserted replaced

-:9410323e4b0d
+:f8ae1031c706
 return Qnil;
 }
 }
 /* Split STRING into a list of substrings.  The substrings are the
-parts of original STRING separated by SEPCHAR.  */
+parts of original STRING separated by SEPCHAR.
+If UNESCAPE is non-zero, ESCAPECHAR specifies a character that will quote
+SEPCHAR, and cause it not to split STRING. A double ESCAPECHAR is
+necessary for ESCAPECHAR to appear once in a substring. */
 static Lisp_Object
 split_string_by_ichar_1 (const Ibyte *string, Bytecount size,
-			  Ichar sepchar)
+Ichar sepchar, int unescape, Ichar escapechar)
 {
 Lisp_Object result = Qnil;
 const Ibyte *end = string + size;
-while (1)
+if (unescape)
 {
-const Ibyte *p = string;
+Ibyte unescape_buffer[64], *unescape_buffer_ptr = unescape_buffer,
-while (p < end)
+escaped[MAX_ICHAR_LEN], *unescape_cursor;
-	{
+Bytecount unescape_buffer_size = countof (unescape_buffer),
-	  if (itext_ichar (p) == sepchar)
+escaped_len = set_itext_ichar (escaped, escapechar);
-	    break;
+Boolint deleting_escapes, previous_escaped;
-	  INC_IBYTEPTR (p);
+Ichar pchar;
-	}
-result = Fcons (make_string (string, p - string), result);
+while (1)
-if (p < end)
+{
-	{
+const Ibyte *p = string, *cursor;
-	  string = p;
+deleting_escapes = 0;
-	  INC_IBYTEPTR (string);	/* skip sepchar */
+previous_escaped = 0;
-	}
-else
+while (p < end)
-	break;
+{
+pchar = itext_ichar (p);
+if (pchar == sepchar)
+{
+if (!previous_escaped)
+{
+break;
+}
+}
+else if (pchar == escapechar
+/* Doubled escapes don't escape: */
+&& !previous_escaped)
+{
+++deleting_escapes;
+previous_escaped = 1;
+}
+else
+{
+previous_escaped = 0;
+}
+INC_IBYTEPTR (p);
+}
+if (deleting_escapes)
+{
+if (((p - string) - (escaped_len * deleting_escapes))
+> unescape_buffer_size)
+{
+unescape_buffer_size =
+((p - string) - (escaped_len * deleting_escapes)) * 1.5;
+unescape_buffer_ptr = alloca_ibytes (unescape_buffer_size);
+}
+cursor = string;
+unescape_cursor = unescape_buffer_ptr;
+previous_escaped = 0;
+while (cursor < p)
+{
+pchar = itext_ichar (cursor);
+if (pchar != escapechar || previous_escaped)
+{
+memcpy (unescape_cursor, cursor,
+itext_ichar_len (cursor));
+INC_IBYTEPTR (unescape_cursor);
+}
+previous_escaped = !previous_escaped
+&& (pchar == escapechar);
+INC_IBYTEPTR (cursor);
+}
+result = Fcons (make_string (unescape_buffer_ptr,
+unescape_cursor
+- unescape_buffer_ptr),
+result);
+}
+else
+{
+result = Fcons (make_string (string, p - string), result);
+}
+if (p < end)
+{
+string = p;
+INC_IBYTEPTR (string);	/* skip sepchar */
+}
+else
+break;
+}
+}
+else
+{
+while (1)
+{
+const Ibyte *p = string;
+while (p < end)
+{
+if (itext_ichar (p) == sepchar)
+break;
+INC_IBYTEPTR (p);
+}
+result = Fcons (make_string (string, p - string), result);
+if (p < end)
+{
+string = p;
+INC_IBYTEPTR (string);	/* skip sepchar */
+}
+else
+break;
+}
 }
 return Fnreverse (result);
 }
 /* The same as the above, except PATH is an external C string (it is
 depend on split_external_path("") returning nil instead of an empty
 string?  */
 if (!newlen)
 return Qnil;
-return split_string_by_ichar_1 (newpath, newlen, SEPCHAR);
+return split_string_by_ichar_1 (newpath, newlen, SEPCHAR, 0, 0);
 }
 Lisp_Object
 split_env_path (const CIbyte *evarname, const Ibyte *default_)
 {
 path = egetenv (evarname);
 if (!path)
 path = default_;
 if (!path)
 return Qnil;
-return split_string_by_ichar_1 (path, qxestrlen (path), SEPCHAR);
+return split_string_by_ichar_1 (path, qxestrlen (path), SEPCHAR, 0, 0);
 }
 /* Ben thinks this function should not exist or be exported to Lisp.
 We use it to define split-path-string in subr.el (not!).  */
-DEFUN ("split-string-by-char", Fsplit_string_by_char, 2, 2, 0, /*
+DEFUN ("split-string-by-char", Fsplit_string_by_char, 2, 3, 0, /*
 Split STRING into a list of substrings originally separated by SEPCHAR.
-*/
-(string, sepchar))
+With optional ESCAPE-CHAR, any instances of SEPCHAR preceded by that
-{
+character will not split the string, and a double instance of ESCAPE-CHAR
+will be necessary for a single ESCAPE-CHAR to appear in the output string.
+*/
+(string, sepchar, escape_char))
+{
+Ichar escape_ichar = 0;
 CHECK_STRING (string);
 CHECK_CHAR (sepchar);
+if (!NILP (escape_char))
+{
+CHECK_CHAR (escape_char);
+escape_ichar = XCHAR (escape_char);
+}
 return split_string_by_ichar_1 (XSTRING_DATA (string),
-				   XSTRING_LENGTH (string),
+XSTRING_LENGTH (string),
-				   XCHAR (sepchar));
+XCHAR (sepchar),
+!NILP (escape_char), escape_ichar);
 }
 /* #### This was supposed to be in subr.el, but is used VERY early in
 the bootstrap process, so it goes here.  Damn.  */
 "`path-separator' should be set to a single-character string",
 Vpath_separator);
 return (split_string_by_ichar_1
 	  (XSTRING_DATA (path), XSTRING_LENGTH (path),
-	   itext_ichar (XSTRING_DATA (Vpath_separator))));
+	   itext_ichar (XSTRING_DATA (Vpath_separator)), 0, 0));
 }
 DEFUN ("nthcdr", Fnthcdr, 2, 2, 0, /*
 Take cdr N times on LIST, and return the result.
 Call FUNCTION CALL_COUNT times, with NSEQUENCES arguments each time,
 taking the elements from SEQUENCES.  If VALS is non-NULL, store the
 results into VALS, a C array of Lisp_Objects; else, if LISP_VALS is
 non-nil, store the results into LISP_VALS, a sequence with sufficient
-room for CALL_COUNT results. Else, do not accumulate any result.
+room for CALL_COUNT results (but see the documentation of SOME_OR_EVERY.)
+Else, do not accumulate any result.
 If VALS is non-NULL, NSEQUENCES is one, and SEQUENCES[0] is a cons,
 mapcarX will store the elements of SEQUENCES[0] in stack and GCPRO them,
 so FUNCTION cannot insert a non-cons into SEQUENCES[0] and throw off
 mapcarX.
 destructively modifies SEQUENCES in a way that might affect the ongoing
 traversal operation.
 If SOME_OR_EVERY is SOME_OR_EVERY_SOME, return the (possibly multiple)
 values given by FUNCTION the first time it is non-nil, and abandon the
-iterations.  LISP_VALS in this case must be an object created by
+iterations.  LISP_VALS must be a cons, and the return value will be
-make_opaque_ptr, dereferenced as pointing to a Lisp object. If
+stored in its car.  If SOME_OR_EVERY is SOME_OR_EVERY_EVERY, store Qnil
-SOME_OR_EVERY is SOME_OR_EVERY_EVERY, store Qnil at the Lisp_Object
+in the car of LISP_VALS if FUNCTION gives nil; otherwise leave it
-pointer address provided by LISP_VALS if FUNCTION gives nil; otherwise
+alone. */
-leave it alone. */
 #define SOME_OR_EVERY_NEITHER 0
 #define SOME_OR_EVERY_SOME    1
 #define SOME_OR_EVERY_EVERY   2
 gcpro2.nvars = call_count;
 for (i = 0; i < call_count; ++i)
 	{
 	  args[1] = vals[i];
-	  vals[i] = Ffuncall (nsequences + 1, args);
+	  vals[i] = IGNORE_MULTIPLE_VALUES (Ffuncall (nsequences + 1, args));
 	}
 }
 else
 {
 Binbyte *sequence_types = alloca_array (Binbyte, nsequences);
 			    return;
 			  }
 			break;
 		      }
-		    goto bad_show_or_every_flag;
+		    goto bad_some_or_every_flag;
 		  }
 		case lrecord_type_vector:
 		  {
 		    called = IGNORE_MULTIPLE_VALUES (called);
 		    i < XVECTOR_LENGTH (lisp_vals) ?
 		      set_bit_vector_bit (XBIT_VECTOR (lisp_vals), i,
 					  XINT (called)) :
 		      (void) Faset (lisp_vals, make_int (i), called);
 		    break;
 		  }
-		bad_show_or_every_flag:
+		bad_some_or_every_flag:
 		default:
 		  {
 		    ABORT();
 		    break;
 		  }

Mercurial > hg > xemacs-beta

comparison src/fns.c @ 5039:f8ae1031c706