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. |
---|
21 | If THEIRREPO is not specified, use default repositiory specified |
---|
22 | in 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 | (add-to-preflist ourrepo "repos" theirrepo) |
---|
29 | (let ((motd (get-preflist theirrepo "motd"))) |
---|
30 | (when motd |
---|
31 | (format t "~{~&~A~}" motd))) |
---|
32 | (let ((our-patchinfo (read-repo-patch-list ourrepo)) |
---|
33 | (their-patchinfo (read-repo-patch-list theirrepo))) |
---|
34 | (multiple-value-bind (common only-ours only-theirs) |
---|
35 | (get-common-and-uncommon our-patchinfo their-patchinfo) |
---|
36 | (declare (ignore common)) |
---|
37 | (format t "~&Found these new patches:") |
---|
38 | (dolist (p only-theirs) |
---|
39 | (format t "~& - ~A" p)) |
---|
40 | (let* ((all-their-patches |
---|
41 | (mapcar (lambda (patchinfo) |
---|
42 | (read-patch-from-repo theirrepo patchinfo)) |
---|
43 | only-theirs)) |
---|
44 | (their-patches |
---|
45 | (if (y-or-n-p "Pull all patches?") |
---|
46 | all-their-patches |
---|
47 | (select-patches all-their-patches))) |
---|
48 | (our-patches |
---|
49 | (mapcar (lambda (patchinfo) |
---|
50 | (read-patch-from-repo ourrepo patchinfo)) |
---|
51 | only-ours)) |
---|
52 | (merged-patches (patches |
---|
53 | (merge-patches (make-instance 'composite-patch |
---|
54 | :patches their-patches) |
---|
55 | (make-instance 'composite-patch |
---|
56 | :patches our-patches))))) |
---|
57 | (format t "~&Applying patches") |
---|
58 | (let ((applying-to-source t) |
---|
59 | (source-and-pristine-differ nil)) |
---|
60 | (dolist (p merged-patches) |
---|
61 | ;; First, copy the modified patch to the repository. |
---|
62 | (write-patch-to-repo p ourrepo) |
---|
63 | ;; Then, apply it to the pristine copy. This couldn't |
---|
64 | ;; possibly fail. |
---|
65 | (apply-patch-to-pristine p ourrepo) |
---|
66 | ;; Note the patch in the inventory. |
---|
67 | (append-inventory ourrepo (named-patch-patchinfo p)) |
---|
68 | ;; And finally apply the patch to the real source. This |
---|
69 | ;; could fail if the source has been modified. Deal with |
---|
70 | ;; that in a crude way. XXX: it is wasteful to apply |
---|
71 | ;; patches twice. |
---|
72 | (when applying-to-source |
---|
73 | (restart-case |
---|
74 | (apply-patch p ourrepo) |
---|
75 | (skip-this () |
---|
76 | :report "Don't apply this patch to the source tree (it was applied to the pristine tree)" |
---|
77 | (setf source-and-pristine-differ t)) |
---|
78 | (skip-all () |
---|
79 | :report "Stop trying to apply patches to the source tree (they will be applied to the pristine tree)" |
---|
80 | (setf source-and-pristine-differ t) |
---|
81 | (setf applying-to-source nil)))) |
---|
82 | (format t ".")) |
---|
83 | (when source-and-pristine-differ |
---|
84 | (format t "~&~<Some patches could not be applied to the source tree. ~ |
---|
85 | You should manually merge changes from the pristine tree in _darcs/pristine/.~>" nil))))) |
---|
86 | (format t "~&All done"))) |
---|