diff --git a/library/collections/namespaces.factor b/library/collections/namespaces.factor index e359c7246f..8ed2389e68 100644 --- a/library/collections/namespaces.factor +++ b/library/collections/namespaces.factor @@ -1,5 +1,8 @@ ! Copyright (C) 2003, 2005 Slava Pestov. ! See http://factor.sf.net/license.txt for BSD license. +IN: words +DEFER: literalize + IN: namespaces USING: hashtables kernel kernel-internals lists math sequences strings vectors words ; @@ -114,11 +117,6 @@ SYMBOL: building push ] ifte ; -: literal, ( word -- ) - #! Append some code that pushes the word on the stack. Used - #! when building quotations. - literalize % ; - : unique, ( obj -- ) #! Add the object to the sequence being built with make-seq #! unless an equal object has already been added. @@ -128,6 +126,11 @@ SYMBOL: building #! Append to the sequence being built with make-seq. building get swap nappend ; +: literal, ( word -- ) + #! Append some code that pushes the word on the stack. Used + #! when building quotations. + literalize % ; + : make-vector ( quot -- vector ) 100 make-seq ; inline diff --git a/library/compiler/compiler.factor b/library/compiler/compiler.factor index 9aac8d5edc..70c6a8ddd4 100644 --- a/library/compiler/compiler.factor +++ b/library/compiler/compiler.factor @@ -13,7 +13,7 @@ kernel lists math namespaces prettyprint io words ; : compiling ( word -- word parameter ) check-architecture - "Compiling " write dup word. terpri flush + "Compiling " write dup unparse. terpri flush dup word-def ; GENERIC: (compile) ( word -- ) @@ -43,7 +43,7 @@ M: compound (compile) ( word -- ) "compile" get [ word compile ] when ; parsing : cannot-compile ( word error -- ) - "Cannot compile " write swap word. terpri print-error ; + "Cannot compile " write swap unparse. terpri print-error ; : try-compile ( word -- ) [ compile ] [ [ cannot-compile ] when* ] catch ; @@ -52,7 +52,7 @@ M: compound (compile) ( word -- ) : decompile ( word -- ) dup compiled? [ - "Decompiling " write dup word. terpri flush + "Decompiling " write dup unparse. terpri flush [ word-primitive ] keep set-word-primitive ] [ drop diff --git a/library/syntax/see.factor b/library/syntax/see.factor index 63b18999bf..59622720ca 100644 --- a/library/syntax/see.factor +++ b/library/syntax/see.factor @@ -4,23 +4,8 @@ IN: prettyprint USING: generic hashtables io kernel lists namespaces sequences streams strings styles unparser words ; -! Prettyprinting words -: vocab-actions ( search -- list ) - [ - [[ "Words" "words ." ]] - [[ "Use" "use+" ]] - [[ "In" "\"in\" set" ]] - ] ; - -: vocab-attrs ( vocab -- attrs ) - #! Words without a vocabulary do not get a link or an action - #! popup. - unparse vocab-actions "actions" swons unit ; - -: vocab. ( vocab -- ) dup vocab-attrs write-attr ; - : prettyprint-IN: ( word -- ) - \ IN: unparse. bl word-vocabulary vocab. terpri ; + \ IN: unparse. bl word-vocabulary write terpri ; : prettyprint-prop ( word prop -- ) tuck word-name word-prop [ diff --git a/library/tools/jedit-wire.factor b/library/tools/jedit-wire.factor index 3ca441483d..a0c7c39a20 100644 --- a/library/tools/jedit-wire.factor +++ b/library/tools/jedit-wire.factor @@ -39,7 +39,7 @@ prettyprint sequences io strings words styles ; ! remaining -- input : jedit-write-attr ( str style -- ) CHAR: w write - [ swap . "USE: styles" print [ car presented = not ] subset . ] string-out + [ drop . f . ] string-out dup write-len write ; TUPLE: jedit-stream ; diff --git a/library/tools/listener.factor b/library/tools/listener.factor index ad3b27eefc..57066e8e1f 100644 --- a/library/tools/listener.factor +++ b/library/tools/listener.factor @@ -6,6 +6,7 @@ presentation sequences strings styles unparser vectors words ; SYMBOL: listener-prompt SYMBOL: quit-flag +SYMBOL: listener-hook global [ " " listener-prompt set ] bind @@ -32,8 +33,10 @@ global [ " " listener-prompt set ] bind : listen ( -- ) #! Wait for user input, and execute. - listener-prompt get write flush - [ read-multiline [ call ] [ bye ] ifte ] try ; + listener-prompt get write flush [ + read-multiline + [ call listener-hook get call ] [ bye ] ifte + ] try ; : listener ( -- ) #! Run a listener loop that executes user input. diff --git a/library/ui/hierarchy.factor b/library/ui/hierarchy.factor index df8645c4f9..047befa672 100644 --- a/library/ui/hierarchy.factor +++ b/library/ui/hierarchy.factor @@ -15,6 +15,10 @@ sequences ; [ remove-gadget ] [ 2drop ] ifte ] when* ; +: clear-gadget ( gadget -- ) + dup gadget-children [ f swap set-gadget-parent ] each + f over set-gadget-children relayout ; + : (add-gadget) ( gadget box -- ) #! This is inefficient. over unparent diff --git a/library/ui/incremental.factor b/library/ui/incremental.factor index edf541ffc2..330c9f1c96 100644 --- a/library/ui/incremental.factor +++ b/library/ui/incremental.factor @@ -44,3 +44,6 @@ M: incremental layout* drop ; 2dup incremental-loc tuck update-cursor prefer-incremental ; + +: clear-incremental ( incremental -- ) + dup clear-gadget { 0 0 0 } swap set-incremental-cursor ; diff --git a/library/ui/init-world.factor b/library/ui/init-world.factor index cca0fadff7..109b92ec4d 100644 --- a/library/ui/init-world.factor +++ b/library/ui/init-world.factor @@ -1,10 +1,16 @@ ! Copyright (C) 2005 Slava Pestov. ! See http://factor.sf.net/license.txt for BSD license. IN: gadgets -USING: generic io kernel listener math namespaces styles threads ; +USING: generic io kernel listener math namespaces prettyprint +sequences styles threads ; SYMBOL: stack-display +: ui.s ( -- ) + stack-display get dup pane-clear [ + datastack reverse [ unparse. terpri ] each + ] with-stream* ; + : init-world global [ world set @@ -27,7 +33,12 @@ SYMBOL: stack-display dup stack-display set 3/4 add-layer - [ pane get [ clear print-banner listener ] with-stream ] in-thread + [ + pane get [ + [ ui.s ] listener-hook set + clear print-banner listener + ] with-stream + ] in-thread pane get request-focus ] bind ; diff --git a/library/ui/panes.factor b/library/ui/panes.factor index 587b07a355..3f21add508 100644 --- a/library/ui/panes.factor +++ b/library/ui/panes.factor @@ -63,6 +63,9 @@ C: pane ( -- pane ) M: pane focusable-child* ( pane -- editor ) pane-input ; +: pane-clear ( pane -- ) + dup pane-output clear-incremental pane-current clear-gadget ; + : pane-write-1 ( style text pane -- ) >r r> pane-current add-gadget ; diff --git a/library/ui/presentations.factor b/library/ui/presentations.factor index 364538ac19..5dc9e3e2bd 100644 --- a/library/ui/presentations.factor +++ b/library/ui/presentations.factor @@ -43,7 +43,7 @@ global [ 100 commands set ] bind [ 2nip ] [ drop dup init-commands ] ifte ; : gadget. ( gadget -- ) - gadget swons unit "" swap write-attr ; + gadget swons unit "" swap write-attr terpri ; [ drop t ] "Prettyprint" [ prettyprint ] define-command [ drop t ] "Inspect" [ inspect ] define-command @@ -54,4 +54,4 @@ global [ 100 commands set ] bind [ word? ] "Usage" [ usage . ] define-command [ word? ] "jEdit" [ jedit ] define-command -[ [ gadget? ] is? ] "Display" [ ] define-command +[ [ gadget? ] is? ] "Display" [ gadget. ] define-command