package.lisp

   1 ;;; package.lisp --- Common Lisp Package definition
   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
  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   ;; #### PORTME.
  37   (:import-from #+sbcl      :sb-mop
  38                 #+cmu       :mop
  39                 #+ccl       :ccl
  40                 #+ecl       :clos
  41                 #+clisp     :clos
  42                 #+abcl      :mop
  43                 #+allegro   :mop
  44                 #+lispworks :clos
  45                 :class-slots :slot-definition-name :validate-superclass)
  46   (:import-from :com.dvlsoft.clon.asdf
  47     :configuration
  48     :define-constant
  49     :+release-major-level+
  50     :+release-minor-level+
  51     :+release-status+
  52     :+release-status-level+
  53     :+release-name+
  54     :version)
  55   (:export
  56     ;; From com.dvlsoft.clon.asd:
  57     :+release-major-level+
  58     :+release-minor-level+
  59     :+release-status+
  60     :+release-status-level+
  61     :+release-name+
  62     :version
  63     ;; From package.lisp:
  64     :nickname-package
  65     ;; From src/util.lisp:
  66     :exit
  67     :cmdline
  68     :dump
  69     ;; From src/text.lisp:
  70     :make-text
  71     ;; From src/options/flag.lisp:
  72     :make-flag
  73     ;; From src/options/switch.lisp:
  74     :make-switch
  75     ;; From src/options/stropt.lisp:
  76     :make-stropt
  77     ;; From src/options/lispobj.lisp:
  78     :make-lispobj
  79     ;; From src/options/path.lisp:
  80     :make-path
  81     ;; From src/options/enum.lisp:
  82     :make-enum
  83     ;; From src/options/xswitch.lisp:
  84     :make-xswitch
  85     ;; From src/group.lisp:
  86     :make-group :defgroup
  87     ;; From src/synopsis.lisp:
  88     :*synopsis*
  89     :make-synopsis :defsynopsis
  90     ;; From src/context.lisp:
  91     :*context*
  92     :make-context
  93     :with-context
  94     :progname
  95     :remainder
  96     :cmdline-options-p
  97     :cmdline-p
  98     :getopt
  99     :getopt-cmdline
 100     :multiple-value-getopt-cmdline
 101     :do-cmdline-options
 102     :help))
 103
 104
 105 (in-package :com.dvlsoft.clon)
 106
 107
 108 ;; -------------------
 109 ;; External utilities:
 110 ;; -------------------
 111
 112 (defun nickname-package (&optional (nickname :clon))
 113   "Add NICKNAME (:CLON by default) to the :COM.DVLSOFT.CLON package."
 114   (rename-package :com.dvlsoft.clon
 115                   (package-name :com.dvlsoft.clon)
 116                   (adjoin nickname (package-nicknames :com.dvlsoft.clon)
 117                           :test #'string-equal)))
 118
 119
 120 ;; -------------------
 121 ;; Internal utilities:
 122 ;; -------------------
 123
 124 (defvar *readtable* (copy-readtable)
 125   "The Clon readtable.")
 126
 127
 128 ;; String concatenation
 129 ;; --------------------
 130 (defun tilde-reader (stream char)
 131   "Read a series of ~\"string\" to be concatenated together."
 132   (declare (ignore char))
 133   (flet ((read-string (&aux (string (read stream t nil t)))
 134            (check-type string string "a string")
 135            string))
 136     (apply #'concatenate 'string
 137            (read-string)
 138            (loop :while (char= (peek-char t stream nil nil t) #\~)
 139                  :do (read-char stream t nil t)
 140                  :collect (read-string)))))
 141
 142 (set-macro-character #\~ #'tilde-reader nil *readtable*)
 143
 144 ;; Emacs indentation
 145 ;; -----------------
 146 (defun clindent (symbol indent)
 147   "Set SYMBOL's indentation to INDENT in (X)Emacs.
 148 This function sets SYMBOL's common-lisp-indent-function property.
 149 If INDENT is a symbol, use its indentation definition.
 150 Otherwise, INDENT is considered as an indentation definition."
 151   (when (and (member :swank *features*)
 152              (configuration :swank-eval-in-emacs))
 153     ;; #### NOTE: case portability
 154     (funcall (intern (string :eval-in-emacs) :swank)
 155              `(put ',symbol 'common-lisp-indent-function
 156                    ,(if (symbolp indent)
 157                         `(get ',indent 'common-lisp-indent-function)
 158                       `',indent))
 159              t)))
 160
 161 (defmacro defindent (symbol indent)
 162   "Set SYMBOL's indentation to INDENT in (X)Emacs.
 163 SYMBOL and INDENT need not be quoted.
 164 See CLINDENT for more information."
 165   `(eval-when (:compile-toplevel :execute :load-toplevel)
 166      (clindent ',symbol ',indent)))
 167
 168 (defun i-reader (stream subchar arg)
 169   "Read an argument list for the DEFINDENT macro."
 170   (declare (ignore subchar arg))
 171   (cons 'defindent (read stream)))
 172
 173 (set-dispatch-macro-character #\# #\i #'i-reader *readtable*)
 174
 175
 176 ;; ECL, CLISP, Allegro and LispWorks do not like to see undefined reader
 177 ;; macros in expressions that belong to other compilers. For instance this
 178 ;; will break: #+ccl (#_ccl-only-function) It seems to be a correct behavior
 179 ;; (see *read-suppress* in CLHS), although other implementations like SBCL and
 180 ;; CMUCL are more gentle. The solution I use is to define those reader macros
 181 ;; to simply return nil.
 182
 183 ;; #### PORTME.
 184 #+(or ecl clisp allegro lispworks)
 185 (progn
 186   (defun dummy-reader (stream subchar args)
 187     "Return nil."
 188     (declare (ignore stream subchar args))
 189     nil)
 190   (set-dispatch-macro-character #\# #\_ #'dummy-reader *readtable*)
 191   (set-dispatch-macro-character #\# #\$ #'dummy-reader *readtable*))
 192
 193 (defmacro in-readtable (name)
 194   "Set the current readtable to the value of NAME::*READTABLE*."
 195   `(eval-when (:compile-toplevel :load-toplevel :execute)
 196      (setf cl:*readtable*
 197            ;; #### NOTE: case portability
 198            (symbol-value (find-symbol (string :*readtable*) ,name)))))
 199
 200
 201 ;;; package.lisp ends here