;;; gnus-clfns.el --- compiler macros for emulating cl functions
-;; Copyright (C) 2000, 2001 Free Software Foundation, Inc.
+
+;; Copyright (C) 2000, 2001, 2002 Free Software Foundation, Inc.
;; Author: Kastsumi Yamaoka <yamaoka@jpl.org>
;; Keywords: cl, compile
(or n (setq n 1))
(and (< n m)
(progn
- (if (> n 0) (setcdr (nthcdr (- (1- m) n) x) nil))
+ (if (> n 0)
+ (progn
+ (setq x (copy-sequence x))
+ (setcdr (nthcdr (- (1- m) n) x) nil)))
x)))))
`(let* ((x ,x)
(m (length x)))
(and (< 1 m)
(progn
+ (setq x (copy-sequence x))
(setcdr (nthcdr (- m 2) x) nil)
x))))))
((typep x type) x)
(t (error "Can't coerce %s to type %s" x type))))))
+ (define-compiler-macro copy-list (&whole form list)
+ (if (and (fboundp 'copy-list)
+ (subrp (symbol-function 'copy-list)))
+ form
+ `(let ((list ,list))
+ (if (consp list)
+ (let ((res nil))
+ (while (consp list) (push (pop list) res))
+ (prog1 (nreverse res) (setcdr res list)))
+ (car list)))))
+
(define-compiler-macro last (&whole form x &optional n)
(if (and (fboundp 'last)
(subrp (symbol-function 'last)))
"Concatenate all the argument characters and make the result a string."
(concat args))
+ (define-compiler-macro string-to-list (&whole form string)
+ (cond ((fboundp 'string-to-list)
+ form)
+ ((fboundp 'string-to-char-list)
+ (list 'string-to-char-list string))
+ (t
+ `(let* ((str ,string)
+ (len (length str))
+ (idx 0)
+ c l)
+ (while (< idx len)
+ (setq c (sref str idx))
+ (setq idx (+ idx (char-bytes c)))
+ (setq l (cons c l)))
+ (nreverse l)))))
+
+ ;; 92.7.2 by K.Handa (imported from Mule 2.3)
+ (defun-maybe string-to-list (str)
+ (let ((len (length str))
+ (idx 0)
+ c l)
+ (while (< idx len)
+ (setq c (sref str idx))
+ (setq idx (+ idx (char-bytes c)))
+ (setq l (cons c l)))
+ (nreverse l)))
+
(define-compiler-macro subseq (&whole form seq start &optional end)
(if (and (fboundp 'subseq)
(subrp (symbol-function 'subseq)))
((and (memq fn clfns)
(listp form))
(push fn fns)))
- (setq forms (append form forms))))
+ (when (listp form)
+ (setq forms (append form forms)))))
(when fns
(if buffer
(set-buffer buffer)
(progn
(insert fill-prefix
(mapconcat (lambda (fn) (format "%s" fn))
- (nreverse fns) " "))
+ (nreverse fns) " ")
+ "\n")
(point)))
(fill-region (point-min) (point-max))
(goto-char (point-min))