- cl-darcs-cvs@lists.common-lisp.net - mailman3.common-lisp.net

[Cl-darcs-cvs] r107 - cl-darcs/trunk
by mhenoch＠common-lisp.net 11 Mar '07

11 Mar '07

Author: mhenoch Date: Sat Mar 10 22:10:57 2007 New Revision: 107 Modified: cl-darcs/trunk/util.lisp Log: Fix EOF handling of READ-BINARY-LINE Modified: cl-darcs/trunk/util.lisp ============================================================================== --- cl-darcs/trunk/util.lisp (original) +++ cl-darcs/trunk/util.lisp Sat Mar 10 22:10:57 2007 @@ -96,10 +96,15 @@ Return a vector of binary values. Return EOF-VALUE if EOF-ERROR-P is nil and end-of-file occurs before any data is read." (multiple-value-bind (line delim) - (read-until 10 stream eof-error-p eof-value) - (if (or (not (zerop (length line))) (eql delim 10)) - line - delim))) + (read-until 10 stream nil :eof) + (cond + ;; nothing read, and we've reached the end + ((and (zerop (length line)) (eq delim :eof)) + (if eof-error-p + (error 'end-of-file :stream stream) + eof-value)) + (t + line)))) (defun read-token (stream) "Read and return a whitespace-separated token from STREAM.

1 0

[Cl-darcs-cvs] r106 - cl-darcs/trunk
by mhenoch＠common-lisp.net 10 Mar '07

10 Mar '07

