(read-color, x-defined-colors, event-object, get-popup-menu-response,

toolbar-gnus, get-charset-property, find-coding-system, coding-system-get,
font-lock-set-defaults): Don't bind.
(union, member-if, mapcon, mapc, last): Don't define as compiler macros under
XEmacs.
(member-if): New compiler macro for emulating cl function.

diff --git a/lisp/dgnushack.el b/lisp/dgnushack.el
index e4cf885..2b21985 100644 (file)
--- a/lisp/dgnushack.el
+++ b/lisp/dgnushack.el
@@ -50,86 +50,99 @@
 
 (require 'cl)
 
-;; cl functions.
-(define-compiler-macro mapc (&whole form fn seq &rest rest)
-  (if (and (fboundp 'mapc)
-          (subrp (symbol-function 'mapc)))
-      form
-    (if rest
-       `(let* ((fn ,fn)
-               (seq ,seq)
-               (args (list seq ,@rest))
-               (m (apply (function min) (mapcar (function length) args)))
-               (n 0))
-          (while (< n m)
-            (apply fn (mapcar (function (lambda (arg) (nth n arg))) args))
-            (setq n (1+ n)))
-          seq)
-      `(let ((seq ,seq))
-        (mapcar ,fn seq)
-        seq))))
-
-(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
+;; Emulating cl functions.
+(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 mapc (&whole form fn seq &rest rest)
+    (if (and (fboundp 'mapc)
+            (subrp (symbol-function 'mapc)))
+       form
+      (if rest
+         `(let* ((fn ,fn)
+                 (seq ,seq)
+                 (args (list seq ,@rest))
+                 (m (apply (function min) (mapcar (function length) args)))
+                 (n 0))
+            (while (< n m)
+              (apply fn (mapcar (function (lambda (arg) (nth n arg))) args))
+              (setq n (1+ n)))
+            seq)
+       `(let ((seq ,seq))
+          (mapcar ,fn seq)
+          seq))))
+
+  (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
-              (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 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)))))
+              (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
@@ -241,16 +254,8 @@
 ;; Unknown variables and functions.
 (unless (boundp 'buffer-file-coding-system)
   (defvar buffer-file-coding-system (symbol-value 'file-coding-system)))
-(autoload 'font-lock-set-defaults "font-lock")
-(unless (fboundp 'coding-system-get)
-  (defalias 'coding-system-get 'ignore))
-(when (boundp 'MULE)
-  (defalias 'find-coding-system 'ignore))
-(unless (fboundp 'get-charset-property)
-  (defalias 'get-charset-property 'ignore))
 (unless (featurep 'xemacs)
   (defalias 'Custom-make-dependencies 'ignore)
-  (defalias 'toolbar-gnus 'ignore)
   (defalias 'update-autoloads-from-directory 'ignore))
 (autoload 'texinfo-parse-line-arg "texinfmt")
 
@@ -265,13 +270,6 @@
 (defalias 'ange-ftp-re-read-dir 'ignore)
 (defalias 'define-mail-user-agent 'ignore)
 
-(eval-and-compile
-  (unless (string-match "XEmacs" emacs-version)
-    (fset 'get-popup-menu-response 'ignore)
-    (fset 'event-object 'ignore)
-    (fset 'x-defined-colors 'ignore)
-    (fset 'read-color 'ignore)))
-
 (defun dgnushack-compile (&optional warn)
   ;;(setq byte-compile-dynamic t)
   (unless warn