source: cl-darcs/trunk/revert.lisp

Last change on this file was 115, checked in by Magnus Henoch, 15 years ago

Only print "Reapplying" when actually reapplying something

File size: 1.9 KB
Line 
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.
21SELECT-PATCHES specifies how to select which patches to revert.
22It can be one of:
23:ALL - revert all patches
24:ASK - ask for each patch through Y-OR-N-P
25a 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
Note: See TracBrowser for help on using the repository browser.