cdr commands))))))

(define* (display-group group #:optional (abbrev? #t))
  (format #t "~:(~A~) Commands~:[~; [abbrev]~]:~2%" (group-name group) abbrev?)
  (for-each (lambda (c)
	      (display-summary (command-usage c)
			       (if abbrev? (command-abbrevs c) '())
			       (command-summary c)))
	    (group-commands group))
  (newline))

(define (display-command command)
  (display "Usage: ")
  (display (command-doc command))
  (newline))

(define (display-summary usage abbrevs summary)
  (let* ((usage-len (string-length usage))
         (abbrevs (if (pair? abbrevs)
                      (format #f "[,~A~{ ,~A~}]" (car abbrevs) (cdr abbrevs))
                      ""))
         (abbrevs-len (string-length abbrevs)))
    (format #t " ,~A~A~A - ~A\n"
            usage
            (cond
             ((> abbrevs-len 32)
              (error "abbrevs too long" abbrevs))
             ((> (+ usage-len abbrevs-len) 32)
              (format #f "~%~v_" (+ 2 (- 32 abbrevs-len))))
             (else
              (format #f "~v_" (- 32 abbrevs-len usage-len))))
            abbrevs
            summary)))

(define (read-command repl)
  (catch #t
    (lambda () (read))
    (lambda (key . args)
      (pmatch args
        ((,subr ,msg ,args . ,rest)
         (format #t "Throw to key `~a' while reading command:\n" key)
         (display-error #f (current-output-port) subr msg args rest))
        (else
         (format #t "Throw to key `~a' with args `~s' while reading command.\n"
                 key args)))
      (force-output)
      *unspecified*)))

(define (read-command-arguments c repl)
  ((command-info-arguments-reader (command-info c)) repl))

(define (meta-command repl)
  (let ((command (read-command repl)))
    (cond
     ((eq? command *unspecified*)) ; read error, already signalled; pass.
     ((not (symbol? command))
      (format #t "Meta-command not a symbol: ~s~%" command))
     ((lookup-command command)
      => (lambda (c)
           (and=> (read-command-arguments c repl)
                  (lambda (args) (apply (command-procedure c) repl args)))))
     (else
      (format #t "Unknown meta command: ~A~%" command)))))

(define (add-meta-command! name category proc argument-reader)
  (hashq-set! *command-infos* name (make-command-info proc argument-reader))
  (if category
      (let ((entry (assq category *command-table*)))
        (if entry
            (set-cdr! entry (append (cdr entry) (list (list name))))
            (set! *command-table*
                  (append *command-table*
                          (list (list category (list name)))))))))

(define-syntax define-meta-command
  (syntax-rules ()
    ((_ ((name category) repl (expression0 ...) . datums) docstring b0 b1 ...)
     (add-meta-command!
      'name
      'category
      (lambda* (repl expression0 ... . datums)
        docstring
        b0 b1 ...)
      (lambda (repl)
        (define (handle-read-error form-name key args)
          (pmatch args
            ((,subr ,msg ,args . ,rest)
             (format #t "Throw to key `~a' while reading ~@[argument `~A' of ~]command `~A':\n"
                     key form-name 'name)
             (display-error #f (current-output-port) subr msg args rest))
            (else
             (format #t "Throw to key `~a' with args `~s' while reading ~@[ argument `~A' of ~]command `~A'.\n"
                     key args form-name 'name)))
          (abort))
        (% (let* ((expression0
                   (catch #t
                          (lambda ()
                            (repl-reader
                             ""
                             (lambda* (#:optional (port (current-input-port)))
                               ((language-reader (repl-language repl))
                                port (current-module)))))
                          (lambda (k . args)
                            (handle-read-error 'expression0 k args))))
                  ...)
             (append
              (list expression0 ...)
              (catch #t
                     (lambda ()
                       (let ((port (open-input-string (read-line))))
                         (let lp ((out '()))
                           (let ((x (read port)))
                             (if (eof-object? x)
                                 (reverse out)
                                 (lp (cons x out)))))))
                     (lambda (k . args)
                       (handle-read-error #f k args)))))
           (lambda (k) #f)))))           ; the abort handler

    ((_ ((name category) repl . datums) docstring b0 b1 ...)
     (define-meta-command ((name category) repl () . datums)
       docstring b0 b1 ...))

    ((_ (name repl (expression0 ...) . datums) docstring b0 b1 ...)
     (define-meta-command ((name #f) repl (expression0 ...) . datums)
       docstring b0 b1 ...))

    ((_ (name repl . datums) docstring b0 b1 ...)
     (define-meta-command ((name #f) repl () . datums)
       docstring b0 b1 ...))))