July 2006 - cl-darcs-cvs@lists.common-lisp.net

[Cl-darcs-cvs] r34 - cl-darcs/trunk
by mhenoch＠common-lisp.net 15 Jul '06

15 Jul '06

Author: mhenoch Date: Sat Jul 15 07:40:12 2006 New Revision: 34 Modified: cl-darcs/trunk/pull.lisp Log: Use "defaultrepo" preference if no repo specified to pull from Modified: cl-darcs/trunk/pull.lisp ============================================================================== --- cl-darcs/trunk/pull.lisp (original) +++ cl-darcs/trunk/pull.lisp Sat Jul 15 07:40:12 2006 @@ -16,9 +16,15 @@ (in-package :darcs) -(defun pull (ourrepo theirrepo) - "Pull new patches from THEIRREPO into OURREPO." +(defun pull (ourrepo &optional theirrepo) + "Pull new patches from THEIRREPO into OURREPO. +If THEIRREPO is not specified, use default repositiory specified +in preferences." (setf ourrepo (fad:pathname-as-directory ourrepo)) + (unless theirrepo + (setf theirrepo (car (get-preflist ourrepo "defaultrepo"))) + (unless theirrepo + (error "No remote repositiory specified, and no default available."))) (let ((our-patchinfo (read-repo-patch-list ourrepo)) (their-patchinfo (read-repo-patch-list theirrepo))) (multiple-value-bind (common only-ours only-theirs)

1 0

[Cl-darcs-cvs] r33 - cl-darcs/trunk
by mhenoch＠common-lisp.net 15 Jul '06

15 Jul '06

Author: mhenoch Date: Sat Jul 15 07:33:00 2006 New Revision: 33 Modified: cl-darcs/trunk/cl-darcs.asd Log: Add pull.lisp to ASDF file Modified: cl-darcs/trunk/cl-darcs.asd ============================================================================== --- cl-darcs/trunk/cl-darcs.asd (original) +++ cl-darcs/trunk/cl-darcs.asd Sat Jul 15 07:33:00 2006 @@ -29,6 +29,7 @@ (:file "patchinfo" :depends-on ("util")) (:file "get" :depends-on ("util")) + (:file "pull" :depends-on ("util")) (:file "init" :depends-on ("util")) (:file "prefs" :depends-on ("util")) (:file "repo" :depends-on ("util"))

1 0

[Cl-darcs-cvs] r32 - cl-darcs/trunk
by mhenoch＠common-lisp.net 14 Jul '06

14 Jul '06

Author: mhenoch Date: Fri Jul 14 19:47:25 2006 New Revision: 32 Added: cl-darcs/trunk/pull.lisp Log: Add pull.lisp Added: cl-darcs/trunk/pull.lisp ============================================================================== --- (empty file) +++ cl-darcs/trunk/pull.lisp Fri Jul 14 19:47:25 2006 @@ -0,0 +1,52 @@ +;;; Copyright (C) 2006 Magnus Henoch +;;; +;;; This program is free software; you can redistribute it and/or +;;; modify it under the terms of the GNU General Public License as +;;; published by the Free Software Foundation; either version 2 of the +;;; License, or (at your option) any later version. +;;; +;;; This program is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;; General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with this program; if not, write to the Free Software +;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + +(in-package :darcs) + +(defun pull (ourrepo theirrepo) + "Pull new patches from THEIRREPO into OURREPO." + (setf ourrepo (fad:pathname-as-directory ourrepo)) + (let ((our-patchinfo (read-repo-patch-list ourrepo)) + (their-patchinfo (read-repo-patch-list theirrepo))) + (multiple-value-bind (common only-ours only-theirs) + (get-common-and-uncommon our-patchinfo their-patchinfo) + (declare (ignore common)) + (format t "~&Found these new patches:") + (dolist (p only-theirs) + (format t "~& - ~A" p)) + ;; XXX: This is where we pick which of their patches we want to + ;; pull. + (let* ((their-patches + (mapcar (lambda (pi) + (read-patch-from-repo theirrepo pi)) + only-theirs)) + (our-patches + (mapcar (lambda (pi) + (read-patch-from-repo ourrepo pi)) + only-ours)) + (merged-patches (patches + (merge-patches (make-instance 'composite-patch + :patches their-patches) + (make-instance 'composite-patch + :patches our-patches))))) + (format t "~&Applying patches") + (dolist (p merged-patches) + (apply-patch p ourrepo) + ;; If this is not a named patch, our assumptions are + ;; challenged. + (append-inventory ourrepo (named-patch-patchinfo p)) + (format t "."))))) + (format t "~&All done"))

1 0

[Cl-darcs-cvs] r31 - cl-darcs/trunk
by mhenoch＠common-lisp.net 14 Jul '06

14 Jul '06

Author: mhenoch Date: Fri Jul 14 19:47:12 2006 New Revision: 31 Modified: cl-darcs/trunk/repo.lisp Log: Add append-inventory function Modified: cl-darcs/trunk/repo.lisp ============================================================================== --- cl-darcs/trunk/repo.lisp (original) +++ cl-darcs/trunk/repo.lisp Fri Jul 14 19:47:12 2006 @@ -132,6 +132,20 @@ (write-byte 10 f) (print-patchinfos (car patchinfo-list))))))))) +(defun append-inventory (outrepo patchinfo) + "Append PATCHINFO to inventory in OUTREPO." + (with-open-file (f (merge-pathnames + (make-pathname :directory '(:relative "_darcs") + :name "inventory") + outrepo) + :direction :output :if-exists :append + :element-type '(unsigned-byte 8)) + (map nil (lambda (char) + (write-byte (char-code char) f)) + (with-output-to-string (strout) + (write-patchinfo patchinfo strout))) + (write-byte 10 f))) + (defun get-common-and-uncommon (ours theirs) "Given patchsets OURS and THEIRS, find common and uncommon patches. OURS and THEIRS are lists of lists of patchinfos, as returned by

1 0

[Cl-darcs-cvs] r30 - cl-darcs/trunk
by mhenoch＠common-lisp.net 14 Jul '06

14 Jul '06

Author: mhenoch Date: Fri Jul 14 19:46:56 2006 New Revision: 30 Modified: cl-darcs/trunk/patchinfo.lisp Log: Add print-object method for patchinfo structures Modified: cl-darcs/trunk/patchinfo.lisp ============================================================================== --- cl-darcs/trunk/patchinfo.lisp (original) +++ cl-darcs/trunk/patchinfo.lisp Fri Jul 14 19:46:56 2006 @@ -116,3 +116,10 @@ (setf (patchinfo-inverted copy) (not (patchinfo-inverted copy))) copy)) + +(defmethod print-object ((patchinfo patchinfo) stream) + (if *print-readably* + (call-next-method) + (format stream "~A ~A (~A)" (patchinfo-date patchinfo) + (patchinfo-name patchinfo) + (patchinfo-author patchinfo))))

1 0

[Cl-darcs-cvs] r29 - cl-darcs/trunk
by mhenoch＠common-lisp.net 12 Jul '06

12 Jul '06

Author: mhenoch Date: Wed Jul 12 15:09:17 2006 New Revision: 29 Modified: cl-darcs/trunk/merge.lisp Log: Implement merge-patches-after-patch Modified: cl-darcs/trunk/merge.lisp ============================================================================== --- cl-darcs/trunk/merge.lisp (original) +++ cl-darcs/trunk/merge.lisp Wed Jul 12 15:09:17 2006 @@ -80,4 +80,9 @@ (defun merge-patches-after-patch (p1s p2) "Create a variant of P1S that can be applied after P2. P1S is a list of patches; P2 is a patch." - (error "merge-patches-after-patch not yet implemented.")) + (destructuring-bind (p1-new p2-new) + (commute (merge-patch-after-patches p2 p1s) + (make-instance 'composite-patch :patches p1s)) + (declare (ignore p2-new)) + (patches p1-new))) +

1 0

[Cl-darcs-cvs] r28 - cl-darcs/trunk
by mhenoch＠common-lisp.net 12 Jul '06

12 Jul '06

Author: mhenoch Date: Wed Jul 12 15:06:02 2006 New Revision: 28 Modified: cl-darcs/trunk/commute.lisp Log: Add commute methods for composite patches Modified: cl-darcs/trunk/commute.lisp ============================================================================== --- cl-darcs/trunk/commute.lisp (original) +++ cl-darcs/trunk/commute.lisp Wed Jul 12 15:06:02 2006 @@ -77,3 +77,44 @@ ;; In other cases, there is no failsafe way to commute the ;; patches, so we give up. nil))))) + +(defmethod commute ((p2 composite-patch) (p1 patch)) + (cond + ;; Simple case first... + ((null (patches p2)) + (list p1 p2)) + (t + ;; Now, p1 was committed before all the patches in p2, and we + ;; want it to come after. + (let ((p2s (patches p2)) + p2s-new) + (loop for p in p2s + do (destructuring-bind (&optional p1-new p-new) + (commute p p1) + (cond + ((null p1-new) + (return-from commute (call-next-method))) + (t + (setf p1 p1-new) + (push p-new p2s-new))))) + (list p1 (make-instance 'composite-patch :patches (nreverse p2s-new))))))) +(defmethod commute ((p2 patch) (p1 composite-patch)) + (cond + ((null (patches p1)) + (list p1 p2)) + (t + ;; p2 was committed after all the patches in p1. Thus we start + ;; backwards in p1, commuting p2 with each of the patches. + (let ((p1s (reverse (patches p1))) + p1s-new) + (loop for p in p1s + do (destructuring-bind (&optional p-new p2-new) + (commute p2 p) + (cond + ((null p-new) + (return-from commute (call-next-method))) + (t + (setf p2 p2-new) + (push p-new p1s-new))))) + (list (make-instance 'composite-patch :patches p1s-new) + p2)))))

