Mercurial > hg > xemacs-beta
annotate lisp/make-docfile.el @ 5086:47bcef7b0b44
Print multiple values with #<INTERNAL OBJECT (XEmacs bug?) ...>, too
2010-03-02 Aidan Kehoe <kehoea@parhasard.net>
* eval.c (print_multiple_value):
Say #<INTERNAL OBJECT (XEmacs bug?) ...> when printing these, for
consistency with the rest of the print code.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Tue, 02 Mar 2010 13:20:51 +0000 |
| parents | 788c38f20376 |
| children | e402e3506a53 |
| rev | line source |
|---|---|
| 428 | 1 ;;; make-docfile.el --- Cache docstrings in external file |
| 2 | |
| 3 ;; Copyright (C) 1985, 1986, 1992-1995, 1997 Free Software Foundation, Inc. | |
| 1303 | 4 ;; Copyright (C) 2002, 2003 Ben Wing. |
| 428 | 5 |
| 6 ;; Author: Unknown | |
| 1330 | 7 ;; Maintainer: XEmacs Development Team |
| 428 | 8 ;; Keywords: internal |
| 9 | |
| 10 ;; This file is part of XEmacs. | |
| 11 | |
| 12 ;; XEmacs is free software; you can redistribute it and/or modify it | |
| 13 ;; under the terms of the GNU General Public License as published by | |
| 14 ;; the Free Software Foundation; either version 2, or (at your option) | |
| 15 ;; any later version. | |
| 16 | |
| 17 ;; XEmacs is distributed in the hope that it will be useful, but | |
| 18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
| 20 ;; General Public License for more details. | |
| 21 | |
| 22 ;; You should have received a copy of the GNU General Public License | |
| 23 ;; along with XEmacs; see the file COPYING. If not, write to the Free | |
| 24 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA | |
| 25 ;; 02111-1307, USA. | |
| 26 | |
| 27 ;;; Synched up with: Not in FSF | |
| 28 | |
| 29 ;;; Commentary: | |
| 30 | |
| 31 ;; This is a front-end to the make-docfile program that gathers up all the | |
| 32 ;; lisp files that will be dumped with XEmacs. It would probably be best | |
| 33 ;; to just move make-docfile.c completely to lisp and be done with it. | |
| 34 | |
| 35 ;;; Code: | |
| 36 | |
| 1261 | 37 ;; Help debug problems. |
| 38 (setq stack-trace-on-error t | |
| 39 load-always-display-messages t) | |
| 40 | |
| 428 | 41 (defvar options nil) |
| 42 (defvar processed nil) | |
| 43 (defvar docfile nil) | |
| 44 (defvar docfile-buffer nil) | |
| 45 (defvar site-file-list nil) | |
| 46 (defvar docfile-out-of-date nil) | |
| 47 | |
| 3511 | 48 (defvar build-directory (expand-file-name ".." invocation-directory)) |
| 49 (defvar build-lib-src (expand-file-name "lib-src" build-directory)) | |
| 1330 | 50 (defvar source-lisp (file-name-directory (expand-file-name |
| 51 (nth 2 command-line-args)))) | |
| 52 (defvar source-src (expand-file-name "../src" source-lisp)) | |
| 53 | |
| 1303 | 54 (defun message (fmt &rest args) |
| 55 (princ (apply #'format fmt args)) | |
| 56 (terpri)) | |
| 57 | |
| 428 | 58 ;; Gobble up the stuff we don't wish to pass on. |
| 59 (setq command-line-args (cdr (cdr (cdr (cdr command-line-args))))) | |
| 60 | |
| 61 ;; First gather up the command line options. | |
| 62 (let (done) | |
| 63 (while (and (null done) command-line-args) | |
| 64 (let ((arg (car command-line-args))) | |
| 65 (cond ((or (string-equal arg "-o") ; Specify DOC file name | |
| 66 (string-equal arg "-a") ; Append to DOC file | |
| 67 (string-equal arg "-d")) ; Set working directory | |
| 68 (if (string-equal arg "-o") | |
| 69 (setq docfile (expand-file-name (car (cdr command-line-args))))) | |
| 70 (setq options (cons arg options)) | |
| 71 (setq options (cons (expand-file-name (car (cdr command-line-args))) options))) | |
| 72 ((string-equal arg "-i") ; Set site files to scan | |
| 73 (setq site-file-list (car (cdr command-line-args)))) | |
| 74 (t (setq done t))) | |
| 75 (if (null done) | |
| 76 (setq command-line-args (cdr (cdr command-line-args))))))) | |
| 77 (setq options (nreverse options)) | |
| 78 | |
| 1303 | 79 ;; (message (concat "Options: " (prin1-to-string options))) |
| 80 | |
| 428 | 81 ;; Next process the list of C files. |
| 1303 | 82 (defun process-args (args) |
| 83 (while args | |
| 84 (let ((arg (car args))) | |
| 85 ;; When called from xemacs.mak, we need to do some frobbing on the | |
| 86 ;; args given to us -- remove NEEDTODUMP and make-docfile.exe, | |
| 87 ;; convert .obj files into .c files in the source directory, | |
| 88 ;; handle response files (beginning with @, specifying arguments), | |
| 89 ;; due to line-length limitations in the shell. | |
| 90 (if (string-match "^@" arg) | |
| 91 ;; MS Windows response file | |
| 92 ;; no generate-new-buffer so use its implementation. | |
| 93 (let ((buf (get-buffer-create (generate-new-buffer-name "foo")))) | |
| 94 (set-buffer buf) | |
| 95 (insert-file-contents-internal (substring arg 1)) | |
| 96 ;; now majorly grind up the response file. | |
| 97 ;; backslashes get doubled, quotes around strings, | |
| 98 ;; get rid of pesky CR's and NL's, and put parens around | |
| 99 ;; the whole thing so we have a valid list of strings. | |
| 100 (goto-char (point-max)) | |
| 101 (insert "\")") | |
| 102 (goto-char (point-min)) | |
| 103 (insert "(\"") | |
| 104 (while (search-forward "\\" nil t) | |
| 105 (replace-match "\\\\" nil t)) | |
| 106 (goto-char (point-min)) | |
| 107 (while (search-forward "\n" nil t) | |
| 108 (replace-match "" nil t)) | |
| 109 (goto-char (point-min)) | |
| 110 (while (search-forward "\r" nil t) | |
| 111 (replace-match "" nil t)) | |
| 112 (goto-char (point-min)) | |
| 113 (while (search-forward " " nil t) | |
| 114 (replace-match "\" \"" nil t)) | |
| 115 (goto-char (point-min)) | |
| 116 (process-args (read buf))) | |
| 117 ;; remove NEEDTODUMP and make-docfile.exe, convert .obj files into | |
| 118 ;; .c files in the source directory. | |
| 119 (when (and (not (string-match "\\(NEEDTODUMP\\|\\.exe$\\)" arg)) | |
| 120 (not (member arg processed))) | |
| 121 (when (string-match "\\(.*\\)\\.obj$" arg) | |
| 1330 | 122 (setq arg (expand-file-name |
| 123 (concat | |
| 124 (file-name-nondirectory | |
| 125 ;; no match-string so use its implementation. | |
| 126 (substring arg (match-beginning 1) | |
| 127 (match-end 1))) | |
| 128 ".c") | |
| 129 source-src))) | |
| 428 | 130 (if (and (null docfile-out-of-date) |
| 131 (file-newer-than-file-p arg docfile)) | |
| 132 (setq docfile-out-of-date t)) | |
| 1303 | 133 (setq processed (cons arg processed)))) |
| 134 (setq args (cdr args))))) | |
| 135 | |
| 1330 | 136 ;; Then process the list of Lisp files. |
| 1303 | 137 (process-args command-line-args) |
| 428 | 138 |
| 1330 | 139 (setq load-path (list source-lisp)) |
| 428 | 140 |
| 141 ;; Then process the autoloads | |
| 142 (setq autoload-file-name "auto-autoloads.elc") | |
| 1333 | 143 (defvar custom-declare-variable-list nil) ; unclean |
| 428 | 144 (load "find-paths.el") |
| 145 (load "packages.el") | |
| 146 (load "setup-paths.el") | |
| 1261 | 147 (load "raw-process.el") |
| 428 | 148 |
|
4547
ab9e8f0fb295
Check absolute source file names against DOC with #'file-newer-than-file-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4539
diff
changeset
|
149 (let (preloaded-file-list arg0 arg package-preloaded-file-list absolute) |
| 1330 | 150 (load (expand-file-name "dumped-lisp.el" source-lisp)) |
| 428 | 151 |
|
4539
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3511
diff
changeset
|
152 (setq package-preloaded-file-list |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3511
diff
changeset
|
153 (packages-collect-package-dumped-lisps late-package-load-path) |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3511
diff
changeset
|
154 preloaded-file-list |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3511
diff
changeset
|
155 (append package-preloaded-file-list |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3511
diff
changeset
|
156 preloaded-file-list |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3511
diff
changeset
|
157 packages-hardcoded-lisp) |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3511
diff
changeset
|
158 |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3511
diff
changeset
|
159 processed (cons "-d" processed) |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3511
diff
changeset
|
160 processed (cons source-lisp processed) |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3511
diff
changeset
|
161 ;; Include loadup.el, which is never in preloaded-file-list: |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3511
diff
changeset
|
162 processed (cons "loadup.el" processed)) |
| 428 | 163 |
| 164 (while preloaded-file-list | |
|
4539
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3511
diff
changeset
|
165 (setq arg0 (packages-add-suffix (car preloaded-file-list)) |
|
4547
ab9e8f0fb295
Check absolute source file names against DOC with #'file-newer-than-file-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4539
diff
changeset
|
166 arg (locate-library arg0) |
|
ab9e8f0fb295
Check absolute source file names against DOC with #'file-newer-than-file-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4539
diff
changeset
|
167 absolute arg) |
|
4539
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3511
diff
changeset
|
168 (if (null arg) |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3511
diff
changeset
|
169 (progn |
| 1303 | 170 (message "Error: dumped file %s does not exist" arg0) |
| 428 | 171 ;; Uncomment in case of difficulties |
|
4539
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3511
diff
changeset
|
172 ;(message "late-package-hierarchies: %S" |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3511
diff
changeset
|
173 ; late-package-hierarchies) |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3511
diff
changeset
|
174 ;(message "guessed-roots: %S" (paths-find-emacs-roots |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3511
diff
changeset
|
175 ; invocation-directory |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3511
diff
changeset
|
176 ; invocation-name |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3511
diff
changeset
|
177 ; #'paths-emacs-root-p)) |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3511
diff
changeset
|
178 ;(message "guessed-data-roots: %S" (paths-find-emacs-roots |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3511
diff
changeset
|
179 ; invocation-directory |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3511
diff
changeset
|
180 ; invocation-name |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3511
diff
changeset
|
181 ; #'paths-emacs-data-root-p)) |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3511
diff
changeset
|
182 ) |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3511
diff
changeset
|
183 (when (equal arg (expand-file-name arg0 source-lisp)) |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3511
diff
changeset
|
184 ;; Use relative paths where possible, since this makes file lookup |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3511
diff
changeset
|
185 ;; in an installed XEmacs easier: |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3511
diff
changeset
|
186 (setq arg arg0)) |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3511
diff
changeset
|
187 (if (null (member arg processed)) |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3511
diff
changeset
|
188 (progn |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3511
diff
changeset
|
189 (if (and (null docfile-out-of-date) |
|
4547
ab9e8f0fb295
Check absolute source file names against DOC with #'file-newer-than-file-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4539
diff
changeset
|
190 ;; We need to check the absolute path here: |
|
ab9e8f0fb295
Check absolute source file names against DOC with #'file-newer-than-file-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4539
diff
changeset
|
191 (file-newer-than-file-p absolute docfile)) |
|
4539
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3511
diff
changeset
|
192 (setq docfile-out-of-date t)) |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3511
diff
changeset
|
193 (setq processed (cons arg processed))))) |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3511
diff
changeset
|
194 (setq preloaded-file-list (cdr preloaded-file-list)))) |
| 428 | 195 |
| 196 ;; Finally process the list of site-loaded files. | |
| 197 (if site-file-list | |
| 198 (let (site-load-packages) | |
| 199 (load site-file-list t t) | |
| 200 (while site-load-packages | |
| 201 (let ((arg (car site-load-packages))) | |
| 202 (if (null (member arg processed)) | |
| 203 (progn | |
| 204 (if (and (null docfile-out-of-date) | |
| 205 (file-newer-than-file-p arg docfile)) | |
| 206 (setq docfile-out-of-date t)) | |
| 207 (setq processed (cons arg processed))))) | |
| 208 (setq site-load-packages (cdr site-load-packages))))) | |
| 209 | |
| 210 ;(let ((autoloads (packages-list-autoloads-path))) | |
| 1303 | 211 ; ;; (message (concat "Autoloads: " (prin1-to-string autoloads))) |
| 428 | 212 ; (while autoloads |
| 213 ; (let ((arg (car autoloads))) | |
| 214 ; (if (null (member arg processed)) | |
| 215 ; (progn | |
| 1303 | 216 ; ;; (message arg) |
| 428 | 217 ; (if (and (null docfile-out-of-date) |
| 218 ; (file-newer-than-file-p arg docfile)) | |
| 219 ; (setq docfile-out-of-date t)) | |
| 220 ; (setq processed (cons arg processed)))) | |
| 221 ; (setq autoloads (cdr autoloads))))) | |
| 222 | |
| 223 ;; Now fire up make-docfile and we're done | |
| 224 | |
| 225 (setq processed (nreverse processed)) | |
| 226 | |
| 1303 | 227 (terpri) |
| 228 | |
| 229 ;(message (prin1-to-string (append options processed))) | |
| 428 | 230 |
| 1303 | 231 (when docfile-out-of-date |
| 232 (condition-case nil | |
| 233 (delete-file docfile) | |
| 234 (error nil)) | |
| 235 (message "Spawning make-docfile ...") | |
| 236 ;; (message (prin1-to-string (append options processed))) | |
| 237 | |
| 1330 | 238 (setq exec-path (list build-lib-src)) |
| 428 | 239 |
| 1303 | 240 ;; (locate-file-clear-hashing nil) |
| 241 (if (memq system-type '(berkeley-unix next-mach)) | |
| 242 ;; Suboptimal, but we have a unresolved bug somewhere in the | |
| 243 ;; low-level process code. #### Now that we've switched to using | |
| 244 ;; the regular asynch process code, we should try removing this. | |
| 245 (call-process-internal | |
| 246 "/bin/csh" | |
| 247 nil | |
| 248 t | |
| 249 nil | |
| 250 "-fc" | |
| 251 (mapconcat | |
| 252 #'identity | |
| 253 (append | |
| 1330 | 254 (list (expand-file-name "make-docfile" build-lib-src)) |
| 1303 | 255 options processed) |
| 256 " ")) | |
| 257 ;; (message (prin1-to-string (append options processed))) | |
| 258 (apply 'call-process-internal | |
| 1330 | 259 ;; exec-path is set. |
| 260 ;; (expand-file-name "make-docfile" build-lib-src) | |
| 1303 | 261 "make-docfile" |
| 428 | 262 nil |
| 263 t | |
| 264 nil | |
| 1303 | 265 (append options processed))) |
| 428 | 266 |
| 1303 | 267 (message "Spawning make-docfile ...done") |
| 268 ;; (write-region-internal (point-min) (point-max) "/tmp/DOC") | |
| 269 ) | |
| 428 | 270 |
| 271 (kill-emacs) | |
| 272 | |
| 273 ;;; make-docfile.el ends here |