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