* liece-clfns.el: Require `pym'.

(liece-clfns-subr-fboundp): New macro.
(last,member-if,member-if-not,delete-if,remove-if,remove-if-not,
assoc-if,rassoc-if): Use it.

* liece-inlines.el (string-list-member-ignore-case): Use
`member-ignore-case'.
(string-list-remove-ignore-case): Use remq.
(string-list-member): Abolish.
(string-list-delete-ignore-case): Use delq.
(string-equal-ignore-case): Use `compare-strings' if available.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index ff7887d..bc04e25 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,18 @@
+2000-09-03   Daiki Ueno  <ueno@unixuser.org>
+
+
+       * liece-clfns.el: Require `pym'.
+       (liece-clfns-subr-fboundp): New macro.
+       (last,member-if,member-if-not,delete-if,remove-if,remove-if-not,
+       assoc-if,rassoc-if): Use it.
+
+       * liece-inlines.el (string-list-member-ignore-case): Use
+       `member-ignore-case'.
+       (string-list-remove-ignore-case): Use remq.
+       (string-list-member): Abolish.
+       (string-list-delete-ignore-case): Use delq.
+       (string-equal-ignore-case): Use `compare-strings' if available.
+
 2000-09-01   Daiki Ueno  <ueno@unixuser.org>
 
        * liece-channel.el (liece-channel-change): Handle

diff --git a/lisp/liece-clfns.el b/lisp/liece-clfns.el
index a76ea7a..3858949 100644 (file)
--- a/lisp/liece-clfns.el
+++ b/lisp/liece-clfns.el
@@ -30,13 +30,19 @@
 
 ;;; Code:
 
