make browser editing optional
parent
ac0e0432a0
commit
be47ff8672
|
@ -44,12 +44,13 @@ USE: html
|
||||||
USE: parser
|
USE: parser
|
||||||
USE: errors
|
USE: errors
|
||||||
|
|
||||||
: <browser> ( vocab word -- )
|
: <browser> ( allow-edit? vocab word -- )
|
||||||
#! An object for storing the current browser
|
#! An object for storing the current browser
|
||||||
#! user interface state.
|
#! user interface state.
|
||||||
<namespace> [
|
<namespace> [
|
||||||
"current-word" set
|
"current-word" set
|
||||||
"current-vocab" set
|
"current-vocab" set
|
||||||
|
"allow-edit?" set
|
||||||
] extend ;
|
] extend ;
|
||||||
|
|
||||||
: write-vocab-list ( -- )
|
: write-vocab-list ( -- )
|
||||||
|
@ -93,7 +94,7 @@ USE: errors
|
||||||
#! Write the source for the given word from the vocab as HTML.
|
#! Write the source for the given word from the vocab as HTML.
|
||||||
<namespace> [
|
<namespace> [
|
||||||
"responder" "inspect" put
|
"responder" "inspect" put
|
||||||
"Edit" [ "edit-state" t put ] quot-href <br/>
|
"allow-edit?" get [ "Edit" [ "edit-state" t put ] quot-href <br/> ] when
|
||||||
"edit-state" get [
|
"edit-state" get [
|
||||||
write-editable-word-source
|
write-editable-word-source
|
||||||
] [
|
] [
|
||||||
|
@ -189,16 +190,25 @@ USE: errors
|
||||||
] </form>
|
] </form>
|
||||||
] </body>
|
] </body>
|
||||||
] </html>
|
] </html>
|
||||||
] show
|
] show [
|
||||||
|
"allow-edit?" get [
|
||||||
|
"eval" get [
|
||||||
|
"eval" f put
|
||||||
|
"Editing has been disabled." show-message-page
|
||||||
|
] when
|
||||||
|
] unless
|
||||||
|
"allow-edit?" get "allow-edit?" set
|
||||||
|
] extend
|
||||||
] bind [
|
] bind [
|
||||||
|
"allow-edit?" get
|
||||||
"vocabs" get
|
"vocabs" get
|
||||||
"words" get
|
"words" get
|
||||||
"eval" get dup [ "vocabs" get swap eval-string ] [ drop ] ifte
|
"eval" get dup [ "vocabs" get swap eval-string ] [ drop ] ifte
|
||||||
] bind <browser>
|
] bind <browser>
|
||||||
] forever ;
|
] forever ;
|
||||||
|
|
||||||
: browser-responder ( -- )
|
: browser-responder ( allow-edit? -- )
|
||||||
#! Start the Smalltalk-like browser.
|
#! Start the Smalltalk-like browser.
|
||||||
"browser" "" <browser> browse ;
|
"browser" "" <browser> browse ;
|
||||||
|
|
||||||
"browser" [ browser-responder ] install-cont-responder
|
"browser" [ f browser-responder ] install-cont-responder
|
||||||
|
|
Loading…
Reference in New Issue