demos/advanced.lisp

   1 ;;; advanced.lisp --- Advanced usage demonstration program
   2
   3 ;; Copyright (C) 2010, 2011 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:operate,
  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          #-(or sbcl cmu ccl ecl)
  49          '(#p"/usr/local/share/common-lisp/source/asdf/asdf.lisp"))
  50
  51 #-asdf2 (setf asdf:*central-registry*
  52               (list* (merge-pathnames "share/common-lisp/systems/"
  53                                       (user-homedir-pathname))
  54                      #p"/usr/local/share/common-lisp/systems/"
  55                      #p"/usr/share/common-lisp/systems/"
  56                      asdf:*central-registry*))
  57
  58 #-asdf2 (ignore-errors (asdf:operate 'asdf:load-op :asdf-binary-locations))
  59
  60 (asdf:operate 'asdf:load-op :com.dvlsoft.clon :verbose nil)
  61
  62 (eval-when (:execute :load-toplevel :compile-toplevel)
  63   (com.dvlsoft.clon:nickname-package))
  64
  65 (clon:defsynopsis (:postfix "cmd [OPTIONS]")
  66   (text :contents "Available commands: push pull.
  67 Use 'cmd --help' to get command-specific help.")
  68   (flag :short-name "h" :long-name "help"
  69         :description "Print this help and exit.")
  70   (switch :short-name "d" :long-name "debug"
  71           :description "Turn debugging on or off."
  72           :argument-style :on/off
  73           :env-var "DEBUG"))
  74
  75 (defconstant +push-synopsis+
  76     (clon:defsynopsis (:make-default nil)
  77       (text :contents "Push local changes to the remote server.")
  78       (flag :short-name "h" :long-name "help"
  79             :description "Print this help and exit.")
  80       (flag :short-name "d" :long-name "dry-run"
  81             :description "Fake the push operation.")
  82       (stropt :long-name "remote"
  83               :argument-name "SERVER"
  84               :description "Use SERVER instead of default remote."))
  85   "The synopsis for the PUSH operation.")
  86
  87 (defconstant +pull-synopsis+
  88     (clon:defsynopsis (:make-default nil)
  89       (text :contents "Pull remote changes to the local server.")
  90       (flag :short-name "h" :long-name "help"
  91             :description "Print this help and exit.")
  92       (flag :short-name "d" :long-name "dry-run"
  93             :description "Fake the push operation.")
  94       (switch :long-name "update"
  95               :default-value t
  96               :description "Also update the working directory."))
  97   "The synopsis for the PULL operation.")
  98
  99
 100 (defun main ()
 101   "Entry point for the standalone application."
 102   (clon:make-context)
 103   (cond ((or (clon:getopt :short-name "h")
 104              (not (clon:cmdline-p)))
 105          (clon:help))
 106         (t
 107          (unless (clon:remainder)
 108            (format t "Missing command.~%")
 109            (clon:exit 1))
 110          (clon:make-context
 111           :synopsis (cond ((string= (first (clon:remainder)) "push")
 112                            +push-synopsis+)
 113                           ((string= (first (clon:remainder)) "pull")
 114                            +pull-synopsis+)
 115                           (t
 116                            (format t "Unknown command.~%")
 117                            (clon:exit 1)))
 118           :cmdline (clon:remainder))
 119          (cond ((clon:getopt :short-name "h")
 120                 (clon:help))
 121                (t
 122                 (format t "Command name: ~A~%~%" (clon:progname))
 123                 (format t "Options:")
 124                 (clon:do-cmdline-options (option name value source)
 125                   (print (list option name value source)))
 126                 (terpri)
 127                 (format t "Remainder: ~A~%" (clon:remainder))))))
 128   (clon:exit))
 129
 130 (clon:dump "advanced" main)
 131
 132
 133 ;;; advanced.lisp ends here