;;; dgnushack.el --- a hack to set the load path for byte-compiling
-;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000
+;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
(defvar srcdir (or (getenv "srcdir") "."))
-(push (or (getenv "lispdir")
- "/usr/share/emacs/site-lisp")
+(defun my-getenv (str)
+ (let ((val (getenv str)))
+ (if (equal val "no") nil val)))
+
+(if (my-getenv "lispdir")
+ (push (my-getenv "lispdir") load-path))
+
+(push (or (my-getenv "URLDIR") (expand-file-name "../../url/lisp/" srcdir))
load-path)
-(push (or (getenv "W3DIR") (expand-file-name "../../w3/lisp/" srcdir))
+
+(push (or (my-getenv "W3DIR") (expand-file-name "../../w3/lisp/" srcdir))
load-path)
+(push "/usr/share/emacs/site-lisp" load-path)
+
(unless (featurep 'xemacs)
(define-compiler-macro last (&whole form x &optional n)
(if (and (fboundp 'last)
(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)))))))))
)
;; If we are building w3 in a different directory than the source
(require 'bytecomp)
(push srcdir load-path)
-(push "/usr/share/emacs/site-lisp" load-path)
(load (expand-file-name "lpath.el" srcdir) nil t)
(defalias 'device-sound-enabled-p 'ignore)
(let ((files (directory-files srcdir nil "^[^=].*\\.el$"))
;;(byte-compile-generate-call-tree t)
file elc)
+ ;; Avoid barfing (from gnus-xmas) because the etc directory is not yet
+ ;; installed.
+ (when (featurep 'xemacs)
+ (setq gnus-xmas-glyph-directory "dummy"))
(dolist (file '("dgnushack.el" "lpath.el"))
(setq files (delete file files)))
- (if (featurep 'base64)
- (setq files (delete "base64.el" files)))
- (condition-case ()
- (require 'w3-forms)
+ (when (featurep 'base64)
+ (setq files (delete "base64.el" files)))
+ (condition-case code
+ (require 'w3-forms)
(error
+ (message "No w3: %s %s" code (locate-library "w3-forms"))
(dolist (file '("nnweb.el" "nnlistserv.el" "nnultimate.el"
- "nnslashdot.el" "nnwarchive.el" "webmail.el"))
+ "nnslashdot.el" "nnwarchive.el" "webmail.el"
+ "nnwfm.el" "nnrss.el"))
(setq files (delete file files)))))
- (dolist (file
+ (dolist (file
(if (featurep 'xemacs)
'("md5.el" "smiley-ems.el")
- '("gnus-xmas.el" "gnus-picon.el" "messagexmas.el"
+ '("gnus-xmas.el" "gnus-picon.el" "messagexmas.el"
"nnheaderxm.el" "smiley.el")))
(setq files (delete file files)))
(dolist (file files)
(setq file (expand-file-name file srcdir))
- (when (and (file-exists-p (setq elc (concat file "c")))
+ (when (and (file-exists-p
+ (setq elc (concat (file-name-nondirectory file) "c")))
(file-newer-than-file-p file elc))
(delete-file elc)))
-
+
(while (setq file (pop files))
(setq file (expand-file-name file srcdir))
- (when (or (not (file-exists-p (setq elc (concat file "c"))))
+ (when (or (not (file-exists-p
+ (setq elc (concat (file-name-nondirectory file) "c"))))
(file-newer-than-file-p file elc))
(ignore-errors
(byte-compile-file file))))))
(require 'gnus)
(byte-recompile-directory "." 0))
-;;; dgnushack.el ends here
+(defvar dgnushack-gnus-load-file (expand-file-name "gnus-load.el"))
+(defvar dgnushack-cus-load-file (expand-file-name "cus-load.el"))
+
+(defun dgnushack-make-cus-load ()
+ (load "cus-dep")
+ (let ((cusload-base-file dgnushack-cus-load-file))
+ (if (fboundp 'custom-make-dependencies)
+ (custom-make-dependencies)
+ (Custom-make-dependencies))))
+
+(defun dgnushack-make-auto-load ()
+ (require 'autoload)
+ (let ((generated-autoload-file dgnushack-gnus-load-file)
+ (make-backup-files nil)
+ (autoload-package-name "gnus"))
+ (if (featurep 'xemacs)
+ (if (file-exists-p generated-autoload-file)
+ (delete-file generated-autoload-file))
+ (with-temp-file generated-autoload-file
+ (insert ?\014)))
+ (batch-update-autoloads)))
+(defun dgnushack-make-load ()
+ (message (format "Generating %s..." dgnushack-gnus-load-file))
+ (with-temp-file dgnushack-gnus-load-file
+ (insert-file-contents dgnushack-cus-load-file)
+ (delete-file dgnushack-cus-load-file)
+ (goto-char (point-min))
+ (search-forward ";;; Code:")
+ (forward-line)
+ (delete-region (point-min) (point))
+ (insert "\
+;;; gnus-load.el --- automatically extracted custom dependencies and autoload
+;;
+;;; Code:
+")
+ (goto-char (point-max))
+ (if (search-backward "custom-versions-load-alist" nil t)
+ (forward-line -1)
+ (forward-line -1)
+ (while (eq (char-after) ?\;)
+ (forward-line -1))
+ (forward-line))
+ (delete-region (point) (point-max))
+ (insert "\n")
+ ;; smiley-* are duplicated. Remove them all.
+ (let ((point (point)))
+ (insert-file-contents dgnushack-gnus-load-file)
+ (goto-char point)
+ (while (search-forward "smiley-" nil t)
+ (beginning-of-line)
+ (if (looking-at "(autoload ")
+ (delete-region (point) (progn (forward-sexp) (point)))
+ (forward-line))))
+ ;;
+ (goto-char (point-max))
+ (when (search-backward "\n(provide " nil t)
+ (forward-line -1)
+ (delete-region (point) (point-max)))
+ (insert "\
+
+\(provide 'gnus-load)
+
+;;; Local Variables:
+;;; version-control: never
+;;; no-byte-compile: t
+;;; no-update-autoloads: t
+;;; End:
+;;; gnus-load.el ends here\n"))
+ (message (format "Compiling %s..." dgnushack-gnus-load-file))
+ (byte-compile-file dgnushack-gnus-load-file))
+
+;;; dgnushack.el ends here