Indent.
[gnus] / lisp / dgnushack.el
index c9567db..0f4041f 100644 (file)
 ;(push "/usr/share/emacs/site-lisp" load-path)
 
 (unless (featurep 'xemacs)
 ;(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 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)))
   (define-compiler-macro merge (&whole form type seq1 seq2 pred &rest keys)
     (if (and (fboundp 'merge)
             (subrp (symbol-function 'merge)))
             (if (funcall pred (car seq2) (car seq1))
                 (push (pop seq2) res)
               (push (pop seq1) res)))
             (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)))))))))
+          (let ((x (nconc (nreverse res) seq1 seq2)))
+            (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)) 
+                   (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 copy-list (&whole form list)
     (if (and (fboundp 'copy-list)
 
   (define-compiler-macro copy-list (&whole form list)
     (if (and (fboundp 'copy-list)
               (while (consp list) (push (pop list) res))
               (prog1 (nreverse res) (setcdr res list)))
           (car list)))))
               (while (consp list) (push (pop list) res))
               (prog1 (nreverse res) (setcdr res list)))
           (car list)))))
-  )
+
+  (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
 
 ;; If we are building w3 in a different directory than the source
 ;; directory, we must read *.el from source directory and write *.elc
@@ -242,22 +165,22 @@ Modify to suit your needs."))
     (condition-case code
        (require 'w3-parse)
       (error
     (condition-case code
        (require 'w3-parse)
       (error
-       (message "No w3: %s %s" code (locate-library "w3-parse"))
+       (message "No w3: %s %s" (cadr code) (or (locate-library "w3-parse") ""))
        (dolist (file '("nnultimate.el" "webmail.el" "nnwfm.el"))
         (setq files (delete file files)))))
     (condition-case code
        (require 'mh-e)
       (error
        (dolist (file '("nnultimate.el" "webmail.el" "nnwfm.el"))
         (setq files (delete file files)))))
     (condition-case code
        (require 'mh-e)
       (error
-       (message "No mh-e: %s %s" code (locate-library "mh-e"))
+       (message "No mh-e: %s %s" (cadr code) (or (locate-library "mh-e") ""))
        (setq files (delete "gnus-mh.el" files))))
     (condition-case code
        (require 'xml)
       (error
        (setq files (delete "gnus-mh.el" files))))
     (condition-case code
        (require 'xml)
       (error
-       (message "No xml: %s %s" code (locate-library "xml"))
+       (message "No xml: %s %s" (cadr code) (or (locate-library "xml") ""))
        (setq files (delete "nnrss.el" files))))
     (dolist (file
             (if (featurep 'xemacs)
        (setq files (delete "nnrss.el" files))))
     (dolist (file
             (if (featurep 'xemacs)
-                '("md5.el")
+                '("md5.el")
               '("gnus-xmas.el" "messagexmas.el" "nnheaderxm.el")))
       (setq files (delete file files)))
 
               '("gnus-xmas.el" "messagexmas.el" "nnheaderxm.el")))
       (setq files (delete file files)))