;;; Copyright (C) 2007 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 revert-changes (repo &key (select-patches :ask))
  "Revert unrecorded changes in REPO.
SELECT-PATCHES specifies how to select which patches to revert.
It can be one of:
:ALL - revert all patches
:ASK - ask for each patch through Y-OR-N-P
a function - call this function with a PATCH object, and
             revert if it returns true"
  (setf repo (fad:pathname-as-directory repo))
  
  (let* ((patches (diff-repo repo))
	 (patches-to-keep
	  (if (eql select-patches :all)
	      nil
	      (select-patches (copy-seq patches)
			      ;; here the sense of the predicate is
			      ;; inverted.
			      (case select-patches
				(:ask (lambda (p)
					(display-patch p *query-io*)
					(not (y-or-n-p "Revert this patch?"))))
				(t (complement select-patches)))))))
    ;; First revert all patches
    (format t "~&Reverting")
    (dolist (patch (reverse (mapcar #'invert-patch patches)))
      (apply-patch patch repo)
      (princ #\.)
      (force-output))

    (when patches-to-keep
      ;; Then reapply all patches we want to keep
      (format t "~&Reapplying")
      (dolist (patch patches-to-keep)
	(apply-patch patch repo)
	(princ #\.)
	(force-output)))))