;;; initz.el --- Handles the switching of various startup initialization files

;; Copyright (C) 2001-2002 OHASHI Akira <bg66@koka-in.org>

;; Author: OHASHI Akira <bg66@koka-in.org>
;; Keywords: startup, init

;; This file is part of Initz.

;; This program 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 program 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:

(require 'install)
(require 'product)
(require 'initz-vars)
(require 'initz-globals)
(require 'initz-util)
(eval-when-compile (require 'cl))
(eval-and-compile
  (autoload 'initz-error "initz-error" nil t)
  (autoload 'initz-list "initz-list" nil t)
  (autoload 'initz-list-new-file "initz-list" nil t))

(product-provide 'initz
  (product-define "Initz" nil '(0 0 11)))

(defun initz-version (&optional arg)
  "Return Initz version.
If it is called interactively, version string is appeared on minibuffer.
If ARG is specified, don't display code name."
  (interactive "P")
  (let ((product-info (product-string-1 'initz (not arg))))
    (if (interactive-p)
	(message "%s" product-info)
      product-info)))

(defconst initz-done-message-format
  "Loading %s init files for %s...done")

(defun initz-message (mesg)
  "If `initz-verbose' is non-nil, print MESG."
  (when initz-verbose (message mesg)))

(defmacro initz-message-no-log (string &rest args)
  "Like `message', except that message logging is disabled."
  (if (featurep 'xemacs)
      (if args
	  `(display-message 'no-log (format ,string ,@args))
	`(display-message 'no-log ,string))
    `(let (message-log-max)
       (message ,string ,@args))))

(defun initz-trim-separator (string)
  "Trim `initz-separator-string' from STRING."
  (let ((temp string))
    (when (string-match (concat "^" initz-separator-string "+") temp)
      (setq temp (substring temp (match-end 0))))
    (when (string-match (concat initz-separator-string "+$") temp)
      (setq temp (substring temp 0 (match-beginning 0))))
    temp))

(defconst initz-init-alist
  `((argument . ("argument"
		 ,(mapconcat #'(lambda (arg)
				 (initz-trim-separator arg))
			     (cdr command-line-args)
			     initz-separator-string)))
    ( flavor . ("flavor" ,initz-flavor))
    (host . ("host" ,(system-name)))
    (system . ("system" ,(symbol-name system-type)))
    (misc . (,initz-null-string ,initz-null-string))))

(defun initz-get-init-value (sym type)
  "Return the TYPE's value of SYM from `initz-init-alist'."
  (let ((list (cdr (assq sym initz-init-alist)))
	(count 0))
    (unless (null list)
      (catch 'found
	(mapc #'(lambda (temp)
		  (if (eq type temp)
		      (let ((elem (nth count list)))
			(when (and (eq type 'prefix)
				   (not (string= elem initz-null-string)))
			  (setq elem (concat initz-separator-string elem)))
			(throw 'found elem))
		    (setq count (incf count))))
	 '(dir prefix))
	nil))))

(defun initz-directory (kind)
  "Return the directory of KIND."
  (let ((dir (cond
	      ((eq kind 'startup) "startup")
	      ((eq kind 'flavor) initz-flavor)
	      (t initz-null-string))))
    (expand-file-name dir initz-directory)))

(defun initz-startup-directory (sym)
  "Return the startup directory of SYM."
  (expand-file-name
   (initz-get-init-value sym 'dir)
   (initz-directory 'startup)))

(defun initz-flavor-directory (sym)
  "Return the flavor directory of SYM."
  (expand-file-name
   (initz-get-init-value sym 'dir)
   (initz-directory 'flavor)))

(defun initz-get-kind (file)
  "Return the kind of FILE."
  (catch 'found
    (mapc #'(lambda (kind)
	      (when (string-match (initz-directory kind) file)
		(throw 'found kind)))
	  '(startup flavor))
    nil))

(defun initz-get-dir (file)
  "Return dir of the FILE."
  (let ((file (file-name-directory file))
	(directory (initz-directory (initz-get-kind file))))
    (when (string-match "/$" file)
      (setq file (substring file 0 (1- (length file)))))
    (catch 'found
      (if (string= file directory)
	  (throw 'found 'misc)
	(when (string-match (concat directory "\\(.+\\)") file)
	  (let ((dir (substring (match-string 1 file) 1)))
	    (mapc #'(lambda (alist)
		      (when (string= (nth 0 (cdr alist)) dir)
			(throw 'found (car alist))))
		  initz-init-alist))))
      nil)))

(defun initz-get-correspondence-file (init-file)
  "Return correspondence file of the INIT-FILE."
  (let* ((file (file-name-nondirectory init-file))
	 (kind (if (eq (initz-get-kind init-file) 'startup)
		   'flavor
		 'startup))
	 (directory (expand-file-name
		     (initz-get-init-value (initz-get-dir init-file) 'dir)
		     (initz-directory kind))))
    (expand-file-name (if (eq kind 'startup)
			  (substring file 0 (1- (length file)))
			(concat file "c"))
		      directory)))

(defun initz-get-files (kind dir &optional all)
  "Return files of the directory made by KIND and DIR."
  (let ((directory (expand-file-name
		    (initz-get-init-value dir 'dir)
		    (initz-directory kind)))
	(prefix (regexp-quote
		 (concat initz-prefix
			 (initz-get-init-value dir 'prefix))))
	(ext (if (eq kind 'startup) "\\.el$" "\\.elc$")))
    ;; List all files.
    (if all
	(directory-files
	 directory t (concat "^\\(" initz-prefix "\\|"
			     initz-prefix initz-separator-string
			     initz-module-regexp "\\)" ext))
      (unless (and (not (eq dir 'misc))
		   (string= prefix initz-prefix))
	(directory-files
	 directory t (concat "^\\(" prefix "\\|"
			     prefix initz-separator-string
			     initz-module-regexp "\\)" ext))))))

(defun initz-make-directory (sym)
  "Make SYM's directory."
  (mapc #'(lambda (kind)
	    (let ((directory (expand-file-name
			      (initz-get-init-value sym 'dir)
			      (initz-directory kind))))
	      (unless (file-directory-p directory)
		(make-directory directory t))))
	'(startup flavor)))

(defun initz-make-directories ()
  "Make initz directories."
  (interactive)
  (mapc #'(lambda (alist)
	    (let ((sym (car alist)))
	      (initz-make-directory sym)))
	initz-init-alist))

(defun initz-delete-file (flavor-file)
  "Delete the FLAVOR-FILE when startup-file was deleted."
  (let ((startup-file (initz-get-correspondence-file flavor-file)))
    (unless (file-exists-p startup-file)
      (delete-file flavor-file))))

(defun initz-delete-files (sym)
  "Delete files in the SYM's directory when startup-file was deleted."
  (let ((flavor-files (initz-get-files 'flavor sym)))
    (mapc #'(lambda (flavor-file)
	      (initz-delete-file flavor-file))
	  flavor-files)))

(defun initz-delete ()
  "Delete the initz startup files."
  (interactive)
  (initz-make-directories)
  (mapc #'(lambda (alist)
	    (let ((sym (car alist)))
	      (initz-delete-files sym)))
	initz-init-alist))

(defun initz-compile-file (startup-file)
  "Compile the STARTUP-FILE."
  (let ((flavor-file (initz-get-correspondence-file startup-file)))
    (when (file-newer-than-file-p startup-file flavor-file)
      (condition-case nil
	  (unless (save-window-excursion
		    (byte-compile-file startup-file))
	    (error nil))
	(error
	 ;; Use `initz-ignore-list' instead of `initz-ignore-list-internal'
	 ;; purposely.
	 (unless (member (initz-get-module-name startup-file)
			 initz-ignore-list)
	   (add-to-list 'initz-compile-error-files startup-file))
	 nil)))))

(defun initz-compile-files (sym)
  "Compile files in the SYM's directory."
  (let ((startup-files (initz-get-files 'startup sym))
	compiled-files)
    (mapc #'(lambda (startup-file)
	      (initz-compile-file startup-file))
	  startup-files)
    (setq compiled-files (directory-files
			  (initz-startup-directory sym) nil "\\.elc$"))
    (install-files compiled-files (initz-startup-directory sym)
		   (initz-flavor-directory sym) t t)))

(defun initz-compile ()
  "Compile the initz startup files."
  (interactive)
  (initz-delete)
  (setq initz-compile-error-files nil)
  (mapc #'(lambda (alist)
	    (let ((sym (car alist)))
	      (initz-compile-files sym)))
	initz-init-alist)
  (and initz-compile-error-files (eq initz-verbose 'errors)
       (initz-error)))

(defun initz-load-file (flavor-file &optional unload)
  "Load the FLAVOR-FILE."
  (let* ((module (initz-get-module-name flavor-file))
	 (mesg (format (if unload
			   initz-unload-module-message-format
			 initz-load-module-message-format)
		       module)))
    (if (or (member module initz-ignore-list-internal)
	    (and initz-load-list-internal
		 (not (member module initz-load-list-internal))))
	(initz-message (concat mesg "ignored"))
      (unless (and initz-interactively
		   (not (y-or-n-p
			 (format initz-load-module-ask-message-format
				 module))))
	(initz-message mesg)
	(condition-case nil
	    (let*((base-name (initz-get-base-name flavor-file))
		  (feature (intern base-name)))
	      (if unload
		  (unload-feature feature t)
		(when (memq feature features)
		  (unload-feature feature t))
		(require feature))
	      (initz-message (concat mesg "done")))
	  (error (add-to-list 'initz-load-error-files
			      (initz-get-correspondence-file flavor-file))
		 (initz-message (concat mesg "failed"))
		 nil))))))

(defun initz-load-files (sym)
  "Load files in the SYM's directory."
  (let ((flavor-files (initz-get-files 'flavor sym)))
    (mapc #'(lambda (flavor-file)
	      (initz-load-file flavor-file))
	  flavor-files)))

(defun initz-load ()
  "Load the initz startup files."
  (interactive)
  (initz-compile)
  (setq initz-load-error-files nil)
  (initz-add-to-load-path (initz-directory 'flavor))
  ;; tricky
  (setq initz-load-list-internal initz-load-list)
  (setq initz-ignore-list-internal initz-ignore-list)
  (mapc #'(lambda (alist)
	    (let ((sym (car alist)))
	      (initz-load-files sym)))
	initz-init-alist)
  (and initz-load-error-files (eq initz-verbose 'errors)
       (initz-error)))

(defun initz-done ()
  "Initz done."
  (when initz-delete-compile-log-buffer
    (mapc #'(lambda (buffer)
	      (when (string-match "^\\*Compile-Log\\*$" (buffer-name buffer))
		(kill-buffer buffer)))
	  (buffer-list)))
  (initz-message (format initz-done-message-format
			 (initz-version) initz-flavor)))

;;;###autoload
(defun initz-startup ()
  "Initz startup."
  (interactive)
  (unless noninteractive
    (initz-load)
    (initz-done)))

(provide 'initz)

;;; initz.el ends here