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 XEmacs.
  10
  11 ;; XEmacs is free software; you can redistribute it and/or modify it
  12 ;; under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 2, or (at your option)
  14 ;; any later version.
  15
  16 ;; XEmacs is distributed in the hope that it will be useful, but
  17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  19 ;; General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  23 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
  24 ;; 02111-1307, USA.
  25
  26 ;;; Synched up with: Not in FSF
  27
  28 ;;; Commentary:
  29
  30 ;; This is a front-end to the make-docfile program that gathers up all the
  31 ;; lisp files that will be dumped with XEmacs.  It would probably be best
  32 ;; to just move make-docfile.c completely to lisp and be done with it.
  33
  34 ;;; Code:
  35
  36 (defvar options nil)
  37 (defvar processed nil)
  38 (defvar docfile nil)
  39 (defvar docfile-buffer nil)
  40 (defvar site-file-list nil)
  41 (defvar docfile-out-of-date nil)
  42
  43 ;; Gobble up the stuff we don't wish to pass on.
  44 (setq command-line-args (cdr (cdr (cdr (cdr command-line-args)))))
  45
  46 ;; First gather up the command line options.
  47 (let (done)
  48   (while (and (null done) command-line-args)
  49     (let ((arg (car command-line-args)))
  50       (cond ((or (string-equal arg "-o") ; Specify DOC file name
  51                  (string-equal arg "-a") ; Append to DOC file
  52                  (string-equal arg "-d")) ; Set working directory
  53              (if (string-equal arg "-o")
  54                  (setq docfile (expand-file-name (car (cdr command-line-args)))))
  55              (setq options (cons arg options))
  56              (setq options (cons (expand-file-name (car (cdr command-line-args))) options)))
  57             ((string-equal arg "-i") ; Set site files to scan
  58              (setq site-file-list (car (cdr command-line-args))))
  59             (t (setq done t)))
  60       (if (null done)
  61           (setq command-line-args (cdr (cdr command-line-args)))))))
  62 (setq options (nreverse options))
  63
  64 ;; (print (concat "Options: " (prin1-to-string options)))
  65
  66 ;; Next process the list of C files.
  67 (while command-line-args
  68   (let ((arg (car command-line-args)))
  69     (if (null (member arg processed))
  70         (progn
  71           (if (and (null docfile-out-of-date)
  72                    (file-newer-than-file-p arg docfile))
  73               (setq docfile-out-of-date t))
  74           (setq processed (cons arg processed)))))
  75   (setq command-line-args (cdr command-line-args)))
  76
  77 ;; Then process the list of Lisp files.
  78 (let ((build-root (expand-file-name ".." invocation-directory)))
  79   (setq load-path (list (expand-file-name "lisp" build-root))))
  80
  81 (load "very-early-lisp" nil t)
  82
  83 ;; Then process the autoloads
  84 (setq autoload-file-name "auto-autoloads.elc")
  85 (load "find-paths.el")
  86 (load "packages.el")
  87 (load "setup-paths.el")
  88 (load "dump-paths.el")
  89 (require 'custom)
  90 (load "process")
  91
  92 (let (preloaded-file-list)
  93   (load (expand-file-name "../lisp/dumped-lisp.el"))
  94
  95   (let ((package-preloaded-file-list
  96          (packages-collect-package-dumped-lisps late-package-load-path)))
  97
  98     (setq preloaded-file-list
  99           (append package-preloaded-file-list
 100                   preloaded-file-list
 101                   packages-hardcoded-lisp)))
 102
 103   (while preloaded-file-list
 104     (let ((arg0 (packages-add-suffix (car preloaded-file-list)))
 105           arg)
 106       (setq arg (locate-library arg0))
 107       (if (null arg)
 108           (progn
 109           (princ (format "Error:  dumped file %s does not exist\n" arg0))
 110           ;; Uncomment in case of difficulties
 111           ;;(print (format "late-packages: %S" late-packages))
 112           ;;(print (format "guessed-roots: %S" (paths-find-emacs-roots invocation-directory invocation-name)))
 113           )
 114         (if (null (member arg processed))
 115             (progn
 116               (if (and (null docfile-out-of-date)
 117                        (file-newer-than-file-p arg docfile))
 118                   (setq docfile-out-of-date t))
 119               (setq processed (cons arg processed)))))
 120       (setq preloaded-file-list (cdr preloaded-file-list)))))
 121
 122 ;; Finally process the list of site-loaded files.
 123 (if site-file-list
 124     (let (site-load-packages)
 125       (load site-file-list t t)
 126       (while site-load-packages
 127         (let ((arg (car site-load-packages)))
 128           (if (null (member arg processed))
 129               (progn
 130                 (if (and (null docfile-out-of-date)
 131                          (file-newer-than-file-p arg docfile))
 132                     (setq docfile-out-of-date t))
 133                 (setq processed (cons arg processed)))))
 134         (setq site-load-packages (cdr site-load-packages)))))
 135
 136 ;(let ((autoloads (packages-list-autoloads-path)))
 137 ;  ;; (print (concat "Autoloads: " (prin1-to-string autoloads)))
 138 ;  (while autoloads
 139 ;    (let ((arg (car autoloads)))
 140 ;      (if (null (member arg processed))
 141 ;         (progn
 142 ;           ;; (print arg)
 143 ;           (if (and (null docfile-out-of-date)
 144 ;                    (file-newer-than-file-p arg docfile))
 145 ;               (setq docfile-out-of-date t))
 146 ;           (setq processed (cons arg processed))))
 147 ;      (setq autoloads (cdr autoloads)))))
 148
 149 ;; Now fire up make-docfile and we're done
 150
 151 (setq processed (nreverse processed))
 152
 153 ;; (print (prin1-to-string (append options processed)))
 154
 155 (if docfile-out-of-date
 156     (progn
 157       (princ "Spawning make-docfile ...")
 158       ;; (print (prin1-to-string (append options processed)))
 159
 160       (setq exec-path (list (concat default-directory "../lib-src")))
 161
 162       ;; (locate-file-clear-hashing nil)
 163       (if (memq system-type '(berkeley-unix next-mach))
 164           ;; Suboptimal, but we have a unresolved bug somewhere in the
 165           ;; low-level process code
 166           (call-process-internal
 167            "/bin/csh"
 168            nil
 169            t
 170            nil
 171            "-fc"
 172            (mapconcat
 173             #'identity
 174             (append
 175              (list (concat default-directory "../lib-src/make-docfile"))
 176              options processed)
 177             " "))
 178         ;; (print (prin1-to-string (append options processed)))
 179         (apply 'call-process-internal
 180                ;; (concat default-directory "../lib-src/make-docfile")
 181                "make-docfile"
 182                nil
 183                t
 184                nil
 185                (append options processed)))
 186
 187       (princ "Spawning make-docfile ...done\n")
 188       ;; (write-region-internal (point-min) (point-max) "/tmp/DOC")
 189       )
 190   (princ "DOC file is up to date\n"))
 191
 192 (kill-emacs)
 193
 194 ;;; make-docfile.el ends here