Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
What's new
10
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Open sidebar
Hayley Patton
netfarm
Commits
764f45ea
Commit
764f45ea
authored
Mar 18, 2020
by
Hayley Patton
🐢
Browse files
Options
Browse Files
Download
Plain Diff
I forgot to git pull again
parents
f95dc740
63c83f34
Changes
3
Hide whitespace changes
Inline
Side-by-side
Showing
3 changed files
with
25 additions
and
25 deletions
+25
-25
Code/Codecs/codecs.lisp
Code/Codecs/codecs.lisp
+7
-19
Code/Objects/MOP/netfarm-class.lisp
Code/Objects/MOP/netfarm-class.lisp
+18
-5
Code/Text-format/new-renderer.lisp
Code/Text-format/new-renderer.lisp
+0
-1
No files found.
Code/Codecs/codecs.lisp
View file @
764f45ea
...
...
@@ -16,11 +16,7 @@
(
define-codec
integer
(
lambda
(
number
)
(
format
nil
"~d"
number
))
(
lambda
(
string
)
(
handler-case
(
parse-integer
string
)
(
condition
()
(
error
"not parseable"
)))))
#'
parse-integer
)
(
define-codec
boolean
(
lambda
(
boolean
)
...
...
@@ -38,28 +34,20 @@
(
define-codec
base64
(
lambda
(
string
)
(
with-output-to-string
(
output
)
(
encode-base64-bytes
(
string-to-octets
string
:external-format
*encoding*
)
output
)))
(
bytes->base64
(
string-to-octets
string
:external-format
*encoding*
)))
(
lambda
(
base64
)
(
with-input-from-string
(
input
base64
)
(
octets-to-string
(
decode-base64-bytes
input
)
:external-format
*encoding*
))))
(
octets-to-string
(
base64->bytes
base64
)
:external-format
*encoding*
)))
(
define-codec
base64-data
(
lambda
(
vector
)
(
with-output-to-string
(
output
)
(
encode-base64-bytes
vector
output
)))
(
lambda
(
base64
)
(
with-input-from-string
(
input
base64
)
(
decode-base64-bytes
input
))))
#'
bytes->base64
#'
base64->bytes
)
(
define-codec
ref
(
lambda
(
reference
)
(
check-type
reference
reference
)
(
format
nil
(
reference-hash
reference
)))
(
bytes->base64
(
reference-hash
reference
)))
(
lambda
(
string
)
(
make-instance
'reference
:hash
string
)))
(
make-instance
'reference
:hash
(
base64->bytes
string
)))
)
(
defun
find-codec
(
name
type
)
(
let
((
codec-definition
(
gethash
name
*codecs*
)))
...
...
Code/Objects/MOP/netfarm-class.lisp
View file @
764f45ea
...
...
@@ -47,12 +47,13 @@ Providing the class option (:scripts script ...) will attach the initialisation
(
netfarm-class-message-script
class
)
(
eval
script
)))
;; The initialisation scripts of a class are the direct scripts of itself
;; and the scripts of its superscripts
. This isn't very different to how
;;
slots are inherited in CLOS.
;; and the scripts of its superscripts
, with duplicates removed. This isn't
;; very different to how
slots are inherited in CLOS.
(
slot-value
class
'scripts
)
(
append
(
netfarm-class-direct-scripts
class
)
(
loop
for
class
in
(
closer-mop:class-direct-superclasses
class
)
appending
(
netfarm-class-scripts
class
)))))
(
remove-duplicates
(
append
(
netfarm-class-direct-scripts
class
)
(
loop
for
class
in
(
closer-mop:class-direct-superclasses
class
)
appending
(
netfarm-class-scripts
class
))))))
(
defmethod
initialize-instance
:after
((
class
netfarm-class
)
&key
)
(
force-script-data-evaluation
class
)
...
...
@@ -73,6 +74,18 @@ Providing the class option (:scripts script ...) will attach the initialisation
(
:method
((
class
netfarm-class
))
(
hash-object*
(
class->schema
class
))))
(
defclass
netfarm-slot
(
closer-mop:standard-direct-slot-definition
)
((
computed
:initarg
:computed
:initform
nil
)
(
documentation
:initarg
:documentation
:reader
slot-documentation
)
(
netfarm-name
:initarg
:netfarm-name
:reader
slot-netfarm-name
)))
(
defmethod
print-object
((
slot
netfarm-slot
)
stream
)
(
print-unreadable-object
(
slot
stream
:type
t
)
(
format
stream
"~s"
(
slot-netfarm-name
slot
))))
(
defclass
netfarm-computed-slot
(
netfarm-slot
)
())
(
defclass
object
()
((
metadata
:initarg
:metadata
:initform
(
make-hash-table
:test
'equal
)
:reader
object-metadata
)
...
...
Code/Text-format/new-renderer.lisp
View file @
764f45ea
...
...
@@ -151,4 +151,3 @@ string; but RENDER-OBJECT will emit Netfarm standard format text."))
(
:method
((
vector
vector
)
stream
)
(
write-string
"base64-data:"
stream
)
(
s-base64:encode-base64-bytes
vector
stream
nil
)))
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment