X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fdgnushack.el;h=83c0f205292ce45dd87db28972092a96b17c54ee;hb=609e9daf5a06f5d39ca20cc6718f72a414866870;hp=dc88a22eef56f9b5a5efa4b7b26297b3de22f22e;hpb=a990f55e8049f875e0a878f162db81e65ac2c84e;p=gnus

diff --git a/lisp/dgnushack.el b/lisp/dgnushack.el
index dc88a22ee..83c0f2052 100644
--- a/lisp/dgnushack.el
+++ b/lisp/dgnushack.el
@@ -48,38 +48,6 @@
 
 ;(push "/usr/share/emacs/site-lisp" load-path)
 
-;; Define compiler macros for the functions provided by cl in old Emacsen.
-(unless (featurep 'xemacs)
-  (define-compiler-macro butlast (&whole form x &optional n)
-    (if (>= emacs-major-version 21)
-	form
-      (if n
-	  `(let ((x ,x)
-		 (n ,n))
-	     (if (and n (<= n 0))
-		 x
-	       (let ((m (length x)))
-		 (or n (setq n 1))
-		 (and (< n m)
-		      (progn
-			(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))))))
-
-  (define-compiler-macro remove (&whole form item seq)
-    (if (>= emacs-major-version 21)
-	form
-      `(delete ,item (copy-sequence ,seq)))))
-
 ;; 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
@@ -108,6 +76,66 @@
 ;  (cons 'progn (cdr form)))
 ;(defalias 'byte-compile-file-form-defsubst 'byte-compile-file-form-defun)
 
+(when (and (not (featurep 'xemacs))
+	   (= emacs-major-version 21)
+	   (= emacs-minor-version 3)
+	   (condition-case code
+	       (let ((byte-compile-error-on-warn t))
+		 (byte-optimize-form (quote (pop x)) t)
+		 nil)
+	     (error (string-match "called for effect"
+				  (error-message-string code)))))
+  (defadvice byte-optimize-form-code-walker (around silence-warn-for-pop
+						    (form for-effect)
+						    activate)
+    "Silence the warning \"...called for effect\" for the `pop' form.
+It is effective only when the `pop' macro is defined by cl.el rather
+than subr.el."
+    (let (tmp)
+      (if (and (eq (car-safe form) 'car)
+	       for-effect
+	       (setq tmp (get 'car 'side-effect-free))
+	       (not byte-compile-delete-errors)
+	       (not (eq tmp 'error-free))
+	       (eq (car-safe (cadr form)) 'prog1)
+	       (let ((var (cadr (cadr form)))
+		     (last (nth 2 (cadr form))))
+		 (and (symbolp var)
+		      (null (nthcdr 3 (cadr form)))
+		      (eq (car-safe last) 'setq)
+		      (eq (cadr last) var)
+		      (eq (car-safe (nth 2 last)) 'cdr)
+		      (eq (cadr (nth 2 last)) var))))
+	  (progn
+	    (put 'car 'side-effect-free 'error-free)
+	    (unwind-protect
+		ad-do-it
+	      (put 'car 'side-effect-free tmp)))
+	ad-do-it))))
+
+(when (and (not (featurep 'xemacs))
+	   (byte-optimize-form '(and (> 0 1) foo) t))
+  (defadvice byte-optimize-form-code-walker
+    (around fix-bug-in-and/or-forms (form for-effect) activate)
+    "Optimize the rest of the and/or forms.
+It has been fixed in XEmacs before releasing 21.4 and also has been
+fixed in Emacs after 21.3."
+    (if (and for-effect (memq (car-safe form) '(and or)))
+	(let ((fn (car form))
+	      (backwards (reverse (cdr form))))
+	  (while (and backwards
+		      (null (setcar backwards
+				    (byte-optimize-form (car backwards) t))))
+	    (setq backwards (cdr backwards)))
+	  (if (and (cdr form) (null backwards))
+	      (byte-compile-log
+	       "  all subforms of %s called for effect; deleted" form))
+	  (when backwards
+	    (setcdr backwards
+		    (mapcar 'byte-optimize-form (cdr backwards))))
+	  (setq ad-return-value (cons fn (nreverse backwards))))
+      ad-do-it)))
+
 (push srcdir load-path)
 (load (expand-file-name "lpath.el" srcdir) nil t)
 
@@ -127,11 +155,6 @@
 
 (eval-and-compile
   (when (featurep 'xemacs)
-    ;; XEmacs 21.1 needs some extra hand holding
-    (when (eq emacs-minor-version 1)
-      (autoload 'custom-declare-face "cus-face" nil t)
-      (autoload 'cl-compile-time-init "cl-macs" nil t)
-      (autoload 'defadvice "advice" nil nil 'macro))
     (unless (fboundp 'defadvice)
       (autoload 'defadvice "advice" nil nil 'macro))
     (autoload 'Info-directory "info" nil t)
@@ -147,6 +170,8 @@
     (autoload 'delete-annotation "annotations")
     (autoload 'dolist "cl-macs" nil nil 'macro)
     (autoload 'enriched-decode "enriched")
+    (autoload 'executable-find "executable")
+    (autoload 'font-lock-fontify-buffer "font-lock" nil t)
     (autoload 'info "info" nil t)
     (autoload 'make-annotation "annotations")
     (autoload 'make-display-table "disp-table")
@@ -193,14 +218,6 @@ dgnushack-compile."
   (unless warn
     (setq byte-compile-warnings
 	  '(free-vars unresolved callargs redefine)))
-  (unless (locate-library "cus-edit")
-    (error "You do not seem to have Custom installed.
-Fetch it from <URL:http://www.dina.kvl.dk/~abraham/custom/>.
-You also then need to add the following to the lisp/dgnushack.el file:
-
-     (push \"~/lisp/custom\" load-path)
-
-Modify to suit your needs."))
   (let ((files (directory-files srcdir nil "^[^=].*\\.el$"))
 	;;(byte-compile-generate-call-tree t)
 	file elc)
@@ -231,7 +248,8 @@ Modify to suit your needs."))
     (dolist (file
 	     (if (featurep 'xemacs)
 		 '("md5.el")
-	       '("gnus-xmas.el" "messagexmas.el" "nnheaderxm.el")))
+	       '("gnus-xmas.el" "messagexmas.el" "nnheaderxm.el"
+		 "run-at-time.el")))
       (setq files (delete file files)))
 
     (dolist (file files)