-
Notifications
You must be signed in to change notification settings - Fork 0
/
editor-page.ss
133 lines (99 loc) · 4.06 KB
/
editor-page.ss
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
#lang scheme/base
(require "base.ss")
(require (unlib-in symbol)
"attribute-editor.ss"
"editor-controller.ss"
"editor-internal.ss"
"entity-editor.ss"
"page-internal.ss"
"util.ss")
; Mixins -----------------------------------------
(define editor-page-mixin
(compose
(mixin/cells (html-element<%> html-page<%> editor-controller<%>) ()
(inherit get-id
get-editor
on-update)
; Fields ----------------------------
; editor%
(init [editor (error "editor-page constructor: insufficient arguments")])
(super-new [editor editor])
(send editor set-id! (symbol-append (get-id) '-editor))
; submit-button%
(field submit-button
(new submit-button%
[id (symbol-append (get-id) '-submit)]
[action (callback on-update)])
#:child #:accessor)
; Methods ---------------------------
; -> (listof html-component<%>)
(define/override (get-child-components)
(cons (get-editor)
(super get-child-components)))
; -> (listof (U xml (seed -> xml)))
(define/augment (get-html-requirements)
(list* snooze-styles
(inner null get-html-requirements)))
; -> (U snooze-struct #f)
(define/public (get-value)
(send (get-editor) get-value))
; snooze-struct -> void
(define/public (set-value! struct)
(send (get-editor) set-value! struct))
; seed -> xml
(define/augment (render seed)
(xml ,(send (get-editor) render seed)
,(send submit-button render seed))))
editor-controller-mixin))
(define entity-editor-page-mixin
(compose
(mixin/cells (html-element<%> html-page<%> editor-controller<%>) ()
(inherit get-id
get-editor
on-update)
; Fields ----------------------------
; entity
(init [entity #f])
; (listof attribute)
(init [attributes (and entity (entity-data-attributes entity))])
; (listof attribute-editor<%>)
(init [editors (and attributes (map default-attribute-editor attributes))])
; entity-editor%
(init [editor (or (and entity
editors
(new entity-editor%
[entity entity]
[editors editors]))
(error "entity-editor-page constructor: insufficient arguments"))])
(super-new [editor editor])
; Methods ---------------------------
; -> entity
(define/public (get-entity)
(send (get-editor) get-entity))
; -> (U snooze-struct #f)
(define/public (get-initial-value)
(send (get-editor) get-initial-value))
; -> string
(define/override (get-title)
(let* ([title (super get-title)]
[entity (get-entity)]
[struct (get-initial-value)])
(cond [title title]
[(and struct (snooze-struct-saved? struct))
(format "Edit ~a: ~a" (entity-pretty-name entity) (format-snooze-struct struct))]
[struct (format "New ~a" (entity-pretty-name entity))]
[else (format "Editing ~a" (entity-pretty-name entity))]))))
editor-page-mixin))
; Procedures -------------------------------------
; entity [(subclassof html-page%)] -> html-page%
(define (scaffold-create-page entity [page% (default-scaffolded-page-superclass)])
(new (entity-editor-page-mixin page%) [entity entity]))
; entity [(subclassof html-page%)] -> html-page%
(define (scaffold-update-page entity [page% (default-scaffolded-page-superclass)])
(new (entity-editor-page-mixin page%) [entity entity]))
; Provide statements -----------------------------
(provide entity-editor-page-mixin
editor-page-mixin)
(provide/contract
[scaffold-create-page (->* (entity?) ((subclass?/c html-page%)) (is-a?/c html-page%))]
[scaffold-update-page (->* (entity?) ((subclass?/c html-page%)) (is-a?/c html-page%))])