;;; patcher-logmsg.el --- Log message buffers

;; Copyright (C) 2008, 2009, 2010, 2011 Didier Verna
;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2007 Didier Verna

;; Author:        Didier Verna <didier@xemacs.org>
;; Maintainer:    Didier Verna <didier@xemacs.org>
;; Created:       Sat Feb 13 18:24:56 2010
;; Last Revision: Sun Dec  4 15:54:18 2011
;; Keywords:      maint


;; This file is part of Patcher.

;; Patcher is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License version 3,
;; as published by the Free Software Foundation.

;; Patcher 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 this program; if not, write to the Free Software
;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.


;;; Commentary:

;; Contents management by FCM version 0.1.


;;; Code:

(require 'cl)

(eval-when-compile (require 'patcher-cutil))
(require 'patcher-util)
(require 'patcher-face)
(require 'patcher-project)
(require 'patcher-instance)
(require 'patcher-source)
(require 'patcher-change-log)
(require 'patcher-cmtcmd)


(defgroup patcher-logmsg nil
  "Patcher settings for log message buffers."
  :group 'patcher)



;; ==========================================================================
;; Patcher LogMsg fontification
;; ==========================================================================

(defcustom patcher-logmsg-font-lock-keywords
  '(("^\\s-*#.*" . patcher-comment-face)
    ("`\\([^'\n]+\\)'" (1 patcher-reference-face prepend)))
  "*Font lock keywords for log message buffers."
  :group 'patcher-logmsg
  :type 'sexp)




;; ==========================================================================
;; Patcher LogMsg mode
;; ==========================================================================

(defun patcher-logmsg-insert-subject (&optional prefix)
  "Insert subject at point in current buffer.

PREFIX is a string to insert before the subject, if there is indeed
a subject to insert (unavailable interactively).

Return non-nil if something has indeed been inserted."
  (interactive)
  ;; Note that we allow this function to insert the subject anywhere, even in
  ;; the middle of a line.
  (let* ((subject (patcher-project-subject patcher-project))
	 (doit (not (zerop (length subject)))))
    (when doit
      (when prefix
	(insert prefix))
      (insert subject))
    doit))

(defun patcher-logmsg-change-subject ()
  "Read a new subject for the current project.

The new subject is propagated to all relevant buffers."
  (interactive)
  (patcher-change-subject patcher-project))

(defun patcher-logmsg-insert-change-logs (&optional separator prefix)
  "Insert ChangeLog entries at point in current buffer.

If SEPARATOR is non-nil (prefix argument when called interactively),
also insert the ChangeLog separator string defined by the
:change-logs-separator project option \(but only if there are indeed
ChangeLog entries to insert).

PREFIX is an additional string to insert before anything else,
if there is indeed something to insert (unavailable interactively).

Return non-nil if something has indeed been inserted."
  (interactive "P")
  (let ((beg (point)))
    (when (patcher-insert-change-log-contents patcher-project beg)
      (save-excursion
	(goto-char beg)
	;; Ensure that we start at the beginning of a line,
	(unless (point-at-bol)
	  (insert "\n"))
	(when prefix
	  (insert prefix))
	(when separator
	  (setq separator (patcher-project-option patcher-project
			    :change-logs-separator))
	  (unless (zerop (length separator))
	    (insert separator "\n\n"))))
      t)))

(defun patcher-logmsg-insert-compressed-change-logs
  (&optional separator prefix)
  "Insert compressed ChangeLog entries in the current Patcher LogMsg buffer.

If SEPARATOR is non-nil (prefix argument when called interactively),
also insert the ChangeLog separator string defined by the
:change-logs-separator project option \(but only if there are indeed
ChangeLog entries to insert).

PREFIX is an additional string to insert before anything else,
if there is indeed something to insert (unavailable interactively).

Return non-nil if something has indeed been inserted."
  (interactive)
  (when (patcher-logmsg-insert-change-logs separator prefix)
    (patcher-compress-change-logs)
    t))

(defun patcher-logmsg-commit (&optional arg)
  "Commit the change described in the current Patcher LogMsg buffer.

When called interactively, use a prefix to override the commit command.
The actual log message starts at the first non-blank and non-comment line
in this buffer."
  (interactive "P")
  (patcher-detect-committed-project patcher-project)
  (patcher-save-sources patcher-project)
  (patcher-save-change-logs patcher-project)
  (when arg
    (setf (patcher-project-commit-command patcher-project)
	  (read-shell-command "Commit command: "
			      (patcher-project-commit-command
			       patcher-project))))
  ;; Make sure that the log buffer ends with one and only one newline
  ;; character. Empty lines are useless, and I've noticed a bug in Darcs which
  ;; makes it append the interactive ***END OF DESCRIPTION*** stuff to the log
  ;; file contents, when it doesn't end with a newline character.
  (goto-char (point-max))
  (cond ((looking-at "\\'")
	 (skip-chars-backward "\n")
	 (delete-region (point) (1- (point-max))))
	(t
	 (insert "\n")))
  ;; Reach the start of the log message (skip initial comment and blank
  ;; lines).
  (goto-char (point-min))
  (while (and (not (eobp)) (looking-at "[ \t]*#\\|$"))
    (forward-line))
  ;; Ensure there is something in the log message.
  (when (eobp)
    (save-excursion (insert "(none)\n")))
  ;; Write out the log message to the logmsg file.
  (unless (patcher-project-logmsg-file-name patcher-project)
    (setf (patcher-project-logmsg-file-name patcher-project)
	  (make-temp-name (expand-file-name "patch" (temp-directory)))))
  (write-region (point) (point-max)
		(patcher-project-logmsg-file-name patcher-project)
		nil 'silent)
  ;; Compute the final commit command.
  (let ((command (patcher-project-commit-command patcher-project)))
    (setq command
	  (let (case-fold-search)
	    (replace-in-string
	     command
	     "%S" (shell-quote-argument
		   ;; If the log message is put directly on the command line
		   ;; and not extracted from the logmsg file, take care of
		   ;; removing the final newline.
		   (buffer-substring (point) (1- (point-max)))) t)))
    (setq command
	  (replace-in-string command "%s"
			     (patcher-project-logmsg-file-name
			      patcher-project)
			     t))
    (setq command (patcher-command patcher-project command t))
    (let ((buffer (patcher-project-cmtcmd-buffer patcher-project)))
      (if buffer
	  (erase-buffer buffer)
	(setq buffer
	      (setf (patcher-project-cmtcmd-buffer patcher-project)
		    (generate-new-buffer
		     (format "*%s Patcher Project Commit Command*"
			 (patcher-project-name patcher-project)))))
	;; Do it first! It kills local variables.
	(with-current-buffer buffer
	  (patcher-cmtcmd-mode))
	(patcher-setup-auxiliary-buffer patcher-project buffer)))
    (if (not (patcher-project-option patcher-project :edit-commit-command))
	(with-current-buffer (patcher-project-cmtcmd-buffer patcher-project)
	  (patcher-cmtcmd-init command)
	  (patcher-condition-case nil
	      (patcher-cmtcmd-commit)
	    (commit
	     (if (interactive-p)
		 ;; we come from the LogMsg buffer.
		 (progn
		   (display-buffer
		    (patcher-project-process-buffer patcher-project)
		    t)
		   (with-current-buffer (patcher-project-logmsg-buffer
					 patcher-project)
		     (beep)
		     (patcher-message "\
Error during commit. Type \\[patcher-logmsg-commit] to try again.")))
	       ;; Otherwise, propagate to the caller.
	       (patcher-error 'commit command)))))
      (switch-to-buffer (patcher-project-cmtcmd-buffer patcher-project))
      (patcher-cmtcmd-init command))))

(defun patcher-logmsg-kill ()
  "Kill the project related to the current log message buffer."
  (interactive)
  (patcher-kill-project patcher-project))

(defun patcher-logmsg-cancel ()
  "Cancel the current log message."
  (interactive)
  (pop-window-configuration))

(defun patcher-logmsg-init ()
  "(Re)Init the log message in the current Patcher LogMsg buffer.

This is done conforming to the :log-message-items project option.
The actual log message starts at the first non-blank and non-comment line
in this buffer."
  (interactive)
  (erase-buffer)
  (insert-string
   (substitute-command-keys
    "\
# Edit / confirm the log message below.\n\
# - `\\[patcher-logmsg-commit]' to commit the project,\n\
# - `\\[patcher-logmsg-cancel]' to cancel the commit,\n\
# - `\\[patcher-logmsg-kill]' to kill the project.\n\n"))
  (let ((point (point))
	inserted)
    (dolist (item (patcher-project-option patcher-project :log-message-items))
      (setq inserted
	    (cond ((eq item 'subject)
		   (patcher-logmsg-insert-subject (and inserted "\n\n")))
		  ((eq item 'compressed-change-logs)
		   (patcher-logmsg-insert-compressed-change-logs
		    inserted
		    (and inserted "\n\n")))
		  ((eq item 'change-logs)
		   (patcher-logmsg-insert-change-logs
		    inserted
		    (and inserted "\n\n")))
		  (t
		   (patcher-error "invalid log message item: %s" item)))))
    (goto-char point)))

(defcustom patcher-logmsg-mode-hook nil
  "*Hook to run after setting up Patcher LogMsg mode."
  :group 'patcher-logmsg
  :type 'hook)

(defvar patcher-logmsg-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map [(control c) (control p) i] 'patcher-logmsg-init)
    (define-key map [(control c) (control p) s] 'patcher-logmsg-insert-subject)
    (define-key map [(control c) (control p) S] 'patcher-logmsg-change-subject)
    (define-key map [(control c) (control p) l]
      'patcher-logmsg-insert-change-logs)
    (define-key map [(control c) (control p) L]
      'patcher-logmsg-insert-compressed-change-logs)
    (define-key map [(control c) (control p) c] 'patcher-logmsg-commit)
    (define-key map [(control c) (control c)] 'patcher-logmsg-commit)
    (define-key map [(control c) (control z)] 'patcher-logmsg-cancel)
    (define-key map [(control c) (control k)] 'patcher-logmsg-kill)
    map))

(defun patcher-logmsg-mode ()
  "Major mode for Patcher commit log message management.

You're not supposed to use this mode manually, unless you know what you're
doing.

The following commands are available in a LogMsg buffer:
\\{patcher-logmsg-mode-map}"
  (interactive)
  (kill-all-local-variables)
  (setq major-mode 'patcher-logmsg)
  (setq mode-name "Patcher-LogMsg")
  (use-local-map patcher-logmsg-mode-map)
  (setq font-lock-keywords patcher-logmsg-font-lock-keywords)
  (run-hooks 'patcher-logmsg-mode-hook))


(provide 'patcher-logmsg)

;;; patcher-logmsg.el ends here