source: cl-darcs/trunk/pull.lisp

Last change on this file was 170, checked in by Magnus Henoch, 14 years ago

Adapt message when pull finished

File size: 4.2 KB
Line 
1;;; Copyright (C) 2006, 2007, 2008 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 &key (select-patches :ask))
20  "Pull new patches from THEIRREPO into OURREPO.
21If THEIRREPO is not specified, use default repository specified
22in preferences.
23SELECT-PATCHES specifies how to select which remote patches to pull.
24It can be one of:
25:ALL - pull all patches
26:ASK - ask for each patch through Y-OR-N-P
27a function - call this function with a NAMED-PATCH object, and
28             pull if it returns true"
29  (setf ourrepo (fad:pathname-as-directory ourrepo))
30  (unless theirrepo
31    (setf theirrepo (car (get-preflist ourrepo "defaultrepo")))
32    (unless theirrepo
33      (error "No remote repository specified, and no default available.")))
34  (add-to-preflist ourrepo "repos" (upath-to-string theirrepo))
35  (let ((motd (get-preflist theirrepo "motd")))
36    (when motd
37      (format t "~{~&~A~}" motd)))
38  (let ((our-patchinfo (read-repo-patch-list ourrepo))
39        (their-patchinfo (read-repo-patch-list theirrepo)))
40    (multiple-value-bind (common only-ours only-theirs)
41        (get-common-and-uncommon our-patchinfo their-patchinfo)
42      (declare (ignore common))
43
44      (when (null only-theirs)
45        (format t "~&No remote changes to pull in.")
46        (return-from pull))
47
48      (format t "~&Found these new patches:")
49      (dolist (p only-theirs)
50        (format t "~& - ~A" p))
51      (let* ((all-their-patches
52              (mapcar (lambda (patchinfo)
53                        (read-patch-from-repo theirrepo patchinfo))
54                      only-theirs))
55             (their-patches
56              (if (or (eq select-patches :all)
57                      (and (eq select-patches :ask)
58                           (y-or-n-p "Pull all patches?")))
59                  all-their-patches
60                  (select-patches all-their-patches 
61                                  (if (functionp select-patches)
62                                      select-patches
63                                      (lambda (patch) 
64                                        (display-patch patch *query-io*)
65                                        (y-or-n-p "Pull patch ~A? " patch))))))
66             (our-patches
67              (mapcar (lambda (patchinfo)
68                        (read-patch-from-repo ourrepo patchinfo))
69                      only-ours))
70             (merged-patches (patches
71                              (merge-patches (make-instance 'composite-patch
72                                                            :patches their-patches)
73                                             (make-instance 'composite-patch
74                                                            :patches our-patches)))))
75        (format t "~&Applying patches")
76        (let ((applying-to-source t)
77              (source-and-pristine-differ nil))
78          (dolist (p merged-patches)
79            ;; First, copy the modified patch to the repository.
80            (write-patch-to-repo p ourrepo)
81            ;; Then, apply it to the pristine copy.  This couldn't
82            ;; possibly fail.
83            (apply-patch-to-pristine p ourrepo)
84            ;; Note the patch in the inventory.
85            (append-inventory ourrepo (named-patch-patchinfo p))
86            ;; And finally apply the patch to the real source.  This
87            ;; could fail if the source has been modified.  Deal with
88            ;; that in a crude way.  XXX: it is wasteful to apply
89            ;; patches twice.
90            (when applying-to-source
91              (restart-case
92                  (apply-patch p ourrepo)
93                (skip-this ()
94                    :report "Don't apply this patch to the source tree (it was applied to the pristine tree)"
95                    (setf source-and-pristine-differ t))
96                (skip-all ()
97                    :report "Stop trying to apply patches to the source tree (they will be applied to the pristine tree)"
98                    (setf source-and-pristine-differ t)
99                    (setf applying-to-source nil))))
100            (princ #\.)
101            (force-output))
102          (when source-and-pristine-differ
103            (format t "~&~<Some patches could not be applied to the source tree.  ~
104You should manually merge changes from the pristine tree in _darcs/pristine/.~>" nil)))))
105    (format t "~&Finished pulling and applying.")))
Note: See TracBrowser for help on using the repository browser.