From 54ba4fe8a12947612dceb00553c3e75c96c8a972 Mon Sep 17 00:00:00 2001
From: Bert Burgemeister <trebbu@googlemail.com>
Date: Tue, 12 Jun 2012 10:06:53 +0200
Subject: [PATCH] Be more helpful when called without any options

---
 cli.lisp         | 87 ++++++++++++++++++++++++++++++++------------------------
 etc/one-line.cth |  4 +++
 etc/short.cth    |  3 +-
 util.lisp        | 12 --------
 4 files changed, 56 insertions(+), 50 deletions(-)
 create mode 100644 etc/one-line.cth

diff --git a/cli.lisp b/cli.lisp
index 4cd9f63..14eb6ae 100644
--- a/cli.lisp
+++ b/cli.lisp
@@ -624,6 +624,19 @@
              :fallback-value "*"
              :description "List the specified user with their presentation projects, or all users if no user is given."))))
 
+(defun cli:first-action-option (&rest options)
+  "Run action called <option>-action for the first non-nil option;
+return its value."
+  (cli:with-context (cli:make-context)
+     (loop
+        for option in options
+        when (cli:getopt :long-name (string-downcase option))
+        return (funcall (symbol-function (intern (concatenate 'string
+                                                              (string option)
+                                                              "-ACTION")
+                                                 :cli)))
+        finally (cli:help :theme "etc/one-line.cth"))))
+
 (defun cli:main ()
   "The UNIX command line entry point."
   (handler-bind
@@ -654,43 +667,43 @@
       (setf *aux-numeric-labels* aux-numeric-label)
       (setf *aux-text-labels* aux-text-label)
       (setf *login-intro* login-intro))
-    (cli:first-action-option help
-                             licence
-                             license
-                             version
-                             check-db
-                             check-dependencies
-                             nuke-all-tables
-                             create-sys-tables
-                             get-image
-                             store-camera-hardware
-                             store-lens
-                             store-generic-device
-                             store-device-stage-of-life
-                             store-device-stage-of-life-end
-                             store-camera-calibration
-                             create-acquisition-project
-                             delete-acquisition-project
-                             delete-measurement
-                             list-acquisition-project
-                             store-images-and-points
-                             insert-footprints
-                             server
-                             create-presentation-project
-                             delete-presentation-project
-                             list-presentation-project
-                             add-to-presentation-project
-                             remove-from-presentation-project
-                             redefine-trigger-function
-                             create-image-attribute
-                             delete-image-attribute
-                             list-image-attribute
-                             create-aux-view
-                             get-user-points
-                             store-user-points
-                             create-user
-                             delete-user
-                             list-user)
+    (cli:first-action-option 'help
+                             'licence
+                             'license
+                             'version
+                             'check-db
+                             'check-dependencies
+                             'nuke-all-tables
+                             'create-sys-tables
+                             'get-image
+                             'store-camera-hardware
+                             'store-lens
+                             'store-generic-device
+                             'store-device-stage-of-life
+                             'store-device-stage-of-life-end
+                             'store-camera-calibration
+                             'create-acquisition-project
+                             'delete-acquisition-project
+                             'delete-measurement
+                             'list-acquisition-project
+                             'store-images-and-points
+                             'insert-footprints
+                             'server
+                             'create-presentation-project
+                             'delete-presentation-project
+                             'list-presentation-project
+                             'add-to-presentation-project
+                             'remove-from-presentation-project
+                             'redefine-trigger-function
+                             'create-image-attribute
+                             'delete-image-attribute
+                             'list-image-attribute
+                             'create-aux-view
+                             'get-user-points
+                             'store-user-points
+                             'create-user
+                             'delete-user
+                             'list-user)
     (sb-ext:exit :code *unix-exit-code*)))
 
 (defun cli:set-.phoros-options ()
diff --git a/etc/one-line.cth b/etc/one-line.cth
new file mode 100644
index 0000000..002245f
--- /dev/null
+++ b/etc/one-line.cth
@@ -0,0 +1,4 @@
+;; -*- lisp -*-
+:face (text :hidden t)
+:face (option :hidden t)
+:face (group :hidden t)
diff --git a/etc/short.cth b/etc/short.cth
index 7aa329d..543a6e9 100644
--- a/etc/short.cth
+++ b/etc/short.cth
@@ -1,5 +1,6 @@
 ;; -*- lisp -*-
-:face (synopsis :bold t)
+:face (synopsis :bold t
+                :padding-bottom 0)
 :face (text :hidden t)
 :face (option :padding-left 2
 	      :face (syntax :item-separator "/"
diff --git a/util.lisp b/util.lisp
index 00bb087..a597ea1 100644
--- a/util.lisp
+++ b/util.lisp
@@ -141,15 +141,3 @@ aux-use-ssl."
                                                       (car option)))
                         while i collect i))))
          ,@logged-body))))
-
-(defmacro cli:first-action-option (&rest options)
-  "Run action called <option>-action for the first non-nil option;
-return its value."
-  `(cli:with-context (cli:make-context)
-     (loop
-        for option in ',options
-        when (cli:getopt :long-name (string-downcase option))
-        return (funcall (symbol-function (intern (concatenate 'string
-                                                              (string option)
-                                                              "-ACTION")
-                                                 :cli))))))
\ No newline at end of file
-- 
2.11.4.GIT