cgit.sxemacs.org Git - sxemacs/blob - lisp/make-docfile.el

   1 ;;; make-docfile.el --- Cache docstrings in external file
   2
   3 ;; Copyright (C) 1985, 1986, 1992-1995, 1997 Free Software Foundation, Inc.
   4
   5 ;; Author: Unknown
   6 ;; Maintainer: Steven L Baur <steve@xemacs.org>
   7 ;; Keywords: internal
   8
   9 ;; This file is part of SXEmacs.
  10
  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.
  15
  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.
  20
  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/>.
  23
  24 ;;; Synched up with: Not in FSF
  25
  26 ;;; Commentary:
  27
  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.
  31
  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
  35 ;;; real fix. --SY.
  36
  37 ;;; Code:
  38
  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
  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))
  50
  51 (defun message (fmt &rest args)
  52   (princ (apply #'format fmt args))
  53   (terpri))
  54
  55 ;; Gobble up the stuff we don't wish to pass on.
  56 (setq command-line-args (cdr (cdr (cdr (cdr command-line-args)))))
  57
  58 ;; First gather up the command line options.
  59 (let (done)
  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))))
  71             (t (setq done t)))
  72       (if (null done)
  73           (setq command-line-args (cdr (cdr command-line-args)))))))
  74 (setq options (nreverse options))
  75
  76 ;; (print (concat "Options: " (prin1-to-string options)))
  77
  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))
  82         (progn
  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)))
  88
  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))))
  93
  94 (load "very-early-lisp" nil t)
  95
  96 ;; Then process the autoloads
  97 (setq autoload-file-name "auto-autoloads.elc")
  98 (load "find-paths.el")
  99 (load "packages.el")
 100 (load "setup-paths.el")
 101 (load "dump-paths.el")
 102 (load "bytecomp-runtime.el")
 103 (load "subr.el")
 104 (load "backquote.el")
 105 (load "replace.el")
 106 (load "version.el")
 107 (load "cl.el")
 108 (load "cl-extra.el")
 109 (require 'custom)
 110 (load "process")
 111
 112 (let (preloaded-file-list arg0 arg package-preloaded-file-list absolute)
 113   (load (expand-file-name "dumped-lisp.el" source-lisp))
 114
 115   (setq package-preloaded-file-list
 116         (packages-collect-package-dumped-lisps late-package-load-path)
 117         preloaded-file-list
 118         (append package-preloaded-file-list
 119                 preloaded-file-list
 120                 packages-hardcoded-lisp)
 121
 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))
 126
 127   (while preloaded-file-list
 128     (setq arg0 (packages-add-suffix (car preloaded-file-list))
 129           arg (locate-library arg0)
 130           absolute arg)
 131     (if (null arg)
 132         (progn
 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
 139           ;                              invocation-name
 140           ;                              #'paths-emacs-root-p))
 141           ;(message "guessed-data-roots: %S" (paths-find-emacs-roots
 142           ;                                   invocation-directory
 143           ;                                   invocation-name
 144           ;                                   #'paths-emacs-data-root-p))
 145           )
 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:
 149         (setq arg arg0))
 150       (if (null (member arg processed))
 151           (progn
 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))))
 158
 159 ;; Finally process the list of site-loaded files.
 160 (if site-file-list
 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))
 166               (progn
 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)))))
 172
 173 ;(let ((autoloads (packages-list-autoloads-path)))
 174 ;  ;; (print (concat "Autoloads: " (prin1-to-string autoloads)))
 175 ;  (while autoloads
 176 ;    (let ((arg (car autoloads)))
 177 ;      (if (null (member arg processed))
 178 ;         (progn
 179 ;           ;; (print arg)
 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)))))
 185
 186 ;; Now fire up make-docfile and we're done
 187
 188 (setq processed (nreverse processed))
 189
 190 ;; (print (prin1-to-string (append options processed)))
 191
 192 (if docfile-out-of-date
 193     (progn
 194       (princ "Spawning make-docfile ...")
 195       ;; (print (prin1-to-string (append options processed)))
 196
 197       (setq exec-path (list (concat default-directory "../lib-src")))
 198
 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
 204            "/bin/csh"
 205            nil
 206            t
 207            nil
 208            "-fc"
 209            (mapconcat
 210             #'identity
 211             (append
 212              (list (concat default-directory "../lib-src/make-docfile"))
 213              options processed)
 214             " "))
 215         ;; (print (prin1-to-string (append options processed)))
 216         (apply 'call-process-internal
 217                ;; (concat default-directory "../lib-src/make-docfile")
 218                "make-docfile"
 219                nil
 220                t
 221                nil
 222                (append options processed)))
 223
 224       (princ "Spawning make-docfile ...done\n")
 225       ;; (write-region-internal (point-min) (point-max) "/tmp/DOC")
 226       )
 227   (princ "DOC file is up to date\n"))
 228
 229 (kill-emacs)
 230
 231 ;;; make-docfile.el ends here