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

[mhenoch at common-lisp.net]

Author: mhenoch
Date: Tue Apr  1 18:37:24 2008
New Revision: 187

Modified:
   cl-darcs/trunk/cmdline.lisp
Log:
Generate documentation for all command arguments


Modified: cl-darcs/trunk/cmdline.lisp
==============================================================================
--- cl-darcs/trunk/cmdline.lisp	(original)
+++ cl-darcs/trunk/cmdline.lisp	Tue Apr  1 18:37:24 2008
@@ -70,7 +70,7 @@
 
 (defun command-usage (command)
   "Print longer documentation for COMMAND."
-  (format *error-output* "~&~A~%" (documentation (command-function command) 'function)))
+  (format *error-output* "~&~A~%" (get (command-function command) 'darcs-documentation)))
 
 (defmacro define-darcs-command (name options operands docstring &body body)
   "Define a darcs command called NAME.
@@ -98,7 +98,35 @@
 			   `(,o (cdr (assoc (option-keyword ,(option-symbol o)) ,options-sym))))
 			 options)
 		    (destructuring-bind ,operands ,operands-sym
-		      , at body))))))))
+		      , at body))))
+	 (setf (get ',function 'darcs-documentation)
+	       ,(if (null options)
+		    docstring
+		    `(format nil
+			     "~A~%~%~:{~A~30,5T~A~%~}"
+			     ,docstring
+			     (mapcar
+			      (lambda (opt)
+				(list
+				 (cond
+				   ((and (option-short opt)
+					 (option-long opt))
+				    (format nil "--~A~@[=~A~], -~C"
+					    (option-long opt)
+					    (option-arg opt)
+					    (option-short opt)))
+				   ((option-short opt)
+				    (format nil "-~C~@[ ~A~]"
+					    (option-short opt)
+					    (option-arg opt)))
+				   ((option-long opt)
+				    (format nil "--~A~@[=~A~]"
+					    (option-long opt)
+					    (option-arg opt)))
+				   (t
+				    (error "Option ~A has neither short nor long argument form." (option-keyword opt))))
+				 (option-help opt)))
+			      (list ,@(mapcar #'option-symbol options))))))))))  
 
 (defparameter opt-repodir 
   (make-option