Verified Commit d11e2ec2 authored by Vladimir Sedach's avatar Vladimir Sedach
Browse files

Fix deprecation warnings for symbols like foo.bar and foo[bar]

Thanks to appleby for the bug report.
https://github.com/vsedach/Parenscript/issues/41
parent 297f0d75
......@@ -7,40 +7,65 @@
"Given a string, produces to a valid JavaScript identifier by
following transformation heuristics case conversion. For example,
paren-script becomes parenScript, *some-global* becomes SOMEGLOBAL."
(or (gethash identifier cache)
(setf (gethash identifier cache)
(cond ((some (lambda (c) (find c "-*+!?#@%/=:<>^")) identifier)
(let ((lowercase t)
(all-uppercase nil))
(when (and (not (string= identifier "[]")) ;; HACK
(find-if (lambda (x) (find x '(#\. #\[ #\]))) identifier))
(warn "Symbol ~A contains one of '.[]' - this compound naming convention is no longer supported by Parenscript!"
identifier))
(acond ((nth-value 1 (cl-ppcre:scan-to-strings "[\\*|\\+](.+)[\\*|\\+](.*)" identifier :sharedp t))
(setf all-uppercase t
identifier (concatenate 'string (aref it 0) (aref it 1))))
((and (> (length identifier) 1)
(or (eql (char identifier 0) #\+)
(eql (char identifier 0) #\*)))
(setf lowercase nil
identifier (subseq identifier 1))))
(with-output-to-string (acc)
(loop for c across identifier
do (acond ((eql c #\-)
(setf lowercase (not lowercase)))
((position c "!?#@%+*/=:<>^")
(write-sequence (aref #("bang" "what" "hash" "at" "percent"
"plus" "star" "slash" "equals" "colon"
"lessthan" "greaterthan" "caret")
it)
acc))
(t (write-char (cond ((and lowercase (not all-uppercase)) (char-downcase c))
(t (char-upcase c)))
acc)
(setf lowercase t)))))))
((every #'upper-case-p (remove-if-not #'alpha-char-p identifier)) (string-downcase identifier))
((every #'lower-case-p (remove-if-not #'alpha-char-p identifier)) (string-upcase identifier))
(t identifier))))))
(when (and (not (string= identifier "[]"))
(find #\[ identifier))
(warn "Parenscript symbol ~A contains a literal array accessor.
This compound naming convention is deprecated and will be removed!
Use AREF, ELT, GETPROP, @, or CHAIN instead."
identifier))
(when (find #\. identifier)
(warn "Parenscript symbol ~A contains one or more dot operators.
This compound naming convention is deprecated and will be removed!
Use GETPROP, @, or CHAIN instead."
identifier))
(or
(gethash identifier cache)
(setf
(gethash identifier cache)
(cond
((some (lambda (c) (find c "-*+!?#@%/=:<>^")) identifier)
(let ((lowercase t)
(all-uppercase nil))
(acond
((nth-value 1
(cl-ppcre:scan-to-strings
"[\\*|\\+](.+)[\\*|\\+](.*)"
identifier :sharedp t))
(setf all-uppercase t
identifier (concatenate
'string (aref it 0) (aref it 1))))
((and (> (length identifier) 1)
(or (eql (char identifier 0) #\+)
(eql (char identifier 0) #\*)))
(setf lowercase nil
identifier (subseq identifier 1))))
(with-output-to-string (acc)
(loop
for c across identifier
do (acond
((eql c #\-)
(setf lowercase (not lowercase)))
((position c "!?#@%+*/=:<>^")
(write-sequence
(aref #("bang" "what" "hash" "at" "percent"
"plus" "star" "slash" "equals" "colon"
"lessthan" "greaterthan" "caret")
it)
acc))
(t
(write-char
(if (and lowercase (not all-uppercase))
(char-downcase c)
(char-upcase c))
acc)
(setf lowercase t)))))))
((every #'upper-case-p
(remove-if-not #'alpha-char-p identifier))
(string-downcase identifier))
((every #'lower-case-p
(remove-if-not #'alpha-char-p identifier))
(string-upcase identifier))
(t identifier))))))
(defun ordered-set-difference (list1 list2 &key (test #'eql))
"CL set-difference may not preserve order."
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment