changeset 3681:3131094eed8c

[xemacs-hg @ 2006-11-15 21:39:51 by aidan] Move charsets-in-region to C.
author aidan
date Wed, 15 Nov 2006 21:40:02 +0000
parents efca49973324
children be6b3f49446d
files lisp/ChangeLog lisp/mule/mule-charset.el src/ChangeLog src/mule-charset.c
diffstat 4 files changed, 54 insertions(+), 32 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Wed Nov 15 21:12:17 2006 +0000
+++ b/lisp/ChangeLog	Wed Nov 15 21:40:02 2006 +0000
@@ -1,3 +1,11 @@
+2006-11-15  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* mule/mule-charset.el:
+	* mule/mule-charset.el (charsets-in-string):
+	Implement it in terms of charsets-in-region.
+	* mule/mule-charset.el (charsets-in-region): Removed. It's now in
+	C.
+
 2006-11-07  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* unicode.el:
--- a/lisp/mule/mule-charset.el	Wed Nov 15 21:12:17 2006 +0000
+++ b/lisp/mule/mule-charset.el	Wed Nov 15 21:40:02 2006 +0000
@@ -38,42 +38,16 @@
 
 ;;;; Classifying text according to charsets
 
-;; the old version was broken in a couple of ways
-;; this is one of several versions, I tried a hash as well as the
-;; `prev-charset' cache used in the old version, but this was definitely
-;; faster than the hash version and marginally faster than the prev-charset
-;; version
-;; #### this really needs to be moved into C
-(defun charsets-in-region (start end &optional buffer)
-  "Return a list of the charsets in the region between START and END.
-BUFFER defaults to the current buffer if omitted."
-  (let (list)
-    (save-excursion
-      (if buffer
-	  (set-buffer buffer))
-      (save-restriction
-	(narrow-to-region start end)
-	(goto-char (point-min))
-	(while (not (eobp))
-	  ;; the first test will usually succeed on testing the
-	  ;; car of the list; don't waste time let-binding.
-	  (or (memq (char-charset (char-after (point))) list)
-	      (setq list (cons (char-charset (char-after (point))) list)))
-	  (forward-char))))
-    list))
-
 (defun charsets-in-string (string)
   "Return a list of the charsets in STRING."
-  (let (list)
-    (mapc (lambda (ch)
-	    ;; the first test will usually succeed on testing the
-	    ;; car of the list; don't waste time let-binding.
-	    (or (memq (char-charset ch) list)
-		(setq list (cons (char-charset ch) list))))
-	  string)
-    list))
+  (let (res)
+    (with-string-as-buffer-contents string
+      ;; charsets-in-region now in C. 
+      (setq res (charsets-in-region (point-min) (point-max))))
+    res))
 
 (defalias 'find-charset-string 'charsets-in-string)
+
 (defalias 'find-charset-region 'charsets-in-region)
 
 
--- a/src/ChangeLog	Wed Nov 15 21:12:17 2006 +0000
+++ b/src/ChangeLog	Wed Nov 15 21:40:02 2006 +0000
@@ -1,3 +1,9 @@
+2006-11-15  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* mule-charset.c:
+	* mule-charset.c (Fcharsets_in_region):
+	Added a charsets-in-region implementation in C. 
+
 2006-11-14  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* objects-xlike-inc.c (x_find_charset_font):
--- a/src/mule-charset.c	Wed Nov 15 21:12:17 2006 +0000
+++ b/src/mule-charset.c	Wed Nov 15 21:40:02 2006 +0000
@@ -937,6 +937,39 @@
   return Qnil;
 }
 
+DEFUN ("charsets-in-region", Fcharsets_in_region, 2, 3, 0, /*
+Return a list of the charsets in the region between START and END.
+BUFFER defaults to the current buffer if omitted.
+*/
+       (start, end, buffer))
+{
+  /* This function can GC */
+  struct buffer *buf = decode_buffer (buffer, 1);
+  Charbpos pos, stop;	/* Limits of the region. */
+  Lisp_Object res = Qnil;
+  int charsets[NUM_LEADING_BYTES];
+  Ibyte lb;
+  struct gcpro gcpro1;
+
+  memset(charsets, 0, sizeof(charsets));
+  get_buffer_range_char (buf, start, end, &pos, &stop, 0);
+
+  GCPRO1 (res);
+  while (pos < stop)
+    {
+      lb = ichar_leading_byte(BUF_FETCH_CHAR (buf, pos));
+      if (0 == charsets[lb - MIN_LEADING_BYTE])
+	{
+	  charsets[lb - MIN_LEADING_BYTE] = 1;
+	  res = Fcons (XCHARSET_NAME(charset_by_leading_byte(lb)), res);
+	}
+      ++pos;
+    }
+  UNGCPRO;
+
+  return res;
+} 
+
 
 /************************************************************************/
 /*                            memory usage                              */
@@ -1029,6 +1062,7 @@
   DEFSUBR (Fcharset_id);
   DEFSUBR (Fset_charset_ccl_program);
   DEFSUBR (Fset_charset_registries);
+  DEFSUBR (Fcharsets_in_region);
 
 #ifdef MEMORY_USAGE_STATS
   DEFSUBR (Fcharset_memory_usage);