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)))) +