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.