print-query

The following patch implements the print-query function. I've
interpreted the interaction of the FORMATS and SIZES parameters
(without access to CommonSQL to check) as follows:

|-----------------------------------------------------------------|
|               |                    sizes                        |
|               |-------------------------------------------------|
|               |      t        |    list        |      nil       |
|-----------------------------------------------------------------|
|        |      | ~VA using     | ~VA using      |  ~A using no   |
|        |   t  | computed      | supplied       |  column sizes  |
|        |      | sizes         | sizes          |                |
|formats |--------------------------------------------------------|
|        |      | supplied ctrl | supplied ctrl  | supplied ctrl  |
|        | list | string using  | string using   | string using   |
|        |      | computed sizes| supplied sizes | no sizes       |
|-----------------------------------------------------------------|

If format strings are supplied, they are also applied to the titles
(which is not necessarily the best way of doing it). Here's an example
using the database described in the usql tutorial:

USER> (sql:print-query [select [first-name] [last-name] [email]
                         :from [employee]]
                 :titles '("FORENAME" "SURNAME" "EMAIL")
                 :formats '("~V@A; " "~V@A; " "~V@A."))
FORENAME; SURNAME;             EMAIL.
Valdamir;   Lenin;  [email protected].
   Josef;  Stalin; [email protected].
USER>

Marcus
-- 

Index: sql/sql.lisp
===================================================================
RCS file: /cvs/usql/sql/sql.lisp,v
retrieving revision 1.84
diff -u -r1.84 sql.lisp
--- sql/sql.lisp        2003/01/03 05:24:08     1.84
+++ sql/sql.lisp        2004/02/24 13:31:52
@@ -288,10 +288,35 @@
 ;  (break)
   (query (sql-output expr database) :database database))

-(defun print-query (query-exp &key titles formats sizes stream
+(defun print-query (query-exp &key titles (formats t) (sizes t) (stream t)
                              (database *default-database*))
-  (declare (ignore titles formats sizes stream))
-  (query (sql-output query-exp) :database database))
+  "The PRINT-QUERY function takes a symbolic SQL query expression and
+formatting information and prints onto STREAM a table containing the
+results of the query. A list of strings to use as column headings is
+given by TITLES, which has a default value of NIL. The FORMATS
+argument is a list of format strings used to print each attribute, and
+has a default value of T, which means that ~A or ~VA are used if sizes
+are provided or computed. The field sizes are given by SIZES. It has a
+default value of T, which specifies that minimum sizes are
+computed. The output stream is given by STREAM, which has a default
+value of T. This specifies that *STANDARD-OUTPUT* is used."
+  (flet ((compute-sizes (data)
+           (mapcar #'(lambda (x) (apply #'max (mapcar #'length x)))
+                   (apply #'mapcar (cons #'list data))))
+         (format-record (record control sizes)
+           (format stream "~&~?" control
+                   (if (null sizes) record
+                       (mapcan #'(lambda (s f) (list s f)) sizes record)))))
+    (let* ((data (query (sql-output query-exp) :database database))
+           (sizes (if (or (null sizes) (listp sizes)) sizes
+                      (compute-sizes (if titles (cons titles data) data))))
+           (formats (if (or (null formats) (not (listp formats)))
+                        (make-list (length (car data)) :initial-element
+                                   (if (null sizes) "~A " "~VA "))
+                        formats))
+           (control-string (format nil "~{~A~}" formats)))
+      (when titles (format-record titles control-string sizes))
+      (dolist (d data (values)) (format-record d control-string sizes)))))

 (defmethod execute-command ((expr %sql-expression)
                             &key (database *default-database*))