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

[Cl-darcs-cvs] r147 - cl-darcs/trunk
by mhenoch＠common-lisp.net 22 Nov '07

22 Nov '07

Author: mhenoch Date: Thu Nov 22 08:52:39 2007 New Revision: 147 Modified: cl-darcs/trunk/diff.lisp Log: Use TRUENAME on repository directory when diffing Modified: cl-darcs/trunk/diff.lisp ============================================================================== --- cl-darcs/trunk/diff.lisp (original) +++ cl-darcs/trunk/diff.lisp Thu Nov 22 08:52:39 2007 @@ -119,7 +119,7 @@ "Find changes in REPO from pristine tree. Return a list of patches. ORIGINAL and MODIFIED specify directories to start from." - (setf repo (fad:pathname-as-directory repo)) + (setf repo (truename (fad:pathname-as-directory repo))) (unless (and original modified) (setf modified repo) (setf original (upath-subdir repo '("_darcs" "pristine"))))

1 0

[Cl-darcs-cvs] r146 - cl-darcs/trunk
by mhenoch＠common-lisp.net 06 Sep '07

06 Sep '07

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*)))

1 0

[Cl-darcs-cvs] r145 - cl-darcs/trunk
by mhenoch＠common-lisp.net 06 Sep '07

06 Sep '07

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

1 0

[Cl-darcs-cvs] r144 - cl-darcs/trunk
by mhenoch＠common-lisp.net 06 Sep '07

06 Sep '07

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"))

1 0

[Cl-darcs-cvs] r143 - cl-darcs/trunk
by mhenoch＠common-lisp.net 06 Sep '07

06 Sep '07

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

1 0

[Cl-darcs-cvs] r142 - cl-darcs/trunk
by mhenoch＠common-lisp.net 06 Sep '07

06 Sep '07

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."

1 0

[Cl-darcs-cvs] r141 - cl-darcs/trunk
by mhenoch＠common-lisp.net 06 Sep '07

06 Sep '07

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)))

1 0

[Cl-darcs-cvs] r140 - cl-darcs/trunk
by mhenoch＠common-lisp.net 06 Sep '07

06 Sep '07

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"))

1 0

[Cl-darcs-cvs] r139 - cl-darcs/trunk
by mhenoch＠common-lisp.net 06 Sep '07

06 Sep '07

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 ,@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))

1 0

[Cl-darcs-cvs] r138 - cl-darcs/trunk
by mhenoch＠common-lisp.net 05 Sep '07

05 Sep '07

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))

1 0