1 ;;; package-clean.el --- Remove bogus .elc files in package tree
3 ;; Copyright (C) 1997 by Free Software Foundation, Inc.
4 ;; Copyright (C) 2000, 2001 Ben Wing.
6 ;; Author: Ben Wing <ben@xemacs.org>, based on cleantree.el by
7 ;; Steven L Baur <steve@xemacs.org>
9 ;; This file is part of XEmacs.
11 ;; XEmacs is free software; you can redistribute it and/or modify it
12 ;; under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation; either version 2, or (at your option)
16 ;; XEmacs is distributed in the hope that it will be useful, but
17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
19 ;; General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with XEmacs; see the file COPYING. If not, write to the Free
23 ;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
26 ;;; Synched up with: Not in FSF
30 ;; This is meant to be called -batch at the beginning of package-tree
31 ;; compilation (i.e. `make' from the top of the package tree) and
32 ;; removes out-of-date and orphaned .elc files.
36 (setq stack-trace-on-error t)
39 (error "package-clean may only be used with -batch"))
41 (defvar package-clean-ignored-dirs
42 `("." ".." "CVS" "SCCS" "RCS" ,@(unless (featurep 'mule) '("mule"))))
44 (defvar package-clean-ignored-files
45 ;; note: entries here are regexps
48 (defun package-clean-do-it (dir)
50 ;; Remove out-of-date elcs
51 (let ((files (directory-files dir t "\\.el$"))
53 (while (setq file (car files))
54 (setq files (cdr files))
55 (setq file-c (concat file "c"))
56 (when (and (file-exists-p file-c)
57 (file-newer-than-file-p file file-c))
58 (message "Removing out-of-date %s" file-c)
59 (delete-file file-c))))
60 ;; Remove elcs without corresponding el
61 (let ((files (directory-files dir t "\\.elc$"))
63 (while (setq file-c (car files))
64 (setq files (cdr files))
65 (setq file (replace-in-string file-c "c$" ""))
66 (when (and (file-exists-p file-c)
67 (not (file-exists-p file)))
68 (message "Removing %s; no corresponding .el" file-c)
69 (delete-file file-c))))
71 ;; We descend recursively
72 (let ((dirs (directory-files dir t nil t))
74 (while (setq dir (pop dirs))
75 (when (and (not (member (file-name-nondirectory dir)
76 package-clean-ignored-dirs))
77 (file-directory-p dir))
78 (package-clean-do-it dir)))))
80 (message "Removing old or spurious .elcs in directory tree `%s'..."
81 (expand-file-name "."))
82 (package-clean-do-it ".")
83 (message "Removing old or spurious .elcs in directory tree `%s'...done"
84 (expand-file-name "."))