Mercurial > hg > xemacs-beta

comparison lisp/make-docfile.el @ 1303:f99d3d25df86

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2003-02-15 10:15:54 by ben] autoload fixes, make-doc speed improvements Makefile.in.in: Run update-elc-2 with -no-autoloads to avoid multiple autoload-loading problem. configure.usage: Document quick-build better. make-docfile.el: Use `message' (defined in this file) in place of `princ'/`print', and put in a terpri, so that we get correct newline behavior. Rewrite if-progn -> when and a few similar stylistic niceties. And the big change: Allow MS Windows to specify the object files directly and frob them into C files here (formerly this was done in xemacs.mak, and very slooooooooooooooooooowly). Due to line-length limitations in CMD, we need to use a "response file" to hold the arguments, so when we see a response file argument (preceded by an @), read in the args (a bit of trickiness to do this), and process recursively. Also frob .obj -> .c as mentioned earlier and handle other junk dependencies that need to be removed (NEEDTODUMP, make-docfile.exe). update-elc-2.el: Use :test `equal' in call to set-difference. update-elc.el: Put back commented out kill-emacs, update header comment. xemacs.mak: Delete old unused code that checks SATISFIED. Move update-elc-2 up to be near update-elc. Run update-elc-2 with -no-autoloads to avoid multiple autoload-loading problem. Don't compute make-docfile args ourselves. Pass the raw objects to make-docfile.el, which does the computation (much faster than we could). Don't delete the DOC file, split the invocation into two calls to make-docfile.exe (one direct, one through make-docfile.el), etc. In general, all we do is call make-docfile. Add proper dependencies for DOC-file rebuilding so it doesn't get done when not necessary. Implement quick-building here: not building the DOC file unless it doesn't exist, as the quick-build docs say. Makefile.in.in: Don't delete the DOC file. Implement quick-building here: not building the DOC file unless it doesn't exist, as the quick-build docs say. config.h.in, emacs.c: Nothing but niggly spacing changes -- one space before a paren starting a function-call arglist, please.
author ben
date Sat, 15 Feb 2003 10:16:14 +0000
parents 465bd3c7d932
children 70921960b980
comparison
equal deleted inserted replaced
1302:781dc6d5baba 1303:f99d3d25df86
1 ;;; make-docfile.el --- Cache docstrings in external file 1 ;;; make-docfile.el --- Cache docstrings in external file
2 2
3 ;; Copyright (C) 1985, 1986, 1992-1995, 1997 Free Software Foundation, Inc. 3 ;; Copyright (C) 1985, 1986, 1992-1995, 1997 Free Software Foundation, Inc.
4 ;; Copyright (C) 2002 Ben Wing. 4 ;; Copyright (C) 2002, 2003 Ben Wing.
5 5
6 ;; Author: Unknown 6 ;; Author: Unknown
7 ;; Maintainer: Steven L Baur <steve@xemacs.org> 7 ;; Maintainer: Steven L Baur <steve@xemacs.org>
8 ;; Keywords: internal 8 ;; Keywords: internal
9 9
42 (defvar processed nil) 42 (defvar processed nil)
43 (defvar docfile nil) 43 (defvar docfile nil)
44 (defvar docfile-buffer nil) 44 (defvar docfile-buffer nil)
45 (defvar site-file-list nil) 45 (defvar site-file-list nil)
46 (defvar docfile-out-of-date nil) 46 (defvar docfile-out-of-date nil)
47
48 (defun message (fmt &rest args)
49 (princ (apply #'format fmt args))
50 (terpri))
47 51
48 ;; Gobble up the stuff we don't wish to pass on. 52 ;; Gobble up the stuff we don't wish to pass on.
49 (setq command-line-args (cdr (cdr (cdr (cdr command-line-args))))) 53 (setq command-line-args (cdr (cdr (cdr (cdr command-line-args)))))
50 54
51 ;; First gather up the command line options. 55 ;; First gather up the command line options.
64 (t (setq done t))) 68 (t (setq done t)))
65 (if (null done) 69 (if (null done)
66 (setq command-line-args (cdr (cdr command-line-args))))))) 70 (setq command-line-args (cdr (cdr command-line-args)))))))
67 (setq options (nreverse options)) 71 (setq options (nreverse options))
68 72
69 ;; (print (concat "Options: " (prin1-to-string options))) 73 ;; (message (concat "Options: " (prin1-to-string options)))
74
75 ;; insert-file-contents-internal calls out to `format-decode' afterwards,
76 ;; so it must be defined. if non-zero, it tries to be a bunch more stuff
77 ;; so say, "NOOOOOOOOOOOOO! Basta! Ca soufit! Enough, already, OK?"
78 (defun format-decode (fuck me harder) 0)
70 79
71 ;; Next process the list of C files. 80 ;; Next process the list of C files.
72 (while command-line-args 81 (defun process-args (args)
73 (let ((arg (car command-line-args))) 82 (while args
74 (if (null (member arg processed)) 83 (let ((arg (car args)))
75 (progn 84 ;; When called from xemacs.mak, we need to do some frobbing on the
85 ;; args given to us -- remove NEEDTODUMP and make-docfile.exe,
86 ;; convert .obj files into .c files in the source directory,
87 ;; handle response files (beginning with @, specifying arguments),
88 ;; due to line-length limitations in the shell.
89 (if (string-match "^@" arg)
90 ;; MS Windows response file
91 ;; no generate-new-buffer so use its implementation.
92 (let ((buf (get-buffer-create (generate-new-buffer-name "foo"))))
93 (set-buffer buf)
94 (insert-file-contents-internal (substring arg 1))
95 ;; now majorly grind up the response file.
96 ;; backslashes get doubled, quotes around strings,
97 ;; get rid of pesky CR's and NL's, and put parens around
98 ;; the whole thing so we have a valid list of strings.
99 (goto-char (point-max))
100 (insert "\")")
101 (goto-char (point-min))
102 (insert "(\"")
103 (while (search-forward "\\" nil t)
104 (replace-match "\\\\" nil t))
105 (goto-char (point-min))
106 (while (search-forward "\n" nil t)
107 (replace-match "" nil t))
108 (goto-char (point-min))
109 (while (search-forward "\r" nil t)
110 (replace-match "" nil t))
111 (goto-char (point-min))
112 (while (search-forward " " nil t)
113 (replace-match "\" \"" nil t))
114 (goto-char (point-min))
115 (process-args (read buf)))
116 ;; remove NEEDTODUMP and make-docfile.exe, convert .obj files into
117 ;; .c files in the source directory.
118 (when (and (not (string-match "\\(NEEDTODUMP\\|\\.exe$\\)" arg))
119 (not (member arg processed)))
120 (when (string-match "\\(.*\\)\\.obj$" arg)
121 (setq arg (concat (file-name-nondirectory
122 ;; no match-string so use its implementation.
123 (substring arg (match-beginning 1)
124 (match-end 1)))
125 ".c")))
76 (if (and (null docfile-out-of-date) 126 (if (and (null docfile-out-of-date)
77 (file-newer-than-file-p arg docfile)) 127 (file-newer-than-file-p arg docfile))
78 (setq docfile-out-of-date t)) 128 (setq docfile-out-of-date t))
79 (setq processed (cons arg processed))))) 129 (setq processed (cons arg processed))))
80 (setq command-line-args (cdr command-line-args))) 130 (setq args (cdr args)))))
131
132 (process-args command-line-args)
81 133
82 ;; Then process the list of Lisp files. 134 ;; Then process the list of Lisp files.
83 (let ((build-root (expand-file-name ".." invocation-directory))) 135 (let ((build-root (expand-file-name ".." invocation-directory)))
84 (setq load-path (list (expand-file-name "lisp" build-root)))) 136 (setq load-path (list (expand-file-name "lisp" build-root))))
85 137
107 (let ((arg0 (packages-add-suffix (car preloaded-file-list))) 159 (let ((arg0 (packages-add-suffix (car preloaded-file-list)))
108 arg) 160 arg)
109 (setq arg (locate-library arg0)) 161 (setq arg (locate-library arg0))
110 (if (null arg) 162 (if (null arg)
111 (progn 163 (progn
112 (princ (format "Error: dumped file %s does not exist\n" arg0)) 164 (message "Error: dumped file %s does not exist" arg0)
113 ;; Uncomment in case of difficulties 165 ;; Uncomment in case of difficulties
114 ;;(print (format "late-packages: %S" late-packages)) 166 ;;(message "late-packages: %S" late-packages)
115 ;;(print (format "guessed-roots: %S" (paths-find-emacs-roots invocation-directory invocation-name #'paths-emacs-root-p))) 167 ;;(message "guessed-roots: %S" (paths-find-emacs-roots invocation-directory invocation-name #'paths-emacs-root-p))
116 ;;(print (format "guessed-data-roots: %S" (paths-find-emacs-roots invocation-directory invocation-name #'paths-emacs-data-root-p))) 168 ;;(message "guessed-data-roots: %S" (paths-find-emacs-roots invocation-directory invocation-name #'paths-emacs-data-root-p))
117 ) 169 )
118 (if (null (member arg processed)) 170 (if (null (member arg processed))
119 (progn 171 (progn
120 (if (and (null docfile-out-of-date) 172 (if (and (null docfile-out-of-date)
121 (file-newer-than-file-p arg docfile)) 173 (file-newer-than-file-p arg docfile))
136 (setq docfile-out-of-date t)) 188 (setq docfile-out-of-date t))
137 (setq processed (cons arg processed))))) 189 (setq processed (cons arg processed)))))
138 (setq site-load-packages (cdr site-load-packages))))) 190 (setq site-load-packages (cdr site-load-packages)))))
139 191
140 ;(let ((autoloads (packages-list-autoloads-path))) 192 ;(let ((autoloads (packages-list-autoloads-path)))
141 ; ;; (print (concat "Autoloads: " (prin1-to-string autoloads))) 193 ; ;; (message (concat "Autoloads: " (prin1-to-string autoloads)))
142 ; (while autoloads 194 ; (while autoloads
143 ; (let ((arg (car autoloads))) 195 ; (let ((arg (car autoloads)))
144 ; (if (null (member arg processed)) 196 ; (if (null (member arg processed))
145 ; (progn 197 ; (progn
146 ; ;; (print arg) 198 ; ;; (message arg)
147 ; (if (and (null docfile-out-of-date) 199 ; (if (and (null docfile-out-of-date)
148 ; (file-newer-than-file-p arg docfile)) 200 ; (file-newer-than-file-p arg docfile))
149 ; (setq docfile-out-of-date t)) 201 ; (setq docfile-out-of-date t))
150 ; (setq processed (cons arg processed)))) 202 ; (setq processed (cons arg processed))))
151 ; (setq autoloads (cdr autoloads))))) 203 ; (setq autoloads (cdr autoloads)))))
152 204
153 ;; Now fire up make-docfile and we're done 205 ;; Now fire up make-docfile and we're done
154 206
155 (setq processed (nreverse processed)) 207 (setq processed (nreverse processed))
156 208
157 ;; (print (prin1-to-string (append options processed))) 209 (terpri)
158 210
159 (if docfile-out-of-date 211 ;(message (prin1-to-string (append options processed)))
160 (progn 212
161 (princ "Spawning make-docfile ...") 213 (when docfile-out-of-date
162 ;; (print (prin1-to-string (append options processed))) 214 (condition-case nil
163 215 (delete-file docfile)
164 (setq exec-path (list (concat default-directory "../lib-src"))) 216 (error nil))
165 217 (message "Spawning make-docfile ...")
166 ;; (locate-file-clear-hashing nil) 218 ;; (message (prin1-to-string (append options processed)))
167 (if (memq system-type '(berkeley-unix next-mach)) 219
168 ;; Suboptimal, but we have a unresolved bug somewhere in the 220 (setq exec-path (list (concat default-directory "../lib-src")))
169 ;; low-level process code. #### Now that we've switched to using 221
170 ;; the regular asynch process code, we should try removing this. 222 ;; (locate-file-clear-hashing nil)
171 (call-process-internal 223 (if (memq system-type '(berkeley-unix next-mach))
172 "/bin/csh" 224 ;; Suboptimal, but we have a unresolved bug somewhere in the
225 ;; low-level process code. #### Now that we've switched to using
226 ;; the regular asynch process code, we should try removing this.
227 (call-process-internal
228 "/bin/csh"
229 nil
230 t
231 nil
232 "-fc"
233 (mapconcat
234 #'identity
235 (append
236 (list (concat default-directory "../lib-src/make-docfile"))
237 options processed)
238 " "))
239 ;; (message (prin1-to-string (append options processed)))
240 (apply 'call-process-internal
241 ;; (concat default-directory "../lib-src/make-docfile")
242 "make-docfile"
173 nil 243 nil
174 t 244 t
175 nil 245 nil
176 "-fc" 246 (append options processed)))
177 (mapconcat 247
178 #'identity 248 (message "Spawning make-docfile ...done")
179 (append 249 ;; (write-region-internal (point-min) (point-max) "/tmp/DOC")
180 (list (concat default-directory "../lib-src/make-docfile")) 250 )
181 options processed) 251 (message "DOC file is up to date")
182 " "))
183 ;; (print (prin1-to-string (append options processed)))
184 (apply 'call-process-internal
185 ;; (concat default-directory "../lib-src/make-docfile")
186 "make-docfile"
187 nil
188 t
189 nil
190 (append options processed)))
191
192 (princ "Spawning make-docfile ...done\n")
193 ;; (write-region-internal (point-min) (point-max) "/tmp/DOC")
194 )
195 (princ "DOC file is up to date\n"))
196 252
197 (kill-emacs) 253 (kill-emacs)
198 254
199 ;;; make-docfile.el ends here 255 ;;; make-docfile.el ends here