;;; initz-error.el --- Error list mode.

;; 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 'emu)
(require 'initz-globals)
(require 'initz)
(require 'initz-list)

(defvar initz-error-mode-map nil
  "Local map for initz error buffers.")
(unless initz-error-mode-map
    (let ((map (make-sparse-keymap)))
      (define-key map mouse-button-2 'initz-error-find-file-mouse)
      (define-key map "n" 'initz-error-next-line)
      (define-key map "p" 'initz-error-previous-line)
      (define-key map "h" 'backward-char)
      (define-key map "j" 'initz-error-next-line)
      (define-key map "k" 'initz-error-previous-line)
      (define-key map "l" 'forward-char)
      (define-key map " " 'initz-error-find-file)
      (define-key map "\C-m" 'initz-error-find-file)
      (define-key map "B" 'initz-error-byte-compile-file)
      (define-key map "D" 'initz-error-delete-file)
      (define-key map "L" 'initz-error-load-file)
      (define-key map "S" 'initz-startup)
      (define-key map "q" 'initz-error-quit)
      (setq initz-error-mode-map map)))

(defvar initz-error-node-map nil)
(unless initz-error-node-map
  (let ((map (make-sparse-keymap)))
    (set-keymap-parent map initz-error-mode-map)
    (define-key map mouse-button-2 'initz-error-node-click)
    (define-key map " " 'initz-error-node-enter)
    (define-key map "\C-m" 'initz-error-node-enter)
    (setq initz-error-node-map map)))

(defvar initz-error-mode-hook nil
  "Normal hook run when entering initz-error-mode.")

(defconst initz-error-mode-name "Initz Error")

(defconst initz-error-buffer-name "*Initz Error*")

(defconst initz-error-delete-file-ask-message-format
  "Delete %s? ")

(defconst initz-error-click-message-format
  "Click %s on the module name to select it.\n")

(defconst initz-error-enter-message-format
  "In this buffer, type %s to select the module name under point.\n")

(defconst initz-error-compile-message-header
  "Compile error:")

(defconst initz-error-load-message-header
  "Load error:")

;; Initz error mode is suitable only for specially formatted data.
(put 'initz-error-mode 'mode-class 'special)

(defalias 'initz-error-delete-whole-line 'initz-list-delete-whole-line)
(defalias 'initz-error-next-line 'initz-list-next-line)
(defalias 'initz-error-previous-line 'initz-list-previous-line)
(defalias 'initz-error-print-file 'initz-list-print-file)
(defalias 'initz-error-find-file 'initz-list-find-file)
(defalias 'initz-error-find-file-mouse 'initz-list-find-file-mouse)
(defalias 'initz-error-quit 'initz-list-quit)

(defun initz-error-node-insert (node status)
  (let ((start (point)))
    (insert "[" (if (eq status 'expand) "-" "+") "] "
	    (eval (intern (concat "initz-error-"
				  node "-message-header"))) "\n")
    (add-text-properties start (+ start 3)
			 `(face initz-list-node-face
			   mouse-face highlight
			   local-map ,initz-error-node-map
			   keymap ,initz-error-node-map
			   start-open t rear-nonsticky t
			   :node ,node
			   :status ,status))))

(defun initz-error-node-collapse (node)
  (save-excursion
    (setq buffer-read-only nil)
    (goto-char (point-min))
    (if (re-search-forward
	 (concat "^\\[-\\] "
		 (eval (intern (concat "initz-error-"
				       node "-message-header")))
		 "$") nil t)
	(let ((start (progn (beginning-of-line) (point)))
	      end)
	  (forward-line 1)
	  (if (re-search-forward "^\\[[-+]\\] .+:$" nil t)
	      (progn
		(beginning-of-line)
		(setq end (point)))
	    (setq end (point-max)))
	  (delete-region start end))
      (goto-char (point-max)))
    (initz-error-node-insert node 'collapse)
    (set-buffer-modified-p nil)
    (setq buffer-read-only t)))

(defun initz-error-node-expand (node)
  (save-excursion
    (setq buffer-read-only nil)
    (goto-char (point-min))
    (if (re-search-forward
	 (concat "^\\[\\+\\] "
		 (eval (intern (concat "initz-error-"
				       node "-message-header")))
		 "$") nil t)
	(delete-region (progn (beginning-of-line) (point))
		       (progn (forward-line 1) (point)))
      (goto-char (point-max)))
    (initz-error-node-insert node 'expand)
    (let ((sort-start (point)))
      (mapc
       (function (lambda (file)
		   (let (start)
		     (insert-char ?\  4)
		     (setq start (point))
		     (insert (initz-get-module-name file) "\n")
		     (add-text-properties
		      start (1- (point))
		      `(face initz-list-module-face
			mouse-face highlight
			start-open t rear-nonsticky t
			help-echo ,file))
		     (put-text-property start (point) :file file))))
       (eval (intern (concat "initz-" node "-error-files"))))
      (sort-lines nil sort-start (point)))
    (set-buffer-modified-p nil)
    (setq buffer-read-only t)))

(defun initz-error-node-enter ()
  (interactive)
  (let ((node (get-text-property (point) :node))
	(status (get-text-property (point) :status)))
    (when (and node status)
      (if (eq status 'expand)
	  (initz-error-node-collapse node)
	(initz-error-node-expand node))
      (forward-char 1))))

(defun initz-error-node-click (e)
  (interactive "e")
  (mouse-set-point e)
  (initz-error-node-enter))

(defun initz-error-byte-compile-file ()
  "Byte-compile the file under point."
  (interactive)
  (let ((file (get-text-property (point) :file)))
    (when file
      (condition-case nil
	  (when (save-window-excursion
		  (byte-compile-file file))
	    (let* ((compile-file (initz-get-correspondence-file file))
		   (startup-directory (file-name-directory file))
		   (flavor-directory (file-name-directory compile-file)))
	      (install-file (file-name-nondirectory compile-file)
			    startup-directory flavor-directory t t))
	    (when (member file initz-compile-error-files)
	      (setq initz-compile-error-files
		    (delete file initz-compile-error-files))
	      (initz-error-delete-whole-line)))
	(error)))))

(defun initz-error-delete-file ()
  "Delete the file under point."
  (interactive)
  (let ((file (get-text-property (point) :file)))
    (when (and file
	       (y-or-n-p
		(format initz-error-delete-file-ask-message-format
			(initz-get-module-name file))))
      (delete-file file)
      (setq initz-compile-error-files
	    (delete file initz-compile-error-files))
      (setq initz-load-error-files
	    (delete file initz-load-error-files))
      (initz-error-delete-whole-line)
      (initz-error-previous-line)
      (initz-error-next-line))))

(defun initz-error-load-file ()
  "Load the file under point."
  (interactive)
  (let* ((file (get-text-property (point) :file)))
    (initz-error-byte-compile-file)
    (when (initz-load-file (initz-get-correspondence-file file))
      (setq initz-load-error-files
	    (delete file initz-load-error-files))
      (initz-error-delete-whole-line))))

(defun initz-error-mode ()
  "\\<initz-error-mode-map>
   Major mode for browsing initz error buffer.

\\[initz-error-next-line]	Next line.
\\[initz-error-previous-line]	Previous line.
\\[forward-char]	Forward char.
\\[backward-char]	Backward char.

\\[initz-error-find-file]	View the file under point.
\\[initz-error-byte-compile-file]	Byte-compile the file under point.
\\[initz-error-delete-file]	Delete the file under point.
\\[initz-error-load-file]	Load the file under point.
\\[initz-startup]	Initz startup.
\\[initz-error-quit]	Quit the initz error mode."
  (interactive)
  (kill-all-local-variables)
  (use-local-map initz-error-mode-map)
  (setq mode-name initz-error-mode-name)
  (setq major-mode 'initz-error-mode)
  (when (or (featurep 'xemacs) (< emacs-major-version 21))
    (make-local-hook 'post-command-hook))
  (add-hook 'post-command-hook 'initz-error-print-file)
  (run-hooks 'initz-error-mode-hook))

(defun initz-error ()
  "Show initz error messages."
  (interactive)
  (when (or initz-compile-error-files
	    initz-load-error-files)
    ;; FIXME: ad-hoc
    (let ((buf (get-buffer initz-error-buffer-name)))
      (when buf
	(unless (one-window-p)
	  (delete-window))
	(kill-buffer buf)))
    (switch-to-buffer-other-window initz-error-buffer-name)
    (initz-error-mode)
    (goto-char (point-min))
    (insert
     (format initz-error-click-message-format
	     (substitute-command-keys "\\[initz-error-find-file-mouse]")))
    (insert
     (format initz-error-enter-message-format
	     (substitute-command-keys "\\[initz-error-find-file]")))
    (insert "\n")
    (mapc
     (function (lambda (node)
		 (initz-error-node-expand node)))
     '("compile" "load"))
    (set-buffer-modified-p nil)
    (setq buffer-read-only t)
    (goto-char (point-min))
    (search-forward "\n\n")
    (forward-char 1)
    ;; FIXME: ad-hoc
    (other-window 1)))

(provide 'initz-error)

;;; initz-error.el ends here