package.lisp

   1 ;;; package.lisp --- Common Lisp Package definition
   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
  28 ;;; Code:
  29
  30 (in-package :cl-user)
  31
  32 (defpackage :com.dvlsoft.clon
  33   (:documentation "The Command-Line Options Nuker package.")
  34   (:use :cl)
  35   (:shadow :*readtable*)
  36   (:import-from :com.dvlsoft.clon.asdf
  37     :define-constant
  38     :+release-major-level+
  39     :+release-minor-level+
  40     :+release-status+
  41     :+release-status-level+
  42     :+release-name+
  43     :version)
  44   (:export
  45    ;; From com.dvlsoft.clon.asd:
  46    :+release-major-level+
  47    :+release-minor-level+
  48    :+release-status+
  49    :+release-status-level+
  50    :+release-name+
  51    :version
  52    ;; From package.lisp:
  53    :nickname-package
  54    ;; From src/util.lisp:
  55    :exit
  56    :cmdline
  57    :dump
  58    ;; From src/text.lisp:
  59    :make-text
  60    ;; From src/options/flag.lisp:
  61    :make-flag
  62    ;; From src/options/switch.lisp:
  63    :make-switch
  64    ;; From src/options/stropt.lisp:
  65    :make-stropt
  66    ;; From src/options/lispobj.lisp:
  67    :make-lispobj
  68    ;; From src/options/path.lisp:
  69    :make-path
  70    ;; From src/options/enum.lisp:
  71    :make-enum
  72    ;; From src/options/xswitch.lisp:
  73    :make-xswitch
  74    ;; From src/group.lisp:
  75    :make-group :defgroup
  76    ;; From src/synopsis.lisp:
  77    :*default-synopsis*
  78    :make-synopsis :defsynopsis
  79    ;; From src/context.lisp:
  80    :*current-context*
  81    :make-context
  82    :with-context
  83    :progname
  84    :remainder
  85    :getopt
  86    :getopt-cmdline
  87    :multiple-value-getopt-cmdline
  88    :do-cmdline-options
  89    :help))
  90
  91
  92 (in-package :com.dvlsoft.clon)
  93
  94
  95 ;; -------------------
  96 ;; External utilities:
  97 ;; -------------------
  98
  99 (defun nickname-package (&optional (nickname :clon))
 100   "Add NICKNAME (:CLON by default) to the :COM.DVLSOFT.CLON package."
 101   (rename-package :com.dvlsoft.clon
 102                   (package-name :com.dvlsoft.clon)
 103                   (adjoin nickname (package-nicknames :com.dvlsoft.clon)
 104                           :test #'string-equal)))
 105
 106
 107 ;; -------------------
 108 ;; Internal utilities:
 109 ;; -------------------
 110
 111 (defvar *readtable* (copy-readtable)
 112   "The Clon readtable.")
 113
 114 (defun tilde-reader (stream char)
 115   "Read a series of ~\"strings\" to be concatenated together."
 116   (declare (ignore char))
 117   (apply #'concatenate 'string
 118          (loop :for str := (read stream t nil t)
 119                :then (progn (read-char stream t nil t)
 120                             (read stream t nil t))
 121                :collect str
 122                :while (eql (peek-char t stream nil nil t) #\~))))
 123
 124 (set-macro-character #\~ #'tilde-reader nil *readtable*)
 125
 126 ;; ECL and CLISP do not like to see undefined reader macros in expressions
 127 ;; that belong to other compilers. For instance this will break:
 128 ;; #+ccl (#_ccl-only-function)
 129 ;; It seems to be a correct behavior (see *read-suppress* in CLHS), although
 130 ;; other implementations like SBCL and CMUCL are more gentle. The solution I
 131 ;; use is to define those reader macros to simply return nil.
 132 #+(or ecl clisp)
 133 (progn
 134
 135   (defun dummy-reader (stream subchar args)
 136     "Return nil."
 137     (declare (ignore stream subchar args))
 138     nil)
 139
 140   (set-dispatch-macro-character #\# #\_ #'dummy-reader *readtable*)
 141   (set-dispatch-macro-character #\# #\$ #'dummy-reader *readtable*))
 142
 143 (defmacro in-readtable (name)
 144   "Set the current readtable to the value of NAME::*READTABLE*."
 145   `(eval-when (:compile-toplevel :load-toplevel :execute)
 146     (setf cl:*readtable* (symbol-value (find-symbol "*READTABLE*" ,name)))))
 147
 148
 149 ;;; package.lisp ends here