1 ;;; make-docfile.el --- Cache docstrings in external file
3 ;; Copyright (C) 1985, 1986, 1992-1995, 1997 Free Software Foundation, Inc.
6 ;; Maintainer: Steven L Baur <steve@xemacs.org>
9 ;; This file is part of SXEmacs.
11 ;; SXEmacs is free software: you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation, either version 3 of the License, or
14 ;; (at your option) any later version.
16 ;; SXEmacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
24 ;;; Synched up with: Not in FSF
28 ;; This is a front-end to the make-docfile program that gathers up all the
29 ;; lisp files that will be dumped with XEmacs. It would probably be best
30 ;; to just move make-docfile.c completely to lisp and be done with it.
32 ;;; SXEmacs Note: When we moved to a libtool based build chain, I had
33 ;;; to remove all the #'princ calls here otherwise `make DOC' just
34 ;;; gives a zero length DOC file. I doubt that this is a good or even
40 (defvar processed nil)
42 (defvar docfile-buffer nil)
43 (defvar site-file-list nil)
44 (defvar docfile-out-of-date nil)
46 (defvar build-directory (expand-file-name ".." (expand-file-name ".." invocation-directory)))
47 (defvar build-lib-src (expand-file-name "lib-src" build-directory))
48 (defvar source-lisp (file-name-directory #$))
49 (defvar source-src (expand-file-name "../src" source-lisp))
51 (defun message (fmt &rest args)
52 (princ (apply #'format fmt args))
55 ;; Gobble up the stuff we don't wish to pass on.
56 (setq command-line-args (cdr (cdr (cdr (cdr command-line-args)))))
58 ;; First gather up the command line options.
60 (while (and (null done) command-line-args)
61 (let ((arg (car command-line-args)))
62 (cond ((or (string-equal arg "-o") ; Specify DOC file name
63 (string-equal arg "-a") ; Append to DOC file
64 (string-equal arg "-d")) ; Set working directory
65 (if (string-equal arg "-o")
66 (setq docfile (expand-file-name (car (cdr command-line-args)))))
67 (setq options (cons arg options))
68 (setq options (cons (expand-file-name (car (cdr command-line-args))) options)))
69 ((string-equal arg "-i") ; Set site files to scan
70 (setq site-file-list (car (cdr command-line-args))))
73 (setq command-line-args (cdr (cdr command-line-args)))))))
74 (setq options (nreverse options))
76 ;; (print (concat "Options: " (prin1-to-string options)))
78 ;; Next process the list of C files.
79 (while command-line-args
80 (let ((arg (car command-line-args)))
81 (if (null (member arg processed))
83 (if (and (null docfile-out-of-date)
84 (file-newer-than-file-p arg docfile))
85 (setq docfile-out-of-date t))
86 (setq processed (cons arg processed)))))
87 (setq command-line-args (cdr command-line-args)))
89 ;; Then process the list of Lisp files.
90 ;;; We use the ENVironment approach
91 ;; (let ((build-root (expand-file-name ".." invocation-directory)))
92 ;; (setq load-path (list (expand-file-name "lisp" build-root))))
94 (load "very-early-lisp" nil t)
96 ;; Then process the autoloads
97 (setq autoload-file-name "auto-autoloads.elc")
98 (load "find-paths.el")
100 (load "setup-paths.el")
101 (load "dump-paths.el")
102 (load "bytecomp-runtime.el")
104 (load "backquote.el")
112 (let (preloaded-file-list arg0 arg package-preloaded-file-list absolute)
113 (load (expand-file-name "dumped-lisp.el" source-lisp))
115 (setq package-preloaded-file-list
116 (packages-collect-package-dumped-lisps late-package-load-path)
118 (append package-preloaded-file-list
120 packages-hardcoded-lisp)
122 processed (cons "-d" processed)
123 processed (cons source-lisp processed)
124 ;; Include loadup.el, which is never in preloaded-file-list:
125 processed (cons "loadup.el" processed))
127 (while preloaded-file-list
128 (setq arg0 (packages-add-suffix (car preloaded-file-list))
129 arg (locate-library arg0)
133 (message "Error: dumped file %s does not exist" arg0)
134 ;; Uncomment in case of difficulties
135 ;(message "late-package-hierarchies: %S"
136 ; late-package-hierarchies)
137 ;(message "guessed-roots: %S" (paths-find-emacs-roots
138 ; invocation-directory
140 ; #'paths-emacs-root-p))
141 ;(message "guessed-data-roots: %S" (paths-find-emacs-roots
142 ; invocation-directory
144 ; #'paths-emacs-data-root-p))
146 (when (equal arg (expand-file-name arg0 source-lisp))
147 ;; Use relative paths where possible, since this makes file lookup
148 ;; in an installed XEmacs easier:
150 (if (null (member arg processed))
152 (if (and (null docfile-out-of-date)
153 ;; We need to check the absolute path here:
154 (file-newer-than-file-p absolute docfile))
155 (setq docfile-out-of-date t))
156 (setq processed (cons arg processed)))))
157 (setq preloaded-file-list (cdr preloaded-file-list))))
159 ;; Finally process the list of site-loaded files.
161 (let (site-load-packages)
162 (load site-file-list t t)
163 (while site-load-packages
164 (let ((arg (car site-load-packages)))
165 (if (null (member arg processed))
167 (if (and (null docfile-out-of-date)
168 (file-newer-than-file-p arg docfile))
169 (setq docfile-out-of-date t))
170 (setq processed (cons arg processed)))))
171 (setq site-load-packages (cdr site-load-packages)))))
173 ;(let ((autoloads (packages-list-autoloads-path)))
174 ; ;; (print (concat "Autoloads: " (prin1-to-string autoloads)))
176 ; (let ((arg (car autoloads)))
177 ; (if (null (member arg processed))
180 ; (if (and (null docfile-out-of-date)
181 ; (file-newer-than-file-p arg docfile))
182 ; (setq docfile-out-of-date t))
183 ; (setq processed (cons arg processed))))
184 ; (setq autoloads (cdr autoloads)))))
186 ;; Now fire up make-docfile and we're done
188 (setq processed (nreverse processed))
190 ;; (print (prin1-to-string (append options processed)))
192 (if docfile-out-of-date
194 (princ "Spawning make-docfile ...")
195 ;; (print (prin1-to-string (append options processed)))
197 (setq exec-path (list (concat default-directory "../lib-src")))
199 ;; (locate-file-clear-hashing nil)
200 (if (memq system-type '(berkeley-unix next-mach))
201 ;; Suboptimal, but we have a unresolved bug somewhere in the
202 ;; low-level process code
203 (call-process-internal
212 (list (concat default-directory "../lib-src/make-docfile"))
215 ;; (print (prin1-to-string (append options processed)))
216 (apply 'call-process-internal
217 ;; (concat default-directory "../lib-src/make-docfile")
222 (append options processed)))
224 (princ "Spawning make-docfile ...done\n")
225 ;; (write-region-internal (point-min) (point-max) "/tmp/DOC")
227 (princ "DOC file is up to date\n"))
231 ;;; make-docfile.el ends here