1 | (in-package :jss) |
---|
2 | |
---|
3 | ;; JSS syntax for fields |
---|
4 | ;; #"<thing>.<field>" |
---|
5 | ;; |
---|
6 | ;; <thing> is either {<lisp expression>} or a class name or abbreviation that find-java-class can use |
---|
7 | ;; If <thing> is a lisp expression, then it is evaluated (in the lexical environment) and used as an instance |
---|
8 | ;; If <thing> is a class name the result of find-java-class is used and a static field access is done. |
---|
9 | ;; |
---|
10 | ;; <field> is either {<lisp expression} or string |
---|
11 | ;; If <field> is a lisp expression it should evaluate to a string that names a field |
---|
12 | ;; If <field> is a string (no quotes) it is used as the field name |
---|
13 | ;; |
---|
14 | ;; eg. #"foo.bar.baz" -> (get-java-field (find-java-class 'foo.bar) "baz" t) |
---|
15 | ;; #"{foo}.baz" -> (get-java-field (find-java-class foo) "baz" t) |
---|
16 | |
---|
17 | |
---|
18 | (defun jss-transform-to-field (string) |
---|
19 | (let* ((pattern (#"compile" 'java.util.regex.Pattern "(.*)\\.([^.]+)$")) |
---|
20 | (matcher (#"matcher" pattern string))) |
---|
21 | (#"find" matcher) |
---|
22 | (let ((parts (list (#"group" matcher 1) (#"group" matcher 2)))) |
---|
23 | (check-class-or-eval (first parts)) |
---|
24 | (check-field-or-eval (second parts)) |
---|
25 | (apply 'field-access-expression parts)))) |
---|
26 | |
---|
27 | ;; http://stackoverflow.com/questions/5205339/regular-expression-matching-fully-qualified-class-names |
---|
28 | (defun check-class-or-eval (string) |
---|
29 | (assert |
---|
30 | (or (#"matches" string "^((\\p{javaJavaIdentifierStart}(\\p{javaJavaIdentifierPart})*)+)(\\.\\p{javaJavaIdentifierStart}(\\p{javaJavaIdentifierPart})*)*$") |
---|
31 | (#"matches" string "^\\{.+}$")) (string) |
---|
32 | "inside #\"..\" expected either an abbreviated class name or an expression surrounded by {}. Found: #~s" string)) |
---|
33 | |
---|
34 | (defun check-field-or-eval (string) |
---|
35 | (assert (or (#"matches" string "^(\\p{javaJavaIdentifierStart}(\\p{javaJavaIdentifierPart})*)+$") |
---|
36 | (#"matches" string "^\\{.+\\}$")) |
---|
37 | (string) |
---|
38 | "inside #\"..\" expected either a field name or an expression surrounded by {}. Found: #~s" string)) |
---|
39 | |
---|
40 | (defun field-access-expression (thing field) |
---|
41 | `(get-java-field ,(if (char= (char thing 0) #\{) |
---|
42 | (intern (string-upcase (subseq thing 1 (- (length thing) 1)))) |
---|
43 | `(load-time-value (find-java-class ,thing))) |
---|
44 | ,(if (char= (char field 0) #\{) |
---|
45 | (intern (string-upcase (subseq field 1 (- (length field) 1)))) |
---|
46 | field) |
---|
47 | t)) |
---|