X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fdgnushack.el;h=0b9e28aa5252e10f04bdcc3d785e22ff40fc8401;hb=03d947e7c4622b53ad390bd3a0df9d8dd2b5e3f3;hp=189feede91d6d94909d04f55cae48e78a05e686e;hpb=a7d389b92924404fd96004b210649a3ce3d2565d;p=gnus

diff --git a/lisp/dgnushack.el b/lisp/dgnushack.el
index 189feede9..0b9e28aa5 100644
--- a/lisp/dgnushack.el
+++ b/lisp/dgnushack.el
@@ -34,7 +34,7 @@
 (defvar srcdir (or (getenv "srcdir") "."))
 
 (defun my-getenv (str)
-  (let ((val (getenv "lispdir")))
+  (let ((val (getenv str)))
     (if (equal val "no") nil val)))
 
 (if (my-getenv "lispdir")
@@ -70,6 +70,104 @@
 	   (while (consp (cdr x))
 	     (pop x))
 	   x))))
+
+  (define-compiler-macro coerce (&whole form x type)
+    (if (and (fboundp 'coerce)
+	     (subrp (symbol-function 'coerce)))
+	form
+      `(let ((x ,x)
+	     (type ,type))
+	 (cond ((eq type 'list) (if (listp x) x (append x nil)))
+	       ((eq type 'vector) (if (vectorp x) x (vconcat x)))
+	       ((eq type 'string) (if (stringp x) x (concat x)))
+	       ((eq type 'array) (if (arrayp x) x (vconcat x)))
+	       ((and (eq type 'character) (stringp x) (= (length x) 1))
+		(aref x 0))
+	       ((and (eq type 'character) (symbolp x)
+		     (= (length (symbol-name x)) 1))
+		(aref (symbol-name x) 0))
+	       ((eq type 'float) (float x))
+	       ((typep x type) x)
+	       (t (error "Can't coerce %s to type %s" x type))))))
+
+  (define-compiler-macro merge (&whole form type seq1 seq2 pred &rest keys)
+    (if (and (fboundp 'merge)
+	     (subrp (symbol-function 'merge)))
+	form
+      `(let ((type ,type)
+	     (seq1 ,seq1)
+	     (seq2 ,seq2)
+	     (pred ,pred))
+	 (or (listp seq1) (setq seq1 (append seq1 nil)))
+	 (or (listp seq2) (setq seq2 (append seq2 nil)))
+	 (let ((res nil))
+	   (while (and seq1 seq2)
+	     (if (funcall pred (car seq2) (car seq1))
+		 (push (pop seq2) res)
+	       (push (pop seq1) res)))
+	   (coerce (nconc (nreverse res) seq1 seq2) type)))))
+
+  (define-compiler-macro subseq (&whole form seq start &optional end)
+    (if (and (fboundp 'subseq)
+	     (subrp (symbol-function 'subseq)))
+	form
+      (if end
+	  `(let ((seq ,seq)
+		 (start ,start)
+		 (end ,end))
+	     (if (stringp seq)
+		 (substring seq start end)
+	       (let (len)
+		 (if (< end 0)
+		     (setq end (+ end (setq len (length seq)))))
+		 (if (< start 0)
+		     (setq start (+ start (or len (setq len (length seq))))))
+		 (cond ((listp seq)
+			(if (> start 0)
+			    (setq seq (nthcdr start seq)))
+			(let ((res nil))
+			  (while (>= (setq end (1- end)) start)
+			    (push (pop seq) res))
+			  (nreverse res)))
+		       (t
+			(let ((res (make-vector (max (- end start) 0) nil))
+			      (i 0))
+			  (while (< start end)
+			    (aset res i (aref seq start))
+			    (setq i (1+ i)
+				  start (1+ start)))
+			  res))))))
+	`(let ((seq ,seq)
+	       (start ,start))
+	   (if (stringp seq)
+	       (substring seq start)
+	     (let (len)
+	       (if (< start 0)
+		   (setq start (+ start (or len (setq len (length seq))))))
+	       (cond ((listp seq)
+		      (if (> start 0)
+			  (setq seq (nthcdr start seq)))
+		      (copy-sequence seq))
+		     (t
+		      (let* ((end (or len (length seq)))
+			     (res (make-vector (max (- end start) 0) nil))
+			     (i 0))
+			(while (< start end)
+			  (aset res i (aref seq start))
+			  (setq i (1+ i)
+				start (1+ start)))
+			res)))))))))
+
+  (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)))))
   )
 
 ;; If we are building w3 in a different directory than the source
@@ -139,7 +237,7 @@ Modify to suit your needs."))
        (message "No w3: %s %s" code (locate-library "w3-forms"))
        (dolist (file '("nnweb.el" "nnlistserv.el" "nnultimate.el"
 		       "nnslashdot.el" "nnwarchive.el" "webmail.el"
-		       "nnwfm.el"))
+		       "nnwfm.el" "nnrss.el"))
 	 (setq files (delete file files)))))
     (dolist (file
 	     (if (featurep 'xemacs)
@@ -179,10 +277,24 @@ Modify to suit your needs."))
 
 (defun dgnushack-make-auto-load ()
   (require 'autoload)
+  (unless (make-autoload '(define-derived-mode child parent name
+			    "docstring" body)
+			 "file")
+    (defadvice make-autoload (around handle-define-derived-mode activate)
+      "Handle `define-derived-mode'."
+      (if (eq (car-safe (ad-get-arg 0)) 'define-derived-mode)
+	  (setq ad-return-value
+		(list 'autoload
+		      (list 'quote (nth 1 (ad-get-arg 0)))
+		      (ad-get-arg 1)
+		      (nth 4 (ad-get-arg 0))
+		      t nil))
+	ad-do-it))
+    (put 'define-derived-mode 'doc-string-elt 3))
   (let ((generated-autoload-file dgnushack-gnus-load-file)
 	(make-backup-files nil)
 	(autoload-package-name "gnus"))
-    (if (featurep 'xemacs) 
+    (if (featurep 'xemacs)
 	(if (file-exists-p generated-autoload-file)
 	    (delete-file generated-autoload-file))
       (with-temp-file generated-autoload-file