CC = gcc
# On FreeBSD, to use SDL and other libc_r libs:
-CFLAGS = -g -Wall -pthread -export-dynamic
+CFLAGS = -g -Wall -export-dynamic -pthread
# On PowerPC G5:
# CFLAGS = -mcpu=970 -mtune=970 -mpowerpc64 -ffast-math -O3
# On Pentium 4:
[error] SideKick$BufferChangeHandler: We have cplusplus.xml (/home/slava/jEdit/modes/) but got event for DefaultInputHandler.java (/home/slava/jEdit/org/gjt/sp/jedit/gui/)\r
[error] SideKick$BufferChangeHandler: We have cplusplus.xml (/home/slava/jEdit/modes/) but got event for DefaultInputHandler.java (/home/slava/jEdit/org/gjt/sp/jedit/gui/)\r
\r
-- fix responder generated links\r
+- perhaps /i should work with all numbers\r
- profiler is inaccurate: wrong word on cs\r
- buffer change handler in sidekick is screwed\r
- dec> bin> oct> hex> throw errors\r
- parse-number doesn't\r
- eval with multilien strings and #!\r
-- redefining a word doesn't clear comments\r
- quit responder breaks with multithreading\r
- nicer way to combine two paths\r
- don't show listener on certain commands\r
- plugin should not exit jEdit on fatal errors\r
- wordpreview: don't show for string literals and comments\r
- alist -vs- assoc terminology\r
-- write-icon kind of messy; " " should be output by the listener\r
-- f usages. --> don't print all words\r
- file responder: don't show full path in title\r
\r
- clean up listener's action popups\r
- jedit ==> jedit-word, jedit takes a file name\r
-- namespace clone drops static var bindings\r
- add a socket timeout\r
- fix error postoning -- not all errors thrown by i/o code are\r
postponed\r
Map.Entry entry = (Map.Entry)iter.next();
Object key = entry.getKey();
Object value = entry.getValue();
- if(!(value instanceof VarBinding))
- this.words.put(key,value);
+ if(value instanceof VarBinding)
+ {
+ VarBinding b = (VarBinding)value;
+ if(b.instance != null)
+ continue;
+ }
+
+ this.words.put(key,value);
}
}
#! If the quotation compiles, this combinator compiles.
>r over >r call r> r> call ; inline interpret-only
+: slip ( quot x -- x )
+ >r call r> ; inline interpret-only
+
+: 2slip ( quot x y -- x y )
+ >r >r call r> r> ; inline interpret-only
+
+: 3slip ( quot x y z -- x y z )
+ >r >r >r call r> r> r> ; inline interpret-only
+
: dip ( a [ b ] -- b a )
#! Call b as if b was not present on the stack.
#!
] ifte ;
: ALIEN-CALL ( return func dll params -- )
- PARAMETERS >r
+ reverse PARAMETERS >r
dlsym CALL drop
r> CLEANUP
RETURNS ;
: usages. ( word -- )
#! List all usages of a word in all vocabularies.
- intern vocabs [ dupd usages-in-vocab. ] each drop ;
+ intern [
+ vocabs [ dupd usages-in-vocab. ] each drop
+ ] [
+ "Not defined" print
+ ] ifte* ;
: vocab-apropos ( substring vocab -- list )
#! Push a list of all words in a vocabulary whose names
tuck >r dup 0 <= [
r> 3drop
] [
- pred >r call r> r> times
+ pred slip r> times
] ifte ; inline interpret-only
: (times) ( limit n quot -- )
pick pick <= [
3drop
] [
- tuck >r tuck >r rot >r call r> r> succ r> (times)
+ rot pick succ pick 3slip (times)
] ifte ; inline interpret-only
: times* ( n quot -- )
#! In order to compile, the code must consume one more value
#! than it produces.
0 swap (times) ; inline interpret-only
+
+: 2times-succ ( #{ a b } #{ c d } -- z )
+ #! Lexicographically add #{ 0 1 } to a complex number.
+ #! If d + 1 == b, return #{ c+1 0 }. Otherwise, #{ c d+1 }.
+ 2dup imaginary succ swap imaginary = [
+ nip real succ
+ ] [
+ nip >rect succ rect>
+ ] ifte ;
+
+: 2times<= ( #{ a b } #{ c d } -- ? )
+ swap real swap real <= ;
+
+: (2times) ( limit n quot -- )
+ pick pick 2times<= [
+ 3drop
+ ] [
+ rot pick dupd 2times-succ pick 3slip (2times)
+ ] ifte ;
+
+: 2times* ( #{ w h } quot -- )
+ #! Apply a quotation to each pair of complex numbers
+ #! #{ a b } such that a < w, b < h.
+ 0 swap (2times) ;
over underline-attribute
<file-actions-menu> actions-key attribute+ ;
-: style>attribute-set ( style -- attribute-set )
+: 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 [
[ "object-link" dupd object-link-attribute ]
[ "file-link" dupd file-link-attribute ]
[ "bg" dupd >color "Background" swing-attribute+ ]
[ "font" dupd "FontFamily" swing-attribute+ ]
[ "size" dupd "FontSize" swing-attribute+ ]
- [ "icon" dupd <icon> set-icon-style ]
+ [ "icon" icon-attribute ]
] assoc-apply ;
: set-character-attrs ( attrs -- )
jinvoke ;
: reset-attrs ( -- )
- default-style style>attribute-set set-character-attrs ;
+ f default-style style>attribute-set set-character-attrs
+ drop ;
: listener-readln* ( continuation -- )
"listener" get
! Colon defs
: CREATE ( -- word )
scan "in" get create dup set-word
- f "documentation" pick set-word-property ;
+ f "documentation" pick set-word-property
+ f "stack-effect" pick set-word-property ;
: remember-where ( word -- )
"line-number" get "line" pick set-word-property
CREATE dup remember-where [ ]
"in-definition" on ; parsing
-: ;-hook ( -- quot )
- ";-hook" get [ [ define-compound ] ] unless* ;
+: ;-hook ( word def -- )
+ ";-hook" get [ call ] [ define-compound ] ifte* ;
: ;
#! End a word definition.
"in-definition" off
nreverse
- ;-hook call ; parsing
+ ;-hook ; parsing
! Vocabularies
: DEFER: CREATE drop ; parsing
: write-icon ( resource -- )
#! Write an icon. Eg, /library/icons/File.png
- "icon" swons unit " " swap write-attr ;
+ "icon" swons unit "" swap write-attr ;
: print ( string -- )
"stdio" get fprint ;
IN: scratchpad
USE: combinators
USE: kernel
+USE: math
USE: stack
USE: test
[ ] [ 3 [ ] cond ] unit-test
[ t ] [ 4 [ [ 1 = ] [ ] [ 4 = ] [ drop t ] [ 2 = ] [ ] ] cond ] unit-test
+
+[ 0 1 2 3 4 ] [ 5 [ ] times* ] unit-test
+[ ] [ 0 [ ] times* ] unit-test
+
+[ #{ 1 1 } ] [ #{ 2 3 } #{ 1 0 } 2times-succ ] unit-test
+[ #{ 1 2 } ] [ #{ 2 3 } #{ 1 1 } 2times-succ ] unit-test
+[ #{ 2 0 } ] [ #{ 3 3 } #{ 1 2 } 2times-succ ] unit-test
+[ #{ 2 1 } ] [ #{ 3 3 } #{ 2 0 } 2times-succ ] unit-test
+[ #{ 2 0 } ] [ #{ 2 2 } #{ 1 1 } 2times-succ ] unit-test
+
+[ #{ 0 0 } #{ 0 1 } #{ 1 0 } #{ 1 1 } ]
+[ #{ 2 2 } [ ] 2times* ] unit-test
+
+[ #{ 0 0 } #{ 0 1 } #{ 0 2 } #{ 1 0 } #{ 1 1 } #{ 1 2 }
+ #{ 2 0 } #{ 2 1 } #{ 2 2 } ]
+[ #{ 3 3 } [ ] 2times* ] unit-test
projects / factor.git / commitdiff