+(require 'pym)
+
+(defmacro liece-clfns-subr-fboundp (symbol)
+  "Return t if SYMBOL's function definition is a basic function."
+  (or (subr-fboundp symbol)
+      (string-equal (symbol-file symbol) "subr")))
+
 (if (featurep 'xemacs)
     nil
   (require 'cl)
 
   (define-compiler-macro last (&whole form x &optional n)
-    (if (and (fboundp 'last)
-            (subrp (symbol-function 'last)))
+    (if (liece-clfns-subr-fboundp 'last)
        form
       (if n
          `(let* ((x ,x) (n ,n) (m 0) (p x))
@@ -54,8 +60,7 @@
           x))))
 
   (define-compiler-macro member-if (&whole form pred list)
-    (if (and (fboundp 'member-if)
-            (subrp (symbol-function 'member-if)))
+    (if (liece-clfns-subr-fboundp 'member-if)
        form
       `(let ((fn ,pred)
             (seq ,list))
@@ -64,8 +69,7 @@
         seq)))
 
   (define-compiler-macro member-if-not (&whole form pred list)
-    (if (and (fboundp 'member-if-not)
-            (subrp (symbol-function 'member-if-not)))
+    (if (liece-clfns-subr-fboundp 'member-if-not)
        form
       `(let ((fn ,pred)
             (seq ,list))
@@ -74,8 +78,7 @@
         seq)))
   
   (define-compiler-macro delete-if (&whole form pred list)
-    (if (and (fboundp 'delete-if)
-            (subrp (symbol-function 'delete-if)))
+    (if (liece-clfns-subr-fboundp 'delete-if)
        form
       `(let* ((fn ,pred) (seq ,list) (p seq))
         (while (and p (not (funcall fn (car p))))
@@ -83,8 +86,7 @@
         (if p (delq (car p) seq)))))
 
   (define-compiler-macro remove-if (&whole form pred list)
-    (if (and (fboundp 'remove-if)
-            (subrp (symbol-function 'remove-if)))
+    (if (liece-clfns-subr-fboundp 'remove-if)
        form
       `(let* ((fn ,pred) (seq (copy-sequence ,list)) (p seq))
         (while (and p (not (funcall fn (car p))))
@@ -92,8 +94,7 @@
         (if p (delq (car p) seq) seq))))
 
   (define-compiler-macro remove-if-not (&whole form pred list)
-    (if (and (fboundp 'remove-if-not)
-            (subrp (symbol-function 'remove-if-not)))
+    (if (liece-clfns-subr-fboundp 'remove-if-not)
        form
       `(let* ((fn ,pred) (seq (copy-sequence ,list)) (p seq))
         (while (and p (funcall fn (car p)))
@@ -101,8 +102,7 @@
         (if p (delq (car p) seq) seq))))
 
   (define-compiler-macro assoc-if (&whole form pred list)
-    (if (and (fboundp 'assoc-if)
-            (subrp (symbol-function 'assoc-if)))
+    (if (liece-clfns-subr-fboundp 'assoc-if)
        form
       `(let ((fn ,pred) (seq ,list))
         (while (and seq (not (funcall fn (caar seq))))
@@ -110,8 +110,7 @@
         (car seq))))
 
   (define-compiler-macro rassoc-if (&whole form pred list)
-    (if (and (fboundp 'rassoc-if)
-            (subrp (symbol-function 'rassoc-if)))
+    (if (liece-clfns-subr-fboundp 'rassoc-if)
        form
       `(let ((fn ,pred) (seq ,list))
         (while (and seq (not (funcall fn (cdar seq))))

diff --git a/lisp/liece-inlines.el b/lisp/liece-inlines.el
index e572b9e..7bec086 100644 (file)
--- a/lisp/liece-inlines.el
+++ b/lisp/liece-inlines.el
@@ -44,46 +44,45 @@
 (defmacro string-join (strlst &optional del)
   `(mapconcat #'identity ,strlst ,del))
 
-(defsubst string-equal-ignore-case (s1 s2)
-  (string-equal (upcase s1) (upcase s2)))
-
-(defsubst string-list-member-ignore-case (thing list)
-  "Returns t if thing is member of list, not funcallable"
-  (member-if
-   (lambda (item)
-     (and (stringp item) (string-equal-ignore-case thing item)))
-   list))
-
-(defsubst string-list-member (thing list)
-  "Returns t if thing is member of list, not funcallable"
-  (member-if
-   (lambda (item)
-     (and (stringp item) (string-equal thing item)))
-   list))
+(static-if (subr-fboundp 'compare-strings)
+    (defmacro string-equal-ignore-case (s1 s2)
+      `(compare-strings ,s1 0 nil ,s2 0 nil 'ignore-case))
+  (defmacro string-equal-ignore-case (s1 s2)
+    (string-equal (upcase ,s1) (upcase ,s2))))
+
+(static-if (fboundp 'member-ignore-case)
+    (defalias 'string-list-member-ignore-case
+      'member-ignore-case)
+  (defsubst string-list-member-ignore-case (thing list)
+    "Returns t if thing is member of list, not funcallable"
+    (member-if
+     (lambda (item)
+       (and (stringp item) (string-equal-ignore-case thing item)))
+     list)))
 
 (defsubst string-list-remove-ignore-case (thing list)
-  (remove-if
-   (lambda (item)
-     (and (stringp item) (string-equal-ignore-case item thing)))
-   list))
+  (let ((element (string-list-member-ignore-case thing list)))
+    (if element
+       (remq element list)
+      list)))
 
 (defsubst string-list-delete-ignore-case (thing list)
-  (delete-if
-   (lambda (item)
-     (and (stringp item) (string-equal-ignore-case item thing)))
-   list))
+  (let ((element (string-list-delete-ignore-case thing list)))
+    (if element
+       (delq element list)
+      list)))
 
 (defsubst string-list-remove (thing list)
-  (remove-if
-   (lambda (item)
-     (and (stringp item) (string-equal item thing)))
-   list))
+  (let ((element (member thing list)))
+    (if element
+       (remq element list)
+      list)))
 
 (defsubst string-list-delete (thing list)
-  (delete-if
-   (lambda (item)
-     (and (stringp item) (string-equal item thing)))
-   list))
+  (let ((element (member thing list)))
+    (if element
+       (delq element list)
+      list)))
 
 (defsubst string-list-modify-ignore-case (modifiers list)
   (dolist (modifier modifiers)
@@ -94,10 +93,12 @@
        (setq p (cdr p)))))
   list)
 
-(defsubst string-assoc-ignore-case (key list)
-  (assoc-if
-   (lambda (item) (string-equal-ignore-case item key))
-   list))
+(static-if (fboundp 'assoc-ignore-case)
+    (defalias 'string-assoc-ignore-case 'assoc-ignore-case)
+  (defsubst string-assoc-ignore-case (key list)
+    (assoc-if
+     (lambda (item) (string-equal-ignore-case item key))
+     list)))
 
 (defsubst regexp-assoc-ignore-case (key list)
   "Assoc with REGEXP-KEY from LIST."