carbon2-commit: Make canoncase visible to Lisp; use it with chars in internal_equalp.
Aidan Kehoe
kehoea at parhasard.net
Sun Feb 7 12:39:58 EST 2010
changeset: 4958:6bc1f3f6cf0d
user: Aidan Kehoe <kehoea at parhasard.net>
date: Mon Feb 01 17:57:04 2010 +0000
files: lisp/ChangeLog lisp/cl-macs.el src/ChangeLog src/bytecode.c src/casefiddle.c src/fns.c src/lisp.h
description:
Make canoncase visible to Lisp; use it with chars in internal_equalp.
src/ChangeLog addition:
2010-02-01 Aidan Kehoe <kehoea at 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 at 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).
diff -r 87175eb65ff4 -r 6bc1f3f6cf0d lisp/ChangeLog
--- 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 at 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 at xemacs.org>
* cl-extra.el:
diff -r 87175eb65ff4 -r 6bc1f3f6cf0d lisp/cl-macs.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))))
- `(, at 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))))
`(, at let-form
(and (numberp ,y)
diff -r 87175eb65ff4 -r 6bc1f3f6cf0d src/ChangeLog
--- 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 at 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 at xemacs.org>
* objects-gtk-impl.h:
diff -r 87175eb65ff4 -r 6bc1f3f6cf0d src/bytecode.c
--- 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
diff -r 87175eb65ff4 -r 6bc1f3f6cf0d src/casefiddle.c
--- 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);
}
@@ -67,6 +80,9 @@
break;
case CASE_DOWN:
c = DOWNCASE (buf, c);
+ break;
+ case CASE_CANONICALIZE:
+ c = CANONCASE (buf, c);
break;
case CASE_CAPITALIZE:
case CASE_CAPITALIZE_UP:
@@ -117,6 +133,23 @@
(string_or_char, buffer))
{
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, /*
@@ -331,6 +364,7 @@
{
DEFSUBR (Fupcase);
DEFSUBR (Fdowncase);
+ DEFSUBR (Fcanoncase);
DEFSUBR (Fcapitalize);
DEFSUBR (Fupcase_initials);
DEFSUBR (Fupcase_region);
diff -r 87175eb65ff4 -r 6bc1f3f6cf0d src/fns.c
--- 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++)
diff -r 87175eb65ff4 -r 6bc1f3f6cf0d src/lisp.h
--- 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,
More information about the XEmacs-Patches
mailing list