;;; Copyright (C) 2006, 2008 Magnus Henoch
;;;
;;; 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 of the
;;; License, 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 this program; if not, write to the Free Software
;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA

(in-package :darcs)

(defun record-patches (repo name author date log patches)
  "Record PATCHES in REPO.
NAME is the name of the patch, a description of one line.
AUTHOR is the e-mail address (or other identifier) of the author.
DATE is the date in YYYYMMDDHHMMSS format, or the keyword :NOW.
LOG is either NIL or a possibly multi-line description of the patch.
PATCHES is a list of patches that make up the change."
  (let* ((patchinfo
	  (make-patchinfo
	   :name name :author author
	   :date (if (eql date :now)
		     (multiple-value-bind
			   (second minute hour date month year)
			 (get-decoded-time)
		       (format nil "~4,'0d~2,'0d~2,'0d~2,'0d~2,'0d~2,'0d"
			       year month date hour minute second))
		     date)
	   :log (when log
		    (split-sequence:split-sequence #\Newline log))))
	 (patch (make-instance 'named-patch
			       :patchinfo patchinfo
			       :dependencies nil
			       :patch
			       (make-instance 'composite-patch
					      :patches patches))))
    (write-patch-to-repo patch repo)
    (apply-patch-to-pristine patch repo)
    (remove-matching-from-pending repo patches)
    (append-inventory repo patchinfo)))

(defun record-changes (repo name author date log)
  "Record changes in REPO.
Arguments as to `record-patches'."
  (let ((patches (diff-repo repo)))
    (flet ((ask (patch)
	     (display-patch patch *query-io*)
	     (y-or-n-p "Record patch ~A? " patch)))
      (unless patches
	(error "Nothing to record."))

      (record-patches repo name author date log (select-patches patches #'ask)))))

(defun select-patches (patches predicate)
  "Select some of PATCHES using PREDICATE.
Do the necessary commutation and dependency elimination."
  (let (patches-to-record)
    (loop while (setf patches (remove nil patches))
       do
       ;; Should we include this patch? 
       (if (funcall predicate (car patches))
	   (progn
	     ;; Yes, just add it to the list and go on.
	     (push (car patches) patches-to-record)
	     (setf patches (cdr patches)))
	   ;; No, we need to commute it through the rest of the patches.
	   (loop for commute-patches on (cdr patches)
	      ;; Try to commute it with the next patch in line.
	      do (let ((commute-result (commute (car commute-patches) (car patches))))
		   (if commute-result
		       ;; Commutation succeeded; use the altered patches.
		       (destructuring-bind (commuted-current commuted-future) commute-result
			 (setf (car patches) commuted-current)
			 (setf (car commute-patches) commuted-future))
		       ;; Commutation failed; (car commute-patches) depends on (car patches).
		       ;; Try to commute them together.
		       (progn
			 ;; Turn the patch we are commuting through
			 ;; the list into a composite patch, unless it is
			 ;; one already.  Append the dependency.
			 (etypecase (car patches)
			   (composite-patch
			    (nconc (patches (car patches))
				   (list (car commute-patches))))
			   (patch
			    (setf (car patches)
				  (make-instance 'composite-patch
						 :patches (list
							   (car patches)
							   (car commute-patches))))))
			 ;; Drop the dependency from the list of
			 ;; patches to consider.
			 (setf (car commute-patches) nil))))
	      finally (setf patches (cdr patches)))))
    (nreverse patches-to-record)))