+++ /dev/null
-! :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 ;
+++ /dev/null
-! :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 ;
+++ /dev/null
-IN: jedit
-USE: errors
-
-! Doesn't exist in native Factor.
-: local-jedit-line/file "Not supported" throw ;
+++ /dev/null
-! :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: lists
-USE: logic
-USE: namespaces
-USE: parser
-USE: stack
-USE: streams
-USE: stdio
-USE: strings
-USE: unparser
-
-: jedit-server-file ( -- path )
- "jedit-server-file" get
- [ "~" get "/.jedit/server" cat2 ] unless* ;
-
-: jedit-server-info ( -- port auth )
- jedit-server-file <filecr> [
- read drop
- read parse-number
- read parse-number
- ] with-stream ;
-
-: bool, ( ? -- str )
- "true" "false" ? , ;
-
-: list>bsh-array, ( list -- code )
- "new String[] {" ,
- [ unparse , "," , ] each
- "null}" , ;
-
-: make-jedit-request ( files dir params -- code )
- [
- [
- "EditServer.handleClient(" ,
- "restore" get bool, "," ,
- "newView" get bool, "," ,
- "newPlainView" get bool, "," ,
- ( If the dir is not set, we don't want to send f )
- dup [ unparse ] [ drop "null" ] ifte , "," ,
- list>bsh-array, ");\n" ,
- ] make-string
- ] bind ;
-
-: send-jedit-request ( request -- )
- jedit-server-info swap "localhost" swap <client> [
- write-big-endian-32
- dup str-length write-big-endian-16
- write flush
- ] with-stream ;
-
-: remote-jedit-line/file ( line dir file -- )
- rot "+line:" swap unparse cat2 unit cons swap
- <namespace> [
- "restore" off
- "newView" off
- "newPlainView" off
- ] extend make-jedit-request send-jedit-request ;
USE: strings
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 )
global [ "resource-path" get ] bind [ "." ] unless* ;
"/library/httpd/resource-responder.factor"
"/library/httpd/default-responders.factor"
- "/library/jedit/jedit-no-local.factor"
- "/library/jedit/jedit-remote.factor"
- "/library/jedit/jedit.factor"
+ "/library/tools/jedit.factor"
"/library/platform/native/primitives.factor"
--- /dev/null
+! :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: lists
+USE: logic
+USE: namespaces
+USE: parser
+USE: stack
+USE: streams
+USE: stdio
+USE: strings
+USE: unparser
+USE: words
+
+: jedit-server-file ( -- path )
+ "jedit-server-file" get
+ [ "~" get "/.jedit/server" cat2 ] unless* ;
+
+: jedit-server-info ( -- port auth )
+ jedit-server-file <filecr> [
+ read drop
+ read parse-number
+ read parse-number
+ ] with-stream ;
+
+: bool, ( ? -- str )
+ "true" "false" ? , ;
+
+: list>bsh-array, ( list -- code )
+ "new String[] {" ,
+ [ unparse , "," , ] each
+ "null}" , ;
+
+: make-jedit-request ( files dir params -- code )
+ [
+ [
+ "EditServer.handleClient(" ,
+ "restore" get bool, "," ,
+ "newView" get bool, "," ,
+ "newPlainView" get bool, "," ,
+ ( If the dir is not set, we don't want to send f )
+ dup [ unparse ] [ drop "null" ] ifte , "," ,
+ list>bsh-array, ");\n" ,
+ ] make-string
+ ] bind ;
+
+: send-jedit-request ( request -- )
+ jedit-server-info swap "localhost" swap <client> [
+ write-big-endian-32
+ dup str-length write-big-endian-16
+ write flush
+ ] with-stream ;
+
+: jedit-line/file ( line dir file -- )
+ rot "+line:" swap unparse cat2 unit cons swap
+ <namespace> [
+ "restore" off
+ "newView" off
+ "newPlainView" off
+ ] 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 ;
projects / factor.git / commitdiff