Mercurial > hg > xemacs-beta
diff lisp/cl-extra.el @ 5476:f2881cb841b4
Merged with trunk.
author | Mats Lidell <matsl@xemacs.org> |
---|---|
date | Tue, 26 Apr 2011 23:41:47 +0200 |
parents | 248176c74e6b 568ec109e73d |
children | 855b667dea13 |
line wrap: on
line diff
--- a/lisp/cl-extra.el Sat Apr 23 23:47:13 2011 +0200 +++ b/lisp/cl-extra.el Tue Apr 26 23:41:47 2011 +0200 @@ -688,13 +688,59 @@ (setq float-negative-epsilon (* x 2)))))) (cl-float-limits)) -;; No type-checking here, we should add it. -(defalias 'char< '<) -(defalias 'char>= '>=) -(defalias 'char> '>) -(defalias 'char<= '<=) ;;; Character functions. +(macrolet + ((define-char-comparisons (&rest alist) + "Provide Common Lisp's character-specific comparison predicates. + +These throw errors if any arguments are non-characters, conflicting with +typical emacs behavior. This is not the case if +`byte-compile-delete-errors' is non-nil; see the documentation of that +variable. + +This doesn't include the case-insensitive comparisons, and it probably +should." + (let* ((functions (mapcar 'car alist)) + (map (mapcar #'(lambda (symbol) + `(,symbol . + ,(intern (substring (symbol-name symbol) + (length "char"))))) + functions))) + `(progn + (mapc + (function* + (lambda ((function . cl-unsafe-comparison)) + (put function 'cl-unsafe-comparison cl-unsafe-comparison) + (put function 'cl-compiler-macro + #'(lambda (form &rest arguments) + (if byte-compile-delete-errors + (cons (get (car form) 'cl-unsafe-comparison) + (cdr form)) + form))))) + ',map) + ,@(mapcar + (function* + (lambda ((function . documentation)) + `(defun ,function (character &rest more-characters) + ,documentation + (check-type character character) + (check-type more-characters + (satisfies (lambda (list) + (every 'characterp list)))) + (apply ',(cdr (assq function map)) + character more-characters)))) + alist))))) + (define-char-comparisons + (char= . "Return t if all character arguments are the same object.") + (char/= . "Return t if no two character arguments are the same object.") + (char< . "Return t if the character arguments monotonically increase.") + (char> . "Return t if the character arguments monotonically decrease.") + (char<= . "Return t if the character arguments are monotonically \ +nondecreasing.") + (char>= . "Return t if the character arguments are monotonically \ +nonincreasing."))) + (defun* digit-char-p (character &optional (radix 10)) "Return non-nil if CHARACTER represents a digit in base RADIX.