From mhenoch at common-lisp.net Fri Oct 6 17:07:36 2006 From: mhenoch at common-lisp.net (mhenoch at common-lisp.net) Date: Fri, 6 Oct 2006 13:07:36 -0400 (EDT) Subject: [Cl-darcs-cvs] r43 - cl-darcs/trunk Message-ID: <20061006170736.B0D787603F@common-lisp.net> Author: mhenoch Date: Fri Oct 6 13:07:36 2006 New Revision: 43 Modified: cl-darcs/trunk/util.lisp Log: Add copy-directory. Modified: cl-darcs/trunk/util.lisp ============================================================================== --- cl-darcs/trunk/util.lisp (original) +++ cl-darcs/trunk/util.lisp Fri Oct 6 13:07:36 2006 @@ -215,3 +215,31 @@ #+sbcl (sb-posix:rmdir pathname) #-(or clisp sbcl) (error "DELETE-DIR not implemented for ~A." (lisp-implementation-type))) + +(defun copy-directory (source target &key excluding) + "Copy all files and directories in SOURCE to TARGET. +SOURCE and TARGET are pathnames designating directories, both of +which must exist. EXCLUDING is a list of files and directories +to exclude. + +Symlinks will confuse the function." + (setq excluding (mapcar #'truename excluding)) + (let* ((wild (make-pathname :directory '(:relative :wild-inferiors) + :name :wild + :type :wild + :version :wild)) + (source-wild (merge-pathnames wild source)) + (target-wild (merge-pathnames wild target)) + + (files (fad:list-directory (truename source)))) + (dolist (source-file files) + (let ((target-file (translate-pathname source-file source-wild target-wild))) + (cond + ((member source-file excluding :test #'equal) + ;; File excluded - do nothing. + ) + ((fad:directory-pathname-p source-file) + (make-dir target-file) + (copy-directory source-file target-file)) + (t + (fad:copy-file source-file target-file))))))) From mhenoch at common-lisp.net Fri Oct 6 18:51:38 2006 From: mhenoch at common-lisp.net (mhenoch at common-lisp.net) Date: Fri, 6 Oct 2006 14:51:38 -0400 (EDT) Subject: [Cl-darcs-cvs] r44 - cl-darcs/trunk Message-ID: <20061006185138.A972A52004@common-lisp.net> Author: mhenoch Date: Fri Oct 6 14:51:38 2006 New Revision: 44 Modified: cl-darcs/trunk/util.lisp Log: Fix the exclusion feature of copy-directory. Modified: cl-darcs/trunk/util.lisp ============================================================================== --- cl-darcs/trunk/util.lisp (original) +++ cl-darcs/trunk/util.lisp Fri Oct 6 14:51:38 2006 @@ -223,23 +223,25 @@ to exclude. Symlinks will confuse the function." - (setq excluding (mapcar #'truename excluding)) (let* ((wild (make-pathname :directory '(:relative :wild-inferiors) :name :wild :type :wild :version :wild)) (source-wild (merge-pathnames wild source)) (target-wild (merge-pathnames wild target)) + (excluding-wild (mapcar + (lambda (excluded) (merge-pathnames wild excluded)) + excluding)) (files (fad:list-directory (truename source)))) (dolist (source-file files) (let ((target-file (translate-pathname source-file source-wild target-wild))) (cond - ((member source-file excluding :test #'equal) + ((some (lambda (excluded) (pathname-match-p source-file excluded)) excluding-wild) ;; File excluded - do nothing. ) ((fad:directory-pathname-p source-file) (make-dir target-file) - (copy-directory source-file target-file)) + (copy-directory source-file target-file :excluding excluding)) (t (fad:copy-file source-file target-file))))))) From mhenoch at common-lisp.net Fri Oct 6 19:18:24 2006 From: mhenoch at common-lisp.net (mhenoch at common-lisp.net) Date: Fri, 6 Oct 2006 15:18:24 -0400 (EDT) Subject: [Cl-darcs-cvs] r45 - cl-darcs/trunk Message-ID: <20061006191824.EA7F052019@common-lisp.net> Author: mhenoch Date: Fri Oct 6 15:18:24 2006 New Revision: 45 Modified: cl-darcs/trunk/util.lisp Log: Add function pathname-to-string Modified: cl-darcs/trunk/util.lisp ============================================================================== --- cl-darcs/trunk/util.lisp (original) +++ cl-darcs/trunk/util.lisp Fri Oct 6 15:18:24 2006 @@ -201,6 +201,21 @@ (make-pathname :directory (cons :relative directory) :name filename-without-dot :type type)))))) +(defun pathname-to-string (pathname) + "Convert PATHNAME to a string usable in darcs patch files. +PATHNAME is assumed to be a relative pathname going strictly down, +as returned by SANITIZE-FILENAME." + (apply #'concatenate 'string + "./" + (append + (mapcan (lambda (d) + (list d "/")) + (cdr (pathname-directory pathname))) + (when (pathname-name pathname) + (cons (pathname-name pathname) + (when (pathname-type pathname) + (list "." (pathname-type pathname)))))))) + (defun make-dir (pathname) "Create directory PATHNAME." (with-simple-restart (ignore-error "Ignore ~A directory creation error." pathname) From mhenoch at common-lisp.net Fri Oct 6 19:20:19 2006 From: mhenoch at common-lisp.net (mhenoch at common-lisp.net) Date: Fri, 6 Oct 2006 15:20:19 -0400 (EDT) Subject: [Cl-darcs-cvs] r46 - cl-darcs/trunk Message-ID: <20061006192019.DF9AC52016@common-lisp.net> Author: mhenoch Date: Fri Oct 6 15:20:19 2006 New Revision: 46 Modified: cl-darcs/trunk/write-patch.lisp Log: Use pathname-to-string in write-patch Modified: cl-darcs/trunk/write-patch.lisp ============================================================================== --- cl-darcs/trunk/write-patch.lisp (original) +++ cl-darcs/trunk/write-patch.lisp Fri Oct 6 15:20:19 2006 @@ -50,7 +50,7 @@ (write-as-bytes (concatenate 'string "hunk " - (patch-filename patch) + (pathname-to-string (patch-filename patch)) (format nil " ~A" (hunk-line-number patch))) stream) (write-byte 10 stream) @@ -66,7 +66,7 @@ (defun write-token-and-filename (token filename stream) (write-as-bytes token stream) (write-byte 32 stream) - (write-as-bytes filename stream) + (write-as-bytes (pathname-to-string filename) stream) (write-byte 10 stream)) (defmethod write-patch ((patch add-file-patch) stream) @@ -102,7 +102,7 @@ (defmethod write-patch ((patch token-replace-patch) stream) (write-as-bytes (format nil "replace ~A [~A] ~A ~A" - (patch-filename patch) + (pathname-to-string (patch-filename patch)) (token-regexp patch) (old-token patch) (new-token patch)) @@ -138,8 +138,12 @@ (defmethod write-patch ((patch move-patch) stream) (write-sequence (string-to-bytes "move ") stream) - (write-sequence (string-to-bytes (patch-move-from patch)) stream) + (write-sequence (string-to-bytes + (pathname-to-string (patch-move-from patch))) + stream) (write-byte 32 stream) - (write-sequence (string-to-bytes (patch-move-to patch)) stream) + (write-sequence (string-to-bytes + (pathname-to-string + (patch-move-to patch))) stream) (write-byte 10 stream)) From mhenoch at common-lisp.net Fri Oct 6 19:49:24 2006 From: mhenoch at common-lisp.net (mhenoch at common-lisp.net) Date: Fri, 6 Oct 2006 15:49:24 -0400 (EDT) Subject: [Cl-darcs-cvs] r47 - cl-darcs/trunk Message-ID: <20061006194924.92CA258336@common-lisp.net> Author: mhenoch Date: Fri Oct 6 15:49:24 2006 New Revision: 47 Modified: cl-darcs/trunk/util.lisp Log: Add compress-file function Modified: cl-darcs/trunk/util.lisp ============================================================================== --- cl-darcs/trunk/util.lisp (original) +++ cl-darcs/trunk/util.lisp Fri Oct 6 15:49:24 2006 @@ -140,6 +140,20 @@ (util.zip:inflate in out) (dformat "done")))))) +(defun compress-file (infile outfile) + "Compress INFILE and write contents to OUTFILE." + (setf infile (make-upath infile)) + (cond + #+clisp + ((pathnamep infile) + (dformat "~&Compressing ~A through external program..." outfile) + (ext:run-program "gzip" :input (namestring infile) :output (namestring outfile) + :if-output-exists :error) + (dformat "done")) + (t + (cerror "Assume compression performed." + "Don't know how to gzip ~A to ~A." infile outfile)))) + (defun make-temp-file-name () "Create a random name for a temporary file. This is hopefully random enough to avoid problems." From mhenoch at common-lisp.net Fri Oct 6 19:49:46 2006 From: mhenoch at common-lisp.net (mhenoch at common-lisp.net) Date: Fri, 6 Oct 2006 15:49:46 -0400 (EDT) Subject: [Cl-darcs-cvs] r48 - cl-darcs/trunk Message-ID: <20061006194946.37F1858336@common-lisp.net> Author: mhenoch Date: Fri Oct 6 15:49:46 2006 New Revision: 48 Modified: cl-darcs/trunk/write-patch.lisp Log: Use compress-file in write-patch-to-repo Modified: cl-darcs/trunk/write-patch.lisp ============================================================================== --- cl-darcs/trunk/write-patch.lisp (original) +++ cl-darcs/trunk/write-patch.lisp Fri Oct 6 15:49:46 2006 @@ -17,14 +17,16 @@ (in-package :darcs) (defun write-patch-to-repo (patch repo) - "Write the named patch PATCH to REPO, under correct filename." + "Write the named patch PATCH to REPO, compressed, under correct filename." (let ((filename (upath-subdir repo '("_darcs" "patches") (patchinfo-make-filename (named-patch-patchinfo patch))))) - (with-open-file (out filename :direction :output :element-type '(unsigned-byte 8) - :if-exists :error) - (write-patch patch out)))) + (with-temp-file-name tmp-file + (with-open-file (out tmp-file :direction :output :element-type '(unsigned-byte 8) + :if-exists :error) + (write-patch patch out)) + (compress-file tmp-file filename)))) (defgeneric write-patch (patch stream) (:documentation "Write PATCH to STREAM, in darcs patch format. From mhenoch at common-lisp.net Fri Oct 6 19:50:11 2006 From: mhenoch at common-lisp.net (mhenoch at common-lisp.net) Date: Fri, 6 Oct 2006 15:50:11 -0400 (EDT) Subject: [Cl-darcs-cvs] r49 - cl-darcs/trunk Message-ID: <20061006195011.E4B9658362@common-lisp.net> Author: mhenoch Date: Fri Oct 6 15:50:11 2006 New Revision: 49 Modified: cl-darcs/trunk/write-patch.lisp Log: Write newline after { when writing composite patches Modified: cl-darcs/trunk/write-patch.lisp ============================================================================== --- cl-darcs/trunk/write-patch.lisp (original) +++ cl-darcs/trunk/write-patch.lisp Fri Oct 6 15:50:11 2006 @@ -43,6 +43,7 @@ (defmethod write-patch ((patch composite-patch) stream) (write-as-byte #\{ stream) + (write-byte 10 stream) (dolist (part (patches patch)) (write-patch part stream)) (write-as-byte #\} stream) From mhenoch at common-lisp.net Fri Oct 6 19:50:49 2006 From: mhenoch at common-lisp.net (mhenoch at common-lisp.net) Date: Fri, 6 Oct 2006 15:50:49 -0400 (EDT) Subject: [Cl-darcs-cvs] r50 - cl-darcs/trunk Message-ID: <20061006195049.4658858362@common-lisp.net> Author: mhenoch Date: Fri Oct 6 15:50:49 2006 New Revision: 50 Modified: cl-darcs/trunk/cl-darcs.asd Log: Load write-patch.lisp in ASDF file Modified: cl-darcs/trunk/cl-darcs.asd ============================================================================== --- cl-darcs/trunk/cl-darcs.asd (original) +++ cl-darcs/trunk/cl-darcs.asd Fri Oct 6 15:50:49 2006 @@ -36,6 +36,7 @@ (:file "patch-core" :depends-on ("util")) (:file "read-patch" :depends-on ("patch-core")) + (:file "write-patch" :depends-on ("patch-core")) (:file "apply-patch" :depends-on ("patch-core")) (:file "invert-patch" :depends-on ("patch-core")) (:file "touching" :depends-on ("patch-core")) From mhenoch at common-lisp.net Fri Oct 6 19:55:15 2006 From: mhenoch at common-lisp.net (mhenoch at common-lisp.net) Date: Fri, 6 Oct 2006 15:55:15 -0400 (EDT) Subject: [Cl-darcs-cvs] r51 - cl-darcs/trunk Message-ID: <20061006195515.858E158335@common-lisp.net> Author: mhenoch Date: Fri Oct 6 15:55:15 2006 New Revision: 51 Added: cl-darcs/trunk/pristine.lisp Modified: cl-darcs/trunk/get.lisp cl-darcs/trunk/pull.lisp Log: Add functions for keeping a pristine. Use it when getting and pulling. Modified: cl-darcs/trunk/get.lisp ============================================================================== --- cl-darcs/trunk/get.lisp (original) +++ cl-darcs/trunk/get.lisp Fri Oct 6 15:55:15 2006 @@ -64,6 +64,8 @@ ;; What happens when adding patches one by one? (append-inventory outname patchinfo) (format t "."))) + (format t "~&Creating pristine") + (create-pristine-from-tree outname) (format t "~&All done")))) (defun select-some-patches (patchinfo-list) Added: cl-darcs/trunk/pristine.lisp ============================================================================== --- (empty file) +++ cl-darcs/trunk/pristine.lisp Fri Oct 6 15:55:15 2006 @@ -0,0 +1,28 @@ +;;; 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 create-pristine-from-tree (repodir) + "Copy the checked-out tree at REPODIR to get a pristine tree." + (let* ((darcs-dir (upath-subdir repodir '("_darcs"))) + (pristine-dir (upath-subdir darcs-dir '("pristine")))) + (make-dir pristine-dir) + (copy-directory repodir pristine-dir :excluding (list darcs-dir)))) + +(defun apply-patch-to-pristine (patch repodir) + "Apply PATCH to the pristine tree in REPODIR." + (apply-patch patch (upath-subdir repodir '("_darcs" "pristine")))) Modified: cl-darcs/trunk/pull.lisp ============================================================================== --- cl-darcs/trunk/pull.lisp (original) +++ cl-darcs/trunk/pull.lisp Fri Oct 6 15:55:15 2006 @@ -49,11 +49,32 @@ (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)) - (write-patch-to-repo p ourrepo) - (format t "."))))) - (format t "~&All done")) + (let ((applying-to-source t) + (source-and-pristine-differ nil)) + (dolist (p merged-patches) + ;; First, copy the modified patch to the repository. + (write-patch-to-repo p ourrepo) + ;; Then, apply it to the pristine copy. This couldn't + ;; possibly fail. + (apply-patch-to-pristine p ourrepo) + ;; Note the patch in the inventory. + (append-inventory ourrepo (named-patch-patchinfo p)) + ;; And finally apply the patch to the real source. This + ;; could fail if the source has been modified. Deal with + ;; that in a crude way. XXX: it is wasteful to apply + ;; patches twice. + (when applying-to-source + (restart-case + (apply-patch p ourrepo) + (skip-this () + :report "Don't apply this patch to the source tree (it was applied to the pristine tree)" + (setf source-and-pristine-differ t)) + (skip-all () + :report "Stop trying to apply patches to the source tree (they will be applied to the pristine tree)" + (setf source-and-pristine-differ t) + (setf applying-to-source nil)))) + (format t ".")) + (when source-and-pristine-differ + (format t "~&~"))))) + (format t "~&All done"))) From mhenoch at common-lisp.net Fri Oct 6 20:17:24 2006 From: mhenoch at common-lisp.net (mhenoch at common-lisp.net) Date: Fri, 6 Oct 2006 16:17:24 -0400 (EDT) Subject: [Cl-darcs-cvs] r52 - cl-darcs/trunk Message-ID: <20061006201724.C27503C018@common-lisp.net> Author: mhenoch Date: Fri Oct 6 16:17:24 2006 New Revision: 52 Modified: cl-darcs/trunk/README Log: Update README Modified: cl-darcs/trunk/README ============================================================================== --- cl-darcs/trunk/README (original) +++ cl-darcs/trunk/README Fri Oct 6 16:17:24 2006 @@ -19,8 +19,29 @@ To pull new patches from a repo (the address from the remote repo is optional, as it defaults to where you got the tree from): +(pull "/local/repo-dir/") +or (pull "/local/repo-dir/" "http://path/to/repo") +cl-darcs currently doesn't try to merge changes in your local tree +with patches you pull; you have to do that manually if you want to +edit files. + +* Known bugs and misfeatures + +Above all, cl-darcs is currently a read-only client. There is no +support for generating diffs or committing patches. + +Some combinations of merger patches are not properly handled. You +should be able to get a tree with a real darcs client, and then use +cl-darcs for pulling new patches. + +Repositories can be fetched only from local files and HTTP. + +Tags are not faithfully reproduced. + +Checkpoints are not used. + * Compatibility I primarily develop cl-darcs on CLISP, but try to keep it working on @@ -36,7 +57,8 @@ * Links Project page: http://common-lisp.net/project/cl-darcs/ -(the place to look for mailing lists) +Mailing list: cl-darcs-devel at common-lisp.net + http://common-lisp.net/cgi-bin/mailman/listinfo/cl-darcs-devel The original darcs: http://www.darcs.net/ From mhenoch at common-lisp.net Fri Oct 6 20:20:16 2006 From: mhenoch at common-lisp.net (mhenoch at common-lisp.net) Date: Fri, 6 Oct 2006 16:20:16 -0400 (EDT) Subject: [Cl-darcs-cvs] r53 - cl-darcs/trunk Message-ID: <20061006202016.298503D00B@common-lisp.net> Author: mhenoch Date: Fri Oct 6 16:20:15 2006 New Revision: 53 Modified: cl-darcs/trunk/README Log: More README hacking Modified: cl-darcs/trunk/README ============================================================================== --- cl-darcs/trunk/README (original) +++ cl-darcs/trunk/README Fri Oct 6 16:20:15 2006 @@ -9,24 +9,29 @@ At the REPL: (asdf:oos 'asdf:load-op :cl-darcs) -(in-package :cl-darcs) -(get-repo "http://path/to/repo" "/local/non-existent/directory/") +(darcs:get-repo "http://path/to/repo" "/local/non-existent/directory/") Or if you want to select which patches to apply: -(get-repo "http://path/to/repo" "/local/repo-dir/" :query t) +(darcs:get-repo "http://path/to/repo" "/local/repo-dir/" :query t) To pull new patches from a repo (the address from the remote repo is optional, as it defaults to where you got the tree from): -(pull "/local/repo-dir/") +(darcs:pull "/local/repo-dir/") or -(pull "/local/repo-dir/" "http://path/to/repo") +(darcs:pull "/local/repo-dir/" "http://path/to/repo") cl-darcs currently doesn't try to merge changes in your local tree with patches you pull; you have to do that manually if you want to edit files. +* Configuration + +cl-darcs can use an HTTP proxy: + +(setf darcs:*http-proxy* "proxy.example.com:3128") + * Known bugs and misfeatures Above all, cl-darcs is currently a read-only client. There is no From mhenoch at common-lisp.net Wed Oct 11 22:50:44 2006 From: mhenoch at common-lisp.net (mhenoch at common-lisp.net) Date: Wed, 11 Oct 2006 18:50:44 -0400 (EDT) Subject: [Cl-darcs-cvs] r54 - cl-darcs/trunk Message-ID: <20061011225044.EB5AC34052@common-lisp.net> Author: mhenoch Date: Wed Oct 11 18:50:44 2006 New Revision: 54 Modified: cl-darcs/trunk/cl-darcs.asd Log: Add pristine.lisp to ASDF file Modified: cl-darcs/trunk/cl-darcs.asd ============================================================================== --- cl-darcs/trunk/cl-darcs.asd (original) +++ cl-darcs/trunk/cl-darcs.asd Wed Oct 11 18:50:44 2006 @@ -39,6 +39,7 @@ (:file "write-patch" :depends-on ("patch-core")) (:file "apply-patch" :depends-on ("patch-core")) (:file "invert-patch" :depends-on ("patch-core")) + (:file "pristine" :depends-on ("patch-core")) (:file "touching" :depends-on ("patch-core")) (:file "commute" :depends-on ("patch-core")) (:file "merge" :depends-on ("patch-core")) From mhenoch at common-lisp.net Thu Oct 12 12:30:05 2006 From: mhenoch at common-lisp.net (mhenoch at common-lisp.net) Date: Thu, 12 Oct 2006 08:30:05 -0400 (EDT) Subject: [Cl-darcs-cvs] r55 - cl-darcs/trunk Message-ID: <20061012123005.B653659082@common-lisp.net> Author: mhenoch Date: Thu Oct 12 08:30:05 2006 New Revision: 55 Modified: cl-darcs/trunk/README Log: Mention diff command in README Modified: cl-darcs/trunk/README ============================================================================== --- cl-darcs/trunk/README (original) +++ cl-darcs/trunk/README Thu Oct 12 08:30:05 2006 @@ -24,7 +24,10 @@ cl-darcs currently doesn't try to merge changes in your local tree with patches you pull; you have to do that manually if you want to -edit files. +edit files. For now, you need an external tool to find the local +changes, e.g: + +diff -x _darcs -ru _darcs/pristine/ . * Configuration From mhenoch at common-lisp.net Thu Oct 12 12:38:15 2006 From: mhenoch at common-lisp.net (mhenoch at common-lisp.net) Date: Thu, 12 Oct 2006 08:38:15 -0400 (EDT) Subject: [Cl-darcs-cvs] r56 - cl-darcs/trunk Message-ID: <20061012123815.7CF4C59082@common-lisp.net> Author: mhenoch Date: Thu Oct 12 08:38:14 2006 New Revision: 56 Modified: cl-darcs/trunk/README Log: List dependencies in README. Modified: cl-darcs/trunk/README ============================================================================== --- cl-darcs/trunk/README (original) +++ cl-darcs/trunk/README Thu Oct 12 08:38:14 2006 @@ -56,6 +56,18 @@ SBCL as well. Users of non-Unix systems probably need to change MAKE-TEMP-FILE-NAME in util.lisp. +* Dependencies + + - split-sequence: http://www.cl-user.net/asp/libs/split-sequence + - Portable AllegroServe: http://portableaserve.sourceforge.net/ + - trivial-gray-streams: + http://www.cl-user.net/asp/libs/trivial-gray-streams + - Ironclad: http://www.cl-user.net/asp/libs/ironclad + - CL-FAD: http://weitz.de/cl-fad/ + - For CLISP, you need SB-SHA1: http://www.cliki.net/sb-sha1 + +All of these are ASDF-INSTALLable. + * License cl-darcs is covered by the GPL, like the original darcs client. From mhenoch at common-lisp.net Sat Oct 14 21:06:38 2006 From: mhenoch at common-lisp.net (mhenoch at common-lisp.net) Date: Sat, 14 Oct 2006 17:06:38 -0400 (EDT) Subject: [Cl-darcs-cvs] r57 - cl-darcs/tags/0.1.0 Message-ID: <20061014210638.ECC953700E@common-lisp.net> Author: mhenoch Date: Sat Oct 14 17:06:38 2006 New Revision: 57 Added: cl-darcs/tags/0.1.0/ - copied from r56, cl-darcs/trunk/ Log: Tag 0.1.0 From mhenoch at common-lisp.net Mon Oct 16 08:39:53 2006 From: mhenoch at common-lisp.net (mhenoch at common-lisp.net) Date: Mon, 16 Oct 2006 04:39:53 -0400 (EDT) Subject: [Cl-darcs-cvs] r58 - cl-darcs/trunk Message-ID: <20061016083953.8F6DE34001@common-lisp.net> Author: mhenoch Date: Mon Oct 16 04:39:52 2006 New Revision: 58 Modified: cl-darcs/trunk/patch-core.lisp cl-darcs/trunk/unreadable-stream.lisp Log: Use print-unreadable-object. Modified: cl-darcs/trunk/patch-core.lisp ============================================================================== --- cl-darcs/trunk/patch-core.lisp (original) +++ cl-darcs/trunk/patch-core.lisp Mon Oct 16 04:39:52 2006 @@ -24,10 +24,8 @@ :documentation "List of patches making up the composite patch."))) (defmethod print-object ((patch composite-patch) stream) - (if *print-readably* - (call-next-method) - (format stream "#<~A: ~W>" - (type-of patch) (patches patch)))) + (print-unreadable-object (patch stream :type t) + (write (patches patch) :stream stream))) (defclass split-patch (patch) ((patches :accessor patches :initarg :patches :initform ()))) @@ -37,8 +35,8 @@ (:documentation "Base class for patches affecting a single file.")) (defmethod print-object ((patch file-patch) stream) - (if *print-readably* (call-next-method) - (format stream "#<~A: ~A>" (type-of patch) (patch-filename patch)))) + (print-unreadable-object (patch stream :type t) + (princ (patch-filename patch) stream))) (defclass hunk-patch (file-patch) ((line-number :accessor hunk-line-number :initarg :line-number @@ -50,12 +48,12 @@ (:documentation "A single patch \"hunk\".")) (defmethod print-object ((patch hunk-patch) stream) - (if *print-readably* (call-next-method) - (format stream "#<~A: ~A ~A~[~:;~:*-~A~]~[~:;~:*+~A~]>" - (type-of patch) (patch-filename patch) - (hunk-line-number patch) - (length (hunk-old-lines patch)) - (length (hunk-new-lines patch))))) + (print-unreadable-object (patch stream :type t) + (format stream "~A ~A~[~:;~:*-~A~]~[~:;~:*+~A~]" + (patch-filename patch) + (hunk-line-number patch) + (length (hunk-old-lines patch)) + (length (hunk-new-lines patch))))) (defclass add-file-patch (file-patch) () @@ -81,18 +79,19 @@ (:documentation "A patch that replaces one token with another.")) (defmethod print-object ((patch token-replace-patch) stream) - (if *print-readably* (call-next-method) - (format stream "#<~A: ~A: s/~A/~A/ (~S)>" (type-of patch) (patch-filename patch) - (old-token patch) (new-token patch) - (token-regexp patch)))) + (print-unreadable-object (patch stream :type t) + (format stream "~A: s/~A/~A/ (~S)" + (patch-filename patch) + (old-token patch) (new-token patch) + (token-regexp patch)))) (defclass directory-patch (patch) ((directory :accessor patch-directory :initarg :directory)) (:documentation "Base class for patches affecting a directory.")) (defmethod print-object ((patch directory-patch) stream) - (if *print-readably* (call-next-method) - (format stream "#<~A: ~A>" (type-of patch) (patch-directory patch)))) + (print-unreadable-object (patch stream :type t) + (princ (patch-directory patch) stream))) (defclass add-dir-patch (directory-patch) () @@ -112,14 +111,12 @@ (:documentation "A named patch.")) ;XXX: what does that mean? (defmethod print-object ((patch named-patch) stream) - (if *print-readably* - (call-next-method) - (let ((patchinfo (named-patch-patchinfo patch))) - (format stream "#<~A: ~A ~A: ~<~W~:>>" - (type-of patch) - (patchinfo-date patchinfo) - (patchinfo-name patchinfo) - (named-patch-patch patch))))) + (print-unreadable-object (patch stream :type t) + (let ((patchinfo (named-patch-patchinfo patch))) + (format stream "~A ~A: ~<~W~:>" + (patchinfo-date patchinfo) + (patchinfo-name patchinfo) + (named-patch-patch patch))))) (defclass change-pref-patch (patch) ((pref :initarg :pref :accessor change-pref-which) @@ -128,13 +125,11 @@ (:documentation "A patch for changing a preference.")) (defmethod print-object ((patch change-pref-patch) stream) - (if *print-readably* - (call-next-method) - (format stream "#<~A: ~A: s/~S/~S/>" - (type-of patch) - (change-pref-which patch) - (change-pref-from patch) - (change-pref-to patch)))) + (print-unreadable-object (patch stream :type t) + (format stream "~A: s/~S/~S/" + (change-pref-which patch) + (change-pref-from patch) + (change-pref-to patch)))) (defclass move-patch (patch) ((from :initarg :from :accessor patch-move-from) @@ -142,12 +137,10 @@ (:documentation "A patch that moves a file.")) (defmethod print-object ((patch move-patch) stream) - (if *print-readably* - (call-next-method) - (format stream "#<~A: ~A -> ~A>" - (type-of patch) - (patch-move-from patch) - (patch-move-to patch)))) + (print-unreadable-object (patch stream :type t) + (format stream "~A -> ~A" + (patch-move-from patch) + (patch-move-to patch)))) ;; XXX: this class is probably incorrect and insufficient. (defclass merger-patch (patch) @@ -159,14 +152,12 @@ (unwindings :initarg :unwindings :accessor merger-unwindings))) (defmethod print-object ((patch merger-patch) stream) - (if *print-readably* - (call-next-method) - (format stream "#<~A ~:[(inverted) ~;~]~A: ~A ~A>" - (type-of patch) - (merger-inverted patch) - (merger-version patch) - (merger-first patch) - (merger-second patch)))) + (print-unreadable-object (patch stream :type t) + (format stream "~:[(inverted) ~;~]~A: ~A ~A" + (merger-inverted patch) + (merger-version patch) + (merger-first patch) + (merger-second patch)))) ;; There are more kinds of patches... let's implement them when need ;; arises. Modified: cl-darcs/trunk/unreadable-stream.lisp ============================================================================== --- cl-darcs/trunk/unreadable-stream.lisp (original) +++ cl-darcs/trunk/unreadable-stream.lisp Mon Oct 16 04:39:52 2006 @@ -190,5 +190,5 @@ (push (list 0 (length line) line :line) buffer)))) (defmethod print-object ((object unreadable-stream) stream) - (if *print-readably* (call-next-method) - (format stream "#<~A ~A ~A>" (type-of object) (slot-value object 'buffer) (slot-value object 'stream)))) + (print-unreadable-object (object stream :type t) + (format stream "~A ~A" (slot-value object 'buffer) (slot-value object 'stream)))) From mhenoch at common-lisp.net Sun Oct 22 12:26:31 2006 From: mhenoch at common-lisp.net (mhenoch at common-lisp.net) Date: Sun, 22 Oct 2006 08:26:31 -0400 (EDT) Subject: [Cl-darcs-cvs] r59 - cl-darcs/trunk Message-ID: <20061022122631.13EA150017@common-lisp.net> Author: mhenoch Date: Sun Oct 22 08:26:30 2006 New Revision: 59 Modified: cl-darcs/trunk/write-patch.lisp Log: Use write-as-bytes instead of write-sequence in WRITE-PATCH for CHANGE-PREF-PATCH. Modified: cl-darcs/trunk/write-patch.lisp ============================================================================== --- cl-darcs/trunk/write-patch.lisp (original) +++ cl-darcs/trunk/write-patch.lisp Sun Oct 22 08:26:30 2006 @@ -134,9 +134,9 @@ (write-as-bytes "changepref " stream) (write-as-bytes (change-pref-which patch) stream) (write-byte 10 stream) - (write-sequence (change-pref-from patch) stream) + (write-as-bytes (change-pref-from patch) stream) (write-byte 10 stream) - (write-sequence (change-pref-to patch) stream) + (write-as-bytes (change-pref-to patch) stream) (write-byte 10 stream)) (defmethod write-patch ((patch move-patch) stream) From mhenoch at common-lisp.net Sun Oct 22 12:38:57 2006 From: mhenoch at common-lisp.net (mhenoch at common-lisp.net) Date: Sun, 22 Oct 2006 08:38:57 -0400 (EDT) Subject: [Cl-darcs-cvs] r60 - cl-darcs/trunk Message-ID: <20061022123857.8E134553A5@common-lisp.net> Author: mhenoch Date: Sun Oct 22 08:38:57 2006 New Revision: 60 Modified: cl-darcs/trunk/apply-patch.lisp cl-darcs/trunk/prefs.lisp Log: Add has-prefs-dir. Don't apply CHANGE-PREF-PATCHes unless there is a prefs directory. Modified: cl-darcs/trunk/apply-patch.lisp ============================================================================== --- cl-darcs/trunk/apply-patch.lisp (original) +++ cl-darcs/trunk/apply-patch.lisp Sun Oct 22 08:38:57 2006 @@ -89,15 +89,18 @@ (apply-patch-list (patches patch) repodir)) (defmethod apply-patch ((patch change-pref-patch) repodir) - (with-accessors ((pref change-pref-which) - (from change-pref-from) - (to change-pref-to)) patch - (let ((old-value (or (get-pref repodir pref) ""))) - (unless (string= from old-value) - (warn - "While changing pref ~S to ~S, expected old value to be ~S, but it was ~S." - pref to from old-value)) - (set-pref repodir pref to)))) + ;; Maybe we're applying the patch to a pristine directory, in which + ;; case we don't care about preferences. + (when (has-prefs-dir repodir) + (with-accessors ((pref change-pref-which) + (from change-pref-from) + (to change-pref-to)) patch + (let ((old-value (or (get-pref repodir pref) ""))) + (unless (string= from old-value) + (warn + "While changing pref ~S to ~S, expected old value to be ~S, but it was ~S." + pref to from old-value)) + (set-pref repodir pref to))))) (defmethod apply-patch ((patch add-file-patch) repodir) "Create a file in REPODIR, by PATCH." Modified: cl-darcs/trunk/prefs.lisp ============================================================================== --- cl-darcs/trunk/prefs.lisp (original) +++ cl-darcs/trunk/prefs.lisp Sun Oct 22 08:38:57 2006 @@ -16,6 +16,13 @@ (in-package :darcs) +(defun has-prefs-dir (repo) + "Return true if REPO has a _darcs/prefs subdirectory." + ;; This is currently only used for checking whether we should write + ;; preferences, so it doesn't matter that this implementation + ;; doesn't work for HTTP. + (fad:directory-exists-p (upath-subdir repo '("_darcs" "prefs")))) + (defun read-prefs (upath) "Read all preferences from repository at UPATH. Return an alist with strings." From mhenoch at common-lisp.net Sun Oct 22 12:51:15 2006 From: mhenoch at common-lisp.net (mhenoch at common-lisp.net) Date: Sun, 22 Oct 2006 08:51:15 -0400 (EDT) Subject: [Cl-darcs-cvs] r61 - cl-darcs/trunk Message-ID: <20061022125115.396755F00C@common-lisp.net> Author: mhenoch Date: Sun Oct 22 08:51:15 2006 New Revision: 61 Modified: cl-darcs/trunk/write-patch.lisp Log: Add WRITE-PATCH method for MERGER-PATCH Modified: cl-darcs/trunk/write-patch.lisp ============================================================================== --- cl-darcs/trunk/write-patch.lisp (original) +++ cl-darcs/trunk/write-patch.lisp Sun Oct 22 08:51:15 2006 @@ -150,3 +150,12 @@ (patch-move-to patch))) stream) (write-byte 10 stream)) +(defmethod write-patch ((patch merger-patch) stream) + (write-as-bytes "merger " stream) + (write-as-bytes (merger-version patch) stream) + (write-as-bytes " (" stream) + (write-byte 10 stream) + (write-patch (merger-first patch) stream) + (write-patch (merger-second patch) stream) + (write-as-byte #\) stream) + (write-byte 10 stream))