X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fdgnushack.el;h=1a90445ed83e039b1b018c688dc4585bb8aa1c2e;hb=8a60ddbc6b8060cb6e436dc74775fedf7e3f580a;hp=8938d3f3aeddf03528270d8055fab56a9b3cae35;hpb=dab90e322488e20205f3e4c254049f40577275a9;p=elisp%2Fgnus.git- diff --git a/lisp/dgnushack.el b/lisp/dgnushack.el index 8938d3f..1a90445 100644 --- a/lisp/dgnushack.el +++ b/lisp/dgnushack.el @@ -1,5 +1,6 @@ ;;; dgnushack.el --- a hack to set the load path for byte-compiling -;; Copyright (C) 1994,95,96,97,98,99 Free Software Foundation, Inc. +;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Katsumi Yamaoka @@ -50,46 +51,11 @@ (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 (cons 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)))) +(defvar srcdir (or (getenv "srcdir") ".")) + +(push (or (getenv "W3DIR") (expand-file-name "../../w3/lisp/" srcdir)) + load-path) +(load (expand-file-name "dgnuspath.el" srcdir) nil nil t) ;; If we are building w3 in a different directory than the source ;; directory, we must read *.el from source directory and write *.elc @@ -111,12 +77,34 @@ (require 'bytecomp) -(defvar srcdir (or (getenv "srcdir") ".")) - -(push srcdir load-path) +(unless (fboundp 'si:byte-optimize-form-code-walker) + (byte-optimize-form nil);; Load `byte-opt' or `byte-optimize'. + (setq max-specpdl-size 3000) + (fset 'si:byte-optimize-form-code-walker + (symbol-function 'byte-optimize-form-code-walker)) + (defun byte-optimize-form-code-walker (form for-effect) + (if (and for-effect (memq (car-safe form) '(and or))) + ;; Fix bug in and/or forms. + (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)) + (if backwards + (let ((head backwards)) + (while (setq backwards (cdr backwards)) + (setcar backwards (byte-optimize-form (car backwards) + nil))) + (cons fn (nreverse head))))) + (si:byte-optimize-form-code-walker form for-effect))) + (byte-compile 'byte-optimize-form-code-walker)) + +(load (expand-file-name "gnus-clfns.el" srcdir) nil t t) -;; Attempt to pickup the additional load-path(s). -(load (expand-file-name "dgnuspath.el" srcdir) nil nil t) (condition-case err (load "~/.lpath.el" t nil t) (error (message "Error in \"~/.lpath.el\" file: %s" err))) @@ -130,7 +118,7 @@ (if (null (cdr form)) '(char-after (point)) form)) - (byte-defop-compiler char-after 0-1))) + )) (condition-case nil (char-before) @@ -140,7 +128,8 @@ (defun byte-optimize-char-before (form) (if (null (cdr form)) '(char-before (point)) - form)))) + form)) + )) ;; `char-after' and `char-before' must be well-behaved before lpath.el ;; is loaded. Because it requires `poe' via `path-util'. @@ -177,16 +166,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") @@ -201,12 +182,10 @@ (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))) +(defconst dgnushack-tool-files + '("dgnushack.el" "dgnuspath.el" "ptexinfmt.el")) +(defconst dgnushack-unexported-files + '("dgnuspath.el" "ptexinfmt.el")) (defun dgnushack-compile (&optional warn) ;;(setq byte-compile-dynamic t) @@ -221,34 +200,31 @@ 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 (delete "dgnuspath.el" - (directory-files srcdir nil "^[^=].*\\.el$"))) - (xemacs (string-match "XEmacs" emacs-version)) + (let ((files (directory-files srcdir nil "^[^=].*\\.el$")) ;;(byte-compile-generate-call-tree t) file elc) - (condition-case () - (require 'w3-forms) - (error - (dolist (file '("nnweb.el" "nnlistserv.el" "nnultimate.el" - "nnslashdot.el" "nnwarchive.el" "webmail.el")) - (setq files (delete file files))))) - (condition-case () - (require 'bbdb) - (error (setq files (delete "gnus-bbdb.el" files)))) + (mapcar + (lambda (el) (setq files (delete el files))) + (nconc + dgnushack-tool-files + (condition-case nil + (progn (require 'w3-forms) nil) + (error '("nnweb.el" "nnlistserv.el" "nnultimate.el" + "nnslashdot.el" "nnwarchive.el" "webmail.el"))) + (condition-case nil + (progn (require 'bbdb) nil) + (error '("gnus-bbdb.el"))) + (unless (featurep 'xemacs) + '("gnus-xmas.el" "gnus-picon.el" "messagexmas.el" + "nnheaderxm.el" "smiley.el")) + (when (and (fboundp 'md5) (subrp (symbol-function 'md5))) + '("md5.el")))) (while (setq file (pop files)) - (unless (or (and (not xemacs) - (member file - '("gnus-xmas.el" "gnus-picon.el" - "messagexmas.el" "nnheaderxm.el" - "smiley.el" "x-overlay.el"))) - (and (string-equal file "md5.el") - (not (and (fboundp 'md5) - (subrp (symbol-function 'md5)))))) - (setq file (expand-file-name file srcdir)) - (when (or (not (file-exists-p (setq elc (concat file "c")))) - (file-newer-than-file-p file elc)) - (ignore-errors - (byte-compile-file file))))))) + (setq file (expand-file-name file srcdir)) + (when (or (not (file-exists-p (setq elc (concat file "c")))) + (file-newer-than-file-p file elc)) + (ignore-errors + (byte-compile-file file)))))) (defun dgnushack-recompile () (require 'gnus) @@ -296,29 +272,22 @@ Modify to suit your needs.")) (with-temp-buffer (let ((standard-output (current-buffer))) (Custom-make-dependencies ".")) - (message (buffer-string))) + (message "%s" (buffer-string))) (require 'cus-load) (byte-compile-file "custom-load.el") (message "Generating MANIFEST.%s for the package..." product-name) (with-temp-buffer - (insert "pkginfo/MANIFEST." product-name "\n" - lisp-dir - (mapconcat - 'identity - (sort (delete "dgnuspath.el" - (delete "patchs.elc" - (directory-files "." nil "\\.elc?$"))) - 'string-lessp) - (concat "\n" lisp-dir)) - "\ninfo/" - (mapconcat - 'identity - (sort (directory-files "../texi/" - nil dgnushack-info-file-regexp) - 'string-lessp) - "\ninfo/") - "\n") + (insert "pkginfo/MANIFEST." product-name "\n") + (mapcar + (lambda (file) + (unless (member file dgnushack-unexported-files) + (insert lisp-dir file "\n"))) + (sort (directory-files "." nil "\\.elc?$") 'string-lessp)) + (mapcar + (lambda (file) (insert "info/" file "\n")) + (sort (directory-files "../texi/" nil dgnushack-info-file-regexp) + 'string-lessp)) (write-file (concat "../MANIFEST." product-name))))) (defun dgnushack-install-package () @@ -358,14 +327,13 @@ You must specify the name of the package path as follows: (unless (file-directory-p pkginfo-dir) (make-directory pkginfo-dir)) - (setq files - (sort (delete "dgnuspath.el" - (delete "dgnuspath.elc" - (directory-files "." nil "\\.elc?$"))) - 'string-lessp)) + (setq files (sort (directory-files "." nil "\\.elc?$") 'string-lessp)) + (mapcar (lambda (el) (setq files (delete el files))) + dgnushack-unexported-files) (mapcar (lambda (file) - (unless (member file files) + (unless (or (member file files) + (not (string-match "\\.elc?$" file))) (setq file (expand-file-name file lisp-dir)) (message "Removing %s..." file) (condition-case nil @@ -399,10 +367,11 @@ You must specify the name of the package path as follows: (defun dgnushack-texi-format (&optional addsuffix) (if (not noninteractive) (error "batch-texinfo-format may only be used -batch.")) - (require 'texinfmt) + (require 'ptexinfmt) (let ((auto-save-default nil) (find-file-run-dired nil) - coding-system-for-write) + coding-system-for-write + output-coding-system) (let ((error 0) file (files ())) @@ -426,7 +395,10 @@ You must specify the name of the package path as follows: (progn (if buffer-file-name (kill-buffer (current-buffer))) (find-file file) - (setq coding-system-for-write buffer-file-coding-system) + (if (boundp 'MULE) + (setq output-coding-system (symbol-value + 'file-coding-system)) + (setq coding-system-for-write buffer-file-coding-system)) (when (and addsuffix (re-search-forward "^@setfilename[\t ]+\\([^\t\n ]+\\)" nil t)