changeset 4910:6bc1f3f6cf0d

Make canoncase visible to Lisp; use it with chars in internal_equalp. src/ChangeLog addition: 2010-02-01 Aidan Kehoe <kehoea@parhasard.net> * fns.c (internal_equalp): Use bytecode_arithcompare, which takes two args, instead of passing a stack pointer to Feqlsign. Use CANONCASE(), not DOWNCASE(), for case-insensitive character comparison. Correct a comment here. * casefiddle.c (casify_object): New operation in this function, CASE_CANONICALIZE. (Fcanoncase): New function, used for case-insensitive comparison. * lisp.h: Make Fcanoncase, bytecode_arithcompare visible here. * bytecode.c (bytecode_arithcompare): Make this visible to other files. lisp/ChangeLog addition: 2010-02-01 Aidan Kehoe <kehoea@parhasard.net> * cl-macs.el (equalp): Remove special treatment for an #'equalp with a single character constant argument, it was incorrect (it used #'downcase instead of #'canoncase).
author Aidan Kehoe <kehoea@parhasard.net>
date Mon, 01 Feb 2010 17:57:04 +0000
parents 87175eb65ff4
children 7eec2a1f3412 48b63cd88a21
files lisp/ChangeLog lisp/cl-macs.el src/ChangeLog src/bytecode.c src/casefiddle.c src/fns.c src/lisp.h
diffstat 7 files changed, 65 insertions(+), 15 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Mon Feb 01 06:20:05 2010 -0600
+++ b/lisp/ChangeLog	Mon Feb 01 17:57:04 2010 +0000
@@ -1,3 +1,10 @@
+2010-02-01  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* cl-macs.el (equalp):
+	Remove special treatment for an #'equalp with a single character
+	constant argument, it was incorrect (it used #'downcase instead of
+	#'canoncase).
+
 2010-02-01  Ben Wing  <ben@xemacs.org>
 
 	* cl-extra.el:
--- a/lisp/cl-macs.el	Mon Feb 01 06:20:05 2010 -0600
+++ b/lisp/cl-macs.el	Mon Feb 01 17:57:04 2010 +0000
@@ -3412,12 +3412,6 @@
 	     ;; No need to protect against multiple evaluation here:
 	     `(and (member ,original-y '("" #* [])) t))
 	    (t form)))
-	  ((unordered-check (and (characterp x) (not (cl-const-expr-p y))))
-	   `(,@let-form
-	     (or (eq ,x ,y)
-		 ;; eq has a bytecode, char-equal doesn't.
-		 (and (characterp ,y)
-		      (eq (downcase ,x) (downcase ,y))))))
 	  ((unordered-check (and (numberp x) (not (cl-const-expr-p y))))
 	   `(,@let-form
 	     (and (numberp ,y)
--- a/src/ChangeLog	Mon Feb 01 06:20:05 2010 -0600
+++ b/src/ChangeLog	Mon Feb 01 17:57:04 2010 +0000
@@ -1,3 +1,19 @@
+2010-02-01  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* fns.c (internal_equalp):
+	Use bytecode_arithcompare, which takes two args, instead of
+	passing a stack pointer to Feqlsign.
+	Use CANONCASE(), not DOWNCASE(), for case-insensitive character
+	comparison.
+	Correct a comment here.
+	* casefiddle.c (casify_object): New operation in this function,
+	CASE_CANONICALIZE.
+	(Fcanoncase): New function, used for case-insensitive comparison.
+	* lisp.h:
+	Make Fcanoncase, bytecode_arithcompare visible here.
+	* bytecode.c (bytecode_arithcompare):
+	Make this visible to other files.
+
 2010-02-01  Ben Wing  <ben@xemacs.org>
 
 	* objects-gtk-impl.h:
--- a/src/bytecode.c	Mon Feb 01 06:20:05 2010 -0600
+++ b/src/bytecode.c	Mon Feb 01 17:57:04 2010 +0000
@@ -330,7 +330,7 @@
 
 /* We have our own two-argument versions of various arithmetic ops.
    Only two-argument arithmetic operations have their own byte codes. */
-static int
+int
 bytecode_arithcompare (Lisp_Object obj1, Lisp_Object obj2)
 {
 #ifdef WITH_NUMBER_TYPES
--- a/src/casefiddle.c	Mon Feb 01 06:20:05 2010 -0600
+++ b/src/casefiddle.c	Mon Feb 01 17:57:04 2010 +0000
@@ -28,7 +28,8 @@
 #include "insdel.h"
 #include "syntax.h"
 
-enum case_action {CASE_UP, CASE_DOWN, CASE_CAPITALIZE, CASE_CAPITALIZE_UP};
+enum case_action {CASE_UP, CASE_DOWN, CASE_CAPITALIZE, CASE_CAPITALIZE_UP,
+                  CASE_CANONICALIZE};
 
 static Lisp_Object
 casify_object (enum case_action flag, Lisp_Object string_or_char,
@@ -43,7 +44,19 @@
       Ichar c;
       CHECK_CHAR_COERCE_INT (string_or_char);
       c = XCHAR (string_or_char);
-      c = (flag == CASE_DOWN) ? DOWNCASE (buf, c) : UPCASE (buf, c);
+      if (flag == CASE_DOWN)
+	{
+	  c = DOWNCASE (buf, c);
+	}
+      else if (flag == CASE_UP)
+	{
+	  c = UPCASE (buf, c);
+	}
+      else
+	{
+	  c = CANONCASE (buf, c);
+	}
+
       return make_char (c);
     }
 
@@ -68,6 +81,9 @@
 	    case CASE_DOWN:
 	      c = DOWNCASE (buf, c);
 	      break;
+	    case CASE_CANONICALIZE:
+	      c = CANONCASE (buf, c);
+	      break;
 	    case CASE_CAPITALIZE:
 	    case CASE_CAPITALIZE_UP:
 	      wordp_prev = wordp;
@@ -119,6 +135,23 @@
   return casify_object (CASE_DOWN, string_or_char, buffer);
 }
 
+DEFUN ("canoncase", Fcanoncase, 1, 2, 0, /*
+Convert STRING-OR-CHAR to its canonical lowercase form and return that.
+
+STRING-OR-CHAR may be a character or string.  The result has the same type.
+STRING-OR-CHAR is not altered--the value is a copy.
+
+Optional second arg BUFFER specifies which buffer's case tables to use,
+and defaults to the current buffer.
+
+For any N characters that are equivalent in case-insensitive searching,
+their canonical lowercase character will be the same.
+*/
+       (string_or_char, buffer))
+{
+  return casify_object (CASE_CANONICALIZE, string_or_char, buffer);
+}
+
 DEFUN ("capitalize", Fcapitalize, 1, 2, 0, /*
 Convert STRING-OR-CHAR to capitalized form and return that.
 This means that each word's first character is upper case
@@ -331,6 +364,7 @@
 {
   DEFSUBR (Fupcase);
   DEFSUBR (Fdowncase);
+  DEFSUBR (Fcanoncase);
   DEFSUBR (Fcapitalize);
   DEFSUBR (Fupcase_initials);
   DEFSUBR (Fupcase_region);
--- a/src/fns.c	Mon Feb 01 06:20:05 2010 -0600
+++ b/src/fns.c	Mon Feb 01 17:57:04 2010 +0000
@@ -2888,15 +2888,12 @@
   /* 2. If both numbers, compare with `='. */
   if (NUMBERP (obj1) && NUMBERP (obj2))
     {
-      Lisp_Object args[2];
-      args[0] = obj1;
-      args[1] = obj2;
-      return !NILP (Feqlsign (2, args));
+      return (0 == bytecode_arithcompare (obj1, obj2));
     }
 
   /* 3. If characters, compare case-insensitively. */
   if (CHARP (obj1) && CHARP (obj2))
-    return DOWNCASE (0, XCHAR (obj1)) == DOWNCASE (0, XCHAR (obj2));
+    return CANONCASE (0, XCHAR (obj1)) == CANONCASE (0, XCHAR (obj2));
 
   /* 4. If arrays of different types, compare their lengths, and
         then compare element-by-element. */
@@ -2909,7 +2906,7 @@
 	EMACS_INT i;
 	EMACS_INT l1 = XINT (Flength (obj1));
 	EMACS_INT l2 = XINT (Flength (obj2));
-	/* Both arrays, but of different types */
+	/* Both arrays, but of different lengths */
 	if (l1 != l2)
 	  return 0;
 	for (i = 0; i < l1; i++)
--- a/src/lisp.h	Mon Feb 01 06:20:05 2010 -0600
+++ b/src/lisp.h	Mon Feb 01 17:57:04 2010 +0000
@@ -4388,6 +4388,7 @@
 
 /* Defined in casefiddle.c */
 EXFUN (Fdowncase, 2);
+EXFUN (Fcanoncase, 2);
 EXFUN (Fupcase, 2);
 EXFUN (Fupcase_initials, 2);
 EXFUN (Fupcase_initials_region, 3);
@@ -5119,6 +5120,7 @@
 Lisp_Object vconcat3 (Lisp_Object, Lisp_Object, Lisp_Object);
 Lisp_Object nconc2 (Lisp_Object, Lisp_Object);
 Lisp_Object bytecode_nconc2 (Lisp_Object *);
+int bytecode_arithcompare (Lisp_Object obj1, Lisp_Object obj2);
 void check_losing_bytecode (const char *, Lisp_Object);
 
 Lisp_Object add_suffix_to_symbol (Lisp_Object symbol,