Mercurial > hg > xemacs-beta

comparison lisp/cl.el @ 412:697ef44129c6 r21-2-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-14
author cvs
date Mon, 13 Aug 2007 11:20:41 +0200
parents de805c49cfc1
children 11054d720c21
comparison
equal deleted inserted replaced
411:12e008d41344 412:697ef44129c6
315 (while (>= (decf i) 0) (setq v (+ (* v 3) (aref time i)))) 315 (while (>= (decf i) 0) (setq v (+ (* v 3) (aref time i))))
316 v)) 316 v))
317 317
318 (defvar *gensym-counter* (* (logand (cl-random-time) 1023) 100)) 318 (defvar *gensym-counter* (* (logand (cl-random-time) 1023) 100))
319 319
320 (defun gensym (&optional arg)
321 "Generate a new uninterned symbol.
322 The name is made by appending a number to PREFIX, default \"G\"."
323 (let ((prefix (if (stringp arg) arg "G"))
324 (num (if (integerp arg) arg
325 (prog1 *gensym-counter*
326 (setq *gensym-counter* (1+ *gensym-counter*))))))
327 (make-symbol (format "%s%d" prefix num))))
328
329 (defun gentemp (&optional arg)
330 "Generate a new interned symbol with a unique name.
331 The name is made by appending a number to PREFIX, default \"G\"."
332 (let ((prefix (if (stringp arg) arg "G"))
333 name)
334 (while (intern-soft (setq name (format "%s%d" prefix *gensym-counter*)))
335 (setq *gensym-counter* (1+ *gensym-counter*)))
336 (intern name)))
337 320
338 ;;; Numbers. 321 ;;; Numbers.
339 322
340 (defun floatp-safe (x) 323 (defun floatp-safe (x)
341 "Return t if OBJECT is a floating point number. 324 "Return t if OBJECT is a floating point number.
695 678
696 ;; XEmacs change 679 ;; XEmacs change
697 ;(load "cl-defs") 680 ;(load "cl-defs")
698 681
699 ;;; Define data for indentation and edebug. 682 ;;; Define data for indentation and edebug.
700 (mapcar 683 (mapc
701 #'(lambda (entry) 684 #'(lambda (entry)
702 (mapcar 685 (mapc
703 #'(lambda (func) 686 #'(lambda (func)
704 (put func 'lisp-indent-function (nth 1 entry)) 687 (put func 'lisp-indent-function (nth 1 entry))
705 (put func 'lisp-indent-hook (nth 1 entry)) 688 (put func 'lisp-indent-hook (nth 1 entry))
706 (or (get func 'edebug-form-spec) 689 (or (get func 'edebug-form-spec)
707 (put func 'edebug-form-spec (nth 2 entry)))) 690 (put func 'edebug-form-spec (nth 2 entry))))
748 731
749 (defvar cl-hacked-flag nil) 732 (defvar cl-hacked-flag nil)
750 (defun cl-hack-byte-compiler () 733 (defun cl-hack-byte-compiler ()
751 (if (and (not cl-hacked-flag) (fboundp 'byte-compile-file-form)) 734 (if (and (not cl-hacked-flag) (fboundp 'byte-compile-file-form))
752 (progn 735 (progn
753 (when (not (fboundp 'cl-compile-time-init))
754 (load "cl-macs" nil t))
755 (cl-compile-time-init) ; in cl-macs.el 736 (cl-compile-time-init) ; in cl-macs.el
756 (setq cl-hacked-flag t)))) 737 (setq cl-hacked-flag t))))
757 738
758 ;;; Try it now in case the compiler has already been loaded. 739 ;;; Try it now in case the compiler has already been loaded.
759 (cl-hack-byte-compiler) 740 (cl-hack-byte-compiler)