Pretty Printing Tables

Common Lisp has a really nice function called FORMAT which is like C's printf on steriods. FORMAT uses an embedded language as a format string to allow you to print any data types and structures with ease. Unfortunately I haven't found a way to print tables the way I want using a single format command. So I wrote a function called PRINT-TABLE that takes a two-dimensional array or a list of lists as input and prints something nice like this:

EULER> (defparameter people '(("ID" "First Name" "Last Name")
                              (1 "Fred" "Flintstone")
                              (2 "Barney" "Rubble")
                              (3 "Wilma" "Flintstone")))
PEOPLE
EULER> (print-table people t)
ID|First Name|Last Name
--+----------+----------
1 |Fred      |Flintstone
2 |Barney    |Rubble
3 |Wilma     |Flintstone
NIL

The function has two modes. One mode uses the first row as a header and prints a separator after it, like above. The other mode prints a grid. This is useful when printing the output of my sudoku solver:

EULER> (print-table (solve-sudoku *test-puzzle*))
4|8|3|9|2|1|6|5|7
-+-+-+-+-+-+-+-+-
9|6|7|3|4|5|8|2|1
-+-+-+-+-+-+-+-+-
2|5|1|8|7|6|4|9|3
-+-+-+-+-+-+-+-+-
5|4|8|1|3|2|9|7|6
-+-+-+-+-+-+-+-+-
7|2|9|5|6|4|1|3|8
-+-+-+-+-+-+-+-+-
1|3|6|7|9|8|2|4|5
-+-+-+-+-+-+-+-+-
3|7|2|6|8|9|5|1|4
-+-+-+-+-+-+-+-+-
8|1|4|2|5|3|7|6|9
-+-+-+-+-+-+-+-+-
6|9|5|4|1|7|3|8|2
NIL

Of course for printing soduku puzzles it would be nice to only draw the grid lines for each of the nine regions. I'll probably write a different grid printer for soduku puzzles later and leave this one more general-purpose.

Being fairly new to Lisp I'm sure the code I wrote is not as efficient or small as it could be.  I'm open for suggestions on ways to improve it.  Or perhaps someone can show me a library function or a way to use FORMAT to do this.  Here's the code:

(defun repeat-char (c n)
  "Returns a string repeating character c n times."
  ;TODO: There is probably a shorter/better way to do this
  (format nil "~a" (with-output-to-string (s)
                     (loop for x from 1 to n do (princ c s)))))

(defun calc-column-widths (table)
  "Returns the column widths of a table by iterating thru all cells
and using the max cell width in a column as that column's width"
  (loop with num-of-cols = (length (first table))
        with widths = (loop for x from 1 to num-of-cols collect 0)
        for row in table
        do (loop for cell in row
                 for col-index from 0
                 for cell-length = (length (format nil "~a" cell))
                 when (> cell-length (nth col-index widths))
                 do (setf (nth col-index widths) cell-length))
        finally (return widths)))

(defun print-row-divider(col-widths)
  (print-row (loop for w in col-widths
                   collect (repeat-char #\- w))
             col-widths #\+))

(defun print-row (row col-widths &optional (divider-char #\|))
  (loop for cell in row
        for col-index from 0
        with col-count = (length row)
        when (= col-index (1- col-count))
        do (format t "~a" cell)
        else
        do (format t (format nil "~~~da~~c" (nth col-index col-widths))
                   cell divider-char))
  (format t "~%"))

(defun array->list (a)
  "Converts an array of any dimension to a list of lists."
  (read-from-string (write-to-string a) t t :start 3))

(defun print-table (table &optional (header-p nil))
  "Prints a list of lists or a 2d array in a nicetable format.
If HEADER-P is T then the first row is considered a header and
a divider is printed after it.  If HEADER-P is NIL then all
rows get dividers between them."
  (let* ((table (if (arrayp table)
                    (array->list table)
                    table))
         (col-widths (calc-column-widths table))
         (num-of-rows (length table)))
    (when header-p
        (print-row (pop table) col-widths)
        (print-row-divider col-widths))

(loop for row in table
          for row-index from 0
          do (print-row row col-widths)
          when (and (null header-p)
                    (< row-index (1- num-of-rows)))
          do (print-row-divider col-widths))))