Added compatibility for :preserve readtable-case (Allegro modern)
[parenscript.git] / src / namespace.lisp
blob2a9bc6d0ddbd27dfe6cbb9a085c2a21bf007bbf3
1 ;;; Copyright 2007-2010 Vladimir Sedach
2 ;;; Copyright 2008 Travis Cross
4 ;;; SPDX-License-Identifier: BSD-3-Clause
6 ;;; Redistribution and use in source and binary forms, with or
7 ;;; without modification, are permitted provided that the following
8 ;;; conditions are met:
10 ;;; 1. Redistributions of source code must retain the above copyright
11 ;;; notice, this list of conditions and the following disclaimer.
13 ;;; 2. 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 provided
16 ;;; with the distribution.
18 ;;; 3. Neither the name of the copyright holder nor the names of its
19 ;;; contributors may be used to endorse or promote products derived
20 ;;; from this software without specific prior written permission.
22 ;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND
23 ;;; CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
24 ;;; INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
25 ;;; MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
26 ;;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS
27 ;;; BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
28 ;;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
29 ;;; TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
30 ;;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
31 ;;; ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
32 ;;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
33 ;;; OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
34 ;;; POSSIBILITY OF SUCH DAMAGE.
36 (in-package #:parenscript)
37 (in-readtable :parenscript)
39 (defvar *obfuscated-packages* (make-hash-table))
41 (defun obfuscate-package (package-designator &optional symbol-map)
42 (setf (gethash (find-package package-designator)
43 *obfuscated-packages*)
44 (or symbol-map
45 (let ((symbol-table (make-hash-table)))
46 (lambda (symbol)
47 (or (gethash symbol symbol-table)
48 (setf (gethash symbol symbol-table)
49 (ps-gensym 'g))))))))
51 (defun unobfuscate-package (package-designator)
52 (remhash (find-package package-designator) *obfuscated-packages*))
54 (defun maybe-obfuscate-symbol (symbol)
55 (if (aand (symbol-package symbol) (eq :external (nth-value 1 (find-symbol (symbol-name symbol) it))))
56 symbol
57 (aif (gethash (symbol-package symbol) *obfuscated-packages*)
58 (funcall it symbol)
59 symbol)))
61 (defvar *package-prefix-table* (make-hash-table))
63 (defmacro ps-package-prefix (package)
64 `(gethash (find-package ,package) *package-prefix-table*))
66 (defun symbol-to-js-string (symbol &optional (mangle-symbol-name? t))
67 (let* ((symbol-name (symbol-name (maybe-obfuscate-symbol symbol)))
68 (identifier (if mangle-symbol-name?
69 (encode-js-identifier symbol-name)
70 symbol-name)))
71 (aif (ps-package-prefix (symbol-package symbol))
72 (concatenate 'string it identifier)
73 identifier)))