March 2008 - cl-darcs-cvs@lists.common-lisp.net

[Cl-darcs-cvs] r169 - cl-darcs/trunk
by mhenoch＠common-lisp.net 05 Mar '08

05 Mar '08

Author: mhenoch Date: Wed Mar 5 03:56:43 2008 New Revision: 169 Modified: cl-darcs/trunk/pull.lisp cl-darcs/trunk/upath.lisp Log: Add UPATH-TO-STRING and use it for saving repository addresses Modified: cl-darcs/trunk/pull.lisp ============================================================================== --- cl-darcs/trunk/pull.lisp (original) +++ cl-darcs/trunk/pull.lisp Wed Mar 5 03:56:43 2008 @@ -31,7 +31,7 @@ (setf theirrepo (car (get-preflist ourrepo "defaultrepo"))) (unless theirrepo (error "No remote repository specified, and no default available."))) - (add-to-preflist ourrepo "repos" theirrepo) + (add-to-preflist ourrepo "repos" (upath-to-string theirrepo)) (let ((motd (get-preflist theirrepo "motd"))) (when motd (format t "~{~&~A~}" motd))) Modified: cl-darcs/trunk/upath.lisp ============================================================================== --- cl-darcs/trunk/upath.lisp (original) +++ cl-darcs/trunk/upath.lisp Wed Mar 5 03:56:43 2008 @@ -80,3 +80,15 @@ (pathname (open upath :direction :input :if-does-not-exist :error :element-type (if binary '(unsigned-byte 8) 'character))))) + +(defun upath-to-string (upath) + "Convert UPATH to a string. +This string can be read with MAKE-UPATH." + (ctypecase upath + (string + upath) + (pathname + (namestring upath)) + (net.uri:uri + (with-output-to-string (s) + (net.uri:render-uri upath s)))))

1 0

[Cl-darcs-cvs] r168 - cl-darcs/trunk
by mhenoch＠common-lisp.net 05 Mar '08

05 Mar '08

Author: mhenoch Date: Wed Mar 5 03:11:37 2008 New Revision: 168 Modified: cl-darcs/trunk/cmdline.lisp Log: FIND-REPO: get truename of directory Modified: cl-darcs/trunk/cmdline.lisp ============================================================================== --- cl-darcs/trunk/cmdline.lisp (original) +++ cl-darcs/trunk/cmdline.lisp Wed Mar 5 03:11:37 2008 @@ -110,7 +110,7 @@ Signal an error if there is none, else return the repository root. If DIR is specified, search for repository there instead." (if (fad:directory-exists-p (upath-subdir dir '("_darcs"))) - dir + (fad:directory-exists-p dir) ;get directory truename (let ((parent-dir (ignore-errors (merge-pathnames (make-pathname :directory '(:relative :up))

1 0

[Cl-darcs-cvs] r167 - cl-darcs/trunk
by mhenoch＠common-lisp.net 05 Mar '08

05 Mar '08

