cgit.sxemacs.org Git - sxemacs/blob - lisp/update-elc.el

   1 ;;; update-elc.el --- Bytecompile out-of-date dumped files
   2
   3 ;; Copyright (C) 1997 Free Software Foundation, Inc.
   4 ;; Copyright (C) 1996 Sun Microsystems, Inc.
   5
   6 ;; Author: Ben Wing <ben@xemacs.org>, Steven L Baur <steve@xemacs.org>
   7 ;; Maintainer: SXEmacs Development Team
   8 ;; Keywords: internal
   9
  10 ;; This file is part of SXEmacs.
  11
  12 ;; SXEmacs is free software: you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation, either version 3 of the License, or
  15 ;; (at your option) any later version.
  16
  17 ;; SXEmacs is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  24
  25 ;;; Synched up with: Not in FSF.
  26
  27 ;;; Commentary:
  28
  29 ;; Byte compile the .EL files necessary to dump out xemacs.
  30 ;; Use this file like this:
  31
  32 ;; temacs -batch -l ../lisp/update-elc.el $lisp
  33
  34 ;; where $lisp comes from the Makefile.  .elc files listed in $lisp will
  35 ;; cause the corresponding .el file to be compiled.  .el files listed in
  36 ;; $lisp will be ignored.
  37
  38 ;; (the idea here is that you can bootstrap if your .ELC files
  39 ;; are missing or badly out-of-date)
  40
  41 ;; See also update-elc-2.el
  42
  43 ;;; Code:
  44
  45 (defvar processed nil)
  46 (defvar update-elc-files-to-compile nil)
  47
  48 ;(setq update-elc-files-to-compile
  49 ;      (delq nil
  50 ;           (mapcar (function
  51 ;                    (lambda (x)
  52 ;                      (if (string-match "\.elc$" x)
  53 ;                          (let ((src (substring x 0 -1)))
  54 ;                            (if (file-newer-than-file-p src x)
  55 ;                                (progn
  56 ;                                  (and (file-exists-p x)
  57 ;                                       (null (file-writable-p x))
  58 ;                                       (set-file-modes x (logior (file-modes x) 128)))
  59 ;                                  src))))))
  60 ;                   ;; -batch gets filtered out.
  61 ;                   (nthcdr 3 command-line-args))))
  62
  63 ;; (let ((build-root (getenv "top_srcdir"))) ;;;(expand-file-name ".." invocation-directory)))
  64 ;;   (setq load-path (list (expand-file-name "lisp" build-root))))
  65
  66 (load "very-early-lisp" nil t)
  67
  68 (load "find-paths.el")
  69 (load "packages.el")
  70 (load "setup-paths.el")
  71 (load "dump-paths.el")
  72
  73 (let ((autol (packages-list-autoloads
  74               (if (getenv "BUILD_TREE_ROOT")
  75                   (expand-file-name "lisp" (getenv "BUILD_TREE_ROOT"))
  76                 (concat default-directory "../lisp")))))
  77
  78   ;;(print (prin1-to-string autol))
  79   (while autol
  80     (let ((src (car autol)))
  81       (if (and (file-exists-p src)
  82                (file-newer-than-file-p src (concat src "c")))
  83           (setq update-elc-files-to-compile
  84                 (cons src update-elc-files-to-compile))))
  85     (setq autol (cdr autol))))
  86
  87 ;; (print (prin1-to-string update-elc-files-to-compile))
  88
  89 (let (preloaded-file-list site-load-packages need-to-dump dumped-exe)
  90   (load (if (getenv "SOURCE_TREE_ROOT")
  91             (expand-file-name "lisp/dumped-lisp.el" (getenv "SOURCE_TREE_ROOT"))
  92           (concat default-directory "../lisp/dumped-lisp.el")))
  93
  94   (setq dumped-exe
  95         (cond ((file-exists-p "../src/sxemacs") "../src/sxemacs")
  96               (t nil)))
  97
  98   ;; Path setup
  99   (let ((package-preloaded-file-list
 100          (packages-collect-package-dumped-lisps late-package-load-path)))
 101
 102     (setq preloaded-file-list
 103           (append package-preloaded-file-list
 104                   preloaded-file-list
 105                   '("bytecomp")
 106                   packages-hardcoded-lisp)))
 107
 108   (load (concat default-directory "../site-packages") t t)
 109   (setq preloaded-file-list
 110         (append packages-hardcoded-lisp
 111                 preloaded-file-list
 112                 site-load-packages))
 113
 114   (while preloaded-file-list
 115     (let ((arg (car preloaded-file-list)))
 116       ;; (print (prin1-to-string arg))
 117
 118       ;; now check if .el or .elc is newer than the dumped exe.
 119       ;; if so, need to redump.
 120       (let ((frob
 121              (if (string-match "\\.elc?\\'" arg)
 122                  (substring arg 0 (match-beginning 0))
 123                arg)))
 124             (when (and dumped-exe
 125                        (or (let ((frobel
 126                                   (if (getenv "SOURCE_TREE_ROOT")
 127                                       (expand-file-name
 128                                        (concat "lisp/" frob ".el")
 129                                        (getenv "SOURCE_TREE_ROOT"))
 130                                     (concat "../lisp/" frob ".el"))))
 131                              (and (file-exists-p frobel)
 132                                   (file-newer-than-file-p frobel dumped-exe)))
 133                            (let ((frobelc
 134                                   (if (getenv "BUILD_TREE_ROOT")
 135                                       (expand-file-name
 136                                        (concat "lisp/" frob ".elc")
 137                                        (getenv "BUILD_TREE_ROOT"))
 138                                     (concat "../lisp/" frob ".elc"))))
 139                              (and (file-exists-p frobelc)
 140                                   (file-newer-than-file-p frobelc dumped-exe)))))
 141               (setq need-to-dump t)))
 142
 143 ;      (if (null (member (file-name-nondirectory arg)
 144 ;                       packages-unbytecompiled-lisp))
 145 ;         (progn
 146
 147       (setq arg (locate-library arg))
 148       (if (null arg)
 149           (progn
 150             (print (format "Error: Library file %s not found"
 151                            (car preloaded-file-list)))
 152             ;; Uncomment in case of trouble
 153             ;;(print (format "late-packages: %S" late-packages))
 154             ;;(print (format "guessed-roots: %S" (paths-find-emacs-roots invocation-directory invocation-name)))
 155             (kill-emacs)))
 156       (if (string-match #r"\.elc?\'" arg)
 157           (setq arg (substring arg 0 (match-beginning 0))))
 158       (if (and (null (member arg processed))
 159                (file-exists-p (concat arg ".el"))
 160                (file-newer-than-file-p (concat arg ".el")
 161                                        (concat arg ".elc")))
 162           (setq processed (cons (concat arg ".el") processed)))
 163       (setq preloaded-file-list (cdr preloaded-file-list))))
 164
 165   (if need-to-dump
 166       (condition-case nil
 167           (write-region-internal "foo" nil "../src/NEEDTODUMP")
 168         (file-error nil)))
 169
 170   )
 171
 172 (prin1 processed)
 173 (setq update-elc-files-to-compile (append update-elc-files-to-compile
 174                                           (nreverse processed)))
 175
 176 ;; (print (prin1-to-string update-elc-files-to-compile))
 177
 178 (if update-elc-files-to-compile
 179     (progn
 180       (setq command-line-args
 181             (append '("-l" "loadup-el.el" "run-temacs"
 182                       "-batch" "-q" "-no-site-file"
 183                       "-l" "bytecomp" "-f" "batch-byte-compile")
 184                     update-elc-files-to-compile))
 185       (load "loadup-el.el"))
 186   (condition-case nil
 187       (delete-file "../src/NOBYTECOMPILE")
 188     (file-error nil)))
 189
 190 (kill-emacs)
 191
 192 ;;; update-elc.el ends here