git.chise.org Git - chise/xemacs-chise.git.1/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@altair.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 (car (cdr command-line-args))))
  55              (setq options (cons arg options))
  56              (setq options (cons (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 (setq load-path (split-path (getenv "EMACSBOOTSTRAPLOADPATH")))
  79
  80 (load "very-early-lisp" nil t)
  81
  82 ;; Then process the autoloads
  83 (setq autoload-file-name "auto-autoloads.elc")
  84 (setq source-directory (concat default-directory "../lisp"))
  85 ;; (print (concat "Source directory: " source-directory))
  86 (load "find-paths.el")
  87 (load "packages.el")
  88 (load "setup-paths.el")
  89 (load "dump-paths.el")
  90
  91 (setq
  92  load-path
  93  (nconc load-path (split-path (getenv "EMACSBOOTSTRAPLOADPATH"))))
  94
  95 (let (preloaded-file-list)
  96   (load (concat default-directory "../lisp/dumped-lisp.el"))
  97
  98   (let ((package-preloaded-file-list
  99          (packages-collect-package-dumped-lisps late-package-load-path)))
 100
 101     (setq preloaded-file-list
 102           (append package-preloaded-file-list
 103                   preloaded-file-list
 104                   packages-hardcoded-lisp)))
 105
 106   (while preloaded-file-list
 107     (let ((arg0 (packages-add-suffix (car preloaded-file-list)))
 108           arg)
 109       (setq arg (locate-library arg0))
 110       (if (null arg)
 111           (progn
 112           (princ (format "Error:  dumped file %s does not exist\n" arg0))
 113           ;; Uncomment in case of difficulties
 114           ;;(print (format "late-packages: %S" late-packages))
 115           ;;(print (format "guessed-roots: %S" (paths-find-emacs-roots invocation-directory invocation-name)))
 116           )
 117         (if (null (member arg processed))
 118             (progn
 119               (if (and (null docfile-out-of-date)
 120                        (file-newer-than-file-p arg docfile))
 121                   (setq docfile-out-of-date t))
 122               (setq processed (cons arg processed)))))
 123       (setq preloaded-file-list (cdr preloaded-file-list)))))
 124
 125 ;; Finally process the list of site-loaded files.
 126 (if site-file-list
 127     (let (site-load-packages)
 128       (load site-file-list t t)
 129       (while site-load-packages
 130         (let ((arg (car site-load-packages)))
 131           (if (null (member arg processed))
 132               (progn
 133                 (if (and (null docfile-out-of-date)
 134                          (file-newer-than-file-p arg docfile))
 135                     (setq docfile-out-of-date t))
 136                 (setq processed (cons arg processed)))))
 137         (setq site-load-packages (cdr site-load-packages)))))
 138
 139 ;(let ((autoloads (packages-list-autoloads-path)))
 140 ;  ;; (print (concat "Autoloads: " (prin1-to-string autoloads)))
 141 ;  (while autoloads
 142 ;    (let ((arg (car autoloads)))
 143 ;      (if (null (member arg processed))
 144 ;         (progn
 145 ;           ;; (print arg)
 146 ;           (if (and (null docfile-out-of-date)
 147 ;                    (file-newer-than-file-p arg docfile))
 148 ;               (setq docfile-out-of-date t))
 149 ;           (setq processed (cons arg processed))))
 150 ;      (setq autoloads (cdr autoloads)))))
 151
 152 ;; Now fire up make-docfile and we're done
 153
 154 (setq processed (nreverse processed))
 155
 156 ;; (print (prin1-to-string (append options processed)))
 157
 158 (if docfile-out-of-date
 159     (progn
 160       (princ "Spawning make-docfile ...")
 161       ;; (print (prin1-to-string (append options processed)))
 162
 163       (setq exec-path (list (concat default-directory "../lib-src")))
 164
 165       ;; (locate-file-clear-hashing nil)
 166       (if (memq system-type '(berkeley-unix next-mach))
 167           ;; Suboptimal, but we have a unresolved bug somewhere in the
 168           ;; low-level process code
 169           (call-process-internal
 170            "/bin/csh"
 171            nil
 172            t
 173            nil
 174            "-fc"
 175            (mapconcat
 176             'identity
 177             (append
 178              (list (concat default-directory "../lib-src/make-docfile"))
 179              options processed)
 180             " "))
 181         ;; (print (prin1-to-string (append options processed)))
 182         (apply 'call-process-internal
 183                ;; (concat default-directory "../lib-src/make-docfile")
 184                "make-docfile"
 185                nil
 186                t
 187                nil
 188                (append options processed)))
 189
 190       (princ "Spawning make-docfile ...done\n")
 191       ;; (write-region-internal (point-min) (point-max) "/tmp/DOC")
 192       )
 193   (princ "DOC file is up to date\n"))
 194
 195 (kill-emacs)
 196
 197 ;;; make-docfile.el ends here