source: cl-darcs/tags/0.1.0/pull.lisp

Last change on this file was 51, checked in by Magnus Henoch, 16 years ago

Add functions for keeping a pristine. Use it when getting and pulling.

File size: 3.3 KB
Line 
1;;; Copyright (C) 2006 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 pull (ourrepo &optional theirrepo)
20  "Pull new patches from THEIRREPO into OURREPO.
21If THEIRREPO is not specified, use default repositiory specified
22in preferences."
23  (setf ourrepo (fad:pathname-as-directory ourrepo))
24  (unless theirrepo
25    (setf theirrepo (car (get-preflist ourrepo "defaultrepo")))
26    (unless theirrepo
27      (error "No remote repositiory specified, and no default available.")))
28  (let ((our-patchinfo (read-repo-patch-list ourrepo))
29        (their-patchinfo (read-repo-patch-list theirrepo)))
30    (multiple-value-bind (common only-ours only-theirs)
31        (get-common-and-uncommon our-patchinfo their-patchinfo)
32      (declare (ignore common))
33      (format t "~&Found these new patches:")
34      (dolist (p only-theirs)
35        (format t "~& - ~A" p))
36      ;; XXX: This is where we pick which of their patches we want to
37      ;; pull.
38      (let* ((their-patches
39              (mapcar (lambda (pi)
40                        (read-patch-from-repo theirrepo pi))
41                      only-theirs))
42             (our-patches
43              (mapcar (lambda (pi)
44                        (read-patch-from-repo ourrepo pi))
45                      only-ours))
46             (merged-patches (patches
47                              (merge-patches (make-instance 'composite-patch
48                                                            :patches their-patches)
49                                             (make-instance 'composite-patch
50                                                            :patches our-patches)))))
51        (format t "~&Applying patches")
52        (let ((applying-to-source t)
53              (source-and-pristine-differ nil))
54          (dolist (p merged-patches)
55            ;; First, copy the modified patch to the repository.
56            (write-patch-to-repo p ourrepo)
57            ;; Then, apply it to the pristine copy.  This couldn't
58            ;; possibly fail.
59            (apply-patch-to-pristine p ourrepo)
60            ;; Note the patch in the inventory.
61            (append-inventory ourrepo (named-patch-patchinfo p))
62            ;; And finally apply the patch to the real source.  This
63            ;; could fail if the source has been modified.  Deal with
64            ;; that in a crude way.  XXX: it is wasteful to apply
65            ;; patches twice.
66            (when applying-to-source
67              (restart-case
68                  (apply-patch p ourrepo)
69                (skip-this ()
70                    :report "Don't apply this patch to the source tree (it was applied to the pristine tree)"
71                    (setf source-and-pristine-differ t))
72                (skip-all ()
73                    :report "Stop trying to apply patches to the source tree (they will be applied to the pristine tree)"
74                    (setf source-and-pristine-differ t)
75                    (setf applying-to-source nil))))
76            (format t "."))
77          (when source-and-pristine-differ
78            (format t "~&~<Some patches could not be applied to the source tree.~
79You should manually merge changes from the pristine tree in _darcs/pristine/.~:@>")))))
80    (format t "~&All done")))
Note: See TracBrowser for help on using the repository browser.