xemacs-beta: src/editfns.c comparison

comparison src/editfns.c @ 377:d883f39b8495 r21-2b4

Import from CVS: tag r21-2b4

author	cvs
date	Mon, 13 Aug 2007 11:05:42 +0200
parents	cc15677e0335
children	8626e4521993

comparison

equal deleted inserted replaced

-:e2295b4d9f2e
+:d883f39b8495
 #include "events.h"             /* for EVENTP */
 #include "extents.h"
 #include "frame.h"
 #include "insdel.h"
 #include "window.h"
+#include "chartab.h"
 #include "line-number.h"
 #include "systime.h"
 #include "sysdep.h"
 #include "syspwd.h"
 get_buffer_range_char (b, start, end, &begv, &zv, GB_ALLOW_NIL);
 return make_string_from_buffer (b, begv, zv - begv);
 }
+/* It might make more sense to name this
+`buffer-substring-no-extents', but this name is FSFmacs-compatible,
+and what the function does is probably good enough for what the
+user-code will typically want to use it for. */
+DEFUN ("buffer-substring-no-properties", Fbuffer_substring_no_properties, 0, 3, 0, /*
+Return the text from BEG to END, as a string, without copying the extents.
+*/
+(start, end, buffer))
+{
+/* This function can GC */
+Bufpos begv, zv;
+struct buffer *b = decode_buffer (buffer, 1);
+get_buffer_range_char (b, start, end, &begv, &zv, GB_ALLOW_NIL);
+return make_string_from_buffer_no_extents (b, begv, zv - begv);
+}
 DEFUN ("insert-buffer-substring", Finsert_buffer_substring, 1, 3, 0, /*
 Insert before point a substring of the contents of buffer BUFFER.
 BUFFER may be a buffer or a buffer name.
 Arguments START and END are character numbers specifying the substring.
 They default to the beginning and the end of BUFFER.
 unbind_to (count, Qnil);
 return Qnil;
 }
+/* #### Shouldn't this also accept a BUFFER argument, in the good old
+XEmacs tradition?  */
 DEFUN ("translate-region", Ftranslate_region, 3, 3, 0, /*
-From START to END, translate characters according to TABLE.
+Translate characters from START to END according to TABLE.
-TABLE is a string; the Nth character in it is the mapping
-for the character with code N.  Returns the number of characters changed.
+If TABLE is a string, the Nth character in it is the mapping for the
+character with code N.
+If TABLE is a vector, its Nth element is the mapping for character
+with code N.  The values of elements may be characters, strings, or
+nil (nil meaning don't replace.)
+If TABLE is a char-table, its elements describe the mapping between
+characters and their replacements.  The char-table should be of type
+`char' or `generic'.
+Returns the number of substitutions performed.
 */
 (start, end, table))
 {
 /* This function can GC */
 Bufpos pos, stop;	/* Limits of the region. */
-REGISTER Emchar oc;		/* Old character. */
+int cnt = 0;		/* Number of changes made. */
-REGISTER Emchar nc;		/* New character. */
-int cnt;		/* Number of changes made. */
-Charcount size;	/* Size of translate table. */
 int mc_count;
 struct buffer *buf = current_buffer;
+Emchar oc;
 get_buffer_range_char (buf, start, end, &pos, &stop, 0);
-CHECK_STRING (table);
-size = XSTRING_CHAR_LENGTH (table);
-cnt = 0;
 mc_count = begin_multiple_change (buf, pos, stop);
-for (; pos < stop; pos++)
+if (STRINGP (table))
 {
-oc = BUF_FETCH_CHAR (buf, pos);
+struct Lisp_String *stable = XSTRING (table);
-if (oc >= 0 && oc < size)
+Charcount size = string_char_length (stable);
+#ifdef MULE
+/* Under Mule, string_char(n) is O(n), so for large tables or
+large regions it makes sense to create an array of Emchars.  */
+if (size * (stop - pos) > 65536)
 	{
-	  nc = string_char (XSTRING (table), oc);
+	  Emchar *etable = alloca_array (Emchar, size);
-	  if (nc != oc)
+	  convert_bufbyte_string_into_emchar_string
+	    (string_data (stable), string_length (stable), etable);
+	  for (; pos < stop && (oc = BUF_FETCH_CHAR (buf, pos), 1); pos++)
 	    {
-	      buffer_replace_char (buf, pos, nc, 0, 0);
+	      if (oc < size)
+		{
+		  Emchar nc = etable[oc];
+		  if (nc != oc)
+		    {
+		      buffer_replace_char (buf, pos, nc, 0, 0);
+		      ++cnt;
+		    }
+		}
+	    }
+	}
+else
+#endif /* MULE */
+	{
+	  for (; pos < stop && (oc = BUF_FETCH_CHAR (buf, pos), 1); pos++)
+	    {
+	      if (oc < size)
+		{
+		  Emchar nc = string_char (stable, oc);
+		  if (nc != oc)
+		    {
+		      buffer_replace_char (buf, pos, nc, 0, 0);
+		      ++cnt;
+		    }
+		}
+	    }
+	}
+}
+else if (VECTORP (table))
+{
+Charcount size = XVECTOR_LENGTH (table);
+Lisp_Object *vtable = XVECTOR_DATA (table);
+for (; pos < stop && (oc = BUF_FETCH_CHAR (buf, pos), 1); pos++)
+	{
+	  if (oc < size)
+	    {
+	      Lisp_Object replacement = vtable[oc];
+	    retry:
+	      if (CHAR_OR_CHAR_INTP (replacement))
+		{
+		  Emchar nc = XCHAR_OR_CHAR_INT (replacement);
+		  if (nc != oc)
+		    {
+		      buffer_replace_char (buf, pos, nc, 0, 0);
+		      ++cnt;
+		    }
+		}
+	      else if (STRINGP (replacement))
+		{
+		  Charcount incr = XSTRING_CHAR_LENGTH (replacement) - 1;
+		  buffer_delete_range (buf, pos, pos + 1, 0);
+		  buffer_insert_lisp_string_1 (buf, pos, replacement, 0);
+		  pos += incr, stop += incr;
+		  ++cnt;
+		}
+	      else if (!NILP (replacement))
+		{
+		  replacement = wrong_type_argument (Qchar_or_string_p, replacement);
+		  goto retry;
+		}
+	    }
+	}
+}
+else if (CHAR_TABLEP (table)
+	   && (XCHAR_TABLE_TYPE (table) == CHAR_TABLE_TYPE_GENERIC
+	       || XCHAR_TABLE_TYPE (table) == CHAR_TABLE_TYPE_CHAR))
+{
+struct Lisp_Char_Table *ctable = XCHAR_TABLE (table);
+for (; pos < stop && (oc = BUF_FETCH_CHAR (buf, pos), 1); pos++)
+	{
+	  Lisp_Object replacement = get_char_table (oc, ctable);
+	retry2:
+	  if (CHAR_OR_CHAR_INTP (replacement))
+	    {
+	      Emchar nc = XCHAR_OR_CHAR_INT (replacement);
+	      if (nc != oc)
+		{
+		  buffer_replace_char (buf, pos, nc, 0, 0);
+		  ++cnt;
+		}
+	    }
+	  else if (STRINGP (replacement))
+	    {
+	      Charcount incr = XSTRING_CHAR_LENGTH (replacement) - 1;
+	      buffer_delete_range (buf, pos, pos + 1, 0);
+	      buffer_insert_lisp_string_1 (buf, pos, replacement, 0);
+	      pos += incr, stop += incr;
 	      ++cnt;
 	    }
+	  else if (!NILP (replacement))
+	    {
+	      replacement = wrong_type_argument (Qchar_or_string_p, replacement);
+	      goto retry2;
+	    }
 	}
 }
+else
+dead_wrong_type_argument (Qstringp, table);
 end_multiple_change (buf, mc_count);
 return make_int (cnt);
 }
 DEFSUBR (Fchar_Equal);
 DEFSUBR (Fgoto_char);
 DEFSUBR (Fstring_to_char);
 DEFSUBR (Fchar_to_string);
 DEFSUBR (Fbuffer_substring);
+DEFSUBR (Fbuffer_substring_no_properties);
 DEFSUBR (Fpoint_marker);
 DEFSUBR (Fmark_marker);
 DEFSUBR (Fpoint);
 DEFSUBR (Fregion_beginning);

Mercurial > hg > xemacs-beta

comparison src/editfns.c @ 377:d883f39b8495 r21-2b4