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