1 (in-package :parenscript
)
3 (defun string-join (strings separator
)
4 (format nil
"~{~}" (format nil
"~~a~~^~a" separator
) strings
))
6 (defun val-to-string (val)
8 (string-downcase (symbol-name val
))
9 (princ-to-string val
)))
11 (defun string-split (string separators
&key
(keep-separators nil
) (remove-empty-subseqs nil
))
12 (do ((len (length string
))
17 (let ((split (if (> i last
)
18 (cons (subseq string last i
) res
)
20 (nreverse (if remove-empty-subseqs
21 (delete "" split
:test
#'string-equal
)
23 (when (member (char string i
) separators
)
24 (push (subseq string last i
) res
)
25 (when keep-separators
(push (string (char string i
)) res
))
28 (defparameter *special-chars
*
39 ;;; Parenscript-style symbol -> Javascript-style symbol
41 (defun constant-string-p (string)
42 (let ((len (length string
))
43 (constant-chars '(#\
+ #\
*)))
45 (member (char string
0) constant-chars
)
46 (member (char string
(1- len
)) constant-chars
))))
48 (defun first-uppercase-p (string)
49 (and (> (length string
) 1)
50 (member (char string
0) '(#\
+ #\
*))))
52 (defun untouchable-string-p (string)
53 (and (> (length string
) 1)
54 (char= #\
: (char string
0))))
56 (defun symbol-to-js-string (symbol)
57 "Given a Lisp symbol or string, produces to a valid JavaScript
58 identifier by following transformation heuristics case conversion. For
59 example, paren-script becomes parenScript, *some-global* becomes
61 (when (symbolp symbol
)
62 (setf symbol
(symbol-name symbol
)))
63 (let ((symbols (string-split symbol
'(#\.
#\
[ #\
]) :keep-separators t
:remove-empty-subseqs t
)))
64 (cond ((null symbols
) "")
65 ((= (length symbols
) 1)
70 (cond ((constant-string-p symbol
)
72 symbol
(subseq symbol
1 (1- (length symbol
)))))
73 ((first-uppercase-p symbol
)
75 symbol
(subseq symbol
1)))
76 ((untouchable-string-p symbol
)
78 symbol
(subseq symbol
1))))
82 ((and lowercase
(not all-uppercase
))
87 (dotimes (i (length symbol
))
88 (let ((c (char symbol i
)))
91 (setf lowercase
(not lowercase
)))
92 ((assoc c
*special-chars
*)
93 (dolist (i (coerce (cdr (assoc c
*special-chars
*)) 'list
))
96 (coerce (nreverse res
) 'string
)))
97 (t (string-join (mapcar #'symbol-to-js-string symbols
) "")))))
99 (defun ordered-set-difference (list1 list2
&key
(test #'eql
)) ; because the CL set-difference may not preserve order
100 (reduce (lambda (list el
) (remove el list
:test test
))