157 lines
4.9 KiB
Factor
157 lines
4.9 KiB
Factor
! :folding=indent:collapseFolds=1:
|
|
|
|
! $Id$
|
|
!
|
|
! Copyright (C) 2003, 2004 Slava Pestov.
|
|
!
|
|
! Redistribution and use in source and binary forms, with or without
|
|
! modification, are permitted provided that the following conditions are met:
|
|
!
|
|
! 1. Redistributions of source code must retain the above copyright notice,
|
|
! this list of conditions and the following disclaimer.
|
|
!
|
|
! 2. Redistributions in binary form must reproduce the above copyright notice,
|
|
! this list of conditions and the following disclaimer in the documentation
|
|
! and/or other materials provided with the distribution.
|
|
!
|
|
! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
|
|
! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
|
|
! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
|
|
! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
|
|
! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
|
|
! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
|
|
! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
|
|
! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
|
|
! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
|
|
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
|
|
|
IN: console
|
|
USE: combinators
|
|
USE: continuations
|
|
USE: init
|
|
USE: listener
|
|
USE: kernel
|
|
USE: lists
|
|
USE: namespaces
|
|
USE: stack
|
|
USE: stdio
|
|
USE: presentation
|
|
USE: streams
|
|
USE: strings
|
|
USE: unparser
|
|
|
|
: <attribute-set> ( -- attribute-set )
|
|
[ ] "javax.swing.text.SimpleAttributeSet" jnew ;
|
|
|
|
: attribute+ ( attribute-set value key -- )
|
|
transp
|
|
[ "java.lang.Object" "java.lang.Object" ]
|
|
"javax.swing.text.SimpleAttributeSet"
|
|
"addAttribute" jinvoke ;
|
|
|
|
: style-constant ( name -- key )
|
|
#! javax.swing.text.StyleConstants contains static variables
|
|
#! which key in an AttributeSet.
|
|
"javax.swing.text.StyleConstants" swap jvar-static-get
|
|
; inline
|
|
|
|
: set-icon-style ( attribute-set icon -- )
|
|
[
|
|
"javax.swing.text.MutableAttributeSet"
|
|
"javax.swing.Icon"
|
|
] "javax.swing.text.StyleConstants"
|
|
"setIcon" jinvoke-static ;
|
|
|
|
: <icon> ( resource -- icon )
|
|
resource
|
|
[ "java.net.URL" ]
|
|
"javax.swing.ImageIcon" jnew ;
|
|
|
|
: swing-attribute+ ( attribute-set value key -- )
|
|
style-constant attribute+ ;
|
|
|
|
: >color ( triplet -- hex )
|
|
uncons uncons uncons drop
|
|
[ "int" "int" "int" ]
|
|
"java.awt.Color"
|
|
jnew ;
|
|
|
|
: actions-key ( -- attr )
|
|
"console.ConsolePane" "Actions" jvar-static-get ; inline
|
|
|
|
: <eval-action> ( label cmd -- action )
|
|
"console" get [
|
|
"java.lang.String"
|
|
"java.lang.String"
|
|
"console.Console"
|
|
] "console.Console$EvalAction" jnew ;
|
|
|
|
: >action-array ( list -- array )
|
|
[ "javax.swing.Action" ] coerce ;
|
|
|
|
: <actions-menu> ( actions -- array )
|
|
[ uncons <eval-action> ] map >action-array ;
|
|
|
|
: underline-attribute ( attribute-set -- )
|
|
t "Underline" swing-attribute+ ;
|
|
|
|
: actions-attribute ( attribute-set actions -- )
|
|
<actions-menu> actions-key attribute+ ;
|
|
|
|
: icon-attribute ( string style value -- )
|
|
dupd <icon> set-icon-style
|
|
>r drop " " r> ;
|
|
|
|
: style>attribute-set ( string style -- string attribute-set )
|
|
#! We need the string, since outputting an icon changes the
|
|
#! string to " ".
|
|
<attribute-set> swap [
|
|
[ "actions" dupd actions-attribute ]
|
|
[ "bold" drop dup t "Bold" swing-attribute+ ]
|
|
[ "italics" drop dup t "Italic" swing-attribute+ ]
|
|
[ "underline" drop dup t "Underline" swing-attribute+ ]
|
|
[ "fg" dupd >color "Foreground" swing-attribute+ ]
|
|
[ "bg" dupd >color "Background" swing-attribute+ ]
|
|
[ "font" dupd "FontFamily" swing-attribute+ ]
|
|
[ "size" dupd "FontSize" swing-attribute+ ]
|
|
[ "icon" icon-attribute ]
|
|
] assoc-apply ;
|
|
|
|
: console-readln* ( continuation -- )
|
|
"console" get [ "factor.Cons" "console.Console" ]
|
|
"factor.jedit.FactorShell" "readLine" jinvoke-static ;
|
|
|
|
: console-readln ( -- line )
|
|
[ console-readln* toplevel ] callcc1 ;
|
|
|
|
: console-write-attr ( string style -- )
|
|
style>attribute-set swap "console" get
|
|
[ "javax.swing.text.AttributeSet" "java.lang.String" ]
|
|
"console.Output" "writeAttrs" jinvoke ;
|
|
|
|
: <console-stream> ( console -- stream )
|
|
#! Creates a stream for reading/writing to the given
|
|
#! console instance.
|
|
<stream> [
|
|
"console" set
|
|
( -- string )
|
|
[ console-readln ] "freadln" set
|
|
( string -- )
|
|
[ default-style console-write-attr ] "fwrite" set
|
|
( string style -- )
|
|
[ console-write-attr ] "fwrite-attr" set
|
|
( -- )
|
|
[ ] "fflush" set
|
|
( -- )
|
|
[ ] "fclose" set
|
|
( string -- )
|
|
[ this fwrite "\n" this fwrite ] "fprint" set
|
|
] extend ;
|
|
|
|
: console-hook ( console -- )
|
|
[
|
|
dup "console" set
|
|
<console-stream> "stdio" set
|
|
init-listener
|
|
] with-scope ;
|