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

   1 ;;; update-elc-2.el --- Recompile remaining .el files, post-dumping
   2
   3 ;; Copyright (C) 1997 by Free Software Foundation, Inc.
   4 ;; Copyright (C) 2000 Ben Wing.
   5
   6 ;; Author: Ben Wing <ben@xemacs.org>, based on cleantree.el by
   7 ;;         Steven L Baur <steve@xemacs.org>
   8 ;; Maintainer: SXEmacs Development Team
   9 ;; Keywords: internal
  10
  11 ;; This file is part of SXEmacs.
  12
  13 ;; SXEmacs is free software: you can redistribute it and/or modify
  14 ;; it under the terms of the GNU General Public License as published by
  15 ;; the Free Software Foundation, either version 3 of the License, or
  16 ;; (at your option) any later version.
  17
  18 ;; SXEmacs is distributed in the hope that it will be useful,
  19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;; GNU General Public License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  25
  26 ;;; Synched up with: Not in FSF
  27
  28 ;;; Commentary:
  29
  30 ;; This file should be used after XEmacs has been dumped, to recompile
  31 ;; all remaining out-of-date .els and clean up orphaned .elcs.  It should
  32 ;; be called as
  33 ;;
  34 ;;   xemacs -batch -vanilla -l update-elc-2.el -f batch-update-elc-2 ${dirname}
  35 ;;
  36 ;; where ${dirname} is the directory tree to recompile, usually `lisp'.
  37 ;;
  38 ;; Note that this is very different from update-elc.el, which is called
  39 ;; BEFORE dumping, handles only the files needed to dump, and is called
  40 ;; from temacs instead of xemacs.
  41 ;;
  42 ;; The original cleantree.el had the comment: This code is derived
  43 ;; from Gnus based on a suggestion by David Moore <dmoore@ucsd.edu>
  44
  45 ;;; Code:
  46
  47 (defvar update-elc-ignored-dirs
  48   `("." ".." "CVS" "SCCS" "RCS" "{arch}" ".arch-ids"
  49     ,@(unless (featurep 'mule) '("mule"))
  50     ,@(unless (fboundp #'ffi-defun) '("ffi"))))
  51
  52 (defvar update-elc-ignored-files
  53   ;; note: entries here are regexps
  54   `("^," ;; #### huh?
  55     "^paths\\.el$"
  56     "^loadup\\.el$"
  57     "^loadup-el\\.el$"
  58     "^update-elc\\.el$"
  59     "^update-elc-2\\.el$"
  60     "^dumped-lisp\\.el$"
  61     "^make-docfile\\.el$"
  62     "^site-start\\.el$"
  63     "^site-load\\.el$"
  64     "^site-init\\.el$"
  65     "^version\\.el$"
  66     "^very-early-lisp\\.el$"
  67     ,@(unless (fboundp 'ffi-defun) '("^ffi.*\\.el$"))))
  68
  69 ;; SEEN accumulates the list of already-handled dirs.
  70 (defun do-update-elc-2 (dir compile-stage-p seen)
  71   (setq dir (file-name-as-directory dir))
  72   ;; Only scan this sub-tree if we haven't been here yet.
  73   (unless (member (file-truename dir) seen)
  74     (push (file-truename dir) seen)
  75
  76     ;; Do this directory.
  77     (if compile-stage-p
  78         ;; Stage 2: Recompile necessary .els
  79         (let ((files (directory-files dir t "\\.el$"))
  80               file file-c)
  81           (while (setq file (car files))
  82             (setq files (cdr files))
  83             (setq file-c (concat file "c"))
  84             (when (and (file-exists-p file)
  85                        (or (not (file-exists-p file-c))
  86                            (file-newer-than-file-p file file-c))
  87                        (let (ignore)
  88                          (mapcar
  89                           #'(lambda (regexp)
  90                               (if (string-match regexp
  91                                                 (file-name-nondirectory file))
  92                                   (setq ignore t)))
  93                           update-elc-ignored-files)
  94                          (not ignore)))
  95               (byte-compile-file file))))
  96
  97       ;; Stage 1.
  98       ;; Remove out-of-date elcs
  99       (let ((files (directory-files dir t "\\.el$"))
 100             file file-c)
 101         (while (setq file (car files))
 102           (setq files (cdr files))
 103           (setq file-c (concat file "c"))
 104           (when (and (file-exists-p file-c)
 105                      (file-newer-than-file-p file file-c))
 106             (message "Removing out-of-date %s" file-c)
 107             (delete-file file-c))))
 108       ;; Remove elcs without corresponding el
 109       (let ((files (directory-files dir t "\\.elc$"))
 110             file file-c)
 111         (while (setq file-c (car files))
 112           (setq files (cdr files))
 113           (setq file (replace-in-string file-c "c$" ""))
 114           (when (and (file-exists-p file-c)
 115                      (not (file-exists-p file)))
 116             (message "Removing %s; no corresponding .el" file-c)
 117             (delete-file file-c))))
 118
 119     ;; We descend recursively
 120     (let ((dirs (directory-files dir t nil t 'subdir))
 121           dir)
 122       (while (setq dir (pop dirs))
 123         (when (and (not (member (file-name-nondirectory dir)
 124                                 update-elc-ignored-dirs))
 125                    (file-directory-p dir))
 126           (do-update-elc-2 dir compile-stage-p seen))))
 127
 128     )))
 129
 130
 131 (defun batch-update-elc-2 ()
 132   (defvar command-line-args-left)
 133   (unless noninteractive
 134     (error "`batch-update-elc-2' is to be used only with -batch"))
 135   (let ((dir (car command-line-args-left)))
 136     ;; We remove all the bad .elcs before any byte-compilation, because
 137     ;; there may be dependencies between one .el and another (even across
 138     ;; directories), and we don't want to load an out-of-date .elc while
 139     ;; byte-compiling a file.
 140     (message "Removing old or spurious .elcs in directory tree `%s'..." dir)
 141     (do-update-elc-2 dir nil nil)
 142     (message "Removing old or spurious .elcs in directory tree `%s'...done"
 143              dir)
 144     (message "Recompiling updated .els in directory tree `%s'..." dir)
 145     (do-update-elc-2 dir t nil)
 146     (message "Recompiling updated .els in directory tree `%s'...done" dir))
 147   (setq command-line-args-left nil))
 148
 149 ;;; update-elc-2.el ends here