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