From ce92c7af769b9e0c3f3081025ead58bc93b3a26c Mon Sep 17 00:00:00 2001 From: ueno Date: Sun, 3 Sep 2000 17:59:49 +0000 Subject: [PATCH] * 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. --- lisp/ChangeLog | 15 ++++++++++ lisp/liece-clfns.el | 31 ++++++++++----------- lisp/liece-inlines.el | 73 +++++++++++++++++++++++++------------------------ 3 files changed, 67 insertions(+), 52 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index ff7887d..bc04e25 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,18 @@ +2000-09-03 Daiki Ueno + + + * 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 * liece-channel.el (liece-channel-change): Handle diff --git a/lisp/liece-clfns.el b/lisp/liece-clfns.el index a76ea7a..3858949 100644 --- 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 --- 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." -- 1.7.10.4