X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fdgnushack.el;h=496935d5933316da1b993bd1ee680c20cf47b3f3;hb=3c6a96d019e0fcdf0d35f9d4873f62c1962995ad;hp=94ef2919103f0238c77ef0dd9a8c252b7349ead5;hpb=6dff341e8accb81bf4174cdacb5354301c80249f;p=elisp%2Fgnus.git-

diff --git a/lisp/dgnushack.el b/lisp/dgnushack.el
index 94ef291..496935d 100644
--- a/lisp/dgnushack.el
+++ b/lisp/dgnushack.el
@@ -1,5 +1,6 @@
 ;;; dgnushack.el --- a hack to set the load path for byte-compiling
-;; Copyright (C) 1994,95,96,97,98,99 Free Software Foundation, Inc.
+;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000
+;;        Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;;	Katsumi Yamaoka <yamaoka@jpl.org>
@@ -50,6 +51,83 @@
 
 (require 'cl)
 
+(push "/usr/share/emacs/site-lisp" load-path)
+
+(unless (featurep 'xemacs)
+  (define-compiler-macro last (&whole form x &optional n)
+    (if (and (fboundp 'last)
+	     (subrp (symbol-function 'last)))
+	form
+      (if n
+	  `(let* ((x ,x)
+		  (n ,n)
+		  (m 0)
+		  (p x))
+	     (while (consp p)
+	       (incf m)
+	       (pop p))
+	     (if (<= n 0)
+		 p
+	       (if (< n m)
+		   (nthcdr (- m n) x)
+		 x)))
+	`(let ((x ,x))
+	   (while (consp (cdr x))
+	     (pop x))
+	   x))))
+
+  (define-compiler-macro mapcon (&whole form fn seq &rest rest)
+    (if (and (fboundp 'mapcon)
+	     (subrp (symbol-function 'mapcon)))
+	form
+      (if rest
+	  `(let (res
+		 (args (list ,seq ,@rest))
+		 p)
+	     (while (not (memq nil args))
+	       (push (apply ,fn args) res)
+	       (setq p args)
+	       (while p
+		 (setcar p (cdr (pop p)))
+		 ))
+	     (apply (function nconc) (nreverse res)))
+	`(let (res
+	       (arg ,seq))
+	   (while arg
+	     (push (funcall ,fn arg) res)
+	     (setq arg (cdr arg)))
+	   (apply (function nconc) (nreverse res))))))
+
+  (define-compiler-macro member-if (&whole form pred list)
+    (if (and (fboundp 'member-if)
+	     (subrp (symbol-function 'member-if)))
+	form
+      `(let ((fn ,pred)
+	     (seq ,list))
+	 (while (and seq
+		     (not (funcall fn (car seq))))
+	   (pop seq))
+	 seq)))
+
+  (define-compiler-macro union (&whole form list1 list2)
+    (if (and (fboundp 'union)
+	     (subrp (symbol-function 'union)))
+	form
+      `(let ((a ,list1)
+	     (b ,list2))
+	 (cond ((null a) b)
+	       ((null b) a)
+	       ((equal a b) a)
+	       (t
+		(or (>= (length a) (length b))
+		    (setq a (prog1 b (setq b a))))
+		(while b
+		  (or (memq (car b) a)
+		      (push (car b) a))
+		  (pop b))
+		a)))))
+  )
+
 ;; If we are building w3 in a different directory than the source
 ;; directory, we must read *.el from source directory and write *.elc
 ;; into the building directory.  For that, we define this function