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