1 0

[Cl-darcs-cvs] r27 - cl-darcs/trunk
by mhenoch＠common-lisp.net 12 Jul '06

12 Jul '06

Author: mhenoch Date: Wed Jul 12 14:17:37 2006 New Revision: 27 Modified: cl-darcs/trunk/merge.lisp Log: Further hack merge.lisp Modified: cl-darcs/trunk/merge.lisp ============================================================================== --- cl-darcs/trunk/merge.lisp (original) +++ cl-darcs/trunk/merge.lisp Wed Jul 12 14:17:37 2006 @@ -16,11 +16,44 @@ (in-package :darcs) -(defun merge-patches (p1 p2) - "Create variant of P1 that can be applied after P2. +(defgeneric merge-patches (p1 p2) + (:documentation "Create variant of P1 that can be applied after P2. P1 and P2 are parallel patches, i.e. they apply to the same tree. We now want to apply P2 and then P1 to that tree. This function -returns a version of P1 that satisfies that constraint." +returns a version of P1 that satisfies that constraint.")) + +;; named patches +(defmethod merge-patches ((p1 named-patch) (p2 patch)) + (make-instance 'named-patch + :patchinfo (named-patch-patchinfo p1) + :dependencies (named-patch-dependencies p1) + :patch + (merge-patches (named-patch-patch p1) p2))) +(defmethod merge-patches ((p1 patch) (p2 named-patch)) + (merge-patches p1 (named-patch-patch p2))) + +;; composite patches +(defmethod merge-patches ((p1 composite-patch) (p2 composite-patch)) + (make-instance + 'composite-patch + :patches + (let ((patches1 (patches p1)) + (patches2 (patches p2))) + (cond + ((null patches1) + nil) + (t + (labels ((mc (p1s p2s) + (if (null p2s) + p1s + (mc (merge-patches-after-patch p1s (car p2s)) (cdr p2s))))) + (mc patches1 patches2))))))) +(defmethod merge-patches ((p1 composite-patch) (p2 patch)) + (make-instance 'composite-patch :patches (merge-patches-after-patch (patches p1) p2))) +(defmethod merge-patches ((p1 patch) (p2 composite-patch)) + (merge-patch-after-patches p1 (patches p2))) + +(defmethod merge-patches ((p1 patch) (p2 patch)) (or (elegant-merge p1 p2) (error "Couldn't merge ~A and ~A." p1 p2))) @@ -36,3 +69,15 @@ (declare (ignore p2-old)) (when (equal-patch p1 p1-old t) p1-new))))) + +(defun merge-patch-after-patches (p1 p2s) + "Create a variant of P1 that can be applied after all of P2S. +P1 is a patch; P2S is a list of patches." + (loop for p2s-left on p2s + do (setf p1 (merge-patches p1 (car p2s-left)))) + p1) + +(defun merge-patches-after-patch (p1s p2) + "Create a variant of P1S that can be applied after P2. +P1S is a list of patches; P2 is a patch." + (error "merge-patches-after-patch not yet implemented."))

1 0

[Cl-darcs-cvs] r26 - cl-darcs/trunk
by mhenoch＠common-lisp.net 12 Jul '06

12 Jul '06

Author: mhenoch Date: Wed Jul 12 11:30:01 2006 New Revision: 26 Added: cl-darcs/trunk/merge.lisp Modified: cl-darcs/trunk/cl-darcs.asd Log: Add merge.lisp Modified: cl-darcs/trunk/cl-darcs.asd ============================================================================== --- cl-darcs/trunk/cl-darcs.asd (original) +++ cl-darcs/trunk/cl-darcs.asd Wed Jul 12 11:30:01 2006 @@ -39,6 +39,7 @@ (:file "invert-patch" :depends-on ("patch-core")) (:file "touching" :depends-on ("patch-core")) (:file "commute" :depends-on ("patch-core")) + (:file "merge" :depends-on ("patch-core")) (:file "unwind" :depends-on ("patch-core")) (:file "equal" :depends-on ("patch-core")) Added: cl-darcs/trunk/merge.lisp ============================================================================== --- (empty file) +++ cl-darcs/trunk/merge.lisp Wed Jul 12 11:30:01 2006 @@ -0,0 +1,38 @@ +;;; Copyright (C) 2006 Magnus Henoch +;;; +;;; This program is free software; you can redistribute it and/or +;;; modify it under the terms of the GNU General Public License as +;;; published by the Free Software Foundation; either version 2 of the +;;; License, or (at your option) any later version. +;;; +;;; This program is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;; General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with this program; if not, write to the Free Software +;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + +(in-package :darcs) + +(defun merge-patches (p1 p2) + "Create variant of P1 that can be applied after P2. +P1 and P2 are parallel patches, i.e. they apply to the same tree. +We now want to apply P2 and then P1 to that tree. This function +returns a version of P1 that satisfies that constraint." + (or (elegant-merge p1 p2) + (error "Couldn't merge ~A and ~A." p1 p2))) + +(defun elegant-merge (p1 p2) + ;; A piece of patch algebra. See PatchCommute.lhs for the + ;; explanation. + (destructuring-bind (&optional p2-new p1-new) + (commute p1 (invert-patch p2)) + (declare (ignore p2-new)) + (when p1-new + (destructuring-bind (&optional p2-old p1-old) + (commute p1-new p2) + (declare (ignore p2-old)) + (when (equal-patch p1 p1-old t) + p1-new)))))

1 0

[Cl-darcs-cvs] r25 - cl-darcs/trunk
by mhenoch＠common-lisp.net 12 Jul '06

12 Jul '06

Author: mhenoch Date: Wed Jul 12 10:59:30 2006 New Revision: 25 Modified: cl-darcs/trunk/commute.lisp cl-darcs/trunk/equal.lisp cl-darcs/trunk/unwind.lisp Log: Add license notices Modified: cl-darcs/trunk/commute.lisp ============================================================================== --- cl-darcs/trunk/commute.lisp (original) +++ cl-darcs/trunk/commute.lisp Wed Jul 12 10:59:30 2006 @@ -1,3 +1,19 @@ +;;; Copyright (C) 2006 Magnus Henoch +;;; +;;; This program is free software; you can redistribute it and/or +;;; modify it under the terms of the GNU General Public License as +;;; published by the Free Software Foundation; either version 2 of the +;;; License, or (at your option) any later version. +;;; +;;; This program is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;; General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with this program; if not, write to the Free Software +;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + (in-package :darcs) (defgeneric commute (p2 p1) Modified: cl-darcs/trunk/equal.lisp ============================================================================== --- cl-darcs/trunk/equal.lisp (original) +++ cl-darcs/trunk/equal.lisp Wed Jul 12 10:59:30 2006 @@ -1,3 +1,19 @@ +;;; Copyright (C) 2006 Magnus Henoch +;;; +;;; This program is free software; you can redistribute it and/or +;;; modify it under the terms of the GNU General Public License as +;;; published by the Free Software Foundation; either version 2 of the +;;; License, or (at your option) any later version. +;;; +;;; This program is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;; General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with this program; if not, write to the Free Software +;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + (in-package :darcs) (defun equal-list (predicate a b) Modified: cl-darcs/trunk/unwind.lisp ============================================================================== --- cl-darcs/trunk/unwind.lisp (original) +++ cl-darcs/trunk/unwind.lisp Wed Jul 12 10:59:30 2006 @@ -1,3 +1,19 @@ +;;; Copyright (C) 2006 Magnus Henoch +;;; +;;; This program is free software; you can redistribute it and/or +;;; modify it under the terms of the GNU General Public License as +;;; published by the Free Software Foundation; either version 2 of the +;;; License, or (at your option) any later version. +;;; +;;; This program is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;; General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with this program; if not, write to the Free Software +;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + (in-package :darcs) ;; From PatchCommute.lhs

1 0