| 1 |
;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-INTERPOL; Base: 10 -*- |
|---|
| 2 |
;;; $Header: /usr/local/cvsrep/cl-interpol/specials.lisp,v 1.12 2008/07/23 13:58:40 edi Exp $ |
|---|
| 3 |
|
|---|
| 4 |
;;; Copyright (c) 2003-2008, Dr. Edmund Weitz. All rights reserved. |
|---|
| 5 |
|
|---|
| 6 |
;;; Redistribution and use in source and binary forms, with or without |
|---|
| 7 |
;;; modification, are permitted provided that the following conditions |
|---|
| 8 |
;;; are met: |
|---|
| 9 |
|
|---|
| 10 |
;;; * Redistributions of source code must retain the above copyright |
|---|
| 11 |
;;; notice, this list of conditions and the following disclaimer. |
|---|
| 12 |
|
|---|
| 13 |
;;; * Redistributions in binary form must reproduce the above |
|---|
| 14 |
;;; copyright notice, this list of conditions and the following |
|---|
| 15 |
;;; disclaimer in the documentation and/or other materials |
|---|
| 16 |
;;; provided with the distribution. |
|---|
| 17 |
|
|---|
| 18 |
;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED |
|---|
| 19 |
;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED |
|---|
| 20 |
;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
|---|
| 21 |
;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY |
|---|
| 22 |
;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
|---|
| 23 |
;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE |
|---|
| 24 |
;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS |
|---|
| 25 |
;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, |
|---|
| 26 |
;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING |
|---|
| 27 |
;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS |
|---|
| 28 |
;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. |
|---|
| 29 |
|
|---|
| 30 |
(in-package :cl-interpol) |
|---|
| 31 |
|
|---|
| 32 |
(defvar *list-delimiter* #\Space |
|---|
| 33 |
"What is inserted between the elements of a list which is |
|---|
| 34 |
interpolated by #\@.") |
|---|
| 35 |
|
|---|
| 36 |
(defvar *inner-delimiters* '((#\( . #\)) |
|---|
| 37 |
(#\{ . #\}) |
|---|
| 38 |
(#\< . #\>) |
|---|
| 39 |
(#\[ . #\])) |
|---|
| 40 |
"Legal delimiters for interpolation with #\$ and #\@.") |
|---|
| 41 |
|
|---|
| 42 |
(defvar *outer-delimiters* '((#\( . #\)) |
|---|
| 43 |
(#\{ . #\}) |
|---|
| 44 |
(#\< . #\>) |
|---|
| 45 |
(#\[ . #\]) |
|---|
| 46 |
#\/ #\| #\" #\' #\#) |
|---|
| 47 |
"Legal outer delimiters for CL-INTERPOL strings.") |
|---|
| 48 |
|
|---|
| 49 |
(defvar *regex-delimiters* '(#\/) |
|---|
| 50 |
"Outer delimiters which automatically enable regex mode.") |
|---|
| 51 |
|
|---|
| 52 |
(defvar *unicode-aliases* |
|---|
| 53 |
(make-hash-table :test #'equalp) |
|---|
| 54 |
"A hash table which maps Unicode aliases to their real names.") |
|---|
| 55 |
|
|---|
| 56 |
(defvar *optional-delimiters-p* nil |
|---|
| 57 |
"Whether text following $ or @ should interpolate even without a |
|---|
| 58 |
following delimiter. Lexical variables are handled correctly, |
|---|
| 59 |
but the rules are somewhat complex -- see the docs for details.") |
|---|
| 60 |
|
|---|
| 61 |
(defmacro defvar-unbound (variable-name documentation) |
|---|
| 62 |
"Like DEFVAR, but the variable will be unbound rather than getting |
|---|
| 63 |
an initial value. This is useful for variables which should have no |
|---|
| 64 |
global value but might have a dynamically bound value." |
|---|
| 65 |
;; stolen from comp.lang.lisp article <k7727i3s.fsf@comcast.net> by |
|---|
| 66 |
;; "prunesquallor@comcast.net" |
|---|
| 67 |
`(eval-when (:load-toplevel :compile-toplevel :execute) |
|---|
| 68 |
(defvar ,variable-name) |
|---|
| 69 |
(setf (documentation ',variable-name 'variable) |
|---|
| 70 |
,documentation))) |
|---|
| 71 |
|
|---|
| 72 |
(defvar-unbound *saw-backslash* |
|---|
| 73 |
"Whether we have to re-process an \L or \U because it closes several |
|---|
| 74 |
scopes.") |
|---|
| 75 |
|
|---|
| 76 |
(defvar-unbound *pair-level* |
|---|
| 77 |
"") |
|---|
| 78 |
|
|---|
| 79 |
(defvar-unbound *stream* |
|---|
| 80 |
"Bound to the stream which is read from while parsing a string.") |
|---|
| 81 |
|
|---|
| 82 |
(defvar-unbound *start-char* |
|---|
| 83 |
"Bound to the opening outer delimiter while parsing a string.") |
|---|
| 84 |
|
|---|
| 85 |
(defvar-unbound *term-char* |
|---|
| 86 |
"Bound to the closing outer delimiter while parsing a string.") |
|---|
| 87 |
|
|---|
| 88 |
(defvar *previous-readtables* nil |
|---|
| 89 |
"A stack which holds the previous readtables that have been pushed |
|---|
| 90 |
here by ENABLE-INTERPOL-SYNTAX.") |
|---|
| 91 |
|
|---|
| 92 |
(defvar-unbound *readtable-copy* |
|---|
| 93 |
"Bound to the current readtable if it has to be temporarily |
|---|
| 94 |
modified.") |
|---|
| 95 |
|
|---|
| 96 |
;; stuff for Nikodemus Siivola's HYPERDOC |
|---|
| 97 |
;; see <http://common-lisp.net/project/hyperdoc/> |
|---|
| 98 |
;; and <http://www.cliki.net/hyperdoc> |
|---|
| 99 |
|
|---|
| 100 |
(defvar *hyperdoc-base-uri* "http://weitz.de/cl-interpol/") |
|---|
| 101 |
|
|---|
| 102 |
(let ((exported-symbols-alist |
|---|
| 103 |
(loop for symbol being the external-symbols of :cl-interpol |
|---|
| 104 |
collect (cons symbol |
|---|
| 105 |
(concatenate 'string |
|---|
| 106 |
"#" |
|---|
| 107 |
(string-downcase symbol)))))) |
|---|
| 108 |
(defun hyperdoc-lookup (symbol type) |
|---|
| 109 |
(declare (ignore type)) |
|---|
| 110 |
(cdr (assoc symbol |
|---|
| 111 |
exported-symbols-alist |
|---|
| 112 |
:test #'eq)))) |
|---|
| 113 |
|
|---|