412 lines
16 KiB
EmacsLisp
412 lines
16 KiB
EmacsLisp
;;; dvc-build.el --- compile-time helper.
|
|
|
|
;; Copyright (C) 2004-2008 by all contributors
|
|
|
|
;; Author: Matthieu Moy <Matthieu.Moy@imag.fr>
|
|
;; Thien-Thi Nguyen <ttn@gnuvola.org>
|
|
;; Inspired from the work of Steve Youngs <steve@youngs.au.com>
|
|
|
|
;; This file is part of DVC.
|
|
;;
|
|
;; DVC is free software; you can redistribute it and/or modify
|
|
;; it under the terms of the GNU General Public License as published by
|
|
;; the Free Software Foundation; either version 2, or (at your option)
|
|
;; any later version.
|
|
|
|
;; DVC is distributed in the hope that it will be useful,
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;; GNU General Public License for more details.
|
|
|
|
;; You should have received a copy of the GNU General Public License
|
|
;; along with GNU Emacs; see the file COPYING. If not, write to
|
|
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
|
|
;; Boston, MA 02110-1301, USA.
|
|
|
|
;;; Commentary:
|
|
|
|
;; This file provides various functions for $(ebatch); see Makefile.in.
|
|
;; It is neither compiled nor installed.
|
|
|
|
;;; Code:
|
|
|
|
(unless noninteractive
|
|
(error "This file is not intended for interactive use (see Makefile.in)"))
|
|
|
|
;; Expect a small set of env vars to be set by caller.
|
|
(defvar srcdir (or (getenv "srcdir")
|
|
(error "Env var `srcdir' not set")))
|
|
(defvar otherdirs (or (getenv "otherdirs")
|
|
;; We used to `error' as for `srcdir' here, but on some
|
|
;; systems, if the value is "", `getenv' returns nil, so
|
|
;; we can't be too strict. Reported by Stephen Leake.
|
|
""))
|
|
|
|
;; Take control of exit(3).
|
|
(fset 'bye-bye (symbol-function 'kill-emacs))
|
|
(defun kill-emacs (&optional arg)
|
|
(when (and arg (not (equal 0 arg)))
|
|
(bye-bye)))
|
|
|
|
;; Standard
|
|
|
|
(defun zonk-file (filename)
|
|
(when (file-exists-p filename)
|
|
(delete-file filename)))
|
|
|
|
(require 'cl)
|
|
(require 'loadhist)
|
|
(require 'bytecomp)
|
|
|
|
(defun f-set-difference (a b) (set-difference a b :test 'string=))
|
|
(defun f-intersection (a b) (intersection a b :test 'string=))
|
|
|
|
(defun srcdir/ (filename)
|
|
(expand-file-name filename srcdir))
|
|
|
|
;; Increase the max-specpdl-size size to avoid an error on some platforms
|
|
(setq max-specpdl-size (max 1000 max-specpdl-size))
|
|
|
|
;; Munge `load-path': contrib at end, everything else in front.
|
|
(add-to-list 'load-path (srcdir/ "contrib") t)
|
|
(dolist (dir
|
|
;;+ (split-string otherdirs " " t)
|
|
;; Three-arg `split-string' is supported as of Emacs 22 and XEmacs
|
|
;; 21.4.16. We will switch to it eventually. For now, this works:
|
|
(delete "" (split-string otherdirs " ")))
|
|
(add-to-list 'load-path dir))
|
|
(add-to-list 'load-path (unless (equal "." srcdir) srcdir))
|
|
(add-to-list 'load-path nil)
|
|
|
|
;; Avoid interference from Emacs' VC.
|
|
(setq vc-handled-backends nil)
|
|
|
|
;; Internal vars are named --foo.
|
|
|
|
;; Platform-specific filenames.
|
|
(defvar --autoloads-filename (if (featurep 'xemacs)
|
|
"auto-autoloads.el"
|
|
"dvc-autoloads.el"))
|
|
|
|
(defvar --custom-autoloads-filename (if (featurep 'xemacs)
|
|
"custom-load.el"
|
|
"cus-load.el"))
|
|
|
|
;; List of files to compile.
|
|
(defvar --to-compile
|
|
(f-set-difference
|
|
;; plus
|
|
(append
|
|
;; generated files
|
|
(unless (string= "." srcdir)
|
|
(mapcar 'expand-file-name '("dvc-version.el"
|
|
"dvc-site.el")))
|
|
;; contrib libraries
|
|
(when (string= (file-name-directory (locate-library "ewoc"))
|
|
(srcdir/ "contrib/"))
|
|
'("contrib/ewoc.el"))
|
|
;; $(srcdir)/*.el
|
|
(directory-files srcdir nil "^[^=].*\\.el$"))
|
|
;; minus
|
|
(append
|
|
;; static
|
|
`("dvc-build.el"
|
|
,--autoloads-filename
|
|
,--custom-autoloads-filename
|
|
,(if (featurep 'xemacs)
|
|
"dvc-emacs.el"
|
|
"dvc-xemacs.el"))
|
|
;; dynamic: if invalid, use nil
|
|
(unless (locate-library "tree-widget")
|
|
'("tla-browse.el")))))
|
|
|
|
;; Warnings we care about.
|
|
(defvar --warnings '(unresolved callargs redefine))
|
|
|
|
;; Autoload forms for XEmacs.
|
|
(when (featurep 'xemacs)
|
|
(autoload 'setenv (if (emacs-version>= 21 5) "process" "env") nil t)
|
|
;; DVC things
|
|
(autoload 'replace-regexp-in-string "dvc-xemacs.el")
|
|
(autoload 'line-number-at-pos "dvc-xemacs.el")
|
|
(autoload 'line-beginning-position "dvc-xemacs.el")
|
|
(autoload 'line-end-position "dvc-xemacs.el")
|
|
(autoload 'match-string-no-properties "dvc-xemacs.el")
|
|
(autoload 'tla--run-tla-sync "tla-core.el")
|
|
(autoload 'dvc-switch-to-buffer "dvc-buffers.el")
|
|
(autoload 'dvc-trace "dvc-utils.el")
|
|
(autoload 'dvc-flash-line "tla")
|
|
(autoload 'tla-tree-root "tla")
|
|
(autoload 'tla--name-construct "tla-core")
|
|
(defalias 'dvc-cmenu-mouse-avoidance-point-position
|
|
'mouse-avoidance-point-position)
|
|
;; External things
|
|
(autoload 'debug "debug")
|
|
(autoload 'tree-widget-action "tree-widget")
|
|
(autoload 'ad-add-advice "advice")
|
|
(autoload 'customize-group "cus-edit" nil t)
|
|
(autoload 'dired "dired" nil t)
|
|
(autoload 'dired-other-window "dired" nil t)
|
|
(autoload 'dolist "cl-macs" nil nil 'macro)
|
|
(autoload 'easy-mmode-define-keymap "easy-mmode")
|
|
(autoload 'minibuffer-prompt-end "completer")
|
|
(autoload 'mouse-avoidance-point-position "avoid")
|
|
(autoload 'read-passwd "passwd")
|
|
(autoload 'read-kbd-macro "edmacro" nil t)
|
|
(autoload 'regexp-opt "regexp-opt")
|
|
(autoload 'reporter-submit-bug-report "reporter")
|
|
(autoload 'view-file-other-window "view-less" nil t)
|
|
(autoload 'view-mode "view-less" nil t)
|
|
(autoload 'with-electric-help "ehelp")
|
|
(autoload 'read-kbd-macro "edmacro")
|
|
(autoload 'pp-to-string "pp"))
|
|
|
|
(unless (fboundp 'defadvice)
|
|
(autoload 'defadvice "advice" nil nil 'macro))
|
|
|
|
(defalias 'facep 'ignore) ; ???
|
|
|
|
(defun byte-compile-dest-file (source)
|
|
"Convert an Emacs Lisp source file name to a compiled file name.
|
|
In addition, remove directory name part from SOURCE."
|
|
(concat (file-name-nondirectory (file-name-sans-versions source)) "c"))
|
|
|
|
;; Fix some Emacs byte-compiler problems.
|
|
(unless (featurep 'xemacs)
|
|
|
|
(when (and (= emacs-major-version 21)
|
|
(>= emacs-minor-version 3)
|
|
(condition-case code
|
|
(let ((byte-compile-error-on-warn t))
|
|
(byte-optimize-form (quote (pop x)) t)
|
|
nil)
|
|
(error (string-match "called for effect"
|
|
(error-message-string code)))))
|
|
(defadvice byte-optimize-form-code-walker (around silence-warn-for-pop
|
|
(form for-effect)
|
|
activate)
|
|
"Silence the warning \"...called for effect\" for the `pop' form.
|
|
It is effective only when the `pop' macro is defined by cl.el rather
|
|
than subr.el."
|
|
(let (tmp)
|
|
(if (and (eq (car-safe form) 'car)
|
|
for-effect
|
|
(setq tmp (get 'car 'side-effect-free))
|
|
(not byte-compile-delete-errors)
|
|
(not (eq tmp 'error-free))
|
|
(eq (car-safe (cadr form)) 'prog1)
|
|
(let ((var (cadr (cadr form)))
|
|
(last (nth 2 (cadr form))))
|
|
(and (symbolp var)
|
|
(null (nthcdr 3 (cadr form)))
|
|
(eq (car-safe last) 'setq)
|
|
(eq (cadr last) var)
|
|
(eq (car-safe (nth 2 last)) 'cdr)
|
|
(eq (cadr (nth 2 last)) var))))
|
|
(progn
|
|
(put 'car 'side-effect-free 'error-free)
|
|
(unwind-protect
|
|
ad-do-it
|
|
(put 'car 'side-effect-free tmp)))
|
|
ad-do-it))))
|
|
|
|
(when (byte-optimize-form '(and (> 0 1) foo) t)
|
|
(defadvice byte-optimize-form-code-walker
|
|
(around fix-bug-in-and/or-forms (form for-effect) activate)
|
|
"Optimize the rest of the and/or forms.
|
|
It has been fixed in XEmacs before releasing 21.4 and also has been
|
|
fixed in Emacs after 21.3."
|
|
(if (and for-effect (memq (car-safe form) '(and or)))
|
|
(let ((fn (car form))
|
|
(backwards (reverse (cdr form))))
|
|
(while (and backwards
|
|
(null (setcar backwards
|
|
(byte-optimize-form (car backwards) t))))
|
|
(setq backwards (cdr backwards)))
|
|
(if (and (cdr form) (null backwards))
|
|
(byte-compile-log
|
|
" all subforms of %s called for effect; deleted" form))
|
|
(when backwards
|
|
(setcdr backwards
|
|
(mapcar 'byte-optimize-form (cdr backwards))))
|
|
(setq ad-return-value (cons fn (nreverse backwards))))
|
|
ad-do-it))))
|
|
|
|
;; Work around for an incompatibility (XEmacs 21.4 vs. 21.5), see the
|
|
;; following threads:
|
|
;;
|
|
;; http://thread.gmane.org/gmane.emacs.gnus.general/56414
|
|
;; Subject: attachment problems found but not fixed
|
|
;;
|
|
;; http://thread.gmane.org/gmane.emacs.gnus.general/56459
|
|
;; Subject: Splitting mail -- XEmacs 21.4 vs 21.5
|
|
;;
|
|
;; http://thread.gmane.org/gmane.emacs.xemacs.beta/20519
|
|
;; Subject: XEmacs 21.5 and Gnus fancy splitting.
|
|
(when (and (featurep 'xemacs)
|
|
(let ((table (copy-syntax-table emacs-lisp-mode-syntax-table)))
|
|
(modify-syntax-entry ?= " " table)
|
|
(with-temp-buffer
|
|
(with-syntax-table table
|
|
(insert "foo=bar")
|
|
(goto-char (point-min))
|
|
(forward-sexp 1)
|
|
(eolp)))))
|
|
;; The original `with-syntax-table' uses `copy-syntax-table' which
|
|
;; doesn't seem to copy modified syntax entries in XEmacs 21.5.
|
|
(defmacro with-syntax-table (syntab &rest body)
|
|
"Evaluate BODY with the SYNTAB as the current syntax table."
|
|
`(let ((stab (syntax-table)))
|
|
(unwind-protect
|
|
(progn
|
|
;;(set-syntax-table (copy-syntax-table ,syntab))
|
|
(set-syntax-table ,syntab)
|
|
,@body)
|
|
(set-syntax-table stab)))))
|
|
|
|
(defun missing-or-old-elc ()
|
|
"Return the list of .el files newer than their .elc."
|
|
(remove-if-not (lambda (file)
|
|
(let ((source (srcdir/ file))
|
|
(elc (byte-compile-dest-file file)))
|
|
(or (not (file-exists-p elc))
|
|
(file-newer-than-file-p source elc))))
|
|
--to-compile))
|
|
|
|
;; Teach make-autoload how to handle define-dvc-unified-command.
|
|
(require 'autoload)
|
|
(require 'dvc-unified)
|
|
(defadvice make-autoload (before handle-define-dvc-unified-command activate)
|
|
(if (eq (car-safe (ad-get-arg 0)) 'define-dvc-unified-command)
|
|
(ad-set-arg 0 (macroexpand (ad-get-arg 0)))))
|
|
|
|
;; Teach `make-autoload' how to handle `define-derived-mode'.
|
|
(unless (make-autoload '(define-derived-mode child parent name
|
|
"docstring" body)
|
|
"file")
|
|
(defadvice make-autoload (around handle-define-derived-mode activate)
|
|
"Handle `define-derived-mode'."
|
|
(if (eq (car-safe (ad-get-arg 0)) 'define-derived-mode)
|
|
(setq ad-return-value
|
|
(list 'autoload
|
|
(list 'quote (nth 1 (ad-get-arg 0)))
|
|
(ad-get-arg 1)
|
|
(nth 4 (ad-get-arg 0))
|
|
t nil))
|
|
ad-do-it))
|
|
(put 'define-derived-mode 'doc-string-elt 3))
|
|
|
|
;; Update custom-autoloads and autoloads (merging them for GNU Emacs),
|
|
;; and compile everything that needs compiling.
|
|
(defun dvc-build-all ()
|
|
;; The default warnings don't look so bad to me!
|
|
;;(unless command-line-args-left
|
|
;; (setq byte-compile-warnings --warnings))
|
|
(setq command-line-args-left nil)
|
|
|
|
(let ((fake-c-l-a-l (list srcdir))
|
|
(changed (missing-or-old-elc)))
|
|
|
|
;; Make `--custom-autoloads-filename'.
|
|
(when changed
|
|
(load "cus-dep")
|
|
(let ((cusload-base-file --custom-autoloads-filename)
|
|
(command-line-args-left fake-c-l-a-l))
|
|
(if (fboundp 'custom-make-dependencies)
|
|
(custom-make-dependencies)
|
|
(Custom-make-dependencies))
|
|
(when (featurep 'xemacs)
|
|
(message "Compiling %s..." --custom-autoloads-filename)
|
|
(byte-compile-file --custom-autoloads-filename))))
|
|
|
|
;; Make `--autoloads-filename'.
|
|
(unless (and (file-exists-p --autoloads-filename)
|
|
(null changed))
|
|
(let ((generated-autoload-file (expand-file-name --autoloads-filename))
|
|
(command-line-args-left fake-c-l-a-l)
|
|
(make-backup-files nil)
|
|
(autoload-package-name "dvc"))
|
|
(if (featurep 'xemacs)
|
|
(zonk-file generated-autoload-file)
|
|
(with-temp-file generated-autoload-file
|
|
(insert ?\014)))
|
|
(batch-update-autoloads)))
|
|
|
|
;; Insert some preload forms into the autoload file.
|
|
(with-temp-file --autoloads-filename
|
|
(insert-file-contents --autoloads-filename)
|
|
(let ((blurb ";;; DVC PRELOAD\n"))
|
|
(unless (save-excursion
|
|
;; The preload forms are not guaranteed to be at beginning
|
|
;; of buffer; they might be prefixed by cus-load munging.
|
|
;; So search for them. (Previously, we used `looking-at'.)
|
|
(search-forward blurb nil t))
|
|
(insert blurb)
|
|
(dolist (form '((require 'dvc-core)
|
|
(eval-when-compile
|
|
(require 'dvc-unified)
|
|
(require 'dvc-utils))))
|
|
(pp form (current-buffer))))))
|
|
|
|
;; Merge custom load and autoloads for GNU Emacs and compile the result.
|
|
(let ((tail-blurb (concat "\n\n"
|
|
"(provide 'dvc-autoloads)\n\n"
|
|
";;; Local Variables:\n"
|
|
";;; version-control: never\n"
|
|
";;; no-update-autoloads: t\n"
|
|
";;; End:\n"
|
|
";;; dvc-autoloads.el ends here\n")))
|
|
(when (or (not (file-exists-p --autoloads-filename))
|
|
changed)
|
|
(unless (featurep 'xemacs)
|
|
(message "Merging %s into %s ..."
|
|
--custom-autoloads-filename
|
|
--autoloads-filename)
|
|
(with-temp-file --autoloads-filename
|
|
(insert-file-contents --custom-autoloads-filename)
|
|
(delete-file --custom-autoloads-filename)
|
|
(search-forward ";;; Code:\n")
|
|
(delete-region (point-min) (point))
|
|
(insert ";;; dvc-autoloads.el\n\n"
|
|
";;; Code:\n")
|
|
(goto-char (point-max))
|
|
;; ??? What do we have against this innocent var? --ttn
|
|
(when (search-backward "custom-versions-load-alist" nil t)
|
|
(forward-line -1))
|
|
(delete-region (point) (point-max))
|
|
(insert-file-contents --autoloads-filename)
|
|
(goto-char (point-max))
|
|
(when (search-backward "\n(provide " nil t)
|
|
(delete-region (1- (point)) (point-max)))
|
|
(insert tail-blurb)))
|
|
(message "Compiling %s..." --autoloads-filename)
|
|
(byte-compile-file --autoloads-filename)
|
|
(when (featurep 'xemacs)
|
|
(message (concat "Creating dummy dvc-autoloads.el..."))
|
|
(with-temp-file "dvc-autoloads.el"
|
|
(insert tail-blurb)))))
|
|
|
|
;; Compile `--to-compile' files.
|
|
(when changed
|
|
(dolist (file --to-compile)
|
|
(load (srcdir/ file) nil nil t))
|
|
;; We compute full fanout, not just root-set one-level-downstream.
|
|
;; In this way we err on the safe side.
|
|
(let (todo)
|
|
(while changed
|
|
(nconc changed (f-set-difference
|
|
(f-intersection
|
|
(mapcar 'file-name-nondirectory
|
|
(file-dependents
|
|
(srcdir/ (car changed))))
|
|
--to-compile)
|
|
todo))
|
|
(pushnew (pop changed) todo :test 'string=))
|
|
(mapc 'zonk-file (mapcar 'byte-compile-dest-file todo))
|
|
(mapc 'byte-compile-file (mapcar 'srcdir/ todo)))))
|
|
|
|
;; All done. TODO: Summarize.
|
|
(bye-bye))
|
|
|
|
;;; dvc-build.el ends here
|