demos/advanced.lisp

   1 ;;; advanced.lisp --- Advanced usage demonstration program
   2
   3 ;; Copyright (C) 2010, 2011, 2012 Didier Verna.
   4
   5 ;; Author:     Didier Verna <didier@lrde.epita.fr>
   6 ;; Maintainer: Didier Verna <didier@lrde.epita.fr>
   7
   8 ;; This file is part of Clon.
   9
  10 ;; Permission to use, copy, modify, and distribute this software for any
  11 ;; purpose with or without fee is hereby granted, provided that the above
  12 ;; copyright notice and this permission notice appear in all copies.
  13
  14 ;; THIS SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
  15 ;; WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
  16 ;; MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
  17 ;; ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
  18 ;; WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
  19 ;; ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
  20 ;; OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
  21
  22
  23 ;;; Commentary:
  24
  25 ;; Contents management by FCM version 0.1.
  26
  27 ;; This demonstration program shows how to use multiple synopsis, contexts and
  28 ;; (virtual) command-lines in the same application in order to manage more
  29 ;; complex command-line syntax where options and non-options parts can be
  30 ;; freely intermixed. See section 5 "Advanced Usage" in the Clon User Manual.
  31
  32 ;; #### NOTE: some trickery is needed below in order to make this code
  33 ;; ECL-compliant, due to ECL's specific way of generating executables. This
  34 ;; includes:
  35 ;; - setting *load-verbose* to nil,
  36 ;; - passing a nil :verbose flag to asdf:load-system,
  37 ;; - wrapping nickname-package in an eval-when form.
  38 ;; None of these tweaks are needed for the other compilers.
  39
  40
  41 ;;; Code:
  42
  43 (in-package :cl-user)
  44
  45 (setq *load-verbose* nil)
  46
  47 (require :asdf
  48          ;; #### PORTME.
  49          #-(or sbcl cmu ccl ecl allegro
  50                (and lispworks (not lispworks-personal-edition)))
  51          '(#p"/usr/local/share/common-lisp/source/asdf/asdf.lisp"))
  52
  53 (asdf:load-system :com.dvlsoft.clon :verbose nil)
  54
  55 (eval-when (:execute :load-toplevel :compile-toplevel)
  56   (com.dvlsoft.clon:nickname-package))
  57
  58 (clon:defsynopsis (:postfix "cmd [OPTIONS]")
  59   (text :contents "Available commands: push pull.
  60 Use 'cmd --help' to get command-specific help.")
  61   (flag :short-name "h" :long-name "help"
  62         :description "Print this help and exit.")
  63   (switch :short-name "d" :long-name "debug"
  64           :description "Turn debugging on or off."
  65           :argument-style :on/off
  66           :env-var "DEBUG"))
  67
  68 (defconstant +push-synopsis+
  69     (clon:defsynopsis (:make-default nil)
  70       (text :contents "Push local changes to the remote server.")
  71       (flag :short-name "h" :long-name "help"
  72             :description "Print this help and exit.")
  73       (flag :short-name "d" :long-name "dry-run"
  74             :description "Fake the push operation.")
  75       (stropt :long-name "remote"
  76               :argument-name "SERVER"
  77               :description "Use SERVER instead of default remote."))
  78   "The synopsis for the PUSH operation.")
  79
  80 (defconstant +pull-synopsis+
  81     (clon:defsynopsis (:make-default nil)
  82       (text :contents "Pull remote changes to the local server.")
  83       (flag :short-name "h" :long-name "help"
  84             :description "Print this help and exit.")
  85       (flag :short-name "d" :long-name "dry-run"
  86             :description "Fake the push operation.")
  87       (switch :long-name "update"
  88               :default-value t
  89               :description "Also update the working directory."))
  90   "The synopsis for the PULL operation.")
  91
  92
  93 (defun main ()
  94   "Entry point for the standalone application."
  95   (clon:make-context)
  96   (cond ((or (clon:getopt :short-name "h")
  97              (not (clon:cmdline-p)))
  98          (clon:help))
  99         (t
 100          (unless (clon:remainder)
 101            (format t "Missing command.~%")
 102            (clon:exit 1))
 103          (clon:make-context
 104           :synopsis (cond ((string= (first (clon:remainder)) "push")
 105                            +push-synopsis+)
 106                           ((string= (first (clon:remainder)) "pull")
 107                            +pull-synopsis+)
 108                           (t
 109                            (format t "Unknown command.~%")
 110                            (clon:exit 1)))
 111           :cmdline (clon:remainder))
 112          (cond ((clon:getopt :short-name "h")
 113                 (clon:help))
 114                (t
 115                 (format t "Command name: ~A~%~%" (clon:progname))
 116                 (format t "Options:")
 117                 (clon:do-cmdline-options (option name value source)
 118                   (print (list option name value source)))
 119                 (terpri)
 120                 (format t "Remainder: ~A~%" (clon:remainder))))))
 121   (clon:exit))
 122
 123 (clon:dump "advanced" main)
 124
 125
 126 ;;; advanced.lisp ends here