Mercurial > hg > xemacs-beta

comparison lisp/cl-extra.el @ 5476:f2881cb841b4

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Merged with trunk.
author Mats Lidell <matsl@xemacs.org>
date Tue, 26 Apr 2011 23:41:47 +0200
parents 248176c74e6b 568ec109e73d
children 855b667dea13
comparison
equal deleted inserted replaced
5475:248176c74e6b 5476:f2881cb841b4
686 (setq x 1e0) 686 (setq x 1e0)
687 (while (/= (- 1e0 x) 1e0) (setq x (/ x 2))) 687 (while (/= (- 1e0 x) 1e0) (setq x (/ x 2)))
688 (setq float-negative-epsilon (* x 2)))))) 688 (setq float-negative-epsilon (* x 2))))))
689 (cl-float-limits)) 689 (cl-float-limits))
690 690
691 ;; No type-checking here, we should add it.
692 (defalias 'char< '<)
693 (defalias 'char>= '>=)
694 (defalias 'char> '>)
695 (defalias 'char<= '<=)
696 691
697 ;;; Character functions. 692 ;;; Character functions.
693 (macrolet
694 ((define-char-comparisons (&rest alist)
695 "Provide Common Lisp's character-specific comparison predicates.
696
697 These throw errors if any arguments are non-characters, conflicting with
698 typical emacs behavior. This is not the case if
699 `byte-compile-delete-errors' is non-nil; see the documentation of that
700 variable.
701
702 This doesn't include the case-insensitive comparisons, and it probably
703 should."
704 (let* ((functions (mapcar 'car alist))
705 (map (mapcar #'(lambda (symbol)
706 `(,symbol .
707 ,(intern (substring (symbol-name symbol)
708 (length "char")))))
709 functions)))
710 `(progn
711 (mapc
712 (function*
713 (lambda ((function . cl-unsafe-comparison))
714 (put function 'cl-unsafe-comparison cl-unsafe-comparison)
715 (put function 'cl-compiler-macro
716 #'(lambda (form &rest arguments)
717 (if byte-compile-delete-errors
718 (cons (get (car form) 'cl-unsafe-comparison)
719 (cdr form))
720 form)))))
721 ',map)
722 ,@(mapcar
723 (function*
724 (lambda ((function . documentation))
725 `(defun ,function (character &rest more-characters)
726 ,documentation
727 (check-type character character)
728 (check-type more-characters
729 (satisfies (lambda (list)
730 (every 'characterp list))))
731 (apply ',(cdr (assq function map))
732 character more-characters))))
733 alist)))))
734 (define-char-comparisons
735 (char= . "Return t if all character arguments are the same object.")
736 (char/= . "Return t if no two character arguments are the same object.")
737 (char< . "Return t if the character arguments monotonically increase.")
738 (char> . "Return t if the character arguments monotonically decrease.")
739 (char<= . "Return t if the character arguments are monotonically \
740 nondecreasing.")
741 (char>= . "Return t if the character arguments are monotonically \
742 nonincreasing.")))
743
698 (defun* digit-char-p (character &optional (radix 10)) 744 (defun* digit-char-p (character &optional (radix 10))
699 "Return non-nil if CHARACTER represents a digit in base RADIX. 745 "Return non-nil if CHARACTER represents a digit in base RADIX.
700 746
701 RADIX defaults to ten. The actual non-nil value returned is the integer 747 RADIX defaults to ten. The actual non-nil value returned is the integer
702 value of the character in base RADIX." 748 value of the character in base RADIX."