| 1 | ;;; Copyright (C) 2007 Magnus Henoch |
|---|
| 2 | ;;; |
|---|
| 3 | ;;; This program is free software; you can redistribute it and/or |
|---|
| 4 | ;;; modify it under the terms of the GNU General Public License as |
|---|
| 5 | ;;; published by the Free Software Foundation; either version 2 of the |
|---|
| 6 | ;;; License, or (at your option) any later version. |
|---|
| 7 | ;;; |
|---|
| 8 | ;;; This program is distributed in the hope that it will be useful, |
|---|
| 9 | ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
|---|
| 10 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
|---|
| 11 | ;;; General Public License for more details. |
|---|
| 12 | ;;; |
|---|
| 13 | ;;; You should have received a copy of the GNU General Public License |
|---|
| 14 | ;;; along with this program; if not, write to the Free Software |
|---|
| 15 | ;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA |
|---|
| 16 | |
|---|
| 17 | (in-package :darcs) |
|---|
| 18 | |
|---|
| 19 | (defun revert-changes (repo &key (select-patches :ask)) |
|---|
| 20 | "Revert unrecorded changes in REPO. |
|---|
| 21 | SELECT-PATCHES specifies how to select which patches to revert. |
|---|
| 22 | It can be one of: |
|---|
| 23 | :ALL - revert all patches |
|---|
| 24 | :ASK - ask for each patch through Y-OR-N-P |
|---|
| 25 | a function - call this function with a PATCH object, and |
|---|
| 26 | revert if it returns true" |
|---|
| 27 | (setf repo (fad:pathname-as-directory repo)) |
|---|
| 28 | |
|---|
| 29 | (let* ((patches (diff-repo repo)) |
|---|
| 30 | (patches-to-keep |
|---|
| 31 | (if (eql select-patches :all) |
|---|
| 32 | nil |
|---|
| 33 | (select-patches (copy-seq patches) |
|---|
| 34 | ;; here the sense of the predicate is |
|---|
| 35 | ;; inverted. |
|---|
| 36 | (case select-patches |
|---|
| 37 | (:ask (lambda (p) |
|---|
| 38 | (display-patch p *query-io*) |
|---|
| 39 | (not (y-or-n-p "Revert this patch?")))) |
|---|
| 40 | (t (complement select-patches))))))) |
|---|
| 41 | ;; First revert all patches |
|---|
| 42 | (format t "~&Reverting") |
|---|
| 43 | (dolist (patch (reverse (mapcar #'invert-patch patches))) |
|---|
| 44 | (apply-patch patch repo) |
|---|
| 45 | (princ #\.) |
|---|
| 46 | (force-output)) |
|---|
| 47 | |
|---|
| 48 | (when patches-to-keep |
|---|
| 49 | ;; Then reapply all patches we want to keep |
|---|
| 50 | (format t "~&Reapplying") |
|---|
| 51 | (dolist (patch patches-to-keep) |
|---|
| 52 | (apply-patch patch repo) |
|---|
| 53 | (princ #\.) |
|---|
| 54 | (force-output))))) |
|---|
| 55 | |
|---|
