]> gitweb.factorcode.org Git - factor.git/commitdiff
ui listener shows the stack now, fixed gadget display command
authorSlava Pestov <slava@factorcode.org>
Thu, 14 Jul 2005 04:32:52 +0000 (04:32 +0000)
committerSlava Pestov <slava@factorcode.org>
Thu, 14 Jul 2005 04:32:52 +0000 (04:32 +0000)
library/collections/namespaces.factor
library/compiler/compiler.factor
library/syntax/see.factor
library/tools/jedit-wire.factor
library/tools/listener.factor
library/ui/hierarchy.factor
library/ui/incremental.factor
library/ui/init-world.factor
library/ui/panes.factor
library/ui/presentations.factor

index e359c7246f0edd0c411eb6ce964148fe0ff9771e..8ed2389e68706283174e1014f74d00362558532f 100644 (file)
@@ -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 <vector> make-seq ; inline
 
index 9aac8d5edcd15c011cfb16c2d39a0bc0c12182c6..70c6a8ddd42693a5976961f9a007ce13324d1ce4 100644 (file)
@@ -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
index 63b18999bf6fddd6c6b103562ce57da788152a53..59622720ca5c5e9e1ad6a9a01ac727d107b98762 100644 (file)
@@ -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> "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 [
index 3ca441483db96c168b10faae2b49cc831cc1f777..a0c7c39a20b4efdf778f585266b0180a1d6b8552 100644 (file)
@@ -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 ;
index ad3b27eefce932d71b5376f26884021c2d0e81f1..57066e8e1f986ef8701c1a3c414793818ef046ed 100644 (file)
@@ -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.
index df8645c4f9291901bff593f9302157e75eac37a0..047befa672eebc6af9fb7b305395898db4f29b29 100644 (file)
@@ -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
index edf541ffc2ba868de76d2e0da92a28860a5acc55..330c9f1c9680bc6b0ce6917c0555ec1a103e7757 100644 (file)
@@ -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 ;
index cca0fadff7af58bcee06cb8c49f07a94082421e4..109b92ec4d0135809a1bfdcbe023311580b44550 100644 (file)
@@ -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> world set
@@ -27,7 +33,12 @@ SYMBOL: stack-display
         <pane> dup stack-display set <scroller>
         3/4 <y-splitter> 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 ;
index 587b07a355bfb4581a2afcaae68a52dfd9ca6ee6..3f21add508278aa351615ace46b36eccee9c24b7 100644 (file)
@@ -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 <presentation> r> pane-current add-gadget ;
 
index 364538ac19cb270dccfdee4cf31093759c34aee6..5dc9e3e2bd17d7058a40d9c16b89f0a89d801b96 100644 (file)
@@ -43,7 +43,7 @@ global [ 100 <vector> commands set ] bind
     [ 2nip ] [ drop <styled-label> 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 <vector> commands set ] bind
 [ word? ] "Usage" [ usage . ] define-command
 [ word? ] "jEdit" [ jedit ] define-command
 
-[ [ gadget? ] is? ] "Display" [ ] define-command
+[ [ gadget? ] is? ] "Display" [ gadget. ] define-command