Mercurial > hg > xemacs-beta
comparison lisp/prim/update-elc.el @ 163:0132846995bd r20-3b8
Import from CVS: tag r20-3b8
author | cvs |
---|---|
date | Mon, 13 Aug 2007 09:43:35 +0200 |
parents | 43dd3413c7c7 |
children | 8eaf7971accc |
comparison
equal
deleted
inserted
replaced
162:4de2936b4e77 | 163:0132846995bd |
---|---|
42 ;; Currently this code gets the list of files to check passed to it from | 42 ;; Currently this code gets the list of files to check passed to it from |
43 ;; src/Makefile. This must be fixed. -slb | 43 ;; src/Makefile. This must be fixed. -slb |
44 | 44 |
45 ;;; Code: | 45 ;;; Code: |
46 | 46 |
47 (setq update-elc-files-to-compile | 47 (defvar processed nil) |
48 (delq nil | 48 (defvar update-elc-files-to-compile nil) |
49 (mapcar (function | 49 |
50 (lambda (x) | 50 ;(setq update-elc-files-to-compile |
51 (if (string-match "\.elc$" x) | 51 ; (delq nil |
52 (let ((src (substring x 0 -1))) | 52 ; (mapcar (function |
53 (if (file-newer-than-file-p src x) | 53 ; (lambda (x) |
54 (progn | 54 ; (if (string-match "\.elc$" x) |
55 (and (file-exists-p x) | 55 ; (let ((src (substring x 0 -1))) |
56 (null (file-writable-p x)) | 56 ; (if (file-newer-than-file-p src x) |
57 (set-file-modes x (logior (file-modes x) 128))) | 57 ; (progn |
58 src)))))) | 58 ; (and (file-exists-p x) |
59 ;; -batch gets filtered out. | 59 ; (null (file-writable-p x)) |
60 (nthcdr 3 command-line-args)))) | 60 ; (set-file-modes x (logior (file-modes x) 128))) |
61 ; src)))))) | |
62 ; ;; -batch gets filtered out. | |
63 ; (nthcdr 3 command-line-args)))) | |
64 | |
65 (define-function 'defalias 'define-function) | |
66 (require 'packages) | |
67 | |
68 (let ((autol (list-autoloads))) | |
69 ;; (print (prin1-to-string autol)) | |
70 (while autol | |
71 (let ((src (car autol))) | |
72 (if (and (file-exists-p src) | |
73 (file-newer-than-file-p src (concat src "c"))) | |
74 (setq update-elc-files-to-compile | |
75 (cons src update-elc-files-to-compile)))) | |
76 (setq autol (cdr autol)))) | |
77 | |
78 ;; We must have some lisp support at this point | |
79 (let ((temp-path (expand-file-name ".." (car load-path)))) | |
80 (setq load-path (nconc (directory-files temp-path t "^[^-.]" | |
81 nil 'dirs-only) | |
82 (cons temp-path load-path)))) | |
83 | |
84 ;(load "backquote") | |
85 ;(load "bytecomp-runtime") | |
86 ;(load "subr") | |
87 ;(load "replace") | |
88 ;(load "version.el") | |
89 ;(load "cl") | |
90 ;(load "featurep") | |
91 | |
92 ;; (print (prin1-to-string update-elc-files-to-compile)) | |
93 | |
94 (let (dumped-lisp-packages site-load-packages) | |
95 (load (concat default-directory "../lisp/prim/dumped-lisp.el")) | |
96 ;; (print (prin1-to-string dumped-lisp-packages)) | |
97 (load (concat default-directory "../site-packages") t t) | |
98 (setq dumped-lisp-packages | |
99 (append packages-hardcoded-lisp | |
100 dumped-lisp-packages | |
101 packages-useful-lisp | |
102 site-load-packages)) | |
103 (while dumped-lisp-packages | |
104 (let ((arg (car dumped-lisp-packages))) | |
105 ;; (print (prin1-to-string arg)) | |
106 (if (null (member arg packages-unbytecompiled-lisp)) | |
107 (progn | |
108 (setq arg (locate-library arg)) | |
109 (if (null arg) | |
110 (progn | |
111 (print (format "Library file %s: not found" | |
112 (car dumped-lisp-packages))) | |
113 (kill-emacs))) | |
114 (if (string-match "\\.elc?\\'" arg) | |
115 (setq arg (substring arg 0 (match-beginning 0)))) | |
116 (if (and (null (member arg processed)) | |
117 (file-exists-p (concat arg ".el")) | |
118 (file-newer-than-file-p (concat arg ".el") | |
119 (concat arg ".elc"))) | |
120 (setq processed (cons (concat arg ".el") processed))))) | |
121 (setq dumped-lisp-packages (cdr dumped-lisp-packages))))) | |
122 | |
123 (setq update-elc-files-to-compile (append update-elc-files-to-compile | |
124 processed)) | |
125 | |
126 ;; (print (prin1-to-string update-elc-files-to-compile)) | |
61 | 127 |
62 (if update-elc-files-to-compile | 128 (if update-elc-files-to-compile |
63 (progn | 129 (progn |
64 (setq command-line-args | 130 (setq command-line-args |
65 (cons (car command-line-args) | 131 ;; (cons (car command-line-args) |
66 (append | 132 (append |
67 '("-l" "loadup-el.el" "run-temacs" | 133 '("-l" "loadup-el.el" "run-temacs" |
68 "-batch" "-q" "-no-site-file" | 134 "-batch" "-q" "-no-site-file" |
69 "-l" "bytecomp" "-f" "batch-byte-compile") | 135 "-l" "bytecomp" "-f" "batch-byte-compile") |
70 update-elc-files-to-compile))) | 136 update-elc-files-to-compile)) ;; ) |
71 (load "loadup-el.el"))) | 137 (load "loadup-el.el") |
138 )) | |
72 | 139 |
73 (kill-emacs) | 140 (kill-emacs) |
74 | 141 |
75 ;;; update-elc.el ends here | 142 ;;; update-elc.el ends here |