Mercurial > hg > xemacs-beta

comparison lisp/cl.el @ 272:c5d627a313b1 r21-0b34

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-0b34
author cvs
date Mon, 13 Aug 2007 10:28:48 +0200
parents 0e522484dd2a
children 558f606b08ae
comparison
equal deleted inserted replaced
271:c7b7086b0a39 272:c5d627a313b1
147 147
148 148
149 ;;; Predicates. 149 ;;; Predicates.
150 150
151 (defun eql (a b) ; See compiler macro in cl-macs.el 151 (defun eql (a b) ; See compiler macro in cl-macs.el
152 "T if the two args are the same Lisp object. 152 "Return t if the two args are the same Lisp object.
153 Floating-point numbers of equal value are `eql', but they may not be `eq'." 153 Floating-point numbers of equal value are `eql', but they may not be `eq'."
154 (if (floatp a) 154 (if (floatp a)
155 (equal a b) 155 (equal a b)
156 (eq a b))) 156 (eq a b)))
157 157
330 330
331 331
332 ;;; Numbers. 332 ;;; Numbers.
333 333
334 (defun floatp-safe (x) 334 (defun floatp-safe (x)
335 "T if OBJECT is a floating point number. 335 "Return t if OBJECT is a floating point number.
336 On Emacs versions that lack floating-point support, this function 336 On Emacs versions that lack floating-point support, this function
337 always returns nil." 337 always returns nil."
338 ;;(and (numberp x) (not (integerp x))) 338 ;;(and (numberp x) (not (integerp x)))
339 ;; XEmacs: use floatp. XEmacs is always compiled with 339 ;; XEmacs: use floatp. XEmacs is always compiled with
340 ;; floating-point, anyway. 340 ;; floating-point, anyway.
341 (floatp x)) 341 (floatp x))
342 342
343 (defun plusp (x) 343 (defun plusp (x)
344 "T if NUMBER is positive." 344 "Return t if NUMBER is positive."
345 (> x 0)) 345 (> x 0))
346 346
347 (defun minusp (x) 347 (defun minusp (x)
348 "T if NUMBER is negative." 348 "Return t if NUMBER is negative."
349 (< x 0)) 349 (< x 0))
350 350
351 (defun oddp (x) 351 (defun oddp (x)
352 "T if INTEGER is odd." 352 "Return t if INTEGER is odd."
353 (eq (logand x 1) 1)) 353 (eq (logand x 1) 1))
354 354
355 (defun evenp (x) 355 (defun evenp (x)
356 "T if INTEGER is even." 356 "Return t if INTEGER is even."
357 (eq (logand x 1) 0)) 357 (eq (logand x 1) 0))
358 358
359 (defun cl-abs (x) 359 (defun cl-abs (x)
360 "Return the absolute value of ARG." 360 "Return the absolute value of ARG."
361 (if (>= x 0) x (- x))) 361 (if (>= x 0) x (- x)))
551 (defun cddddr (x) 551 (defun cddddr (x)
552 "Return the `cdr' of the `cdr' of the `cdr' of the `cdr' of X." 552 "Return the `cdr' of the `cdr' of the `cdr' of the `cdr' of X."
553 (cdr (cdr (cdr (cdr x))))) 553 (cdr (cdr (cdr (cdr x)))))
554 554
555 (defun last (x &optional n) 555 (defun last (x &optional n)
556 "Returns the last link in the list LIST. 556 "Return the last link in the list LIST.
557 With optional argument N, returns Nth-to-last link (default 1)." 557 With optional argument N, return Nth-to-last link (default 1)."
558 (if n 558 (if n
559 (let ((m 0) (p x)) 559 (let ((m 0) (p x))
560 (while (consp p) (incf m) (pop p)) 560 (while (consp p) (incf m) (pop p))
561 (if (<= n 0) p 561 (if (<= n 0) p
562 (if (< n m) (nthcdr (- m n) x) x))) 562 (if (< n m) (nthcdr (- m n) x) x)))
563 (while (consp (cdr x)) (pop x)) 563 (while (consp (cdr x)) (pop x))
564 x)) 564 x))
565 565
566 (defun butlast (x &optional n) 566 (defun butlast (x &optional n)
567 "Returns a copy of LIST with the last N elements removed." 567 "Return a copy of LIST with the last N elements removed."
568 (if (and n (<= n 0)) x 568 (if (and n (<= n 0)) x
569 (nbutlast (copy-sequence x) n))) 569 (nbutlast (copy-sequence x) n)))
570 570
571 (defun nbutlast (x &optional n) 571 (defun nbutlast (x &optional n)
572 "Modifies LIST to remove the last N elements." 572 "Modify LIST to remove the last N elements."
573 (let ((m (length x))) 573 (let ((m (length x)))
574 (or n (setq n 1)) 574 (or n (setq n 1))
575 (and (< n m) 575 (and (< n m)
576 (progn 576 (progn
577 (if (> n 0) (setcdr (nthcdr (- (1- m) n) x) nil)) 577 (if (> n 0) (setcdr (nthcdr (- (1- m) n) x) nil))
646 (d (cl-do-subst cl-new cl-old (cdr cl-tree)))) 646 (d (cl-do-subst cl-new cl-old (cdr cl-tree))))
647 (if (and (eq a (car cl-tree)) (eq d (cdr cl-tree))) 647 (if (and (eq a (car cl-tree)) (eq d (cdr cl-tree)))
648 cl-tree (cons a d)))) 648 cl-tree (cons a d))))
649 (t cl-tree))) 649 (t cl-tree)))
650 650
651 (defun acons (a b c) (cons (cons a b) c)) 651 (defun acons (a b c)
652 "Return a new alist created by adding (KEY . VALUE) to ALIST."
653 (cons (cons a b) c))
654
652 (defun pairlis (a b &optional c) (nconc (mapcar* 'cons a b) c)) 655 (defun pairlis (a b &optional c) (nconc (mapcar* 'cons a b) c))
653 656
654 657
655 ;;; Miscellaneous. 658 ;;; Miscellaneous.
656 659