(defun command-read-arguments ()
  "Read the arguments following the expression that has just been read and that is being evaluated."
  (flet ((read-arguments (stream)
           (loop :for argument := (read stream nil stream)
                 :until (eq argument stream)
                 :collect argument)))
    (if (and (member :swank *features*)
             (find-package "SWANK")
             (eq :external (nth-value 1 (find-symbol "*ARGUMENT-STREAM*" "SWANK")))
             (streamp (symbol-value (intern "*ARGUMENT-STREAM*" "SWANK"))))
        (read-arguments (symbol-value (intern "*ARGUMENT-STREAM*" "SWANK")))
        (with-input-from-string (stream  (if (listen *standard-input*)
                                             (read-line *standard-input*)
                                             ""))
          (read-arguments stream)))))

(defun call-command (command)
  "
DO:     Call the command with the arguments read from the following line.
RETURN: No value.
"
  (apply command (command-read-arguments))
  (values))

(defvar *commands* '()
  "List of commands, with their lambda-list and docstring.")

(defmacro command-error-handling (&body body)
  `(handler-case
       (progn ,@body)
     (error (err)
       (format *error-output* "~&~A~%" err))))

(defmacro define-command (name (&rest lambda-list) &body docstring-declarations-and-body)
  "
DO:         Define a REPL command that can be invoked by name, without
            surrounding it with parentheses.

NOTE:       Commands are defined as functions, associated with a
            symbol-macro expanding to a call-command call.
            Call-command will parse the rest of the line  as arguments
            for the command.  Errors are handled and printed.  No
            value is returned.  Commands must print their results.

EXAMPLE:
            (define-command cmdt (&rest arguments)
              (prin1 (append arguments arguments))
              (terpri))

            cl-user> cmdt 1 2 3
            (1 2 3 1 2 3)
            ; No value
            cl-user>
"
  (multiple-value-bind (docstrings declarations body)
      (parse-body :lambda docstring-declarations-and-body)
    `(progn
       (setf *commands* (cons (list ',name ',lambda-list ',(car docstrings))
                              (delete ',name *commands* :key (function first))))
       (defun ,name ,lambda-list
         ,@docstrings ,@declarations
         (command-error-handling ,@body))
       (define-symbol-macro ,name (call-command ',name)))))

(defun fmt-lambda-list (stream lambda-list at colon  &rest parameters)
  "Formats a lambda list using [] for optional and parameters."
  (declare (ignore at colon parameters))
  (let ((lh (make-help (parse-lambda-list lambda-list :ordinary))))
    (write-string
     (mapconcat (lambda (p)
                  (case (car p)
                    (:key (let ((*print-circle* nil))  (format nil "[:~A ~:*~A]" (cdr p))))
                    (otherwise (cdr p))))
                (if (and (find :key  lh :key (function car))
                         (find :rest lh :key (function car)))
                    (delete :rest lh :key (function car))
                    lh)
                " ")
     stream)))

(define-command help (&optional (command nil commandp))
  "With a command argument, prints the docstring of the specified command.
without, lists all the commands with their docstrings."
  (flet ((format-help (help)
           (format t "~%~S~@[ ~/com.informatimago.pjb:fmt-lambda-list/~]~%~@[~A~%~]"
                   (first help) (second help)
                   (mapconcat (lambda (line) (format nil "  ~A" line))
                              (split-string (third help) #(#\newline))
                              (coerce #(#\newline) 'string)))))
    (if commandp
        (let ((help (find command *commands* :key (function first) :test (function string-equal))))
          (if help
              (format-help help)
              (format t "~%No help for ~S~%" command)))
        (dolist (help (setf *commands* (sort *commands* (function string<) :key (function first))))
          (format-help help))))
  (terpri))