Author: mhenoch Date: Wed Mar 5 03:10:11 2008 New Revision: 167 Modified: cl-darcs/trunk/upath.lisp Log: UPATH-SUBDIR: assume that base pathname is a directory, and use PATHNAME-AS-DIRECTORY Modified: cl-darcs/trunk/upath.lisp ============================================================================== --- cl-darcs/trunk/upath.lisp (original) +++ cl-darcs/trunk/upath.lisp Wed Mar 5 03:10:11 2008 @@ -1,4 +1,4 @@ -;;; Copyright (C) 2006 Magnus Henoch +;;; Copyright (C) 2006, 2008 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 @@ -37,7 +37,8 @@ (pathname path))))) (defun upath-subdir (base subdirs &optional filename) - "From BASE, descend into SUBDIRS and FILENAME." + "From BASE, descend into SUBDIRS and FILENAME. +PATH is assumed to refer to a directory, not a file." (setf base (make-upath base)) (let* ((subdirs-list (remove-if #'keywordp (if (pathnamep subdirs) @@ -59,6 +60,7 @@ new-uri)) ;; this won't work correctly if BASE has a filename (pathname + (setf base (fad:pathname-as-directory base)) (merge-pathnames (make-pathname :directory (cons :relative subdirs-list) :name filename)

1 0

[Cl-darcs-cvs] r166 - cl-darcs/trunk
by mhenoch＠common-lisp.net 05 Mar '08

05 Mar '08

Author: mhenoch Date: Wed Mar 5 03:05:40 2008 New Revision: 166 Modified: cl-darcs/trunk/pull.lisp Log: Fix typo in error message Modified: cl-darcs/trunk/pull.lisp ============================================================================== --- cl-darcs/trunk/pull.lisp (original) +++ cl-darcs/trunk/pull.lisp Wed Mar 5 03:05:40 2008 @@ -30,7 +30,7 @@ (unless theirrepo (setf theirrepo (car (get-preflist ourrepo "defaultrepo"))) (unless theirrepo - (error "No remote repositiory specified, and no default available."))) + (error "No remote repository specified, and no default available."))) (add-to-preflist ourrepo "repos" theirrepo) (let ((motd (get-preflist theirrepo "motd"))) (when motd

1 0

[Cl-darcs-cvs] r165 - cl-darcs/trunk
by mhenoch＠common-lisp.net 05 Mar '08

05 Mar '08

Author: mhenoch Date: Wed Mar 5 03:03:55 2008 New Revision: 165 Modified: cl-darcs/trunk/repo.lisp Log: Handle empty inventory files Modified: cl-darcs/trunk/repo.lisp ============================================================================== --- cl-darcs/trunk/repo.lisp (original) +++ cl-darcs/trunk/repo.lisp Wed Mar 5 03:03:55 2008 @@ -48,8 +48,11 @@ (let (tag-patches patches) (with-open-stream (in (make-instance 'unreadable-stream :base-stream (open-upath inventory-file :binary t))) - ;; If first line is "Starting with tag:", - (let ((first-line (read-binary-line in))) + (let ((first-line (read-binary-line in nil :eof))) + (when (eq first-line :eof) + ;; XXX: should this be (list nil)? + (return-from read-repo-patch-list nil)) + ;; If first line is "Starting with tag:", (if (string= (bytes-to-string first-line) "Starting with tag:") (let* ((tag-patch ;; read the first patch...

1 0

[Cl-darcs-cvs] r164 - cl-darcs/trunk
by mhenoch＠common-lisp.net 05 Mar '08

05 Mar '08

Author: mhenoch Date: Wed Mar 5 03:01:47 2008 New Revision: 164 Modified: cl-darcs/trunk/pull.lisp Log: Adapt message when there are no patches to pull Modified: cl-darcs/trunk/pull.lisp ============================================================================== --- cl-darcs/trunk/pull.lisp (original) +++ cl-darcs/trunk/pull.lisp Wed Mar 5 03:01:47 2008 @@ -42,7 +42,7 @@ (declare (ignore common)) (when (null only-theirs) - (format t "~&Found no new patches.") + (format t "~&No remote changes to pull in.") (return-from pull)) (format t "~&Found these new patches:")

1 0

[Cl-darcs-cvs] r163 - cl-darcs/trunk
by mhenoch＠common-lisp.net 05 Mar '08

05 Mar '08

Author: mhenoch Date: Wed Mar 5 02:55:07 2008 New Revision: 163 Removed: cl-darcs/trunk/init.lisp Modified: cl-darcs/trunk/cl-darcs.asd cl-darcs/trunk/repo.lisp Log: Delete init.lisp and its INIT-TREE. Write empty inventory in PREPARE-NEW-REPO. Modified: cl-darcs/trunk/cl-darcs.asd ============================================================================== --- cl-darcs/trunk/cl-darcs.asd (original) +++ cl-darcs/trunk/cl-darcs.asd Wed Mar 5 02:55:07 2008 @@ -34,7 +34,6 @@ (: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")) (:file "diff" :depends-on ("util")) Modified: cl-darcs/trunk/repo.lisp ============================================================================== --- cl-darcs/trunk/repo.lisp (original) +++ cl-darcs/trunk/repo.lisp Wed Mar 5 02:55:07 2008 @@ -1,4 +1,4 @@ -;;; Copyright (C) 2006, 2007 Magnus Henoch +;;; Copyright (C) 2006, 2007, 2008 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 @@ -30,7 +30,8 @@ (dolist (dir '("patches" "checkpoints" "prefs" "inventories")) (make-dir (merge-pathnames (make-pathname :directory (list :relative dir)) - darcs-dir)))) + darcs-dir))) + (write-inventory outname ())) (write-default-prefs outname)) ;; {lazily,}read_repo in DarcsRepo.lhs

1 0

[Cl-darcs-cvs] r162 - cl-darcs/trunk
by mhenoch＠common-lisp.net 05 Mar '08

05 Mar '08

Author: mhenoch Date: Wed Mar 5 02:36:57 2008 New Revision: 162 Modified: cl-darcs/trunk/cmdline.lisp Log: FIND-REPO finds repository in parent directories too Modified: cl-darcs/trunk/cmdline.lisp ============================================================================== --- cl-darcs/trunk/cmdline.lisp (original) +++ cl-darcs/trunk/cmdline.lisp Wed Mar 5 02:36:57 2008 @@ -105,12 +105,19 @@ (destructuring-bind ,operands ,operands-sym ,@body)))))))) -(defun find-repo () - "Find repository in current directory. -Signal an error if there is none." - (unless (fad:directory-exists-p (upath-subdir *default-pathname-defaults* '("_darcs"))) - (error "Not in a darcs repo.")) - *default-pathname-defaults*) +(defun find-repo (&optional (dir *default-pathname-defaults*)) + "Find repository in current directory or above. +Signal an error if there is none, else return the repository root. +If DIR is specified, search for repository there instead." + (if (fad:directory-exists-p (upath-subdir dir '("_darcs"))) + dir + (let ((parent-dir (ignore-errors + (merge-pathnames + (make-pathname :directory '(:relative :up)) + dir)))) + (if parent-dir + (find-repo parent-dir) + (error "Not in a darcs repo."))))) (define-darcs-command add () (&rest files-and-dirs) "Add files and directories for later recording.

1 0

[Cl-darcs-cvs] r161 - cl-darcs/trunk
by mhenoch＠common-lisp.net 05 Mar '08

05 Mar '08

Author: mhenoch Date: Wed Mar 5 02:18:21 2008 New Revision: 161 Modified: cl-darcs/trunk/pull.lisp Log: Fix typo in docstring Modified: cl-darcs/trunk/pull.lisp ============================================================================== --- cl-darcs/trunk/pull.lisp (original) +++ cl-darcs/trunk/pull.lisp Wed Mar 5 02:18:21 2008 @@ -1,4 +1,4 @@ -;;; Copyright (C) 2006, 2007 Magnus Henoch +;;; Copyright (C) 2006, 2007, 2008 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 @@ -18,7 +18,7 @@ (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 +If THEIRREPO is not specified, use default repository specified in preferences. SELECT-PATCHES specifies how to select which remote patches to pull. It can be one of:

1 0

[Cl-darcs-cvs] r160 - cl-darcs/trunk
by mhenoch＠common-lisp.net 05 Mar '08

05 Mar '08

Author: mhenoch Date: Wed Mar 5 02:04:31 2008 New Revision: 160 Modified: cl-darcs/trunk/pending.lisp Log: When adding a file, make sure that we can read it Modified: cl-darcs/trunk/pending.lisp ============================================================================== --- cl-darcs/trunk/pending.lisp (original) +++ cl-darcs/trunk/pending.lisp Wed Mar 5 02:04:31 2008 @@ -70,6 +70,11 @@ (let ((pristine-file (merge-pathnames file (upath-subdir repo '("_darcs" "pristine")))) (working-file (merge-pathnames file repo))) + ;; Make sure that we can read the file + (when (eql type :file) + (with-open-file (s working-file :direction :input) + t)) + ;; XXX: does this work properly for directories? (when (or ;; Is file/directory already committed?

1 0