Author: mhenoch Date: Sat Mar 10 18:04:14 2007 New Revision: 106 Modified: cl-darcs/trunk/pull.lisp cl-darcs/trunk/record.lisp Log: Make PULL conditionally interactive. SELECT-PATCHES now takes a predicate as second argument. Modified: cl-darcs/trunk/pull.lisp ============================================================================== --- cl-darcs/trunk/pull.lisp (original) +++ cl-darcs/trunk/pull.lisp Sat Mar 10 18:04:14 2007 @@ -16,10 +16,16 @@ (in-package :darcs) -(defun pull (ourrepo &optional theirrepo) +(defun pull (ourrepo &optional theirrepo &key (select-patches :ask)) "Pull new patches from THEIRREPO into OURREPO. If THEIRREPO is not specified, use default repositiory specified -in preferences." +in preferences. +SELECT-PATCHES specifies how to select which remote patches to pull. +It can be one of: +:ALL - pull all patches +:ASK - ask for each patch through Y-OR-N-P +a function - call this function with a NAMED-PATCH object, and + pull if it returns true" (setf ourrepo (fad:pathname-as-directory ourrepo)) (unless theirrepo (setf theirrepo (car (get-preflist ourrepo "defaultrepo"))) @@ -42,9 +48,16 @@ (read-patch-from-repo theirrepo patchinfo)) only-theirs)) (their-patches - (if (y-or-n-p "Pull all patches?") + (if (or (eq select-patches :all) + (and (eq select-patches :ask) + (y-or-n-p "Pull all patches?"))) all-their-patches - (select-patches all-their-patches))) + (select-patches all-their-patches + (if (functionp select-patches) + select-patches + (lambda (patch) + (display-patch patch *query-io*) + (y-or-n-p "Pull patch ~A? " patch)))))) (our-patches (mapcar (lambda (patchinfo) (read-patch-from-repo ourrepo patchinfo)) Modified: cl-darcs/trunk/record.lisp ============================================================================== --- cl-darcs/trunk/record.lisp (original) +++ cl-darcs/trunk/record.lisp Sat Mar 10 18:04:14 2007 @@ -49,20 +49,22 @@ "Record changes in REPO. Arguments as to `record-patches'." (let ((patches (diff-repo repo))) - (unless patches - (error "Nothing to record.")) + (flet ((ask (patch) + (display-patch patch *query-io*) + (y-or-n-p "Record patch ~A? " patch))) + (unless patches + (error "Nothing to record.")) - (record-patches repo name author date log (select-patches patches)))) + (record-patches repo name author date log (select-patches patches #'ask))))) -(defun select-patches (patches) - "Ask the user to select some of PATCHES. +(defun select-patches (patches predicate) + "Select some of PATCHES using PREDICATE. Do the necessary commutation and dependency elimination." (let (patches-to-record) (loop while (setf patches (remove nil patches)) do ;; Should we include this patch? - (display-patch (car patches) *query-io*) - (if (y-or-n-p "Record patch ~A?" (car patches)) + (if (funcall predicate (car patches)) (progn ;; Yes, just add it to the list and go on. (push (car patches) patches-to-record)

1 0

[Cl-darcs-cvs] r105 - cl-darcs/trunk
by mhenoch＠common-lisp.net 10 Mar '07

10 Mar '07

Author: mhenoch Date: Sat Mar 10 16:18:44 2007 New Revision: 105 Modified: cl-darcs/trunk/util.lisp Log: Implement DELETE-DIR for Lispworks Modified: cl-darcs/trunk/util.lisp ============================================================================== --- cl-darcs/trunk/util.lisp (original) +++ cl-darcs/trunk/util.lisp Sat Mar 10 16:18:44 2007 @@ -247,7 +247,8 @@ "Delete directory PATHNAME." #+clisp (ext:delete-dir pathname) #+sbcl (sb-posix:rmdir pathname) - #-(or clisp sbcl) + #+lispworks (lw:delete-directory pathname) + #-(or clisp sbcl lispworks) (error "DELETE-DIR not implemented for ~A." (lisp-implementation-type))) (defun copy-directory (source target &key excluding)

1 0

[Cl-darcs-cvs] r104 - cl-darcs/trunk
by mhenoch＠common-lisp.net 10 Mar '07

10 Mar '07

Author: mhenoch Date: Sat Mar 10 16:18:07 2007 New Revision: 104 Modified: cl-darcs/trunk/util.lisp Log: Use ENSURE-DIRECTORIES-EXIST in MAKE-DIR Modified: cl-darcs/trunk/util.lisp ============================================================================== --- cl-darcs/trunk/util.lisp (original) +++ cl-darcs/trunk/util.lisp Sat Mar 10 16:18:07 2007 @@ -238,10 +238,10 @@ (defun make-dir (pathname) "Create directory PATHNAME." (with-simple-restart (ignore-error "Ignore ~A directory creation error." pathname) - #+clisp (ext:make-dir pathname) - #+sbcl (sb-posix:mkdir pathname #o777) - #-(or clisp sbcl) - (error "MAKE-DIR not implemented for ~A." (lisp-implementation-type)))) + (multiple-value-bind (path created) (ensure-directories-exist pathname) + (declare (ignore path)) + (unless created + (error "Directory ~A already exists." pathname))))) (defun delete-dir (pathname) "Delete directory PATHNAME."

1 0

[Cl-darcs-cvs] r103 - cl-darcs/trunk
by mhenoch＠common-lisp.net 10 Mar '07

10 Mar '07

Author: mhenoch Date: Sat Mar 10 16:13:10 2007 New Revision: 103 Modified: cl-darcs/trunk/cl-darcs.asd cl-darcs/trunk/upath.lisp Log: Use Drakma instead of Aserve Modified: cl-darcs/trunk/cl-darcs.asd ============================================================================== --- cl-darcs/trunk/cl-darcs.asd (original) +++ cl-darcs/trunk/cl-darcs.asd Sat Mar 10 16:13:10 2007 @@ -12,7 +12,7 @@ :author "Magnus Henoch <henoch(a)dtek.chalmers.se>" :depends-on (:split-sequence ;; HTTP client - :aserve + :drakma :puri :trivial-gray-streams ;; SHA1, hex etc :ironclad Modified: cl-darcs/trunk/upath.lisp ============================================================================== --- cl-darcs/trunk/upath.lisp (original) +++ cl-darcs/trunk/upath.lisp Sat Mar 10 16:13:10 2007 @@ -72,77 +72,9 @@ (ctypecase upath (net.uri:uri (dformat "~&Opening ~A..." upath) - (let ((client-request (net.aserve.client:make-http-client-request upath :proxy *http-proxy*))) - (net.aserve.client:read-client-response-headers client-request) - (let ((code (net.aserve.client:client-request-response-code client-request))) - (cond - ((= code 200) - (make-instance (if binary 'http-byte-input-stream 'http-char-input-stream) - :client-request client-request)) - ((and (> redirect-max-depth 0) (member code '(301 302 303 307))) - (let ((new-location (cdr (assoc :location (net.aserve.client:client-request-headers client-request))))) - (dformat "~&Redirected to ~A." new-location) - (net.aserve.client:client-request-close client-request) - (open-upath - (net.uri:uri new-location) - :redirect-max-depth (1- redirect-max-depth) :binary binary))) - (t - (error "Couldn't read ~A: ~A ~A." - upath - (net.aserve.client:client-request-response-code client-request) - (net.aserve.client:client-request-response-comment client-request))))))) + (apply #'drakma:http-request upath :redirect redirect-max-depth + :want-stream t (when *http-proxy* `(:proxy ,*http-proxy*)))) (pathname (open upath :direction :input :if-does-not-exist :error :element-type (if binary '(unsigned-byte 8) 'character))))) - - -(defclass http-input-stream (trivial-gray-streams:trivial-gray-stream-mixin - trivial-gray-streams:fundamental-input-stream) - ((client-request :initarg :client-request) - (binary) - (unread :initform nil)) - (:documentation "A Gray stream wrapping an Allegroserve HTTP request.")) - -(defclass http-char-input-stream (http-input-stream - trivial-gray-streams:fundamental-character-input-stream) - ((binary :initform nil)) - (:documentation "An HTTP input stream for characters.")) - -(defclass http-byte-input-stream (http-input-stream - trivial-gray-streams:fundamental-binary-input-stream) - ((binary :initform t)) - (:documentation "An HTTP input stream for bytes.")) - -(defmethod trivial-gray-streams:stream-read-sequence - ((stream http-input-stream) sequence start end &key &allow-other-keys) - (if (slot-value stream 'binary) - (net.aserve.client:client-request-read-sequence - sequence (slot-value stream 'client-request)) - (let* ((buffer (make-array (- end start) :element-type '(unsigned-byte 8))) - (len (net.aserve.client:client-request-read-sequence - buffer (slot-value stream 'client-request)))) - (loop for i from 0 below len - do (setf (elt sequence (+ i start)) (aref buffer i))) - len))) - -(defmethod trivial-gray-streams:stream-read-byte ((stream http-input-stream)) - (let ((buffer (make-array 1 :element-type '(unsigned-byte 8)))) - (if (= 1 (trivial-gray-streams:stream-read-sequence stream buffer 0 1)) - (aref buffer 0) - :eof))) - -(defmethod trivial-gray-streams:stream-read-char ((stream http-input-stream)) - (or (pop (slot-value stream 'unread)) - (let ((byte (trivial-gray-streams:stream-read-byte stream))) - (if (eql byte :eof) byte (code-char byte))))) - -(defmethod trivial-gray-streams:stream-unread-char ((stream http-input-stream) char) - (push char (slot-value stream 'unread))) - -(defmethod stream-element-type ((stream http-input-stream)) - (if (slot-value stream 'binary) '(unsigned-byte 8) 'character)) - -(defmethod close ((stream http-input-stream) &key &allow-other-keys) - (net.aserve.client:client-request-close (slot-value stream 'client-request)) - (call-next-method))

1 0

[Cl-darcs-cvs] r102 - cl-darcs/trunk
by mhenoch＠common-lisp.net 10 Mar '07

10 Mar '07

Author: mhenoch Date: Sat Mar 10 15:39:19 2007 New Revision: 102 Modified: cl-darcs/trunk/util.lisp Log: Fix off-by-ten error in HEX-TO-NUMBER Modified: cl-darcs/trunk/util.lisp ============================================================================== --- cl-darcs/trunk/util.lisp (original) +++ cl-darcs/trunk/util.lisp Sat Mar 10 15:39:19 2007 @@ -47,9 +47,9 @@ ((<= (char-code #\0) c (char-code #\9)) (- c (char-code #\0))) ((<= (char-code #\A) c (char-code #\F)) - (- c (char-code #\A))) + (+ 10 (- c (char-code #\A)))) ((<= (char-code #\a) c (char-code #\f)) - (- c (char-code #\a))) + (+ 10 (- c (char-code #\a)))) (t (error "Invalid hex digit ~A." c))))

1 0

[Cl-darcs-cvs] r101 - in cl-darcs/tags/0.2.0: . doc
by mhenoch＠common-lisp.net 27 Feb '07

27 Feb '07

Author: mhenoch Date: Mon Feb 26 21:58:38 2007 New Revision: 101 Added: cl-darcs/tags/0.2.0/ - copied from r53, cl-darcs/trunk/ cl-darcs/tags/0.2.0/README - copied unchanged from r99, cl-darcs/trunk/README cl-darcs/tags/0.2.0/apply-patch.lisp - copied unchanged from r98, cl-darcs/trunk/apply-patch.lisp cl-darcs/tags/0.2.0/cl-darcs.asd - copied unchanged from r100, cl-darcs/trunk/cl-darcs.asd cl-darcs/tags/0.2.0/commute.lisp - copied unchanged from r97, cl-darcs/trunk/commute.lisp cl-darcs/tags/0.2.0/diff.lisp - copied unchanged from r91, cl-darcs/trunk/diff.lisp cl-darcs/tags/0.2.0/display-patch.lisp - copied unchanged from r81, cl-darcs/trunk/display-patch.lisp cl-darcs/tags/0.2.0/doc/ - copied from r95, cl-darcs/trunk/doc/ cl-darcs/tags/0.2.0/get.lisp - copied unchanged from r94, cl-darcs/trunk/get.lisp cl-darcs/tags/0.2.0/packages.lisp - copied unchanged from r92, cl-darcs/trunk/packages.lisp cl-darcs/tags/0.2.0/patch-core.lisp - copied unchanged from r86, cl-darcs/trunk/patch-core.lisp cl-darcs/tags/0.2.0/prefs.lisp - copied unchanged from r60, cl-darcs/trunk/prefs.lisp cl-darcs/tags/0.2.0/pull.lisp - copied unchanged from r96, cl-darcs/trunk/pull.lisp cl-darcs/tags/0.2.0/record.lisp - copied unchanged from r82, cl-darcs/trunk/record.lisp cl-darcs/tags/0.2.0/unreadable-stream.lisp - copied unchanged from r58, cl-darcs/trunk/unreadable-stream.lisp cl-darcs/tags/0.2.0/upath.lisp - copied unchanged from r62, cl-darcs/trunk/upath.lisp cl-darcs/tags/0.2.0/util.lisp - copied unchanged from r90, cl-darcs/trunk/util.lisp cl-darcs/tags/0.2.0/write-patch.lisp - copied unchanged from r61, cl-darcs/trunk/write-patch.lisp Log: Tag 0.2.0

1 0

[Cl-darcs-cvs] r100 - cl-darcs/trunk
by mhenoch＠common-lisp.net 27 Feb '07

27 Feb '07

Author: mhenoch Date: Mon Feb 26 21:56:42 2007 New Revision: 100 Modified: cl-darcs/trunk/cl-darcs.asd Log: Update version in ASDF file Modified: cl-darcs/trunk/cl-darcs.asd ============================================================================== --- cl-darcs/trunk/cl-darcs.asd (original) +++ cl-darcs/trunk/cl-darcs.asd Mon Feb 26 21:56:42 2007 @@ -7,7 +7,7 @@ (defsystem cl-darcs :description "Darcs client" - :version "0.0.1" + :version "0.2.0" :licence "GPL" :author "Magnus Henoch <henoch(a)dtek.chalmers.se>" :depends-on (:split-sequence

1 0

[Cl-darcs-cvs] r99 - cl-darcs/trunk
by mhenoch＠common-lisp.net 27 Feb '07

27 Feb '07

Author: mhenoch Date: Mon Feb 26 21:55:18 2007 New Revision: 99 Modified: cl-darcs/trunk/README Log: Update README Modified: cl-darcs/trunk/README ============================================================================== --- cl-darcs/trunk/README (original) +++ cl-darcs/trunk/README Mon Feb 26 21:55:18 2007 @@ -6,52 +6,25 @@ * Usage -At the REPL: - -(asdf:oos 'asdf:load-op :cl-darcs) -(darcs:get-repo "http://path/to/repo" "/local/non-existent/directory/") - -Or if you want to select which patches to apply: - -(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): - -(darcs:pull "/local/repo-dir/") -or -(darcs:pull "/local/repo-dir/" "http://path/to/repo") - -When pulling, the new patches will be applied on top of any unrecorded -changes, which has a good chance of not working. - -To record your own changes: - -(darcs:record-changes "/local/repo-dir/" - "Short patch description" - "my-address(a)example.com" - :now - "Longer, possibly multi-line, description. -Or just NIL.") - -You will be asked about which changes should be recorded. - -* Configuration - -cl-darcs can use an HTTP proxy: - -(setf darcs:*http-proxy* "proxy.example.com:3128") +See the manual in the doc directory. * Known bugs and misfeatures -Above all, cl-darcs is currently a read-only client. There is no -support for generating diffs or committing patches. +cl-darcs is brittle and might eat your data. Getting a remote +repository or pulling patches from it will not affect it; what happens +with the target repository varies slighly. Make backups of data you +care about, and report bugs! + +cl-darcs seems to cope well with either just pulling patches from a +remote source, or just recording patches, but the combination of these +two activities hasn't been extensively tested. 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. +Repositories can be fetched only from local files and HTTP. Patches +can only be applied to local repositories. Tags are not faithfully reproduced. @@ -59,9 +32,10 @@ * Compatibility -I primarily develop cl-darcs on CLISP, but try to keep it working on -SBCL as well. Users of non-Unix systems probably need to change -MAKE-TEMP-FILE-NAME in util.lisp. +cl-darcs works on CLISP and SBCL on Unix-like systems. Getting it to +work on other Lisp implementations should be simple; grep the code for +#+clisp or #+sbcl. For other operating systems, modify +MAKE-TEMP-FILE-NAME in util.lisp accordingly. * Dependencies

1 0

[Cl-darcs-cvs] r98 - cl-darcs/trunk
by mhenoch＠common-lisp.net 24 Feb '07

24 Feb '07

Author: mhenoch Date: Sat Feb 24 18:50:52 2007 New Revision: 98 Modified: cl-darcs/trunk/apply-patch.lisp Log: Fix APPLY-PATCH for TOKEN-REPLACE-PATCH Modified: cl-darcs/trunk/apply-patch.lisp ============================================================================== --- cl-darcs/trunk/apply-patch.lisp (original) +++ cl-darcs/trunk/apply-patch.lisp Sat Feb 24 18:50:52 2007 @@ -186,27 +186,27 @@ (token-regexp patch)))) (replacement (format nil "\\1~A\\2" (new-token patch)))) (dformat "~&Patching ~A with ~A." filename patch) - (with-file-patching (in out filename) (apply-patch patch repodir) + (with-file-patching (in out filename) (let ((file-empty t)) (flet ((maybe-terpri () ;; Unless we're writing the first line, we have to ;; terminate the previous one. (if file-empty (setf file-empty nil) - (terpri out)))) + (write-byte 10 out)))) (loop - (multiple-value-bind (line delim) (read-until #\Newline in nil :eof) - (setf line (coerce line 'string)) - (when (cl-ppcre:scan new-regexp line) - (cerror "Ignore" "While replacing ~S with ~S, found ~S before patching: ~S." - (old-token patch) (new-token patch) (new-token patch) line)) - - (maybe-terpri) - (when (eql delim :eof) - (return)) - - (let ((patched-line (cl-ppcre:regex-replace-all old-regexp line replacement))) - (write-string patched-line out))))))))) + (let ((line (read-binary-line in nil :eof))) + (when (eql line :eof) + (return)) + (maybe-terpri) + + (setf line (bytes-to-string line)) + (when (cl-ppcre:scan new-regexp line) + (cerror "Ignore" "While replacing ~S with ~S, found ~S before patching: ~S." + (old-token patch) (new-token patch) (new-token patch) line)) + + (let ((patched-line (cl-ppcre:regex-replace-all old-regexp line replacement))) + (write-sequence (string-to-bytes patched-line) out))))))))) (defmethod apply-patch ((patch hunk-patch) repodir) "Apply a single hunk patch to REPODIR."

1 0