[Emacs-diffs] Changes to emacs/lisp/emacs-lisp/cl-extra.el

[Juanma Barranquero]

Index: emacs/lisp/emacs-lisp/cl-extra.el
diff -c emacs/lisp/emacs-lisp/cl-extra.el:1.27 
emacs/lisp/emacs-lisp/cl-extra.el:1.28
*** emacs/lisp/emacs-lisp/cl-extra.el:1.27      Mon May 16 15:32:09 2005
--- emacs/lisp/emacs-lisp/cl-extra.el   Sun May 22 17:48:02 2005
***************
*** 46,52 ****
  
  (defun coerce (x type)
    "Coerce OBJECT to type TYPE.
! TYPE is a Common Lisp type specifier."
    (cond ((eq type 'list) (if (listp x) x (append x nil)))
        ((eq type 'vector) (if (vectorp x) x (vconcat x)))
        ((eq type 'string) (if (stringp x) x (concat x)))
--- 46,53 ----
  
  (defun coerce (x type)
    "Coerce OBJECT to type TYPE.
! TYPE is a Common Lisp type specifier.
! \n(fn OBJECT TYPE)"
    (cond ((eq type 'list) (if (listp x) x (append x nil)))
        ((eq type 'vector) (if (vectorp x) x (vconcat x)))
        ((eq type 'string) (if (stringp x) x (concat x)))
***************
*** 120,135 ****
        (nreverse cl-res))))
  
  (defun map (cl-type cl-func cl-seq &rest cl-rest)
!   "Map a function across one or more sequences, returning a sequence.
! TYPE is the sequence type to return, FUNC is the function, and SEQS
! are the argument sequences."
    (let ((cl-res (apply 'mapcar* cl-func cl-seq cl-rest)))
      (and cl-type (coerce cl-res cl-type))))
  
  (defun maplist (cl-func cl-list &rest cl-rest)
!   "Map FUNC to each sublist of LIST or LISTS.
  Like `mapcar', except applies to lists and their cdr's rather than to
! the elements themselves."
    (if cl-rest
        (let ((cl-res nil)
            (cl-args (cons cl-list (copy-sequence cl-rest)))
--- 121,137 ----
        (nreverse cl-res))))
  
  (defun map (cl-type cl-func cl-seq &rest cl-rest)
!   "Map a FUNCTION across one or more SEQUENCEs, returning a sequence.
! TYPE is the sequence type to return.
! \n(fn TYPE FUNCTION SEQUENCE...)"
    (let ((cl-res (apply 'mapcar* cl-func cl-seq cl-rest)))
      (and cl-type (coerce cl-res cl-type))))
  
  (defun maplist (cl-func cl-list &rest cl-rest)
!   "Map FUNCTION to each sublist of LIST or LISTs.
  Like `mapcar', except applies to lists and their cdr's rather than to
! the elements themselves.
! \n(fn FUNCTION LIST...)"
    (if cl-rest
        (let ((cl-res nil)
            (cl-args (cons cl-list (copy-sequence cl-rest)))
***************
*** 146,159 ****
        (nreverse cl-res))))
  
  (defun cl-mapc (cl-func cl-seq &rest cl-rest)
!   "Like `mapcar', but does not accumulate values returned by the function."
    (if cl-rest
        (progn (apply 'map nil cl-func cl-seq cl-rest)
             cl-seq)
      (mapc cl-func cl-seq)))
  
  (defun mapl (cl-func cl-list &rest cl-rest)
!   "Like `maplist', but does not accumulate values returned by the function."
    (if cl-rest
        (apply 'maplist cl-func cl-list cl-rest)
      (let ((cl-p cl-list))
--- 148,163 ----
        (nreverse cl-res))))
  
  (defun cl-mapc (cl-func cl-seq &rest cl-rest)
!   "Like `mapcar', but does not accumulate values returned by the function.
! \n(fn FUNCTION SEQUENCE...)"
    (if cl-rest
        (progn (apply 'map nil cl-func cl-seq cl-rest)
             cl-seq)
      (mapc cl-func cl-seq)))
  
  (defun mapl (cl-func cl-list &rest cl-rest)
!   "Like `maplist', but does not accumulate values returned by the function.
! \n(fn FUNCTION LIST...)"
    (if cl-rest
        (apply 'maplist cl-func cl-list cl-rest)
      (let ((cl-p cl-list))
***************
*** 161,176 ****
    cl-list)
  
  (defun mapcan (cl-func cl-seq &rest cl-rest)
!   "Like `mapcar', but nconc's together the values returned by the function."
    (apply 'nconc (apply 'mapcar* cl-func cl-seq cl-rest)))
  
  (defun mapcon (cl-func cl-list &rest cl-rest)
!   "Like `maplist', but nconc's together the values returned by the function."
    (apply 'nconc (apply 'maplist cl-func cl-list cl-rest)))
  
  (defun some (cl-pred cl-seq &rest cl-rest)
    "Return true if PREDICATE is true of any element of SEQ or SEQs.
! If so, return the true (non-nil) value returned by PREDICATE."
    (if (or cl-rest (nlistp cl-seq))
        (catch 'cl-some
        (apply 'map nil
--- 165,183 ----
    cl-list)
  
  (defun mapcan (cl-func cl-seq &rest cl-rest)
!   "Like `mapcar', but nconc's together the values returned by the function.
! \n(fn FUNCTION SEQUENCE...)"
    (apply 'nconc (apply 'mapcar* cl-func cl-seq cl-rest)))
  
  (defun mapcon (cl-func cl-list &rest cl-rest)
!   "Like `maplist', but nconc's together the values returned by the function.
! \n(fn FUNCTION LIST...)"
    (apply 'nconc (apply 'maplist cl-func cl-list cl-rest)))
  
  (defun some (cl-pred cl-seq &rest cl-rest)
    "Return true if PREDICATE is true of any element of SEQ or SEQs.
! If so, return the true (non-nil) value returned by PREDICATE.
! \n(fn PREDICATE SEQ...)"
    (if (or cl-rest (nlistp cl-seq))
        (catch 'cl-some
        (apply 'map nil
***************
*** 183,189 ****
        cl-x)))
  
  (defun every (cl-pred cl-seq &rest cl-rest)
!   "Return true if PREDICATE is true of every element of SEQ or SEQs."
    (if (or cl-rest (nlistp cl-seq))
        (catch 'cl-every
        (apply 'map nil
--- 190,197 ----
        cl-x)))
  
  (defun every (cl-pred cl-seq &rest cl-rest)
!   "Return true if PREDICATE is true of every element of SEQ or SEQs.
! \n(fn PREDICATE SEQ...)"
    (if (or cl-rest (nlistp cl-seq))
        (catch 'cl-every
        (apply 'map nil
***************
*** 195,205 ****
      (null cl-seq)))
  
  (defun notany (cl-pred cl-seq &rest cl-rest)
!   "Return true if PREDICATE is false of every element of SEQ or SEQs."
    (not (apply 'some cl-pred cl-seq cl-rest)))
  
  (defun notevery (cl-pred cl-seq &rest cl-rest)
!   "Return true if PREDICATE is false of some element of SEQ or SEQs."
    (not (apply 'every cl-pred cl-seq cl-rest)))
  
  ;;; Support for `loop'.
--- 203,215 ----
      (null cl-seq)))
  
  (defun notany (cl-pred cl-seq &rest cl-rest)
!   "Return true if PREDICATE is false of every element of SEQ or SEQs.
! \n(fn PREDICATE SEQ...)"
    (not (apply 'some cl-pred cl-seq cl-rest)))
  
  (defun notevery (cl-pred cl-seq &rest cl-rest)
!   "Return true if PREDICATE is false of some element of SEQ or SEQs.
! \n(fn PREDICATE SEQ...)"
    (not (apply 'every cl-pred cl-seq cl-rest)))
  
  ;;; Support for `loop'.
***************
*** 332,347 ****
          (setq a (* (/ a (gcd a b)) b))))
        a)))
  
! (defun isqrt (a)
    "Return the integer square root of the argument."
!   (if (and (integerp a) (> a 0))
!       (let ((g (cond ((<= a 100) 10) ((<= a 10000) 100)
!                    ((<= a 1000000) 1000) (t a)))
            g2)
!       (while (< (setq g2 (/ (+ g (/ a g)) 2)) g)
          (setq g g2))
        g)
!     (if (eq a 0) 0 (signal 'arith-error nil))))
  
  (defun floor* (x &optional y)
    "Return a list of the floor of X and the fractional part of X.
--- 342,357 ----
          (setq a (* (/ a (gcd a b)) b))))
        a)))
  
! (defun isqrt (x)
    "Return the integer square root of the argument."
!   (if (and (integerp x) (> x 0))
!       (let ((g (cond ((<= x 100) 10) ((<= x 10000) 100)
!                    ((<= x 1000000) 1000) (t x)))
            g2)
!       (while (< (setq g2 (/ (+ g (/ x g)) 2)) g)
          (setq g g2))
        g)
!     (if (eq x 0) 0 (signal 'arith-error nil))))
  
  (defun floor* (x &optional y)
    "Return a list of the floor of X and the fractional part of X.
***************
*** 388,396 ****
    "The remainder of X divided by Y, with the same sign as X."
    (nth 1 (truncate* x y)))
  
! (defun signum (a)
!   "Return 1 if A is positive, -1 if negative, 0 if zero."
!   (cond ((> a 0) 1) ((< a 0) -1) (t 0)))
  
  
  ;; Random numbers.
--- 398,406 ----
    "The remainder of X divided by Y, with the same sign as X."
    (nth 1 (truncate* x y)))
  
! (defun signum (x)
!   "Return 1 if X is positive, -1 if negative, 0 if zero."
!   (cond ((> x 0) 1) ((< x 0) -1) (t 0)))
  
  
  ;; Random numbers.
***************
*** 514,520 ****
               res))))))
  
  (defun concatenate (type &rest seqs)
!   "Concatenate, into a sequence of type TYPE, the argument SEQUENCES."
    (cond ((eq type 'vector) (apply 'vconcat seqs))
        ((eq type 'string) (apply 'concat seqs))
        ((eq type 'list) (apply 'append (append seqs '(nil))))
--- 524,531 ----
               res))))))
  
  (defun concatenate (type &rest seqs)
!   "Concatenate, into a sequence of type TYPE, the argument SEQUENCEs.
! \n(fn TYPE SEQUENCE...)"
    (cond ((eq type 'vector) (apply 'vconcat seqs))
        ((eq type 'string) (apply 'concat seqs))
        ((eq type 'list) (apply 'append (append seqs '(nil))))
***************
*** 532,538 ****
    (nconc (nreverse x) y))
  
  (defun list-length (x)
!   "Return the length of a list.  Return nil if list is circular."
    (let ((n 0) (fast x) (slow x))
      (while (and (cdr fast) (not (and (eq fast slow) (> n 0))))
        (setq n (+ n 2) fast (cdr (cdr fast)) slow (cdr slow)))
--- 543,549 ----
    (nconc (nreverse x) y))
  
  (defun list-length (x)
!   "Return the length of list X.  Return nil if list is circular."
    (let ((n 0) (fast x) (slow x))
      (while (and (cdr fast) (not (and (eq fast slow) (> n 0))))
        (setq n (+ n 2) fast (cdr (cdr fast)) slow (cdr slow)))
***************
*** 550,556 ****
  ;;; Property lists.
  
  (defun get* (sym tag &optional def)    ; See compiler macro in cl-macs.el
!   "Return the value of SYMBOL's PROPNAME property, or DEFAULT if none."
    (or (get sym tag)
        (and def
           (let ((plist (symbol-plist sym)))
--- 561,568 ----
  ;;; Property lists.
  
  (defun get* (sym tag &optional def)    ; See compiler macro in cl-macs.el
!   "Return the value of SYMBOL's PROPNAME property, or DEFAULT if none.
! \n(fn SYMBOL PROPNAME &optional DEFAULT)"
    (or (get sym tag)
        (and def
           (let ((plist (symbol-plist sym)))
***************
*** 560,566 ****
  
  (defun getf (plist tag &optional def)
    "Search PROPLIST for property PROPNAME; return its value or DEFAULT.
! PROPLIST is a list of the sort returned by `symbol-plist'."
    (setplist '--cl-getf-symbol-- plist)
    (or (get '--cl-getf-symbol-- tag)
        ;; Originally we called get* here,
--- 572,579 ----
  
  (defun getf (plist tag &optional def)
    "Search PROPLIST for property PROPNAME; return its value or DEFAULT.
! PROPLIST is a list of the sort returned by `symbol-plist'.
! \n(fn PROPLIST PROPNAME &optional DEFAULT)"
    (setplist '--cl-getf-symbol-- plist)
    (or (get '--cl-getf-symbol-- tag)
        ;; Originally we called get* here,
***************
*** 582,588 ****
      (and (cdr p) (progn (setcdr p (cdr (cdr (cdr p)))) t))))
  
  (defun cl-remprop (sym tag)
!   "Remove from SYMBOL's plist the property PROP and its value."
    (let ((plist (symbol-plist sym)))
      (if (and plist (eq tag (car plist)))
        (progn (setplist sym (cdr (cdr plist))) t)
--- 595,602 ----
      (and (cdr p) (progn (setcdr p (cdr (cdr (cdr p)))) t))))
  
  (defun cl-remprop (sym tag)
!   "Remove from SYMBOL's plist the property PROPNAME and its value.
! \n(fn SYMBOL PROPNAME)"
    (let ((plist (symbol-plist sym)))
      (if (and plist (eq tag (car plist)))
        (progn (setplist sym (cdr (cdr plist))) t)