From mhenoch at common-lisp.net Wed Sep 5 21:50:02 2007 From: mhenoch at common-lisp.net (mhenoch at common-lisp.net) Date: Wed, 5 Sep 2007 17:50:02 -0400 (EDT) Subject: [Cl-darcs-cvs] r135 - cl-darcs/trunk Message-ID: <20070905215002.ECBAB1903F@common-lisp.net> Author: mhenoch Date: Wed Sep 5 17:50:01 2007 New Revision: 135 Modified: cl-darcs/trunk/diff.lisp Log: Fix DIFF-REPO when there is no pending patch Modified: cl-darcs/trunk/diff.lisp ============================================================================== --- cl-darcs/trunk/diff.lisp (original) +++ cl-darcs/trunk/diff.lisp Wed Sep 5 17:50:01 2007 @@ -133,7 +133,9 @@ (pristine-wild (merge-pathnames wild pristine)) (original-wild (merge-pathnames wild original)) (modified-wild (merge-pathnames wild modified)) - (pending (read-pending repo)) + (pending (or + (read-pending repo) + (make-instance 'composite-patch :patches ()))) patches) ;; XXX: check if both directories exist From mhenoch at common-lisp.net Wed Sep 5 21:50:49 2007 From: mhenoch at common-lisp.net (mhenoch at common-lisp.net) Date: Wed, 5 Sep 2007 17:50:49 -0400 (EDT) Subject: [Cl-darcs-cvs] r136 - cl-darcs/trunk Message-ID: <20070905215049.A785E1B000@common-lisp.net> Author: mhenoch Date: Wed Sep 5 17:50:48 2007 New Revision: 136 Modified: cl-darcs/trunk/diff.lisp Log: s/:forward/:forwards/ Modified: cl-darcs/trunk/diff.lisp ============================================================================== --- cl-darcs/trunk/diff.lisp (original) +++ cl-darcs/trunk/diff.lisp Wed Sep 5 17:50:48 2007 @@ -174,7 +174,7 @@ (dolist (file files-in-original) ;; Was it touched by some "pending" patch? (multiple-value-bind (touching new-name) - (find-touching pending file :forward) + (find-touching pending file :forwards) (if touching ;; If yes, we want to record those patches, and remember the new name. (setf patches (nconc patches (patches touching))) From mhenoch at common-lisp.net Wed Sep 5 21:55:23 2007 From: mhenoch at common-lisp.net (mhenoch at common-lisp.net) Date: Wed, 5 Sep 2007 17:55:23 -0400 (EDT) Subject: [Cl-darcs-cvs] r137 - cl-darcs/trunk Message-ID: <20070905215523.C929F1B000@common-lisp.net> Author: mhenoch Date: Wed Sep 5 17:55:23 2007 New Revision: 137 Modified: cl-darcs/trunk/util.lisp Log: PATHNAME-SANE-P: pathnames without directory components are sane Modified: cl-darcs/trunk/util.lisp ============================================================================== --- cl-darcs/trunk/util.lisp (original) +++ cl-darcs/trunk/util.lisp Wed Sep 5 17:55:23 2007 @@ -228,9 +228,10 @@ (defun pathname-sane-p (pathname) "Return true if PATHNAME is a relative path going strictly down." (let ((directory (pathname-directory pathname))) - (and (listp directory) - (eql (car directory) :relative) - (every #'stringp (cdr directory))))) + (or (null directory) + (and (listp directory) + (eql (car directory) :relative) + (every #'stringp (cdr directory)))))) (defun pathname-to-string (pathname) "Convert PATHNAME to a string usable in darcs patch files. From mhenoch at common-lisp.net Wed Sep 5 22:00:40 2007 From: mhenoch at common-lisp.net (mhenoch at common-lisp.net) Date: Wed, 5 Sep 2007 18:00:40 -0400 (EDT) Subject: [Cl-darcs-cvs] r138 - cl-darcs/trunk Message-ID: <20070905220040.CED951D12E@common-lisp.net> Author: mhenoch Date: Wed Sep 5 18:00:40 2007 New Revision: 138 Modified: cl-darcs/trunk/pull.lisp Log: PULL: Don't pull new patches if there are none Modified: cl-darcs/trunk/pull.lisp ============================================================================== --- cl-darcs/trunk/pull.lisp (original) +++ cl-darcs/trunk/pull.lisp Wed Sep 5 18:00:40 2007 @@ -1,4 +1,4 @@ -;;; Copyright (C) 2006 Magnus Henoch +;;; Copyright (C) 2006, 2007 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 @@ -40,6 +40,11 @@ (multiple-value-bind (common only-ours only-theirs) (get-common-and-uncommon our-patchinfo their-patchinfo) (declare (ignore common)) + + (when (null only-theirs) + (format t "~&Found no new patches.") + (return-from pull)) + (format t "~&Found these new patches:") (dolist (p only-theirs) (format t "~& - ~A" p)) From mhenoch at common-lisp.net Thu Sep 6 05:26:42 2007 From: mhenoch at common-lisp.net (mhenoch at common-lisp.net) Date: Thu, 6 Sep 2007 01:26:42 -0400 (EDT) Subject: [Cl-darcs-cvs] r139 - cl-darcs/trunk Message-ID: <20070906052642.7E9B22F00A@common-lisp.net> Author: mhenoch Date: Thu Sep 6 01:26:40 2007 New Revision: 139 Added: cl-darcs/trunk/cmdline.lisp Modified: cl-darcs/trunk/packages.lisp Log: Start hacking command line interface Added: cl-darcs/trunk/cmdline.lisp ============================================================================== --- (empty file) +++ cl-darcs/trunk/cmdline.lisp Thu Sep 6 01:26:40 2007 @@ -0,0 +1,90 @@ +;;; Copyright (C) 2007 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) + +(defvar *darcs-commands* () + "List of commands that can be executed from the command line. +Each element is a symbol that names the command. The corresponding +function is named cmd-SYMBOL, and is called with all command line +arguments but the first one. It should return an integer exit code.") + +(eval-when (:compile-toplevel :load-toplevel) + (defun command-function (command) + "Turn a command symbol into a function symbol." + (intern (format nil "CMD-~A" command) :darcs))) + +(defun handle-command-line (argv) + "Handle a command line, emulating the real darcs client. +ARGV is a list of strings. This function is to be called in some +platform-dependent manner, while being portable itself. An integer +exit code is returned." + (let* ((command (find (car argv) *darcs-commands* :test #'string-equal)) + (function (when command (command-function command)))) + (if (null command) + (progn + (if (null argv) + (format *error-output* "No command given!~n") + (format *error-output* "Invalid command '~A'!~n" command)) + (usage) + 1) + (handler-case + (apply function (cdr argv)) + (program-error () + (command-usage command) + 1))))) + +(defun usage () + "Print usage information about commands to *ERROR-OUTPUT*." + (format *error-output* "Usage: darcs COMMAND ...~n~nCommands:~n") + (dolist (cmd *darcs-commands*) + (let ((function (command-function cmd))) + (format *error-output* " ~A~15,2T~A~N" + (split-sequence:split-sequence + #\Newline (documentation function 'function) + :count 1))))) + +(defun command-usage (command) + "Print longer documentation for COMMAND." + (format *error-output* "~A~N" (documentation (command-function command) 'function))) + +(defmacro define-darcs-command (name arglist docstring &body body) + (let ((function (command-function name))) + `(progn + (pushnew ',name *darcs-commands*) + (defun ,function ,arglist ,docstring , at 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*) + +(define-darcs-command add (&rest files-and-dirs) + "Add files and directories for later recording. + +Usage: darcs add FILE ..." + (let ((repo (find-repo))) + (dolist (file files-and-dirs) + (add-file repo file) + (format t "~&Added ~A" file)))) + +(define-darcs-command whatsnew () + "See what has been changed in the working directory. + +Usage: darcs whatsnew" + (diff-repo-display (find-repo))) Modified: cl-darcs/trunk/packages.lisp ============================================================================== --- cl-darcs/trunk/packages.lisp (original) +++ cl-darcs/trunk/packages.lisp Thu Sep 6 01:26:40 2007 @@ -8,4 +8,5 @@ #:get-repo #:pull #:diff-repo #:diff-repo-display #:record-changes #:create-repo #:revert-changes #:send-to-file - #:add-file)) + #:add-file + #:handle-command-line)) From mhenoch at common-lisp.net Thu Sep 6 05:27:28 2007 From: mhenoch at common-lisp.net (mhenoch at common-lisp.net) Date: Thu, 6 Sep 2007 01:27:28 -0400 (EDT) Subject: [Cl-darcs-cvs] r140 - cl-darcs/trunk Message-ID: <20070906052728.34D8433081@common-lisp.net> Author: mhenoch Date: Thu Sep 6 01:27:25 2007 New Revision: 140 Modified: cl-darcs/trunk/cl-darcs.asd Log: Add cmdline to ASDF file Modified: cl-darcs/trunk/cl-darcs.asd ============================================================================== --- cl-darcs/trunk/cl-darcs.asd (original) +++ cl-darcs/trunk/cl-darcs.asd Thu Sep 6 01:27:25 2007 @@ -37,6 +37,7 @@ (:file "prefs" :depends-on ("util")) (:file "repo" :depends-on ("util")) (:file "diff" :depends-on ("util")) + (:file "cmdline" :depends-on ("util")) (:file "patch-core" :depends-on ("util")) (:file "record" :depends-on ("patch-core")) From mhenoch at common-lisp.net Thu Sep 6 05:31:48 2007 From: mhenoch at common-lisp.net (mhenoch at common-lisp.net) Date: Thu, 6 Sep 2007 01:31:48 -0400 (EDT) Subject: [Cl-darcs-cvs] r141 - cl-darcs/trunk Message-ID: <20070906053148.46F8233084@common-lisp.net> Author: mhenoch Date: Thu Sep 6 01:31:47 2007 New Revision: 141 Modified: cl-darcs/trunk/cmdline.lisp Log: Fix format specifiers Modified: cl-darcs/trunk/cmdline.lisp ============================================================================== --- cl-darcs/trunk/cmdline.lisp (original) +++ cl-darcs/trunk/cmdline.lisp Thu Sep 6 01:31:47 2007 @@ -37,8 +37,8 @@ (if (null command) (progn (if (null argv) - (format *error-output* "No command given!~n") - (format *error-output* "Invalid command '~A'!~n" command)) + (format *error-output* "No command given!~%") + (format *error-output* "Invalid command '~A'!~%" command)) (usage) 1) (handler-case @@ -49,17 +49,17 @@ (defun usage () "Print usage information about commands to *ERROR-OUTPUT*." - (format *error-output* "Usage: darcs COMMAND ...~n~nCommands:~n") + (format *error-output* "Usage: darcs COMMAND ...~%~%Commands:~%") (dolist (cmd *darcs-commands*) (let ((function (command-function cmd))) - (format *error-output* " ~A~15,2T~A~N" + (format *error-output* " ~A~15,2T~A~%" (split-sequence:split-sequence #\Newline (documentation function 'function) :count 1))))) (defun command-usage (command) "Print longer documentation for COMMAND." - (format *error-output* "~A~N" (documentation (command-function command) 'function))) + (format *error-output* "~A~%" (documentation (command-function command) 'function))) (defmacro define-darcs-command (name arglist docstring &body body) (let ((function (command-function name))) From mhenoch at common-lisp.net Thu Sep 6 05:34:08 2007 From: mhenoch at common-lisp.net (mhenoch at common-lisp.net) Date: Thu, 6 Sep 2007 01:34:08 -0400 (EDT) Subject: [Cl-darcs-cvs] r142 - cl-darcs/trunk Message-ID: <20070906053408.8C22B3705C@common-lisp.net> Author: mhenoch Date: Thu Sep 6 01:34:05 2007 New Revision: 142 Modified: cl-darcs/trunk/cmdline.lisp Log: Fix USAGE. Modified: cl-darcs/trunk/cmdline.lisp ============================================================================== --- cl-darcs/trunk/cmdline.lisp (original) +++ cl-darcs/trunk/cmdline.lisp Thu Sep 6 01:34:05 2007 @@ -53,9 +53,10 @@ (dolist (cmd *darcs-commands*) (let ((function (command-function cmd))) (format *error-output* " ~A~15,2T~A~%" - (split-sequence:split-sequence - #\Newline (documentation function 'function) - :count 1))))) + cmd + (car (split-sequence:split-sequence + #\Newline (documentation function 'function) + :count 1)))))) (defun command-usage (command) "Print longer documentation for COMMAND." From mhenoch at common-lisp.net Thu Sep 6 05:47:35 2007 From: mhenoch at common-lisp.net (mhenoch at common-lisp.net) Date: Thu, 6 Sep 2007 01:47:35 -0400 (EDT) Subject: [Cl-darcs-cvs] r143 - cl-darcs/trunk Message-ID: <20070906054735.9EE8E37063@common-lisp.net> Author: mhenoch Date: Thu Sep 6 01:47:33 2007 New Revision: 143 Modified: cl-darcs/trunk/cmdline.lisp Log: Fix error message for unknown command Modified: cl-darcs/trunk/cmdline.lisp ============================================================================== --- cl-darcs/trunk/cmdline.lisp (original) +++ cl-darcs/trunk/cmdline.lisp Thu Sep 6 01:47:33 2007 @@ -38,7 +38,7 @@ (progn (if (null argv) (format *error-output* "No command given!~%") - (format *error-output* "Invalid command '~A'!~%" command)) + (format *error-output* "Invalid command '~A'!~%" (car argv))) (usage) 1) (handler-case From mhenoch at common-lisp.net Thu Sep 6 05:53:43 2007 From: mhenoch at common-lisp.net (mhenoch at common-lisp.net) Date: Thu, 6 Sep 2007 01:53:43 -0400 (EDT) Subject: [Cl-darcs-cvs] r144 - cl-darcs/trunk Message-ID: <20070906055343.D6BDD450C3@common-lisp.net> Author: mhenoch Date: Thu Sep 6 01:53:42 2007 New Revision: 144 Modified: cl-darcs/trunk/get.lisp cl-darcs/trunk/repo.lisp Log: PREPARE-NEW-REPO: assume and assert that directory exists, instead of creating it. Callers updated. Modified: cl-darcs/trunk/get.lisp ============================================================================== --- cl-darcs/trunk/get.lisp (original) +++ cl-darcs/trunk/get.lisp Thu Sep 6 01:53:42 2007 @@ -1,4 +1,4 @@ -;;; Copyright (C) 2006 Magnus Henoch +;;; Copyright (C) 2006, 2007 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 @@ -40,6 +40,7 @@ (format t "~{~&~A~}" motd))) ;; Create directories... + (ensure-directories-exist outname) (prepare-new-repo outname) (set-default-repo outname inrepodir) Modified: cl-darcs/trunk/repo.lisp ============================================================================== --- cl-darcs/trunk/repo.lisp (original) +++ cl-darcs/trunk/repo.lisp Thu Sep 6 01:53:42 2007 @@ -18,7 +18,8 @@ (defun prepare-new-repo (outname) "Create directories for starting a repo at OUTNAME." - (make-dir outname) + (unless (fad:directory-exists-p outname) + (error "Directory ~A does not exist." outname)) (make-dir (merge-pathnames (make-pathname :directory (list :relative "_darcs")) outname)) (dolist (dir '("patches" "checkpoints" "prefs" "inventories")) From mhenoch at common-lisp.net Thu Sep 6 06:07:15 2007 From: mhenoch at common-lisp.net (mhenoch at common-lisp.net) Date: Thu, 6 Sep 2007 02:07:15 -0400 (EDT) Subject: [Cl-darcs-cvs] r145 - cl-darcs/trunk Message-ID: <20070906060715.25780111CD@common-lisp.net> Author: mhenoch Date: Thu Sep 6 02:07:13 2007 New Revision: 145 Modified: cl-darcs/trunk/repo.lisp Log: Check if PREPARE-NEW-REPO is run in a repository Modified: cl-darcs/trunk/repo.lisp ============================================================================== --- cl-darcs/trunk/repo.lisp (original) +++ cl-darcs/trunk/repo.lisp Thu Sep 6 02:07:13 2007 @@ -20,12 +20,17 @@ "Create directories for starting a repo at OUTNAME." (unless (fad:directory-exists-p outname) (error "Directory ~A does not exist." outname)) - (make-dir (merge-pathnames (make-pathname :directory (list :relative "_darcs")) - outname)) - (dolist (dir '("patches" "checkpoints" "prefs" "inventories")) - (make-dir (merge-pathnames - (make-pathname :directory (list :relative "_darcs" dir)) - outname))) + (let ((darcs-dir (merge-pathnames + (make-pathname :directory (list :relative "_darcs")) + outname))) + (when (fad:directory-exists-p darcs-dir) + ;; This error message should match the one in darcs/tests/init.pl + (error "Do not run this command in a repository.")) + (make-dir darcs-dir) + (dolist (dir '("patches" "checkpoints" "prefs" "inventories")) + (make-dir (merge-pathnames + (make-pathname :directory (list :relative dir)) + darcs-dir)))) (write-default-prefs outname)) ;; {lazily,}read_repo in DarcsRepo.lhs From mhenoch at common-lisp.net Thu Sep 6 06:13:12 2007 From: mhenoch at common-lisp.net (mhenoch at common-lisp.net) Date: Thu, 6 Sep 2007 02:13:12 -0400 (EDT) Subject: [Cl-darcs-cvs] r146 - cl-darcs/trunk Message-ID: <20070906061312.3613F13017@common-lisp.net> Author: mhenoch Date: Thu Sep 6 02:13:11 2007 New Revision: 146 Modified: cl-darcs/trunk/cmdline.lisp Log: Add init command Modified: cl-darcs/trunk/cmdline.lisp ============================================================================== --- cl-darcs/trunk/cmdline.lisp (original) +++ cl-darcs/trunk/cmdline.lisp Thu Sep 6 02:13:11 2007 @@ -89,3 +89,7 @@ Usage: darcs whatsnew" (diff-repo-display (find-repo))) + +(define-darcs-command init () + "Initialize a darcs repository in the current directory." + (create-repo (truename *default-pathname-defaults*)))