Mercurial > hg > xemacs-beta
annotate lisp/make-docfile.el @ 4915:bedf3747a6d7
Use DOC for dumped Lisp file names; Xref to source-lisp if readable, symbol-file
lisp/ChangeLog addition:
2010-02-01 Aidan Kehoe <kehoea@parhasard.net>
* loadhist.el (symbol-file):
If #'built-in-symbol-file returns a Lisp file name, and
source-lisp is readable, construct a full pathname to include
that. Otherwise use lisp-directory, as we used to.
* loadup.el:
Delete load-history entries for those files in
preloaded-file-list; unloading the associated features makes very
little sense, and the symbol file information can be had from DOC.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Wed, 03 Feb 2010 00:20:08 +0000 |
| parents | ab9e8f0fb295 |
| children | 788c38f20376 |
| 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 | |
| 81 ;; insert-file-contents-internal calls out to `format-decode' afterwards, | |
| 1330 | 82 ;; so it must be defined. if non-zero, it tries to do a bunch more stuff |
| 1303 | 83 ;; so say, "NOOOOOOOOOOOOO! Basta! Ca soufit! Enough, already, OK?" |
| 84 (defun format-decode (fuck me harder) 0) | |
| 428 | 85 |
| 86 ;; Next process the list of C files. | |
| 1303 | 87 (defun process-args (args) |
| 88 (while args | |
| 89 (let ((arg (car args))) | |
| 90 ;; When called from xemacs.mak, we need to do some frobbing on the | |
| 91 ;; args given to us -- remove NEEDTODUMP and make-docfile.exe, | |
| 92 ;; convert .obj files into .c files in the source directory, | |
| 93 ;; handle response files (beginning with @, specifying arguments), | |
| 94 ;; due to line-length limitations in the shell. | |
| 95 (if (string-match "^@" arg) | |
| 96 ;; MS Windows response file | |
| 97 ;; no generate-new-buffer so use its implementation. | |
| 98 (let ((buf (get-buffer-create (generate-new-buffer-name "foo")))) | |
| 99 (set-buffer buf) | |
| 100 (insert-file-contents-internal (substring arg 1)) | |
| 101 ;; now majorly grind up the response file. | |
| 102 ;; backslashes get doubled, quotes around strings, | |
| 103 ;; get rid of pesky CR's and NL's, and put parens around | |
| 104 ;; the whole thing so we have a valid list of strings. | |
| 105 (goto-char (point-max)) | |
| 106 (insert "\")") | |
| 107 (goto-char (point-min)) | |
| 108 (insert "(\"") | |
| 109 (while (search-forward "\\" nil t) | |
| 110 (replace-match "\\\\" nil t)) | |
| 111 (goto-char (point-min)) | |
| 112 (while (search-forward "\n" nil t) | |
| 113 (replace-match "" nil t)) | |
| 114 (goto-char (point-min)) | |
| 115 (while (search-forward "\r" nil t) | |
| 116 (replace-match "" nil t)) | |
| 117 (goto-char (point-min)) | |
| 118 (while (search-forward " " nil t) | |
| 119 (replace-match "\" \"" nil t)) | |
| 120 (goto-char (point-min)) | |
| 121 (process-args (read buf))) | |
| 122 ;; remove NEEDTODUMP and make-docfile.exe, convert .obj files into | |
| 123 ;; .c files in the source directory. | |
| 124 (when (and (not (string-match "\\(NEEDTODUMP\\|\\.exe$\\)" arg)) | |
| 125 (not (member arg processed))) | |
| 126 (when (string-match "\\(.*\\)\\.obj$" arg) | |
| 1330 | 127 (setq arg (expand-file-name |
| 128 (concat | |
| 129 (file-name-nondirectory | |
| 130 ;; no match-string so use its implementation. | |
| 131 (substring arg (match-beginning 1) | |
| 132 (match-end 1))) | |
| 133 ".c") | |
| 134 source-src))) | |
| 428 | 135 (if (and (null docfile-out-of-date) |
| 136 (file-newer-than-file-p arg docfile)) | |
| 137 (setq docfile-out-of-date t)) | |
| 1303 | 138 (setq processed (cons arg processed)))) |
| 139 (setq args (cdr args))))) | |
| 140 | |
| 1330 | 141 ;; Then process the list of Lisp files. |
| 1303 | 142 (process-args command-line-args) |
| 428 | 143 |
| 1330 | 144 (setq load-path (list source-lisp)) |
| 428 | 145 |
| 146 ;; Then process the autoloads | |
| 147 (setq autoload-file-name "auto-autoloads.elc") | |
| 1333 | 148 (defvar custom-declare-variable-list nil) ; unclean |
| 428 | 149 (load "find-paths.el") |
| 150 (load "packages.el") | |
| 151 (load "setup-paths.el") | |
| 1261 | 152 (load "raw-process.el") |
| 428 | 153 |
|
4547
ab9e8f0fb295
Check absolute source file names against DOC with #'file-newer-than-file-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4539
diff
changeset
|
154 (let (preloaded-file-list arg0 arg package-preloaded-file-list absolute) |
| 1330 | 155 (load (expand-file-name "dumped-lisp.el" source-lisp)) |
| 428 | 156 |
|
4539
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3511
diff
changeset
|
157 (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
|
158 (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
|
159 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
|
160 (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
|
161 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 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
|
163 |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3511
diff
changeset
|
164 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
|
165 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
|
166 ;; 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
|
167 processed (cons "loadup.el" processed)) |
| 428 | 168 |
| 169 (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
|
170 (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
|
171 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
|
172 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
|
173 (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
|
174 (progn |
| 1303 | 175 (message "Error: dumped file %s does not exist" arg0) |
| 428 | 176 ;; 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
|
177 ;(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
|
178 ; 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
|
179 ;(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
|
180 ; invocation-directory |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3511
diff
changeset
|
181 ; invocation-name |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3511
diff
changeset
|
182 ; #'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
|
183 ;(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
|
184 ; invocation-directory |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3511
diff
changeset
|
185 ; invocation-name |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3511
diff
changeset
|
186 ; #'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
|
187 ) |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3511
diff
changeset
|
188 (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
|
189 ;; 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
|
190 ;; 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
|
191 (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
|
192 (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
|
193 (progn |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3511
diff
changeset
|
194 (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
|
195 ;; 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
|
196 (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
|
197 (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
|
198 (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
|
199 (setq preloaded-file-list (cdr preloaded-file-list)))) |
| 428 | 200 |
| 201 ;; Finally process the list of site-loaded files. | |
| 202 (if site-file-list | |
| 203 (let (site-load-packages) | |
| 204 (load site-file-list t t) | |
| 205 (while site-load-packages | |
| 206 (let ((arg (car site-load-packages))) | |
| 207 (if (null (member arg processed)) | |
| 208 (progn | |
| 209 (if (and (null docfile-out-of-date) | |
| 210 (file-newer-than-file-p arg docfile)) | |
| 211 (setq docfile-out-of-date t)) | |
| 212 (setq processed (cons arg processed))))) | |
| 213 (setq site-load-packages (cdr site-load-packages))))) | |
| 214 | |
| 215 ;(let ((autoloads (packages-list-autoloads-path))) | |
| 1303 | 216 ; ;; (message (concat "Autoloads: " (prin1-to-string autoloads))) |
| 428 | 217 ; (while autoloads |
| 218 ; (let ((arg (car autoloads))) | |
| 219 ; (if (null (member arg processed)) | |
| 220 ; (progn | |
| 1303 | 221 ; ;; (message arg) |
| 428 | 222 ; (if (and (null docfile-out-of-date) |
| 223 ; (file-newer-than-file-p arg docfile)) | |
| 224 ; (setq docfile-out-of-date t)) | |
| 225 ; (setq processed (cons arg processed)))) | |
| 226 ; (setq autoloads (cdr autoloads))))) | |
| 227 | |
| 228 ;; Now fire up make-docfile and we're done | |
| 229 | |
| 230 (setq processed (nreverse processed)) | |
| 231 | |
| 1303 | 232 (terpri) |
| 233 | |
| 234 ;(message (prin1-to-string (append options processed))) | |
| 428 | 235 |
| 1303 | 236 (when docfile-out-of-date |
| 237 (condition-case nil | |
| 238 (delete-file docfile) | |
| 239 (error nil)) | |
| 240 (message "Spawning make-docfile ...") | |
| 241 ;; (message (prin1-to-string (append options processed))) | |
| 242 | |
| 1330 | 243 (setq exec-path (list build-lib-src)) |
| 428 | 244 |
| 1303 | 245 ;; (locate-file-clear-hashing nil) |
| 246 (if (memq system-type '(berkeley-unix next-mach)) | |
| 247 ;; Suboptimal, but we have a unresolved bug somewhere in the | |
| 248 ;; low-level process code. #### Now that we've switched to using | |
| 249 ;; the regular asynch process code, we should try removing this. | |
| 250 (call-process-internal | |
| 251 "/bin/csh" | |
| 252 nil | |
| 253 t | |
| 254 nil | |
| 255 "-fc" | |
| 256 (mapconcat | |
| 257 #'identity | |
| 258 (append | |
| 1330 | 259 (list (expand-file-name "make-docfile" build-lib-src)) |
| 1303 | 260 options processed) |
| 261 " ")) | |
| 262 ;; (message (prin1-to-string (append options processed))) | |
| 263 (apply 'call-process-internal | |
| 1330 | 264 ;; exec-path is set. |
| 265 ;; (expand-file-name "make-docfile" build-lib-src) | |
| 1303 | 266 "make-docfile" |
| 428 | 267 nil |
| 268 t | |
| 269 nil | |
| 1303 | 270 (append options processed))) |
| 428 | 271 |
| 1303 | 272 (message "Spawning make-docfile ...done") |
| 273 ;; (write-region-internal (point-min) (point-max) "/tmp/DOC") | |
| 274 ) | |
| 428 | 275 |
| 276 (kill-emacs) | |
| 277 | |
| 278 ;;; make-docfile.el ends here |