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