;;; initz-list.el --- File list mode.

;; Copyright (C) 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)

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

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

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

(defconst initz-list-mode-name "Initz List")

(defconst initz-list-buffer-name "*Initz List*")

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

(defconst initz-list-input-dir-message-format
  "Dir[%s] (%s): ")

(defconst initz-list-input-module-message-format
  "Module[%s]: ")

(defconst initz-list-new-file-illegal-message
  "Module name is illegal.")

(defconst initz-list-new-file-exists-message
  "File already exists.")

(defconst initz-list-new-file-provided-message
  "Module is already provided.")

(defconst initz-list-new-file-comment-message-format
  ";;; %s --- init file for %s.\n\n\n\n")

(defconst initz-list-new-file-provide-message-format
  "(provide '%s)\n")

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

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

(defconst initz-list-modeline-string
  "Initz")

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

(defadvice sort-build-lists (after sort-including-newline activate)
  (when (or (eq major-mode 'initz-list-mode)
	    (eq major-mode 'initz-error-mode))
    (setq ad-return-value
	  (mapcar #'(lambda (list)
		      (cons (cons (caar list) (1+ (cdar list)))
			    (cons (cadr list) (1+ (cddr list)))))
		  ad-return-value))))

(defun initz-list-delete-whole-line ()
  "Delete whole line at point."
  (setq buffer-read-only nil)
  (delete-region (progn (beginning-of-line) (point))
		 (progn (forward-line 1) (point)))
  (set-buffer-modified-p nil)
  (setq buffer-read-only t))

(defun initz-list-get-dir ()
  "Return the dir at point."
  (save-excursion
    (end-of-line)
    (when (re-search-backward "^\\[[-+]\\] \\([^ :]+\\)" nil t)
	(match-string 1))))

(defun initz-list-input-dir (&optional default)
  "Input the dir."
  (let* ((completing-list (mapcar #'(lambda (list)
				      (symbol-name (car list)))
				  initz-init-alist))
	 (default (if (stringp default) default "misc")))
    (completing-read
     (format initz-list-input-dir-message-format
	     initz-directory default)
     (mapcar #'(lambda (name)
		 (cons name name))
	     completing-list)
     nil t nil nil default)))

