make browser editing optional

cvs
Chris Double 2004-08-01 22:29:32 +00:00
parent ac0e0432a0
commit be47ff8672
1 changed files with 15 additions and 5 deletions

View File

@ -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