[Cl-darcs-cvs] r139 - cl-darcs/trunk

[mhenoch at 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))