(defun initz-list-input-module (dir)
  "Input the module."
  (let ((init (initz-get-init-value (intern dir) 'prefix)))
    (setq init (initz-trim-separator init))
    (unless (string= init initz-null-string)
      (setq init (concat init initz-separator-string)))
    (if initz-list-input-module-completing
	(completing-read
	 (format initz-list-input-module-message-format dir)
	 (mapcar #'(lambda (feature)
		     (let ((name (symbol-name feature)))
		       (cons name name)))
		 features)
	 nil nil init)
      (read-string
       (format initz-list-input-module-message-format dir)
       init))))

(defun initz-list-insert-file (dir startup-file)
  "Insert the STARTUP-FILE at DIR section."
  ;; FIXME: Delete `save-excursion' and fix the next `FIXME'.
  (save-excursion
    (goto-char (point-min))
    (when (re-search-forward (concat "^\\[[-+]\\] " dir "[ :]") nil t)
      (beginning-of-line)
      (let ((status (get-text-property (point) :status)))
	(when (eq status 'expand)
	  (let (sort-start)
	    (forward-line 1)
	    (setq sort-start (point))
	    (if (re-search-forward "^\\[[-+]\\] " nil t)
		(beginning-of-line)
	      (re-search-forward "\\'" nil t))
	    (setq buffer-read-only nil)
	    (insert-char ?\  4)
	    (let ((start (point)))
	      (insert (initz-get-module-name startup-file) "\n")
	      (add-text-properties start (1- (point))
				   `(face initz-list-module-face
					  mouse-face highlight
					  start-open t rear-nonsticky t
					  help-echo ,startup-file))
	      (put-text-property start (point) :file startup-file))
	    (sort-lines nil sort-start (point)))
 	  (set-buffer-modified-p nil)
	  (setq buffer-read-only t)
	  ;; FIXME: Move to the line inserted now
	  )))))

(defun initz-list-node-insert (node status)
  (let ((prefix (initz-get-init-value node 'prefix))
	(start (point)))
    (setq prefix (initz-trim-separator prefix))
    ;; `prefix' will be broken.
    (if (string= prefix initz-null-string)
	(setq prefix initz-null-string)
      (setq prefix (concat " (" prefix ")")))
    (insert "[" (if (eq status 'expand) "-" "+") "] "
	    (symbol-name node) prefix ":\n")
    (add-text-properties start (+ start 3)
			 `(face initz-list-node-face
			   mouse-face highlight
			   local-map ,initz-list-node-map
			   keymap ,initz-list-node-map
			   start-open t rear-nonsticky t
			   :node ,node
			   :status ,status))))

(defun initz-list-node-collapse (node)
  (save-excursion
    (setq buffer-read-only nil)
    (goto-char (point-min))
    (if (re-search-forward (concat "^\\[-\\] "
				   (symbol-name node) "[ :]") 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-list-node-insert node 'collapse)
    (set-buffer-modified-p nil)
    (setq buffer-read-only t)))

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

(defun initz-list-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-list-node-collapse node)
	(initz-list-node-expand node))
      (forward-char 1))))

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

(defun initz-list-next-line (&optional arg)
  (interactive)
  (if (integerp arg)
      (next-line arg)
    (next-line 1))
  (beginning-of-line)
  (let ((start (re-search-forward "^\\(    \\|\\[\\|\\)" nil t)))
    (when (integer-or-marker-p start)
	(goto-char start))))

(defun initz-list-previous-line ()
  (interactive)
  (initz-list-next-line -1))

(defun initz-list-print-file ()
  "Print the file name under point."
  (interactive)
  (let ((file (get-text-property (point) :file)))
    (and file
	 (initz-message-no-log file))))

(defun initz-list-find-file ()
  "View the file under point."
  (interactive)
  (let ((file (get-text-property (point) :file)))
    (and file
	 (find-file-other-window file))))

(defun initz-list-find-file-mouse (e)
  "View the file under clicked point."
  (interactive "e")
  (mouse-set-point e)
  (unless (eolp)
    (initz-list-find-file)))

(defun initz-list-byte-compile-file ()
  "Byte-compile the file under point."
  (interactive)
  (let ((file (get-text-property (point) :file)))
    (when file
      (let ((compile-file (initz-get-correspondence-file file)))
	(when (file-newer-than-file-p file compile-file)
	  (condition-case nil
	      (when (save-window-excursion
		      (byte-compile-file file))
		(let ((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))
		(setq initz-compile-error-files
		      (delete file initz-compile-error-files)))
	    (error)))))))

(defun initz-list-delete-file ()
  "Delete the file under point."
  (interactive)
  (let ((file (get-text-property (point) :file)))
    (when (and file
	       (y-or-n-p
		(format initz-list-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-list-delete-whole-line)
      (initz-list-previous-line)
      (initz-list-next-line))))

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

;;;###autoload
(defun initz-list-new-file ()
  "Make new init file."
  (interactive)
  (let* ((default (initz-list-get-dir))
	 (dir (initz-list-input-dir default))
	 (module (initz-list-input-module dir)))
    (if (not (or (and (string= dir "misc") (string= module initz-null-string))
		 (string-match (concat "^" initz-module-regexp "$") module)))
	(message initz-list-new-file-illegal-message)
      (setq module (initz-trim-separator module))
      (let* ((startup-file (expand-file-name
			    (concat initz-prefix
				    (if (string= module initz-null-string)
					initz-null-string
				      initz-separator-string)
				    module ".el")
			    (initz-startup-directory (intern dir)))))
	(if (file-exists-p startup-file)
	    (message initz-list-new-file-exists-message)
	  (let ((base-name (initz-get-base-name startup-file)))
	    (if (memq (intern base-name) features)
		(message initz-list-new-file-provided-message)
	      (initz-list-insert-file dir startup-file)
	      (find-file-other-window startup-file)
	      (insert (format initz-list-new-file-comment-message-format
			      (file-name-nondirectory startup-file)
			      (if (string= module initz-null-string)
				  initz-prefix
				module)))
	      (insert (format initz-list-new-file-provide-message-format
			      base-name))
	      (save-buffer)
	      (goto-char (point-min))
	      (search-forward "\n\n"))))))))

(defun initz-list-quit ()
  "Quit the initz list mode."
  (interactive)
  (when (or (eq major-mode 'initz-list-mode)
	    (eq major-mode 'initz-error-mode))
    (remove-hook 'post-command-hook
		 (intern (concat
			  (substring (symbol-name major-mode) 0
				     (string-match "mode"
						   (symbol-name major-mode)))
			  "print-file")))
    (let ((buf (current-buffer)))
      (unless (one-window-p)
	(delete-window))
      (kill-buffer buf))))

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

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

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

;;;###autoload
(defun initz-list ()
  "Show initz list buffer."
  (interactive)
  ;; FIXME: ad-hoc
  (let ((buf (get-buffer initz-list-buffer-name)))
    (when buf
      (unless (one-window-p)
	(delete-window))
      (kill-buffer buf)))
  (switch-to-buffer-other-window initz-list-buffer-name)
  (initz-list-mode)
  (goto-char (point-min))
  (insert
   (format initz-list-click-message-format
	   (substitute-command-keys "\\[initz-list-find-file-mouse]")))
  (insert
   (format initz-list-enter-message-format
	   (substitute-command-keys "\\[initz-list-find-file]")))
  (insert "\n")
  (mapc #'(lambda (alist)
	    (let ((sym (car alist)))
	      (funcall (intern (concat "initz-list-node-"
				       (symbol-name
					initz-list-default-node-status)))
		       sym)))
	initz-init-alist)
  (set-buffer-modified-p nil)
  (setq buffer-read-only t)
  (goto-char (point-min))
  (search-forward "\n\n")
  (forward-char 1))

(provide 'initz-list)

;;; initz-list.el ends here