;;; pure-make.el --- helper file to make and install Emacs Lisp modules

;; Copyright (C) 2000 by Project Pure.

;; Author: SHIMADA Mitsunobu <simm@irc.fan.gr.jp>
;; Keywords: PURE, make, install

;; $Id: pure-make.el,v 1.5.2.1 2001/09/26 18:20:00 simm Exp $

;; This file 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.

;; This file 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., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; 

;;; Code:

(defconst pure-make-xemacs-p  (featurep 'xemacs))
(defconst pure-make-xmule-p   (and pure-make-xemacs-p (featurep 'mule)))
(defconst pure-make-emacs20-p (and (not (featurep 'xemacs))
				   (boundp 'emacs-major-version)
				   (<= 20 emacs-major-version)))
(defconst pure-make-oldfsf-p  (and (not (featurep 'xemacs))
				   (boundp 'emacs-major-version)
				   (> 20 emacs-major-version)))
(defconst pure-make-mule2-p   (and pure-make-oldfsf-p (featurep 'mule)))
(defconst pure-make-nemacs-p  (boundp 'NEMACS))
(defconst pure-make-sbemacs-p (not (or (boundp 'NEMACS) (featurep 'mule))))

(defconst pure-make-exec-ext
  (if (or (eq system-type 'windows-nt) (eq system-type 'OS/2)) ".exe" ""))

; (defvar pure-make-lispfile-list nil
;   "*.el file list to be installed.
; Each element consists in *.el filename string or cons cell,
; whose car is a *.el filename string and cdr is conditional s-expression.
;
; ex. '(\"pure-cs.el\"
;       \"pure-cs-detect.el\"
;       \"pure-cs-kana.el\"
;       (\"pure-cs-mule2.el\" . (and (featurep 'mule)
;                                  (eq \"2\" (substring mule-version 0 1))))
;       (\"pure-cs-e20.el\"   . (and (not (featurep 'xemacs))
;                                  (boundp 'emacs-major-version)
;                                  (<= 20 emacs-major-version)))
;       (\"pure-cs-xmas.el\"  . (featurep 'xemacs)))"

(defvar pure-make-bindir
  (if (eq 'OS/2 system-type)
      (expand-file-name "src/" (getenv "EMACS"))
    (expand-file-name
     (cond ((or (featurep 'meadow) (eq 'windows-nt system-type)) "../bin/")
	   ((featurep 'xemacs) "../../../bin/")
	   (t "../../../../bin/"))
     data-directory))
  "Directory which emacs executable binary exists.")

(defvar pure-make-sitelisp
  (if (eq 'OS/2 system-type)
      (expand-file-name "site-lisp/" (getenv "EMACS"))
    (expand-file-name
     (cond ((featurep 'xemacs) "../../xemacs/site-lisp/")
	   ((or (featurep 'meadow) (eq 'windows-nt system-type)) "../site-lisp/")
	   (t "../../site-lisp/"))
     data-directory))
  "Directory of site-lisp base.")

(defvar pure-make-package-base
  (and (featurep 'xemacs)
       (boundp 'early-packages)
       (let (dir
	     (dirs (append (if early-package-load-path early-packages)
			   (if late-package-load-path late-packages)
			   (if last-package-load-path last-packages))))
	 (while (not (file-exists-p (setq dir (car dirs))))
	   (setq dirs (cdr dirs)))
	 dir))
  "Directory of XEmacs package base. If FSF-Emacs, NIL.")

(defvar pure-make-arguments
  (let ((alist nil) (rest command-line-args-left))
    (while rest
      (if (string-match "^\\([^=]+\\)=\\(.+\\)" (car rest))
	  (setq alist (cons
		       (cons
			(intern
			 (downcase (substring (car rest) (match-beginning 1) (match-end 1))))
			(substring (car rest) (match-beginning 2) (match-end 2)))
		       alist)))
      (setq rest (cdr rest)))
    alist)
  "Command line argunents for installation.
This variable assumes that command line (in Makefile) format is formatted below:
  $(EMACS) $(BYTECOMP) -f make-pure-install packagedir=$(PACKDIR) lispdir=$(LISPDIR)")

(defun pure-make-get-argument (symbol)
  "Get argument value that equals to SYMBOL, from `pure-make-arguments'"
  (cdr (assq symbol pure-make-arguments)))

(defun pure-make-directory (dir)
  "Make directory named `dir'. If `dir' exists, do nothing.
If `dir'-named file exists, error occurs."
  (let ((parent (if (string-match "\\(.*\\)/[^/]*" dir)
		    (substring dir (match-beginning 1) (match-end 1))
		  dir)))
    (or (file-exists-p parent)
	(pure-make-directory parent))
    (if (file-exists-p dir)
	(if (not (file-directory-p dir))
	    (error "Canot make directory `%s'" dir))
      (if (fboundp 'make-directory-internal)
	  (make-directory-internal dir)
	(call-process "mkdir" nil nil nil dir)))
    dir))

(defun pure-make-get-filename (item)
  "Get filename from `item'.
If incompatible data type or file cannot find, returns NIL."
  (or (and (stringp item)
	   (file-exists-p item)
	   item)
      (and (consp item)
	   (eval (cdr item))
	   (stringp (car item))
	   (not (file-directory-p (car item)))
	   (car item))))

(defun pure-make-compile-lisp (list &rest args)
  "Byte compile Emacs Lisp file according to `list',
after load files described in `args'."
  (setq load-path (cons (expand-file-name ".") load-path))
  (mapcar
   '(lambda (item)
      (cond ((stringp item) (load item))
	    (t (require item))))
   args)
  ;; compile main
  (let (file compiled)
    (mapcar
     '(lambda (cell)
	(and (setq file (pure-make-get-filename cell))
	     (setq compiled (concat file "c"))
	     (file-newer-than-file-p file compiled)
	     (byte-compile-file file)))
     list)))

(defun pure-make-install-lisp (list src dst)
  "Install Emacs Lisp file from `src' to `dst' accroding to `list'."
  (let* ((path (cond ((string= "site-lisp" dst)
                      pure-make-sitelisp)
		     ((string-match "^[~/]" dst)
		      (expand-file-name dst))
		     (t (expand-file-name dst pure-make-sitelisp)))))
    (or (string-match "/$" path) (setq path (concat path "/")))
    (pure-make-directory path)
    (message "Install *.el files...")
    (let (file)
      (mapcar
       '(lambda (cell)
	  (and (setq file (pure-make-get-filename cell))
	       (message "%s -> %s" file path)
	       (copy-file file (expand-file-name (file-name-nondirectory file) path) t t)))
       list))
    (message "done.")
    (message "Install *.elc files...")
    (mapcar
     '(lambda (file)
	(and (string-match ".*\\.elc$" file)
	     (message "%s -> %s" file path)
	     (or
	      (copy-file file (expand-file-name (file-name-nondirectory file) path) t nil)
	      t)
	     (delete-file file)))
     (directory-files src))
    (message "done.")))

(defun pure-make-install-current-lisp (list dir)
  "Install Emacs Lisp in current directory to `dir', according to `list'."
  (pure-make-install-lisp list (expand-file-name "./") dir))

(defun pure-make-install-package (list package &optional base &rest alist)
  "Install Emacs Lisp in current directory as XEmacs package `package', according to `list'."
  (let* ((pbase    (or base pure-make-package-base))
	 (pkginfo  (expand-file-name "pkginfo/" pbase))
	 (infodir  (expand-file-name "info/" pbase))
	 (lispbase (expand-file-name "lisp/" pbase))
	 (lispdir  (expand-file-name package lispbase))
	 (etcbase  (expand-file-name "etc/" pbase))
	 (etcdir   (expand-file-name package etcbase)))
    (pure-make-directory lispdir)
    (pure-make-install-current-lisp list lispdir)
    (message "Install other files...")
    (mapcar
     (function
      (lambda (item)
	(or (and (consp item)
	         (stringp (car item))
	         (symbolp (cdr item))
	         (progn
		   (copy-file (car item) (expand-file-name (car item) (eval (cdr item))) t t)
		   (message "%s -> %s"
			    (car item) (expand-file-name (car item) (eval (cdr item))))))
	    (and (consp item)
		 (consp (car item))
		 (stringp (caar item))
		 (stringp (cdar item))
		 (progn
		   (copy-file (expand-file-name (caar item) (cdar item))
			      (expand-file-name
			       (caar item) (pure-make-directory (eval (cdr item)))) t t)
		   (message "%s -> %s"
			    (caar item) (expand-file-name (caar item) (eval (cdr item)))))))))
     alist)))

;; That's all
(provide 'pure-make)

;;; pure-make.el ends here