[Cl-darcs-cvs] r112 - cl-darcs/trunk

[mhenoch at common-lisp.net]

Author: mhenoch
Date: Thu Mar 15 21:47:47 2007
New Revision: 112

Added:
   cl-darcs/trunk/revert.lisp
Modified:
   cl-darcs/trunk/cl-darcs.asd
Log:
Add revert.lisp and REVERT-CHANGES


Modified: cl-darcs/trunk/cl-darcs.asd
==============================================================================
--- cl-darcs/trunk/cl-darcs.asd	(original)
+++ cl-darcs/trunk/cl-darcs.asd	Thu Mar 15 21:47:47 2007
@@ -54,6 +54,7 @@
    (:file "unwind" :depends-on ("patch-core"))
    (:file "equal" :depends-on ("patch-core"))
    (:file "send" :depends-on ("patch-core"))
+   (:file "revert" :depends-on ("patch-core"))
 
    ;; Franz' inflate implementation
    #-allegro (:file "ifstar")

Added: cl-darcs/trunk/revert.lisp
==============================================================================
--- (empty file)
+++ cl-darcs/trunk/revert.lisp	Thu Mar 15 21:47:47 2007
@@ -0,0 +1,54 @@
+;;; 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))
+
+    ;; Then reapply all patches we want to keep
+    (format t "~&Reapplying")
+    (dolist (patch patches-to-keep)
+      (apply-patch patch repo)
+      (princ #\.)
+      (force-output))))
+