Remove more Java Factor-only code
Slava Pestov
parent
a61108625a
commit
b81477008f
|
|
@ -1,156 +0,0 @@
|
||||||
! :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 ;
|
|
||||||
|
|
@ -1,98 +0,0 @@
|
||||||
! :folding=indent:collapseFolds=1:
|
|
||||||
|
|
||||||
! $Id$
|
|
||||||
!
|
|
||||||
! Copyright (C) 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: jedit
|
|
||||||
USE: combinators
|
|
||||||
USE: math
|
|
||||||
USE: namespaces
|
|
||||||
USE: stack
|
|
||||||
USE: strings
|
|
||||||
USE: words
|
|
||||||
|
|
||||||
: view ( -- view )
|
|
||||||
[ ] "org.gjt.sp.jedit.jEdit"
|
|
||||||
"getActiveView" jinvoke-static ;
|
|
||||||
|
|
||||||
: edit-pane ( -- editPane )
|
|
||||||
view
|
|
||||||
[ ] "org.gjt.sp.jedit.View" "getEditPane" jinvoke ;
|
|
||||||
|
|
||||||
: text-area ( -- textArea )
|
|
||||||
edit-pane
|
|
||||||
[ ] "org.gjt.sp.jedit.EditPane" "getTextArea" jinvoke ;
|
|
||||||
|
|
||||||
: text-area-buffer ( textArea -- buffer )
|
|
||||||
[ ] "org.gjt.sp.jedit.textarea.JEditTextArea"
|
|
||||||
"getBuffer" jinvoke ;
|
|
||||||
|
|
||||||
: buffer ( -- buffer )
|
|
||||||
edit-pane
|
|
||||||
[ ] "org.gjt.sp.jedit.EditPane" "getBuffer" jinvoke ;
|
|
||||||
|
|
||||||
: open-file* ( view parent path newFile props -- buffer )
|
|
||||||
[
|
|
||||||
"org.gjt.sp.jedit.View"
|
|
||||||
"java.lang.String"
|
|
||||||
"java.lang.String"
|
|
||||||
"boolean"
|
|
||||||
"java.util.Hashtable"
|
|
||||||
] "org.gjt.sp.jedit.jEdit" "openFile" jinvoke-static ;
|
|
||||||
|
|
||||||
: open-file ( parent path -- buffer )
|
|
||||||
view -rot f f open-file* ;
|
|
||||||
|
|
||||||
: wait-for-requests ( -- )
|
|
||||||
[ ]
|
|
||||||
"org.gjt.sp.jedit.io.VFSManager" "waitForRequests"
|
|
||||||
jinvoke-static ;
|
|
||||||
|
|
||||||
: line-count ( textarea -- lines )
|
|
||||||
[ ] "org.gjt.sp.jedit.textarea.JEditTextArea" "getLineCount"
|
|
||||||
jinvoke ;
|
|
||||||
|
|
||||||
: line>start-offset ( line textarea -- )
|
|
||||||
[ "int" ]
|
|
||||||
"org.gjt.sp.jedit.textarea.JEditTextArea"
|
|
||||||
"getLineStartOffset" jinvoke ;
|
|
||||||
|
|
||||||
: set-caret ( caret textarea -- )
|
|
||||||
[ "int" ]
|
|
||||||
"org.gjt.sp.jedit.textarea.JEditTextArea"
|
|
||||||
"setCaretPosition" jinvoke ;
|
|
||||||
|
|
||||||
: goto-line* ( line textarea -- )
|
|
||||||
tuck line>start-offset swap set-caret ;
|
|
||||||
|
|
||||||
: goto-line ( line textarea -- )
|
|
||||||
tuck line-count min swap goto-line* ;
|
|
||||||
|
|
||||||
: local-jedit-line/file ( line dir file -- )
|
|
||||||
open-file [
|
|
||||||
wait-for-requests pred text-area goto-line
|
|
||||||
] [
|
|
||||||
drop
|
|
||||||
] ifte ;
|
|
||||||
|
|
@ -1,5 +0,0 @@
|
||||||
IN: jedit
|
|
||||||
USE: errors
|
|
||||||
|
|
||||||
! Doesn't exist in native Factor.
|
|
||||||
: local-jedit-line/file "Not supported" throw ;
|
|
||||||
|
|
@ -37,16 +37,6 @@ USE: stdio
|
||||||
USE: strings
|
USE: strings
|
||||||
USE: words
|
USE: words
|
||||||
|
|
||||||
: jedit-local? ( -- ? )
|
|
||||||
java? [ global [ "jedit" get ] bind ] [ f ] ifte ;
|
|
||||||
|
|
||||||
: jedit-line/file ( line dir file -- )
|
|
||||||
jedit-local? [
|
|
||||||
local-jedit-line/file
|
|
||||||
] [
|
|
||||||
remote-jedit-line/file
|
|
||||||
] ifte ;
|
|
||||||
|
|
||||||
: resource-path ( -- path )
|
: resource-path ( -- path )
|
||||||
global [ "resource-path" get ] bind [ "." ] unless* ;
|
global [ "resource-path" get ] bind [ "." ] unless* ;
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -133,9 +133,7 @@ USE: stdio
|
||||||
"/library/httpd/resource-responder.factor"
|
"/library/httpd/resource-responder.factor"
|
||||||
"/library/httpd/default-responders.factor"
|
"/library/httpd/default-responders.factor"
|
||||||
|
|
||||||
"/library/jedit/jedit-no-local.factor"
|
"/library/tools/jedit.factor"
|
||||||
"/library/jedit/jedit-remote.factor"
|
|
||||||
"/library/jedit/jedit.factor"
|
|
||||||
|
|
||||||
"/library/platform/native/primitives.factor"
|
"/library/platform/native/primitives.factor"
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -36,6 +36,7 @@ USE: streams
|
||||||
USE: stdio
|
USE: stdio
|
||||||
USE: strings
|
USE: strings
|
||||||
USE: unparser
|
USE: unparser
|
||||||
|
USE: words
|
||||||
|
|
||||||
: jedit-server-file ( -- path )
|
: jedit-server-file ( -- path )
|
||||||
"jedit-server-file" get
|
"jedit-server-file" get
|
||||||
|
|
@ -76,10 +77,36 @@ USE: unparser
|
||||||
write flush
|
write flush
|
||||||
] with-stream ;
|
] with-stream ;
|
||||||
|
|
||||||
: remote-jedit-line/file ( line dir file -- )
|
: jedit-line/file ( line dir file -- )
|
||||||
rot "+line:" swap unparse cat2 unit cons swap
|
rot "+line:" swap unparse cat2 unit cons swap
|
||||||
<namespace> [
|
<namespace> [
|
||||||
"restore" off
|
"restore" off
|
||||||
"newView" off
|
"newView" off
|
||||||
"newPlainView" off
|
"newPlainView" off
|
||||||
] extend make-jedit-request send-jedit-request ;
|
] extend make-jedit-request send-jedit-request ;
|
||||||
|
|
||||||
|
: resource-path ( -- path )
|
||||||
|
global [ "resource-path" get ] bind [ "." ] unless* ;
|
||||||
|
|
||||||
|
: word-file ( path -- dir file )
|
||||||
|
dup [
|
||||||
|
dup "resource:/" str-head? dup [
|
||||||
|
nip resource-path swap
|
||||||
|
] [
|
||||||
|
swap ( f file )
|
||||||
|
] ifte
|
||||||
|
] [
|
||||||
|
f
|
||||||
|
] ifte ;
|
||||||
|
|
||||||
|
: word-line/file ( word -- line dir file )
|
||||||
|
#! Note that line numbers here start from 1
|
||||||
|
dup "line" word-property swap "file" word-property
|
||||||
|
word-file ;
|
||||||
|
|
||||||
|
: jedit ( word -- )
|
||||||
|
word-line/file dup [
|
||||||
|
jedit-line/file
|
||||||
|
] [
|
||||||
|
3drop "Unknown source" print
|
||||||
|
] ifte ;
|
||||||
Loading…
Reference in New Issue