gWidgetsRGtk2/0000755000175100001440000000000013246035251012720 5ustar hornikusersgWidgetsRGtk2/inst/0000755000175100001440000000000012240025532013667 5ustar hornikusersgWidgetsRGtk2/inst/examples/0000755000175100001440000000000012240025532015505 5ustar hornikusersgWidgetsRGtk2/inst/examples/t.test.glade0000644000175100001440000003037011406427003017731 0ustar hornikusers GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK True GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK 7 4 4 4 True True GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK 0.95000000000000007 0.5 1 0.01 0.050000000000000003 0.050000000000000003 0.0099999997764825821 2 1 2 4 5 True GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK 0 FALSE TRUE 3 4 3 4 True GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK 0 0 FALSE TRUE 1 2 3 4 True GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK 0 "two.sided" "less" "greater" 3 4 2 3 True True GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK 1 2 2 3 True True GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK 3 4 1 2 True True GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK 1 2 1 2 True True True GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK dismiss 0 3 4 6 7 True GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK 4 5 6 True GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK conf.level= GTK_JUSTIFY_RIGHT 4 5 True GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK paired= GTK_JUSTIFY_RIGHT 2 3 3 4 True GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK var.equal= GTK_JUSTIFY_RIGHT 3 4 True GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK alt= GTK_JUSTIFY_RIGHT 2 3 2 3 True GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK mu= GTK_JUSTIFY_RIGHT 2 3 True GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK y= GTK_JUSTIFY_RIGHT 2 3 1 2 True GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK x= GTK_JUSTIFY_RIGHT 1 2 True GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK t.test 1 3 gWidgetsRGtk2/inst/images/0000755000175100001440000000000012240025532015134 5ustar hornikusersgWidgetsRGtk2/inst/images/hist.xpm0000644000175100001440000000076611406427003016644 0ustar hornikusers/* XPM */ static char * g_bars_xpm[] = { "20 16 3 1", " c #FFFFFFFFFFFF", ". c #000000000000", "X c #0000FFFFFFFF", " ", "....................", ". .", ". .... .", ". .XX. .", ". .XX. .", ". ....XX. .", ". .XX.XX. .", ". .XX.XX.... .", ". ....XX.XX.XX. .", ". .XX.XX.XX.XX.... .", ". .XX.XX.XX.XX.XX. .", ". .XX.XX.XX.XX.XX. .", ". .XX.XX.XX.XX.XX. .", "....................", " "}; gWidgetsRGtk2/inst/images/rename.bmp0000644000175100001440000000165211406427003017111 0ustar hornikusersBM6(   @!Y"1R&I L g%nzxF!P!u)AU$e,e ] ~q%Fk3ފ^ }Y_}ƒqM!"Kℕx%3u|CqQ'B)D`6;'Hp8e"rJo*Pe'~N#U-x,_1/D-5No0o@|0lv&o`rŁv┓Tw#do`oZk~/zc'z4ίYiS fLW4Qby*7t~xF2]AgDR &Gq)o{P)X%W$R*Q(ZhgWidgetsRGtk2/inst/images/darrow.xpm0000644000175100001440000000270111406427003017162 0ustar hornikusers/* XPM */ static char * darrow_xpm[] = { "19 20 64 1", " c None", ". c #FFFFFF", "+ c #F7F7F7", "@ c #EFEFEF", "# c #E6E6E6", "$ c #E6DEDE", "% c #DEDEDE", "& c #DED6D6", "* c #D6D6D6", "= c #D6CECE", "- c #CECECE", "; c #CECEC5", "> c #C5C5C5", ", c #C5C5BD", "' c #C5BDBD", ") c #BDBDBD", "! c #BDBDB5", "~ c #B5B5B5", "{ c #B5B5AD", "] c #B5ADAD", "^ c #ADADAD", "/ c #ADADA5", "( c #ADA5A5", "_ c #A5A5A5", ": c #9C9C9C", "< c #9C9494", "[ c #949494", "} c #94948C", "| c #948C8C", "1 c #8C8C8C", "2 c #8C8C84", "3 c #8C8484", "4 c #848484", "5 c #8C7B84", "6 c #847B7B", "7 c #7B7B7B", "8 c #7B7373", "9 c #737373", "0 c #73736B", "a c #7B6B73", "b c #736B6B", "c c #7B636B", "d c #6B6B6B", "e c #6B6B63", "f c #6B6363", "g c #6B5A63", "h c #DE107B", "i c #CE1073", "j c #525252", "k c #5A4A52", "l c #5A4A4A", "m c #524A4A", "n c #A5195A", "o c #4A4A4A", "p c #4A4A42", "q c #AD1063", "r c #9C195A", "s c #8C2152", "t c #A5105A", "u c #4A4242", "v c #842152", "w c #523A42", "x c #4A313A", "y c #52293A", " ", " 'akkkc]+ ", " 'k8_)))_6k< ", " g0>>>>>)))![| ", " |^>>>>>>>>))]_g ", " <:,------;>>')!b' ", "+k--kwwwwwwwwwl)~k ", "]1*=aqiiiiiiing))9'", "a)*%*yhhhhhhhy)>)_a", "k*%%#5nhhhhhnc;>))k", "k%%##@xhhhhhy-->>)k", "k%##@+>)k", "a>#@++ xhhhx**->>(a", "'6#@+ (shn6%*->>4]", " k#@++ +whx%%*->>k+", " '4#@+++^v5%**-):| ", " g-%@@@#m%%*=-^| ", " [~####%%**-8g ", " |k<>%%*~6k' ", " +]akkka' "}; gWidgetsRGtk2/inst/images/uarrow.gif0000644000175100001440000000074011406427003017145 0ustar hornikusersGIF89aŽŽ{{{{{{{sssssssk{ksskk{ckkkkkkckcckZc{sRRRZJRZJJRJJZJJJJJBcZ!RZJBB!RR:BJ1:R):!Created with The GIMP!?,p0&I`6`!ȡPX``5Jx47,ޅk8Sn  ?0 ^T=-=0 (3 0&>S& $,3..6&k?01<0 0K '  A'da!=Kr%3aFeGqHd;gWidgetsRGtk2/inst/images/2dlayer.xpm0000644000175100001440000000074411406427003017233 0ustar hornikusers/* XPM */ static char * g_2dlayer_xpm[] = { "20 16 2 1", " c #FFFFFFFFFFFF", ". c #000000000000", " .................", " . .", " .. ...... .", " . . . .", " .. . . .", " . . ...... .", ". .. .", ". . .", " .. .", " . .", " .. .", " . . . . . . . . .", " .................", " ", " . . ", " . "}; gWidgetsRGtk2/inst/images/symbol_diamond.xpm0000644000175100001440000000076511406427003020674 0ustar hornikusers/* XPM */ static char * symbol_diamond_xpm[] = { "18 18 2 1", " c #FFFFFFFFFFFF", ". c #000000000000", " ", " ", " ", " ", " .. ", " .... ", " .. .. ", " .. .. ", " .. .. ", " .. .. ", " .. .. ", " .. .. ", " .... ", " .. ", " ", " ", " ", " "}; gWidgetsRGtk2/inst/images/ts.xpm0000644000175100001440000000100011406427003016301 0ustar hornikusers/* XPM */ static char * plot_small_xpm[] = { "19 16 4 1", " c #FFFFFFFFFFFF", ". c #000000000000", "X c #FFFF00000000", "o c #00000000FFFF", " ................. ", " . . ", " . . XX. ", " . X X . ", " . . XX X . ", " . X XX . ", " . .X X . ", " . X . ", " .. X . X. . . .. ", " . XX X . ", " . X XX ..... . ", " . X . . . . ", " . X ..... . ", " .X . . ", " ................. ", " . . . . . "}; gWidgetsRGtk2/inst/images/symbol_uptriangle.xpm0000644000175100001440000000077011406427003021427 0ustar hornikusers/* XPM */ static char * symbol_uptriangle_xpm[] = { "18 18 2 1", " c #FFFFFFFFFFFF", ". c #000000000000", " ", " ", " ", " ", " .. ", " .. ", " .... ", " . . ", " .. .. ", " . . ", " .. .. ", " . . ", " .......... ", " .......... ", " ", " ", " ", " "}; gWidgetsRGtk2/inst/images/rename.xpm0000644000175100001440000001111111406427003017126 0ustar hornikusers/* XPM */ static char * rename_xpm[] = { "22 13 250 2", " c #E2FFFC", ". c #E2FFFA", "+ c #EDFFFF", "@ c #F2FFFF", "# c #F8FFFF", "$ c #FCFFFD", "% c #FFFBF8", "& c #FFFAF6", "* c #FFFBF9", "= c #FFFBFC", "- c #FFFBFF", "; c #FDFAFF", "> c #FCFBFF", ", c #F8FBFF", "' c #F3F8FF", ") c #F7FAFF", "! c #FFF8FF", "~ c #F6EAFF", "{ c #FFF4FF", "] c #FEF6FF", "^ c #F5F3FF", "/ c #FDFFF7", "( c #F0FFFF", "_ c #F5FFFF", ": c #EBF7F7", "< c #F9FFFF", "[ c #898E8A", "} c #8C8D88", "| c #A8A5A0", "1 c #FFFEFA", "2 c #FFFCFD", "3 c #FFF7FF", "4 c #FFF5FF", "5 c #F5E6FF", "6 c #291B50", "7 c #251458", "8 c #241357", "9 c #2A1D52", "0 c #281B51", "a c #685BA3", "b c #FDF3FF", "c c #FFFCFF", "d c #FEFFFD", "e c #FFFAFF", "f c #ECE5ED", "g c #FFFEFF", "h c #FFFFFF", "i c #8A8F8B", "j c #A4ABA3", "k c #787E74", "l c #ECEDE7", "m c #FBF5F7", "n c #FFF3FF", "o c #FFEDFF", "p c #320046", "q c #41055D", "r c #440F67", "s c #260B52", "t c #100047", "u c #291971", "v c #7B6FB9", "w c #F0F0F8", "x c #FFF2FF", "y c #FFE3F3", "z c #9A9599", "A c #919692", "B c #B6C2B8", "C c #9AA89B", "D c #9AA69C", "E c #FBFFFF", "F c #F8E3FF", "G c #4C1966", "H c #340057", "I c #DCA4FF", "J c #D0B4FF", "K c #E0D0FF", "L c #6251AD", "M c #372A79", "N c #F0EAFF", "O c #FEFEFF", "P c #FFEEFF", "Q c #FFF1FF", "R c #898385", "S c #929791", "T c #D0E0D3", "U c #7A917F", "V c #90AB9A", "W c #DCF6ED", "X c #ECFFFF", "Y c #E6E4FF", "Z c #271B63", "` c #341F7A", " . c #CEB7FF", ".. c #C9B8FE", "+. c #CEBFFF", "@. c #695AAF", "#. c #150953", "$. c #F4F4FE", "%. c #FFDCFB", "&. c #FFE1FF", "*. c #FFE7FF", "=. c #FFE2F9", "-. c #C592A3", ";. c #A47681", ">. c #E2BBBE", ",. c #B39394", "'. c #A3898A", "). c #FFF1FA", "!. c #FFF6FF", "~. c #110654", "{. c #231A77", "]. c #6F64C2", "^. c #6F61AE", "/. c #6B5AA8", "(. c #2F1E7E", "_. c #8D80D2", ":. c #FEFDFF", "<. c #FFE0FF", "[. c #83244E", "}. c #C15682", "|. c #78002D", "1. c #86002C", "2. c #C5325F", "3. c #9E062F", "4. c #B31B44", "5. c #95042D", "6. c #890735", "7. c #88194E", "8. c #86306F", "9. c #FFCDFF", "0. c #40156F", "a. c #30157C", "b. c #14016C", "c. c #261176", "d. c #1B066F", "e. c #1D0881", "f. c #7261CB", "g. c #E7DDFF", "h. c #FEFAFF", "i. c #FFE4FF", "j. c #711C43", "k. c #8A2851", "l. c #871642", "m. c #800029", "n. c #A91744", "o. c #D13660", "p. c #AD103B", "q. c #920027", "r. c #A31748", "s. c #AF3870", "t. c #832265", "u. c #FFDEFF", "v. c #4A1472", "w. c #2A056F", "x. c #D3B8FF", "y. c #D1BBFF", "z. c #CCB7FF", "A. c #6550C7", "B. c #271680", "C. c #887EBB", "D. c #FCF7FF", "E. c #A78595", "F. c #A37D8A", "G. c #B08690", "H. c #BD9097", "I. c #BA8B91", "J. c #C2939D", "K. c #A07183", "L. c #FFECFF", "M. c #21004D", "N. c #4B2288", "O. c #D3B0FF", "P. c #CFBAFF", "Q. c #C1B1FC", "R. c #9584E2", "S. c #332678", "T. c #7C759F", "U. c #FEFCFF", "V. c #F3F6FD", "W. c #FBFEFF", "X. c #9FA2A7", "Y. c #A0A5A8", "Z. c #939997", "`. c #A9AEAA", " + c #80857E", ".+ c #9FA29B", "++ c #91908C", "@+ c #8E898D", "#+ c #A398A9", "$+ c #462671", "%+ c #330E6B", "&+ c #C3A2FB", "*+ c #C8B3F6", "=+ c #D5C6FF", "-+ c #9A8BDE", ";+ c #20145E", ">+ c #5F597D", ",+ c #F7F6FF", "'+ c #788082", ")+ c #9CA1A4", "!+ c #FEFFFF", "~+ c #F9F3F3", "{+ c #FFFDFB", "]+ c #FDF3F4", "^+ c #B3A6AD", "/+ c #A493A5", "(+ c #FFF0FF", "_+ c #FCE4FF", ":+ c #210746", "<+ c #210550", "[+ c #412975", "}+ c #241055", "|+ c #2C1C65", "1+ c #1A0965", "2+ c #1A0D5D", "3+ c #8A83AD", "4+ c #FBF9FF", "5+ c #F8FCFB", "6+ c #F5F9F8", "7+ c #9E9FA1", "8+ c #908F94", "9+ c #F6F1F5", "0+ c #FFFDFF", "a+ c #FFF9FC", "b+ c #898085", "c+ c #A298A3", "d+ c #211440", "e+ c #312259", "f+ c #261752", "g+ c #201349", "h+ c #1C0E4C", "i+ c #251667", "j+ c #7A6EB6", "k+ c #E3DEFE", "l+ c #FFF4F5", "m+ c #FFFAFD", "n+ c #FEF2F6", "o+ c #F9EEF6", "p+ c #FFF9FF", "q+ c #FCFAFF", "r+ c #F8F9FB", "s+ c #FCFFFF", "t+ c #F6FBFE", "u+ c #E7EBF4", "v+ c #F6F8FF", "w+ c #FBFBFF", "x+ c #EFEEFF", "y+ c #F6ECFF", "z+ c #FEF7FF", "A+ c #FCFFF6", " . + @ # $ % & * = - ; > , ' ) ! ~ { ] ^ / ", "( @ _ : < [ } | 1 2 3 4 5 6 7 8 9 0 a b c d ", "e e f g h i j k l m n n o p q r s t u v e w ", "x y 3 e z A B C D E - F o G H I J K L M N O ", "P Q n ! R S T U V W X _ Y Z ` ...+.@.#.e $.", "%.&.*.=.-.;.>.,.'.).3 !.4 ~.{.].^./.(._.! :.", "<.[.}.|.1.2.3.4.5.6.7.8.9.0.a.b.c.d.e.f.g.h.", "i.j.k.l.m.n.o.p.q.r.s.t.u.v.w.x.y.z.A.B.C.D.", "4 Q { E.F.G.H.I.J.K.o L.*.M.N.O.P.Q.R.S.T.U.", "V.W.X.Y.Z.`. +.+++@+#+!.Q $+%+&+*+=+-+;+>+,+", "# # '+)+!+g ~+{+]+^+/+(+_+:+<+[+}+|+1+2+3+4+", "5+6+7+8+g 9+0+a+2 b+c+3 3 d+e+f+g+h+i+j+k+O ", "l+m+n+o+p+- q+r+s+E t+u+W.v+w+x+- p+y+z+g A+"}; gWidgetsRGtk2/inst/images/rename.jpg0000644000175100001440000000102411406427003017104 0ustar hornikusersJFIFC    $.' ",#(7),01444'9=82<.342C  2!!22222222222222222222222222222222222222222222222222 "&!1Q2A# "1Aaq ?RܑYƟenJe!9ug>|C]iԻKm=fNe)ud tIr$)f@X@i= yЗ jX-#OcPWʳ{vUD x鍤\?ae!奰b}z3ӏKmM*]&>X a)@9RNNznYSggWidgetsRGtk2/inst/images/subset.xpm0000644000175100001440000000527111406427003017176 0ustar hornikusers/* XPM */ static char * sheet_icon2_xpm[] = { "48 48 9 1", " c #FFFFFFFFFFFF", ". c #000000000000", "X c #D6D6D6D6D6D6", "o c #FFFF00000000", "O c #FFFF5E5EF3F3", "+ c #FFFF0000FFFF", "@ c #0000FFFFFFFF", "# c #FFFF91915555", "$ c #FFFFFFFF0000", " ", " ........................................... ", " .XXXXXXXXXXXXX.XXXXXXXXXXXXX.XXXXXXXXXXXXX. ", " .XXXXXXXXXXXXX.XXXXX...XXXXX.XXXX....XXXXX. ", " .XXXXXXXXXXXXX.XXXX.XXX.XXXX.XXXX.XXX.XXXX. ", " .XXXXXXXXXXXXX.XXXX.....XXXX.XXXX....XXXXX. ", " .XXXXXXXXXXXXX.XXXX.XXX.XXXX.XXXX.XXX.XXXX. ", " .XXXXXXXXXXXXX.XXXX.XXX.XXXX.XXXX....XXXXX. ", " .XXXXXXXXXXXXX.XXXXXXXXXXXXX.XXXXXXXXXXXXX. ", " ........................................... ", " .XXXXXXXXXXXXX. . . ", " .XXXXXX.XXXXXX. . ... . ", " .XXXXXX.XXXXXX. oo . .OO+. . ", " .XXXXXX.XXXXXX. oooooo . ...O. . ", " .XXXXXX.XXXXXX. oo . .@@@.. . ", " .XXXXXXXXXXXXX. . ...@@. . ", " ..............................###.@........ ", " .XXXXXXXXXXXXX. ..####. . ", " .XXXXX....XXXX. .####. . ", " .XXXXXXX..XXXX. oooooo .####. . ", " .XXXXX..XXXXXX. .####. . ", " .XXXXX....XXXX. .####. . ", " .XXXXXXXXXXXXX. .####. . ", " ...........................####............ ", " .XXXXXXXXXXXXX. .####. . ", " .XXXXX....XXXX. .####. oo oo . ", " .XXXXXX..XXXXX. .####. o oo . ", " .XXXXXXXX.XXXX. .####. oo o . ", " .XXXXX....XXXX. .####. oo oo . ", " .XXXXXXXXXXXXX. .####. . ", " .......................####................ ", " .XXXXXXXXXXXXX. .####.. . ", " .XXXXX.XX.XXXX. .####. . oo oo . ", " .XXXXX....XXXX. .####. . ooo . ", " .XXXXXXXX.XXXX. .####. . ooo . ", " .XXXXXXXX.XXXX. .####. . oo oo . ", " .XXXXXXXXXXXXX. ...##. . . ", " ....................$$.#................... ", " .XXXXXXXXXXXXX. .$$$. . . ", " .XXXXX....XXXX. ..$.. . ooooooo . ", " .XXXXX...XXXXX. ... . . ", " .XXXXXXXX.XXXX. . . ooooooo . ", " .XXXXX....XXXX. . . ", " .XXXXXXXXXXXXX. . . ", " ........................................... ", " ", " ", " "}; gWidgetsRGtk2/inst/images/barplot.xpm0000644000175100001440000000076711406427003017341 0ustar hornikusers/* XPM */ static char * g_hbars_xpm[] = { "20 16 3 1", " c #FFFFFFFFFFFF", ". c #000000000000", "X c #0000FFFF0000", " ", "....................", ". .", "........... .", ".XXXXXXXXX. .", "................. .", ".XXXXXXXXXXXXXXX. .", "................. .", ".XXXXXXXXXXXXX. .", "............... .", ".XXXXXXXXXXX. .", "................ .", ".XXXXXXXXXXXXXX. .", "................ .", "....................", " "}; gWidgetsRGtk2/inst/images/graph2.xpm0000644000175100001440000000770311406427003017056 0ustar hornikusers/* XPM */ static char * as2_xpm[] = { "32 32 113 2", " c None", ". c #000000", "+ c #A0A0A0", "@ c #8D8D8D", "# c #555555", "$ c #D0D0D0", "% c #FFFFFF", "& c #FF2A2A", "* c #AAAAAA", "= c #535353", "- c #4D4D4D", "; c #808080", "> c #1C1C1C", ", c #DCDCDC", "' c #FFA0A0", ") c #FF1B1B", "! c #FFC0C0", "~ c #959595", "{ c #0E0E0E", "] c #D5D5D5", "^ c #E3E3E3", "/ c #FFEEEE", "( c #FF0000", "_ c #FF4E4E", ": c #FFF4F4", "< c #8E8E8E", "[ c #FF7B7B", "} c #FF2020", "| c #FFB0B0", "1 c #393939", "2 c #FFB8B8", "3 c #FFAAAA", "4 c #FF1C1C", "5 c #FFD5D5", "6 c #C6C6C6", "7 c #D4D4D4", "8 c #2A2A2A", "9 c #7E7E7E", "0 c #2B2B2B", "a c #757575", "b c #6A6A6A", "c c #FFEDED", "d c #B8B8B8", "e c #2B1C1C", "f c #FFBFBF", "g c #FFF5F5", "h c #D0C0C0", "i c #FF9F9F", "j c #FF6565", "k c #2B0000", "l c #FF7070", "m c #FFFAFA", "n c #6A3232", "o c #EF3B3B", "p c #FF1515", "q c #B80E0E", "r c #FF5555", "s c #FFC6C6", "t c #717171", "u c #F1F1F1", "v c #FF8E8E", "w c #B80000", "x c #FF2B2B", "y c #FF5151", "z c #5B4C4C", "A c #D79393", "B c #FF3535", "C c #4E2323", "D c #FFF1F1", "E c #FFE3E3", "F c #FFD4D4", "G c #4E0000", "H c #FF6B6B", "I c #FFCCCC", "J c #FFCACA", "K c #FF4040", "L c #FFE0E0", "M c #EFEFEF", "N c #CFCFCF", "O c #4E4E4E", "P c #FFDCDC", "Q c #232323", "R c #7B7B7B", "S c #6E6E6E", "T c #989898", "U c #868686", "V c #070707", "W c #FF0707", "X c #FF9595", "Y c #F8F8F8", "Z c #151515", "` c #FFCBCB", " . c #FF0505", ".. c #FF6A6A", "+. c #DFDFDF", "@. c #C2C2C2", "#. c #FF2323", "$. c #686868", "%. c #5F5F5F", "&. c #434343", "*. c #424242", "=. c #181818", "-. c #982D2D", ";. c #6D6D6D", ">. c #BABABA", ",. c #A3A3A3", "'. c #494949", "). c #626262", "!. c #C8C8C8", "~. c #AFAFAF", "{. c #909090", "]. c #E2E2E2", "^. c #707070", ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . ", ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . ", ". . % % % % % % % % % % % % % % % % % % % % % % % % % % % % . . ", ". . % % % % % % % % % % % % % % % % % % % % % % % % % % % % . . ", ". . % % + @ # $ % % % % % % # . % & * . * % % % % % % % % % . . ", ". . % % = - # $ % % % % % ; > , ' ) ! ~ { ] % % % % % % % % . . ", ". . % % % , # $ % % % % ^ # * / ( ( _ : # < % % % % % % % % . . ", ". . % % % , # $ % % % % * . * [ ( ( } | # . % % % % % % % % . . ", ". . % % % , # $ % % % ^ 1 # ^ 2 3 4 3 5 6 > # % % % % % % % . . ", ". . % % % , # $ % % % 7 . ; % % % & % % % 8 . % % % % % % % . . ", ". . % % % , # $ % % % 7 # % % % % & % % % 8 . % % % % % % % . . ", ". . % % @ 9 # $ % % % . # % % % % _ % % % % . 0 % % % % % % . . ", ". . % % a b # $ % c 3 { < % % % % d % % % % # e f g % % % % . . ", ". . % % % , # h i j ( 0 % % % % ; ; * % % % % k } l ! m % % . . ", ". . % % % , n o p ( ( q r r s t * u < * v r r w ( ( x y % % . . ", ". . % % % , z A B ( ( C 5 5 D 0 % % * ; E 5 F G ( ( H I % % . . ", ". . % % % , # $ % J ( 0 % % % 0 % % * ; % % % k K L % % % % . . ", ". . % % M N # $ % 8 . O % % # 7 % P % ; * % % Q . ; % % % % . . ", ". . % % R S # $ % 8 . % % % # 7 % & % ; * % % 7 . ; % % % % . . ", ". . % % T U # $ % 8 . % % % # 7 % & % ; * % % 7 . ; % % % % . . ", ". . % % % , # $ % 8 . % % % 6 u % & % ] ^ % % 7 . ; % % % % . . ", ". . % % % , # $ t V ] % % % % _ & W & X % % % Y < Z d % % % . . ", ". . % % % , # $ # . % % % % % ` ( ( K L % % % % * . * % % % . . ", ". . % % % , # $ # . % % % % % % } ...% % % % % * . * % % % . . ", ". . % % +.@.# $ # . % % % % % % 5 #.E % % % % % * . * % % % . . ", ". . % % $.%.&.; *.=.T T T T T T T -.T T T T T T ;.=.;.T % % . . ", ". . % % >.,.'.R R R R R ).# R R R R R # ).R R R R R '.S % % . . ", ". . % % % , # !.M M M M ~.$.] M M M M {.R ].M M M M ^.@ % % . . ", ". . % % % % % % % % % % % % % % % % % % % % % % % % % % % % . . ", ". . % % % % % % % % % % % % % % % % % % % % % % % % % % % % . . ", ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . ", ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . "}; gWidgetsRGtk2/inst/images/scatterplot3d.xpm0000644000175100001440000000077311406427003020466 0ustar hornikusers/* XPM */ static char * g_scatter3d_xpm[] = { "20 16 3 1", " c #FFFFFFFFFFFF", ". c #000000000000", "X c #00000000FFFF", " ........ ", " . . ...... ", " . . XXX . ", " . . X XXX . ", " . . XXX X . ", " . XXX. XXX XXX . ", " . X . XXX XXX . ", " . XXX. X XXX . ", " . XXX. XXX X . ", " . XXX. XXX . ", " . X.............. ", " . XXX . ", " . . . ", " .. . ", " ....... . ", " ...... "}; gWidgetsRGtk2/inst/images/larrow.xpm0000644000175100001440000000267511406427003017204 0ustar hornikusers/* XPM */ static char * larrow_xpm[] = { "20 19 64 1", " c None", ". c #FFFFFF", "+ c #F7F7F7", "@ c #EFEFEF", "# c #E6E6E6", "$ c #E6DEDE", "% c #DEDEDE", "& c #DED6D6", "* c #D6D6D6", "= c #D6CECE", "- c #CECECE", "; c #CECEC5", "> c #C5C5C5", ", c #C5C5BD", "' c #C5BDBD", ") c #BDBDBD", "! c #BDBDB5", "~ c #B5B5B5", "{ c #B5B5AD", "] c #B5ADAD", "^ c #ADADAD", "/ c #ADADA5", "( c #ADA5A5", "_ c #A5A5A5", ": c #9C9C9C", "< c #9C9494", "[ c #949494", "} c #94948C", "| c #948C8C", "1 c #8C8C8C", "2 c #8C8C84", "3 c #8C8484", "4 c #848484", "5 c #8C7B84", "6 c #847B7B", "7 c #7B7B7B", "8 c #7B7373", "9 c #737373", "0 c #73736B", "a c #7B6B73", "b c #736B6B", "c c #7B636B", "d c #6B6B6B", "e c #6B6B63", "f c #6B6363", "g c #6B5A63", "h c #DE107B", "i c #CE1073", "j c #525252", "k c #5A4A52", "l c #5A4A4A", "m c #524A4A", "n c #A5195A", "o c #4A4A4A", "p c #4A4A42", "q c #AD1063", "r c #9C195A", "s c #8C2152", "t c #A5105A", "u c #4A4242", "v c #842152", "w c #523A42", "x c #4A313A", "y c #52293A", " 'akkka]+ ", " 'k6>%%*)1k< ", " g4####%%**-:| ", " [-#@@@##%%=-,^g ", " |~%@+++@##*ak->0' ", "+k#@++ ++@5yqw->>k ", "]<#@+ >8' ", "a>#@++(xrhhhiw->>_a ", "k%##^wshhhhhiw->>)k ", "k%%mvhhhhhhhiw->>)k ", "k*%%5xnhhhhhiw;>))k ", "a~*%%%6xnhhhiw>>)_c ", "'6***%%*8ynhiw>))6] ", " k-=*****-cynw')!k+ ", " '8-------;)gl)][< ", " g^)>>>>>>>))!_| ", " |:>>>>>)))~bg ", " |k4()))_9k' ", " +]akkka' "}; gWidgetsRGtk2/inst/images/larrow.gif0000644000175100001440000000075011406427003017135 0ustar hornikusersGIF89aŽŽ{{{{{{{sssssssk{ksskk{ckkkkkkckcckZc{sRRRZJRZJJRJJZJJJJJBcZ!RZJBB!RR:BJ1:R):J):! ,&$Ȑ  8 0$!c(AX08t<`0 ' |s 0nj..X0"ETq٬M-@ (  0B!i<.-#!}(R`-3=!&?0i = ` ;2_ 8<&7= #ΓCB06> ?0LE%0&dZ 0P-A'.Tn`!`G‘$;gWidgetsRGtk2/inst/images/arrows.xpm0000644000175100001440000000077011406427003017205 0ustar hornikusers/* XPM */ static char * g_flux3d_xpm[] = { "20 16 3 1", " c #FFFFFFFFFFFF", ". c #000000000000", "X c #00000000FFFF", " ........ ", " . ...... ", " . X . ", " . X . ", " . XXX XXXXX . ", " . XX X . ", " . X X X . ", " . X XXX XXX . ", " . XX XX . ", " . X X X X . ", " . XXX X X . ", " . XX X X . ", " . X X X . ", " . X . ", " ....... . ", " ...... "}; gWidgetsRGtk2/inst/images/lines.xpm0000644000175100001440000000104111406427003016772 0ustar hornikusers/* XPM */ static char * g_lines_xpm[] = { "20 16 5 1", " c #FFFFFFFFFFFF", ". c #000000000000", "X c #00000000FFFF", "o c #FFFF00000000", "O c #00007DF70000", " ", "....................", ". .", ". X XX o .", ". X XX o .", ". X XX oo .", ". XXX oo O .", ". ooo OO .", ". ooo OO .", ". oooo OO .", ". OOO .", ". OOO .", ". OOO .", ". .", "....................", " "}; gWidgetsRGtk2/inst/images/symbol_none.xpm0000644000175100001440000000073511406427003020215 0ustar hornikusers/* XPM */ static char * symbol_none_xpm[] = { "18 18 1 1", " c #FFFFFFFFFFFF", " ", " ", " ", " ", " ", " ", " ", " ", " ", " ", " ", " ", " ", " ", " ", " ", " ", " "}; gWidgetsRGtk2/inst/images/symbol_dntriangle.xpm0000644000175100001440000000077011406427003021404 0ustar hornikusers/* XPM */ static char * symbol_dntriangle_xpm[] = { "18 18 2 1", " c #FFFFFFFFFFFF", ". c #000000000000", " ", " ", " ", " ", " .......... ", " .......... ", " . . ", " .. .. ", " . . ", " .. .. ", " . . ", " .... ", " .. ", " .. ", " ", " ", " ", " "}; gWidgetsRGtk2/inst/images/plot.xpm0000644000175100001440000000101611406427003016640 0ustar hornikusers/* XPM */ static char * g_lpoints_xpm[] = { "20 16 4 1", " c #FFFFFFFFFFFF", ". c #000000000000", "X c #FFFF00000000", "o c #00000000FFFF", " ", "....................", ". .", ". XXoo .", ". oo ooX .", ". oo X .", ". X oo .", ". X oo .", ". X X .", ". oo X .", ". oo X .", ". X X.", ".XX .", ". .", "....................", " "}; gWidgetsRGtk2/inst/images/curve.xpm0000644000175100001440000000511611406427003017013 0ustar hornikusers/* XPM */ static char * plot_icon_xpm[] = { "48 48 4 1", " c #FFFFFFFFFFFF", ". c #000000000000", "X c #00000000FFFF", "o c #FFFF00000000", " ", " .. ", " . ................................. ", " .. . . ", " . . . ", " .. . ", " . . . ", " .. . . ", " .. ... . . ", " . . XX XX . ", " . . . X X . X X o. ", " . . .. X X X oo . ", " . . X X . X o X . ", " . .. . X X X o X. ", " . ..X X . X o X. ", " . . X X oo X. ", " .X X . o . ", " .X X oX . ", " .. .X X . o X . ", " .. X X oo X . ", " . ... . . . .X. . . o . X . . . . . ", " . X o X . ", " . X oo X . ", " .. X o X . ", " . o . X . ", " .. . oo X . ", " . .. o X . X......... . ", " .. . o X X. . . ", " . oo X . X . X ... .. . ", " .. o X X . .. . ", " . o X. X . .. . ", " .. . oo XX . o ... .. . ", " . ..o . . .. . ", " . .o .......... . ", " . . ........ . ", " .. . ", " . . . . . . . . . ", " . . . . . . . . . . . . . . . . . . ", " . . ................................. ", " . ", " . . .. .. .. . . . . ", " . . . .. .. . . .. . .. ", " . . . . . . ... . . ", " ", " . . ", " . ", " . . ", " "}; gWidgetsRGtk2/inst/images/symbol_plus.xpm0000644000175100001440000000076211406427003020241 0ustar hornikusers/* XPM */ static char * symbol_plus_xpm[] = { "18 18 2 1", " c #FFFFFFFFFFFF", ". c #000000000000", " ", " ", " ", " ", " .. ", " .. ", " .. ", " .. ", " .......... ", " .......... ", " .. ", " .. ", " .. ", " .. ", " ", " ", " ", " "}; gWidgetsRGtk2/inst/images/pch2.xpm0000644000175100001440000000234311406427003016522 0ustar hornikusers/* XPM */ static char * pointers_xpm[] = { "32 32 2 1", " c #000000000000", ". c #FFFFFFFFFFFF", " ", " ", " ............................ ", " ............................ ", " ............. ............. ", " ............. ............. ", " ............. ............. ", " ............. ............. ", " ...... ...... ", " ....... ....... ", " ........ ........ ", " ......... ......... ", " .......... .......... ", " ........... ........... ", " ............ ............ ", " ............. ............. ", " ............. ............. ", " ............ ............ ", " ........... ........... ", " .......... .......... ", " ......... ......... ", " ........ ........ ", " ....... ....... ", " ...... ...... ", " ............. ............. ", " ............. ............. ", " ............. ............. ", " ............. ............. ", " ............................ ", " ............................ ", " ", " "}; gWidgetsRGtk2/inst/images/integer.xpm0000644000175100001440000000146111406427003017323 0ustar hornikusers/* XPM */ static char * numeric_xpm[] = { "24 24 4 1", " c None", ". c #965896589658", "X c #CF3CCF3CCF3C", "o c #000000000000", " ", " ", " ", " ", " ", " ", " ", " ", " ooo ooo ", " oX Xo ", " o o ", " o ", " o o ", " oX Xo o. ", " ooo ooo o oX ", " oX ", " oooo ", " ", " ", " ", " ", " ", " ", " "}; gWidgetsRGtk2/inst/images/function.xpm0000644000175100001440000000105211406427003017507 0ustar hornikusers/* XPM */ static char * function_small_xpm[] = { "19 19 3 1", " c None", ". c #965896589658", "X c #000000000000", " ", " ", " . ", " XXX. ", " .X XX ", " XX .X ", " .X. ", " .X X X ", " XXXXX X X ", " XX .X X X X.", " .X. .X XX X.", " .X .X XX X.", " X. XX .X X X X.", " XX X. X X ", " .XXX X X ", " . ", " ", " ", " "}; gWidgetsRGtk2/inst/images/contour.xpm0000644000175100001440000000114211406427003017353 0ustar hornikusers/* XPM */ static char * g_contour_xpm[] = { "20 16 8 1", " c #00000000FFFF", ". c #0000FFFFFFFF", "X c #00007DF70000", "o c #0000FFFF0000", "O c #FFFFFFFF0000", "+ c #FFFF00000000", "@ c #861700000000", "# c #000000009E79", " ..XXXXXXXXX..... ", " ..XXoooooXXXXXXX.. ", "..XXooOOOoooooooXX..", ".XXooOO++OoooooooXX.", ".XXoOO+@@+OOOOOOooXX", ".XXOO+@@@++++++OOooo", ".XoOO++@+++@@@@+OOOo", ".XooO++@@@@@@@++OOOo", ".XXoOOO++++++++OOooo", ".XXoooOO++OOOOOOoooX", ".XXXooOOOOOooooooXXX", "..XXoooooOOoooooXX..", " ..XXooooooXXXXX....", " ...XXXXXXXXXX... ", " ....XXX...... #", "## ........ ###"}; gWidgetsRGtk2/inst/images/numeric.xpm0000644000175100001440000000146111406427003017330 0ustar hornikusers/* XPM */ static char * numeric_xpm[] = { "24 24 4 1", " c None", ". c #965896589658", "X c #CF3CCF3CCF3C", "o c #000000000000", " ", " ", " ", " ", " ", " ", " ", " ", " ooo ooo ", " oX Xo ", " o o ", " o ", " o o ", " oX Xo o. ", " ooo ooo o oX ", " oX ", " oooo ", " ", " ", " ", " ", " ", " ", " "}; gWidgetsRGtk2/inst/images/uarrow.xpm0000644000175100001440000000270111406427003017203 0ustar hornikusers/* XPM */ static char * uarrow_xpm[] = { "19 20 64 1", " c None", ". c #FFFFFF", "+ c #F7F7F7", "@ c #EFEFEF", "# c #E6E6E6", "$ c #E6DEDE", "% c #DEDEDE", "& c #DED6D6", "* c #D6D6D6", "= c #D6CECE", "- c #CECECE", "; c #CECEC5", "> c #C5C5C5", ", c #C5C5BD", "' c #C5BDBD", ") c #BDBDBD", "! c #BDBDB5", "~ c #B5B5B5", "{ c #B5B5AD", "] c #B5ADAD", "^ c #ADADAD", "/ c #ADADA5", "( c #ADA5A5", "_ c #A5A5A5", ": c #9C9C9C", "< c #9C9494", "[ c #949494", "} c #94948C", "| c #948C8C", "1 c #8C8C8C", "2 c #8C8C84", "3 c #8C8484", "4 c #848484", "5 c #8C7B84", "6 c #847B7B", "7 c #7B7B7B", "8 c #7B7373", "9 c #737373", "0 c #73736B", "a c #7B6B73", "b c #736B6B", "c c #7B636B", "d c #6B6B6B", "e c #6B6B63", "f c #6B6363", "g c #6B5A63", "h c #DE107B", "i c #CE1073", "j c #525252", "k c #5A4A52", "l c #5A4A4A", "m c #524A4A", "n c #A5195A", "o c #4A4A4A", "p c #4A4A42", "q c #AD1063", "r c #9C195A", "s c #8C2152", "t c #A5105A", "u c #4A4242", "v c #842152", "w c #523A42", "x c #4A313A", "y c #52293A", " 'akkka]+ ", " 'k6~*%%>>-*%%xhw+ ++@#k ", "]4>>-*%6nhs( +@#6'", "a(>>-**xhhhx ++@#>a", "k)>>-*8nhhhr<+@##%k", "k)>>--yhhhhhx@##%%k", "k))>;cnhhhhhn5#%%*k", "a_)>)yhhhhhhhy*%*)a", "'9))gniiiiiiiqa=*1]", " k~)lwwwwwwwwwk--k+", " 'b!)'>>;------,:< ", " g_]))>>>>>>>>^| ", " |[!)))>>>>>0g ", " c #363326", ", c #B5AC80", "' c #9F9770", ") c #4F4B38", "! c #050403", "~ c #605B44", "{ c #ADA57A", "] c #A09770", "^ c #BFB586", "/ c #908966", "( c #14130E", "_ c #13120D", ": c #3A3729", "< c #8B8462", "[ c #7C7657", "} c #ACA479", "| c #343124", "1 c #4D4936", "2 c #3C392A", "3 c #B4AB7F", "4 c #B5AD80", "5 c #1E1C15", "6 c #0F0E0A", "7 c #3C392B", "8 c #211F17", "9 c #333024", "0 c #615C45", "a c #847D5D", "b c #99916C", "c c #C3BA8A", "d c #8F8965", "e c #8C8663", "f c #A79E76", "g c #3D3A2B", "h c #15140E", "i c #ABA379", "j c #CCC290", "k c #CEC492", "l c #D0C693", "m c #D1C793", "n c #CFC593", "o c #CAC18F", "p c #8E8865", "q c #C8BF8E", "r c #D1C794", "s c #D4CA96", "t c #CDC491", "u c #D5CB97", "v c #D2C894", "w c #948D68", "x c #201F16", "y c #5C5841", "z c #BFB687", "A c #C9BF8E", "B c #C7BD8D", "C c #A29A72", "D c #A8A076", "E c #D3C995", "F c #C3B989", "G c #3F3C2C", "H c #5D5942", "I c #C0B788", "J c #C5BC8B", "K c #A19971", "L c #CCC390", "M c #CAC08E", "N c #C0B787", "O c #3E3B2C", "P c #1F1D16", "Q c #403D2D", "R c #B2A97D", "S c #CEC592", "T c #C2B989", "U c #C5BB8B", "V c #9C946E", "W c #3F3C2D", "X c #A49C74", "Y c #CBC18F", "Z c #CFC693", "` c #CFC592", " . c #CDC390", ".. c #C7BE8C", "+. c #817B5B", "@. c #69634A", "#. c #BCB385", "$. c #A59D74", "%. c #B1A97D", "&. c #C7BE8D", "*. c #C6BD8C", "=. c #A9A177", "-. c #ADA47A", ";. c #4A4634", ">. c #69644A", ",. c #BDB485", "'. c #5D5841", "). c #5C5740", " ", " ", " . . . ", " + @ # $ % ", " + & * = - ; > ", " . + , = ' ) ! ", " . ~ { ] ^ / ( _ : : ", " . < [ } | 1 . 2 3 4 5 6 7 ", " 8 ( 9 0 4 a b c c d e f g ", " h i j k l m n o p 6 ", " 6 < q r s t l u v w x ", " y z A r B C D l E j F G ", " H I q m J K C L v M N O ", " P Q R S v T U m S V W ( ", " . X Y S Z ` ...+.. ", " @.#.$.%.&.*.=.X -.;. ", " >.. W z ,.P _ ) ", " P '.).6 ", " ", " "}; gWidgetsRGtk2/inst/images/factor.xpm0000644000175100001440000000144211406427003017143 0ustar hornikusers/* XPM */ static char * factor_xpm[] = { "24 24 4 1", " c None", ". c #965896589658", "X c #CF3CCF3CCF3C", "o c #000000000000", " ", " ", " ", " X..X ", " .ooooX ", " .oXXoo ", " oo .o ", " Xo. ", " .oX ", " oo ", " oooooo ", " X.o.XX ", " .oX ", " o.X ", " o. ", " .o. ", " .oX ", " X oo ", " o.Xo. ", " oooo ", " oo ", " ", " ", " "}; gWidgetsRGtk2/inst/images/dataframe.xpm0000644000175100001440000000507211406427003017614 0ustar hornikusers/* XPM */ static char * sheet_icon_xpm[] = { "48 48 3 1", " c #FFFFFFFFFFFF", ". c #000000000000", "X c #D6D6D6D6D6D6", " ", " ........................................... ", " .XXXXXXXXXXXXX.XXXXXXXXXXXXX.XXXXXXXXXXXXX. ", " .XXXXXXXXXXXXX.XXXXX...XXXXX.XXXX....XXXXX. ", " .XXXXXXXXXXXXX.XXXX.XXX.XXXX.XXXX.XXX.XXXX. ", " .XXXXXXXXXXXXX.XXXX.....XXXX.XXXX....XXXXX. ", " .XXXXXXXXXXXXX.XXXX.XXX.XXXX.XXXX.XXX.XXXX. ", " .XXXXXXXXXXXXX.XXXX.XXX.XXXX.XXXX....XXXXX. ", " .XXXXXXXXXXXXX.XXXXXXXXXXXXX.XXXXXXXXXXXXX. ", " ........................................... ", " .XXXXXXXXXXXXX. . . ", " .XXXXXX.XXXXXX. . . ", " .XXXXXX.XXXXXX. . . ", " .XXXXXX.XXXXXX. . . ", " .XXXXXX.XXXXXX. . . ", " .XXXXXXXXXXXXX. . . ", " ........................................... ", " .XXXXXXXXXXXXX. . . ", " .XXXXX....XXXX. . . ", " .XXXXXXX..XXXX. . . ", " .XXXXX..XXXXXX. . . ", " .XXXXX....XXXX. . . ", " .XXXXXXXXXXXXX. . . ", " ........................................... ", " .XXXXXXXXXXXXX. . . ", " .XXXXX....XXXX. . . ", " .XXXXXX..XXXXX. . . ", " .XXXXXXXX.XXXX. . . ", " .XXXXX....XXXX. . . ", " .XXXXXXXXXXXXX. . . ", " ........................................... ", " .XXXXXXXXXXXXX. . . ", " .XXXXX.XX.XXXX. . . ", " .XXXXX....XXXX. . . ", " .XXXXXXXX.XXXX. . . ", " .XXXXXXXX.XXXX. . . ", " .XXXXXXXXXXXXX. . . ", " ........................................... ", " .XXXXXXXXXXXXX. . . ", " .XXXXX....XXXX. . . ", " .XXXXX...XXXXX. . . ", " .XXXXXXXX.XXXX. . . ", " .XXXXX....XXXX. . . ", " .XXXXXXXXXXXXX. . . ", " ........................................... ", " ", " ", " "}; gWidgetsRGtk2/inst/images/cloud.xpm0000644000175100001440000000077111406427003016777 0ustar hornikusers/* XPM */ static char * g_surface_xpm[] = { "20 16 3 1", " c #FFFFFFFFFFFF", ". c #000000000000", "X c #00000000FFFF", " ........ ", " . . ...... ", " . XXXXX . ", " . XXXXXXXXX . ", " . XXXXXXXXXXXXXXX ", " . XXXXXXXXXXXXXXX. ", " . XXXXXXXXXXXXXX . ", " . XXXXXXXXXXXXXX . ", " .XXXXXXXXXXXXXXX . ", " XXXXXXXXXXXXXXX . ", " XXXXXXXXXXXXXX.... ", " . . XXXXXXXX . ", " . . XXXXXX . ", " .. . ", " ....... . ", " ...... "}; gWidgetsRGtk2/inst/images/symbol_impulse.xpm0000644000175100001440000000076511406427003020737 0ustar hornikusers/* XPM */ static char * symbol_impulse_xpm[] = { "18 18 2 1", " c #FFFFFFFFFFFF", ". c #000000000000", " ", " ", " ", " ", " .. ", " .... ", " .... ", " .. ", " .. ", " .. ", " .. ", " .. ", " .. ", " .. ", " ", " ", " ", " "}; gWidgetsRGtk2/inst/images/symbol_circle.xpm0000644000175100001440000000076411406427003020521 0ustar hornikusers/* XPM */ static char * symbol_circle_xpm[] = { "18 18 2 1", " c #FFFFFFFFFFFF", ". c #000000000000", " ", " ", " ", " ", " .... ", " ........ ", " .. .. ", " .. .. ", " .. .. ", " .. .. ", " .. .. ", " .. .. ", " ........ ", " .... ", " ", " ", " ", " "}; gWidgetsRGtk2/inst/images/calendar.xpm0000644000175100001440000003057611406427003017450 0ustar hornikusers/* XPM */ static char *calendar[] = { /* width height num_colors chars_per_pixel */ " 115 36 256 2", /* colors */ ".. c #040204", ".# c #5c89bc", ".a c #7cc2ec", ".b c #841e04", ".c c #b4828f", ".d c #2c4884", ".e c #b4a6bc", ".f c #9c563c", ".g c #64a2cc", ".h c #c4c2c4", ".i c #e4e4dc", ".j c #d4522c", ".k c #5c0204", ".l c #dca2bc", ".m c #8c86ac", ".n c #44629c", ".o c #2c2224", ".p c #e4c6bc", ".q c #dc8a94", ".r c #847674", ".s c #240204", ".t c #6c6a6c", ".u c #a4a2b1", ".v c #d4d2d9", ".w c #9492b0", ".x c #d4728c", ".y c #b4b2bc", ".z c #c46a44", ".A c #e4b29c", ".B c #040236", ".C c #b490ac", ".D c #e4f2fc", ".E c #5c96c4", ".F c #bc3a1c", ".G c #7c4e3c", ".H c #64628c", ".I c #acaab9", ".J c #1c2464", ".K c #bc6e7c", ".L c #ec6e64", ".M c #cc9cb4", ".N c #84628c", ".O c #cccacc", ".P c #f4a68c", ".Q c #a48a7c", ".R c #dcdad7", ".S c #9c96a4", ".T c #647aac", ".U c #7482ac", ".V c #8c4e34", ".W c #cca28c", ".X c #e4deec", ".Y c #846e94", ".Z c #04164f", ".0 c #444244", ".1 c #fceefc", ".2 c #4c77ac", ".3 c #ccb2a4", ".4 c #f4f2f4", ".5 c #0c161c", ".6 c #ac5654", ".7 c #74b2d7", ".8 c #e4eaf4", ".9 c #dcaeb8", "#. c #e49274", "## c #bcbacb", "#a c #fcb6ac", "#b c #bc99b4", "#c c #243874", "#d c #747291", "#e c #4c362c", "#f c #fcc6b4", "#g c #a4a2bc", "#h c #a4aec4", "#i c #e4764c", "#j c #848294", "#k c #1c0204", "#l c #b492a4", "#m c #c4c2d4", "#n c #e46234", "#o c #9c86ac", "#p c #d4764c", "#q c #34265c", "#r c #dcdae4", "#s c #9c9eb8", "#t c #847aa4", "#u c #141650", "#v c #544274", "#w c #5c7cac", "#x c #f4fafc", "#y c #7c7aa1", "#z c #6c222c", "#A c #f4cab4", "#B c #040221", "#C c #9c3244", "#D c #c4a6b4", "#E c #8c8ea4", "#F c #2c3234", "#G c #241654", "#H c #d4d4e4", "#I c #8c9abc", "#J c #649ac4", "#K c #d43634", "#L c #644e7c", "#M c #d4cedc", "#N c #a486ac", "#O c #b43a1c", "#P c #d4a2b6", "#Q c #ecaea0", "#R c #f4bac4", "#S c #848aa4", "#T c #ccc6d9", "#U c #8c5254", "#V c #6cabd4", "#W c #e4e4ec", "#X c #c4666c", "#Y c #ec8274", "#Z c #946e6c", "#0 c #b4b5cc", "#1 c #040247", "#2 c #c492ac", "#3 c #242e6c", "#4 c #d49ad4", "#5 c #ccccdc", "#6 c #547eb4", "#7 c #b45e6c", "#8 c #74bae4", "#9 c #eceae4", "a. c #fc927c", "a# c #bcc2d4", "aa c #b45ab4", "ab c #4c3a74", "ac c #a43224", "ad c #7c7e7c", "ae c #a47a9c", "af c #b44a54", "ag c #dc463c", "ah c #d476cc", "ai c #fcd2d4", "aj c #545484", "ak c #3c0204", "al c #642a3c", "am c #fc7e64", "an c #cc7e74", "ao c #ecb2c4", "ap c #942a74", "aq c #745684", "ar c #5c6a9c", "as c #cc969c", "at c #ac6244", "au c #7c668c", "av c #9c728c", "aw c #dc6a41", "ax c #bc7a5c", "ay c #7c6254", "az c #9c4644", "aA c #d4aea4", "aB c #341634", "aC c #dc574c", "aD c #2c022c", "aE c #f45a44", "aF c #8c5a64", "aG c #ec8e84", "aH c #dc766c", "aI c #84cef4", "aJ c #c4827c", "aK c #e4beac", "aL c #fccbd4", "aM c #fcdedc", "aN c #c43a3c", "aO c #6c92c4", "aP c #7c525c", "aQ c #e49a8c", "aR c #141e5c", "aS c #7c2224", "aT c #5c568c", "aU c #9c7674", "aV c #bc624c", "aW c #b4aec4", "aX c #4c4a7c", "aY c #ac8aac", "aZ c #f4beac", "a0 c #9c9ab6", "a1 c #8c4a4c", "a2 c #fcc2cc", "a3 c #8482ac", "a4 c #7c769c", "a5 c #5c8ebc", "a6 c #342234", "a7 c #fca699", "a8 c #949aac", "a9 c #6ca6d4", "b. c #24225c", "b# c #f46c5c", "ba c #8c6694", "bb c #e4aabc", "bc c #c498b1", "bd c #aca6bc", "be c #acacc7", "bf c #3c2a64", "bg c #8c7ca0", "bh c #fcfdfc", "bi c #fccebc", "bj c #343637", "bk c #ac84a4", "bl c #344a84", "bm c #bc92ac", "bn c #d49ab4", "bo c #6c7eac", "bp c #5476ac", "bq c #bcbdd4", "br c #ec784c", "bs c #bc8ea4", "bt c #eceef4", "bu c #543e74", "bv c #e44a3c", "bw c #945e64", "bx c #f48a84", "by c #4c6294", "bz c #ecf2f9", "bA c #7c82a4", "bB c #4c423c", "bC c #141614", "bD c #a49eb4", "bE c #1c164c", "bF c #bcaebc", "bG c #040214", "bH c #6496c4", "bI c #04022c", "bJ c #8c8eb4", "bK c #ac3224", "bL c #fcbeac", "bM c #dca6ba", "bN c #8c8aa8", "bO c #a4a6b4", "bP c #d4d6d4", "bQ c #9496ac", "bR c #b4b6c4", "bS c #646694", "bT c #acaebc", "bU c #ccced4", "bV c #dcdedc", "bW c #f4f6fc", "bX c #74b6dc", "bY c #a4a6c2", "bZ c #c4c6d8", "b0 c #dcdeea", "b1 c #847e9c", "b2 c #7c7e9c", "b3 c #c4aabc", "b4 c #649ecc", "b5 c #d4a6bc", "b6 c #f4becc", "b7 c #947264", "b8 c #fc9684", "b9 c #8486aa", /* pixels */ "......................................................................................................................................................................................................................................", "......................................................................................................................................................................................................................................", "......................................................................................................................................................................................................................................", "......................................................................................................................................................................................................................................", "..........................................................................................................................................bGbGbG#BbIbI#B.Z.Z.Z.Z#1#1.B..............bCbCbCbCadadadadbCbCbC............................", "............................................................................................................................#B#B#B.B#1.B#1#c#c#c.#.#.##6aIaIaIaI.d.d.dbGbGbGbG.s#k.saUaUaUaU.1.1.1.1#4#4#4a6a6a6a6....................", "......................................................................................................#BbG#B.B.B.B.B.JaR.J.J.n.n.nb4b4b4b4.a.a.a#8.a.a.aaO.#aO.#aTajaT#B#B#B#B.6.6.6#Q#Q#Q#Q.x.x.x.xahahahaaaaaaaaaBaBaB..............", "................................................................................bGbGbGbGbIbI#B.Z.Z.Z.Z.dbl.d.#.#.#.#bXbXbXbX#V#V#VbHbHbHbH.T#w#w.Y.Y.Yau.lb5.l.lasas#2#z#z#z#zbibi#f.3aAaA.3#Zb7b7#ZafafafapapapapaDaDaD..............", "..................................................................#B#B#B.B.B.B.B#3#c#3#c.2.2.2#Va9a9#VbXbXbX.E.E#J.E#w#w#w#w.U.U.UbZ#TbZ#T#W#W#W#b#b#b#b.9bb.9.9#U#U#U#Q#Q#Q#QaKaKaK.t.t.t.t.0bBbB.0#p#p#pbKbKbKbK#k#k#k..............", "............................................bGbGbGbGbI.BbIaRaRaR#u.n.n.nb4b4b4b4bXbXbXbX.ga9.g#w#6#w#6bobobo#0#0#0#0#r#r#r#r#m###mbhbhbhbhbhbhbhbdbdbdbdaFaFaFaFananan#fbibibi.r.r.r#F#F#F#Fatatatataw#naw.k.k.k.k....................", "............................................bGbGbGbG.B.BbIaRaRaRaR.n.n.nb4b4b4b4.7.7bX.7.g#V.g#6#w#6#6bobobo#0#0#0#0#r#r#r#r###m##bhbhbhbhbhbhbhbdbdbdbdaFaFaFaFananan#Abi#A#f.r.r.rbj#F#Fbjatatatatawawaw.k.k.k.k....................", "..............................#B#B#B.Z.Z.Z.Z.d.d.d.da5a5.#.7.7#V.7#V#V#V.#.#.#.#.Tbp#w#wbYbY#h.v#H.v.v######bhbhbhbhbhbhbhbh#m#m#mb0.X#Wb0#5.O#T#d#d#d#dazazazaz#fbibi.Q.Q.Q.Q#F#F#F.G.V.G.G#i#i#iaw.b.b.b............................", ".................B.B.B#3#3#3#3.2.2.2.7#V.7.7#V.7#V.7.E.E.Ebpbpbpbp#I#I#Ia#.h#m#m#0#0bF#0bhbhbhbhbhbhbh#m#T#m#W#W.X#W#rb0#r#ra0a0a0bNb9.m.mbTbTbTa1a1a1a1#aaK#aaZ.W.W.Wbjbjbjbj#e#e#e#i#iaw#i#ObK#O#O#k#k#k............................", ".................J.J.JbX#8bX#8b4.gb4.2.2.2.2ararararb9b9b9.m.m.mbNbWbWbhbhbhbhbh#5#M#5#5#Wb0#W#W#W#W#W#g#g#gbNb9bJbNbZbZ#TbZ#W#W#WbYbObY.u#Z#Z#ZaQ#.aQaQ.A.A.A.A.0.0.0.o.o.o.o.z.zaV.j.j.j.jakakakak..................................", ".................B#1.BbybybybybAb2bA#y#y#yad########.i.i#9.y##.y##.R.v#H.4btbt.4aW#0aW#0a3a3b9#mbq#mbqb0b0b0bq#0bqbqbhbhbhbhbhbhbh.u.u.u.uaJaJaJaZaZaZaZayayayay.5.5.5.f.f.f.f#n#n#naSaSaSaS#B#B#B#B..................................", "................#B#B#Ba4a4a4a4#9#9#9.h.O.O.ObObObObO.O.O.ObQ.wbQ.w#y#y#y#########H#H#5#H#0#0#0bhbhbhbhbWbhbh#Db3#D#D.X#W.X#W#W#W#W#jbAadb2.p.p.pbL#A#fbLaxaxaxax.V.V.Vawawawawacacac.c.c.c.c#GbE#GbE..................................", "......................aXaXaXaXbPbPbPbO.u.u.u.H.H.H.Ha0a8a0.h.h#m.hbebeaWbWbWbWbWbhbhbhbh#5#5#5#Y#Y#Y#Ybvbvbv#K#K#K#KaCaCaCaC##bR##.I.I.I.IaA#PaA#A#A#A#A.PaQ.P.Pbrbrbr.F.F.F.FbwbwaFbsaY.c.Cabababab#B#B#B............................", "......................#u#u#u#ubgbgbg.Cbs.C.CaYaYaYaYbWbWbWbhbhbhbh#M#5#5.Xb0.X.Xbt.4bzbtaGaGaGaNaNaNaN.e#D.eb0b0bVb0.L.L.L.L#a#a#a.O.O.O.O.q.q.qbxbxbxbx#.#.#.#.aVaVaValalalalavavav#Pb5b5#Pasbnbcbc.B#1#1............................", "......................#B#B#BbI#2#2#2aLaiaiaibMbMbMbM.v.v.vbW.4bWbW#mbZbZa3a3a3bA###0###0aCaCaC.C#l#l#lbhbhbhbhbhbhbha7a7a7a7b8b8b8bU.ObU.O#7#7#7#C#C#C#CaP#UaPaP.S.S.S.S#s#s.SbM.lbMbiaLaLaLaLa2aLaLbubububGbGbGbG....................", "......................bI.BbIbI#2#2#2aiaiaiaibMbMbMbM.v#H#H.4.4.4.4#m#m#ma3bAa3b9#0###0##aCaCaC#l#l#l#lbhbhbhbhbhbhbha7a7a7a7b8b8b8bUbUbUbU#7#7#7#C#C#C#CaPaPa1aP.S.S.SbDbD#sbDbMbMbMa2aLaLaLaLaLaLaL#v#vbubGbGbGbG....................", "......................#B#B#B#B.NbabaaLaLaLa2bn.Mbn.M#t#t#y#0#0#0#0bZ#mbZbebebebebhbhbhbWamamamb3bFb3b3.D.D.Da7a7a7a7b#b#b#b##X#X#XbT#h#h#h.ybTbT#E#E#EbN.X.R#r.RbWbh.4btbt#9bz#lbm.Ca2a2a2a2bbbb.9bbaqaqaq.B.B.BbI....................", "..............................#q#q#qaYbsaY.Cbm#2bm#2#o#N#NbWbW#xbWbhbhbh#5bZ#5bZbz.Dbzbza.a.a.aHaHaHaH.K.K.KaEaEaEaEaCaCaCaC.c.c.c#x#xbh#xbhbhbh#r.X#r#r#5#5#5#5bhbhbhbtbzbzbzbg#t.mau.Nauaub1b1b1b1#s.u#sb..Jb..J....................", "...............................B#1#1bbbbbbbbaiaiaLai.M.M.M#Wb0#W#Wbhbhbh#5#5#5#5bJbJb9bJbFbFbFb#b#b#b#agagagaMaMaMaMbhbhbhbhbZbZbZb0b0b0b0bhbhbh#9#Wbt#W.wbJbJ.w#gbO.ua0.Sa0a0b9#S.ma8a8a8bQ.ib0.ib0#9.i.i#d#d#d#d#B#B#B..............", "..............................bIbIbIbkbkbkbkaLaLaiaLbn#P#P.mbNbN.m#0#0#0aW#0aW#0#s#s#s#sbWbW.4bhbhbhbhbqa#.h.8.8.8btbhbhbhbh#W.i#W.w.w.w.w.Ibebe#s#sa0#s#d#da4#d.I.I.I.R.RbP.RbP.v.vbQbQbQbQ.RbV.R.R.i.i.ibY.IbdbY#1#1#1..............", "..............................bGbGbGbububububsbmbsbmbkbkbk#o#o#o#obz.4btbhbhbhbh#m#m#m#mbtbtbtbhbhbhbhb0b0b0#sbD#s#s#0##.y#0bebebe#y#y#y#ybT.ybT.RbP.RbP.ha#.h.ha0#sa0.i.i.i.i.i.i.i.w.w.w.wb2#yb2#yajajaj#u#u#u#u.B.B.B..............", "....................................bE#GbE#GaoaoaoaoaiaLaLbmbm#bbmbtbtbtbhbhbhbh#r#H#r#H#gbY#g#####0##.Ibebeb9b9b9.mb0#rb0.Xbhbhbh#HbU#H.vbTaWbT.i.i.i.i.R.R.RbP#E#E#E#S#EbNbNajaXaj#u#u#u#ubIbIbIbIbG#BbG............................", ".....................................B.B.B.B#P#P#P#PaLaiaibMbM.lbMbebebe##bqbq##bYbYbYbdb9.mb9b0b0.Xb0bhbhbh#m#m#ma##9#W#Wbtbhbhbhbhbhbhbh.wbQbQbQbQbQbQajajajaj#u#u#ubIbI#BbI..bG....................................................", "....................................#B#B#B#Bau.N.N.Nbcbcbcaeaeaeae#t#t#tb0b0b0b0bhbWbh#x#mbq#m.4.4bW.4bhbhbhbtbtbtbtbe#0aWaW#0#0#0bS.HbS.H#u#u#ubIbIbIbIbGbGbGbG......................................................................", "....................................#B#B#B#B.N.Nau.N#bbc#baeaeaeae#t.Y#tb0#Wb0.XbhbWbhbW#mbq#m.4bW.4.4bhbhbhbtbtbtbtaWbebeaW#0#0#0.HbSbSbS#u#u#ubI.BbIbIbGbGbGbG......................................................................", "............................................bfbfbfbfbbbbbba2b6a2b6#b#b#b#xbW#x#xbhbhbhbhb0#Wb0a#bqa##m#0#0##bS.HbS.H#u#u#u#u.B.B.BbG#BbGbG............................................................................................", "............................................#ubE#ubE#R#R#Raiaiaiai#P#P#P#TbZ.ObZ###0###0bSbSbSbE#u#u#u.B.B.BbG#BbG#B..................................................................................................................", "............................................bIbIbI.Bbkbkbkbmbmbmbm#L#L#L#u#u#u#u.B.B.B.B#BbGbG........................................................................................................................................", "............................................#B#B#BbG#1#1#1.B.B.B.B#B#B#B..............................................................................................................................................................", "......................................................................................................................................................................................................................................", "......................................................................................................................................................................................................................................", "......................................................................................................................................................................................................................................" }; gWidgetsRGtk2/inst/images/boxplot1.xpm0000644000175100001440000000101311406427003017427 0ustar hornikusers/* XPM */ static char * g_hbox_xpm[] = { "20 16 4 1", " c #FFFFFFFFFFFF", ". c #000000000000", "X c #618514511040", "o c #FFFF0000FFFF", " ", "....................", ". .", ". XXXXXX .", ". X XooooX X .", ". XXXooooXXX .", ". X XooooX X .", ". XXXXXX .", ". XXXX .", ". X XooX X .", ". XXXXooXXXX .", ". X XooX X .", ". XXXX .", ". .", "....................", " "}; gWidgetsRGtk2/inst/images/function1.xpm0000644000175100001440000000077211406427003017600 0ustar hornikusers/* XPM */ static char * g_function_xpm[] = { "20 16 3 1", " c #FFFFFFFFFFFF", ". c #965896589658", "X c #000000000000", " ", " . ", " XXX. ", " XX XX ", " XX .X ", " .X. ", " .X X X ", " XXXXX X X ", " XX .X X X X.", " .X. .X XX X.", " XX .X XX X.", " X. XX .X X X X.", " XX X. X X ", " .XXX X X ", " . ", " "}; gWidgetsRGtk2/inst/images/newplot.xpm0000644000175100001440000000154311406427003017357 0ustar hornikusers/* XPM */ static char * new_plot_xpm[] = { "24 24 7 1", " c None", "x c #FFFFFFFFFFFF", ". c #FFFF00000000", "X c #FFFFB2CA69A6", "o c #FFFFFFFF0000", "O c #000000000000", "+ c #00000000FFFF", " . ", " . . . ", " .XXX. ", " XoooX ", " OOOOOOOOOOOO..XoIoX.. ", " OxxxxxxxxxxxxXoooX ", " OOxOOOOOxOxxxx.XXX. ", " OxOxxxOxxx+x.xx.O . ", " OOxOOOOOxOx++xx+.O ", " Oxxxxxxxx+xx++xxO ", " OOxxxxxxxO+xxxxxxO ", " Oxxxxxxxx+xxxxxxO ", " OOOxx+xOx+OxOxOxOO ", " Oxxx++xx+xxxxxxxO ", " OOxx+xx++xxxxxxxxO ", " Ox+xxxxxOxxxxxxxO ", " OOx+xxxxxxxxxxxxxO ", " O++xxxxxOxxxxxxxO ", " OOOOOOOOOOOOOOOOOO ", " O O O O O O O O O ", " ", " ", " ", " "}; gWidgetsRGtk2/inst/images/symbol_dot.xpm0000644000175100001440000000076111406427003020043 0ustar hornikusers/* XPM */ static char * symbol_dot_xpm[] = { "18 18 2 1", " c #FFFFFFFFFFFF", ". c #000000000000", " ", " ", " ", " ", " ", " ", " .. ", " .... ", " ...... ", " ...... ", " .... ", " .. ", " ", " ", " ", " ", " ", " "}; gWidgetsRGtk2/inst/images/symbol_rtriangle.xpm0000644000175100001440000000076711406427003021252 0ustar hornikusers/* XPM */ static char * symbol_rtriangle_xpm[] = { "18 18 2 1", " c #FFFFFFFFFFFF", ". c #000000000000", " ", " ", " ", " ", " .. ", " .... ", " .. ... ", " .. ... ", " .. ... ", " .. ... ", " .. ... ", " .. ... ", " .... ", " .. ", " ", " ", " ", " "}; gWidgetsRGtk2/inst/images/graph.xpm0000644000175100001440000000246111406427003016770 0ustar hornikusers/* XPM */ static char * as_xpm[] = { "32 32 6 1", " c #000000000000", ". c #FFFFFFFFFFFF", "X c #303030303030", "o c #FFFF00000000", "O c #CCCCCCCCCCCC", "+ c #FFFFC0C0C0C0", " ", " ", " ..X......... .o. ......... ", " .XX........ O.+o+.O ........ ", " ooooo...... ..ooo.. ........ ", " +ooo+..... O.+ooo+.O ....... ", " .ooo...... O.ooooo.O ....... ", " .+o+..... O....o....O ...... ", " ..o...... O....o....O ...... ", " ..X...... .....o....O ...... ", " ..X..... O.....o.....O ..... ", " .XX..... O...........O ..... ", " ..X...+o ...... .....O o+... ", " ..X.+ooo .....O.O..... ooo+. ", " ..Xooooooooo. ... .ooooooooo ", " ..X.+oooO....O...O....Oooo+. ", " ..X...+oO.... ... ....Oo+... ", " ..X...O O...O.....O...O O... ", " ..X...O .... ..o.. .... O... ", " .XX... O....O..o..O....O ... ", " ..o... O.... ..o.. ....O ... ", " .+o+.. O.......o.......O ... ", " .ooo.O ......ooooo...... O.. ", " +ooo+O ......+ooo+...... O.. ", " oooooO .......ooo....... O.. ", " .. ..o+.......+o+.......+o.. ", " .. ..ooo+......o......+ooo.. ", " .XXXXoooooXXXXXXXXXXXoooooXX ", " ..X..ooo+.X.......X...+oooX. ", " .....o+.................+oX. ", " ", " "}; gWidgetsRGtk2/inst/images/select.xpm0000644000175100001440000000157711406427003017155 0ustar hornikusers/* XPM */ static char * set_column_xpm[] = { "24 24 8 1", " c None", "x c #FFFFFFFFFFFF", ". c #FFFF00000000", "X c #000000000000", "o c #59655D755965", "O c #AEBAAAAAAEBA", "+ c #FFFF96582081", "@ c #C71BC30BC71B", " ", " . ", " Xooooooooo .. ", " XOOOooOOOo ...... ", " XOOXOOXOOo ...... ", " XOOooooOOo .. .. ", " XOOoOOoOOo . .. ", " Xooooooooo .. ", " XxxxxxxxxX .. ", " Xxxx.+xxxX .. ", " Xxxx+.xxxX ", " XXXX.+XXXX X @X@oXo ", " Xxxx+.xxxX XX X XX X ", " Xxxx.+xxxX X X oX ", " Xxxx+.xxxX X oX oX ", " XXXX.+XXXX @X@X @o X ", " Xxxx+.xxxX XXXXXXoXo ", " Xxxx.+xxxX ", " Xxxx+.xxxX ", " XXXX.+XXXX ", " Xx+.+.+.xX ", " Xxx+.+.xxX ", " xx+.xxx ", " "}; gWidgetsRGtk2/inst/images/bubbles.xpm0000644000175100001440000000077111406427003017307 0ustar hornikusers/* XPM */ static char * g_bubbles_xpm[] = { "20 16 3 1", " c #FFFFFFFFFFFF", ". c #000000000000", "X c #FFFF0000FFFF", " ", "....................", ". .", ". .. .", ". .. .XX. .", ". .XX. .. .", ". .XXXX. .", ". .XXXX. .. .", ". .XX. .XX. .", ". .. .. .XXXX. .", ". .XX. .. .XXXX. .", ". .XX. .. .XX. .", ". .. .. .", ". .", "....................", " "}; gWidgetsRGtk2/inst/images/boxplot.xpm0000644000175100001440000000101411406427003017347 0ustar hornikusers/* XPM */ static char * g_boxes_xpm[] = { "20 16 4 1", " c #FFFFFFFFFFFF", ". c #000000000000", "X c #861700000000", "o c #FFFF0000FFFF", " ", "....................", ". .", ". XXX .", ". XXX X XXX .", ". X XXX XXX X .", ". XXX X XoX XXX .", ". XoX XXX XoX XoX .", ". XoX XoX XXX XoX .", ". XXX XoX X XXX .", ". X XXX XXX X .", ". XXX X XXX .", ". XXX .", ". .", "....................", " "}; gWidgetsRGtk2/inst/images/darrow.gif0000644000175100001440000000073011406427003017123 0ustar hornikusersGIF89aŽŽ{{{{{{{sssssssk{ksskk{ckkkkkkckcckZc{sRRRZJRZJJRJJZJJJJJBcZ!RZJBB!RR:BJ1:R):!Created with The GIMP!?,pH, lldqX-!*-_7zaXXC̅`u0<10?&6..3,V$I>-->lJ 3-3(xVK=>ua73# & O=_& !B8! ?0~<-= 0O ; fB, dC`! 8F6hYB>PHP ;gWidgetsRGtk2/inst/images/rarrow.xpm0000644000175100001440000000267511406427003017212 0ustar hornikusers/* XPM */ static char * rarrow_xpm[] = { "20 19 64 1", " c None", ". c #FFFFFF", "+ c #F7F7F7", "@ c #EFEFEF", "# c #E6E6E6", "$ c #E6DEDE", "% c #DEDEDE", "& c #DED6D6", "* c #D6D6D6", "= c #D6CECE", "- c #CECECE", "; c #CECEC5", "> c #C5C5C5", ", c #C5C5BD", "' c #C5BDBD", ") c #BDBDBD", "! c #BDBDB5", "~ c #B5B5B5", "{ c #B5B5AD", "] c #B5ADAD", "^ c #ADADAD", "/ c #ADADA5", "( c #ADA5A5", "_ c #A5A5A5", ": c #9C9C9C", "< c #9C9494", "[ c #949494", "} c #94948C", "| c #948C8C", "1 c #8C8C8C", "2 c #8C8C84", "3 c #8C8484", "4 c #848484", "5 c #8C7B84", "6 c #847B7B", "7 c #7B7B7B", "8 c #7B7373", "9 c #737373", "0 c #73736B", "a c #7B6B73", "b c #736B6B", "c c #7B636B", "d c #6B6B6B", "e c #6B6B63", "f c #6B6363", "g c #6B5A63", "h c #DE107B", "i c #CE1073", "j c #525252", "k c #5A4A52", "l c #5A4A4A", "m c #524A4A", "n c #A5195A", "o c #4A4A4A", "p c #4A4A42", "q c #AD1063", "r c #9C195A", "s c #8C2152", "t c #A5105A", "u c #4A4242", "v c #842152", "w c #523A42", "x c #4A313A", "y c #52293A", " 'akkka]+ ", " 'k9_)))(4k| ", " gb~)))>>>>>:| ", " |_!))>>>>>>>)^g ", " <[])lg);-------8' ", " +k!)'wnyc-*****=-k ", " ]6))>wihny8*%%***6'", " c_)>>wihhhnx6%%%*~a", " k))>;wihhhhhnx5%%*k", " k)>>-wihhhhhhhvm%%k", " k)>>-wihhhhhsw^##%k", " a_>>-wihhhrx(++@#>a", " '8>>-wihnx< +@#<]", " k>>-wqy5@++ ++@#k+", " '0>-ka*##@+++@%~| ", " g^,-=%%##@@@#-[ ", " |:-**%%####4g ", " 6k' ", " +]akkka' "}; gWidgetsRGtk2/inst/images/target.xpm0000644000175100001440000000234111406427003017152 0ustar hornikusers/* XPM */ static char * target_xpm[] = { "32 32 2 1", " c #000000000000", ". c #FFFFFFFFFFFF", " ", " ", " ............................ ", " ............................ ", " ............................ ", " ... ... ", " ... ... ", " ... ........ ........ ... ", " ... ........ ........ ... ", " ... ........ ........ ... ", " ... ........ ........ ... ", " ... ........ ........ ... ", " ... ........ ........ ... ", " ... .................. ... ", " ... .................. ... ", " ... ...... ... ", " ... ...... ... ", " ... .................. ... ", " ... .................. ... ", " ... ........ ........ ... ", " ... ........ ........ ... ", " ... ........ ........ ... ", " ... ........ ........ ... ", " ... ........ ........ ... ", " ... ........ ........ ... ", " ... ... ", " ... ... ", " ............................ ", " ............................ ", " ............................ ", " ", " "}; gWidgetsRGtk2/tests/0000755000175100001440000000000012240025532014054 5ustar hornikusersgWidgetsRGtk2/tests/RunTests.R0000644000175100001440000000065011740676416016010 0ustar hornikusersrequire(gWidgets) options("guiToolkit"="RGtk2") gWidgetsDir <- system.file("tests",package="gWidgets") ## should be there, but just in case if(gWidgetsDir != "") { files <- list.files(gWidgetsDir, pattern = "\\.R$", full.names = TRUE) files <- files[grepl("^ex", basename(files))] ## XXX removed to get past CRAN # for(unitTest in files) { # source(unitTest) # } } gWidgetsRGtk2/tests/runRUnit.R0000644000175100001440000000160211740676375016011 0ustar hornikusers## Run test suite through RUnit if installed ## ## RUnit is better at testing non-interactive features ## We add RUnit tests to the gWidgets/tests directory in files ## names test.XXX containing functions test-XXX <- function() {} library(gWidgets) options(guiToolkit="RGtk2") doRequire <- function(i) do.call(sprintf("%s","require"), list(i)) if(doRequire("RUnit")) { testsuite.gWidgets <- defineTestSuite("gWidgets", dirs = system.file("tests",package="gWidgets"), testFileRegexp = "^test-.+\\.R", testFuncRegexp = "^test.+", rngKind = "Marsaglia-Multicarry", rngNormalKind = "Kinderman-Ramage") # testResult <- runTestSuite(testsuite.gWidgets) # printTextProtocol(testResult) } gWidgetsRGtk2/NAMESPACE0000644000175100001440000001627413131734634014155 0ustar hornikusersimport(methods) import(utils) import(grDevices) import(graphics) import(RGtk2) import(gWidgets) import(cairoDevice) exportMethods( "[", ".glabel", ".gbutton", ".gcheckbox", ".gradio", ".gdroplist", ".gcheckboxgroup", ".gspinbutton", ".gslider", ".gedit", ".gtext", ".gaction", ".gmenu", ".gtoolbar", ".gtable", ".gdf", ".gdfnotebook", ".gtree", ".gfile", ".gfilebrowse", ".gcalendar", ".ggraphics", ".ggraphicsnotebook", ".gimage", ".gstatusbar", ".gseparator", ".gcommandline", ".ghelp", ".ghelpbrowser", ".ghtml", ".gvarbrowser", # ".gdynamicselect", ".gwindow", ".ggroup", ".gframe", ".gexpandgroup", ".gnotebook", ".glayout", ".gpanedgroup", "svalue", "svalue<-", "add", "addSpace", "addSpring", "insert","delete", "dispose", "visible", "visible<-", "enabled", "enabled<-", "size", "size<-", "focus", "focus<-", "tooltip<-", "defaultWidget","defaultWidget<-", "font", "font<-", "tag", "tag<-", "id", "id<-", "isExtant", "addhandler", #"addHandler", "addhandlerchanged","addHandlerChanged", "addhandlerkeystroke", "addhandlerclicked", "addhandlerdoubleclick", "addhandlerrightclick", "addhandlerfocus", "addhandlerblur", "addhandlerdestroy", "addhandlerexpose", "addhandlerunrealize", "addhandlermousemotion", "addhandleridle", "addpopupmenu", "add3rdmousepopupmenu", "adddropsource", "adddropmotion", "adddroptarget", "removehandler", "blockhandler", "unblockhandler", ".svalue", ".svalue<-", ".leftBracket", ".leftBracket<-", ".add", ".addSpace", ".addSpring", ".insert", ".delete", ".dispose", ".visible", ".visible<-", ".enabled", ".editable", ".editable<-", ".enabled<-", ".size", ".size<-", ".focus", ".focus<-", ".tooltip<-", ".defaultWidget",".defaultWidget<-",".font", ".font<-", ".tag", ".tag<-", ".id", ".id<-", ".isExtant", ".addhandler",".addhandlerchanged", ".addhandlerkeystroke", ".addhandlerclicked", ".addhandlerdoubleclick", ".addhandlerrightclick", ".addhandlerfocus", ".addhandlerblur", ".addhandlerdestroy", ".addhandlerexpose", ".addhandlerunrealize", ".addhandlermousemotion", ".addhandleridle", ".addpopupmenu", ".add3rdmousepopupmenu", ".adddropsource", ".adddropmotion", ".adddroptarget", ".galert",".gmessage", ".ginput", ".gconfirm", ".gbasicdialog",".gbasicdialognoparent", ".addStockIcons",".getStockIcons", ".stockIconFromClass",".stockIconFromObject", ".removehandler", ".blockhandler", ".unblockhandler", ".svalue", "update",".update", "length",".length", "dim",".dim", "dimnames",".dimnames", "dimnames<-",".dimnames<-", "names",".names", "names<-",".names<-", ".getToolkitWidget" ) #, # "as.gWidgetsRGtk2", # "as.gWidgetsRGtk2.default", # "as.gWidgetsRGtk2.GtkButton" #) export("gdfedit",".gdfedit") exportClasses( "AtkNoOpObjectFactory", "AtkObjectFactory", "AtkRelationSet", "AtkStateSet", "GBoxed", "GObject", "GScanner", "GdkDragContext", "GdkPixbufLoader", "GdkRegion", "GtkAboutDialog", "GtkAccelGroup", "GtkAccelLabel", "GtkAction", "GtkActionGroup", "GtkAdjustment", "GtkAlignment", "GtkArrow", "GtkAspectFrame", "GtkBin", "GtkBox", "GtkButton", "GtkButtonBox", "GtkCList", "GtkCTree", "GtkCalendar", "GtkCellRenderer", "GtkCellRendererCombo", "GtkCellRendererPixbuf", "GtkCellRendererProgress", "GtkCellRendererText", "GtkCellRendererToggle", "GtkCellView", "GtkCheckButton", "GtkCheckMenuItem", "GtkColorButton", "GtkColorSelection", "GtkColorSelectionDialog", "GtkCombo", "GtkComboBox", "GtkComboBoxEntry", "GtkContainer", "GtkCurve", "GtkDialog", "GtkDrawingArea", "GtkEntry", "GtkEntryCompletion", "GtkEventBox", "GtkExpander", "GtkFileFilter", "GtkFileSelection", "GtkFixed", "GtkFontButton", "GtkFontSelection", "GtkFontSelectionDialog", "GtkFrame", "GtkGammaCurve", "GtkHBox", "GtkHButtonBox", "GtkHPaned", "GtkHRuler", "GtkHScale", "GtkHScrollbar", "GtkHSeparator", "GtkHandleBox", "GtkIMContext", "GtkIMContextSimple", "GtkIMMulticontext", "GtkIconFactory", "GtkIconSet", "GtkIconSource", "GtkIconTheme", "GtkIconView", "GtkImage", "GtkImageMenuItem", "GtkInputDialog", "GtkInvisible", "GtkItem", "GtkLabel", "GtkLayout", "GtkList", "GtkListItem", "GtkMenu", "GtkMenuBar", "GtkMenuItem", "GtkMenuShell", "GtkMisc", "GtkNotebook", "GtkObject", "GtkOptionMenu", "GtkPaned", "GtkProgress", "GtkProgressBar", "GtkRadioAction", "GtkRadioButton", "GtkRange", "GtkRcStyle", "GtkRuler", "GtkScale", "GtkScrollbar", "GtkScrolledWindow", "GtkSeparator", "GtkSeparatorMenuItem", "GtkSeparatorToolItem", "GtkSizeGroup", "GtkSocket", "GtkSpinButton", "GtkStatusbar", "GtkStyle", "GtkTable", "GtkTearoffMenuItem", "GtkTextAttributes", "GtkTextBuffer", "GtkTextChildAnchor", "GtkTextTag", "GtkTextTagTable", "GtkTextView", "GtkTipsQuery", "GtkToggleAction", "GtkToggleButton", "GtkToggleToolButton", "GtkToolButton", "GtkToolItem", "GtkToolbar", "GtkTooltips", "GtkTreeModelSort", "GtkTreePath", "GtkTreeView", "GtkTreeViewColumn", "GtkUIManager", "GtkVBox", "GtkVButtonBox", "GtkVPaned", "GtkVRuler", "GtkVScale", "GtkVScrollbar", "GtkVSeparator", "GtkViewport", "GtkWidget", "GtkWindow", "GtkWindowGroup", "PangoAttrList", "PangoCairoFcFontMap", "PangoCoverage", "PangoFcFontMap", "PangoFontDescription", "PangoFontMap", "PangoGlyphString", "PangoItem", "RGtkDataFrame") ## coercion methods #importFrom(gWidgets, "as.gWidget") export("as.gWidgetsRGtk2") S3method("as.gWidgetsRGtk2","default") S3method(as.gWidgetsRGtk2,"GtkButton") S3method(as.gWidgetsRGtk2,"GtkCheckButton") ## no gcheckboxgroup -- made from gWidgets S3method(as.gWidgetsRGtk2,"GtkComboBoxEntry") ## ISSUE WITH [, .. S3method(as.gWidgetsRGtk2,"GtkComboBox") S3method(as.gWidgetsRGtk2,"GtkEntry") S3method(as.gWidgetsRGtk2,"GtkExpander") S3method(as.gWidgetsRGtk2,"GtkFrame") S3method(as.gWidgetsRGtk2,"GtkDrawingArea") ## ggrid didn't touch S3method(as.gWidgetsRGtk2,"GtkHBox") S3method(as.gWidgetsRGtk2,"GtkVBox") S3method(as.gWidgetsRGtk2,"GtkImage") S3method(as.gWidgetsRGtk2,"GtkLabel") S3method(as.gWidgetsRGtk2,"GtkTable") # glayout S3method(as.gWidgetsRGtk2,"GtkNotebook") S3method(as.gWidgetsRGtk2,"GtkHPaned") # gpanedgroup S3method(as.gWidgetsRGtk2,"GtkVPaned") S3method(as.gWidgetsRGtk2,"GtkRadioButton") S3method(as.gWidgetsRGtk2,"GtkHSeparator") S3method(as.gWidgetsRGtk2,"GtkVSeparator") S3method(as.gWidgetsRGtk2,"GtkHScale") S3method(as.gWidgetsRGtk2,"GtkVScale") S3method(as.gWidgetsRGtk2,"GtkSpinButton") S3method(as.gWidgetsRGtk2,"GtkStatusbar") S3method(as.gWidgetsRGtk2,"GtkTextView") ## no gtoolbar -- odd datastore -- a list ## no gtree -- odd data store S3method(as.gWidgetsRGtk2,"GtkWindow") gWidgetsRGtk2/NEWS0000644000175100001440000002411112434630240013413 0ustar hornikusersDear Emacs, please make this -*-Text-*- mode! NEWS for gWidgetsRGtk2 Changes for version 0.0-83 -------------------------- * add Rbuildignore Changes for version 0.0-82 -------------------------- * add character value for filter argument of gfile * fix font<- for size. (Thanks Yuhie) * gtree `update` function is improved Changes for version 0.0-81 -------------------------- * removed testing code to pass CRAN check on windows. Odd error, but likely from older gWidgets being used Changes for version 0.0-80 -------------------------- * attempt to fix drag and drop Changes for version 0.0-79 -------------------------- * fix to ggraphics.R for allocations Changes for version 0.0-78 -------------------------- * changes to gvarbrowser Changes for version 0.0-77 -------------------------- * change in dnd, icons to avoid using "Namespce" functions * put back tag code into gtext * fix to gdf and do.subset=TRUE. (Thanks Stephanie) * fix to font.attr argument of insert method for gtext. (Had commented out for speed, but forgot to fix ...) THanks Yvonnick. Changes for version 0.0-76 -------------------------- * requires gWidgets 0.0-46 * added generics for $, [[ and [[<- to work with underlying toolkit object * use info bar for galert when parent is a gwindow. * bug fix for gdf and sorting (Thanks Stephanie) * do.buttons argument for gbasicdialog. Passed as hidden argument, or formal one with newer gWidgets Changes for version 0.0-75 -------------------------- * bug fix for Observer class to allow proto methods * reworked fonts for gtext so that tags are not preloaded. That was much too slow. * new editable generic, but no methods yet * focus method for gwindow to raise window Changes for version 0.0-74 -------------------------- * bug fixes svalue<-gtable and block_handlers Changes for version 0.0-73 -------------------------- * fix gstatusbar. OVerride default label, as it truncated the bottom of the message with a recent GTK. However, removed support for popping stack of messages. Likely not an issue, but can be put back if requested. * fix to gradio to avoid premature garbage collection leading to crash under tctorture. There may still be an issue with gbutton. (If so, pass in a parent container to the constructor.) * Reworked gradio and gcheckboxgroup to use a backend reference class. Cleans up the code considerably. Changes for version 0.0-72 -------------------------- * removed example code -- for some reason CRAN was choking on it. Changes for version 0.0-71 -------------------------- * bug fix to get traitr vignette to work cleanly Changes for version 0.0-70 -------------------------- * fix to gcombobox's [<- method Changes for version 0.0-69 -------------------------- * overload from= argument for gslider to specify arbitrary sortable vector * bug fix for handlers when label, images not enabled * added use.togglebutton for gcheckbox * another fix to gvarbrowser (Thanks Tom, wxffxw) * use RGtk2Extras now (name change) (Thanks TOm) * fix to gradio's [<- method * change to 3rd mouse popup and gtable (THanks Wincent) * fix to gvarbrowser (Thanks Stephanie) Changes for version 0.0-68 -------------------------- * fix to font<- and colors. Thanks to S. Bonett for the feedback. * added [ method for glayout. (oops, thanks but forgot who, sorry) * added svalue<- method to gtree, changed svalue(obj, index=XXX) behaviour * fix bug with insert method for gtext and scrolling to end. Changes for version 0.0-67 -------------------------- * fix to addHandlerClicked for gtree * added rubber-band selection to ggraphics (also addHandlerChanged). * right click menu option for ggraphics Changes for version 0.0-66 (uploaded 6-28-10) -------------------------- * visible<- method for gedit. If FALSE will do password entry characters * bug fix to gtree (Thanks Dieter) * add multiple=TRUE argument to gfile Changes for version 0.0-65 -------------------------- * implemented new option use.table for gcheckboxgroup. Places widgets into table so one can scroll. * fixed bug in gcommandline that was breaking ggenericwidget * fix to glabel when editable=TRUE Changes for version 0.0-64 -------------------------- * Bug fix to ggrid code to make assignment work with visible. * change to font.attr argument to gtext. Requires upgrade to gWidgets (0.0-39) Now sets attributes for the buffer, not just initial text. The add method and font<- method can be used to adjust properties of pieces of text. Added behaviour for font<- when no text is selected it changes text of entire buffer Changes for version 0.0-63 -------------------------- * bug fixes to ggrid to make gtable work better. Changes for version 0.0-62 --------------------------- * bug fixes for gdfnotebook. (Thanks Rune) * fix to make dnd work as expected with gedit. * bug fixes for gtoolbar, gmenu when icons were involved. Issue arose with newer GTK versions. (Thanks Rune) Changes for version 0.0-61 --------------------------- * namespace mistake Changes for version 0.0-60 --------------------------- * bug fix to gmenu which was preventing pmg from loading * in gvarbrowser added means for user to specify knownTypes. This variable holds specification of similar classes. Changes for version 0.0-59 --------------------------- * Fix to gfile for filtering and intialfilename * implementing gdfedit front end to RGtk2DfEdit package of Tom Taverner Changes for version 0.0-58 --------------------------- * fix so that svalue<- for gtable only calls handler once. * bug fix with addHandlerChanged and pageno with gnotebook * add hidden argument "diy" to gdf to suppress adding keymotion handlers or popup on column header clicking. Changes for version 0.0-57 --------------------------- * font<- method for gbutton fixed * fix to svalue<- for gcombobox to handle index=FALSE properly Changes for version 0.0-56 --------------------------- * another fix to svalue for ggrid. Wasn't working with svalue(obj, index=FALSE) <- values (setting by value). Must match through %in% (so best that chosencol is a character. Changes for version 0.0-55 --------------------------- * fix bug with svalue<- for gtable, wasn't clearing selection Changes for version 0.0-54 -------------------------- * add CTRL-1 for 3rd mouse binding, so that single-button mac users can be happy Changes for version 0.0-53 -------------------------- * fix to gfilebrowse (thanks to Hana) * added [<- method for spinbutton, gslider Changes for version 0.0-53 -------------------------- * Fix to gbutton constructor with gaction objects for action argument (Thanks Lisa) * fix to error message in gtable (Thanks Ronggui) Changes for version 0.0-52 -------------------------- * changed modal dialogs. Changes for version 0.0-51 -------------------------- * changed polling for gvarbrowser, can also change with inteval=secs*1000 Changes for version 0.0-50 -------------------------- * fix to gvarbrowser -- last one didn't quite work. (Thanks again Albert) Changes for version 0.0-49 -------------------------- * fix to gvarbrowser to handle POSIX objects as expected (thanks Albert) Changes for version 0.0-48 -------------------------- * added gbasicdialog for compliance with toolkits that need to have parent container specified * implemented svalue<- for gaction Changes for version 0.0-47 -------------------------- * added gaction implementation. This can be used for gbutton, gmenu, gtoolbar. The svalue<- method does not work * added ability in gWidgetsRGtk2 to put widgets into toolbars Changes for version 0.0-46 -------------------------- * fix to gframe for expand=FALSE * fix to gframe, gexpandgroup for spacing argument * added width argument for gcombobox via ... This needs to be incorporated into generic in gWidgets are * fix to visible<- * fix typo in addhandlerkeystroke for gtext Changes for version 0.0-44 -------------------------- * fix handler code in gcheckboxgroup (Giles) Changes for version 0.0-41 -------------------------- * fix to .add in ggroup to take RGtk2 default alignment * fix to gedit -- if no [<- call, then no completion is created. Changes for version 0.0-40 -------------------------- * attempts to speed things up. Changes for version 0.0-39 -------------------------- * fix to EventBox(es) so that under windows the coloring is consistent. Changes for version 0.0-38 -------------------------- * fixed bug with markup argument in gframe, yalign property * fixed bug with width argument in gedit Changes for version 0.0-37 -------------------------- * fix to gtree. Bug with single column offspring. Changes for version 0.0-35 -------------------------- * changes to NAMESPACE to get pass check cleanly * fixed issue with S4 methods and oldClasses by avoiding the whole thing Changes for version 0.0-34 -------------------------- * fixes to gcheckboxgroup: a bug fix with [<- and ability to change length of items using obj[]<- construct. Changes for version 0.0-33 -------------------------- * changes to docs, DESCRIPTION to pass R CMD check. Changes for version 0.0-32 -------------------------- * minor bug fix for gedit also glabel(editable=TRUE) Changes for version 0.0-30 -------------------------- * Fixed bug with gradio and selected * added tests directory to run tests from gWidgets package Changes for version 0.0-30 -------------------------- * Changed definition of basic widgets to use ANY instead of a class union that container either guiWidget, gWidgetRGtk2 or RGtkObject. The new is feature of 2.7.0 was messing this up. Should fix this. * new function as.gWidgetsRGtk2 for coercing an RGtkObject object into a gWidgetsRGtk2 object * added anchor argument to ggroup * fixed glayout so that visible assignment is not needed. The widget now resizes dynamically when asked. Added expand argument, and anchor argument. * fixed handler for gradio. * added handlers blockHandler, unblockHandler. These may be useful when updating a widget's values causes a handler to be called * gwindow. Add menubars, toolbars, and statusbars directly to the top level gwindow object * gtext: added addHandlerKeystroke. The value h$keystroke contains the key gWidgetsRGtk2/R/0000755000175100001440000000000013233652621013123 5ustar hornikusersgWidgetsRGtk2/R/gcheckbox.R0000644000175100001440000001130213216523516015201 0ustar hornikuserssetClass("gCheckboxRGtk", contains="gComponentRGtk", prototype=prototype(new("gComponentRGtk")) ) ## constructor setMethod(".gcheckbox", signature(toolkit="guiWidgetsToolkitRGtk2"), function(toolkit, text, checked=FALSE, use.togglebutton=FALSE, handler=NULL, action=NULL, container=NULL,...) { force(toolkit) if(missing(text)) text <- "" if(use.togglebutton) return(gtogglebutton(text, checked, handler, action, container, ...)) check <- gtkCheckButtonNewWithLabel(text) check$SetActive(checked) obj <- as.gWidgetsRGtk2(check) if (!is.null(container)) { if(is.logical(container) && container == TRUE) container = gwindow(visible=TRUE, toolkit=toolkit) add(container, obj,...) } if (!is.null(handler)) { id = addhandler(obj, "toggled",handler, action=action) } invisible(obj) }) as.gWidgetsRGtk2.GtkCheckButton <- function(widget,...) { parent <- widget$parent if(is.null(parent)) { parent <- gtkAlignmentNew(0,0,0,0) parent$add(widget) } obj = new("gCheckboxRGtk",block=parent, widget=widget, toolkit=guiToolkit("RGtk2")) return(obj) } ### methods setMethod(".svalue", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gCheckboxRGtk"), function(obj, toolkit, index=NULL, drop=NULL, ...) { obj@widget$getActive() }) setReplaceMethod(".svalue", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gCheckboxRGtk"), function(obj, toolkit, index=NULL, ..., value) { obj@widget$setActive(value) return(obj) }) ## [ setMethod(".leftBracket", signature(toolkit="guiWidgetsToolkitRGtk2",x="gCheckboxRGtk"), function(x, toolkit, i, j, ..., drop=TRUE) { x@widget[[1]]$GetText() }) setMethod("[", signature(x="gCheckboxRGtk"), function(x, i, j, ..., drop=TRUE) { .leftBracket(x, x@toolkit, i, j, ..., drop=drop) }) setReplaceMethod(".leftBracket", signature(toolkit="guiWidgetsToolkitRGtk2",x="gCheckboxRGtk"), function(x, toolkit, i, j, ..., value) { x@widget[[1]]$SetText(value) return(x) }) setReplaceMethod("[", signature(x="gCheckboxRGtk"), function(x, i, j,..., value) { .leftBracket(x, x@toolkit, i, j, ...) <- value return(x) }) ## handlers setMethod(".addhandlerclicked", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gCheckboxRGtk"), function(obj, toolkit, handler, action=NULL, ...) { addhandler(obj, "toggled", handler, action=action,...) }) setMethod(".addhandlerchanged", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gCheckboxRGtk"), function(obj, toolkit, handler, action=NULL, ...) { .addhandlerclicked(obj, toolkit, handler, action=action,...) }) ################################################## ## class to provide a toggle button alternative to a checkbox. The toggle button ## is very similar setClass("gToggleButtonRGtk", contains="gCheckboxRGtk" ) ## Provides a toggle button alternative to a check box. ## ## constructor, not a method as called internally gtogglebutton <- function(text, checked=FALSE, handler=NULL, action=NULL, container=NULL, ...) { widget <- gtkToggleButton() obj <- new("gToggleButtonRGtk", block=widget, widget=widget, toolkit=guiToolkit("RGtk2")) if(!missing(text)) obj[] <- text svalue(obj) <- checked if(!is.null(handler)) addHandlerChanged(obj, handler=handler, action=action) if(!is.null(container)) { if(is.logical(container) && container) container <- gwindow() add(container, obj, ...) } return(obj) } ## method to set text setReplaceMethod(".leftBracket", signature(toolkit="guiWidgetsToolkitRGtk2",x="gToggleButtonRGtk"), function(x, toolkit, i, j, ..., value) { tb <- getWidget(x) icons <- getStockIcons() if(value %in% names(icons)) { tb['use-stock'] <- TRUE tb['label'] <- icons[[value]] } else { tb['use-stock'] <- FALSE tb['label'] <- value } return(x) }) gWidgetsRGtk2/R/ghelp.R0000644000175100001440000004676711445300622014363 0ustar hornikusers## ## a notebook for holding help pages ## setClass("gHelpRGtk", ## contains="gComponentRGtk", ## prototype=prototype(new("gComponentRGtk")) ## ) ## setMethod(".ghelp", ## signature(toolkit="guiWidgetsToolkitRGtk2"), ## function(toolkit, ## topic=NULL, package=NULL, ## container = NULL, ## ...) { # passed to gnotebook ## force(toolkit) ## ## check if newversion of R, if so, we con't do a thing but return a label ## if(getRversion() >= "2.10.0" && getRversion() < "2.11.0") { ## l <- .glabel(toolkit, "ghelp needs to be updated for your version of R. Sorry.", cont=container) ## return(l) ## } ## group = ggroup(horizontal=FALSE, container = container, ...) ## notebook = gnotebook(...) ## add(group, notebook, expand=TRUE) ## obj = new("gHelpRGtk", block=group, widget=notebook, ## toolkit=toolkit) ## ## obj = list(ref=group, gnotebook = notebook, notebook = notebook$notebook) ## ## class(obj) = c("gHelp",class(notebook)) ## if(!is.null(topic)) ## .add(obj,toolkit, value = list(topic=topic, package=package)) ## invisible(obj) ## }) ## ################################################## ## ## gHelp methods ## ## workhorse is add -- value is either ## ## just a topic (not a list), or a list with components topic, package ## setMethod(".add", ## signature(toolkit="guiWidgetsToolkitRGtk2",obj="gHelpRGtk"), ## function(obj, toolkit, value, ...) { ## if(is.list(value)) { ## topic = value$topic ## package = value$package ## } else if(length(grep(":",value)) > 0) { # "stats:::t.test" works here ## tmp = unlist(strsplit(value, ":+")) ## package = tmp[1] ## topic = tmp[2] ## } else { ## topic = value ## package = NULL ## } ## ## error check ## if(!is.character(topic) || length(topic) > 1 || length(topic) == 0) { ## warning("Adios, adding to ghelp needs a valid topic\n") ## return() ## } ## if(getRversion() < "2.10.0") { ## ## if package is NULL, we find them ## if(is.null(package)) { ## possiblePackages = getPossiblePackages(topic) ## if(length(possiblePackages) > 0) { ## package = possiblePackages ## } else { ## warning(Paste("Can't find a package containing ", topic,"\n")) ## return() ## } ## } ## ## add a page for each package ## for(pkg in package) { ## helpPage = makeHelpPage(topic, pkg) ## tag(helpPage,"topic") <- topic ## tag(helpPage,"package") <- pkg ## add(obj@widget, helpPage, label = Paste("Help on ",pkg,"::",topic)) ## } ## return() ## } else if(getRversion() >= "2.11.0") { ## ## add a page for each package ## l <- list(topic=topic) ## if(!is.null(package)) ## l$package <- package ## out <- do.call("help", l) ## pkgname <- basename(dirname(dirname(out))) ## temp <- tools::Rd2txt(utils:::.getHelpFile(out), out = tempfile("Rtxt"), package=pkgname) ## x <- readLines(temp) ## unlink(temp) ## helpPage <- gtext(cont=obj@widget, label=topic) ## ## add text to gtext widget ## for(i in x) { ## if(grepl("^_\b",i)) { ## insert(helpPage, gsub("_\b","",i), font.attr=c(weight="bold")) ## } else { ## insert(helpPage, i) ## } ## } ## } ## return() ## }) ## ## value returns the topic of the current page or the one give by index ## setMethod(".svalue", ## signature(toolkit="guiWidgetsToolkitRGtk2",obj="gHelpRGtk"), ## function(obj, toolkit, index=NULL, drop=NULL, ...) { ## pageno = svalue(obj@widget) ## widget = obj@widget[pageno] ## topic = tag(widget,"topic") ## package = tag(widget,"package") ## return(list(topic=topic, package=package)) ## }) ## setMethod(".length", ## signature(toolkit="guiWidgetsToolkitRGtk2",x="gHelpRGtk"), ## function(x, toolkit) { ## length(x@widget) ## }) ## setMethod(".dispose", ## signature(toolkit="guiWidgetsToolkitRGtk2",obj="gHelpRGtk"), ## function(obj, toolkit, ...) { ## dispose(obj@widget) ## }) ## ################################################## ## ## helpers ## ## Return gtext widget with help page ## makeHelpPage = function(topic, pkg) { ## helpFile = help(topic, package=force(pkg), verbose=TRUE) ## # helpFile = system.file("help",topic,package=pkg) ## if(helpFile[1] != "") { ## ## deal with windows issue here ## helpFile = zip.file.extract(as.character(helpFile),"Rhelp.zip") ## text = readLines(helpFile) ## text = sapply(text, function(i) gsub("\\_\\\b","",i)) ## helpPage = gtext(text[1],font.attr=c(weight="bold")) ## add(helpPage, text[2]) ## add(helpPage, text[3], font.attr=c(weight="bold",size="big",color="blue")) ## add(helpPage, text[-(1:3)]) ## ## This gave troubles when there were more than a few pages open! ## ## sapply(text[-(1:3)], function(x) { ## ## if( length(grep("^\\w+:", x)) > 0) { ## ## tmp = unlist(strsplit(x,":")) ## ## add(helpPage,Paste(tmp[1],":"),font.attr=c("blue"), do.newline=FALSE) ## ## add(helpPage,paste(tmp[-1], sep="", collapse=":")) ## ## } else { ## ## add(helpPage,x) ## ## } ## ## }) ## } else { ## helpPage = gtext(paste("Page for ",topic," in package ",pkg," was not found.",collapse=" ")) ## } ## return(helpPage) ## } ## getPossiblePackages = function(topic) { ## possiblePackages = c() ## ## find all packages ## lib.loc <- .libPaths() ## packages <- .packages(all.available = TRUE, lib.loc = lib.loc) ## for (lib in lib.loc) { ## for (pkg in packages) { ## dir <- system.file(package = pkg, lib.loc = lib) ## ## XXX This needs to be rewritten for R version 2.11.0 or later ## l <- list(topic, dir, "AnIndex", "help") ## path <- do.call("index.search",l) ## if(path != "") ## possiblePackages = c(possiblePackages, pkg) ## } ## } ## if(length(possiblePackages) == 0) { ## warning("Adios, can't find a package to match ",topic,"\n") ## return() ## } ## return(possiblePackages) ## } ## ################################################## ## ## is this of class gHelp? ## is.ghelp = function(x) { ## is(x,"gHelpRGtk") ## } ## ## return name of any gHelp instances in environment ## findHelpObjectName = function(envir=.GlobalEnv) { ## x = ls(envir=envir) ## x[sapply(1:length(x),function(i) ## is.ghelp(get(x[i],envir=envir)))] ## x[!sapply(1:length(x), function(i) ## is.invalid(get(x[i],envir=envir)))] ## } ## ################################################## ## ## This just pops up a window to show the argument from a help page ## ## Hack to open up help page to the argument ## showHelpAtArgument = function(argument, topic, package=NULL, ## width=600, height=250) { ## if(missing(argument) || missing(topic)) ## return() ## if(is.null(package)) { ## possiblePackages = getPossiblePackages(topic) ## if(length(possiblePackages) > 0) { ## package = possiblePackages ## } else { ## warning(Paste("Can't find a package containing", topic,"\n")) ## return() ## } ## } ## ## the widget ## win=gwindow(Paste("Help on argument: ",topic), visible=FALSE) # set to visible if one is found ## size(win) <- c(width,height) ## group = ggroup(horizontal=FALSE, container=win) ## textwindow = gtext() ## add(group, textwindow, expand=TRUE) ## for(pkg in package) { ## ## helpFile = system.file("help",topic,package=pkg) ## helpFile = help(topic, package=force(pkg), verbose=TRUE)[1] ## if(helpFile != "") { ## text = readLines(helpFile) ## text = sapply(text, function(i) gsub("\\_\\\b","",i)) ## argPosition = grep(Paste(argument,": "), text) ## if(length(argPosition) == 0) { ## next ## } else { ## argPosition = argPosition[1] - 1 ## ##Found one ## visible(win) <- TRUE # show window ## } ## add(textwindow,Paste("From package:",pkg), font.attr=c(weight="bold")) ## ## add first line (it has a :) ## add(textwindow,text[argPosition+1],font.attr=c(weight="bold",color="blue")) ## ## add until a : ## i = 2; n = length(text) ## while(length(grep(":",text[argPosition+i])) == 0 && ## (argPosition + i) <= n ## ) { ## add(textwindow,text[argPosition+i],font.attr=c(weight="bold",color="blue")) ## i = i + 1 ## } ## add(textwindow,"\n") ## } ## } ## ## close button ## buttonGroup = ggroup(container=group) ## addSpring(buttonGroup) ## gbutton("cancel", container=buttonGroup, ## handler = function(h,...) dispose(h$obj)) ## } ## ################################################## ## ## build on ghelp widget to make a browser with search, ## ## simpler than old pmg.helpBrowser. Break that into components ## ## a notebook for holding help pages ## setClass("gHelpbrowserRGtk", ## contains="gComponentRGtk", ## prototype=prototype(new("gComponentRGtk")) ## ) ## setMethod(".ghelpbrowser", ## signature(toolkit="guiWidgetsToolkitRGtk2"), ## function(toolkit, ## title = "Help browser", maxTerms=100, ## width=550, height=600) { ## force(toolkit) ## win = gwindow("Help browser", v=T) ## size(win) <- c(width,height) ## obj=new("gHelpbrowserRGtk",block=win,widget=win,toolkit=toolkit) ## ## obj = list(ref=win) ## ##class(obj) = c("gHelpBrowser","gWidget") ## gp = ggroup(horizontal = FALSE, container = win, expand=TRUE) ## toolbarGroup = ggroup(container = gp) ## ## toolbar = list() ## ## toolbar$quit$handler=function(h,...) dispose(win) ## ## toolbar$quit$icon = "quit" ## ## toolbar$examples$handler=function(h,...) { ## ## ## run example of current topic ## ## lst = svalue(help.notebook) ## ## if(!is.null(lst$topic)) ## ## do.call("example",lst) ## ## } ## ## toolbar$examples$icon = "evaluate" ## ## gtoolbar(toolbar, style="both-horiz", container = toolbarGroup, expand=TRUE) ## # add(toolbarGroup, gbutton("Quit", handler = function(h,...) dispose(win))) ## quitHandler = function(h,...) dispose(win) ## quitButton = ggroup(container=toolbarGroup) ## add(quitButton,gimage("quit",dirname="stock",handler=quitHandler)) ## add(quitButton, glabel("Quit",handler = quitHandler)) ## runExamples = function(h,...) { ## lst = svalue(help.notebook) ## if(!is.null(lst$topic)) ## do.call("example",lst) ## } ## examplesButton = ggroup(container=toolbarGroup) ## add(examplesButton,gimage("evaluate",dirname="stock",handler=runExamples)) ## add(examplesButton, glabel("run examples",handler = runExamples)) ## ## add(toolbarGroup, gbutton("close")) ## addSpring(toolbarGroup) ## ## others? ## searchOptionsList = list( ## "Help on function:" = function(...) NULL, ## "help.search: apropos"=function(...) searchResultsApropos(...), ## "help.search: pattern"=function(...) searchResultsHelpSearch(...) ## ) ## searchOptions = gdroplist(names(searchOptionsList), ## container = toolbarGroup) ## searchBox = gedit("", container = toolbarGroup) ## ## search through packages ## expgp = gexpandgroup("Browse package help pages:",container = gp) ## packageNotebook = gnotebook() ## size(packageNotebook) <- c(400,300) ## # size(packageNotebook) <- c(leftnotebookwidth,notebookheight) ## add(expgp,packageNotebook, expand=TRUE) ## addhandlerchanged(packageNotebook,function(h,...) { ## dispose(h$obj, to.right=TRUE) ## }) # delete to right, when changed ## visible(expgp) <- FALSE ## allPackages = .packages(all=TRUE) ## packageList = gtable(data.frame("Package names"=I(allPackages))) ## add(packageNotebook, packageList,label="All packages") ## addhandlerdoubleclick(packageList, handler = function(h,...) { ## ## get contents, show with filter ## package = svalue(h$obj) ## contents = getContentsOfPackage(package) ## page = ggroup(horizontal=FALSE) ## ## objectList ## if(ncol(contents) >=2) ## objectList <- gtable(contents, filter.column=2) ## else ## objectList <- gtable(contents) ## add(page, objectList, expand=TRUE) ## ## add to packageNotebook ## add(packageNotebook,page, label=Paste("Objects in ",package)) ## addhandlerdoubleclick(objectList,action=package, ## handler=function(h,...) { ## topic = svalue(h$obj) ## package = h$action ## svalue(statusBar) <- Paste("Getting help page for ",topic) ## add(help.notebook,list(topic=topic, package=package)) ## svalue(statusBar) ## svalue(nb) <- 1 # help page ## visible(expgp) <- FALSE ## return(FALSE) ## }) ## return(FALSE) # doubleclick return for no more propogation ## }) ## ################################################## ## nb = gnotebook(tab.pos=3) ## add(gp,nb, expand=TRUE) ## help.notebook = ghelp(tab.pos=1,closebuttons=TRUE) # bottom tab ## emptyDataFrame = data.frame(Title=c(""), Package=c(""),Descr=c("")) ## for(j in 1:3) emptyDataFrame[,j] <- as.character(emptyDataFrame[,j]) ## search.results = gtable(emptyDataFrame, filter.column=2) ## add(nb, help.notebook, label="Help pages") ## add(nb, search.results, label="Search results") ## svalue(nb) <-1 # help page first ## statusBar = gstatusbar(container=gp) ## svalue(statusBar) <- "Enter search term in box, click ENTER to begin" ## ## actions ## ## double click on search results ## addhandlerdoubleclick(search.results, ## handler = function(h,...) { ## vals = svalue(search.results, drop=FALSE) # a data frame ## topic = vals[,1,drop=TRUE] ## package = vals[,2,drop=TRUE] ## svalue(statusBar) <- ## Paste("Getting help page for ",topic) ## add(help.notebook, list(topic=topic, package=package)) ## svalue(statusBar) # pops statusbar? ## ## swap tabs ## svalue(nb) <- 1 ## return(FALSE) # no mas ## }) ## ## make search resuslts -- return dataframe with title, package, description ## ## as character vectors ## searchResultsApropos = function(query) { ## out = help.search(apropos=query, ignore.case = TRUE) ## out = out$matches ## if(nrow(out) > 0) { ## out = out[1:min(nrow(out),maxTerms),c(1,3,2), drop=FALSE] ## } else { ## out = c("no matches","","") ## } ## colnames(out) = c("topic","Package","title") ## out = as.data.frame(out) ## for(j in 1:3) out[,j] <- as.character(out[,j]) # avoid factors ## return(out) ## } ## searchResultsHelpSearch = function(query) { ## out = help.search(pattern=query, ignore.case = TRUE) ## out = out$matches ## if(nrow(out) > 0) { ## out = out[1:min(nrow(out),maxTerms),c(1,3,2), drop=FALSE] ## } else { ## out = c("no matches","","") ## } ## colnames(out) = c("topic","Package","title") ## out = as.data.frame(out, stringsAsFactors = FALSE) ## return(out) ## } ## addhandlerchanged(searchBox, handler = function(h,...) { ## searchType = svalue(searchOptions, index=TRUE) ## svalue(statusBar) <- "Getting to work" ## if(searchType == 1) { ## ## first one is show help page ## topic = svalue(h$obj) ## add(help.notebook,topic) ## } else { ## df = searchOptionsList[[searchType]](svalue(h$obj)) ## ## set value in widget ## search.results[,] <- df ## ## raise search box ## svalue(nb) <-2 ## svalue(statusBar) <-"Double click line to show help page" ## } ## svalue(statusBar) # pops ## }) ## return(obj) ## }) ## ################################################## ## ## these are from old version ## ## contents a matrix with entry, keywords, description and URL ## getContentsOfPackage = function(package=NULL) { ## if(is.null(package)) { ## warning("Empty package name") ## return(NA) ## } ## if(getRversion() < "2.10.0") { ## contents = read.dcf(system.file("CONTENTS",package=package)) ## return(data.frame(Entry=I(contents[,1]),Keywords=I(contents[,3]), ## Description=I(contents[,4]))) ## } else if(getRversion() >= "2.11.0") { ## l <- list(package=package) ## tmp <- do.call("help", l) ## contents <- tmp$info[[2]] ## ## need to strip of white space ## contents <- contents[grepl("^[a-zA-Z]", contents)] ## contents <- sapply(strsplit(contents,"\\s+"), function(i) i[1]) ## contents <- contents[!grepl("^==",contents)] ## contents <- contents[!contents == ""] ## return(data.frame(Entry=contents, stringsAsFactors=FALSE)) ## } ## } gWidgetsRGtk2/R/gslider.R0000644000175100001440000001127713216523364014711 0ustar hornikusers## So much is identical here to gspinbutton, we should make a class to derive these from -- another day. setClass("gSliderRGtk", contains="gComponentRGtk", prototype=prototype(new("gComponentRGtk")) ) setMethod(".gslider", signature(toolkit="guiWidgetsToolkitRGtk2"), function(toolkit, from=0, to=100, by = 1, value=from, horizontal=TRUE, handler=NULL, action=NULL, container=NULL, ...) { force(toolkit) if(length(from) == 1) x <- seq(from, to, by) else x <- from x <- sort(unique(x)) if (horizontal) widget <- gtkHScaleNewWithRange(1L, length(x), 1L) else widget <- gtkVScaleNewWithRange(1L, length(x), 1L) obj <- as.gWidgetsRGtk2(widget) ## obj <- new("gSliderRGtk",block=align, widget=widget, ## toolkit=guiToolkit("RGtk2")) tag(obj, "..byIndexValues") <- x tag(obj, "default_fill") <- ifelse(horizontal, "x", "y") svalue(obj) <- value[1] gSignalConnect(widget, "format-value", function(widget, value, ...) { format(tag(obj, "..byIndexValues")[as.integer(value)], digits=3) }) if (!is.null(container)) { if(is.logical(container) && container == TRUE) container = gwindow(visible=TRUE) add(container, obj,...) } if (!is.null(handler)) { id = addhandlerchanged(obj, handler, action) } invisible(obj) }) ## coerce gtkwidget into scale widget so that methods can work as.gWidgetsRGtk2.GtkHScale <- function(widget, ...) { asgWidgetsRGtk2.SCALE(widget, yscale=0, ...) } as.gWidgetsRGtk2.GtkVScale <- function(widget, ...) { asgWidgetsRGtk2.SCALE(widget, xscale=0, ...) } asgWidgetsRGtk2.SCALE <- function(widget,xscale=1, yscale=1, ...) { if(is.null(widget$parent)) { align <- gtkAlignmentNew(xscale=xscale, yscale=yscale) align$add(widget) obj <- new("gSliderRGtk",block=align, widget=widget, toolkit=guiToolkit("RGtk2")) } else { obj <- new("gSliderRGtk",block=widget, widget=widget, toolkit=guiToolkit("RGtk2")) } return(obj) } ### methods setMethod(".svalue", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gSliderRGtk"), function(obj, toolkit, index=NULL, drop=NULL, ...) { ind <- obj@widget$getValue() if(!is.null(index) && index) return(ind) else return(tag(obj, "..byIndexValues")[ind]) }) setReplaceMethod(".svalue", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gSliderRGtk"), function(obj, toolkit, index=NULL, ..., value) { if(is.null(index) || !index) { ## value is a value, must match value <- as.character(match(value, tag(obj, "..byIndexValues"))) } getWidget(obj)$setValue(value) ## update label? return(obj) }) ## return values ## @param i, j, drop ignored setMethod(".leftBracket", signature(toolkit="guiWidgetsToolkitRGtk2",x="gSliderRGtk"), function(x, toolkit, i, j, ..., drop=TRUE) { tag(x, "..byIndexValues") }) ## non-essential method to dispatch done to leftBracket setReplaceMethod("[", signature(x="gSliderRGtk"), function(x, i, j,..., value) { .leftBracket(x, x@toolkit, i, j, ...) <- value return(x) }) setReplaceMethod(".leftBracket", signature(toolkit="guiWidgetsToolkitRGtk2",x="gSliderRGtk"), function(x, toolkit, i, j, ..., value) { obj <- x widget <- getWidget(obj) curValue <- svalue(obj) value <- sort(unique(value)) tag(obj, "..byIndexValues") <- value widget$setRange(1, length(value)) widget$setIncrements(1L, 1L) # button 1, button 2 svalue(obj) <- curValue ## all done return(obj) }) ### handlers setMethod(".addhandlerchanged", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gSliderRGtk"), function(obj, toolkit, handler, action=NULL, ...) { addhandler(obj, "value-changed", handler, action,...) }) gWidgetsRGtk2/R/ggroup.R0000644000175100001440000002301411635514760014556 0ustar hornikusers## class in aaaClasses.R ## constructor setMethod(".ggroup", signature(toolkit="guiWidgetsToolkitRGtk2"), function(toolkit, horizontal = TRUE, spacing = 5, use.scrollwindow = FALSE, container = NULL, ... ) { force(toolkit) theArgs = list(...) # raise.on.dragmotion if(is.null(spacing)) spacing = 0 if (horizontal) group <- gtkHBoxNew(homogeneous=FALSE, spacing=spacing) else group <- gtkVBoxNew(homogeneous=FALSE, spacing=spacing) ## let breath a little group$SetBorderWidth(0L) ## do we pack into a scroll window? theArgs = list(...) if(use.scrollwindow == TRUE) { ## put into a scroll window sw = gtkScrolledWindowNew() sw$SetPolicy("GTK_POLICY_AUTOMATIC","GTK_POLICY_AUTOMATIC") sw$AddWithViewport(group) obj = new("gGroupRGtk", block=sw, widget=group, toolkit=toolkit) } else { obj = new("gGroupRGtk", block=group, widget=group, toolkit=toolkit) } if(!is.null(container)) { if(is.logical(container) && container == TRUE) container <- gwindow(visible=TRUE, toolkit=toolkit) add(container, obj, ...) } ## raise if we drag across if(!is.null(theArgs$raise.on.dragmotion)) { ## we tried Raise and Focus here, but still have bug ## with windows causing the drop value to flutter away ## after the window is raised. So we cop out and avoid ## this on Window if(.Platform$OS.type != "windows") { ## need drop target before a drag motion!! adddroptarget(obj, handler = function(h,...) {}) ## adddropmotion(obj, handler = function(h,...) getWidget(h$obj)$GetWindow()$Raise()) ## some bug in windows, try focus adddropmotion(obj, handler = function(h,...) focus(obj) <- TRUE) ##getWidget(h$obj)$GetParentWindow()$Focus()) } } return(obj) }) as.gWidgetsRGtk2.GtkVBox <- as.gWidgetsRGtk2.GtkHBox <- function(widget,...) { obj <- new("gGroupRGtk", block=widget, widget=widget, toolkit=guiToolkit("RGtk2")) } ################################################## ## methods ## for gGroup ## methods of expand, anchor ## ... arguments: expand, fill, anchor, padding setMethod(".add", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gGroupRGtk", value="gWidgetRGtk"), function(obj, toolkit, value, ...) { parent <- getWidget(obj) child <- getBlock(value) childWidget <- getWidget(value) theArgs <- list(...) ## get expand, anchor, fill expand <- getWithDefault(theArgs$expand, FALSE) if(!is.null(theArgs$align)) theArgs$anchor <- theArgs$align anchor <- getWithDefault(theArgs$anchor, NULL) if(!is.null(anchor)) { # put in [0,1]^2 anchor <- (anchor+1)/2 # [0,1] anchor[2] <- 1 - anchor[2] # flip yalign } default_fill <- getWithDefault(tag(value, "default_fill"), "both") fill <- getWithDefault(theArgs$fill, default_fill) # x, y or both ## we do things differently if there is a gtkAlignment for a block if(is(child, "GtkAlignment")) { if(expand && (fill =="both" || fill == "x")) { child['xscale'] <- 1 } if(expand && (fill == "both" || fill == "y")) { child['yscale'] <- 1 } if(expand && fill == "") { child['xscale'] <- child['yscale'] <- 1 } if(!is.null(anchor)) { child['xalign'] <- anchor[1] child['yalign'] <- anchor[2] } parent$packStart(child, expand=expand, fill=TRUE, padding=0) } else { ## anchor argument if(!is.null(anchor)) setXYalign(child, childWidget, anchor) ## padding if(is.null(theArgs$padding)) theArgs$padding=0 fill <- expand if(!is.null(theArgs$fill)) { if(theArgs$fill == "both") { fill <- TRUE } else { horizontal <- is(obj@widget, "GtkHBox") if(theArgs$fill == "x" && horizontal) fill <- TRUE else if(theArgs$fill == "y" && !horizontal) fill <- TRUE } } parent$packStart(child, expand, fill, theArgs$padding) } ## This is an example of the pack_start() method. ## box.pack_start(child, expand, fill, padding) ## box is the box you are packing the object into; the first argument is the child object to be packed. The objects will all be buttons for now, so we'll be packing buttons into boxes. ## The expand argument to pack_start() and pack_end() controls whether the widgets are laid out in the box to fill in all the extra space in the box so the box is expanded to fill the area allotted to it (True); or the box is shrunk to just fit the widgets (False). Setting expand to False will allow you to do right and left justification of your widgets. Otherwise, they will all expand to fit into the box, and the same effect could be achieved by using only one of pack_start() or pack_end(). ## The fill argument to the pack methods control whether the extra space is allocated to the objects themselves (True), or as extra padding in the box around these objects (False). It only has an effect if the expand argument is also True. }) setMethod(".add", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gGroupRGtk", value="RGtkObject"), function(obj, toolkit, value, ...) { parent <- getWidget(obj) child <- value childWidget <- getWidget(value) theArgs <- list(...) ## get expand, anchor, fill expand <- getWithDefault(theArgs$expand, FALSE) if(!is.null(theArgs$align)) theArgs$anchor <- theArgs$align anchor <- getWithDefault(theArgs$anchor, NULL) if(!is.null(anchor)) { # put in [0,1]^2 anchor <- (anchor+1)/2 # [0,1] anchor[2] <- 1 - anchor[2] # flip yalign } fill <- getWithDefault(theArgs$fill, "") # "", x, y or both ## we do things differently if there is a gtkAlignment for a block childBlock <- getBlock(value) if(is(childBlock, "GtkAlignment")) { if(expand && (fill =="both" || fill == "x")) { childBlock['xscale'] <- 1 } if(expand && (fill == "both" || fill == "y")) { childBlock['yscale'] <- 1 } if(expand && fill == "") { child['xscale'] <- child['yscale'] <- 1 } if(!is.null(anchor)) { childBlock['xalign'] <- anchor[1] childBlock['yalign'] <- anchor[2] } parent$packStart(child, expand=expand, fill=TRUE, padding=0) } else { if(!is.null(anchor)) setXYalign(child, childWidget, anchor) ## fill only valid when expand is TRUE. ## when horizontal=TRUE (left to right, we always fill top top bottom ("y") so only x counts ## if horizontal=FALSE, only "y" counts fill <- expand if(!is.null(theArgs$fill)) { if(theArgs$fill == "both") { fill <- TRUE } else { horizontal <- is(obj@widget, "GtkHBox") if(theArgs$fill == "x" && horizontal) fill <- TRUE else if(theArgs$fill == "y" && !horizontal) fill <- TRUE } } ## pack it in parent$packStart(child, expand=expand, fill=fill, padding=0) # expand to fill if TRUE } }) setReplaceMethod(".svalue", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gGroupRGtk"), function(obj, toolkit, index=NULL, drop=NULL, ..., value) { ## adds some breathing room to object ## value is pixels getWidget(obj)$SetBorderWidth(as.numeric(value)) return(obj) }) setReplaceMethod(".size", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gGroupRGtk"), function(obj, toolkit, ...,value) { width = value[1]; height = value[2] block = obj@block # use block not widget here in case its a sw block$SetSizeRequest(width, height) return(obj) }) ################################################## ## handlers gWidgetsRGtk2/R/ggrid.R0000644000175100001440000021665012165554270014360 0ustar hornikusers### file for making gtable and gdf. ## TODO: ## * always have rownames, switch for showing ## * ggrid is called by gtable, gdf. So ggrid (not exported) can haeva argument such as doIcons, doRownNames, doFilter, doSort ## ad drin colors for rfg, rbg ## svalue.gtkTreeView and svalue gtkTreeViewColumn ## for column index=TREE returns col.no. o/w vector ## function for showing a vector or data frame setClass("gGridRGtk", contains="gComponentRGtk", prototype=prototype(new("gComponentRGtk")) ) ## constructor for selecting values from a data set -- not meant for editing setMethod(".gtable", signature(toolkit="guiWidgetsToolkitRGtk2"), function(toolkit, items, multiple = FALSE, chosencol = 1, # for drag and drop, value icon.FUN = NULL, filter.column = NULL, filter.labels = NULL, filter.FUN = NULL, # two args gtable instance, filter.labels element handler = NULL, action = NULL, container = NULL, ...) { force(toolkit) obj = .ggrid( toolkit, items=items, multiple = multiple, chosencol = chosencol, editable = FALSE, icon.FUN = icon.FUN, filter.column = filter.column, filter.labels = filter.labels, filter.FUN = filter.FUN, # doSort = FALSE, # makes visible work doSort = TRUE, # makes visible work doRownames = FALSE, handler=handler, action=action, container = container, ...) tag(obj,"type") <- "gtable" ## should be a class -- ughh return(obj) }) ## constructor for editing a data frame setMethod(".gdf", signature(toolkit="guiWidgetsToolkitRGtk2"), function(toolkit, items = NULL, name = deparse(substitute(items)), do.subset = FALSE, container=NULL,...) { force(toolkit) ## the colors theArgs = list(...) .colors = theArgs$colors if(is.null(colors)) .colors = c( bg = "navajo white",fg = "black", rbg = "white smoke",rfg="red" ) obj = NULL if(is.null(items)) { ## popup dialog to get first column, then ring back ## need to use gbasicdialog to make modal group = ggroup(horizontal=FALSE) tbl = glayout(); add(group, tbl, expand=TRUE) theName = gedit("X1") theType = gdroplist(c("numeric","character"))##,"factor")) theNoRows = gspinbutton(from=1,to=100,by=1,value=1) tbl[1,1] = glabel("First variable name:");tbl[1,2] = theName tbl[2,1] = glabel("Its type:");tbl[2,2] = theType tbl[3,1] = glabel("No. rows:");tbl[3,2] = theNoRows visible(tbl) <- TRUE gbasicdialog(title="Describe first variable", widget=group, handler = function(h,...) { tmp = cbind(do.call(paste("as.",svalue(theType),sep=""), list(rep(NA, length=svalue(theNoRows))))) colnames(tmp)[1] = svalue(theName) items <<- tmp }) } obj <- .ggrid( toolkit, items = items, multiple=FALSE, chosencol = 1, editable=TRUE, doFilter=FALSE, doIcons=FALSE, doSort = FALSE, doRownames=TRUE, doSubsetBy = do.subset, handler=NULL, action=NULL, container=container, colors=.colors, diy = theArgs$diy, # suppress ke or popup ...) tag(obj,"type") <- "gdf" ## should be a class -- ughh ## ## add 3rd mouse handler for the view ## lst = list() ## lst$"Apply function to column"$handler = function(h,...) { ## col.no = h$action ## win = gwindow("Apply function to column",visible=TRUE) ## group = ggroup(horizontal = FALSE, container=win) ## glabel("Apply function to column", markup=TRUE, container=group) ## tmpGroup = ggroup(container=group) ## glabel("function(x) = {", markup=TRUE,container=tmpGroup) ## addSpring(tmpGroup) ## FUN = gtext(container=group) ## tmpGroup = ggroup(container=group) ## glabel("}", container=tmpGroup) ## addSpring(tmpGroup) ## buttonGroup = ggroup(container=group) ## addSpring(buttonGroup) ## gbutton("ok",container=buttonGroup,handler = function(h,...) { ## FUN = Paste("function(x) {",svalue(FUN),"}") ## f = eval(parse(text=FUN)) ## theNewVals = f(obj[,col.no, drop=FALSE]) ## obj[,col.no] = theNewVals ## dispose(win) ## }) ## gbutton("cancel",container=buttonGroup, handler = function(h,...) ## dispose(win)) ## } ## lst$"Sort by column (increasing)"$handler = function(h,...) { ## col.no = h$action ## newOrder = order(obj[,col.no], decreasing = FALSE) ## obj[,] = obj[newOrder,] ## ## signal? -- is killing R ## ## cr = view.col$GetCellRenderers()[[1]] ## ## try(cr$SignalEmit("edited"), silent=TRUE) # notify ## } ## lst$"Sort by column (decreasing)"$handler = function(h,...) { ## col.no = h$action ## newOrder = order(obj[,col.no], decreasing = TRUE) ## obj[,] = obj[newOrder,] ## ## signal? ## ## cr = view.col$GetCellRenderers()[[1]] ## ## try(cr$SignalEmit("edited"), silent=TRUE) # notify ## } ## ## can't easily do this, as obj[,] wants to keep the same types ## ## lst$"Coerce column type"$handler = function(h,...) { ## ## colNum = h$action ## ## theData = obj[,colNum,drop=TRUE] ## ## theClass = class(theData) ## ## allClasses = c("numeric","integer","character","factor","logical") ## ## win = gwindow("Coerce column data") ## ## g = ggroup(horizontal=FALSE, cont=win) ## ## add(g,glabel("Select the new column type")) ## ## gdroplist(allClasses,cont=g,selected = which(theClass == allClasses), ## ## handler = function(h,...) { ## ## newClass = svalue(h$obj) ## ## theData = do.call(paste("as.",newClass,sep="",collapse=""),list(theData)) ## ## df = obj[,]; df[,colNum] <- theData ## ## obj[,] <- df ## ## dispose(win) ## ## }) ## ## add(g, gbutton("close",handler = function(...) dispose(win))) ## ## } ## ## rename -- tedious. Was better when label was editable ## lst$"Rename column"$handler = function(h,...) { ## col.no = h$action ## view.col = tag(obj,"view")$GetColumn( ## col.no-1+tag(obj,"doRownames") + tag(obj,"doIcons")) ## win = gwindow("Change name", visible=TRUE) ## group = ggroup(horizontal=FALSE, container=win) ## ok.handler = function(h,...) { ## names(obj)[col.no] <- svalue(h$action) ## dispose(win) ## if(tag(obj,"doSubsetBy")) { ## subsetBy = tag(obj,"subsetBy") ## update(subsetBy) ## } ## return(FALSE) ## } ## newName = gedit(id(view.col),container=group) ## addhandlerchanged(newName, handler=ok.handler, action=newName) ## buttonGroup = ggroup(container=group);addSpring(buttonGroup) ## add(buttonGroup,gbutton("ok", handler = ok.handler, action=newName)) ## add(buttonGroup,gbutton("cancel",handler=function(h,...) dispose(win))) ## return(TRUE) ## } ## f = function(h, widget, event,...) { ## if(event$GetButton() != 3) { ## return(FALSE) # propogate signal ## } else { ## cursor = widget$GetCursor() ## view.col = cursor[["focus_column"]] ## if(is.null(view.col)) { ## view.col = cursor[['focus.column']] # view.col is the column ## } ## column.number = tag(view.col,"column.number") ## if(is.null(column.number)) { ## cat("Select a cell first by clicking once\n") ## return() ## } ## column.number = column.number - 1 + tag(obj,"doRownames") + tag(obj,"doIcons") ## mb = gmenu(h$action, popup = TRUE, action=column.number) # action argument? ## mb = tag(mb,"mb") # actual gtkwidget ## print(class(mb)) ## gtkMenuPopupHack(mb, ## button = event$GetButton(), ## activate.time=event$GetTime(), ## func = NULL ## ) ## return(TRUE) ## } ## } ## ## This isn't working! ## ## addhandler(tag(obj,"view"),signal = "button-press-event", ## ## handler=f, action=lst) ## ## return(obj) }) ## make this generic, its not part of gWidgets API setGeneric(".ggrid",function(toolkit, items, # items to show: vector, matrix or df multiple = FALSE, # allow multiple selection chosencol = 1, # for drag and drop, svalue editable = FALSE, # T -> gDF, F gtable icon.FUN = NULL, # make icons? filter.column = NULL, # do we filter easily? filter.labels = NULL, # if we filter harder filter.FUN = NULL, # two args gtable instance, filter.labels element doIcons = ifelse(is.null(icon.FUN),FALSE, TRUE), doFilter = FALSE, # see belo doSort = TRUE, doRownames = FALSE, doSubsetBy = FALSE, handler = NULL, # double click handler action = NULL, # passed to handler container = NULL, # optional container ...) standardGeneric(".ggrid")) setMethod(".ggrid", signature(toolkit="guiWidgetsToolkitRGtk2"), function(toolkit, items, # items to show: vector, matrix or df multiple = FALSE, # allow multiple selection chosencol = 1, # for drag and drop, svalue editable = FALSE, # T -> gDF, F gtable icon.FUN = NULL, # make icons? filter.column = NULL, # do we filter easily? filter.labels = NULL, # if we filter harder filter.FUN = NULL, # two args gtable instance, filter.labels element doIcons = ifelse(is.null(icon.FUN),FALSE, TRUE), doFilter = FALSE, doSort = TRUE, doRownames = FALSE, doSubsetBy = FALSE, handler = NULL, # double click handler action = NULL, # passed to handler container = NULL, # optional container ...) { force(toolkit) theArgs = list(...) # for colors if(is.null(theArgs$colors)) { theColors = c( bg = "navajo white",fg = "black", rbg = "white smoke",rfg ="red" # fg="black",bg="white", # default for fg and bg # rfg="white",rbg="black" # for rows ) } else { theColors = theArgs$colors # must have names } ## define the object group = ggroup(horizontal=FALSE, container = container, ...) ## make widget=group, later set to view obj = new("gGridRGtk", block=group, widget=group, toolkit=toolkit) tag(obj,"chosencol") <- chosencol tag(obj,"filter.column") <- filter.column # 1:n based tag(obj,"theColors") <- theColors tag(obj,"do.it.yourself") <- theArgs$diy # c("suppress.key","suppress.popup") || NULL ## what are we doing? iconFudge = ifelse(as.logical(doIcons), 1, 0) tag(obj,"doIcons") <- doIcons tag(obj,"icon.FUN") <- icon.FUN tag(obj,"doRownames") <- doRownames ## sort offilter? if(doFilter || !is.null(filter.column) || !is.null(filter.FUN) ) { doFilter <- TRUE } if(doFilter) doSort <- FALSE # can't sort and filter tag(obj,"doSort") <- doSort tag(obj,"doFilter") <- doFilter tag(obj,"doSubsetBy") <- doSubsetBy items = hack.as.data.frame(items) if(class(items)[1] != "data.frame") { warning("The items can not be coerced into a data frame") return(NA) # error message? } m = nrow(items); n = ncol(items) itemsPadded = makePaddedDataFrame( obj, items, visible = rep(TRUE, length=n) ) store = rGtkDataFrame(itemsPadded) tag(obj,"store") <- store ## figure out whether we filter or sort ## do we filter? edit? neither? tag(obj,"editable") <- editable if(tag(obj,"doFilter")) { filter.popup = gdroplist(c("")) # replace with values if defined ## we filter *if$ filter.column is set or if filter.FUN is non null if(!is.null(filter.column)) { ## we filter based on value in this column. Define filter.labels filter.labels = c("",sort(unique(as.character(store[,3*(filter.column+1)])))) filter.FUN = function(obj, filter.by) { if(length(filter.by) == 0 || filter.by == "") { vals = rep(TRUE, dim(obj)[1]) } else { vals = as.character(obj[,filter.column,drop=TRUE]) == as.character(filter.by) } return(vals) } filterGroup = ggroup(container = group) glabel("Filter by:", container=filterGroup) filter.popup = gdroplist(filter.labels, container=filterGroup) } else { if(is.function(filter.FUN)) { filterGroup = ggroup(container = group) glabel("Filter by:", container=filterGroup) filter.popup = gdroplist(filter.labels, container=filterGroup) } } tag(obj,"filter.FUN") <- filter.FUN ## if filter.FUN = is non null and *not* a function, no sorting if(is.function(filter.FUN)) { tag(obj,"filter.popup") <- filter.popup addhandlerchanged(filter.popup, action=obj,handler = function(h,...) { vals = tag(h$action,"filter.FUN")(h$action, svalue(h$obj)) visible(h$action) <- vals }) } } if(doSort) { ##model = gtkTreeModelSort(store) model = store } else { model = store$FilterNew() model$SetVisibleColumn(0) } view <- gtkTreeViewNew(TRUE) view$SetModel(model) tag(obj,"view") <- view tag(view, "gridObj") <- obj # no toolkit inside view obj@widget <- view # replace widget ## add scroll window for tree view sw <- gtkScrolledWindowNew() sw$SetPolicy("GTK_POLICY_AUTOMATIC","GTK_POLICY_AUTOMATIC") sw$Add(view) add(group,sw, expand=TRUE, fill="both") ## properties if(multiple) { treeselection = view$GetSelection() treeselection$SetMode(GtkSelectionMode["multiple"]) } ## turn on alternating shading if more than 1 column if(ncol(items) > 1) view$SetRulesHint(TRUE) ## search view$SetEnableSearch(TRUE) if(doRownames) view$SetSearchColumn(2) else view$SetSearchColumn(3*(chosencol+1)-1) # -1 to put in GTK 0 base ## Now to display the data if(!is.null(icon.FUN)) addIcons(view) for(j in 1:n) { if(tag(obj,"editable")) { view.col = addTreeViewColumnWithEdit(obj,j, colnames(items)[j]) } else { view.col = addTreeViewColumnNoEdit(obj, j, colnames(items)[j]) } } if(tag(obj,"doRownames")) { view.col = addTreeViewColumnWithEdit(obj, 0,"Row.names") } ## do we add subsetBy if(doSubsetBy) { ## now add subset by to group.cycling subsetByGroup = gexpandgroup("subset=", container=group) subsetBy = gsubsetby(obj, container=subsetByGroup, handler = function(h,...) { visValues = h$value return() if(is.na(visValues[1])) visible(h$action) <- rep(TRUE, dim(obj)[2]) else visible(h$action) <- visValues }) tag(obj,"subsetBy")<-subsetBy ## add subsetby to each view.col for a variable for(i in view$GetColumns()) tag(i,"subsetBy") <- subsetBy # sapply(view$GetColumns(), function(view.col) # tag(view.col,"subsetBy") <- subsetBy) } if(tag(obj,"editable") && ((is.null(tag(obj,"do.it.yourself")) || !("suppress.key" %in% tag(obj,"do.it.yourself")))) ) { ## handler for moving around addKeyMotionHandler(obj) } ## add handler for double click if(!is.null(handler)) { id = addhandlerdoubleclick(obj, handler, action) } return(obj) }) ### methods setMethod(".svalue", signature(toolkit="guiWidgetsToolkitRGtk2",obj="GtkTreeView"), function(obj, toolkit, index=NULL, drop=NULL, ...) { svalue(tag(obj,"gridObj"),index, drop, ...) }) setMethod(".svalue", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gGridRGtk"), function(obj, toolkit, index=NULL, drop=NULL,...) { theArgs = list(...) view = tag(obj,"view") indices = .getSelectedIndices(obj,view) ## careful, we may be filtering! vals = visible(obj) if(!is.null(index) && index == TRUE) { ## we may be filtering. Need to undo return(which(vals)[indices]) } ## Now a value. Works if filtering df = obj[vals,,drop=FALSE] if(!is.null(drop) && drop == FALSE) df[indices,,drop=FALSE] else df[indices, tag(obj,"chosencol"), drop=TRUE] # no drop=FALSE here }) ## return indices for the original store, not filtered or sorted .getSelectedIndices = function(obj, view, ...) { selection <- view$GetSelection()$GetSelectedRows()$retval if(length(selection) == 0) return(NULL) store <- view$GetModel() if(is.null(tag(obj,"type")) || tag(obj,"type") == "gdf") { indices <- sapply(selection,function(i) { ind <- store$ConvertPathToChildPath(i)$ToString() as.numeric(ind) + 1 # shift to 1:m base }) } else { indices <- sapply(selection,function(i) { ind <- as.numeric(i$ToString()) as.numeric(ind) + 1 # shift to 1:m base }) } return(indices) } ## set by index value selected value setReplaceMethod(".svalue", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gGridRGtk"), function(obj, toolkit, index=NULL, ..., value) { view <- tag(obj,"view") selection <- view$GetSelection() ## get indices, then select if((!is.null(index) &&index == TRUE) || (is.null(index) && is.numeric(value))) { ind <- as.integer(value) - 1L } else { ## set by value -- not by index curVals <- obj[,tag(obj,"chosencol")] ind <- match(value, curVals) if(length(ind) == 1 && is.na(ind)) { ## exit if no match ind <- NULL selection$unselectAll() return(obj) } ind <- ind -1L } ind <- ind[ind >= 0] # only non-negative indices ## if((!is.null(index) && index == FALSE) || !is.integer(value)) { ## ## get indices, then select ## (is.null(index) && is.integer(value))) { ## ind <- as.character(as.integer(value) - 1L) ## } else { ## ind <- as.character(as.integer(value) - 1L) ## } ## block handlers to quiet down change signal if(length(ind)) { blockhandler(selection) selection$unselectAll() unblockhandler(selection) } else { ## we want to call handler when 0 or negative index selection$unselectAll() } lapply(ind, function(i) { path <- gtkTreePathNewFromString(i) selection$SelectPath(path) }) ## move to cell unless none selected if(is.null(ind) || length(ind) == 0 || (length(ind) ==1 && is.na(ind))) return(obj) i <- min(ind) path <- gtkTreePathNewFromString(i) view$scrollToCell(path) return(obj) }) ## helper function here ## unlike make.names this doesn't put "X" prefix make.row.names <- function(x, unique=TRUE) { dups = duplicated(x) if(any(dups)) x[dups] <- make.names(x,unique=unique)[dups] return(x) } setMethod("[", signature(x="GtkTreeView"), function(x, i, j, ..., drop=TRUE) { .leftBracket(x, x@toolkit, i, j, ..., drop=drop) }) setMethod(".leftBracket", signature(toolkit="guiWidgetsToolkitRGtk2",x="GtkTreeView"), function(x, toolkit, i, j, ..., drop=TRUE) { gwCat("DEBUG: call leftBracket on gtkTreeView: deprecate?\n") gridObj = tag(x,"gridObj") if(missing(i) && missing(j)) tmp = gridObj[,,...,drop=drop] else if(missing(i)) tmp = gridObj[,j,...,drop=drop] if(missing(j)) tmp = gridObj[i,,...,drop=drop] else tmp = gridObj[i,j,...,drop=drop] return(tmp) }) ## refers to the entire data frame ## index returned by svalue(index=T) works here setMethod("[", signature(x="gGridRGtk"), function(x, i, j, ..., drop=TRUE) { .leftBracket(x, x@toolkit, i, j, ..., drop=drop) }) setMethod(".leftBracket", signature(toolkit="guiWidgetsToolkitRGtk2",x="gGridRGtk"), function(x, toolkit, i, j, ..., drop=TRUE) { theArgs = list(...) ## look for visible=TRUE to show only visible items showVisible = ifelse(is.null(theArgs$visible),FALSE,theArgs$visible) ## can't increase size of data frame *or* change the class store <- .getRGtkDataFrame(x) n <- (dim(store)[2] - 2)/3 -1 frame <- store[ , 3*((1:n)+1), drop=FALSE] rownames(frame) <- make.row.names(store[,3]) names(frame) <- names(x) ## handle missing values if(missing(i) && missing(j)) { i = if(showVisible) which(visible(x)) else seq_len(nrow(x)) j = seq_len(n) } else if (missing(i)) { i = if(showVisible) which(visible(x)) else seq_len(nrow(x)) } else if (missing(j)) { j = seq_len(n) } if(showVisible) i = intersect(i,which(visible(x))) ## return return(frame[i,j,drop=drop]) }) ## [<- setReplaceMethod("[", signature(x="GtkTreeView"), function(x, i, j,..., value) { .leftBracket(x, x@toolkit, i, j, ...) <- value return(x) }) setReplaceMethod(".leftBracket", signature(toolkit="guiWidgetsToolkitRGtk2",x="GtkTreeView"), function(x, toolkit, i, j, ..., value) { gridObj = tag(x,"gridObj") if(missing(i) && missing(j)) gridObj[,,...] <- value if(missing(i)) gridObj[,j,...] <- value if(missing(j)) gridObj[i,,...] <- value else gridObj[i,j,...] <- value return(x) }) ## Refers to the entire data frame, unsorted. ## This is kind of a brutal hack. I'd like to add in ## a way to colorize the NA values that are added, but gave up setReplaceMethod("[", signature(x="gGridRGtk"), function(x, i, j,..., value) { .leftBracket(x, x@toolkit, i, j, ...) <- value return(x) }) setReplaceMethod(".leftBracket", signature(toolkit="guiWidgetsToolkitRGtk2",x="gGridRGtk"), function(x, toolkit, i, j, ..., value) { d = dim(x); m= d[1]; n=d[2] dv = dim(as.data.frame(value)) theColors = tag(x,"theColors") store = .getRGtkDataFrame(x) view = tag(x,"view") frame = as.data.frame(store) ## we have to be careful if we are *replacing*. If the size isn't ## the same, then we make a new store. if(missing(i) && missing(j)) { if(dv[2] == 0) dv[2] <- 1 if(dv[2] < n) { warning("Can't replace with fewer columns") return(x) } else if(dv[2] == n) { ## same number of columns. Now rows? ## what size is dv[1]? if(dv[1] == m) { if(m > 0) { ## straight replace -- same no. cols, rows store[,3*((1:n)+1)] <- value if(!is.null(rownames(value))) store[,3] <- rownames(value) return(x) } } else { ## fewer or more rows ## make a new padded rGtkDataFrame, then replace model if(dv[1] == 0) { ## zero out frame = frame[0,,drop=FALSE] } else if(dv[1] < m) { ## fewer rows, same columns frame = frame[1:dv[1],,drop=FALSE] if(dv[1] > 0) # something to replace? frame[,3*((1:n)+1)] <- value ## leave row and column names out of this ## user can replace with dimnames } else { ## more rows, same columns ## need to lengthen data frame ## strategy -- replace first rows, then add one at atime ## for k=1 case value = as.data.frame(value,stringsAsFactors=FALSE) frame[1:m, 3*((1:n)+1)] <- value[1:m,] for(i in (m+1):dv[1]) { replaceList = list(TRUE,"",i,frame[1,4],frame[1,5]) for(k in 1:n) { replaceList[[3*(k+1)]] <- value[i,k] # value replaceList[[3*(k+1)+1]] <- frame[1,3*(k+1)+1] #fg replaceList[[3*(k+1)+2]] <- frame[1,3*(k+1)+2] #bg } frame[i,] <- replaceList } } ## now swap out model in tree view newstore = rGtkDataFrame(frame) if(tag(x,"doSort")) { ##model = gtkTreeModelSort(newstore) model = newstore } else { model = newstore$FilterNew() model$SetVisibleColumn(0) } view$SetModel(model) } } else if(dv[2] > n) { ## more columns, need to extend. ## first get right number of rows ## add /replace rows ## then add columns if(dv[1] <= m) { ## fewer rows, truncate frame = frame[1:dv[1],] } else { ## more rows and more columns, first add rows ## lengthen rows for(i in (m+1):dv[1]) { newRowName = rownames(value)[i] newRowName = make.row.names(c(newRowName,rownames(frame)), unique=TRUE) replaceList = list(TRUE,"",newRowName,frame[1,4],frame[1,5]) for(j in 1:n) { replaceList[[3*(j+1)]] <- value[i,j] # value replaceList[[3*(j+1)+1]] <- frame[1,3*(j+1)+1] #fg replaceList[[3*(j+1)+2]] <- frame[1,3*(j+1)+2] #bg } frame[i,] <- replaceList } } ## finished with rows, ## now we need to add columns. We do so one column at a time for(j in (n+1):dv[2]) { newVals = value[,j,drop=TRUE] newPart = data.frame( a=newVals, b=rep(theColors['fg'],length=dv[1]), c=rep(theColors['bg'],length=dv[1]), stringsAsFactors = FALSE ) names(newPart)[1] <- colnames(value)[j] frame[,(3*(j+1)):(3*(j+1)+2)] = newPart } # frame = adjustNA(value, frame) ## now swap out frame newstore = rGtkDataFrame(frame) if(tag(x,"doFilter")) { model = newstore$FilterNew() model$SetVisibleColumn(0) } else { model = gtkTreeModelSort(newstore) } view$SetModel(model) ## now extend view -- for(j in (n+1):dv[2]) { if(tag(x,"editable")) view.col = addTreeViewColumnWithEdit(x,j, colnames(value)[j]) else view.col = addTreeViewColumnNoEdit(x, j, colnames(value)[j]) } } ## fix up the rownames store = .getRGtkDataFrame(x) if(dv[2] > 1 && dv[1] > 0) store[,3] <- rownames(value) } else { if(missing(i)) { ## no j is missing, just i if(dv[1] != m) { warning("Sorry, you can't shorten or lengthen number of rows without replacing data frame. Try x[,] <- value instead.") return(x) } else { i = 1:m } } else if(missing(j)) { if(length(value) < n) { warning("can't shorten number of columns") return(x) } else if(length(value) > n) { warning("To lengthen data frame, you must replace: x[,]<-value") return(x) } else { j = 1:n } } ## now we can assign with i and j store[i, 3*(j+1) ] <- value } ## fix icons if there` if(tag(x,"doIcons")) { store = .getRGtkDataFrame(x) d <- dim(store) if(d[1] > 0) { n = (d[2]-2)/3 - 1 frame = store[,3*((1:n)+1)] store[,2] = getstockiconname(tag(x,"icon.FUN")(frame)) } } ## update filter if(tag(x,"doFilter") && !is.null(tag(x,"filter.column"))) { popup = tag(x,"filter.popup") vals = frame[,3*(tag(x,"filter.column")+1), drop=TRUE] popup[] <- c("",as.character(sort(unique(vals)))) svalue(popup, index=TRUE) <- 1 } return(x) }) ## first column is the visible row setMethod(".visible", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gGridRGtk"), function(obj,toolkit,set=NULL, ...) { ## visible is only of value if sorting is not taking place if(tag(obj, "doSort")) return(rep(TRUE, dim(obj)[1])) ## not sorting, so first column holds visibility info frame = .getRGtkDataFrame(obj) return(frame[,1, drop=TRUE]) }) ## sets the first column setReplaceMethod(".visible", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gGridRGtk"), function(obj, toolkit, ..., value) { if(tag(obj, "doSort")) { #gwcat(gettext("Can't use visible<- method unless filtering is being used\n")) return(obj) # no means to set } frame = .getRGtkDataFrame(obj) m = nrow(frame) frame[,1] <- rep(value, length=m) try(tag(obj,"view")$GetModel()$Refilter(), silent=TRUE) # show return(obj) }) ## data frame like setMethod(".dim", signature(toolkit="guiWidgetsToolkitRGtk2",x="gGridRGtk"), function(x,toolkit) { store = .getRGtkDataFrame(x) tmp = dim(store) return(c(tmp[1], (tmp[2]-2)/3 - 1)) }) setMethod(".dimnames", signature(toolkit="guiWidgetsToolkitRGtk2",x="gGridRGtk"), function(x,toolkit) { store = .getRGtkDataFrame(x) rownames = make.row.names(store[,3]) colnames = names(x) return(list(rownames, colnames)) }) setReplaceMethod(".dimnames", signature(toolkit="guiWidgetsToolkitRGtk2",x="gGridRGtk"), function(x, toolkit, value) { if(!is.list(value)) stop("value is a list with first element the row names, and second the column names") rnames = value[[1]] cnames = value[[2]] d = dim(x) if(is.null(rnames) || length(rnames) != d[1]) stop("Row names are the wrong size") if(is.null(cnames) || length(cnames) != d[2]) stop("Column names are the wrong size") ## set column names names(x) <- cnames ## set row names store = tag(x,"store") if(is.null(store)) store = tag(x, "store") if(length(rnames) > 0) store[,3] <- make.row.names(rnames) return(x) }) setMethod(".length", signature(toolkit="guiWidgetsToolkitRGtk2",x="gGridRGtk"), function(x,toolkit) return(dim(x)[2])) setMethod(".names", signature(toolkit="guiWidgetsToolkitRGtk2",x="gGridRGtk"), function(x, toolkit) { view.cols = tag(x,"view")$GetColumns() theNames = character(length(view.cols)) for(i in 1:length(view.cols)) theNames[i] = id(view.cols[[i]]) if(tag(x,"doRownames")) theNames = theNames[-1] if(tag(x,"doIcons")) theNames = theNames[-1] return(theNames) }) setReplaceMethod(".size", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gGridRGtk"), function(obj, toolkit, ..., value) { w <- getWidget(obj) if(is.list(value) && !is.null(value$columnWidths)) { colWidths <- value$columnWidths colWidths <- rep(colWidths, length.out=dim(obj)[2]) sapply(seq_len(colWidths), function(i) { col <- w$getColumn(i-1) col$setMinWidth(colWidths[i]) }) } if(is.list(value) && !is.null(value$rowHeights)){ ## no height method } ## width/height now if(is.list(value)) { width <- value$width # possibly NULL height <- value$height } else { width <- value[1] height <- ifelse(length(value) > 1, value[2], -1) } if(is.null(width)) width <- -1 if(is.null(height)) height <- -1 if(!is.null(width)) w$SetSizeRequest(width,height) return(obj) }) setReplaceMethod(".names", signature(toolkit="guiWidgetsToolkitRGtk2",x="gGridRGtk"), function(x, toolkit, value) { ## check that dimensions are correct n = length(x) if (length(value) != n) stop("vector of names is the wrong length") ## fix up names as needed value = make.names(value, unique=TRUE) view.cols = tag(x,"view")$GetColumns() ## which cols depends on rownames sapply(1:n, function(i) { # adding logical id(view.cols[[i + tag(x,"doRownames") + tag(x,"doIcons") ]]) <- value[i] }) return(x) }) ## method to place edit setCursorAtCell = function(obj, i,j,start.editing=TRUE) { if(is(obj,"gGridRGtk") || is(obj,"guiWidget")) view = tag(obj,"view") else view = obj path = gtkTreePathNewFromString(i-1) # offset view.col = view$GetColumn(j-1 + tag(obj,"doRownames")+tag(obj,"doIcons")) # offset view$SetCursor(path=path, focus.column=view.col,start.editing=start.editing) return(TRUE) } ## Functions for colors -- were methods, but didn't use fgcolors = function(obj,i,j, ...) { d = dim(obj) ## return grid of colors if(missing(i)) i = 1:d[1] if(missing(j)) j = 1:d[2] frame = as.data.frame(.getRGtkDataFrame(obj)) frame[i, 3*(j+1)+1, drop=FALSE] } "fgcolors<-" = function(obj, i,j, ..., value) { ## if both missing, assume value repeats down columns d = dim(obj) store = .getRGtkDataFrame(obj) if(missing(i) && missing(j)) { value = rep(value, length=d[2]) #recycle sapply(1:d[2], function(k) store[1:d[1],3*(k+1)+1] <- rep(value[k],length=d[1])) } else if(missing(i)) { ## only assign to j values rep(value, length=length(j)) sapply(1:length(j), function(k) store[1:d[1],3*(j[k]+1)+1] <- rep(value[k],length=d[1])) } else if(missing(j)) { ## assume it runs down rows rep(value, length=length(i)) sapply(1:length(i), function(k) store[i[k],3*((1:d[2])+1)+1] <- rep(value[k],length=d[2])) } else { store[i,3*(j+1)+1] <- value } return(obj) } bgcolors = function(obj, i,j,...) { d = dim(obj) ## return grid of colors if(missing(i)) i = 1:d[1] if(missing(j)) j = 1:d[2] frame = as.data.frame(.getRGtkDataFrame(obj)) frame[i, 3*(j+1)+2, drop=FALSE] } "bgcolors<-" = function(obj, i,j, ..., value) { ## if both missing, assume value repeats down columns d = dim(obj) store = .getRGtkDataFrame(obj) if(missing(i) && missing(j)) { value = rep(value, length=d[2]) #recycle sapply(1:d[2], function(k) store[1:d[1],3*(k+1)+2] <- rep(value[k],length=d[1])) } else if(missing(i)) { ## only assign to j values rep(value, length=length(j)) sapply(1:length(j), function(k) store[1:d[1],3*(j[k]+1)+2] <- rep(value[k],length=d[1])) } else if(missing(j)) { ## assume it runs down rows rep(value, length=length(i)) sapply(1:length(i), function(k) store[i[k],3*((1:d[2]) +1)+2] <- rep(value[k],length=d[2])) } else { store[i,3*j+2] <- value } return(obj) } ## handlers setMethod(".addhandlerdoubleclick", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gGridRGtk"), function(obj, toolkit, handler, action=NULL, ...) { ## need to put onto view -- not group ## id = addhandler(tag(obj,"view"), "row-activated",handler,action) id = addhandler(obj, "row-activated",handler,action,...) invisible(id) }) ## gdf: click on headers -- passed on to each treeview ## gtable: click on row ## note: to block gtable, need blockHandler(getToolkitWidget(b)$getSelection(), id) setMethod(".addhandlerclicked", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gGridRGtk"), function(obj, toolkit, handler, action=NULL, ...) { if(tag(obj,"type") == "gdf") { # hack, should have a class here sapply(tag(obj,"view")$GetColumns(), function(object) { addhandlerclicked(tag(object,"widget"), handler, action,...) }) } else { ## gtable -- put onto selection sel <- obj@widget$GetSelection() ID <- gtktry(connectSignal(sel, signal = "changed", f = function(h,...) { h$handler(h,...) }, data = list(obj=obj, action=action, handler=handler), user.data.first = TRUE, after = FALSE ), silent=TRUE) ## add to selection l <- tag(sel,"handler.id") if(is.null(l)) l <- list() l <- c(l, ID) tag(sel,"handler.id", replace=TRUE) <- l invisible(ID) } }) ## for gdf -- change value ## for gtable -- double click setMethod(".addhandlerchanged", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gGridRGtk"), function(obj, toolkit, handler, action=NULL, ...) { if(tag(obj,"type") == "gdf") { ## apply handler to change of each treeviewcolumn if(!missing(handler)) { # only if handler is not missing view = tag(obj,"view") for(i in view$GetColumns()) addhandlerchanged(i, handler, action,...) } } else { ## gtable -- double click addhandler(obj, "row-activated",handler,action,...) } }) ## Header handlers -- column clicked and columnrightclick setMethod(".addhandlercolumnclicked", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gGridRGtk"), function(obj, toolkit, handler, action=NULL, ...) { ## apply handler to change of each treeviewcolumn if(!missing(handler)) { # only if handler is not missing view = tag(obj,"view") viewCols <- view$getColumns() IDs <- sapply(seq_along(viewCols), function(i) { vc <- viewCols[[i]] widget <- vc$getWidget() widget <- widget$getParent()$getParent()$getParent() addhandlerclicked(widget, handler, action, column=i, ...) }) invisible(IDs) } }) setMethod(".addhandlercolumnrightclick", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gGridRGtk"), function(obj, toolkit, handler, action=NULL, ...) { ## apply handler to change of each treeviewcolumn if(!missing(handler)) { # only if handler is not missing view = tag(obj,"view") viewCols <- view$getColumns() IDs <- sapply(seq_along(viewCols), function(i) { vc <- viewCols[[i]] widget <- vc$getWidget() widget <- widget$getParent()$getParent()$getParent() addhandlerrightclick(widget, handler, action, column=i, ...) }) invisible(IDs) } }) setMethod(".addhandlercolumndoubleclick", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gGridRGtk"), function(obj, toolkit, handler, action=NULL, ...) { ## apply handler to change of each treeviewcolumn if(!missing(handler)) { # only if handler is not missing view = tag(obj,"view") viewCols <- view$getColumns() IDs <- sapply(seq_along(viewCols), function(i) { vc <- viewCols[[i]] widget <- vc$getWidget() widget <- widget$getParent()$getParent()$getParent() addhandlerdoubleclick(widget, handler, action, column=1, ...) }) invisible(IDs) } }) ### helpers ############################### ################## ## internal function ## return the rGtk data frame stored in obj .getRGtkDataFrame = function(obj, ...) { view = tag(obj,"view") model <- view$getModel() if(!is(model, "RGtkDataFrame")) model <- model$getModel() return(model) } ## XXX This is a mess -- replace me one day XXX ## the data frame has columns ## 1 -- visibilit ## 2 -- either rownames or icon names ## (3i, 3i+1, 3i+2) - df[,i],colors[1],colors[2] makePaddedDataFrame <- function(obj, items, visible = rep(TRUE,length=ncol(items)) ) { m = nrow(items) n = ncol(items) cnames = colnames(items) reducedClass <- function(x) { out <- class(x) out[length(out)] } theClass = sapply(items, reducedClass) firstCol = rep(visible, length=m) ## we always add 5 cols at first: visible, icons, rownames, and rfg, rbg ## then for each col, we add 3 values, fg, bg if(is.null(tag(obj,"icon.FUN"))) secondCol = rep("", length=m) else secondCol = getstockiconname(tag(obj,"icon.FUN")(items)) ## go get em -- ugly code, how to make data frame *without* factor class? lst = list() lst[[1]] = firstCol; lst[[2]] = secondCol lst[[3]] = rownames(items) theColors = tag(obj,"theColors") lst[[4]] = rep(theColors['rfg'], length=m) lst[[5]] = rep(theColors['rbg'], length=m) bgColors = rep(theColors["bg"], length=m) fgColors = rep(theColors["fg"], length=m) sapply(1:n, function(j) lst[[3*(j+1)]] <<- items[,j]) sapply(1:n, function(j) lst[[3*(j+1) + 1]] <<- fgColors) # foreground first sapply(1:n, function(j) lst[[3*(j+1) + 2 ]] <<- bgColors) # frame = do.call("data.frame", lst) frame <- data.frame(lst, stringsAsFactors=FALSE) ## coerce to proper class frame[,1] <- as.logical(frame[,1]) # visible ## for(i in 2:5) frame[,i] = as.character(frame[,i]) ## for(j in seq_along(n)) { ## if(theClass[j] != "AsIs") ## frame[,3*(j+1)] = do.call(Paste("as.",theClass[j]), ## list(x=frame[,3*(j+1)])) ## frame[,3*(j+1) + 1] = as.character(frame[,(3*(j+1)+1)]) ## frame[,3*(j+1) + 2] = as.character(frame[,(3*(j+1)+2)]) ## } ## if we want to trap NA values, this works # ## for NA values, we change colors # areNA = which(is.na(items), arr.ind=TRUE) # if(is.matrix(areNA)) { # lst = split(areNA, areNA[,2]) # for(j in names(lst)) { # i = lst[[j]]; if(is.matrix(i)) i = i[,1] # frame[i,3*(as.numeric(j)+1) + 1] = theColors["nafg"] # frame[i,3*(as.numeric(j)+1) + 2] = theColors["nabg"] # } # } ## colnames colNames = rep("",3*n+2) colNames[1] = "visible"; colNames[2]="icons" colNames[3] = "Row.names" colNames[4] = "rfg"; colNames[5] = "rbg" colNames[3*((1:n)+1)] = cnames colNames[3*((1:n)+1) + 1] = paste("fgCol",1:n, sep="") colNames[3*((1:n)+1) + 2] = paste("bgCol",1:n, sep="") colnames(frame) <- colNames return(frame) } addIcons = function(view) { cellrenderer = gtkCellRendererPixbufNew() view.col = gtkTreeViewColumnNew() view.col$PackStart(cellrenderer, TRUE) view.col$AddAttribute(cellrenderer, "stock-id", 1) view$InsertColumn(view.col,0) } ## j is in 1:n *or* 0 for rownames addTreeViewColumnNoEdit <- function(obj, j,label) { view <- tag(obj, "view") cellrenderer <- gtkCellRendererTextNew() view.col <- gtkTreeViewColumnNew() view.col$PackStart(cellrenderer, TRUE) id(view.col) <- label ## store these tag(view.col,"column.number") <- j# add this for later usage tag(view.col,"view") <- view tag(view.col,"gridObj") <- obj ## properties view.col$SetResizable(TRUE) view.col$SetClickable(TRUE) if(tag(obj,"doSort")) { view.col$SetSortColumnId(3*(j+1) - 1) } ## ## TOO SLOW and does' ## view.col$SetCellDataFunc(cellrenderer, func= ## function(vc, cr, model, iter, data) { ## curVal <- model$getValue(iter, data)$value ## cr['text'] <- if(is.na(curVal)) { ## "NA" ## } else if(is.nan(curVal)) { ## "NaN" ## } else if(is.null(curVal)) { ## "NULL" ## } else { ## curVal ## } ## cr['foreground'] <- model$getValue(iter, data + 1)$value ## cr['background'] <- model$getValue(iter, data + 2)$value ## }, ## func.data = 3*(j+1) - 1 + tag(obj,"doIcons") + tag(obj,"doRownames")) view.col$AddAttribute(cellrenderer, "text", 3*(j+1) - 1) if(!is.null(tag(obj,"type")) && tag(obj,"type") == "gdf") { view.col$AddAttribute(cellrenderer,"foreground",3 *(j+1) + 1 - 1) view.col$AddAttribute(cellrenderer,"background",3 *(j+1) + 2 - 1) } view$InsertColumn(view.col, j - 1 + tag(obj,"doIcons") + tag(obj,"doRownames")) return(view.col) } ################################################## ### Define some key functions ### this is the main handler for editing data ## movement after editing is wanky! This pushes down a row, then the ## handler on the view starts editing. Unfortunately, it doesn't ## save then move edit.handler = function(h,cell,path,newtext) { if(is.null(path) || is.null(newtext)) return(FALSE) # propogate ## get position obj = h$action # the gGrid object column.number = h$column.number store = .getRGtkDataFrame(obj) i = as.numeric(path) + 1 # row ## if visible, we need to adjust i to point to right row if(colnames(store)[1] == "visible") i <- which(store[,"visible", drop=TRUE])[i] j = column.number ## coerce newtext from text to proper class theColData = obj[,j] if(is.integer(theColData)) { newtext = as.integer(newtext) } else if(is.numeric(theColData)) { newtext = as.numeric(newtext) } else if(is.character(theColData)) { newtext = as.character(newtext) } else if(is.factor(theColData)) { if(newtext %in% levels(theColData)) { ## nothing } else { levels(obj[,j]) = c(levels(theColData), newtext) ## was df ## tried a popup window, didn't work } } else if(is.logical(theColData)) { newtext = as.logical(newtext) } else { newtext = newtext # nothing p } ## update foreground color == if was NA then fg=bg store[i,3*(j+1)] = newtext if(j == 0) { store[i,3*(j+1)+1] = tag(obj,"theColors")['rfg'] store[i,3*(j+1)+2] = tag(obj,"theColors")['rbg'] } else { store[i,3*(j+1)+1] = tag(obj,"theColors")['fg'] store[i,3*(j+1)+2] = tag(obj,"theColors")['bg'] } ## update subsetby if there doSubsetBy = tag(obj,"doSubsetBy") # a logical or noull if(!is.null(doSubsetBy) && doSubsetBy) update(tag(obj,"subsetBy")) return(TRUE) } addTreeViewColumnWithEdit = function(obj, j,label) { view = tag(obj,"view") cellrenderers = tag(obj,"cellrenderers") if(is.null(cellrenderers)) { cellrenderers = list() tag(obj,"cellrenderers") <- cellrenderers } cellrenderer = gtkCellRendererTextNew() tag(obj,"cellrenderers") <- c(cellrenderers, cellrenderer) ## store to test ## properties gObjectSet(cellrenderer,"editable"=TRUE) gObjectSet(cellrenderer,"rise"=-10) view.col = gtkTreeViewColumn() ## add these for later usage tag(view.col,"column.number") <- j tag(view.col,"view") <- view tag(view.col,"gridObj") <- obj view.col$SetResizable(TRUE) # view.col$SetClickable(TRUE) ## cell renderers view.col$PackStart(cellrenderer, TRUE) id(view.col) <- label ## Need to fix this up, if numeric then editable is wanky view.col$AddAttribute(cellrenderer, "text", 3*(j+1) - 1) view.col$AddAttribute(cellrenderer,"foreground",3 *(j+1) + 1 - 1) view.col$AddAttribute(cellrenderer,"background",3 *(j+1) + 2 - 1) ## edit signal callbackId = gtktry(connectSignal(cellrenderer, signal = "edited", f=edit.handler, data = list(obj=cellrenderer,action=obj,column.number = j), user.data.first = TRUE, after=FALSE), silent=TRUE) ## view$InsertColumn(view.col, j - 1 + tag(obj,"doIcons") + tag(obj,"doRownames")) ## fix up a bit addDragAndDropToViewCol(view.col) ## add popup unless asked not to. (YN suggestion) if(is.null(tag(obj,"do.it.yourself")) || !("suppress.popup" %in% tag(obj,"do.it.yourself"))) addPopupMenuToViewCol(view.col) ## return the column return(view.col) } addPopupMenuToViewCol = function(view.col) { view.col$SetClickable(TRUE) # make clickable headers lst = list() lst$"Apply function to column"$handler = function(h,...) { win = gwindow("Apply function to column",visible=TRUE) group = ggroup(horizontal = FALSE, container=win) glabel("Apply function to column", markup=TRUE, container=group) tmpGroup = ggroup(container=group) glabel("function(x) = {", markup=TRUE,container=tmpGroup) addSpring(tmpGroup) FUN = gtext(container=group) tmpGroup = ggroup(container=group) glabel("}", container=tmpGroup) addSpring(tmpGroup) buttonGroup = ggroup(container=group) addSpring(buttonGroup) gbutton("ok",container=buttonGroup,handler = function(h,...) { obj = tag(view.col,"gridObj") FUN = Paste("function(x) {",svalue(FUN),"}") f = eval(parse(text=FUN)) col.no = tag(view.col,"column.number") ## not correct: - 1 # rownames offset oldVals = obj[,col.no, drop=FALSE] theNewVals = f(oldVals) obj[,col.no] = theNewVals dispose(win) }) gbutton("cancel",container=buttonGroup, handler = function(h,...) dispose(win)) } ## lst$"Clear column"$handler = function(h,...) { ## col.no = tag(view.col,"column.number") ## - 1 # rownames offset ## obj[,col.no] = rep(NA, length(view.col)) ## } lst$"Sort by column (decreasing)"$handler = function(h,...) { col.no = tag(view.col,"column.number") ## - 1 # rownames offset newOrder = order(obj[,col.no], decreasing = TRUE) obj[,] = obj[newOrder,] # rownames(obj) = rownames(obj)[newOrder] ## signal? ## cr = view.col$GetCellRenderers()[[1]] ## try(cr$SignalEmit("edited"), silent=TRUE) # notify } lst$"Sort by column (increasing)"$handler = function(h,...) { col.no = tag(view.col,"column.number") ## - 1 # rownames offset newOrder = order(obj[,col.no], decreasing = FALSE) obj[,] = obj[newOrder,] # rownames(obj) = rownames(obj)[newOrder] ## signal? -- is killing R ## cr = view.col$GetCellRenderers()[[1]] ## try(cr$SignalEmit("edited"), silent=TRUE) # notify } lst$"Rename column"$handler = function(h,...) { win = gwindow("Change name", visible=TRUE) group = ggroup(horizontal=FALSE, container=win) ok.handler = function(h,...) { newVal = make.names(svalue(h$action)) id(view.col) <- newVal ## signal ## cr = view.col$GetCellRenderers()[[1]] ## try(cr$SignalEmit("edited"), silent=TRUE) # notify dispose(win) if(!is.null(tag(obj,"doSubsetBy")) && tag(obj,"doSubsetBy") ) # update(tag(obj,"subsetBy")) # update return(FALSE) } newName = gedit(id(view.col),container=group) addhandlerchanged(newName, handler=ok.handler, action=newName) buttonGroup = ggroup(container=group);addSpring(buttonGroup) add(buttonGroup,gbutton("ok", handler = ok.handler, action=newName)) add(buttonGroup,gbutton("cancel",handler=function(h,...) dispose(win))) return(TRUE) } ## define this so that it gets picked up in popup handlers obj = tag(view.col,"gridObj") ## put popup onto this guy -- button doesn't get 3rd mouse signal widget = tag(view.col,"widget") gtkbutton = view.col$GetWidget()$GetParent()$GetParent()$GetParent() ## was widget # add3rdmousepopupmenu(widget, menulist=lst) add3rdmousepopupmenu(gtkbutton, menulist=lst) # add3rdmousepopupmenu(tag(view.col,"header"), menulist=lst) } ## drag and drop handler on button oflabel addDragAndDropToViewCol = function(view.col) { ## the widget is set by the "id<-" method ## this attaches an event box to the GetWidget() # gtkbutton = view.col$GetWidget()$GetParent()$GetParent()$GetParent() force(adddropsource(view.col$GetWidget()$GetParent()$GetParent()$GetParent(), targetType="object", action = view.col)) } ### This one moves the cursor and then sets the state to editing addKeyMotionHandler = function(obj, ...) { view = tag(obj,"view") addhandler(view,"key-release-event",action=obj,handler=function(h,widget,event,...) { obj = h$action d = dim(obj) keyval = event$GetKeyval() cursor = widget$GetCursor() ## i,j are current positions, i = cursor$path$ToString() i = as.numeric(i) + 1 # in 1:m coordinates view.col = cursor[['focus_column']] # view.col is the column if(is.null(view.col)) { view.col = cursor[['focus.column']] # view.col is the column } j = tag(view.col,"column.number") ## where to move to if( keyval == GDK_Down ) { ## do we need to add a new row? ## for down arrow we can, for enter we don't if(i == d[1]) { frame = obj[,,drop=FALSE] ## pad with NA values lst = list();for(tmp in 1:d[2]) lst[[tmp]]=NA frame[d[1]+1,] = lst obj[,] = frame } ## move down setCursorAtCell(obj,i+1,j, start.editing=TRUE) } else if(keyval == GDK_Return) { if(i !=d[1]) i = i+ 1 # dont add unless downarrow setCursorAtCell(obj, i, j, start.editing=TRUE) } else if( keyval == GDK_Up) { if(i > 1) # can't go too long i = i - 1 setCursorAtCell(obj, i, j, start.editing=TRUE) } else if(keyval == GDK_Tab) { ## move to right ## add new column if at d[2] already ## Add dialog in case we are at last column if(j == d[2]) { setCursor = FALSE addNewColumnDialog(obj,i, j) } else { setCursorAtCell(obj, i, j + 1, start.editing=TRUE) } } return(TRUE) }) } ## Dialog to add a new column addNewColumnDialog <- function(obj, i, j, ...) { view = tag(obj,"view") ## need to popup a dialog to gather name and class, set view win = gwindow("Add column") group = ggroup(horizontal=FALSE, container=win) tbl = glayout() colName = gedit(paste("X",j+1,sep="")) ## logical is a problem in showing (shows as TRUE even if NA) colClass = gdroplist(c("numeric","character"))##,"factor"))##,"logical")) tbl[1,1] = glabel("Column name:") tbl[1,2] = colName tbl[2,1] = glabel("Column class") tbl[2,2] = colClass visible(tbl) <- TRUE add(group, tbl, expand=TRUE) buttonGroup = ggroup(container=group) addSpring(buttonGroup) gbutton("ok",container=buttonGroup, handler =function(h,...) { frame = obj[,,drop=FALSE] type = svalue(colClass) nRows = dim(obj)[1] if(type == "numeric") { x = rep(NA,length=nRows) x = as.numeric(x) newframe = data.frame(frame,x) } else if(type == "character") { x = character(dim(obj)[1]) newframe = data.frame(frame,x,stringsAsFactors=FALSE) } else if(type == "factor") { x = character(dim(obj)[1]) newframe = data.frame(frame,x,stringsAsFactors=TRUE) } names(newframe)[dim(obj)[2]+1] <- svalue(colName) obj[,] <- newframe ## need to set cursor here, as this happens after the setCursor below setCursorAtCell(obj, i,j+1, start.editing=TRUE) ## clean up dispose(win) return(TRUE) }) gbutton("cancel", container=buttonGroup, handler=function(h,...) { dispose(win) }) } ################################################## addColumn = function(obj, x, name=NULL) { store = .getRGtkDataFrame(obj) d = dim(obj) x = rep(x, length=d[1]) # recycle theColors = tag(obj,"theColors") fgColor = rep(theColors['fg'], length=d[1]) bgColor = rep(theColors['bg'], length=d[1]) toAdd = data.frame(x,fg=fgColor, bg=bgColor) if(is.character(x)) toAdd[,1] = as.character(x) for(i in 2:3) toAdd[,i] = as.character(toAdd[,i]) store$AppendColumns(toAdd) if(is.null(name)) name = paste("X",d[2]+1,sep="") view.col = addTreeViewColumnNoEdit(obj, d[2]+1, name) } addRow = function(obj, x, ...) { store = .getRGtkDataFrame(obj) d = dim(obj) dstore = dim(store) if(is.null(x)) x = rep(NA,length=d[2]) if(length(x) != d[2]) { warning("Need to add same size row or no row") return() } theRow = list(); theColors = tag(obj,"theColors") theRow[[1]] = TRUE; theRow[[2]]="" sapply(1:d[2], function(i) theRow[[3*i]] <<- x[[i]]) sapply(1:d[2], function(i) theRow[[3*i + 1]] <<- theColors['fg']) sapply(1:d[2], function(i) theRow[[3*i + 2]] <<- theColors['bg']) store$AppendRows(theRow) } ## subsetBy part ################################################## ## subset by widget -- specific to gDF object ################################################## ## here action, after values, gives an environment to evaluate variables within setClass("gSubsetbyRGtk", contains="gComponentRGtk", prototype=prototype(new("gComponentRGtk")) ) setGeneric("gsubsetby",function(gridObj, handler = NULL, action = NULL, # when changed container=NULL, ...) standardGeneric("gsubsetby")) setMethod("gsubsetby", signature(gridObj = "gGridRGtk"), function(gridObj, handler = NULL, action = NULL, # when changed container=NULL, ...) { vars = names(gridObj) group = ggroup(container = container, ...) subsetVar = gdroplist(c("NA",vars), selected=1,container = group) subsetHow = gdroplist(c(""), editable=TRUE, selected=1, container=group) size(subsetVar) <- c(25*8, 30) size(subsetHow) <- c(25*8, 30) leftArrow = gimage("larrow",dirname="stock",container = group) rightArrow = gimage("rarrow",dirname="stock",container = group) obj = new("gSubsetbyRGtk", block=group,widget=group,toolkit=gridObj@toolkit) tag(obj, "subsetVar") <- subsetVar tag(obj, "subsetHow") <- subsetHow tag(obj, "leftArrow") <- leftArrow tag(obj, "rightArrow") <- rightArrow tag(obj, "vars") <- vars tag(obj, "handler") <- handler tag(obj, "action") <- gridObj ## add handlers ## changing var name resets subsetHow addhandlerchanged(subsetVar, handler = function(h,...) { varName = svalue(subsetVar) if(!length(varName) || varName == "NA") { subsetHow[] = c("") } else { theColumn = which(varName == names(gridObj)) theValues = gridObj[,theColumn, drop=TRUE] theValues = sort(unique(theValues)) if(is.factor(theValues)) theValues = as.character(theValues) if(is.character(theValues)) theValues = paste(paste('"',theValues,sep=""), '"', sep = "") # quote subsetHow[] = c("",paste("==",theValues,sep=" ")) } svalue(subsetHow,index=TRUE) <- 1 }) ## changing subsetHow updates gridobject addhandlerchanged(subsetHow,handler = function(h,...) { how = svalue(subsetHow) if(is.empty(how)) { visible(gridObj) <- rep(TRUE, nrow(gridObj)) } else { theColumn = which(svalue(subsetVar) == names(gridObj)) theValues = gridObj[,theColumn] # using name to extract column if(is.factor(theValues)) theValues = as.character(theValues) ## subsetHow of the form '== value' cmd = paste("theValues",svalue(subsetHow),collapse="") whichRows = gtktry(eval(parse(text=cmd)),silent=TRUE) if(!inherits( whichRows, "try-error")) { whichRows[is.na(whichRows)] <- FALSE visible(gridObj) <- whichRows } } }) addhandlerclicked(leftArrow, handler = function(h,...) { subsetHow = tag(obj,"subsetHow") setValues = subsetHow[] curIndex = svalue(subsetHow,index=TRUE) n = length(setValues) if(is.na(curIndex)) curIndex = 2 # then newi = 1 newIndex = (curIndex-2)%%n+1 # faster than ifelse? svalue(subsetHow,index=TRUE) <- newIndex return(TRUE) }) addhandlerclicked(rightArrow, handler = function(h,...) { subsetHow = tag(obj,"subsetHow") setValues = subsetHow[] curIndex = svalue(subsetHow,index=TRUE) n = length(setValues) if(is.na(curIndex)) curIndex = n # then newi = 1 newIndex = curIndex %% n + 1 ## really (i-1)+1 mod n + 1 svalue(subsetHow,index=TRUE) <- newIndex return(TRUE) }) return(obj) }) ################################################## ## methods ## this updates the names in subsetVar setMethod("update", signature(obj="gSubsetbyRGtk"), function(object, ...) { obj = object # subsetby guy gridObj = tag(obj,"action") tag(obj,"subsetVar")[] <- c("NA",names(gridObj)) }) setMethod("length", signature(x="gSubsetbyRGtk"), function(x) { gwCat("DEBUG: length called on gSubsetbyRGtk\n") }) ## returns a vector of TRUE or FALSE setMethod("svalue", signature(obj="gSubsetbyRGtk"), function(obj, index=NULL, drop=NULL, ...) { subsetVar = tag(obj, "subsetVar") subsetHow = tag(obj, "subsetHow") varName = svalue(subsetVar) if(!length(varName) || varName == "NA") return(NA) ## have a variable values = svalue(varName) assign(varName,values) condition = svalue(subsetHow) ret = eval(parse(text=Paste(varName, condition))) return(ret) }) ## put onto the both widgets setMethod("addhandlerchanged", signature(obj="gSubsetbyRGtk"), function(obj, handler=NULL, action=NULL, ...) { subsetVar = tag(obj, "subsetVar") subsetHow = tag(obj, "subsetHow") lst = list() lst[["subsetVar"]] <- addhandlerchanged(subsetVar, handler, action) ### It seems that this can cause a loop: subsetHow->ggrid->tvCol->subsetBy->subsetHow lst[["subsetHow"]] <- addhandlerchanged(subsetHow, handler, action) ### why is this buggy? ## return(lst) # return IDS }) ## redirect to above setMethod(".addhandlerchanged", signature(toolkit="guiWidgetsToolkitRGtk2", obj="gSubsetbyRGtk"), function(obj, toolkit, handler, action=NULL, ...) { addhandlerchanged(obj, handler, action, ...) }) gWidgetsRGtk2/R/gtkStuff.R0000644000175100001440000002112113216523701015035 0ustar hornikusers## try without stack smashing gtktry = function(expr, silent=TRUE) { tryCatch(expr, error = function(e) { gwCat(sprintf("Error: %s\n",e)) msg = conditionMessage(e) invisible(structure(msg, class = "try-error")) }) } ## set alignment #Sets the alignment of the child. This property has no effect unless the child is a GtkMisc or a GtkAligment. # xalign : the horizontal position of the child, 0.0 is left aligned, 1.0 is right aligned # yalign : the vertical position of the child, 0.0 is top aligned, 1.0 is bottom aligned setXYalign <- function(child, childWidget, anchor) { if(is(child,"GtkMisc") || is(child,"GtkAlignment")) { child['xalign'] <- anchor[1] child['yalign'] <- anchor[2] } else if(!is.null(childWidget)) { if(is(childWidget,"GtkMisc") || is(childWidget,"GtkAlignment")) { childWidget['xalign'] <- anchor[1] childWidget['yalign'] <- anchor[2] } } } ## return gtk objects from others getBlock <- function(widget) { if(inherits(widget,"")) return(NULL) if(is(widget,"RGtkObject")) return(widget) if(is(widget,"gWidgetRGtk")) return(getBlock(widget@block)) if(is(widget,"guiWidget")) return(getBlock(widget@widget)) gwCat(gettext("Can't get block")) return(NULL) } ## return NA or widget getWidget <- function(widget) { if(inherits(widget,"")) return(NULL) while(!is(widget,"RGtkObject")) { if(inherits(widget,"")) return(NULL) widget = widget@widget } widget } ## return GtkWindow if possible getGtkWindow = function(widget) { if(inherits(widget,"guiContainer") || inherits(widget,"guiComponent")) widget = getToolkitWidget(widget) while(!is(widget,"GtkWindow")) { widget = widget$GetParent() if(inherits(widget,"")) return(NULL) } return(widget) } ## Method to interact with toolkit objects setMethod(".getToolkitWidget", signature(obj="gWidgetRGtk", toolkit="guiWidgetsToolkitRGtk2"), function(obj, toolkit) getWidget(obj)) ## setMethod(".callToolkitMethod", ## signature(x="gWidgetRGtk", toolkit="guiWidgetsToolkitRGtk2"), ## function(x, toolkit, meth_name) { ## widget <- getWidget(x) ## RGtk2:::.getAutoMethodByName(widget, meth_name, parent.frame()) ## }) setMethod(".getToolkitProperty", signature(x="gWidgetRGtk", toolkit="guiWidgetsToolkitRGtk2"), function(x, toolkit, property) { widget <- getWidget(x) RGtk2::gObjectGet(widget,property) }) setMethod(".setToolkitProperty", signature(x="gWidgetRGtk", toolkit="guiWidgetsToolkitRGtk2"), function(x, toolkit, property, value) { widget <- getWidget(x) widget[property] <- value x }) RtoGObjectConversion = function(obj) { if(inherits(obj,"gComponent")) return("GObject") if(is.list(obj)) return("GObject") Klasse = class(obj)[1] # silly name? switch(Klasse, "integer"="gint", "numeric"="gdouble", "gtk"="GObject", "logical" = "gboolean", "gchararray" ) } ################################################## ## ## gtkTreeViewColumn stuff setMethod("svalue",signature(obj="GtkTreeViewColumn"), function(obj, index=NULL, drop=NULL, ...) { theArgs = list(...) index = ifelse(is.null(index),FALSE, as.logical(index)) drop = ifelse(is.null(drop), TRUE, as.logical(drop)) ## is this a treeviewCOlumn that ggrid made? col.no = gtktry(tag(obj,"column.number"), silent=TRUE) if(inherits(col.no,"try-error")) return(NA) ## return index if requested if(index) return(col.no) ## else return the values gridObj = tag(obj,"gridObj") vals = gridObj[,col.no, visible=TRUE, drop=drop] # only show visible return(vals) }) setMethod("id",signature(obj="GtkTreeViewColumn"), function(obj, ...) { curname = tag(obj,"name") if(is.null(curname) || length(curname) == 0) { # gwCat(gettext("No name for this view column\n")) return(NA) } else { return(curname) } }) setReplaceMethod("id",signature(obj="GtkTreeViewColumn"), function(obj, ..., value) { curname = tag(obj,"name") if(is.null(curname) || length(curname) == 0) { ## not there, set it label = glabel(value) tag(obj,"widget") <- label ## set in view col widget <- getBlock(label) ## block is event box obj$setWidget(widget) # print(class(widget)) # tag(obj,"header") <- widget$getParent()$getParent()$getParent() } else { ## store in widget svalue(tag(obj,"widget"))<-value } tag(obj,"name") <- value return(obj) }) setMethod("addhandlerchanged",signature(obj="GtkTreeViewColumn"), function(obj, handler=NULL, action=NULL, ...) { lst = list() # store ids for handlers lst[["cellrenderer"]] = addhandler(obj$GetCellRenderers()[[1]], signal = "edited", handler = handler, action = action ) ## If view column comes from gdf.R then subsetBy is stored in object ## so changes there will propogate adding change to underlying model ## proved too slow as it seems to get called repeatedly, and ## wouldn't stop by setting return value gridObj = tag(obj,"gridObj") if(!is.null(gridObj)) { doSubsetBy = tag(gridObj,"doSubsetBy") if(!is.null(doSubsetBy) && as.logical(doSubsetBy) == TRUE) { subsetBy = tag(gridObj,"subsetBy") lst[["subsetBy"]] = addhandlerchanged(subsetBy, handler, action) } } return(lst) }) setMethod("addHandlerChanged",signature(obj="GtkTreeViewColumn"), function(obj, handler=NULL, action=NULL, ...) { addhandlerchanged(obj,handler=handler,action=action,...) }) setMethod("removehandler",signature(obj="GtkTreeViewColumn"), function(obj, ID=NULL,...) { removehandler(obj$GetCellRenderers()[[1]],ID,...) }) setMethod("removeHandler",signature(obj="GtkTreeViewColumn"), function(obj, ID=NULL,...) { removehandler(obj,ID=ID,...) }) ## fix up [ for RGtkDataFrame ## is this needed? setMethod("[", signature(x="RGtkDataFrame"), function(x, i, j, ..., drop=TRUE) { .leftBracket(x, guiToolkit("RGtk2"), i, j, ..., drop=drop) }) setMethod(".leftBracket", signature(toolkit="guiWidgetsToolkitRGtk2",x="RGtkDataFrame"), function(x, toolkit, i, j, ..., drop=TRUE) { frame <- as.data.frame(x) #if (!missing(i) && length(i) > 0 && inherits(i[[1]], "GtkTreePath")) # i <- .RGtkCall("R_gtk_tree_paths_to_indices", i)+1 if(missing(i) && missing(j)) frame[, , drop=drop] else if(missing(i)) frame[,j, drop=drop] else if(missing(j)) frame[i,, drop=drop] else frame[i,j,drop=drop] }) ## which versino of RGtk2 getRGtk2Version = function() { m = installed.packages() ver = m["RGtk2","Version"] ver = unlist(strsplit(ver,"\\.")) names(ver) <- c("major","minor","version") return(ver) } ## Determin which OS ## is windows the OS? ## ## @return TRUE or FALSE isWindows <- function() { } ## is windows the OS? ## ## @return TRUE or FALSE isMac <- function() { } ## is windows the OS? ## ## @return TRUE or FALSE isUNIX <- function() { } ## mouse click processing ## Return TRUE if first mouse click ## ## To be called from key-press|release-event ## @param e event for mouse press ## @return TRUE or FALSE isFirstMouseClick <- function(e) { if(!is(e, "GdkEvent")) stop("Must pass in an event") e$getButton() == 1 } ## Return TRUE/FALSE if right mouse click ## ## To be called from key-press|release-event ## @param e event for mouse press ## @return TRUE or FALSE isRightMouseClick <- function(e) { if(!is(e, "GdkEvent")) stop("Must pass in an event") e$GetButton() == 3 || (Sys.info()["sysname"] == "Darwin" && e$GetState() == GdkModifierType['control-mask'] && e$GetButton() == 1) } gWidgetsRGtk2/R/gwindow.R0000644000175100001440000002443413216523763014740 0ustar hornikuserssetClass("gWindowRGtk", contains="gContainerRGtk", prototype=prototype(new("gContainerRGtk")) ) ## constructor setMethod(".gwindow", signature(toolkit="guiWidgetsToolkitRGtk2"), function(toolkit, title="Window", visible=TRUE, width = NULL, height = NULL, parent = NULL, handler=NULL, action = NULL, ... ) { force(toolkit) window <- gtkWindowNew("toplevel", show = FALSE) window$SetTitle(title) ## set default size give 400 x 280 default if(is.null(width)) width <- 400 if(is.null(height)) height = .7*width window$SetDefaultSize(width, height) ## set location -- renamed to parent location <- parent if(!is.null(location)) { if(inherits(location,"guiContainer") || inherits(location,"guiComponent")) { ## a gWidget. widget <- getToolkitWidget(location) if(!inherits(widget,"GtkWindow")) widget <- getGtkWindow(widget) window$SetTransientFor(widget) window$SetPosition(GtkWindowPosition["center-on-parent"]) window$SetDestroyWithParent(TRUE) ## windows fixes window$setSkipTaskbarHint(TRUE) window$setSkipPagerHint(TRUE) } else { ## check that location is a numeric pair if(is.numeric(location) && length(location) >= 2) { location <- as.integer(location) window$Move(location[1],location[2]) } } } ## make object obj <- as.gWidgetsRGtk2(window) if (!is.null(handler)) { ## handler can't refer to h$obj, as it is already ## by the time it gets here. id <- addhandlerdestroy(obj, handler=handler, action=action) } if(visible) window$Show() return(obj) }) as.gWidgetsRGtk2.GtkWindow <- function(widget,...) { window <- widget obj <- new("gWindowRGtk",block=window, widget=window, toolkit=guiToolkit("RGtk2")) if(!is.null(tag(obj,"menubargroup"))) { ## already a gwindow. Move on return(obj) } ## may or may not have child. child <- window$GetChild() ## if there, save child, then put into contentPane if(!is.null(child)) window$Remove(child) # put into cpg (mbg <- ggroup(spacing=0)); svalue(mbg) <- 0 (tbg <- ggroup(spacing=0)); svalue(tbg) <- 0 (ibg <- ggroup(spacing=0, horizontal=FALSE)); svalue(ibg) <- 0 (cpg <- ggroup(spacing=0)); svalue(cpg) <- 0 (sbg <- ggroup(spacing=0)); svalue(sbg) <- 0 tag(obj,"menubargroup") <- mbg tag(obj,"toolbargroup") <- tbg tag(obj, "infobargroup") <- ibg tag(obj,"contentPane") <- cpg tag(obj,"statusbargroup") <- sbg tbl <- gtkTable(rows=4, columns=1, homogeneous=FALSE) tag(obj,"table") <- tbl tbl$SetColSpacings(0) tbl$SetRowSpacings(0) tbl$Attach(getBlock(mbg), 0,1,0,1, yoptions = c("fill")) tbl$Attach(getBlock(tbg), 0,1,1,2, yoptions = c("fill")) tbl$Attach(getBlock(ibg), 0,1,2,3, xoptions=c("shrink", "fill"), yoptions = c("shrink")) tbl$AttachDefaults(getBlock(cpg), 0,1,3,4) ## size grip issue if no statusbar tmp <- getBlock(cpg); tmp['border-width'] = 13 tbl$Attach(getBlock(sbg), 0,1,5,6, yoptions = c("fill")) window$Add(tbl) ## give back child if there if(!is.null(child)) add(cpg, child, expand=TRUE) return(obj) } ################################################## ## Methods ## Old method, when gwindow did not have a ggroup packed in. ## setMethod(".add", ## signature(toolkit="guiWidgetsToolkitRGtk2",obj="gWindowRGtk", value="gWidgetRGtk"), ## function(obj, toolkit, value, ...) { ## getWidget(obj)$Add(value) ## }) ## methods setMethod(".svalue", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gWindowRGtk"), function(obj, toolkit, index=NULL, drop=NULL, ..) { getWidget(obj)$GetTitle() }) setMethod(".svalue<-", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gWindowRGtk"), function(obj, toolkit, index=NULL,..., value) { ## set the title getWidget(obj)$SetTitle(value) return(obj) }) ## no visible() method setMethod(".visible<-", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gWindowRGtk"), function(obj, toolkit, ..., value) { value = as.logical(value) if(value == TRUE) getWidget(obj)$Show() else getWidget(obj)$Hide() return(obj) }) ## focus will raise window ## ## @param object gwindow object ## @param toolkit name of toolkit ## @param ... ignored ## @return NULL called for side effect of raising window setMethod(".focus", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gWindowRGtk"), function(obj, toolkit, ...) { w <- getBlock(obj) w$present() }) setReplaceMethod(".focus", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gWindowRGtk"), function(obj, toolkit, ..., value) { if(as.logical(value)) { w <- getBlock(obj) w$present() } return(obj) }) setMethod(".size", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gWindowRGtk"), function(obj, toolkit, ...) { theSize = getWidget(obj)$GetSize() return(unlist(theSize[2:3])) }) setMethod(".update", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gWindowRGtk"), function(object, toolkit, ...) { w <- getWidget(object) w$setSizeRequest(-1, -1) invisible() }) ## Add and delete. Special methods for [menu|tool|status]bars ## add setMethod(".add", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gWindowRGtk", value="gWidgetRGtk"), function(obj, toolkit, value, ...) { ## should fix expand=TRUE here # .add(obj, toolkit, getBlock(value),...) add(tag(obj,"contentPane"), value, expand=TRUE, fill="both") # no ... }) setMethod(".add", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gWindowRGtk", value="RGtkObject"), function(obj, toolkit, value, ...) { ## should fix expand=TRUE here theArgs=list(...) theArgs$expand=TRUE gp <- tag(obj,"contentPane") do.call("add",list(obj=gp,value=value,theArgs)) # add(tag(obj,"contentPane"), value, ...) }) ## menubar setMethod(".add", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gWindowRGtk", value="gMenuRGtk"), function(obj, toolkit, value, ...) { add(tag(obj,"menubargroup"), value, expand=TRUE) }) ## toolbar setMethod(".add", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gWindowRGtk", value="gToolbarRGtk"), function(obj, toolkit, value, ...) { add(tag(obj,"toolbargroup"), value, expand=TRUE) }) ## statusbar setMethod(".add", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gWindowRGtk", value="gStatusbarRGtk"), function(obj, toolkit, value, ...) { add(tag(obj,"statusbargroup"), value, expand=TRUE) tmp <- getBlock(tag(obj, "contentPane")) tmp['border-width'] <- 0 }) ## delete setMethod(".delete", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gWindowRGtk", widget="gWidgetRGtk"), function(obj, toolkit, widget, ...) { delete(tag(obj,"contentPane"), widget, ...) }) ## menubar setMethod(".delete", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gWindowRGtk", widget="gMenuRGtk"), function(obj, toolkit, widget, ...) { delete(tag(obj,"menubargroup"), widget, ...) }) ## toolbar setMethod(".delete", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gWindowRGtk", widget="gToolbarRGtk"), function(obj, toolkit, widget, ...) { delete(tag(obj,"toolbargroup"), widget, ...) }) ## statusbar setMethod(".delete", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gWindowRGtk", widget="gStatusbarRGtk"), function(obj, toolkit, widget, ...) { delete(tag(obj,"statusbargroup"), widget, ...) widget <- getWidget(obj) tmp <- getBlock(tag(obj, "contentPane")) tmp['border-width'] <- 13 }) ## dispatches setMethod(".dispose", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gWindowRGtk"), function(obj, toolkit, ...) { obj@widget$Destroy() }) ################################################## ## handlers ## THis intercepts the windowmanager delete-event, destroy does not setMethod(".addhandlerunrealize", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gWindowRGtk"), function(obj, toolkit, handler, action=NULL, ...) { theArgs = list(...) gtktry(connectSignal(obj@widget, signal="delete-event", f = function(...) { val = handler(...) if(is.logical(val)) return(val) else return(FALSE) # do delete }, data=list(obj=if(!is.null(theArgs$actualobj)) theArgs$actualobj else obj, action=action,...), user.data.first = TRUE, after=FALSE), silent=TRUE) }) setMethod(".addhandlerdestroy", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gWindowRGtk"), function(obj, toolkit, handler, action=NULL, ...) { .addHandler(obj, toolkit, signal="destroy", handler, action, ...) }) gWidgetsRGtk2/R/gedit.R0000644000175100001440000002524413216523610014345 0ustar hornikusers## class defined in aaaClasses for inheritance ## constructor setMethod(".gedit", signature(toolkit="guiWidgetsToolkitRGtk2"), function(toolkit, text="", width=25, coerce.with = NULL, initial.msg = "", handler=NULL, action=NULL, container=NULL, ... ) { force(toolkit) entry <- gtkEntryNew() obj <- as.gWidgetsRGtk2(entry) tag(obj, "coerce.with") <- coerce.with ## this adds completion fields to this widget. To *add* to the list ## of values that can be completed use gEditobject[]<- values ## entry$setMaxLength(max(width,length(unlist(strsplit(text,""))))) svalue(obj) <- text tag(obj,"completion") <- NULL # a completion object if set via [<- ## process initial message if applicable tag(obj, "init_msg_flag") <- FALSE tag(obj, "init_msg") <- initial.msg if(nchar(text) == 0 && nchar(initial.msg) > 0) { entry$modifyText(GtkStateType["normal"], "gray") entry$setText(initial.msg) id <- gSignalConnect(entry, "focus-in-event", function(...) { entry$setText("") entry$modifyText(GtkStateType["normal"], "black") gSignalHandlerDisconnect(entry,id) tag(obj, "init_msg_flag") <- FALSE }) tag(obj, "init_msg_flag") <- TRUE tag(obj, "init_msg_id") <- id } ## width -- ths sets minimum -- it ay expand to fill space if(!is.null(width)) entry$setWidthChars(as.numeric(width)) if (!is.null(container)) { if(is.logical(container) && container == TRUE) container <- gwindow() add(container, obj,...) } if (!is.null(handler)) tag(obj, "handler.id") <- addhandlerchanged(obj,handler,action) invisible(obj) }) as.gWidgetsRGtk2.GtkEntry <- function(widget, ...) { obj = new("gEditRGtk",block=widget, widget=widget, toolkit=guiToolkit("RGtk2")) return(obj) } ## code to add completion to the entry ## only do so if set via [<- .setCompletion <- function(obj,...) { completion = gtkEntryCompletionNew() ## set model ## this caps out at 1000 -- is this a speed issue? model <- rGtkDataFrame(data.frame(character(1000),stringsAsFactors=FALSE)) completion$SetModel(model) completion$SetTextColumn(0) # Columns count from 0 -- not 1 ## set properties gtktry({completion['inline-completion'] <- TRUE}, silent = TRUE) gtktry({completion['inline-selection'] <- TRUE}, silent = TRUE) ## set completion tag(obj,"completion") <- completion ## get entry from obj entry <- obj@widget entry$SetCompletion(completion) } ## methods setMethod("svalue", signature(obj="GtkEntry"), function(obj, index=NULL, drop=NULL, ...) { .svalue(obj,guiToolkit("RGtk2"), index, drop, ...) }) setMethod(".svalue", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gEditRGtk"), function(obj, toolkit, index=NULL, drop=NULL, ...) { val <- obj@widget$getText() init_msg <- tag(obj, "init_msg") if(!is.null(init_msg) && val == init_msg) val <- "" return(val) }) ## trouble here -- no coerce.with info available in obj setMethod(".svalue", signature(toolkit="guiWidgetsToolkitRGtk2",obj="GtkEntry"), function(obj, toolkit, index=NULL, drop=NULL, ...) { val <- obj$getText() return(val) }) ## svalue<- setReplaceMethod(".svalue", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gEditRGtk"), function(obj, toolkit, index=NULL, ..., value) { if(is.null(value)) return(obj) ## o/w we get a crash widget <- getWidget(obj) ## initial message, clear flag <- tag(obj, "init_msg_flag") if(!is.null(flag) && flag) { widget$modifyText(GtkStateType["normal"], "black") gSignalHandlerDisconnect(widget, tag(obj, "init_msg_id")) tag(obj, "init_msg_flag") <- FALSE } widget$setText(value) widget$activate() tag(obj, "value") <- value return(obj) }) ## want to replace "value" but can't setReplaceMethod(".svalue", signature(toolkit="guiWidgetsToolkitRGtk2",obj="GtkEntry"), function(obj, toolkit, index=NULL, ..., value) { obj$setText(value) obj$activate() return(obj) }) setMethod(".leftBracket", signature(toolkit="guiWidgetsToolkitRGtk2",x="gEditRGtk"), function(x, toolkit, i, j, ..., drop=TRUE) { obj <- x if(!is.null(tag(obj,"completion"))) { store <- obj@widget$GetCompletion()$GetModel() nrows <- dim(store)[1] if(missing(i)) i <- 1:nrows return(store[i , ]) } else { return(c()) } }) setMethod("[", signature(x="gEditRGtk"), function(x, i, j, ..., drop=TRUE) { if(missing(i)) .leftBracket(x,x@toolkit, ...) else .leftBracket(x,x@toolkit, i, ...) }) setReplaceMethod(".leftBracket", signature(toolkit="guiWidgetsToolkitRGtk2",x="gEditRGtk"), function(x, toolkit, i, j, ..., value) { obj <- x if(is.null(tag(obj,"completion"))) .setCompletion(obj) store <- obj@widget$GetCompletion()$GetModel() nrows <- dim(store)[1] n <- length(value) if(n > nrows) values <- values[1:nrows] # truncate if(missing(i)) i <- 1:n store[i , ] <- value ## all done return(obj) }) setReplaceMethod("[", signature(x="gEditRGtk"), function(x, i, j,..., value) { .leftBracket(x, x@toolkit, i, j, ...) <- value return(x) }) ## visible<- if FALSE, for password usage setReplaceMethod(".visible", signature(toolkit="guiWidgetsToolkitRGtk2", obj="gEditRGtk"), function(obj, toolkit, ..., value) { widget <- getWidget(obj) widget$setInvisibleChar(42L) # asterisk widget$setVisibility(as.logical(value)) return(obj) }) ################################################## ## handlers ### doesn't work -- double writes setMethod(".adddropsource", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gEditRGtk"), function(obj, toolkit, targetType="text", handler=NULL, action=NULL, ...) { ## do nothing, alrady in gedit widget }) setMethod(".adddroptarget", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gEditRGtk"), function(obj, toolkit, targetType="text", handler=NULL, action=NULL, ...) { ## gwCat("drop target for gedit uses default only") ## issue is if using after=FALSE, the default drophandler is called. (Can't stop signal emission) ## if using after=TRUE, the dropped value is put into widget's value in similar way, a ## again we don't want this ## so we store the pre-value then set after as a hack predrophandler <- function(h,...) { tag(h$obj,"..predropvalue") <- svalue(h$obj) } gSignalConnect(getWidget(obj), "drag-data-received", f= predrophandler, data=list(obj=obj), user.data.first=TRUE, after=FALSE) postdropHandler <- function(h,w, ctxt, x, y, selection, ...) { svalue(h$obj) <- tag(h$obj,"..predropvalue") # complete the hack tag(h$obj, "..predropvalue") <- NULL dropdata <- selection$GetText() if(is.integer(dropdata)) dropdata <- Paste(intToChar(dropdata)) else dropdata <- rawToChar(dropdata) dropdata <- gsub(Paste("^",.gWidgetDropTargetListKey),"", dropdata) h$dropdata <- dropdata handler(h, widget=w, context=ctxt, x=x, y=y, selection=selection, ...) } id <- gSignalConnect(getWidget(obj), "drag-data-received", f=postdropHandler, data=list(obj=obj, action=action), after=TRUE, user.data.first=TRUE) }) setMethod(".addhandlerchanged", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gEditRGtk"), function(obj, toolkit, handler, action=NULL, ...) { f <- function(h,widget,event,...) { keyval <- event$GetKeyval() if(keyval == GDK_Return) { handler(h,widget,event,...) return(TRUE) } else { return(FALSE) } } id <- addhandler(obj, signal="activate", handler=handler, action=action) return(id) }) setMethod(".addhandlerkeystroke", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gEditRGtk"), function(obj,toolkit, handler=NULL, action=NULL,...) { widget <- getWidget(obj) ID <- gSignalConnect(widget,signal = "key-release-event", f = function(d,widget,event,...) { h <- list(obj=d$obj,action=d$action) key <- event$GetString() h$key <- key if(!is.null(d$handler) && is.function(d$handler)) d$handler(h,...) return(FALSE) # propogate }, user.data.first = TRUE, data = list(obj=obj,handler=handler, action=action) ) invisible(ID) }) gWidgetsRGtk2/R/gvarbrowser.R0000644000175100001440000003306213216523740015615 0ustar hornikusers## Use this to filter by type ## knownTypes in common ### Use this for filtering by (gvarbrowser, gvarbrowsertree) ## This is *ugly* -- how to get a reasonable set of values here? .datasets = c( "numeric","logical","factor","character","integer", "data.frame","matrix","list", "table","xtabs", "nfnGroupedData","nffGroupedData","nmGroupedData", "POSIXct","POSIXlt","POSIXt" ) .models = c("lm","glm","lqs","aov","anova", "lme","lmList","gls", "ar","arma","arima0","fGARCH","fAPARCH" ) .ts = c("ts", "mts", "timeSeries", "its", "zoo","xts") .functions=c("function") .plots = c("recordedplot") knownTypes = list( "data sets and models"=c(.datasets, .models, .ts), "data sets"= c(.datasets,.ts), "model objects" = .models, "time series objects" = .ts, "functions"=.functions, "saved plots" = .plots, "all" = NULL ) ## list of some type lsType = function(type, envir=.GlobalEnv) { x = with(.GlobalEnv, sapply(ls(), function(i) class(get(i)))) objects = names(x)[sapply(x, function(i) any(i %in% type))] return(objects) } lsDatasets = function(envir=.GlobalEnv) lsType(.datasets, envir) lsModels = function(envir=.GlobalEnv) lsType(.models, envir) lsTs = function(envir=.GlobalEnv) lsType(.ts, envir) lsFunctions = function(envir=.GlobalEnv) lsType(.functions, envir) ## function to capture summary (in string) of object ourStr <- function(x) UseMethod("ourStr") ourStr.default <- function(x) "" # say nothing if nothing good to say -- thanks Mom. ourStr.character <- ourStr.logical <- ourStr.numeric <- function(x) sprintf("length %s", length(x)) ourStr.matrix <- function(x) sprintf("%s by %s", nrow(x), ncol(x)) ourStr.data.frame <- function(x) sprintf("%s variables, %s observations", length(x), nrow(x)) ourStr.list <- function(x) sprintf("%s components", length(x)) ourStr.lm <- function(x) deparse(x$call) ## Make offspring data frame offspring = function(path=c(), data=NULL) { emptyDf <- data.frame(names="",hasSubTree=FALSE,type="", summary="", stringsAsFactors=FALSE) if(!is.null(data) && is.function(data)) data <- data() ## data is knownClass value. This checks through inheritance but still the ## question of what classes to show is hardcoded -- eh .inClass <- function(x,data) { if(is.null(data)) return(TRUE) any(sapply(1:length(data), function(i) { out <- is(x,data[i]) if(inherits(out,"try-error")) return(FALSE) return(out) })) } if(length(path) == 0) { fullx <- x <- ls(envir=.GlobalEnv) } else { string <- paste(path,collapse="$") obj <- getObjectFromString(string) x <- with(obj, ls()) fullx <- paste(string,x,sep="$") } if(length(x) == 0) { return(emptyDf) } objType <- newNames <- objSummary <- character(0) hasTree <- logical(0); for(i in seq_along(x)) { y <- getObjectFromString(fullx[i]) if(.inClass(y,data)) { j <- length(objType)+ 1 objType[j] <- str2(y) hasTree[j] <- hasSubTree(y) newNames[j] <- x[i] objSummary[j] <- ourStr(y) } } if(length(objType) == 0) { return(emptyDf) } allValues <- data.frame(names=I(newNames), hasSubTree=hasTree, type=I(objType), summary=I(objSummary), stringsAsFactors=FALSE) ## Thanks Stephanie if(!is.null(data)) { return(allValues[allValues$type %in% data, ,drop=FALSE]) } else { return(allValues) } } hasSubTree = function(x) { tmp = gtktry(is.list(x) && !is.guiWidget(x) && !is.gWidget(x) && !is.RGtkObject(x) && !is.null(names(x)), silent=TRUE) if(!inherits(tmp,"try-error") && tmp) return(TRUE) else return(FALSE) } setClass("gVarbrowserRGtk", representation(filter="guiComponent"), contains="gComponentRGtk", prototype=prototype(new("gComponentRGtk")) ) ## Toolkit constructor for gvarbrowser widget ## ## Call the update method to update the object ## ## ## @example ## Make a popup menu for actions. Issue: works with selection, but selection updated first by left click ## is needed. ## library(gWidgets) ## options(guiToolkit="RGtk2") ## v <- gvarbrowser(container =gwindow("Object broser"), handler=function(h,...) { ## varname <- h$obj[] ## if(length(varname) == 1) { ## do.call("fix", list(varname)) ## } ## }) ## Helper function to get object from argument h passed in to menulist ## getObjectFrom_h <- function(h) { ## varname <- h$action[] # note action, not obj ## obj <- get(varname[1], envir=.GlobalEnv) ## if(length(varname) > 1) ## obj <- obj[[varname[-1]]] ## obj ## } ## ## a list of gaction items or separators ## ml <- list( ## summary=gaction("summary...", action=v, handler=function(h,...) { ## obj <- getObjectFrom_h(h) ## print(summary(obj)) ## }), ## plot=gaction("plot...", action=v, handler=function(h,...) { ## obj <- getObjectFrom_h(h) ## try(plot(obj), silent=TRUE) ## }), ## sep=gseparator(), ## remove=gaction("remove", action=v, handler=function(h,...) { ## varname <- h$action[] ## print(varname) ## if(gconfirm(sprintf("Really delete %s?", varname[1]))) ## rm(list=varname[1], envir=.GlobalEnv) ## }) ## ) ## add3rdMousePopupmenu(v, menulist=ml) setMethod(".gvarbrowser", signature(toolkit="guiWidgetsToolkitRGtk2"), function(toolkit, handler = NULL, action = "summary", container = NULL, ...) { force(toolkit) theArgs <- list(...) if(!is.null(theArgs$inteval)) theArgs$interval <- theArgs$interval ## typo fix. Remove later interval <- ifelse(is.null(theArgs$interval), 2000, theArgs$interval) ## fix up known types if(!is.null(theArgs$knownTypes)) knownTypes <- theArgs$knownTypes else if(!is.null(getOption("knownTypes"))) { knownTypes <- getOption("knownTypes") } multiple <- getWithDefault(theArgs$multiple, TRUE) ## fix handler if action is non-null if(is.null(handler) && !is.null(action)) { handler = function(h, ...) { values <- h$obj[] value <- paste(values, collapse = "$") if (!is.null(action)) print(do.call(h$action, list(svalue(value)))) } } ## begin group <- ggroup(horizontal=FALSE, container=container,...) filterGroup <- ggroup(container=group) glabel("Filter by:",container=filterGroup) filterPopup <- gdroplist(names(knownTypes), container=filterGroup) val <- ifelse("data sets" %in% names(knownTypes), "data sets", names(knownTypes)[1]) svalue(filterPopup) <- val ## main tree tree = gtree(offspring=offspring, offspring.data=function() knownTypes[[svalue(filterPopup)]], col.types=data.frame(Name="string",Type="string",Summary="String"), icon.FUN = function(d,...) { ## Allow user to change stock icon FUN <- getWithDefault(getOption("gWidgetsStockIconFromClass"), stockIconFromClass) byReturnVector(d,function(x) FUN(x[,'type'])) }, multiple=multiple, container = group, expand=TRUE ) updateGroup <- ggroup(container =group) autoUpdate <- gcheckbox("Auto update", checked=TRUE, use.togglebutton=TRUE, container =updateGroup, handler=function(h,...) { enabled(refreshButton) <- !svalue(h$obj) }) refreshButton <- gimage("refresh", dirname="stock", container =updateGroup, handler=function(h,...) { key <- svalue(filterPopup) offspring.data <- knownTypes[[key]] update(obj, offspring.data) }) enabled(refreshButton) <- FALSE tooltip(refreshButton) <- "Click to refresh display" visible(updateGroup) <- FALSE ## update the tree this way addhandlerclicked(filterPopup, handler = function(h,...) { key = svalue(filterPopup) offspring.data = knownTypes[[key]] update(h$action, offspring.data) }, action=tree) ## drop handler adddropsource(tree,handler=function(h,...) { values = h$obj[] values = sapply(values, untaintName) return(paste(values,collapse="$")) }) tag(tree,"view")$SetEnableSearch(TRUE) tag(tree,"view")$SetHeadersClickable(TRUE) obj <- new("gVarbrowserRGtk",block=group, widget=tree, filter=filterPopup, toolkit=toolkit) tag(obj, "filterPopup") <- filterPopup ## ### In place of an idleHandler, we use a taskCallback ## ### This is a little fragile, as remove taskCallback can remove ## updateCallback <- function(x) { ## function(expr, value, ...) { ## if(!isExtant(x)) return(FALSE) # need widget to be available, otherwise shut off ## if(is.call(expr)) { ## FUN <- deparse(expr[[1]]) ## if(FUN %in% c("=","<-", "assign", "rm")) { ## update(x) ## } ## } ## return(TRUE) ## } ## } ## addTaskCallback(updateCallback(obj), name="gvarbrowser") ## add an idle handler for updating tree every second (or interval) idleHandler <- function(h,...) { visible(updateGroup) <- tag(h$action, "logsize") > 2 # 50 or more if(!svalue(autoUpdate)) return() key = svalue(filterPopup) offspring.data = knownTypes[[key]] update(h$obj, offspring.data) ## do we make timeframe longer bigger? n <- ceiling(log(1+ length(.GlobalEnv), 7)) if(n != tag(h$action, "logsize")) { tag(h$action, "logsize") <- n idleid <- tag(h$action, "idleid") gSourceRemove(idleid) tag(h$action, "idleid") <- addhandleridle(tree, interval=2^n*1000, handler = idleHandler, action=h$action) } } idleid <- addhandleridle(tree, interval=interval, handler = idleHandler, action=obj) tag(obj, "idleid") <- idleid tag(obj, "logsize") <- 1 # ceiling(log(1+ length(.GlobalEnv), 10)) addhandlerunrealize(tree, handler = function(h,...) { idleid <- tag(h$action, "idleid") gSourceRemove(idleid) }, action=obj) ## override how we compare items. Default is just by name, here we want ## to include class and summary tag(tree, "isStillThere") <- function(old, new) { if(length(old) && length(new)) { identical(any(ind <- (old[1] == new[,1, drop=TRUE])) && (old[2] %in% new[which(ind),3, drop=TRUE]) && (old[3] %in% new[which(ind),4, drop=TRUE]), # for wxf TRUE) # Tom Taverner change } else { FALSE } } if(!is.null(handler)) { id = addhandlerdoubleclick(tree, handler=handler, action=action) } ## all done return(obj) }) ### methods ## push methods and handlers down to tree in this case setMethod(".update", signature(toolkit="guiWidgetsToolkitRGtk2",object="gVarbrowserRGtk"), function(object, toolkit, ...) { filterPopup <- tag(object, "filterPopup") key <- svalue(filterPopup) offspring.data <- knownTypes[[key]] update(object@widget, offspring.data) }) setMethod(".svalue", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gVarbrowserRGtk"), function(obj, toolkit, index=NULL, drop=NULL, ...) { ## check if any selection value <- NA x <- svalue(obj@widget) if(!(is.atomic(x) && length(x) == 1 && is.na(x))) { f <- function(x) paste(x, collapse="$") values <- obj@widget[] # from tree if(is.list(values)) value <- sapply(values, f) else value <- f(values) } return(value) }) setMethod("[", signature(x="gVarbrowserRGtk"), function(x, i, j, ..., drop=TRUE) { .leftBracket(x,guiToolkit("RGtk2"), i, j, ..., drop=drop) }) setMethod(".leftBracket", signature(toolkit="guiWidgetsToolkitRGtk2",x="gVarbrowserRGtk"), function(x, toolkit, i, j, ..., drop=TRUE) { if(missing(i)) x@widget[...] else x@widget[i,...] }) gWidgetsRGtk2/R/gdfnotebook.R0000644000175100001440000003261312236754532015562 0ustar hornikuserssetClass("gDfNotebookRGtk", representation = representation( gnotebook="guiWidget" ), contains="gNotebookRGtk" ) setMethod(".gdfnotebook", signature(toolkit="guiWidgetsToolkitRGtk2"), function(toolkit, items = NULL, container = NULL, ... # passed to Group, gnotebook = nb, # notebook = nb$notebook) ) { force(toolkit) ## set up notebook ## put notebook into a group mainGroup = ggroup(horizontal=FALSE, container=container, ...) nb = gnotebook() obj = new("gDfNotebookRGtk", block=mainGroup, widget = getWidget(nb), # for inheritance of methods toolkit = toolkit, gnotebook=nb) ## add drophandler to mainGroup adddroptarget(mainGroup, handler = function(h,...) { add(obj, h$dropdata) }) buttonGroup = ggroup(spacing = 0, container = mainGroup) add(mainGroup, nb, expand=TRUE) ## set up buttons openButton = gbutton("open",handler = function(h,...) { openPageDfNotebookDialog(obj) }, action=obj, container=buttonGroup) ## saveButton = gbutton("save",handler = function(h,...) { ## savePageDfNotebook(h$action) ## }, action=obj, container=buttonGroup) closeButton = gbutton("close",handler = function(h,...) { dispose(h$action) ## closePageDfNotebook(h$action) }, action=obj, container=buttonGroup) ## renameButton = gbutton("rename",handler = function(h,...) { ## renamePageDfNotebook(h$action) ## }, action = obj, container=buttonGroup) ## add page if non null if(!is.null(items)) add(obj, items) return(obj) }) ################################################## ## ## gWidgetMethods (inherits others from gnotebook ## object is name of R object *or* file ## REWRITE me to dispatch on value. This first part is ugly and broken setMethod(".add", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gDfNotebookRGtk"), function(obj, toolkit, value, ...) { theArgs = list(...) ## value is dataframe or available from string if(is.character(value) && length(value) == 1) adf = svalue(value) else adf = value if(is.dataframelike(adf) || is(adf,"guiContainer") || is(adf,"gGridRGtk")){ if(is(adf,"gGridRGtk")) editdf = adf else if (is(adf,"guiContainer")) editdf = adf@widget else editdf = gdf(adf, do.subset=TRUE) ## The name if(!is.null(theArgs$label)) theName = theArgs$label else if(!is.null(theArgs$name)) theName = theArgs$name else theName = id(value) if(is.null(theName)) theName = "dataset" ## the label label = glabel(theName) ## toolbar stuff lst = list() lst$"New scratch area"$handler = function(h,...) { newBlankPage(obj@gnotebook) } ## lst$"Save sheet"$handler = function(h,...) { ## savePageDfNotebook(obj) ## } ## lst$"Save sheet"$icon = "save" lst$"Close sheet"$handler = function(h,...) { dispose(obj) ## closePageDfNotebook(obj) } lst$"Close sheet"$icon = "close" lst$"Rename sheet"$handler = function(h,...) renamePageDfNotebook(obj) lst$"Rename sheet"$icon = "rename" add3rdmousepopupmenu(label, lst) ## add to notebook add(obj@gnotebook, editdf, label = label) ## now add in popupmenu to columns. This should be in geditdataframe ## but the singals don't get passed back the way they should # addPopupToPage(editdf, obj) } else { gmessage(Paste("Can't open ",value,": can not be coerced into a data frame.\n"), icon="error") return() } }) ################################################## ## dialogs openPageDfNotebookDialog = function(nb, ...) { ## dialog for selecting variable to open tmp = ls(envir=.GlobalEnv) if(length(tmp) == 0) { dataframelike = data.frame(Avail.DataSets = "", stringsAsFactors=FALSE) } else { dataFrameInds = sapply(tmp, function(x) is.dataframelike(svalue(x))) if(any(dataFrameInds)) { dataframelike = tmp[dataFrameInds] dataframelike = data.frame(Avail.DataSets = dataframelike, stringsAsFactors=FALSE) } else { dataframelike = data.frame(Avail.DataSets = "", stringsAsFactors=FALSE) } } theTitle = "Double click a data set to select" win = gwindow(theTitle, visible=TRUE) group = ggroup(horizontal=FALSE, container=win) ## define lgroup and lgroup. Later we add to panedgroup lgroup = ggroup(horizontal=FALSE) glabel(theTitle, container = lgroup) widget = gtable(items=dataframelike, handler = function(h,...) { dataname = svalue(h$obj) add(nb,svalue(dataname),label=dataname) dispose(win) }) add(lgroup, widget, expand=TRUE) rgroup = ggroup(horizontal=FALSE) glabel("Or fill in the following to add a new sheet", container=rgroup) tbl = glayout(); add(rgroup, tbl, expand=TRUE) theName = gedit("X1") theType = gdroplist(c("numeric","character","factor")) theNoCols = gspinbutton(from=1,to=100,by=1,value=1) tbl[1,1] = glabel("First variable name:");tbl[1,2] = theName tbl[2,1] = glabel("Its type:");tbl[2,2] = theType tbl[3,1] = glabel("No. rows:");tbl[3,2] = theNoCols visible(tbl) <- TRUE buttonGroup=ggroup(container=rgroup); addSpring(buttonGroup) gbutton("add",container=buttonGroup, handler= function(h,...) { tmp = cbind(do.call(paste("as.",svalue(theType),sep=""), list(rep(NA, length=svalue(theNoCols))))) colnames(tmp)[1] = svalue(theName) add(nb, tmp, label=.getScratchName(nb)) # out <- gdf(tmp, do.subset=TRUE, container=nb, label=.getScratchName(nb)) # add(nb,gdf(tmp,do.subset=TRUE)@widget,label=.getScratchName(nb)) # widget to get add working better dispose(win) }) gpanedgroup(lgroup,rgroup,container=group) gseparator(container=group) buttonGroup = ggroup(container=group) addSpring(buttonGroup) gbutton("cancel",container=buttonGroup,handler = function(h,...) dispose(win)) } ### what popup on the buttons do you want addPopupToPage = function(obj, nb) { # obj is gdf instance ## nb is gdfnotebook instance for adding to... f = function(h,...) { view.col = h$obj # treeview obj = h$action lst = list() lst$"Apply function to column"$handler = function(h,...) { win = gwindow("Apply function to column",visible=TRUE) group = ggroup(horizontal = FALSE, container=win) glabel("Apply function to column", markup=TRUE, container=group) tmpGroup = ggroup(container=group) glabel("function(x) = {", markup=TRUE,container=tmpGroup) addSpring(tmpGroup) FUN = gtext(container=group) tmpGroup = ggroup(container=group) glabel("}", container=tmpGroup) addSpring(tmpGroup) buttonGroup = ggroup(container=group) addSpring(buttonGroup) gbutton("ok",container=buttonGroup,handler = function(h,...) { FUN = Paste("function(x) {",svalue(FUN),"}") f = eval(parse(text=FUN)) col.no = tag(view.col,"column.number") - 1 # rownames offset theNewVals = f(obj[,col.no, drop=FALSE]) obj[,col.no] = theNewVals dispose(win) }) gbutton("cancel",container=buttonGroup, handler = function(h,...) dispose(win)) } lst$"Clear column"$handler = function(h,...) { col.no = tag(view.col,"column.number") - 1 # rownames offset obj[,col.no] = rep(NA, length(view.col)) } lst$"Sort by column (decreasing)"$handler = function(h,...) { col.no = tag(view.col,"column.number") - 1 # rownames offset newOrder = order(obj[,col.no], decreasing = TRUE) obj[,] = obj[newOrder,] rownames(obj) = rownames(obj)[newOrder] } lst$"Sort by column (increasing)"$handler = function(h,...) { col.no = tag(view.col,"column.number") - 1 # rownames offset newOrder = order(obj[,col.no], decreasing = FALSE) obj[,] = obj[newOrder,] rownames(obj) = rownames(obj)[newOrder] } lst$"Rename column"$handler = function(h,...) { win = gwindow("Change name", visible=TRUE) group = ggroup(horizontal=FALSE, container=win) ok.handler = function(h,...) { newVal = make.names(svalue(newName)) id(view.col) <- newVal dispose(win) return(FALSE) } newName = gedit(id(view.col),container=group) addhandlerchanged(newName, handler=ok.handler, action=newName) buttonGroup = ggroup(container=group);addSpring(buttonGroup) add(buttonGroup,gbutton("ok", handler = ok.handler, action=newName)) add(buttonGroup,gbutton("cancel",handler=function(h,...) dispose(win))) return(TRUE) } ## This shows that we can make new pages if desired, as nb is passed in ## lst$testnew$handler = function(h,...) ## add(nb$notebook, glabel("new things"),"delete me") ## now make the menu bar, see add3rdbuttonpopup.default mb = gmenu(lst, popup=TRUE) event = gdkEventNew(GdkEventType["button-press"]) ## do the popup mb@widget$PopupHack(button = event$GetButton(), activate.time=event$GetTime()) } ## now add the popup to the buttons. (The widgets are labels, but ## signals are not being passed along when the button is clicked, ## hence this being here, not in geditdataframe. cols = obj@view$GetColumns() callbackIDs = sapply(1:length(cols), function(i) { gtktry(connectSignal(cols[[i]]$GetWidget()$GetParent()$GetParent()$GetParent(), signal="clicked", f = f, data = list(obj=cols[[i]], action=obj, col=i-1), # 0 base columns user.data.first = TRUE, after = TRUE), silent=TRUE) }) invisible(callbackIDs) } ## save current page ## savePageDfNotebook = function(nb, ...) { ## if(! inherits(nb,"gDfNotebookRGtk")) ## stop("Must be a dfNotebook to use me") ## ## dataframe ## ## nb stores gridobject, and tab is name ## curPage = svalue(nb) ## if(curPage == 0) # nothing to save ## return(TRUE) ## ## save it ## gridObj = nb[curPage] # widget store ## dfName = names(nb)[curPage] # for tab label ## df = gridObj[,, drop=FALSE] ## names(df) <- names(gridObj) # fix names ## ## if name match *scratch:no* then we save variables, not as data frame ## if(length(grep("^\\*scratch:[[:digit:]]+\\*$", dfName)) > 0) { ## for(i in names(df)) { ## val = df[,i] ## ind <- which(val != "") ## if(length(ind)) ## val <- val[1:max(ind)] ## else ## val <- val ## if(is.character(val)) { ## tmpfile = tempfile() ## sink(tmpfile) ## tmp = as.numeric(val) ## if(all(!is.na(tmp))) ## val = tmp ## sink(NULL) ## unlink(tmpfile) ## } ## assign(i, val, envir=.GlobalEnv) ## } ## } else { ## ## save entire data set, only trick is $ possibility ## if(length(grep("\\$",dfName)) > 0) { ## cat(gettext("Can't save with $ in name. Rename data set.\n")) ## } else { ## assign(dfName, df, envir=.GlobalEnv) ## } ## } ## } ## rename the page renamePageDfNotebook = function(nb, ...) { old.text = names(nb)[svalue(nb)] win = gwindow("Rename data values", visible=TRUE) group = ggroup(horizontal = FALSE, container=win) glabel("Rename data values", container=group) edit = gedit(old.text, container=group) buttonGroup = ggroup(horizontal=TRUE, container=group) addSpring(buttonGroup) gbutton("ok",container=buttonGroup, handler=function(h,...) { new.text = make.names(svalue(edit)) names(nb)[svalue(nb)] = new.text # curNames = names(nb) # curNames[svalue(nb)] = new.text # names(nb) = curNames dispose(win) }) gbutton("cancel",container=buttonGroup, handler = function(h,...) { dispose(win) }) } ######################################## ## helpers .getScratchName = function(nb,...) { ## get the proper names ## the tab labels tabNames = names(nb) scratchPads = tabNames[grep("^\\*scratch:[[:digit:]]+\\*$", tabNames)] newName = "df" if(length(scratchPads) > 0) { scratchPadsNos = as.numeric(gsub("^\\*scratch:([[:digit:]])+\\*$","\\1", scratchPads)) newName = Paste("*scratch:",1+max(scratchPadsNos),"*") } else { newName = "*scratch:1*" } return(newName) } newBlankPage = function(nb, nrow=25, ncol = 10) { ## balnk widget ## editdf = hack.as.data.frame(matrix("",nrow=nrow,ncol=ncol)) obj = gdf() newName = .getScratchName(nb) add(nb, obj, label=newName) } gWidgetsRGtk2/R/ghtml.R0000644000175100001440000000202213216523642014356 0ustar hornikusers## Copyright (C) 2010 John Verzani ## ## This program is free software; you can redistribute it and/or modify ## it under the terms of the GNU General Public License as published by ## the Free Software Foundation; either version 2 of the License, or ## (at your option) any later version. ## ## This program is distributed in the hope that it will be useful, ## but WITHOUT ANY WARRANTY; without even the implied warranty of ## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ## GNU General Public License for more details. ## ## A copy of the GNU General Public License is available at ## http://www.r-project.org/Licenses/ ## Should be basic html display widget ## not implemented setMethod(".ghtml", signature(toolkit="guiWidgetsToolkitRGtk2"), function(toolkit, x, handler = NULL, action=NULL, container=NULL, ...) { message("The ghtml widget is not implemented in gWidgetsRGtk2") return(NULL) }) gWidgetsRGtk2/R/gdroplist.R0000644000175100001440000004075313216523571015270 0ustar hornikusers## editable has entry widget that can be edited setClass("gDroplistRGtk", contains="gComponentRGtk", prototype=prototype(new("gComponentRGtk")) ) ## Combobox widget ## @param items vector of names; 1-column data.frame of names; 2-column names, icons; 3-column names, icons, tooltip ## @param selected index of initial, 0 if blank ## @param editible -- are we editable? setMethod(".gdroplist", signature(toolkit="guiWidgetsToolkitRGtk2"), function(toolkit, items, selected = 1, # use 0 for blank editable=FALSE, coerce.with = NULL, handler=NULL, action=NULL, container=NULL, ... # do.quote = TRUE for quote of answer ) { force(toolkit) ## Changed this. Make objects a data.frame if ## two columns, second is a stock-icon name. ## ideally third column would specify tooltip ## items must be a vector or data frame if(!inherits(items,"data.frame")) { items = as.vector(items) # undoes factor items = unique(items) # unique items = data.frame(items, stringsAsFactors=FALSE) } doIcons = ifelse(ncol(items) >= 2, TRUE, FALSE) if(ncol(items) == 3) { types <- c(data="gchararray",icons="gchararray", tooltip="gchararray") } else if(ncol(items) == 2) { types <- c(data="gchararray",icons="gchararray") } else { types <- c(dataonly="gchararray") } theArgs = list(...) ## keep this, but don't advertise if(!is.null(theArgs$do.quote)) { coerce.with = function(x) paste("'",x,"'",sep="",collapse="") } ## droplist is not happy with datastore class ## droplist was not happy with numeric vectors! seems strange if(editable) { store = gtkListStoreNew(types) combo <- gtkComboBoxEntryNewWithModel(store, 0) ## now add icon if there if(ncol(items) >= 2) { ## icon renderer cellrenderer = gtkCellRendererPixbufNew() combo$PackStart(cellrenderer, expand=FALSE) combo$AddAttribute(cellrenderer, "stock-id", 1) } entry = combo$GetChild() entry$SetEditable(TRUE) ## add in drop target to entry ## we can't pass in obj here, so we find via scoping dropHandler = function(h,...) { theName = id(h$dropdata) ## override value -- in case it is a widget tag(obj, "value") <- h$dropdata # find obj via scoping svalue(obj) <- "" return(TRUE) } .adddroptarget(entry, toolkit, targetType="object",handler=dropHandler) # .adddroptarget(entry, toolkit, targetType="object") } else { store = gtkTreeStoreNew(types) combo <- gtkComboBoxNewWithModel(store) if(doIcons) { ## icon renderer cellrenderer = gtkCellRendererPixbufNew() combo$PackStart(cellrenderer, expand=FALSE) combo$AddAttribute(cellrenderer, "stock-id", 1) } ## pack in text -- not done if no entry cellrenderer = gtkCellRendererTextNew() combo$PackStart(cellrenderer, expand=TRUE) combo$AddAttribute(cellrenderer,"text", 0) } ## add tooltip if there if(ncol(items) >= 3) { ## no easy way. Thought that we could do the following, but ## it doesn't work. Tooltip is on combobox when not expanded for searching ## combo['has-tooltip'] <-TRUE ## gSignalConnect(combo, "query-tooltip", function(w, x, y, bool, tool, ...) { ## ## look up text from w, x, y ## tool$setText("text") ## TRUE ## }) } obj <- as.gWidgetsRGtk2(combo) ## obj = new("gDroplistRGtk",block=combo,widget=combo, toolkit=toolkit) ## tag(obj,"store") <- store ## tag(obj,"combo") <- combo ## tag(obj,"editable") <- editable tag(obj, "items") <- items tag(obj, "doIcons") <- doIcons tag(obj, "coerce.with") = coerce.with tag(obj, "default_fill") <- "x" ## load up the store if(length(items) > 0) { obj[] <- items } ## should I have actiirst be blank? Use 0 (to make -1) for this combo$Show() combo$SetActive(selected-1) ## set size if really small under windows if(.Platform$OS == "windows") { if(dim(items)[1] > 0) { colChars <- max(sapply(items[,1,drop=TRUE],nchar)) if(colChars < 3) combo['width-request'] <- 15*(4 + colChars) } } ## add drophandler -- switch if drop matches adddroptarget(obj, handler = function(h,...) { name = id(h$dropdata) theValues = obj[] if(!is.na(name) && !is.null(name) && name %in% theValues) { svalue(obj) <- name } }) if (!is.null(container)) { if(is.logical(container) && container == TRUE) container = gwindow(visible=TRUE) add(container, obj,...) } ## pass in a size via width= if(!is.null(theArgs$width)) size(obj) <- c(width=theArgs$width, height=0) if (!is.null(handler)) { id <- addhandlerchanged(obj, handler, action) tag(obj, "handler.id") <- id } invisible(obj) }) as.gWidgetsRGtk2.GtkComboBoxEntry <- function(widget,...) { obj <- .as.gWidgetsRGtk2.gdroplist(widget,...) tag(obj,"editable") <- TRUE return(obj) } as.gWidgetsRGtk2.GtkComboBox <- function(widget,...) { obj <- .as.gWidgetsRGtk2.gdroplist(widget,...) tag(obj,"editable") <- FALSE return(obj) } .as.gWidgetsRGtk2.gdroplist <- function(widget) { parent <- widget$parent if(is.null(parent)) { parent <- gtkAlignmentNew(xscale=1, yscale=0) parent$add(widget) } obj <- new("gDroplistRGtk",block=parent,widget=widget, toolkit=guiToolkit("RGtk2")) store <- widget$GetModel() tag(obj,"store") <- store tag(obj,"combo") <- widget ## get items then store. This is only useful for coerced values ## as otherwise set in constructor items <- c() iter <- store$GetIterFirst() if(is.logical(iter$retval) && iter$retval) { items <- store$GetValue(iter$iter,0)$value ret <- store$IterNext(iter$iter) while(ret) { items <- c(items,store$GetValue(iter$iter,0)$value) ret <- store$IterNext(iter$iter) } } tag(obj,"items") <- data.frame(items=items, stringsAsFactors=FALSE) return(obj) } ### methods ## value is for getting/setting the selected value setMethod(".svalue", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gDroplistRGtk"), function(obj, toolkit, index=NULL, drop=NULL, ...) { ## add in an as.numeric flag, getwidget when editable theArgs = list(...) # deprecated coerce.with = tag(obj, "coerce.with") ## do things depending on whether there is an entry or not ## if editable, then entry is widget and combo may be found by tag("combo") if(tag(obj,"editable")) { if(is.null(index) || index==FALSE) { ## entry = obj@widget # entry is widget entry = obj@widget$GetChild() if(!is.null(theArgs$getwidget)) { gwCat("DEBUG: getwidget is deprecated\n") } if(!is.null(theArgs$as.numeric)) { gwCat("DEBUG: as.numeric as an argument is deprected. Use coerce.with\n") } ## else we return text val = entry$GetText() coerce.with<-tag(obj,"coerce.with") if(is.null(coerce.with)) return(val) else if(is.function(coerce.with)) return(coerce.with(val)) else if(is.character(coerce.with)) return(do.call(coerce.with,list(val))) else warning("Error: coerce.with is a function or character") } else { ## return the index or NA combobox = tag(obj,"combo") # of obj@widget$GetParent() active = combobox$GetActive() if(active < 0) return(NA) else return(active+1) } } else { ## from pygtk manual combobox = obj@widget model = combobox$GetModel() selected = combobox$GetActive() items = obj[] ## selected is the index. It is 0 based if(selected < 0) { return(NULL) # none selected } else { ## do we return the index? if(!is.null(index) && index==TRUE) { return(selected + 1) } else { val = items[selected+1] coerce.with<-tag(obj,"coerce.with") if(is.null(coerce.with)) return(val) else if(is.function(coerce.with)) return(coerce.with(val)) else if(is.character(coerce.with)) return(do.call(coerce.with,list(val))) else warning("Error: coerce.with is a function or character") } } } }) ## set the displayed value to value setReplaceMethod(".svalue", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gDroplistRGtk"), function(obj, toolkit, index=NULL, ..., value) { theArgs = list(...) ## if editable do differently if(tag(obj,"editable")) { if(is.null(index) || index == FALSE) { ## entry = obj@widget entry = obj@widget$GetChild() entry$SetText(value) # gtk Call } else { ## set the index combobox = tag(obj,"combo") # or obj@widget$GetParent() combobox$SetActive(value-1) } } else { combobox = obj@widget items = obj[] # drops icons if(!is.null(index) && as.logical(index)) { # either value or index is non-null combobox$SetActive(value-1) } else { if(any(value == items)) { combobox$SetActive(min(which(value==items)) - 1) } else { combobox$AppendText(value) combobox$SetActive(length(items)) } } } return(obj) }) ## the methods [ and [<- refer to the pre-defined values in the drop list. ## [ setMethod("[", signature(x="gDroplistRGtk"), function(x, i, j, ..., drop=TRUE) { .leftBracket(x, x@toolkit, i, j, ..., drop=drop) }) setMethod(".leftBracket", signature(toolkit="guiWidgetsToolkitRGtk2",x="gDroplistRGtk"), function(x, toolkit, i, j, ..., drop=TRUE) { items = tag(x,"items") if(missing(i)) return(items[,1,drop=TRUE]) else return(items[i,1,drop=TRUE]) }) ## replaces the values in droplist ## values is a vector of values -- not a dataframe #set.values.gDropList = function(obj, values, ...) { setReplaceMethod("[", signature(x="gDroplistRGtk"), function(x, i, j,..., value) { .leftBracket(x, x@toolkit, i, j, ...) <- value return(x) }) setReplaceMethod(".leftBracket", signature(toolkit="guiWidgetsToolkitRGtk2",x="gDroplistRGtk"), function(x, toolkit, i, j, ..., value) { ## items is a data frame ## ncol=2 if doIcons, else 1 olditems = tag(x,"items") old_value <- svalue(x) ## coerce value to a data frame, if not one if(!inherits(value,"data.frame")) value = as.data.frame(value, stringsAsFactors=FALSE) if(missing(i)) { items = value n = nrow(items) i = 1:n } else { items = olditems items[i,] = value } ## update items tag(x,"items") <- items ## now update widget store = tag(x,"store") store$Clear() n = nrow(items) doIcons = tag(x,"doIcons") allIcons = getStockIcons() if(n > 0) { for(j in 1:n) { # iter = store$Append(parent=NULL) iter = store$Append() store$SetValue(iter$iter, column = 0, items[j,1]) if(doIcons) store$SetValue(iter$iter, column = 1, allIcons[[as.character(items[j,2])]]) # convert to name if(ncol(items) >= 3) { store$setValue(iter$iter, column =2, items[j,3]) } } } ## set value if we can if(!is.null(old_value) && old_value %in% items[,1, drop=TRUE]) svalue(x) <- old_value return(x) }) setMethod("length", signature(x="gDroplistRGtk"), function(x) { .length(x, x@toolkit) }) setMethod(".length", signature(toolkit="guiWidgetsToolkitRGtk2",x="gDroplistRGtk"), function(x,toolkit) { return(length(x[])) }) ################################################### ### handlers setMethod(".addhandlerclicked", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gDroplistRGtk"), function(obj, toolkit, handler, action=NULL, ...) { addhandler(obj,"changed",handler,action,...) }) ## want changed by activate -- or arrow for editable -- not keystroke setMethod(".addhandlerchanged", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gDroplistRGtk"), function(obj, toolkit, handler, action=NULL, ...) { if(tag(obj,"editable")) { id = addhandler(obj,"changed",handler = function(h,...) { if(obj@widget$GetActive() != -1) { handler(h,...) } },action) # clicked -- not keystroke ## put handler on entry too gtktry(connectSignal(obj@widget$GetChild(), signal="activate", f=handler, data=list(obj=obj, action=action,...), user.data.first = TRUE, after = FALSE), silent=TRUE) invisible(id) } else { addhandler(obj,"changed",handler,action) } }) setMethod(".addhandlerkeystroke", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gDroplistRGtk"), function(obj, toolkit, handler, action=NULL, ...) { ## put handler on entry gtktry(connectSignal(obj@widget$GetChild(), signal="changed", f=handler, data=list(obj=obj, action=action,...), user.data.first = TRUE, after = FALSE), silent=TRUE) }) gWidgetsRGtk2/R/gframe.R0000644000175100001440000000555311453114755014522 0ustar hornikuserssetClass("gFrameRGtk", contains="gGroupRGtk", prototype=prototype(new("gGroupRGtk")) ) ## add a frame for packing. subclass of gGroup setMethod(".gframe", signature(toolkit="guiWidgetsToolkitRGtk2"), function(toolkit, text = "", markup=FALSE, pos = 0, ## pos in [0,1] 0 for left, 1 for right horizontal=TRUE, container=NULL, ...) { force(toolkit) frame = gtkFrameNew() obj <- as.gWidgetsRGtk2(frame, horizontal=horizontal,...) ## group = ggroup(horizontal=horizontal, ...) # for horizontal, spacing etc. ## frame$Add(getBlock(group)) ## ## add label to group ## obj = new("gFrameRGtk", ## block=frame, widget=group@widget, toolkit=toolkit) tag(obj,"markup") <- markup names(obj) <- text frame$SetLabelAlign(pos,0.5) # was 0, suggested value by felix andrews if (!is.null(container)) { if(is.logical(container) && container == TRUE) container = gwindow(visible=TRUE) add(container, obj, ...) } return(obj) }) as.gWidgetsRGtk2.GtkFrame <- function(widget,...) { if(is.null(tag(widget,"group"))) { theArgs <- list(...) horizontal <- if(is.null(theArgs$horizontal)) TRUE else theArgs$horizontal spacing <- if(is.null(theArgs$spacing)) 5 else theArgs$spacing group <- ggroup(horizontal=horizontal, spacing=spacing) # for horizontal, spacing etc. widget$Add(getBlock(group)) } else { group <- tag(widget,"group") } ## add label to group obj <- new("gFrameRGtk",block=widget, widget=getWidget(group), toolkit=guiToolkit("RGtk2")) tag(obj,"group") <- group if(is.null(tag(obj,"markup"))) tag(obj,"markup") <- FALSE return(obj) } ### methods -- inherited from ggroup ## return label name setMethod(".names",signature(toolkit="guiWidgetsToolkitRGtk2", x="gFrameRGtk"), function(x, toolkit) { if(tag(x,"markup")) { label <- getBlock(x)$GetLabelWidget() label$GetLabel() } else { getBlock(x)$GetLabel() } }) setReplaceMethod(".names", signature(toolkit="guiWidgetsToolkitRGtk2",x = "gFrameRGtk"), function(x,toolkit,value) { frame <- getBlock(x) if(is.null(tag(x,"markup")) || !tag(x,"markup")) { frame$SetLabel(value) } else { label <- gtkLabelNew() label$SetMarkup(value) frame$SetLabelWidget(label) } return(x) }) gWidgetsRGtk2/R/gtext.R0000644000175100001440000004774213216516557014427 0ustar hornikusers## Constants setBufferFonts <- function(textview, font.attr) { font.attr <- unlist(font.attr) nms <- names(font.attr) # a vector -- not alist out <- "" if("style" %in% nms) out <- paste(out, toupperFirst(font.attr['style'])) if("weight" %in% nms) out <- paste(out, toupperFirst(font.attr['weight']), sep=" ") if("size" %in% nms) { sz <- fontSizes[font.attr['size']] sz <- ceiling(12*sz) # to font size } else { sz <- 12 } out <- paste(out, sz, sep=" ") font <- pangoFontDescriptionFromString(out) textview$modifyFont(font) ## now for color if("color" %in% nms) { color <- font.attr['color'] textview$modifyText(GtkStateType['normal'], color) } } setClass("gTextRGtk", # representation(tags="list"), contains="gComponentRGtk", prototype=prototype(new("gComponentRGtk")) ) setMethod(".gtext", signature(toolkit="guiWidgetsToolkitRGtk2"), function(toolkit, text=NULL, width=NULL, height=300, font.attr = NULL, wrap = TRUE, handler = NULL, action=NULL, container=NULL, ...) { force(toolkit) ## make textview textview = gtkTextViewNew() textview$SetLeftMargin(10) textview$SetRightMargin(10) if(wrap) textview$SetWrapMode(GtkWrapMode['word']) else textview$SetWrapMode(GtkWrapMode['none']) ## pack in a scrollwindow sw = gtkScrolledWindowNew() # group = ggroup() # add(group, sw, expand=TRUE) sw$SetPolicy("GTK_POLICY_AUTOMATIC","GTK_POLICY_AUTOMATIC") if(!is.null(width)) sw$SetSizeRequest(width,height) sw$Add(textview) textview$Show() # obj = new("gTextRGtk", block=group, widget=textview, tags=tags, toolkit=toolkit) # obj = new("gTextRGtk", block=sw, widget=textview, tags=tags, toolkit=toolkit) obj <- as.gWidgetsRGtk2(textview, block=sw) ## ## Handle attributes ## if(!is.null(font.attr)) ## font(obj) <- font.attr ## font.attr specifies text properties for the entire buffer (gWidgets 0.0-39) if(!is.null(font.attr)) { .font(textview, toolkit) <- font.attr # setBufferFonts(textview, font.attr) } if(!is.null(text)) { add(obj, text, do.newline=FALSE) } ## attach to container if (!is.null(container)) { if(is.logical(container) && container == TRUE) container = gwindow(visible=TRUE) add(container, obj,...) } if (!is.null(handler)) { id = addhandlerkeystroke(obj, handler, action) } return(obj) }) as.gWidgetsRGtk2.GtkTextView <- function(widget, ...) { theArgs <- list(...) if(!is.null(theArgs$block)) block <- theArgs$block else block <- widget obj <- new("gTextRGtk", block=block, widget=widget, toolkit=guiToolkit("RGtk2")) ## ## add tags if not there ## if(is.null(tag(obj,"tags"))) { ## buffer <- widget$GetBuffer() ## tags <- .addTags(buffer) ## tag(obj,"tags") <- tags ## } return(obj) } ## add tags to buffer ## return tags .addTags <- function(buffer) { ## weights fontWeights = names(PangoWeight) fontWeights = fontWeights[fontWeights != "normal"] # also in Styles tagtbl <- buffer$getTagTable() for(i in fontWeights) if(is.null(tagtbl$lookup(i))) buffer$createTag(i, weight = PangoWeight[i]) ## styles fontStyles = names(PangoStyle) for(i in fontStyles) if(is.null(tagtbl$lookup(i))) buffer$createTag(i, style = PangoStyle[i]) ## family buffer$createTag("monospace",family = "monospace") for(i in names(fontSizes)) if(is.null(tagtbl$lookup(i))) buffer$createTag(i, scale = fontSizes[i]) ## colors -- ## fontColors = c("black","blue","red","yellow","brown","green","pink") ## for(i in fontColors) { ## buffer$createTag(i,foreground = i) ## buffer$createTag(Paste(i,".background"),background = i) ## } fontColors <- grDevices::colors() lapply(fontColors, function(i) { if(is.null(tagtbl$lookup(i))) buffer$createTag(i,foreground = i) if(is.null(tagtbl$lookup(Paste(i,".background")))) buffer$createTag(Paste(i,".background"),background = i) }) tags = list( styles = fontStyles, family = "monospace", weights = fontWeights, sizes = names(fontSizes), foreground.colors = fontColors, background.colors = paste(fontColors,".background", sep="") ) return(tags) } ### methods ## drop=TRUE to get only mouse selected text setMethod(".svalue", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gTextRGtk"), function(obj, toolkit, index=NULL, drop=NULL, ...) { ## grab all text buffer = obj@widget$GetBuffer() if(is.null(drop) || drop == FALSE) { start = buffer$GetStartIter()$iter end = buffer$GetEndIter()$iter } else { ## return only **selected** text ## if drop==TRUE bounds = buffer$GetSelectionBounds() if(bounds$retval == FALSE) return("") start = bounds$start end = bounds$end } val <- buffer$GetText(start,end) return(val) }) ## svalue<-() replaces text setReplaceMethod(".svalue", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gTextRGtk"), function(obj, toolkit, index=NULL, ..., value) { textbuffer = obj@widget$GetBuffer() if(length(value) > 1) value = paste(value, collapse="\n") textbuffer$SetText(value) return(obj) }) ## clear all text in buffer setMethod("dispose",signature(obj="gTextRGtk"), function(obj,...) { .dispose(obj, obj@toolkit, ...) }) setMethod(".dispose", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gTextRGtk"), function(obj, toolkit, ...) { buffer = obj@widget$GetBuffer() startiter = buffer$GetStartIter()$iter enditer = buffer$GetEndIter()$iter buffer$Delete(startiter, enditer) }) ### Add method is a workhorse for this class. Value can be ## * a line of text ## * a vector of lines of text ## * an gWidget instance ## need to do where value of "point" ## add, as a method, needs to have a consistent signature. I' ## add text setMethod(".insert", signature(toolkit="guiWidgetsToolkitRGtk2",obj = "gTextRGtk"), function(obj, toolkit, value, where = c("end","beginning","at.cursor"), font.attr = NULL, do.newline = TRUE, ...) { ## just call add where = match.arg(where) .add(obj, toolkit, value, where=where, font.attr=font.attr, do.newline=do.newline, ...) }) ## add does all the work setMethod(".add", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gTextRGtk",value="character"), function(obj, toolkit, value, ...) { theArgs = list(...) # look for font.attr, do.newline, where do.newline = ifelse(is.null(theArgs$do.newline), TRUE, as.logical(theArgs$do.newline)) markup = theArgs$font.attr if(!is.null(markup)) { if(is.null(tag(obj, "tags"))) tag(obj, "tags") <- .addTags(obj@widget$getBuffer()) markup = markup[markup %in% unlist(tag(obj,"tags"))] # only some markup } where <- getWithDefault(theArgs$where, "end") view <- obj@widget buffer = view$GetBuffer() iter = switch(where, "end"=buffer$GetEndIter()$iter, "beginning"=buffer$GetStartIter()$iter, {gwCat("Only end, beginning implemented") buffer$GetEndIter()$iter }) for(i in 1:length(value) ) { if(is.null(markup)) { buffer$Insert(iter, value[i]) } else { lst = list(object=buffer, iter=iter, text=value[i]) for(key in names(markup)) { if(is.list(markup)) lst[[key]] <- markup[[key]] else lst[[key]] <- markup[key] } do.call("gtkTextBufferInsertWithTagsByName",lst) } if(do.newline) buffer$Insert(iter,"\n") } ## scroll to end -- if appended to end if(where == "end") { gdkWindowProcessAllUpdates() while (gtkEventsPending()) gtkMainIterationDo(blocking=FALSE) end <- buffer$getEndIter()$iter view$scrollToIter(end, within.margin = 0, use.align=TRUE) } }) ## add a widget setMethod(".add", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gTextRGtk",value="guiWidget"), function(obj, toolkit, value, ...) { .add(obj,toolkit, value@widget, ...) }) setMethod(".add", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gTextRGtk",value="gWidgetRGtk"), function(obj, toolkit, value, ...) { theArgs = list(...) # look for font.attr, do.newline, where do.newline = ifelse(is.null(theArgs$do.newline), TRUE, as.logical(theArgs$do.newline)) where = ifelse(is.null(theArgs$where), "end",theArgs$where) buffer = obj@widget$GetBuffer() iter = switch(where, "end"=buffer$GetEndIter()$iter, "beginning"=buffer$GetStartIter()$iter, {gwCat("Only end, beginning implemented") buffer$GetEndIter()$iter }) anchor = buffer$CreateChildAnchor(iter) getWidget(obj)$AddChildAtAnchor(getWidget(value), anchor) if(do.newline) buffer$Insert(iter,"\n") }) ## set the font for the selected area of the gtext object setReplaceMethod(".font", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gTextRGtk"), function(obj, toolkit, ..., value) { textview <- getWidget(obj) buffer <- textview$buffer tagtbl <- buffer$getTagTable() ## get bounds. bounds <- buffer$GetSelectionBounds() if(bounds$retval == FALSE) { ## if no text selected, we set for entire buffer ## change entire buffer -- new as of 0.64 start <- buffer$GetStartIter()$iter end <- buffer$GetEndIter()$iter buffer$removeAllTags(start, end) ## now set font by calling again } else { start <- bounds$start end <- bounds$end } tags <- sapply(value, function(i) i, simplify=FALSE) # to list ## we have family, style, weight, size, color weights <- RGtk2::PangoWeight if(!is.null(wt <- tags$weight) && wt %in% names(weights)) { if(is.null(tagtbl$lookup(wt))) buffer$createTag(wt, weight=weights[wt]) buffer$ApplyTagByName(wt, start, end) } ## style styles <- RGtk2::PangoStyle if(!is.null(style <- tags$style) && style %in% names(styles)) { if(is.null(tagtbl$lookup(style))) buffer$createTag(style, style=styles[style]) buffer$ApplyTagByName(style, start, end) } ## family families <- c("normal","sans", "serif", "monospace") if(!is.null(family <- tags$family) && family %in% families) { if(is.null(tagtbl$lookup(family))) buffer$createTag(family, family=family) buffer$ApplyTagByName(family, start, end) } ## size ## Pango Scale for converting between name and numeric value if(!is.null(size <- tags$size)) { if(is.character(size)) size <- fontSizes[size] else size <- size/12 if(is.null(tagtbl$lookup(size))) buffer$createTag(size, scale=size) buffer$ApplyTagByName(size, start, end) } ## color if(!is.null(color <- tags$color) && color %in% colors()) { if(is.null(tagtbl$lookup(color))) buffer$createTag(color, foreground=color) ## do we need to remove colors? sapply(colors(), function(i) { if(!is.null(tagtbl$lookup(i))) buffer$RemoveTagByName(i, start, end) }) buffer$ApplyTagByName(color, start, end) } ## how to modify background color? ## bg <- sprintf("%s.background", color) ## if(is.null(tagtbl$lookup(bg))) ## buffer$createTag(bg, background=bg) ## get tags that are known ## tags = value ## tags = tags[tags %in% unlist(tag(obj,"tags"))] ## if(length(tags) == 0) { ## cat(gettext("Invalid font specification\n")) ## return(obj) ## } ## for(i in tags) { ## ## color is special ## if(length(names(i)) && names(i)[1] == "color") { ## sapply(colors(), function(j) ## buffer$RemoveTagByName(j, bounds$start, bounds$end)) ## } ## buffer$ApplyTagByName(i, bounds$start, bounds$end) ## } return(obj) }) ### handlers setMethod(".addhandlerkeystroke", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gTextRGtk"), function(obj,toolkit, handler=NULL, action=NULL,...) { widget <- getWidget(obj) ID <- gSignalConnect(widget,signal = "key-release-event", # or key-press-event f = function(d,widget,event,...) { h <- list(obj=d$obj,action=d$action) key <- event$GetString() h$key <- key ## for modifiers state <- event$getState() if(state == 0) modifier <- NA else modifier <- gsub("-mask$", "",names(GdkModifierType)[GdkModifierType == state]) h$modifier <- modifier if(!is.null(d$handler) && is.function(d$handler)) d$handler(h,...) return(FALSE) # propogate }, user.data.first = TRUE, data = list(obj=obj,handler=handler, action=action) ) invisible(ID) }) ## generic setMethod(".addhandlerchanged", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gTextRGtk"), function(obj,toolkit, handler=NULL, action=NULL,...) { .addhandlerkeystroke(obj,toolkit,handler,action,...) }) ################################################## ################################################## ## testing This is copied from pygtk tutorial addWidgetAtPoint = function(obj, value) { evb = gtkEventBoxNew() evb$SetVisibleWindow(FALSE) evb$SetBorderWidth(15) evb$AddEvents(c(GdkEventMask["button-press-mask"], GdkEventMask["button-release-mask"], GdkEventMask["button-motion-mask"], GdkEventMask["button-motion-hint-mask"])) widget = value@widget if(is(widget,"gContainer") || is(widget,"gComponent")) widget = widget@widget # for instance, ggroup evb$Add(widget) evb$ShowAll() ## connect move handler? gtktry(connectSignal(evb, signal = "button-press-event", f = movableWidgetButtonPressHandler, data = list(obj=obj@widget), user.data.first = TRUE), silent=TRUE) gtktry(connectSignal(evb, signal = "button-release-event", f = movableWidgetButtonReleaseHandler, data = list(obj=obj@widget), user.data.first = TRUE), silent=TRUE) gtktry(connectSignal(evb, signal = "motion-notify-event", f = movableWidgetButtonMotionNotifyHandler, data = list(obj=obj@widget), user.data.first = TRUE), silent=TRUE) ## get xpos, ypos ptr = obj@widget$GetPointer() xpos = ptr$x; ypos = ptr$y xpos = 1; ypos = 1 buffer = obj@widget$GetBuffer() iter = buffer$GetEndIter()$iter anchor = buffer$CreateChildAnchor(iter) obj@widget$AddChildAtAnchor(evb, anchor) return() obj@widget$AddChildInWindow(evb, GtkTextWindowType['widget'], xpos, ypos) } movableWidgetButtonPressHandler = function(h, widget, event, ...) { textview = h$obj info = widget$GetData("moveable-widget-data") if(is.null(info)) { info = list("start_x"= NA, "start_y"=NA, button = NA) widget$SetData("moveable-widget-data", info) } if(!is.list(info[['button']]) || is.na(info[['button']])) { info$button = event allocation = widget$GetAllocation() info[['start_x']] = allocation$x info[['start_y']] = allocation$y info[['click_x']] = allocation$x + event$GetX() info[['click_y']] = allocation$y + event$GetY() widget$SetData("moveable-widget-data", info) } return(FALSE) } movableWidgetButtonReleaseHandler = function(h, widget, event, ...) { info = widget$GetData("moveable-widget-data") if(!is.list(info[['button']]) || is.na(info[['button']])) { gwCat("relase handler failed\n") return(FALSE) } info = widget$GetData("moveable-widget-data") x = info[['start_x']] + event$GetX() + widget$GetAllocation()$x - info[['click_x']] y = info[['start_y']] + event$GetY() + widget$GetAllocation()$y - info[['click_y']] widget$SetData("moveable-widget-data", NULL) h$obj$MoveChild(widget, x,y) return(FALSE) } movableWidgetButtonMotionNotifyHandler = function(h, widget, event, ...) { info = widget$GetData("moveable-widget-data") ptr = widget$GetPointer() allocation = widget$GetAllocation() x = ptr$x + allocation$x y = ptr$y + allocation$y x = info[['start_x']] + (x - info[['click_x']]) y = info[['start_y']] + (y - info[['click_y']]) h$obj$MoveChild(widget, x,y) return(FALSE) } gWidgetsRGtk2/R/gradio.R0000644000175100001440000005276313216523654014534 0ustar hornikusers## Use a reference class ################################################## ## Radio widget stuff RadioWidgetGtk <- setRefClass("RadioWidgetGtk", contains="GWidgetGtk", fields=list( inner_block="ANY", # replaceble box container items="ANY", # store the items horizontal="logical", # layout direction obj = "ANY" # gradio object for callbacks ), methods=list( initialize=function(items, selected=1, horizontal=TRUE) { horizontal <<- horizontal block <<- gtkHBox() inner_block <<- gtkHBox(); block$packStart(inner_block) if(!missing(items)) { set_items(items, selected) } .self }, get_items = function() { "Return items" items }, set_items=function(items, selected=NULL) { if(length(items) == 0) return() if(is.null(selected)) selected <- get_index() items <<- items block$remove(inner_block) inner_block <<- if(horizontal) gtkHBox() else gtkVBox() block$packStart(inner_block) widget <<- gtkRadioButton(label=items[1]) ## Keep rbs around until after sapply statement rbs <- lapply(items[-1], gtkRadioButtonNewWithLabelFromWidget, group = widget) sapply(rev(widget$getGroup()), gtkBoxPackStart, object = inner_block) ## add handlers lapply(widget$getGroup(), gSignalConnect, signal="toggled", f=function(self, w, ...) { if(w$getActive()) self$notify_observers(...) }, data=.self, user.data.first=TRUE) set_index(selected) invisible() }, get_index = function() { "Return index of selected" which(sapply(rev(widget$getGroup()), gtkToggleButtonGetActive)) }, set_index = function(i) { "Set index of selection" i <- as.integer(i) l <- rev(widget$getGroup()) if(1 <= i && i <= length(l)) l[[i]]$setActive(TRUE) invisible() } )) setClass("gRadioRGtk", contains="gComponentWithRefClassWithItemsRGtk", prototype=prototype(new("gComponentWithRefClassWithItemsRGtk")) ) ## constructor setMethod(".gradio", signature(toolkit="guiWidgetsToolkitRGtk2"), function(toolkit, items, selected=1, horizontal=FALSE, handler=NULL, action=NULL, container=NULL, ... ) { force(toolkit) ref_widget <- RadioWidgetGtk$new(items, selected, horizontal) obj <- new("gRadioRGtk",block=ref_widget$block, widget=ref_widget$block, ref_widget=ref_widget, toolkit=guiToolkit("RGtk2")) if(is.data.frame(items)) items <- items[,1, drop=TRUE] # first column obj[] <- items svalue(obj,index=TRUE) <- selected ## do we add to the container? if (!is.null(container)) { if(is.logical(container) && container == TRUE) container = gwindow(visible=TRUE, toolkit=obj@toolkit) add(container, obj,...) } ## add handler if(!is.null(handler)) addHandlerChanged(obj, handler, action) invisible(obj) }) ## NOOP as.gWidgetsRGtk2.GtkRadioButton <- function(widget,...) {} ## methods setMethod(".svalue", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gRadioRGtk"), function(obj, toolkit, index=NULL, drop=NULL, ...) { index = ifelse(is.null(index),FALSE,as.logical(index)) ind <- obj@ref_widget$get_index() if(index) return(ind) else return(obj[ind]) }) ## svalue<- setReplaceMethod(".svalue", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gRadioRGtk"), function(obj, toolkit, index=NULL, ..., value) { if(is.data.frame(value)) value <- value[,1, drop=TRUE] index <- getWithDefault(index, is.logical(value)) if(!index) value <- match(value, obj[]) obj@ref_widget$set_index(value[1]) return(obj) }) setMethod(".leftBracket", signature(toolkit="guiWidgetsToolkitRGtk2",x="gRadioRGtk"), function(x, toolkit, i, j, ..., drop=TRUE) { items <- x@ref_widget$get_items() if(missing(i)) items else items[i] }) setMethod("[", signature(x="gRadioRGtk"), function(x, i, j, ..., drop=TRUE) { .leftBracket(x, x@toolkit, i, j, ..., drop=drop) }) setReplaceMethod(".leftBracket", signature(toolkit="guiWidgetsToolkitRGtk2",x="gRadioRGtk"), function(x, toolkit, i, j, ..., value) { items <- x[] if(!missing(i)) items[i] <- value else items <- value x@ref_widget$set_items(items) ## all done return(x) }) setReplaceMethod("[", signature(x="gRadioRGtk"), function(x, i, j,..., value) { .leftBracket(x, x@toolkit, i, j, ...) <- value return(x) }) ## length setMethod(".length", signature(toolkit="guiWidgetsToolkitRGtk2",x="gRadioRGtk"), function(x,toolkit) { length(x[]) }) ################################################## ## handlers ## need to deal with changing buttons via [<- ## added a handlers cache that we can manipulate setMethod(".addhandlerclicked", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gRadioRGtk"), function(obj, toolkit, handler, action=NULL, ...) { o <- Observer$new(o=handler, obj=obj, action=action) obj@ref_widget$add_observer(o) o }) setMethod(".addhandlerchanged", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gRadioRGtk"), function(obj, toolkit, handler, action=NULL, ...) { .addhandlerclicked(obj, toolkit, handler, action, ...) }) ## ## There is an issue here. When we set values via [<- the handlers are gone! ## setMethod(".addhandlerclicked", ## signature(toolkit="guiWidgetsToolkitRGtk2",obj="gRadioRGtk"), ## function(obj, toolkit, handler, action=NULL, ...) { ## radiogp <- getWidget(obj) ## btns <- rev(radiogp$GetGroup()) ## IDs = sapply(btns, function(x) { ## gtktry(connectSignal(x, ## signal="toggled", ## f=function(h,w,...) { ## ## only call handler for change to active ## ## not just toggle ## if(w$GetActive()) ## handler(h,w,...) ## }, ## data=list(obj=obj, action=action,...), ## user.data.first = TRUE, ## after = FALSE), silent=FALSE) ## }) ## handler.ID = tag(obj, "handler.id") ## if(is.null(handler.ID)) ## handler.ID =list() ## for(i in 1:length(IDs)) ## handler.ID[[length(handler.ID)+1]] = IDs[[i]] ## tag(obj, "handler.id", replace=FALSE) <- handler.ID ## invisible(IDs) ## }) ################################################## ## ## constructor ## setMethod(".gradio", ## signature(toolkit="guiWidgetsToolkitRGtk2"), ## function(toolkit, ## items, selected=1, horizontal=FALSE, ## handler=NULL, action=NULL, ## container=NULL, ## ... ## ) { ## force(toolkit) ## if(horizontal) ## g <- gtkHBox() ## else ## g <- gtkVBox() ## radiogp <- gtkRadioButton(group=NULL, label=items[1]) # initial ## obj <- as.gWidgetsRGtk2(radiogp, block=g) ## if(is.data.frame(items)) ## items <- items[,1, drop=TRUE] # first column ## obj[] <- items ## svalue(obj,index=TRUE) <- selected ## tag(obj, ".handlers") <- list() # list of handlers keyed by ID ## ## do we add to the container? ## if (!is.null(container)) { ## if(is.logical(container) && container == TRUE) ## container = gwindow(visible=TRUE, toolkit=obj@toolkit) ## add(container, obj,...) ## } ## ## add handler ## if(!is.null(handler)) ## addHandlerChanged(obj, handler, action) ## invisible(obj) ## }) ## ## coercion method from a gtkRadioButton widget. Pass in container via bloc ## as.gWidgetsRGtk2.GtkRadioButton <- function(widget,...) { ## theArgs <- list(...) ## if(!is.null(theArgs$block)) ## block <- theArgs$block ## else ## block <- gtkHBox() # or vbox! ## obj <- new("gRadioRGtk",block=block, widget=widget, ## toolkit=guiToolkit("RGtk2")) ## return(obj) ## } ## ## methods ## setMethod(".svalue", ## signature(toolkit="guiWidgetsToolkitRGtk2",obj="gRadioRGtk"), ## function(obj, toolkit, index=NULL, drop=NULL, ...) { ## index = ifelse(is.null(index),FALSE,as.logical(index)) ## radiogp <- getWidget(obj) ## btns <- rev(radiogp$GetGroup()) ## ind <- sapply(btns, function(i) i$GetActive()) ## if(index) ## return(which(ind)) ## else ## return(obj[ind]) ## }) ## ## svalue<- ## setReplaceMethod(".svalue", ## signature(toolkit="guiWidgetsToolkitRGtk2",obj="gRadioRGtk"), ## function(obj, toolkit, index=NULL, ..., value) { ## if(is.data.frame(value)) ## value <- value[,1, drop=TRUE] ## radiogp <- getWidget(obj) ## btns <- rev(radiogp$GetGroup()) ## items <- obj[] ## if(!is.null(index) && index==TRUE) { ## if(value %in% 1:length(obj)) ## btns[[as.numeric(value)]]$SetActive(TRUE) ## else ## cat(sprintf("index outside of range\n")) ## } else { ## if(value %in% items) { ## whichIndex = min(which(value == items)) ## btns[[whichIndex]]$SetActive(TRUE) ## } else { ## cat(sprintf("Value %s is not among the items\n",value)) ## } ## } ## return(obj) ## }) ## setMethod(".leftBracket", ## signature(toolkit="guiWidgetsToolkitRGtk2",x="gRadioRGtk"), ## function(x, toolkit, i, j, ..., drop=TRUE) { ## radiogp <- getWidget(x) ## btns <- rev(radiogp$GetGroup()) ## btns <- btns[1:tag(x,".n")] ## items <- sapply(btns, function(i) i$GetLabel()) ## if(missing(i)) ## items ## else ## items[i] ## }) ## setMethod("[", ## signature(x="gRadioRGtk"), ## function(x, i, j, ..., drop=TRUE) { ## .leftBracket(x, x@toolkit, i, j, ..., drop=drop) ## }) ## setReplaceMethod(".leftBracket", ## signature(toolkit="guiWidgetsToolkitRGtk2",x="gRadioRGtk"), ## function(x, toolkit, i, j, ..., value) { ## radiogp <- getWidget(x) ## gp <- getBlock(x) ## btns <- rev(radiogp$GetGroup()) ## n = length(x) ## ## set items ## if(missing(i)) { ## ## The radio group doesn't like to reduce the size. We trick it by ## ## keeping track of a variable length in ".n" tag ## n <- length(value) ## if(n < 2) { ## cat(sprintf("Length of items must be 2 or more\n")) ## return(x) ## } ## ## we store the length of items in the .n value. ## ## When shortening a lenght by setting the group, the GTK ## ## widget does not truncate. We use this to do so. (leaving some ## ## possible orphans in the radioButtonGroup object.) ## tag(x, ".n") <- n ## ## clear old ## sapply(gp$getChildren(), function(i) gp$remove(i)) ## ## make new ## radiogp1 <- gtkRadioButton(group=NULL, label=value[1]) ## sapply(value[-1], function(i) { ## radiogp1$newWithLabelFromWidget(i) ## }) ## ## replace -- doesn't clear, just replaces first n (even if more than n) ## radiogp$setGroup(radiogp1$getGroup()) ## ## now add to container ## btns <- rev(radiogp$getGroup())[1:n] # no more than n of them ## sapply(btns, function(i) gp$PackStart(i)) ## ## need to add in the handlers ## ## Always call to see if a handler exists ## sapply(btns, function(i) { ## gSignalConnect(i, "toggled", f=function(obj, w, ...) { ## if(w$getActive()) { ## ## call handlers from h ## handlers <- tag(obj, ".handlers") ## if(length(handlers)) { ## ## handler is list with blocked, handler, action component ## sapply(handlers, function(handler) { ## if(!handler$blocked) ## handler$handler(list(obj=obj, action=handler$action), ...) ## }) ## } ## } ## }, ## data=x, ## user.data.first=TRUE, ## after=FALSE ## ) ## }) ## } else { ## ## update just the i values ## i <- i[i <= n] ## for(j in 1:length(i)) ## btns[[j]]$SetLabel(value[j]) ## } ## ## all done ## return(x) ## }) ## setReplaceMethod("[", ## signature(x="gRadioRGtk"), ## function(x, i, j,..., value) { ## .leftBracket(x, x@toolkit, i, j, ...) <- value ## return(x) ## }) ## ## length ## setMethod(".length", ## signature(toolkit="guiWidgetsToolkitRGtk2",x="gRadioRGtk"), ## function(x,toolkit) { ## tag(x, ".n") ## # radiogp <- getWidget(x) ## # btns <- rev(radiogp$GetGroup()) ## # length(btns) ## }) ## ## enabled must go on each button ## ## enabled <- ## setReplaceMethod(".enabled", ## signature(toolkit="guiWidgetsToolkitRGtk2",obj="gRadioRGtk"), ## function(obj, toolkit, ..., value) { ## radiogp <- getWidget(obj) ## btns <- rev(radiogp$GetGroup()) ## sapply(btns, function(i) { ## i$SetSensitive(as.logical(value)) ## }) ## return(obj) ## }) ## setReplaceMethod(".visible", ## signature(toolkit="guiWidgetsToolkitRGtk2",obj="gRadioRGtk"), ## function(obj, toolkit, ..., value) { ## radiogp <- getWidget(obj) ## btns <- rev(radiogp$GetGroup()) ## sapply(btns, function(i) { ## if(value) ## i$show() ## else ## i$hide() ## # i$SetSensitive(as.logical(value)) ## }) ## return(obj) ## }) ## ################################################## ## ## handlers ## ## need to deal with changing buttons via [<- ## ## added a handlers cache that we can manipulate ## setMethod(".addhandlerclicked", ## signature(toolkit="guiWidgetsToolkitRGtk2",obj="gRadioRGtk"), ## function(obj, toolkit, handler, action=NULL, ...) { ## handlers <- tag(obj, ".handlers") ## if(length(handlers)) ## nhandlers <- max(as.numeric(names(handlers))) ## else ## nhandlers <- 0 ## newhandler <- list(blocked=FALSE, ## handler=handler, ## action=action) ## ID <- as.character(nhandlers + 1) ## handlers[[ID]] <- newhandler ## tag(obj, ".handlers") <- handlers ## invisible(ID) ## }) ## setMethod(".addhandlerchanged", ## signature(toolkit="guiWidgetsToolkitRGtk2",obj="gRadioRGtk"), ## function(obj, toolkit, handler, action=NULL, ...) { ## .addhandlerclicked(obj,toolkit,handler,action,...) ## }) ## setMethod(".removehandler", ## signature(toolkit="guiWidgetsToolkitRGtk2",obj="gRadioRGtk"), ## function(obj, toolkit, ID=NULL, ...) { ## handlers <- tag(obj, ".handlers") ## if(is.null(ID)) { ## handlers <- list() # remove all ## } else { ## sapply(ID, function(id) { ## handlers[[id]] <<- NULL ## }) ## } ## tag(obj, ".handlers") <- handlers ## }) ## setMethod(".blockhandler", ## signature(toolkit="guiWidgetsToolkitRGtk2",obj="gRadioRGtk"), ## function(obj, toolkit, ID=NULL, ...) { ## handlers <- tag(obj, ".handlers") ## if(is.null(ID)) { ## ID <- names(handlers) ## } ## sapply(ID, function(id) { ## handlers[[id]]$blocked <<- TRUE ## }) ## tag(obj, ".handlers") <- handlers ## }) ## setMethod(".unblockhandler", ## signature(toolkit="guiWidgetsToolkitRGtk2",obj="gRadioRGtk"), ## function(obj, toolkit, ID=NULL, ...) { ## handlers <- tag(obj, ".handlers") ## if(is.null(ID)) { ## ID <- names(handlers) ## } ## sapply(ID, function(id) { ## handlers[[id]]$blocked <<- FALSE ## }) ## tag(obj, ".handlers") <- handlers ## }) ## ## ## There is an issue here. When we set values via [<- the handlers are gone! ## ## setMethod(".addhandlerclicked", ## ## signature(toolkit="guiWidgetsToolkitRGtk2",obj="gRadioRGtk"), ## ## function(obj, toolkit, handler, action=NULL, ...) { ## ## radiogp <- getWidget(obj) ## ## btns <- rev(radiogp$GetGroup()) ## ## IDs = sapply(btns, function(x) { ## ## gtktry(connectSignal(x, ## ## signal="toggled", ## ## f=function(h,w,...) { ## ## ## only call handler for change to active ## ## ## not just toggle ## ## if(w$GetActive()) ## ## handler(h,w,...) ## ## }, ## ## data=list(obj=obj, action=action,...), ## ## user.data.first = TRUE, ## ## after = FALSE), silent=FALSE) ## ## }) ## ## handler.ID = tag(obj, "handler.id") ## ## if(is.null(handler.ID)) ## ## handler.ID =list() ## ## for(i in 1:length(IDs)) ## ## handler.ID[[length(handler.ID)+1]] = IDs[[i]] ## ## tag(obj, "handler.id", replace=FALSE) <- handler.ID ## ## invisible(IDs) ## ## }) gWidgetsRGtk2/R/gtree.R0000644000175100001440000005045613216523716014371 0ustar hornikuserssetClass("gTreeRGtk", contains="gComponentRGtk", prototype=prototype(new("gComponentRGtk")) ) ## offspring takes two argument ## toolkit constructor for gtree setMethod(".gtree", signature(toolkit="guiWidgetsToolkitRGtk2"), function(toolkit, offspring = NULL, hasOffspring = NULL, # for defining offspring. FUN # of children only. offspring.data = NULL, col.types = NULL, # data frame with logical icon.FUN = NULL, # return stock name --called # on offspring, returns a # vector of length nrow chosencol = 1, multiple = FALSE, handler = NULL, action=NULL, container=NULL, ... ) { force(toolkit) ## do we have first col. for icons? iconFudge <- ifelse(is.null(icon.FUN), 0, 1) ## is second column for offspring? ## get base offspring children <- offspring(c(), offspring.data) ## we have some hacks here. First we place icon info into data frame if icon.FUN non NULL ## as well, we also strip out hasOffspring info into doExpand variable. This might be found ## from a function or from the second column -- if logical, or is just FALSE. ## we can have icons, if so we place in column 1 ## column 2 can have offspring data! ## put in icons if needed lst <- getOffSpringIcons(children, hasOffspring, icon.FUN) children <- lst$children doExpand <- lst$doExpand ## ask before we put in icon info if asked if(is.null(col.types)) { col.types <- children[1,] if(iconFudge) col.types <- col.types[, -1] # shift out icon info } ## get GTK types -- force first to be character if(length(col.types) > 1) { types = c("gchararray", sapply(col.types[ ,-1],RtoGObjectConversion)) } else { types <- "gchararray" } if(iconFudge == 1) types <- c("gchararray", types) # stores filename of image ## define treestore, sorted, view treestore <- gtkTreeStoreNew(types) treestoreModel <- gtkTreeModelSortNewWithModel(treestore) view <- gtkTreeViewNewWithModel(treestoreModel) ## if(nrow(children) > 15) ## view$SetFixedHeightMode(TRUE) # speeds up this. FAILED? view$SetSearchColumn(iconFudge) # for CTRL-f ## define cellrender colHeaders <- names(children) for(i in (1+iconFudge):ncol(children)) { cellrenderer = gtkCellRendererTextNew() view.col = gtkTreeViewColumnNew() ## properties view.col$SetResizable(TRUE) ## title if(!is.na(colHeaders[i]) && !is.null(colHeaders[i])) view.col$SetTitle(colHeaders[i]) view.col$SetSortColumnId(i-1) # allow sorting view.col$PackStart(cellrenderer, TRUE) view.col$AddAttribute(cellrenderer, "text", i-1) view$InsertColumn(view.col,i-1) } if(iconFudge == 1) { cellrenderer = gtkCellRendererPixbufNew() view.col = gtkTreeViewColumnNew() ## properties # view.col$SetMaxWidth(20) # 20 pixel icons view.col$PackStart(cellrenderer, TRUE) view.col$AddAttribute(cellrenderer, "stock-id", 0) view$InsertColumn(view.col,0) } ## pack into scrolled window group = ggroup() sw <- gtkScrolledWindowNew() sw$SetPolicy("GTK_POLICY_AUTOMATIC","GTK_POLICY_AUTOMATIC") sw$Add(view) add(group, sw, expand=TRUE) ## allow multiple if asked if(multiple) { treeselection = view$GetSelection() treeselection$SetMode(GtkSelectionMode["multiple"]) } ## turn on alternating shading if more than 1 column if(ncol(children) > 1) view$SetRulesHint(TRUE) obj = new("gTreeRGtk", block=group, widget=view, toolkit=toolkit) tag(obj,"store") <- treestore tag(obj,"SortedStore") <- treestoreModel tag(obj,"view") <- view tag(obj,"offspring") =offspring tag(obj,"hasOffspring") = hasOffspring tag(obj,"offspring.data") = offspring.data tag(obj,"icon.FUN") = icon.FUN tag(obj,"iconFudge") = iconFudge tag(obj,"chosencol") = chosencol tag(obj,"multiple") = multiple tag(obj,"ncols") = length(types) ## put in children, handler for expand-row addChildren(treestore, children, doExpand, iconFudge, parent.iter=NULL) ## now add a handler to row-exapnd addhandler(obj,"row-expanded", handler = function(h,view, iter, path,...) { ## get unsorted iter from path uspath <- treestoreModel$ConvertPathToChildPath(path) iter <- treestore$GetIter(uspath)$iter path <- .getValuesFromIter(h$obj,iter) children <- offspring(path,tag(obj, "offspring.data")) lst <- getOffSpringIcons(children, hasOffspring, icon.FUN) children <- lst$children doExpand <- lst$doExpand addChildren(treestore, children, doExpand, tag(h$obj,"iconFudge"), iter) ## remove errant offspring child.iter <- treestore$IterChildren(iter) if(child.iter$retval) treestore$Remove(child.iter$iter) }) addhandler(obj,"row-collapsed", handler = function(h, view, iter, path, ...) { ## get unsorted iter from path uspath = treestoreModel$ConvertPathToChildPath(path) iter = treestore$GetIter(uspath)$iter ## get children, remove n = treestore$IterNChildren(iter) if(n > 1) { ## n=1 gets removed when expanded for(i in 1:(n-1)) { child.iter = treestore$IterChildren(iter) if(child.iter$retval) treestore$Remove(child.iter$iter) } } }) if(!is.null(handler)) { id = addhandlerdoubleclick(obj,handler,action) tag(obj, "handler.id") <- id } ## attach to container if (!is.null(container)) { if(is.logical(container) && container == TRUE) container = gwindow(visible=TRUE) add(container, obj,...) } return(obj) }) ## Take the data frame and massage it to return ## icons if asked, and figure out offspring getOffSpringIcons = function(children, hasOffspring, icon.FUN) { ## do we expand? ## how to determine if offspring are needed? ## default to hasOffspring, then second column, then default to FALSE if(!is.null(hasOffspring)) { doExpand = hasOffspring(children) } else { ## if second column is logical, we use that if(is.logical(children[,2])) { doExpand = children[,2] children = children[,-2, drop=FALSE] } else { doExpand = rep(FALSE, nrow(children)) } } ## make icons first column if there ## icon.FUN is called on data.frame, returns vector to cbind to children. if(!is.null(icon.FUN)) { if(nrow(children) > 0) { icons = getstockiconname(icon.FUN(children)) children = data.frame(icons=I(icons), children) } else { children = data.frame( icons = character(0), children) } } return(list(children=children, doExpand=doExpand)) } ## children has label, logical, ... ## used to update tree addChildren = function(treestore, children, doExpand, iconFudge, parent.iter=NULL) { if(nrow(children) == 0) return(NULL) ## load row by row, column by column for(i in 1:nrow(children)) { iter <- treestore$Append(parent=parent.iter)$iter ## no write values for each column for(j in 1:ncol(children)) { treestore$SetValue(iter,column=j-1, children[i,j]) } ## add branch? if(!is.na(doExpand[i]) && doExpand[i]) { treestore$Append(parent=iter) } } } ## has different arguments, but we mask this with ... ## this has offspringdata as first argument setMethod("update", signature(object="gTreeRGtk"), function(object,...) { .update(object, object@toolkit, ...) }) setMethod(".update", signature(toolkit="guiWidgetsToolkitRGtk2",object="gTreeRGtk"), function(object, toolkit, ...) { theArgs = list(...) offspring.data = theArgs$offspring.data if(is.null(offspring.data) && length(theArgs)) offspring.data = theArgs[[1]] if(!is.null(offspring.data)) tag(object, "offspring.data") <- offspring.data obj = object # rename, object from update generic ## what should now be in this part of the tree newchildren <- tag(object,"offspring")(c(), tag(object, "offspring.data")) newvalues <- newchildren stillThere <- c() ## allow override by passing in function isStillThere into object via tag ## you may want to use get and digets here ## val is c(name, type) of item from tree; ## allVals is df with nameType of the newvalues to add to tree isStillThere <- function(val, allVals) { if(length(val) && length(allVals)) val[1] %in% allVals[,1,drop=TRUE] else FALSE } isStillThere <- getWithDefault(tag(obj, "isStillThere"), isStillThere) ## loop over values in the treestore, if not in newchildren, remove i <- 0 remove.these <- c() iter = tag(obj,"store")$GetIterFromString(i) while(iter$retval) { n <- ncol(newchildren) - is.null(tag(obj, "hasOffspring")) old <- sapply(1:n, function(i) { tag(obj,"store")$GetValue(iter$iter, i - 1 + tag(obj,"iconFudge"))$value }) # treeValue <- tag(obj,"store")$GetValue(iter$iter,0 +tag(obj,"iconFudge"))$value # treeValueType <- tag(obj,"store")$GetValue(iter$iter,0+ 1 +tag(obj,"iconFudge"))$value # if(isStillThere(c(treeValue, treeValueType), newvalues)) { if(isStillThere(old, newvalues)) { stillThere <- c(stillThere, old[1]) } else { ## need to delete remove.these = c(remove.these, i) } i = i + 1 iter = tag(obj,"store")$GetIterFromString(i) } if(length(remove.these)>0) { for(i in rev(sort(remove.these))) { iter = tag(obj,"store")$GetIterFromString(i) tag(obj,"store")$Remove(iter$iter) } } didThese = newvalues[,1,drop=TRUE] %in% stillThere newchildren = newchildren[!didThese, , drop=FALSE] # don't drop dimension ## add these to end if(nrow(newchildren) > 0) { lst = getOffSpringIcons(newchildren, tag(obj,"hasOffspring"), tag(obj,"icon.FUN")) newchildren = lst$children doExpand = lst$doExpand ## add the children addChildren(tag(obj,"store"), newchildren, doExpand, tag(obj,"iconFudge")) } }) ## XXX OLDuse index for the column to override the column returned ## XXX Index should be for index of selected, e.g 1:2:3 type thing -- aka the path ## @param index if TRUE, then return either a numeric vector or list of numeric vectors (if multiple selection) setMethod(".svalue", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gTreeRGtk"), function(obj, toolkit, index=NULL, drop=NULL,...) { theArgs = list(...) index <- getWithDefault(index, FALSE) if(index) { ## make change -- return tree index twidget <- obj@widget sel <- twidget$getSelection() selectedRows <- sel$getSelectedRows() selList <- selectedRows$retval # list of GtkTreePaths if(length(selList) == 0) { ## no selection return(NULL) } out <- lapply(selList, function(i) { tmp <- i$toString() vals <- as.numeric(unlist(strsplit(tmp, ":"))) + 1 }) if(length(out) == 1) out <- out[[1]] # return a list only if 2 or more return(out) } ## we had case for both multiple or not, but we can use the same code for each ## if(tag(obj,"multiple")) { treeselection = obj@widget$GetSelection() out = treeselection$GetSelectedRows() # 2 parts, paths, model if(length(out$retval) == 0) { return(NULL) } else { model = out$model tmp = c() for(i in out$retval) { iter = model$GetIter(i)$iter value = model$GetValue(iter, tag(obj, "chosencol") - 1 + tag(obj,"iconFudge"))$value tmp = c(tmp,value) } return(tmp) } ## } else { ## ## single selection ## iter = obj@widget$GetSelection()$GetSelected() ## if(iter$retval) ## return(obj@widget$GetModel()$GetValue(iter$iter,whichCol-1 + ## tag(obj,"iconFudge"))$value) ## else ## return(NULL) # nothing selected ## } }) ## svalue<- ## ## Set selection by index. A path looks like c(a,b,c) 1-based ## @param value indices. Either a vector for single selection or list of vectors for multiple selection. ## @param index must be TRUE setReplaceMethod(".svalue", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gTreeRGtk"), function(obj, toolkit, index=NULL, ..., value) { index <- getWithDefault(index, TRUE) if(!index) { gwCat(gettext("Need to have index=TRUE (or NULL)")) return(obj) } ## value is character vector of paths. tr <- getWidget(obj) sel <- tr$getSelection() sel$unselectAll() # clear selection if(is.atomic(value)) value <- list(value) value <- lapply(value, function(i) i-1) lapply(value, function(tmp) { for(j in 1:length(tmp)) { tpath <- gtkTreePathNewFromString(paste(tmp[1:j], collapse=":")) tr$expandRow(tpath, open.all=FALSE) } sel$selectPath(tpath) ## adds if selection is multiple }) return(obj) }) ### need to figure this out ## return the path in values. i,j ignored setMethod("[", signature(x="gTreeRGtk"), function(x, i, j, ..., drop=TRUE) { .leftBracket(x, guiToolkit("RGtk2"), i, j, ..., drop=drop) }) setMethod(".leftBracket", signature(toolkit="guiWidgetsToolkitRGtk2",x="gTreeRGtk"), function(x, toolkit, i, j, ..., drop=TRUE) { obj = x ## XXX We had different cases for multiple and not, but this isn't necessary ## if(tag(obj,"multiple")) { twidget <- obj@widget sel <- twidget$getSelection() selectedRows <- sel$getSelectedRows() selList <- selectedRows$retval # list of GtkTreePaths model <- selectedRows$model if(length(selList) == 0) { ## no selection return(NULL) } out <- lapply(selList, function(path) { string <- path$toString() indices <- unlist(strsplit(string,":")) thePath <- c() for(j in 1:length(indices)) { npath <- paste(indices[1:j],collapse=":") iter <- tag(obj,"SortedStore")$GetIterFromString(npath) thePath[j] <- tag(obj,"SortedStore")$GetValue(iter$iter,0+ tag(obj,"iconFudge"))$value } thePath }) if(length(out) == 1) # if only 1 selection return it, o/w give as list out <- out[[1]] return(out) ## } else { ## sel <- obj@widget$GetSelection()$GetSelected() ## if(!sel$retval) { ## ## no selection ## return(character(0)) ## } ## iter <- sel$iter ## ## need to convert to unsorted ## iter = tag(obj,"SortedStore")$ConvertIterToChildIter(iter)$child.iter ## string = tag(obj,"store")$GetPath(iter)$ToString() ## indices = unlist(strsplit(string,":")) ## thePath = c() ## for(j in 1:length(indices)) { ## path = paste(indices[1:j],collapse=":") ## iter = tag(obj,"store")$GetIterFromString(path) ## thePath[j] = tag(obj,"store")$GetValue(iter$iter,0+ ## tag(obj,"iconFudge"))$value ## } ## if(missing(i)) ## return(thePath) ## else ## return(thePath[i]) ## } }) ### methods ## row-activated in gtable gives double click setMethod(".addhandlerdoubleclick", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gTreeRGtk"), function(obj, toolkit, handler, action=NULL, ...) { addhandler(obj, "row-activated",handler,action,...) }) setMethod(".addhandlerchanged", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gTreeRGtk"), function(obj, toolkit, handler, action=NULL, ...) { .addhandlerdoubleclick(obj, toolkit, handler, action, ...) }) ## clicked is on selection setMethod(".addhandlerclicked", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gTreeRGtk"), function(obj, toolkit, handler, action=NULL, ...) { widget <- getWidget(obj) widget <- widget$getSelection() addhandler(widget, "changed",handler,action,actualobj=obj,...) }) ## used internally .getValuesFromIter = function(obj, iter) { string = tag(obj,"store")$GetPath(iter)$ToString() indices = unlist(strsplit(string,":")) thePath = c() for(i in 1:length(indices)) { path = paste(indices[1:i],collapse=":") iter = tag(obj,"store")$GetIterFromString(path) ## need to fudge here if necessary thePath[i] = tag(obj,"store")$GetValue(iter$iter,0+tag(obj,"iconFudge"))$value } return(thePath) } gWidgetsRGtk2/R/aabClasses.R0000644000175100001440000000076511406427002015310 0ustar hornikusers### these classes need to be defined before their subclasses. Alphabetical doesn't cut ### is so they go here. ### this must come after aaaGenerics, as there gComponentRGtk is defined setClass("gEditRGtk", contains="gComponentRGtk", prototype=prototype(new("gComponentRGtk")) ) setClass("gGroupRGtk", contains="gContainerRGtk", prototype=prototype(new("gContainerRGtk")) ) setClass("gNotebookRGtk", contains="gComponentRGtk" ) gWidgetsRGtk2/R/gcalendar.R0000644000175100001440000000545411406427002015167 0ustar hornikusers## add calendar widget: shoule I have gcalendar, gcalendarbrowser? ## no handler function, can add to entry object with addhandler setClass("gCalendarRGtk", contains="gEditRGtk", prototype=prototype(new("gEditRGtk")) ) setMethod(".gcalendar", signature(toolkit="guiWidgetsToolkitRGtk2"), function(toolkit, text="", format="%Y-%m-%d", handler = NULL, action=NULL, container=NULL,...) { force(toolkit) lggroup <- function(...,coerce.with) ggroup(...) group <- ggroup(horizontal=TRUE, container=container, ..., toolkit=toolkit) lgedit <- function(..., expand, horizontal,spacing) gedit(...) entry <- lgedit(text=text, container=group, handler=handler,action=action,..., toolkit=toolkit) calendar.cb = function(h,...) { ## called when button is clicked ## pop up a calendar, when date selected, copy to entry win = gtkWindowNew(show=FALSE) cal = gtkCalendarNew() win$Add(cal) cal$Show(); win$Show() cal$AddCallback("day-selected-double-click", function(w,...) { l = cal$GetDate() dateselected = paste(l$year,l$month+1,l$day,sep="-",collapse="-") ## format date dateselected = format(as.Date(dateselected,format=format)) svalue(entry) <- dateselected ## call handler if present if(!is.null(handler)) { h = list() h$obj = entry h$action = action handler(h) } ## call change event on entry widget win$Destroy() }) } gbutton("calendar",handler=calendar.cb, container=group) obj = new("gCalendarRGtk", block=group, widget = entry@widget@widget, toolkit=toolkit) ## tag items don't get inherited: theArgs <- list(...) tag(obj,"coerce.with") <- theArgs$coerce.with tag(obj,"format") <- format invisible(obj) }) setMethod(".svalue", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gCalendarRGtk"), function(obj, toolkit, index=NULL, drop=NULL, ...) { val = obj@widget$getText() curDate <- try(as.Date(val, format=tag(obj,"format"))) if(inherits(curDate,"try-error")) return(NA) val <- as.character(curDate) if(!is.null(tag(obj,"coerce.with"))) val = do.call(tag(obj,"coerce.with"), list(val)) return(val) }) gWidgetsRGtk2/R/gstatusbar.R0000644000175100001440000000510211520026363015416 0ustar hornikusers## gtkStatusBar. Use value to push message, value to pop setClass("gStatusbarRGtk", contains="gComponentRGtk", representation=representation(label="GtkLabel"), prototype=prototype(new("gComponentRGtk")) ) ## constructor setMethod(".gstatusbar", signature(toolkit="guiWidgetsToolkitRGtk2"), function(toolkit, text="", container=NULL, ...) { force(toolkit) statusbar <- gtkStatusbarNew() statusbar$setHasResizeGrip(TRUE) sbl <- statusbar[[1]][[1]] ## use our own label, not statusbars l <- gtkLabel() ## l$modifyFont(pangoFontDescriptionFromString("10px")) l['xalign'] <- 0.0 # not 0.5 statusbar[[1]]$remove(statusbar[[1]][[1]]) statusbar[[1]]$add(l) ##statusbar$push(statusbar$getContextId("message"), text) obj <- as.gWidgetsRGtk2(statusbar) svalue(obj) <- text if (!is.null(container)) { if(is.logical(container) && container == TRUE) container = gwindow(visible=TRUE) add(container, obj,...) } invisible(obj) }) as.gWidgetsRGtk2.GtkStatusbar <- function(widget,...) { obj <- new("gStatusbarRGtk",block=widget, widget=widget, label=widget[[1]][[1]], toolkit=guiToolkit("RGtk2")) return(obj) } ### methods ## This pops from stack setMethod(".svalue", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gStatusbarRGtk"), function(obj, toolkit, index=NULL, drop=NULL, ...) { obj@label$getLabel() ## obj@widget$Pop(obj@widget$getContextId("message")) }) ## This pushes to stack setReplaceMethod(".svalue", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gStatusbarRGtk"), function(obj, toolkit, index=NULL, ..., value) { label <- obj@label if(value == "") value <- " " # need some text to act as strut label$setText(paste(value, collapse="\n")) # obj@widget$Push(obj@widget$getContextId("message"), value) return(obj) }) ## push font down to label setReplaceMethod(".font", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gStatusbarRGtk"), function(obj, toolkit, ..., value) { .font(obj@label, toolkit, ...) <- value return(obj) }) gWidgetsRGtk2/R/ggraphics.R0000644000175100001440000004722413216523631015225 0ustar hornikusers## cairo graphics device ## would like to get size from par("fin"), but this isn't so easy as it ## seems to pop up a new plot container ## pas through ... some means to control: ## rubber banding (do.rubber.banding=FALSE) ## menu popup (no_popup=TRUE) setClass("gGraphicsRGtk", contains="gComponentRGtk", prototype=prototype(new("gComponentRGtk")) ) setMethod(".ggraphics", signature(toolkit="guiWidgetsToolkitRGtk2"), function(toolkit, width=dpi*6, height=dpi*6, dpi=75, ps=12, container=NULL,...) { force(toolkit) da <- gtkDrawingAreaNew() asCairoDevice(da, pointsize=ps) ## set size if(!is.null(width) & !is.null(height)) da$setSizeRequest(width, height) ## allow events on this widget da$AddEvents(GdkEventMask["all-events-mask"]) obj <- as.gWidgetsRGtk2(da) # obj = new("gGraphicsRGtk",block=da, widget=da, toolkit=toolkit) ## Woah Nelly! since 2.0.1 the device needs to be realized before we can make it ## so we put this in: ## when a device is clicked. addhandler(obj,signal="map-event",handler = function(h, w, e, ...) { da <- h$action ## in cairoDevice (>= 2.2.0) the device is stored in da$GetData(".devnum") if(is.null(da$GetData(".devnum"))) { asCairoDevice(da, pointsize=ps) # turn into cairo device tag(obj,"device") <- da$GetData(".devnum") } return(TRUE) # don't propogate }, action=da) ## handlers to raise device when clicked upon. This seems a natural way to interact with ## the device .getDevNo <- function(da) da$getData(".devnum") .setDevNo <- function(da, ...) { dev.set(.getDevNo(da)) ## indicate? FALSE} ## raise when click into window gSignalConnect(da, "button-press-event", f=.setDevNo) ## raise when motion over device -- CONFUSING, leave out # da$addEvents(GdkEventMask['enter-notify-mask']) # gSignalConnect(da, "enter-notify-event", f=.setDevNo) ## close device when destroyed gSignalConnect(da, "destroy-event", f=function(da, ...) { dev.off(.getDevNo(da)) return(FALSE) }) ## Add rubber banding ## This code is borrowed from the excellent playwith package by Felix Andrews theArgs <- list(...) doRubberBanding <- getWithDefault(theArgs$do.rubber.banding, TRUE) ## add environment and values to da e <- environment() e$dragging <- FALSE e$x0 <- e$y0 <- e$x <- e$y <- 0 da$setData("env", e) ## need to bind drag actions: click, motion, release if(doRubberBanding) gSignalConnect(da, "button-press-event", function(w, e) { if(isRightMouseClick(e)) return(FALSE) da <- w daClearRectangle(da) wh <- daGetWidthHeight(da) da.w <- wh[1] da.h <- wh[2] ## assign("da", da, envir=.GlobalEnv) ## buf <- gdkPixbufGetFromDrawable(src=da$window, src.x=0, src.y=0, ## dest.x=0, dest.y=0, width=da.w, height=da.h) ## w$setData("buf", buf) env <- w$getData("env") env$x0 <- env$x <- e$x env$y0 <- env$y <- e$y env$dragging <- TRUE return(FALSE) }) if(doRubberBanding) gSignalConnect(da, "motion-notify-event", function(w, e) { env <- w$getData("env") ## are we dragging? if(env$dragging) { daClearRectangle(w) env$x <- e$x env$y <- e$y ## did we move enough? 10 pixels say if(max(abs(env$x - env$x0), abs(env$y - env$y0)) > 10) daDrawRectangle(w, env$x0, env$x, env$y0, env$y) } return(FALSE) }) if(doRubberBanding) gSignalConnect(da, "button-release-event", function(w, e) { if(isRightMouseClick(e)) return(FALSE) env <- w$getData("env") ## remove draggin env$dragging <- FALSE daClearRectangle(w) # tidy up return(FALSE) }) ## Right mouse menu -- some means to prevent if(is.null(theArgs$no_popup)) { l <- list() l$copyAction <- gaction("Copy", "Copy current graph to clipboard", icon="copy", handler=function(h, ...) copyToClipboard(obj)) l$printAction <- gaction("Save", "Save current graph", icon="save", handler=function(h,...) { fname <- gfile(gettext("Filename to save to"), type="save") if(nchar(fname)) { if(!file.exists(fname) || gconfirm(gettext("Overwrite file?"))) svalue(obj) <- fname } }) .add3rdmousepopupmenu(obj, toolkit, l) } ## Add to container if requested if (!is.null(container)) { if(is.logical(container) && container == TRUE) container = gwindow() add(container, obj, ...) } gSignalConnect(da, "realize", function(...) { gdkWindowProcessAllUpdates() while (gtkEventsPending()) gtkMainIterationDo(blocking=FALSE) }) return(obj) }) as.gWidgetsRGtk2.GtkDrawingArea <- function(widget,...) { obj <- new("gGraphicsRGtk",block=widget, widget=widget, toolkit=guiToolkit("RGtk2")) return(obj) } as.gGd = function(obj) { if(inherits(obj,"GtkDrawingArea")) { newobj = list(ref = obj, device = obj$GetData("device")) class(newobj) <- c("gGd", "gComponent") return(newobj) } else { cat(gettext("conversion failed\n")) return(obj) } } ### methods ## adding to a group is funny, we intercept here setMethod(".add", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gGroupRGtk", value="gGraphicsRGtk"), function(obj, toolkit, value, ...) { getWidget(obj)$PackStart(value@block, TRUE, TRUE, 0) # expand to fill if TRUE }) ## raise this device setReplaceMethod(".visible", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gGraphicsRGtk"), function(obj, toolkit, ..., value) { if(is.logical(value) == TRUE) { da <- obj@widget devnum <- da$GetData(".devnum") if(!is.null(devnum)) dev.set(devnum) } return(obj) }) ## save Current Page ## This uses GTK -- not R to save. ## need to have window fully shown setReplaceMethod(".svalue", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gGraphicsRGtk"), function(obj, toolkit, index=NULL, ..., value) { if(length(value) > 1) { file = value$file extension = value$extension } else { file = value; extension <- strsplit(file, ".", fixed = TRUE)[[1L]] if(n <- length(extension)) { extension <- extension[n] } else { cat(gettext("No file extension given")) return() } } ## check that filename is okay if(!is.null(file) && !is.null(extension)) { tmp = unlist(strsplit(file,"\\.")) if(tmp[length(tmp)] != extension) { filename = Paste(file,".",extension) } else { filename = file } } else { return() } da <- getWidget(obj) wh <- daGetWidthHeight(da) da.w <- wh[1] da.h <- wh[2] pixbuf <- gdkPixbufGetFromDrawable(src=da$window, src.x=0, src.y=0, dest.x=0, dest.y=0, width=da.w, height=da.h) out <- try(pixbuf$Save(filename = filename,type=extension), silent=TRUE) if(inherits(out, "try-error")) { galert(sprintf("Error in saving: %s", out), parent=obj) } ## switch(extension, ## "ps" = dev.copy2eps.hack(file=filename, ## onefile=onefile, horizontal=horizontal, ## width=width, height = height), ## "eps" = dev.print.hack(postscript,file=filename, ## onefile=onefile, horizontal=horizontal, ## width=width, height = height), ## "pdf" = dev.print.hack(pdf,file=filename, ## onefile=onefile, horizontal=horizontal, ## width=width, height = height), ## "jpg" = dev.print.hack(jpeg,file=filename, ## onefile=onefile, horizontal=horizontal, ## width=width, height = height), ## "jpeg" = dev.print.hack(jpeg,file=filename,width=width,height=height), ## "png" = dev.print.hack(png,file=filename,width=width,height=height), ## cat("***\n Don't know this extension:", type,"\n\n") ## ) return(obj) }) ### handlers ## add this expose event for graph setMethod(".addhandlerexpose", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gGraphicsRGtk"), function(obj, toolkit, handler, action=NULL, ...) { addhandler(obj,"expose-event",handler,action,...) }) ## applies a handler to the mouse click. The handler gets extra ## argument h$x, h$y passed into it. These are in [0,1] coordinates setMethod(".addhandlerclicked", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gGraphicsRGtk"), function(obj, toolkit, handler, action=NULL, ...) { ## handler has $obj for obj clicked on, $x, $y, $action f = function(h,w,e,...) { if(!isFirstMouseClick(e)) return(FALSE) ## changes to allocation storage with newer RGtk2 xclick = e$GetX() yclick = e$GetY() da <- getWidget(obj) wh <- daGetWidthHeight(da) width <- wh[1] height <- wh[2] x = xclick/width y = (height - yclick)/height ## put into usr coordinates h$x <- grconvertX(x, from="ndc", to="user") h$y <- grconvertY(y, from="ndc", to="user") handler(h, w, e, ...) return(FALSE) } id = addhandler(obj,signal = "button-press-event",handler=f, action=action) invisible(id) }) ## Changed handler is called after rubber band selection is updated ## ## Just click and drag out a rubber band ## The "h" list has components ## h$x for the x values in user coordinates ## h$y for the y values in user coordinates ## These can be converted as in grconvertX(h$x, from="ndc", to="user") setMethod(".addhandlerchanged", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gGraphicsRGtk"), function(obj, toolkit, handler, action=NULL, ...) { da <- getWidget(obj) ID <- gSignalConnect(da, "button-release-event", function(w, e) { if(!isFirstMouseClick(e)) return(FALSE) coords <- drawableToNDC(w) h <- list(obj=obj, action=action, x=grconvertX(coords$x, from="ndc", to="user"), y=grconvertY(coords$y, from="ndc", to="user")) handler(h, ...) return(FALSE) # propagate }) }) ## Draw a rectangle for rubber banding daDrawRectangle <- function(da, x0, x, y0, y) { x <- c(x0, x); y <- c(y0, y) x0 <- min(x); x <- max(x) y0 <- min(y); y <- max(y) allocation = da$allocation ## GetAllocation() da.w <- allocation$allocation$width da.h <- allocation$allocation$height # da.w <- da$getAllocation()$width # da.h <- da$getAllocation()$height ## background style gcb <- gdkGCNew(da$window) gcb$copy(da["style"]$blackGc) gcb$setRgbFgColor(gdkColorParse("gray50")$color) gcb$setLineAttributes(line.width=1, line.style=GdkLineStyle["solid"], cap.style=GdkCapStyle["butt"], join.style=GdkJoinStyle["miter"]) ## foreground style gc <- gdkGCNew(da$window) gc$copy(da["style"]$blackGc) gc$setRgbFgColor(gdkColorParse("black")$color) gc$setRgbBgColor(gdkColorParse("gray50")$color) gc$setLineAttributes(line.width=1, line.style=GdkLineStyle["double-dash"], cap.style=GdkCapStyle["butt"], join.style=GdkJoinStyle["miter"]) gc$setDashes(c(8, 4)) ## the entire rectangle to clear rect <- as.GdkRectangle(c(x=0, y=0, width=da.w, height=da.h)) da$setData("lastRect", rect) for (i in 1:2) { ## draw in background color first tmp.gc <- if (i == 1) gcb else gc gdkDrawRectangle(da$window, gc=tmp.gc, filled=FALSE, x=x0, y=y0, width=x-x0, height=y-y0) } gdkWindowProcessAllUpdates() while (gtkEventsPending()) gtkMainIterationDo(blocking=FALSE) } ## find width and height from allocation, which surprisingly seems to change from time to time daGetWidthHeight <- function(da) { allocation <- da$getAllocation() ## now, do we have width, height? if("width" %in% names(allocation)) { return(c(width=allocation$width, height=allocation$height)) } else if("allocation" %in% names(allocation)) { return(c(width=allocation$allocation$width, height=allocation$allocation$height)) } else { stop("Can't get width.height allocation?") } } ## clear all rectangles that came from rubber banding daClearRectangle <- function(da) { last <- da$getData("lastRect") if(!is.null(last)) da$window$invalidateRect(last, FALSE) gdkWindowProcessAllUpdates() while (gtkEventsPending()) gtkMainIterationDo(blocking=FALSE) } ## convert rectangle on drawable into NDC coordinates drawableToNDC <- function(da) { ## convert to normalized device coordinates e <- da$getData("env") x.pixel <- sort(c(e$x0, e$x)) y.pixel <- sort(c(e$y0, e$y)) wh <- daGetWidthHeight(da) da.w <- wh[1] da.h <- wh[2] ndc <- list(x=x.pixel/da.w, y= 1- rev(y.pixel/da.h)) return(ndc) } ## copy graphic to clipboard for cut-and-paste ## ## I can't seem to bind this to ctrl-c (or some such), as I can't get key-press-event ## to work on tihs widget. Here as an example: ## http://ruby-gnome2.sourceforge.jp/hiki.cgi?tut-gtk2-agtkw-draww ## da['can-focus'] <- TRUE; da$addEvents(GdkEventMask["key-press-mask"]) were tried ## @param da either the drawable object (from a callback say) or the ggraphics object. copyToClipboard <- function(da) { if(!is(da, "GtkDrawingArea")) da <- getWidget(da) # ggraphics object da.w <- da$getAllocation()$width da.h <- da$getAllocation()$height buf <- gdkPixbufGetFromDrawable(src=da$window, src.x=0, src.y=0, dest.x=0, dest.y=0, width=da.w, height=da.h) gtkClipboardGet("CLIPBOARD")$setImage(buf) } ################################################## ## ## dev.print and dev.copy2eps have a test on the device that needs Cairo added to it devPrintHack = function (device = postscript, ...) { current.device <- dev.cur() nm <- names(current.device)[1] if (nm == "null device") stop("no device to print from") if (!(nm %in% c("Cairo", "X11", "GTK", "gnome", "windows", "quartz"))) stop("can only print from screen device") oc <- match.call() print(oc) oc[[1]] <- as.name("dev.copy") oc$device <- device din <- par("din") w <- din[1] h <- din[2] if (missing(device)) { if (is.null(oc$file)) oc$file <- "" hz0 <- oc$horizontal hz <- if (is.null(hz0)) ps.options()$horizontal else eval.parent(hz0) paper <- oc$paper if (is.null(paper)) paper <- ps.options()$paper if (paper == "default") paper <- getOption("papersize") paper <- tolower(paper) switch(paper, a4 = { wp <- 8.27 hp <- 11.69 }, legal = { wp <- 8.5 hp <- 14 }, executive = { wp <- 7.25 hp <- 10.5 }, { wp <- 8.5 hp <- 11 }) wp <- wp - 0.5 hp <- hp - 0.5 if (!hz && is.null(hz0) && h < wp && wp < w && w < hp) { hz <- TRUE } else if (hz && is.null(hz0) && w < wp && wp < h && h < hp) { hz <- FALSE } else { h0 <- ifelse(hz, wp, hp) if (h > h0) { w <- w * h0/h h <- h0 } w0 <- ifelse(hz, hp, wp) if (w > w0) { h <- h * w0/w w <- w0 } } if (is.null(oc$pointsize)) { pt <- ps.options()$pointsize oc$pointsize <- pt * w/din[1] } if (is.null(hz0)) oc$horizontal <- hz if (is.null(oc$width)) oc$width <- w if (is.null(oc$height)) oc$height <- h } else { devname <- deparse(substitute(device)) if (devname %in% c("png", "jpeg", "bmp") && is.null(oc$width) && is.null(oc$height)) warning("need to specify one of 'width' and 'height'") if (is.null(oc$width)) oc$width <- if (!is.null(oc$height)) w/h * eval.parent(oc$height) else w if (is.null(oc$height)) oc$height <- if (!is.null(oc$width)) h/w * eval.parent(oc$width) else h } dev.off(eval.parent(oc)) dev.set(current.device) } dev.copy2eps.hack = function (...) { current.device <- dev.cur() nm <- names(current.device)[1] if (nm == "null device") stop("no device to print from") if (!(nm %in% c("Cairo","X11", "GTK", "gnome", "windows", "quartz"))) stop("can only print from screen device") oc <- match.call() oc[[1]] <- as.name("dev.copy") oc$device <- postscript oc$onefile <- FALSE oc$horizontal <- FALSE if (is.null(oc$paper)) oc$paper <- "special" din <- par("din") w <- din[1] h <- din[2] if (is.null(oc$width)) oc$width <- if (!is.null(oc$height)) w/h * eval.parent(oc$height) else w if (is.null(oc$height)) oc$height <- if (!is.null(oc$width)) h/w * eval.parent(oc$width) else h if (is.null(oc$file)) oc$file <- "Rplot.eps" dev.off(eval.parent(oc)) dev.set(current.device) } gWidgetsRGtk2/R/gpanedgroup.R0000644000175100001440000000711411465667431015576 0ustar hornikuserssetClass("gPanedgroupRGtk", contains="gContainerRGtk", prototype=prototype(new("gContainerRGtk")) ) ## TODO: method obj[1 or 2 ] <- replacewidget setMethod(".gpanedgroup", signature(toolkit="guiWidgetsToolkitRGtk2"), function(toolkit, widget1, widget2, horizontal=TRUE, container=NULL, ...) { ## add a paned group force(toolkit) if(horizontal) { panedWindow = gtkHPanedNew() } else { panedWindow = gtkVPanedNew() } obj <- as.gWidgetsRGtk2(panedWindow) if(!missing(widget1) && !is.null(widget1)) add(obj, widget1) if(!missing(widget2) && !is.null(widget2)) add(obj, widget2) if (!is.null(container)) { if(is.logical(container) && container == TRUE) container = gwindow(visible=TRUE) add(container, obj, ...) } return(obj) }) as.gWidgetsRGtk2.GtkHPaned <- as.gWidgetsRGtk2.GtkVPaned <- function(widget,...) { obj = new("gPanedgroupRGtk", block=widget, widget=widget, toolkit=guiToolkit("RGtk2")) if(is.null(tag(obj,"leftgroup"))) { ## left or right *or* top or bottom leftgroup = ggroup() rightgroup = ggroup() ## already a child? if(!is.null(child <- widget$GetChild1())) add(leftgroup,child,expand=TRUE, fill="both") if(!is.null(child <- widget$GetChild2())) add(rightgroup,child,expand=TRUE, fill="both") widget$Pack1(leftgroup@widget@block)#, resize=FALSE, shrink=FALSE) widget$Pack2(rightgroup@widget@block)#, resize=FALSE, shrink=FALSE) tag(obj,"leftgroup") <- leftgroup tag(obj,"rightgroup") <- rightgroup } return(obj) } ## add -- use this rather than at construction time setMethod(".add", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gPanedgroupRGtk", value="gWidgetRGtk"), function(obj, toolkit, value, ...) { ctr = tag(obj,"ctr") if(is.null(ctr)) ctr = 0 if(ctr == 0) { add(tag(obj,"leftgroup"), value, expand=TRUE, fill="both") ctr = 1 } else if(ctr ==1) { add(tag(obj,"rightgroup"), value, expand=TRUE, fill="both") ctr = 2 } else { gwCat(gettext("Can only add two widgets to a gpanedgroup\n")) } tag(obj,"ctr") <- ctr }) ### methods setMethod(".svalue", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gPanedgroupRGtk"), function(obj, toolkit, index=NULL, drop=NULL, ...) { panedWindow <- obj@widget min <- panedWindow['min-position'] max <- panedWindow['max-position'] position <- panedWindow['position'] return((position - min)/(max - min)) }) ## svalue sets position setReplaceMethod(".svalue", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gPanedgroupRGtk"), function(obj, toolkit, index=NULL, ..., value) { if(0 <= value && value <= 1) { panedWindow <- obj@widget min <- panedWindow['min-position'] max <- panedWindow['max-position'] placement <- min + value * (max - min) panedWindow['position'] <- placement } return(obj) }) gWidgetsRGtk2/R/gexpandgroup.R0000644000175100001440000001265012236052367015760 0ustar hornikusers## expander group, like a group, only expands, contracts if requested ## inherits from ggroup, see ggroup's arguments: horizontal, spacing, container setClass("gExpandgroupRGtk", contains="gGroupRGtk", prototype=prototype(new("gGroupRGtk")) ) setMethod(".gexpandgroup", signature(toolkit="guiWidgetsToolkitRGtk2"), function(toolkit, text="", markup=FALSE, horizontal=TRUE, handler=NULL, action=NULL, container = NULL, ...){ force(toolkit) expander = gtkExpanderNew() if(markup) expander$SetUseMarkup(TRUE) if(text != "") expander$SetLabel(text) obj <- as.gWidgetsRGtk2(expander, horizontal=horizontal) theArgs = list(...) if(!is.null(container)) { if(is.logical(container) && container == TRUE) container = gwindow(visible=TRUE) if(!is.null(theArgs$expand) && theArgs$expand) add(container,obj,expand=TRUE) else add(container,obj) } if(!is.null(handler)) tag(obj, "handler.id") <- addhandlerchanged(obj, handler, action) invisible(obj) }) as.gWidgetsRGtk2.GtkExpander <- function(widget,...) { ## coverting from gWidget? if(!is.null(tag(widget,"group"))) { group <- tag(widget,"group") } else { theArgs <- list(...) horizontal <- if(is.null(theArgs$horizontal)) TRUE else theArgs$horizontal spacing <- if(is.null(theArgs$spacing)) 5 else theArgs$spacing group = ggroup(horizontal=horizontal, spacing=spacing) widget$Add(getBlock(group)) # down from guiWidget to gWidgetRGtk } ## we put widget=group here to get gGroup methods, but ## must be careful below to use "block" when referring to expander obj = new("gExpandgroupRGtk",block=widget,widget=getWidget(group), toolkit=guiToolkit("RGtk2")) tag(obj,"group") <- group return(obj) } ## methods ## value refers to border width ## but it used to refer to the label, we keep this here but suggest ## names be used instead setMethod(".svalue", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gExpandgroupRGtk"), function(obj, toolkit, index=NULL, drop=NULL, ...) { gwCat("Use names() to access label") obj@block$GetLabel() # not @widget@ }) ## if numeric -- set padding to match ggroup ## else set as a label setReplaceMethod(".svalue", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gExpandgroupRGtk", value = "numeric"), function(obj, toolkit, index=NULL, ..., value) { ## set as padding getWidget(obj)$SetBorderWidth(value) return(obj) }) ## set label, but deprecated setReplaceMethod(".svalue", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gExpandgroupRGtk"), function(obj, toolkit, index=NULL, ..., value) { .Deprecated("names<-", msg = "Use the names<- method to the label") obj@block$SetLabel(value) return(obj) }) ## ## names refers to label setMethod(".names", signature(toolkit="guiWidgetsToolkitRGtk2", x="gExpandgroupRGtk"), function(x,toolkit) { x@block$GetLabel() }) setReplaceMethod(".names", signature(toolkit="guiWidgetsToolkitRGtk2",x="gExpandgroupRGtk"), function(x,toolkit,value) { obj@block$SetLabel(value) return(x) }) ## Is widget expanded? setMethod(".visible", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gExpandgroupRGtk"), function(obj, toolkit, ...) { obj@block$getExpanded() }) ## control expand/close with logical setReplaceMethod(".visible", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gExpandgroupRGtk"), function(obj, toolkit, ..., value) { obj@block$SetExpanded(as.logical(value)) return(obj) }) ## names refers to label setMethod(".names", signature(toolkit="guiWidgetsToolkitRGtk2",x="gExpandgroupRGtk"), function(x, toolkit) { x@block$GetLabel() # not @widget@ }) setReplaceMethod(".names", signature(toolkit="guiWidgetsToolkitRGtk2",x="gExpandgroupRGtk"), function(x, toolkit, value) { x@block$SetLabel(value) return(x) }) ## set font setReplaceMethod(".font", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gExpandgroupRGtk"), function(obj, toolkit, value) { label <- obj@block[[2]] label <- gWidgetsRGtk2:::as.gWidgetsRGtk2(label) font(label) <- value return(obj) }) ## handlers ## putonto expander in @block setMethod(".addhandlerchanged", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gExpandgroupRGtk"), function(obj, toolkit, handler, action=NULL, ...) { addhandler(obj@block, "activate",handler, action,...) }) gWidgetsRGtk2/R/gnotebook.R0000644000175100001440000003770511554447333015257 0ustar hornikusers## class previously defined setMethod(".gnotebook", signature(toolkit="guiWidgetsToolkitRGtk2"), function(toolkit, tab.pos = 3, # same as pos= in text closebuttons = FALSE, dontCloseThese = NULL, # integer of tabs not to close container=NULL, # add to this container ...) { force(toolkit) ## beginvv notebook = gtkNotebookNew() notebook$SetScrollable(TRUE) ## tab placement: 1,2,3,4 -> 3,0,2,1 types = c("bottom","left","top","right") tabposition = GtkPositionType[types] notebook$SetTabPos(tabposition[tab.pos]) ## add close button, in same level as tab.pos if(tab.pos == 1 || tab.pos == 3) group = ggroup(container=container, ...) else group = ggroup(horizontal=FALSE,container=container, ...) add(group,notebook,expand=TRUE) ## create gnotebook object obj = new("gNotebookRGtk", block=group, widget=notebook, toolkit=toolkit) tag(obj,"closebuttons") <- closebuttons tag(obj,"dontCloseThese") <- dontCloseThese invisible(obj) }) as.gWidgetsRGtk2.GtkNotebook <- function(widget,...) { ## no group here obj <- new("gNotebookRGtk", block=widget, widget=widget, toolkit=guiToolkit("RGtk2")) tag(obj,"closebuttons") <- FALSE tag(obj,"dontCloseThese") <- FALSE return(obj) } ### methods ## different, set notebook, not group setReplaceMethod(".size", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gNotebookRGtk"), function(obj, toolkit, ..., value) { width = value[1]; height = value[2] obj@widget$SetSizeRequest(width,height) return(obj) }) ## ## close buttons? Call this by default ## defaultCloseButtonHandler = function(h,...) { ## notebook = h$action@notebook # gtk notebook, not gnotebook ## currentPage = notebook$GetCurrentPage() ## notebook$RemovePage(currentPage) ## svalue(h$action) <- currentPage ## } ## return the current tab setMethod(".svalue", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gNotebookRGtk"), function(obj, toolkit, index=NULL, drop=NULL, ...) { if(!is.null(index)) { warning("No index argument for a gnotebook instance") } notebook = obj@widget return(notebook$GetCurrentPage() + 1) }) ## set the current tab to value setReplaceMethod(".svalue", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gNotebookRGtk"), function(obj, toolkit, index=NULL, ..., value) { notebook = obj@widget nPages = notebook$GetNPages() notebook$SetCurrentPage(min(nPages,as.numeric(value)-1)) return(obj) }) ## ## set label or page values ## ## avlues is list with components page.no, label, and/or page ## ## setting page is not implemented (add, remove?) ## set.values.gNotebook = function(obj,values,...) { ## page.no = values$page.no ## if(is.null(page.no)) ## page.no = svalue(obj) ## if(!is.null(values$label)) { ## labelgroup = ggroup() ## label = values$label ## if(is.character(label)) { ## label = glabel(label) ## } ## add(labelgroup, label) ## ## label should be glabel instance ## ## this code could be consolidated. It is taken from add.gNotebook ## if(obj$closebuttons) { ## add(labelgroup,label) ## closeImage = gimage("gtk-close",dirname="stock", ## handler = function(h,...) { ## curPage = notebook$notebook$GetCurrentPage() ## if(!is.null(notebook$dontCloseThese) && ## !((curPage + 1) %in% notebook$dontCloseThese)) { ## dispose(notebook) ## } ## }) ## add(labelgroup,closeImage, expand=FALSE) ## } ## obj$notebook$SetTabLabel(obj$notebook[[page.no]],labelgroup$ref) ## } ## ## now update page widget ## if(!is.null(values$page)) { ## warning("Setting a page in gNotebook is note implemented. Try adding, disposing") ## } ## } ## remove the current tab ## this should be called delete -- which is used to remove objects setMethod(".dispose", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gNotebookRGtk"), function(obj, toolkit, ...) { theArgs = list(...) to.right=ifelse(!is.null(theArgs$to.right), theArgs$to.right,FALSE) dontCloseThese = tag(obj,"dontCloseThese") cur.page = svalue(obj) if(to.right) { no.pages = length(obj) no.right = no.pages - cur.page if(no.right > 0) { ## clear out, must work from last backwards for(i in no.right:1) { if(!is.null(dontCloseThese) && !((cur.page - 1 + i + 1) %in% dontCloseThese)) { ## destroy widget theWidget = obj@widget$getNthPage(cur.page - 1 + 1) obj@widget$RemovePage(cur.page - 1 +i) # cur.page 1-based gtktry(theWidget$destroy()) svalue(obj) <- cur.page } } } } else { ## just this page if(!is.null(dontCloseThese)) { if(!((cur.page - 1 + 1) %in% dontCloseThese)) { theWidget = obj@widget$getNthPage(cur.page - 1) obj@widget$RemovePage(cur.page - 1) # value is 1 based, not 0 gtktry(theWidget$destroy()) svalue(obj) <- cur.page } } else { ## no restriction of closing page theWidget = obj@widget$getNthPage(cur.page - 1) obj@widget$RemovePage(cur.page - 1) # value is 1 based, not 0 gtktry(theWidget$destroy()) svalue(obj) <-cur.page } } }) ## remove the widget form the notebook setMethod(".delete", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gNotebookRGtk"), function(obj, toolkit, widget, ...) { obj@widget$remove(getWidget(widget)) }) ### add() is a workhorse method here. Several args available in ... #add.gNotebook = functionf(obj, value, # label="", markup = FALSE, # index = NULL, override.closebutton = FALSE, ...) { setMethod(".add", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gNotebookRGtk", value="guiWidget"), function(obj, toolkit, value, ...) { .add(obj, toolkit, value@widget, ...) }) setMethod(".add", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gNotebookRGtk", value="gWidgetRGtk"), function(obj, toolkit, value, ...) { ## in ... we have many possibilies ## label -- for setting label (also look for name) ## index for setting the index of page to add ## markup -- markup label ## override.closebutton -- to not put closebutton even if set in constructor ## process ... theArgs = list(...) # for making generic if(!is.null(theArgs$label)) { label = theArgs$label } else if(!is.null(theArgs$name)) { label = theArgs$name } else { label = id(obj) if(is.null(label)) label = "unnamed" } index = if (is.null(theArgs$index)) NULL else theArgs$index if(!is.null(theArgs$pageno)) index = theArgs$pageno # also called paegno markup = if (is.null(theArgs$markup)) FALSE else theArgs$markup override.closebutton = if (is.null(theArgs$override.closebutton)) FALSE else as.logical(theArgs$override.closebutton) ## let's go gtknotebook = obj@widget ## label labelgroup = ggroup() if(is.character(label)) label = glabel(label, markup = markup) add(labelgroup,label) ## closebutton if(!is.null(tag(obj,"closebuttons")) && as.logical(tag(obj,"closebuttons")) && !override.closebutton) { closeImage = gimage("gtk-close",dirname="stock", handler = function(h,...) { dispose(obj) return(TRUE) # cat("DEBUG: all done\n") # curPage = gtknotebook$GetCurrentPage() # if(is.null(tag(obj,"dontCloseThese")) || # dont close if in dontCloseThes # (!is.null(tag(obj,"dontCloseThese")) && # !((curPage + 1) %in% tag(obj,"dontCloseThese")) # )) { # gtknotebook$RemovePage(gtknotebook$GetCurrentPage()) # svalue(obj) <- curPage+1 # } }) add(labelgroup,closeImage, expand=FALSE) } ## store widget into label for dnd tag(labelgroup,"widget") <- value group =ggroup() add(group, value, expand=TRUE) # get to expand ## what to add gtkpage = getWidget(group) labelWidget = getBlock(labelgroup) ## where to add if(is.null(index) | !is.numeric(index)) { thePage = gtknotebook$AppendPage(gtkpage, labelWidget) } else if(index < 0) { thePage = gtknotebook$PrependPage(gtkpage, labelWidget) } else { thePage = gtknotebook$InsertPage(gtkpage, labelWidget, position=(index - 1)) } ## Add DND actions for labels theLabel = gtknotebook$GetTabLabel(gtknotebook$GetNthPage(thePage)) adddropsource(theLabel, targetType = "object", handler = function(h,...) { ## dump the widget attached to label }, action = value ) ## add drop motion for labels adddroptarget(theLabel) adddropmotion(theLabel,handler = function(h,...) gtknotebook$SetCurrentPage(thePage)) ## uncomment below, and comment above, to change drop motion ## add drop motion to label if no close button ## if(!obj$closebuttons || override.closebutton) { ## theLabel = obj$notebook$GetTabLabel(obj$notebook$GetNthPage(thePage)) ## adddroptarget(theLabel) ## adddropmotion(theLabel,handler = function(h,...) obj$notebook$SetCurrentPage(thePage)) ## } ## move to newpage svalue(obj) <- thePage + 1 }) ## Regular R methods treat gnotebook like a vector ## find out number of pages setMethod(".length", signature(toolkit="guiWidgetsToolkitRGtk2",x="gNotebookRGtk"), function(x, toolkit) { x@widget$GetNPages() }) ## return tabnames setMethod(".names",signature(toolkit="guiWidgetsToolkitRGtk2",x="gNotebookRGtk"), function(x, toolkit) { notebook = x@widget NPages = notebook$GetNPages() if(NPages == 0) { return(c()) } else { theNames = sapply(1:NPages, function(i) { notebook$GetTabLabel(notebook$GetNthPage(i-1))[[1]][[1]]$GetText() }) return(theNames) } }) ## can assigne with names(x) <-x or even names(x)[i] <- "single name" setReplaceMethod(".names", signature(toolkit="guiWidgetsToolkitRGtk2",x = "gNotebookRGtk"), function(x,toolkit, value) { n = length(x) if(length(value) != n) stop("New names for notebook must have proper length") notebook = x@widget NPages = notebook$GetNPages() if(NPages == 0) { return(c()) } else { for(i in 1:NPages) notebook$GetTabLabel(notebook$GetNthPage(i-1))[[1]][[1]]$SetText(value[i]) } invisible(x) }) ## return widget contained in notebook page i as a list or single widget setMethod("[", signature(x="gNotebookRGtk"), function(x, i, j, ..., drop=TRUE) { .leftBracket(x, x@toolkit, i, j, ..., drop=drop) }) setMethod(".leftBracket", signature(toolkit="guiWidgetsToolkitRGtk2",x="gNotebookRGtk"), function(x, toolkit, i, j, ..., drop=TRUE) { if(missing(i)) i = seq_along(x) i <- i[i <= length(x)] i <- i[i > 0] if(length(i) == 0) { warning("No widget for that index") return(NULL) } if(length(i) > 1) { lst = lapply(i,function(j) getNotebookPageWidget(x,pageno = j-1) ) return(lst) } else { return(getNotebookPageWidget(x, pageno = i-1)) } }) ## Puts widget into a position setReplaceMethod("[", signature(x="gNotebookRGtk"), function(x, i, j,..., value) { .leftBracket(x, x@toolkit, i, j, ...) <- value return(x) }) setReplaceMethod(".leftBracket", signature(toolkit="guiWidgetsToolkitRGtk2",x="gNotebookRGtk"), function(x, toolkit, i, j, ..., value) { n = length(x) if(missing(i)) { add(x,value) # append! } else { if(length(i) == 1) { add(x, value, index = i) } else { warning("Can't use '[' method for more than 1 element") } } }) ### handlers setMethod(".addhandlerchanged", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gNotebookRGtk"), function(obj, toolkit, handler, action=NULL, ...) { ## put page number into h$pageno widget <- getWidget(obj) ID <- gSignalConnect(widget,signal = "switch-page", f = function(d,widget,page, pageno,...) { h <- list(obj=d$obj,action=d$action, pageno=pageno+1) if(!is.null(d$handler) && is.function(d$handler)) d$handler(h,...) return(FALSE) # propogate }, user.data.first = TRUE, data = list(obj=obj,handler=handler, action=action) ) invisible(ID) # addhandler(obj,"switch-page",handler,action) }) setMethod(".addhandlerexpose", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gNotebookRGtk"), function(obj, toolkit, handler, action=NULL, ...) { addhandlerchanged(obj,handler, action,...) }) ### helpers ## used in [. method getNotebookPageWidget = function(obj, pageno =obj@widget$GetCurrentPage() + 1) { theLabel = obj@widget$GetTabLabel(obj@widget$GetNthPage(pageno)) widget = tag(theLabel,"widget") return(widget) } gWidgetsRGtk2/R/common.R0000644000175100001440000002432111423074223014533 0ustar hornikusers## Common functions #Paste = function(x,...) paste(x,...,sep="",collapse="") Paste = function(..., sep="", collapse="") { x = unlist(list(...)) x = x[!is.na(x)] x = x[x != "NA"] paste(x, sep=sep, collapse=collapse) } PasteWithComma = function(...) { args = unlist(list(...)) args = args[!is.na(args)] paste(args, sep="", collapse=", ") } stripWhiteSpace = function(str) { sub('[[:space:]]+$', '', str) ## from ?gsub sub('^[[:space:]]+', '', str) ## from ?gsub return(str) } toupperFirst <- function(str="") { if(nchar(str) == 0) return(str) out <- toupper(substr(str, 0, 1)) if(nchar(str) > 1) { out <- paste(out, substr(str,2, nchar(str)), sep="") } return(out) } quoteIfNeeded = function(str) { if(length(grep('^\\".*\\"$', str, perl=TRUE)) > 0 || length(grep("^\\'.*\\'$", str, perl=TRUE)) > 0 ) return(str) else return(paste('"',str,'"',sep="",collapse="")) } showErrorMessage = function() { # leave here for scoping on command message = Paste("Error:", "\n\t",geterrmessage()) gmessage(message,icon="error") stop() } ## Push and Pop -- for convenience Push = function(v,d) c(v,d) Pop = function(v) ifelse(length(v) > 1, v[-length(v)], NA) ### is functions is.RGtkObject = function(obj) { is(obj,"RGtkObject") } is.guiWidget = function(obj) { is(obj,"guiWidget") } is.gWidget = function(obj) { is(obj,"gWidgetRGtk") } is.gWindow = function(obj) { is(obj,"gWindowRGtk") } is.gComponent = function(obj) { is(obj,"gComponentRGtk") } is.gContainer = function(obj) { is(obj,"gContainer") } is.gImage = function(obj) { is(obj,"gImageRGtk") } is.gLabel = function(obj) { is(obj,"gLabelRGtk") } is.gMenu = function(obj) { is(obj,"gMenuRGtk") } is.gEditDataFrame=function(obj) { stop("deprecated, use is.gGrid") } is.gGrid = function(obj) { is(obj,"gGridRGtk") } is.invalid = function(obj) { widget = getWidget(obj) parent = widget$GetParentWindow() ifelse(inherits(parent,""), TRUE, FALSE) } ## used to check output is.empty = function(obj) { if(is.null(obj) || is.na(obj) || obj == "") { return(TRUE) } else { return(FALSE) } } ## for showing only possible values is.dataframelike = function(obj) { if(is.data.frame(obj) || is.matrix(obj) || is.numeric(obj) || is.logical(obj) || is.factor(obj)) { return(TRUE) } else { return(FALSE) } } ## check if a gtkTreeViewCOlumn, make no GTK language is.gdataframecolumn = function(obj) { if(class(obj)[1] == "GtkTreeViewColumn") return(TRUE) else return(FALSE) } ## Function to convert back and forth between R classes and GObject classes ### these are used by gvarbrowser ## This is from browseEnv in base ## what type of object is thixs and a size str1 <- function(obj) { md <- mode(obj) lg <- length(obj) objdim <- dim(obj) if (length(objdim) == 0) dim.field <- paste("length:", lg) else { dim.field <- "dim:" for (i in 1:length(objdim)) dim.field <- paste(dim.field, objdim[i]) if (is.matrix(obj)) md <- "matrix" } obj.class <- oldClass(obj) if (!is.null(obj.class)) { md <- obj.class[1] if (inherits(obj, "factor")) dim.field <- paste("levels:", length(levels(obj))) } list( type = md, dim.field = dim.field) } ## what type of object is thixs and a size str2 <- function(obj) { md <- mode(obj) if (is.matrix(obj)) md <- "matrix" obj.class <- oldClass(obj) if (!is.null(obj.class)) { md <- obj.class[1] } return(md) } ## untaint a variable name so that $ can be used untaintName = function(objName) { if (length(grep(" |\\+|\\-|\\*|\\/\\(|\\[|\\:",objName)) > 0) { objName=Paste("\"",objName,"\"") } return(objName) } ## try to stip off data frame stuff in fron to DND target findDataParent = function(x) { child = sub(".*]]","",x) child = sub(".*\\$","",child) parent = sub(Paste(child,"$"),"",x) parent = sub("\\$$","",parent) return(list(child=child,parent=parent)) } ## basically repeat findDataParent until no parent findRootObject = function(x) { x = sub("\\[\\[.*","",x) x = sub("\\$.*","", x) return(x) } ## ReadParseEvaL -- saves typing rpel = function(string, envir=.GlobalEnv) { eval(parse(text=string), envir=envir) } ## get does not work with name$component, this gets around that ## returns NULL if not available getObjectFromString = function(string="", envir=.GlobalEnv) { tmp = gtktry(get(string, envir), silent = TRUE) if(!inherits(tmp, "try-error")) return(tmp) tmp = gtktry(rpel(string,envir), silent=TRUE) if(!inherits(tmp, "try-error")) return(tmp) ## out of chances return(NULL) } ## get the names of the object, if available (datastores) getNamesofObject = function(string="") { ## if empty string, get variables in .GlobalEnv if(string == "") { ## return objects of certain type objects = getObjectsWithType(root=NULL, filter=knownTypes[['data sets']]) return(unlist(objects$Name)) } obj = getObjectFromString(string) if(!is.null(obj)) { if(is.list(obj)) { return(names(obj)) } else if(is.matrix(obj)) { return(colnames(obj)) } else{ return(NULL) } } else { return(NULL) } } ## a function to get objects and their types ## filter is a vector of classes getObjectsWithType = function(root=NULL, filter = NULL, envir=.GlobalEnv) { if(is.null(root)) { objects = ls(envir=envir) } else { string = Paste("with(",root,",ls())") objects = gtktry(rpel(string,envir=envir), silent=TRUE) } ## objects is character vector of components of root. badnames = grep("[[<-]|\\*",objects) if(length(badnames) > 0) objects = objects[-badnames] objectsWithRoot = sapply(objects,function(i) makeObjectName(root,i)) type = sapply(objectsWithRoot, function(i) { string = Paste("str2(",i,")") rpel(string, envir=envir) }) objects = data.frame(Name=I(objects),Type=I(type)) ## filter if(!is.null(filter)) objects = objects[type %in% filter,] return(objects) } ## Find the name of the object by pasting toghther the pieces ## better to do name$name, but value may be a numeric makeObjectName = function(root,value) { if(is.null(root)) return(untaintName(value)) ## now decide between $ and [[]] if(value == make.names(value)) { return(Paste(root,"$",untaintName(value))) } else { return(Paste(root,"[['",value,"']]")) } } ###### ## send a file to csv mode for editing "browseDataAsCSV" <- function(x) { x = try(as.data.frame(x)) if(inherits(x,"try-error")) { stop("Can not coerce data into a data frame") } tmpfile = paste(tempfile(),".csv",sep="",collapse="") write.csv(x,file=tmpfile) browseURL(paste("file://",tmpfile,sep="",collapse="")) } ## help out with gtree byReturnVector = function(df, FUN,...) { tmp = by(df, factor(1:nrow(df)), FUN) sapply(tmp, function(x) x) } hack.as.data.frame = function(items) { ## check rectangular, or coerce to rectangules if(!(is.data.frame(items) || is.matrix(items) || is.vector(items))) { warning("Needs rectangular data, either a vector, matrix or data.frame") return(NA) } ## coerce to data frame if(is.vector(items)) { itemsName = deparse(substitute(items)) items = data.frame(I(items)) names(items) = itemsName } if(is.matrix(items)) { items = hack.as.data.frame.matrix(items) # fun in common.R } ## make a data frame (CO2) items <- as.data.frame(items) return(items) } ## no easy way to not convert character vectors. This is a hack. hack.as.data.frame.matrix = function (x, row.names = NULL, optional = FALSE) { d <- dim(x) nrows <- d[1] ir <- seq(length = nrows) ncols <- d[2] ic <- seq(length = ncols) dn <- dimnames(x) if (missing(row.names)) row.names <- dn[[1]] collabs <- dn[[2]] if (any(empty <- nchar(collabs) == 0)) collabs[empty] <- paste("V", ic, sep = "")[empty] value <- vector("list", ncols) if (mode(x) == "character") { for (i in ic) value[[i]] <- as.character(x[, i]) } else { for (i in ic) value[[i]] <- as.vector(x[, i]) } if (length(row.names) != nrows) row.names <- if (optional) character(nrows) else as.character(ir) if (length(collabs) == ncols) names(value) <- collabs else if (!optional) names(value) <- paste("V", ic, sep = "") attr(value, "row.names") <- row.names class(value) <- "data.frame" value } ################################################## ## timestamp function for objects made with pmg ## Modified from R mailing list, value is comment. Need <- to act in ## OO manner comment needs to be a character vector. If a list were ## okay (say serialize()) then this could be different "Timestamp<-" <- function(obj,value) { currentStamp = Timestamp(obj) currentStamp = c(currentStamp, timestamp=as.character(Sys.time()),comment=value) comment(obj) <- currentStamp return(obj) } Timestamp = function(obj,k=1) { currentComment= comment(obj) allStamps =comment(obj)[names(comment(obj)) %in% "timestamp"] n = length(allStamps) if(n > 0) return(allStamps[(max(1,n+1-k)):n]) else return(NA) } ################################################# ## functions to deal with icons ## class to icon translation -- return stock name ## with prefix stockIconFromClass = function(theClass=NULL) { default = "symbol_star" if(is.null(theClass) || is.na(theClass) || length(theClass) == 0 ) return(NA) theClass = theClass[1] if(theClass %in% .models) return(getstockiconname("lines")) if(theClass %in% .ts) return(getstockiconname("ts")) if(theClass %in% .functions) return(getstockiconname("function")) ret = switch(theClass, "numeric"= "numeric", "integer"= "numeric", "logical" = "logical", "character"="select-font", "matrix" = "matrix", "data.frame" = "dataframe", "list" = "dataframe", "complex"="numeric", "factor"="factor", "recordedplot" = "plot", NA) return(getstockiconname(ret)) } stockIconFromObject = function(obj) stockIconFromClass(class(obj)[1]) ## get with default getWithDefault <- function(x, default) { if(is.null(x) || (is.atomic(x) && length(x) ==1 && is.na(x))) default else x } gWidgetsRGtk2/R/gcheckboxgroup.R0000644000175100001440000011033211612332313016250 0ustar hornikusers## Use reference class, like gradio CbgWidgetGtk <- setRefClass("CbgWidgetGtk", contains="GWidgetGtk", fields=list( inner_block="ANY", # replaceble box container items="ANY", # store the items horizontal="logical", # layout direction obj = "ANY" # gradio object for callbacks ), methods=list( initialize=function(items, checked=FALSE, horizontal=TRUE) { horizontal <<- horizontal block <<- gtkHBox() inner_block <<- gtkHBox(); block$packStart(inner_block) if(!missing(items)) { set_items(items) set_index(which(rep(checked, length.out=length(items)))) } .self }, get_items = function() { "Return items" items }, set_items=function(items) { if(length(items) == 0) return() items <<- items block$remove(inner_block) inner_block <<- if(horizontal) gtkHBox() else gtkVBox() block$packStart(inner_block) widget <<- lapply(items, gtkCheckButton) lapply(widget, gtkBoxPackStart, object = inner_block) ## add handlers lapply(widget, gSignalConnect, signal="toggled", f=function(self, w, ...) { self$notify_observers(...) }, data=.self, user.data.first=TRUE) invisible() }, get_index = function() { "Return indices of selected" which(sapply(widget, gtkToggleButtonGetActive)) }, set_index = function(i) { "Set selection indices" ind <- rep(FALSE, length(items)) ind[as.integer(i)] <- TRUE sapply(seq_along(widget), function(j) widget[[j]]$setActive(ind[j])) invisible() } )) setClass("gCheckboxgroupRGtk", contains="gComponentWithRefClassWithItemsRGtk", prototype=prototype(new("gComponentWithRefClassWithItemsRGtk")) ) setMethod(".gcheckboxgroup", signature(toolkit="guiWidgetsToolkitRGtk2"), function(toolkit, items, checked = FALSE, horizontal=FALSE, use.table=FALSE, handler = NULL, action = NULL, container = NULL, ...) { force(toolkit) if(as.logical(use.table)) { obj <- .gcheckboxgrouptable(toolkit, items, checked=checked, handler=handler, action=action, container=container, ...) return(obj) } if(missing(items)) stop(gettext("Need items to be defined")) if(is.data.frame(items)) items <- items[, 1, drop=TRUE] checked = rep(checked, length(items)) ref_widget <- CbgWidgetGtk$new(items, checked, horizontal) obj = new("gCheckboxgroupRGtk", block=ref_widget$block, widget=ref_widget$block, ref_widget=ref_widget, toolkit=toolkit) ## do we add to the container? if (!is.null(container)) { if(is.logical(container) && container == TRUE) container = gwindow(visible=TRUE, toolkit=obj@toolkit) add(container, obj,...) } ## add handler if(!is.null(handler)) ID = addhandlerchanged(obj, handler=handler, action=action, ...) return(obj) }) ### methods setMethod(".svalue", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gCheckboxgroupRGtk"), function(obj, toolkit, index=NULL, drop=NULL, ...) { index <- getWithDefault(index, FALSE) vals <- obj@ref_widget$get_index() if(index) { vals } else { obj[vals] } }) ## toggles state to be T or F setReplaceMethod(".svalue", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gCheckboxgroupRGtk"), function(obj, toolkit, index=NULL, ..., value) { if(is.data.frame(value)) value <- value[,1,drop=TRUE] index <- getWithDefault(index, FALSE) ## compute values -- logical vector with length n if(!index) { if(!is.logical(value)) { ## characters value <- match(value, obj[]) } else { value = rep(value, length.out=length(obj)) ## recycle value <- which(value) } } obj@ref_widget$set_index(value) return(obj) }) ## [ and [<- refer to the names -- not the TF values setMethod("[", signature(x="gCheckboxgroupRGtk"), function(x, i, j, ..., drop=TRUE) { .leftBracket(x, x@toolkit, i, j, ..., drop=drop) }) setMethod(".leftBracket", signature(toolkit="guiWidgetsToolkitRGtk2",x="gCheckboxgroupRGtk"), function(x, toolkit, i, j, ..., drop=TRUE) { items <- x@ref_widget$get_items() if(missing(i)) return(items) else return(items[i]) }) ## assigns names setReplaceMethod("[", signature(x="gCheckboxgroupRGtk"), function(x, i, j,..., value) { .leftBracket(x, x@toolkit, i, j, ...) <- value return(x) }) setReplaceMethod(".leftBracket", signature(toolkit="guiWidgetsToolkitRGtk2",x="gCheckboxgroupRGtk"), function(x, toolkit, i, j, ..., value) { items = x[] if(!missing(i)) items[i] <- value else items <- value x@ref_widget$set_items(items) return(x) }) ## length setMethod(".length", signature(toolkit="guiWidgetsToolkitRGtk2",x="gCheckboxgroupRGtk"), function(x, toolkit) { length(x[]) }) ## handlers setMethod(".addhandlerclicked", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gCheckboxgroupRGtk"), function(obj, toolkit, handler, action=NULL, ...) { o <- Observer$new(o=handler, obj=obj, action=action) obj@ref_widget$add_observer(o) o }) setMethod(".addhandlerchanged", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gCheckboxgroupRGtk"), function(obj, toolkit, handler, action=NULL, ...) { .addhandlerclicked(obj, toolkit, handler, action, ...) }) ################################################## ################################################## ### Checkbox group in a table setClass("gCheckboxgroupTableRGtk", contains="gComponentRGtk", prototype=prototype(new("gComponentRGtk")) ) setGeneric(".gcheckboxgrouptable", function(toolkit, items, checked=FALSE, handler=NULL, action=NULL, container=NULL, ...) standardGeneric(".gcheckboxgrouptable")) setMethod(".gcheckboxgrouptable", signature(toolkit="guiWidgetsToolkitRGtk2"), function(toolkit, items, checked = FALSE, handler = NULL, action = NULL, container = NULL, ...) { force(toolkit) tbl <- gtkTreeViewNew(TRUE) tbl$SetRulesHint(TRUE) # shade store <- rGtkDataFrame(.makeItems()) tbl$setModel(store) tbl$setHeadersVisible(FALSE) sw <- gtkScrolledWindowNew() sw$SetPolicy("GTK_POLICY_AUTOMATIC","GTK_POLICY_AUTOMATIC") sw$Add(tbl) ## set up the view columns vc <- gtkTreeViewColumnNew() tbl$insertColumn(vc, 0) cr <- gtkCellRendererToggle() vc$PackStart(cr, TRUE) cr['activatable'] <- TRUE # needed vc$addAttribute(cr, "active", 1) item.toggled <- function(tbl, cell, path, data) { store <- tbl$getModel() row <- as.numeric(path) + 1 store[row,2] <- !store[row, 2] } gSignalConnect(cr, "toggled", item.toggled, data=tbl, user.data.first=TRUE) cr <- gtkCellRendererTextNew() vc <- gtkTreeViewColumnNew() vc$PackStart(cr, TRUE) vc$addAttribute(cr, "text", 0) tbl$insertColumn(vc, 1) ## how to add icons, tooltips! ## make combination widget with all the values obj = new("gCheckboxgroupTableRGtk", block=sw, widget=tbl, toolkit=toolkit) obj[] <- items svalue(obj) <- checked if(!is.null(handler)) tag(obj, "handler.id") <- addhandlerchanged(obj,handler,action) if(!is.null(container)) { if(is.logical(container)) { if(container) { container <- gwindow() } else { return(obj) } } add(container, obj, ...) } return(obj) }) ## helper .makeItems <- function(items, icons, tooltips, checked=rep(FALSE, length(items))) { if(missing(items) || (is.data.frame(items) && nrow(items) == 0) || (length(items) == 0) ) { out <- data.frame(items=character(0), checked=logical(0), icons=character(0), tooltips=character(0), stringsAsFactors=FALSE) } else if(is.data.frame(items)) { ## check out <- items if(ncol(out) == 1) out$checked <- as.logical(rep(checked, length=nrow(items))) if(ncol(out) == 2) out$icons <- rep("", nrow(items)) if(ncol(out) == 3) out$tooltip <- rep("", nrow(items)) } else { ## piece together items <- as.character(items) if(missing(icons)) icons <- "" icons <- rep(icons, length=length(items)) if(missing(tooltips)) tooltips <- "" icons <- rep(tooltips, length=length(items)) checked <- rep(checked, length=length(items)) out <- data.frame(items=items, checked=checked, icons=icons, tooltips=tooltips, stringsAsFactors=FALSE) } return(out) } ### methods setMethod(".svalue", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gCheckboxgroupTableRGtk"), function(obj, toolkit, index=NULL, drop=NULL, ...) { n <- length(obj) if(n == 0) return(logical(0)) tbl <- getWidget(obj) store <- tbl$getModel() vals <- store[,2, drop=TRUE] index <- getWithDefault(index, FALSE) if(index) { return(which(vals)) # return indices } else { obj[vals] # vals is logical } }) ## toggles state to be T or F setReplaceMethod(".svalue", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gCheckboxgroupTableRGtk"), function(obj, toolkit, index=NULL, ..., value) { n <- length(obj) if(n == 0) return(obj) tbl <- getWidget(obj) store <- tbl$getModel() index <- getWithDefault(index, FALSE) if(!index) { if(is.logical(value)) { value <- rep(value, length.out=n) value <- which(value) } else { value <- match(value, obj[]) } } ## value is index, we want logical ind <- rep(FALSE, n) ind[value] <- TRUE store[,2] <- ind return(obj) }) ## [ and [<- refer to the names -- not the TF values ## Here we can have a vector of names -- or a data frame ## 1st column names, 2nd icon, third tooltip -- like gcombobox setMethod("[", signature(x="gCheckboxgroupTableRGtk"), function(x, i, j, ..., drop=TRUE) { .leftBracket(x, x@toolkit, i, j, ..., drop=drop) }) setMethod(".leftBracket", signature(toolkit="guiWidgetsToolkitRGtk2",x="gCheckboxgroupTableRGtk"), function(x, toolkit, i, j, ..., drop=TRUE) { if(length(x) == 0) return(character(0)) tbl <- getWidget(x) store <- tbl$getModel() items <- store[,1, drop=TRUE] if(missing(i)) return(items) else return(items[i]) }) ## assigns names setReplaceMethod("[", signature(x="gCheckboxgroupTableRGtk"), function(x, i, j,..., value) { .leftBracket(x, x@toolkit, i, j, ...) <- value return(x) }) setReplaceMethod(".leftBracket", signature(toolkit="guiWidgetsToolkitRGtk2",x="gCheckboxgroupTableRGtk"), function(x, toolkit, i, j, ..., value) { ## value can be a vector or data frame ## if a data.frame we have ## text, stockicon, tooltip items <- .makeItems(value) tbl <- getWidget(x) store <- tbl$getModel() if(missing(i)) { ## replace the store newStore <- rGtkDataFrame(items) tbl$setModel(newStore) } else { if(is.logical(i)) i = which(i) ## set items m <- nrow(items) if(m == 0) return(x) store[i,] <- items } return(x) }) setMethod(".length", signature(toolkit="guiWidgetsToolkitRGtk2",x="gCheckboxgroupTableRGtk"), function(x,toolkit) { tbl <- getWidget(x) store <- tbl$getModel() dim(store)[1] }) ## Handlers must just pass down to each item in the list. setMethod(".addhandlerchanged", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gCheckboxgroupTableRGtk"), function(obj, toolkit, handler, action=NULL, ...) { .addhandlerclicked(obj, toolkit, handler=handler,action=action,...) }) ## clicked is changed setMethod(".addhandlerclicked", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gCheckboxgroupTableRGtk"), function(obj, toolkit, handler, action=NULL, ...) { ## push down to cr tbl <- getWidget(obj) vc <- tbl$getColumn(0) cr <- vc$getCellRenderers()[[1]] ID <- gSignalConnect(cr, "toggled", function(h,...) handler(h), user.data.first=TRUE, data=list(obj=obj, action=action)) invisible(ID) }) setMethod(".removehandler", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gCheckboxgroupTableRGtk"), function(obj, toolkit, ID=NULL, ...) { tbl <- getWidget(obj) vc <- tbl$getColumn(0) cr <- vc$getCellRenderers()[[1]] gSignalHandlerDisconnect(cr, ID) }) setMethod(".blockhandler", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gCheckboxgroupTableRGtk"), function(obj, toolkit, ID=NULL, ...) { tbl <- getWidget(obj) vc <- tbl$getColumn(0) cr <- vc$getCellRenderers()[[1]] gSignalHandlerBlock(cr, ID) }) setMethod(".unblockhandler", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gCheckboxgroupTableRGtk"), function(obj, toolkit, ID=NULL, ...) { tbl <- getWidget(obj) vc <- tbl$getColumn(0) cr <- vc$getCellRenderers()[[1]] gSignalHandlerUnblock(cr, ID) }) ################################################## ## build widget based on gcheckbox ## setMethod(".gcheckboxgroup", ## signature(toolkit="guiWidgetsToolkitRGtk2"), ## function(toolkit, ## items, checked = FALSE, ## horizontal=FALSE, use.table=FALSE, ## handler = NULL, action = NULL, container = NULL, ...) { ## force(toolkit) ## if(as.logical(use.table)) { ## obj <- .gcheckboxgrouptable(toolkit, ## items, checked=checked, ## handler=handler, action=action, ## container=container, ...) ## return(obj) ## } ## if(missing(items)) ## stop(gettext("Need items to be defined")) ## if(is.data.frame(items)) ## items <- items[, 1, drop=TRUE] ## checked = rep(checked, length(items)) ## group = ggroup(horizontal = horizontal, container=container, ...) ## lst = list() ## n = length(items) ## for(i in 1:n) { ## newItem = gcheckbox(items[i], checked=checked[i]) ## lst[[ as.character(items[i]) ]] = newItem ## add(group, newItem) ## } ## ## make combination widget with all the values ## obj = new("gCheckboxgroupRGtk",block=group, widget=group, toolkit=toolkit) ## tag(obj, "items") <- items ## tag(obj, "itemlist") <- lst ## tag(obj, "handlerList") <- list() ## tag(obj, "handlerCount") <- 0 ## ## add handler ## if(!is.null(handler)) ## ID = addhandlerchanged(obj, handler=handler, action=action, ...) ## return(obj) ## }) ## ### methods ## setMethod(".svalue", ## signature(toolkit="guiWidgetsToolkitRGtk2",obj="gCheckboxgroupRGtk"), ## function(obj, toolkit, index=NULL, drop=NULL, ...) { ## theArgs = list(...) ## lst = tag(obj, "itemlist") ## vals = sapply(lst, svalue) # logicals ## if(!is.null(index) && index == TRUE) { ## return(which(vals)) ## } else { ## return(tag(obj,"items")[vals]) ## } ## }) ## ## toggles state to be T or F ## setReplaceMethod(".svalue", ## signature(toolkit="guiWidgetsToolkitRGtk2",obj="gCheckboxgroupRGtk"), ## function(obj, toolkit, index=NULL, ..., value) { ## if(is.data.frame(value)) ## value <- value[,1,drop=TRUE] ## lst = tag(obj,"itemlist") ## n <- length(obj) ## ## compute values -- logical vector with length n ## if(!is.null(index) && index) { ## ## indices ## values <- rep(FALSE, n) ## values[value] <- TRUE ## } else if(!is.logical(value)) { ## ## characters ## ind <- match(value, obj[]) ## ind <- ind[!is.na(ind)] ## values <- rep(FALSE,length=n) ## values[ind] <- TRUE ## } else { ## ## logical vector, we recycle ## values = rep(value, length.out=n) ## recycle ## } ## ## apply to each checkbox ## sapply(1:n, function(i) svalue(lst[[i]]) <- values[i]) ## return(obj) ## }) ## ## [ and [<- refer to the names -- not the TF values ## setMethod("[", ## signature(x="gCheckboxgroupRGtk"), ## function(x, i, j, ..., drop=TRUE) { ## .leftBracket(x, x@toolkit, i, j, ..., drop=drop) ## }) ## setMethod(".leftBracket", ## signature(toolkit="guiWidgetsToolkitRGtk2",x="gCheckboxgroupRGtk"), ## function(x, toolkit, i, j, ..., drop=TRUE) { ## items = tag(x,"items") ## if(missing(i)) ## return(items) ## else ## return(items[i]) ## }) ## ## assigns names ## setReplaceMethod("[", ## signature(x="gCheckboxgroupRGtk"), ## function(x, i, j,..., value) { ## .leftBracket(x, x@toolkit, i, j, ...) <- value ## return(x) ## }) ## setReplaceMethod(".leftBracket", ## signature(toolkit="guiWidgetsToolkitRGtk2",x="gCheckboxgroupRGtk"), ## function(x, toolkit, i, j, ..., value) { ## items = tag(x,"items") ## lst = tag(x,"itemlist") ## n = length(items) ## ## if i is missing, we can relabel if length the same ## ## otherwise we delete and start again ## ## We will need to add the handlers back ## if(missing(i)) { ## if(length(value) != n) { ## group <- x@widget ## ## delete ## sapply(rev(lst), function(child) ## delete(group, child)) ## ## add ## lst <- list() ## for(i in 1:length(value)) { ## newItem = gcheckbox(value[i], checked=FALSE) ## lst[[ as.character(value[i]) ]] = newItem ## add(group, newItem) ## } ## tag(x, "items") <- value ## tag(x, "itemlist") <- lst ## ## addhandlers ## handlerList <- tag(x,"handlerList") ## if(length(handlerList) > 0) { ## for(j in handlerList) { ## sapply(lst, function(i) ## addhandlerchanged(i, ## handler=j$handler, action=j$action, ## actualobj=x, ...)) ## } ## } ## ## return ## return(x) ## } else { ## ## back to our regularly scheduled programming ## i = 1:n ## } ## } ## if(is.logical(i)) ## i = which(i) ## items[i] = value ## sapply(1:n, function(i) ## lst[[i]][] <- items[i] ## ) ## tag(x,"items") <- items ## tag(x,"itemlist") <- lst ## return(x) ## }) ## ## length ## setMethod(".length", ## signature(toolkit="guiWidgetsToolkitRGtk2",x="gCheckboxgroupRGtk"), ## function(x,toolkit) { ## length(tag(x,"items")) ## }) ## ## handlers ## setMethod(".addhandlerchanged", ## signature(toolkit="guiWidgetsToolkitRGtk2",obj="gCheckboxgroupRGtk"), ## function(obj, toolkit, handler, action=NULL, ...) { ## handlerList <- tag(obj,"handlerList") ## ct <- tag(obj,"handlerCount") ## ID <- as.character(ct+1) ## handlerList[[ID]] <- list( ## handler=handler, ## action=action ## ) ## tag(obj,"handlerList") <- handlerList ## ## now call on each ## lst = tag(obj,"itemlist") ## IDs <- lapply(lst, function(i) ## addhandlerchanged(i,handler=handler, action=action, actualobj=obj, ...)) ## invisible(IDs) ## }) ## setMethod(".removehandler", ## signature(toolkit="guiWidgetsToolkitRGtk2",obj="gCheckboxgroupRGtk"), ## function(obj, toolkit, ID=NULL, ...) { ## tag(obj,"handlerList") <- NULL ## lst <- tag(obj,"itemlist") ## sapply(1:length(lst), function(i) ## removehandler(lst[[i]], ID[[i]]) ## ) ## }) ## setMethod(".blockhandler", ## signature(toolkit="guiWidgetsToolkitRGtk2",obj="gCheckboxgroupRGtk"), ## function(obj, toolkit, ID=NULL, ...) { ## lst <- tag(obj,"itemlist") ## sapply(1:length(lst), function(i) ## blockhandler(lst[[i]], ID[[i]]) ## ) ## }) ## setMethod(".unblockhandler", ## signature(toolkit="guiWidgetsToolkitRGtk2",obj="gCheckboxgroupRGtk"), ## function(obj, toolkit, ID=NULL, ...) { ## lst <- tag(obj,"itemlist") ## sapply(1:length(lst), function(i) ## unblockhandler(lst[[i]], ID[[i]]) ## ) ## }) ## ################################################## ## ################################################## ## ### Checkbox group in a table ## setClass("gCheckboxgroupTableRGtk", ## contains="gComponentRGtk", ## prototype=prototype(new("gComponentRGtk")) ## ) ## setGeneric(".gcheckboxgrouptable", function(toolkit, items, checked=FALSE, ## handler=NULL, action=NULL, ## container=NULL, ...) ## standardGeneric(".gcheckboxgrouptable")) ## setMethod(".gcheckboxgrouptable", ## signature(toolkit="guiWidgetsToolkitRGtk2"), ## function(toolkit, ## items, checked = FALSE, ## handler = NULL, action = NULL, container = NULL, ...) { ## force(toolkit) ## tbl <- gtkTreeViewNew(TRUE) ## tbl$SetRulesHint(TRUE) # shade ## store <- rGtkDataFrame(.makeItems()) ## tbl$setModel(store) ## tbl$setHeadersVisible(FALSE) ## sw <- gtkScrolledWindowNew() ## sw$SetPolicy("GTK_POLICY_AUTOMATIC","GTK_POLICY_AUTOMATIC") ## sw$Add(tbl) ## ## set up the view columns ## vc <- gtkTreeViewColumnNew() ## tbl$insertColumn(vc, 0) ## cr <- gtkCellRendererToggle() ## vc$PackStart(cr, TRUE) ## cr['activatable'] <- TRUE # needed ## vc$addAttribute(cr, "active", 1) ## item.toggled <- function(tbl, cell, path, data) { ## store <- tbl$getModel() ## row <- as.numeric(path) + 1 ## store[row,2] <- !store[row, 2] ## } ## gSignalConnect(cr, "toggled", item.toggled, data=tbl, user.data.first=TRUE) ## cr <- gtkCellRendererTextNew() ## vc <- gtkTreeViewColumnNew() ## vc$PackStart(cr, TRUE) ## vc$addAttribute(cr, "text", 0) ## tbl$insertColumn(vc, 1) ## ## how to add icons, tooltips! ## ## make combination widget with all the values ## obj = new("gCheckboxgroupTableRGtk", block=sw, widget=tbl, ## toolkit=toolkit) ## obj[] <- items ## svalue(obj) <- checked ## if(!is.null(handler)) ## tag(obj, "handler.id") <- addhandlerchanged(obj,handler,action) ## if(!is.null(container)) { ## if(is.logical(container)) { ## if(container) { ## container <- gwindow() ## } else { ## return(obj) ## } ## } ## add(container, obj, ...) ## } ## return(obj) ## }) ## ## helper ## .makeItems <- function(items, icons, tooltips, checked=rep(FALSE, length(items))) { ## if(missing(items) || ## (is.data.frame(items) && nrow(items) == 0) || ## (length(items) == 0) ## ) { ## out <- data.frame(items=character(0), ## checked=logical(0), ## icons=character(0), ## tooltips=character(0), ## stringsAsFactors=FALSE) ## } else if(is.data.frame(items)) { ## ## check ## out <- items ## if(ncol(out) == 1) ## out$checked <- as.logical(rep(checked, length=nrow(items))) ## if(ncol(out) == 2) ## out$icons <- rep("", nrow(items)) ## if(ncol(out) == 3) ## out$tooltip <- rep("", nrow(items)) ## } else { ## ## piece together ## items <- as.character(items) ## if(missing(icons)) ## icons <- "" ## icons <- rep(icons, length=length(items)) ## if(missing(tooltips)) ## tooltips <- "" ## icons <- rep(tooltips, length=length(items)) ## checked <- rep(checked, length=length(items)) ## out <- data.frame(items=items, checked=checked, icons=icons, tooltips=tooltips, ## stringsAsFactors=FALSE) ## } ## return(out) ## } ## ### methods ## setMethod(".svalue", ## signature(toolkit="guiWidgetsToolkitRGtk2",obj="gCheckboxgroupTableRGtk"), ## function(obj, toolkit, index=NULL, drop=NULL, ...) { ## n <- length(obj) ## if(n == 0) ## return(logical(0)) ## tbl <- getWidget(obj) ## store <- tbl$getModel() ## vals <- store[,2, drop=TRUE] ## index <- getWithDefault(index, FALSE) ## if(index) { ## return(which(vals)) # return indices ## } else { ## obj[vals] # vals is logical ## } ## }) ## ## toggles state to be T or F ## setReplaceMethod(".svalue", ## signature(toolkit="guiWidgetsToolkitRGtk2",obj="gCheckboxgroupTableRGtk"), ## function(obj, toolkit, index=NULL, ..., value) { ## n <- length(obj) ## if(n == 0) ## return(obj) ## tbl <- getWidget(obj) ## store <- tbl$getModel() ## index <- getWithDefault(index, is.numeric(value)) ## if(index) { ## tmp <- rep(FALSE, n) ## tmp[value] <- TRUE ## value <- tmp ## } ## ## recycle ## value <- as.logical(rep(value, length=n)) ## store[,2] <- value ## return(obj) ## }) ## ## [ and [<- refer to the names -- not the TF values ## ## Here we can have a vector of names -- or a data frame ## ## 1st column names, 2nd icon, third tooltip -- like gcombobox ## setMethod("[", ## signature(x="gCheckboxgroupTableRGtk"), ## function(x, i, j, ..., drop=TRUE) { ## .leftBracket(x, x@toolkit, i, j, ..., drop=drop) ## }) ## setMethod(".leftBracket", ## signature(toolkit="guiWidgetsToolkitRGtk2",x="gCheckboxgroupTableRGtk"), ## function(x, toolkit, i, j, ..., drop=TRUE) { ## if(length(x) == 0) ## return(character(0)) ## tbl <- getWidget(x) ## store <- tbl$getModel() ## items <- store[,1, drop=TRUE] ## if(missing(i)) ## return(items) ## else ## return(items[i]) ## }) ## ## assigns names ## setReplaceMethod("[", ## signature(x="gCheckboxgroupTableRGtk"), ## function(x, i, j,..., value) { ## .leftBracket(x, x@toolkit, i, j, ...) <- value ## return(x) ## }) ## setReplaceMethod(".leftBracket", ## signature(toolkit="guiWidgetsToolkitRGtk2",x="gCheckboxgroupTableRGtk"), ## function(x, toolkit, i, j, ..., value) { ## ## value can be a vector or data frame ## ## if a data.frame we have ## ## text, stockicon, tooltip ## items <- .makeItems(value) ## tbl <- getWidget(x) ## store <- tbl$getModel() ## if(missing(i)) { ## ## replace the store ## newStore <- rGtkDataFrame(items) ## tbl$setModel(newStore) ## } else { ## if(is.logical(i)) ## i = which(i) ## ## set items ## m <- nrow(items) ## if(m == 0) ## return(x) ## store[i,] <- items ## } ## return(x) ## }) ## setMethod(".length", ## signature(toolkit="guiWidgetsToolkitRGtk2",x="gCheckboxgroupTableRGtk"), ## function(x,toolkit) { ## tbl <- getWidget(x) ## store <- tbl$getModel() ## dim(store)[1] ## }) ## ## Handlers must just pass down to each item in the list. ## setMethod(".addhandlerchanged", ## signature(toolkit="guiWidgetsToolkitRGtk2",obj="gCheckboxgroupTableRGtk"), ## function(obj, toolkit, handler, action=NULL, ...) { ## .addhandlerclicked(obj, toolkit, handler=handler,action=action,...) ## }) ## ## clicked is changed ## setMethod(".addhandlerclicked", ## signature(toolkit="guiWidgetsToolkitRGtk2",obj="gCheckboxgroupTableRGtk"), ## function(obj, toolkit, handler, action=NULL, ...) { ## ## push down to cr ## tbl <- getWidget(obj) ## vc <- tbl$getColumn(0) ## cr <- vc$getCellRenderers()[[1]] ## ID <- gSignalConnect(cr, "toggled", function(h,...) handler(h), ## user.data.first=TRUE, ## data=list(obj=obj, action=action)) ## invisible(ID) ## }) ## setMethod(".removehandler", ## signature(toolkit="guiWidgetsToolkitRGtk2",obj="gCheckboxgroupTableRGtk"), ## function(obj, toolkit, ID=NULL, ...) { ## tbl <- getWidget(obj) ## vc <- tbl$getColumn(0) ## cr <- vc$getCellRenderers()[[1]] ## gSignalHandlerDisconnect(cr, ID) ## }) ## setMethod(".blockhandler", ## signature(toolkit="guiWidgetsToolkitRGtk2",obj="gCheckboxgroupTableRGtk"), ## function(obj, toolkit, ID=NULL, ...) { ## tbl <- getWidget(obj) ## vc <- tbl$getColumn(0) ## cr <- vc$getCellRenderers()[[1]] ## gSignalHandlerBlock(cr, ID) ## }) ## setMethod(".unblockhandler", ## signature(toolkit="guiWidgetsToolkitRGtk2",obj="gCheckboxgroupTableRGtk"), ## function(obj, toolkit, ID=NULL, ...) { ## tbl <- getWidget(obj) ## vc <- tbl$getColumn(0) ## cr <- vc$getCellRenderers()[[1]] ## gSignalHandlerUnblock(cr, ID) ## }) gWidgetsRGtk2/R/gspinbutton.R0000644000175100001440000000677511406427002015632 0ustar hornikusers## Could make spinbutton slider, subclass as methods are identical setClass("gSpinbuttonRGtk", contains="gComponentRGtk", prototype=prototype(new("gComponentRGtk")) ) setMethod(".gspinbutton", signature(toolkit="guiWidgetsToolkitRGtk2"), function(toolkit, from=0,to=10,by=1,value=from,digits=0, handler=NULL, action=NULL, container=NULL, ...) { force(toolkit) ## fix digits if user forgot if(digits == 0 && as.logical((by %% 1))) # FALSE if integer o/w T digits = abs(floor(log(by,10))) adjustment = gtkAdjustmentNew(value=value, lower=from, upper=to,step.incr=by) spin = gtkSpinButtonNew(adjustment,climb.rate=0.6, digits=digits) obj <- as.gWidgetsRGtk2(spin) svalue(obj) <- value # wasn't working as desired if (!is.null(container)) { if(is.logical(container) && container == TRUE) container = gwindow(visible=TRUE) add(container, obj,...) } if (!is.null(handler)) { id = addhandlerchanged(obj, handler, action) } invisible(obj) }) as.gWidgetsRGtk2.GtkSpinButton <- function(widget,...) { obj <- new("gSpinbuttonRGtk", block=widget, widget=widget, toolkit=guiToolkit("RGtk2")) return(obj) } ### methods setMethod(".svalue", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gSpinbuttonRGtk"), function(obj, toolkit, index=NULL, drop=NULL, ...) { obj@widget$GetValue() }) setReplaceMethod(".svalue", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gSpinbuttonRGtk"), function(obj, toolkit, index=NULL, ..., value) { obj@widget$SetValue(value) return(obj) }) ## Method to replace values of sping button setReplaceMethod("[", signature(x="gSpinbuttonRGtk"), function(x, i, j,..., value) { .leftBracket(x, x@toolkit, i, j, ...) <- value return(x) }) setReplaceMethod(".leftBracket", signature(toolkit="guiWidgetsToolkitRGtk2",x="gSpinbuttonRGtk"), function(x, toolkit, i, j, ..., value) { obj <- x widget <- getWidget(obj) ## check that value is a regular sequence if(length(value) <=1) { warning("Can only assign a vector with equal steps, as produced by seq") return(obj) } if(length(value) > 2 && !all.equal(diff(diff(value)), rep(0, length(value) - 2))) { warning("Can only assign a vector with equal steps, as produced by seq") return(obj) } ## get current value, increment curValue <- svalue(obj) inc <- head(diff(value), n=1) widget$setRange(min(value), max(value)) widget$setIncrements(inc, inc) # button 1, button 2 widget$setValue(curValue) ## all done return(obj) }) ### handlers setMethod(".addhandlerchanged", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gSpinbuttonRGtk"), function(obj, toolkit, handler, action=NULL, ...) { addhandler(obj,"value-changed",handler, action, ...) }) gWidgetsRGtk2/R/aaaGenerics.R0000644000175100001440000020521613131731317015453 0ustar hornikusers## toolkit class ## register classes here for toolkits ## setClass("guiWidgetsToolkitRGtk2", ## contains="guiWidgetsToolkit", ## prototype=prototype(new("guiWidgetsToolkit")) ## ) ################################################## ## put S3 classes from RGtk2 into S4 classes ## got these from apropos("New") -> try(class(do.call(i,list()))) oldClasses = c( "AtkNoOpObjectFactory", "AtkObjectFactory", "AtkRelationSet", "AtkStateSet", "GBoxed", "GObject", "GScanner", "GdkDragContext", "GdkPixbufLoader", "GdkRegion", "GtkAboutDialog", "GtkAccelGroup", "GtkAccelLabel", "GtkAction", "GtkActionGroup", "GtkAdjustment", "GtkAlignment", "GtkArrow", "GtkAspectFrame", "GtkBin", "GtkBox", "GtkButton", "GtkButtonBox", "GtkCList", "GtkCTree", "GtkCalendar", "GtkCellRenderer", "GtkCellRendererCombo", "GtkCellRendererPixbuf", "GtkCellRendererProgress", "GtkCellRendererText", "GtkCellRendererToggle", "GtkCellView", "GtkCheckButton", "GtkCheckMenuItem", "GtkColorButton", "GtkColorSelection", "GtkColorSelectionDialog", "GtkCombo", "GtkComboBox", "GtkComboBoxEntry", "GtkContainer", "GtkCurve", "GtkDialog", "GtkDrawingArea", "GtkEntry", "GtkEntryCompletion", "GtkEventBox", "GtkExpander", "GtkFileFilter", "GtkFileSelection", "GtkFileChooserWidget", "GtkFixed", "GtkFontButton", "GtkFontSelection", "GtkFontSelectionDialog", "GtkFrame", "GtkGammaCurve", "GtkHBox", "GtkHButtonBox", "GtkHPaned", "GtkHRuler", "GtkHScale", "GtkHScrollbar", "GtkHSeparator", "GtkHandleBox", "GtkIMContext", "GtkIMContextSimple", "GtkIMMulticontext", "GtkIconFactory", "GtkIconSet", "GtkIconSource", "GtkIconTheme", "GtkIconView", "GtkImage", "GtkImageMenuItem", "GtkInfoBar", "GtkInputDialog", "GtkInvisible", "GtkItem", "GtkLabel", "GtkLayout", "GtkList", "GtkListItem", "GtkMenu", "GtkMenuBar", "GtkMenuItem", "GtkMenuShell", "GtkMisc", "GtkNotebook", "GtkObject", "GtkOptionMenu", "GtkPaned", "GtkProgress", "GtkProgressBar", "GtkRadioAction", "GtkRadioButton", "GtkRange", "GtkRcStyle", "GtkRuler", "GtkScale", "GtkScrollbar", "GtkScrolledWindow", "GtkSeparator", "GtkSeparatorMenuItem", "GtkSeparatorToolItem", "GtkSizeGroup", "GtkSocket", "GtkSpinButton", "GtkStatusbar", "GtkStyle", "GtkTable", "GtkTearoffMenuItem", "GtkTextAttributes", "GtkTextBuffer", "GtkTextChildAnchor", "GtkTextTag", "GtkTextTagTable", "GtkTextView", "GtkTipsQuery", "GtkToggleAction", "GtkToggleButton", "GtkToggleToolButton", "GtkToolButton", "GtkToolItem", "GtkToolbar", "GtkTooltips", "GtkTreeModelSort", "GtkTreePath", "GtkTreeStore", "GtkTreeView", "GtkTreeViewColumn", "GtkUIManager", "GtkVBox", "GtkVButtonBox", "GtkVPaned", "GtkVRuler", "GtkVScale", "GtkVScrollbar", "GtkVSeparator", "GtkViewport", "GtkWidget", "GtkWindow", "GtkWindowGroup", ## "PangoAttrList", "PangoCairoFcFontMap", "PangoCoverage", "PangoFcFontMap", "PangoFontDescription", "PangoFontMap", "PangoGlyphString", "PangoItem", "GObject", "RGtkDataFrame", ## add in others that come up "GtkTreeSelection" ) setOldClass("RGtkObject") lapply(oldClasses, function(i) { setOldClass(i) setIs(i,"RGtkObject") }) setOldClass("try-error") # for handling try-errors ## a base class which is virtual ################################################## ## A virtual class to hold either RGTK or these guys ## A virtual class for our newly defined objects setClass("gWidgetRGtk") ## this worked in 2.4.0 but not later, remove ##setIs("guiWidget","guiWidgetORgWidgetRGtkORRGtkObject") ##setIs("gWidgetRGtk","guiWidgetORgWidgetRGtkORRGtkObject") ##setIs("RGtkObject","guiWidgetORgWidgetRGtkORRGtkObject") setClassUnion("guiWidgetORgWidgetRGtkORRGtkObject", c("guiWidget","gWidgetRGtk","RGtkObject")) ## subclss ## This behaviour changed in R as of 2.7.0. We throw in the towel here and use "ANY and not the preferred guiWidgetORgWidgetRGtkORRGtkObject ##.Rversion <- R.Version() ##if(.Rversion$major == "2" && .Rversion$minor == "7.0" ) { setClass("gComponentRGtk", representation( block="ANY", widget="ANY", toolkit="guiWidgetsToolkit" ), contains="gWidgetRGtk", ) setClass("gContainerRGtk", representation( block="ANY", widget="ANY", toolkit="guiWidgetsToolkit" ), contains="gWidgetRGtk", ) ## } else { ## setClass("gComponentRGtk", ## representation( ## block="guiWidgetORgWidgetRGtkORRGtkObject", ## widget="guiWidgetORgWidgetRGtkORRGtkObject", ## toolkit="guiWidgetsToolkit" ## ), ## contains="gWidgetRGtk", ## ) ## setClass("gContainerRGtk", ## representation( ## block="guiWidgetORgWidgetRGtkORRGtkObject", ## widget="guiWidgetORgWidgetRGtkORRGtkObject", ## toolkit="guiWidgetsToolkit" ## ), ## contains="gWidgetRGtk", ## ) ## } ################################################## ### Common methods. Specific to a class are put into the file for that class ## we have two definitions. For instance, "svalue" and ".svalue". The "svalue" method dispatches on the object to the .svalue method. This allows us to use svalue instead of .svalue when defining the methods/constructors inside this package. setMethod("svalue",signature(obj="gWidgetRGtk"), function(obj, index=NULL, drop=NULL, ...) { .svalue(obj, obj@toolkit, index=index, drop=drop, ...) }) ## svalue ## need method for character setMethod("svalue",signature(obj="character"), function(obj, index=NULL, drop=NULL, ...) { ifelse(length(obj) == 1, return(getObjectFromString(obj)), return(obj) ) }) setMethod(".svalue",signature(toolkit = "guiWidgetsToolkitRGtk2", obj="character"), function(obj, toolkit, index=NULL, drop=NULL, ...) { ifelse(length(obj) == 1, return(getObjectFromString(obj)), return(NA) ) }) ## svalue<- -- objec specific setReplaceMethod("svalue",signature(obj="gWidgetRGtk"), function(obj, index=NULL, ...,value) { .svalue(obj, obj@toolkit, index=index, ...) <- value obj }) ## [ setMethod("[", signature(x="gWidgetRGtk"), function(x,i,j,...,drop=TRUE) { return(.leftBracket(x, x@toolkit,i,j,...,drop=TRUE)) # if(missing(i) && missing(j)) # .leftBracket(x@widget, toolkit,,,...,drop=TRUE) # else if(missing(j)) # .leftBracket(x@widget, toolkit,i,,...,drop=TRUE) # else # .leftBracket(x@widget, toolkit,i,j,...,drop=TRUE) }) ## [<- setReplaceMethod("[",signature(x="gWidgetRGtk"), function(x,i,j,...,value) { if(missing(i) && missing(j)) .leftBracket(x, x@toolkit,...) <- value else if(missing(j)) .leftBracket(x, x@toolkit,i,...) <- value else .leftBracket(x, x@toolkit,i,j,...) <- value return(x) }) ## size ## return size -- not implemented setMethod("size",signature(obj="gWidgetRGtk"), function(obj, ...) { return() .size(obj, obj@toolkit,...) }) setMethod(".size", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gWidgetRGtk"), function(obj, toolkit, ...) { ## send to gWidgetRGtk2 .size(obj@widget, toolkit, ...) }) setMethod(".size", signature(toolkit="guiWidgetsToolkitRGtk2",obj="RGtkObject"), function(obj, toolkit, ...) { ## get from SizeAllocation() val <- obj$GetAllocation() return(c(width=val$width, height=val$height)) }) ## not needed? setMethod(".size", signature(toolkit="guiWidgetsToolkitRGtk2",obj="GtkWindow"), function(obj, toolkit, ...) { print("returning size information not yet implemented.") }) ## size<- setReplaceMethod("size",signature(obj="gWidgetRGtk"), function(obj, ..., value) { .size(obj, obj@toolkit,...) <- value return(obj) }) setReplaceMethod(".size", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gWidgetRGtk"), function(obj, toolkit, ..., value) { if(length(value) >= 2) { width <- value[1]; height <- value[2] } else if(names(value) == "height") { width <- -1; height <- value } else { width <- value; height <- -1 } widget = obj@widget widget$SetSizeRequest(width,height) # widget$SetDefaultSize(width,height) return(obj) }) ## visible setMethod("visible",signature(obj="gWidgetRGtk"), function(obj, set=NULL, ...) { .visible(obj,obj@toolkit, set=set, ...) }) setMethod(".visible", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gWidgetRGtk"), function(obj, toolkit, set=TRUE, ...) { widget <- getWidget(obj) if(is.null(set)) widget['visible'] else if(as.logical(set)) widget$Show() else widget$Hide() }) ## visible<- setReplaceMethod("visible",signature(obj="gWidgetRGtk"), function(obj, ..., value) { .visible(obj, obj@toolkit, ...) <- value return(obj) }) setReplaceMethod(".visible", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gWidgetRGtk"), function(obj, toolkit, ..., value) { visible(obj, value) return(obj) }) ## isExtant -- can we see the window setMethod("isExtant",signature(obj="gWidgetRGtk"), function(obj, ...) { .isExtant(obj,obj@toolkit, ...) }) setMethod(".isExtant", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gWidgetRGtk"), function(obj, toolkit, ...) { widget = getWidget(obj) if(is.null(widget)) return(FALSE) !inherits(widget,"") # test to see if destroyed }) ## enabled -- not implemeneted, don't know how to find sensitive. Would need to keep in ## in the widget using tag or somesuch setMethod("enabled",signature(obj="gWidgetRGtk"), function(obj, ...) { warning("enable not defined, try enabled<-()") return(NA) .enabled(obj, obj@toolkit,...) }) setMethod(".enabled", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gWidgetRGtk"), function(obj, toolkit, ...) { widget <- getWidget(obj) if("sensitive" %in% names(widget)) widget['sensitive'] else TRUE }) setMethod(".enabled", signature(toolkit="guiWidgetsToolkitRGtk2",obj="GtkWindow"), function(obj, toolkit, ...) { print("returning enabled information not yet implemented.") }) ## enabled<- setReplaceMethod("enabled",signature(obj="gWidgetRGtk"), function(obj, ..., value) { .enabled(obj, obj@toolkit,...) <- value return(obj) }) setReplaceMethod(".enabled", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gWidgetRGtk"), function(obj, toolkit, ..., value) { widget = getWidget(obj) .enabled(widget, toolkit, ...) <- value return(obj) }) setReplaceMethod(".enabled", signature(toolkit="guiWidgetsToolkitRGtk2",obj="RGtkObject"), function(obj, toolkit, ..., value) { obj$SetSensitive(as.logical(value)) return(obj) }) ## editable -- can the widget be edited setMethod("editable",signature(obj="gWidgetRGtk"), function(obj, ...) { return() .editable(obj, obj@toolkit,...) }) setMethod(".editable", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gWidgetRGtk"), function(obj, toolkit, ...) { message("no default editable method") }) ## editable<- setReplaceMethod("editable",signature(obj="gWidgetRGtk"), function(obj, ..., value) { .editable(obj, obj@toolkit,...) <- value return(obj) }) setReplaceMethod(".editable", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gWidgetRGtk"), function(obj, toolkit, ..., value) { message("no default editable<- method") return(obj) }) ## focus setMethod("focus",signature(obj="gWidgetRGtk"), function(obj, ...) { .focus(obj, obj@toolkit,...) }) setMethod(".focus", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gWidgetRGtk"), function(obj, toolkit, ...) focus(obj) <- TRUE) ## focus<- setReplaceMethod("focus",signature(obj="gWidgetRGtk"), function(obj, ..., value) { .focus(obj, obj@toolkit,...) <- value return(obj) }) setReplaceMethod(".focus", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gWidgetRGtk"), function(obj, toolkit, ..., value) { focus(obj@widget, toolkit, ...) <- value return(obj) }) setReplaceMethod("focus",signature(obj="RGtkObject"), function(obj, ..., value) { .focus(obj, toolkit=guiToolkit("RGtk2"),...) <- value return(obj) }) ## window setReplaceMethod(".focus", signature(toolkit="guiWidgetsToolkitRGtk2",obj="GtkWindow"), function(obj, toolkit, ..., value) { value = as.logical(value) if(value) obj$GetWindow()$Raise() else obj$GetWindow()$Lower() return(obj) }) ## other objects setReplaceMethod(".focus", signature(toolkit="guiWidgetsToolkitRGtk2",obj="RGtkObject"), function(obj, toolkit, ..., value) { value = as.logical(value) if(value) { obj$GrabFocus() obj$GetParentWindow()$Raise() } else { obj$GetParentWindow()$Lower() } return(obj) }) ## tooltip<- setReplaceMethod("tooltip",signature(obj="gWidgetRGtk"), function(obj, ..., value) { .tooltip(obj, obj@toolkit,...) <- value return(obj) }) setReplaceMethod(".tooltip", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gWidgetRGtk"), function(obj, toolkit, ..., value) { tooltip(obj@widget, toolkit, ...) <- value return(obj) }) setReplaceMethod("tooltip",signature(obj="RGtkObject"), function(obj, ..., value) { ## set the tip. obj$setTooltipText(paste(value, collapse="\n")) ## deprecated ## tooltipGroup <- try(gtkTooltips(), silent = TRUE) ## if(inherits(tooltipGroup, "try-error")) ## return(obj) ## ## some widgets don't allow a tooltip (glabel, ...) ## ## right check is widget.flags()>k.NO_WINDOW ## try(tooltipGroup$setTip(obj, tip.text = value), silent=TRUE) return(obj) }) ## default Widget ## defaultWidget setMethod("defaultWidget",signature(obj="gWidgetRGtk"), function(obj, ...) { .defaultWidget(obj, obj@toolkit,...) }) setMethod(".defaultWidget", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gWidgetRGtk"), function(obj, toolkit, ...) getWidget(obj)['has-default'] ) ## defaultWidget<- setReplaceMethod("defaultWidget",signature(obj="gWidgetRGtk"), function(obj, ..., value) { .defaultWidget(obj, obj@toolkit,...) <- value return(obj) }) setReplaceMethod("defaultWidget",signature(obj="RGtkObject"), function(obj, ..., value) { .defaultWidget(obj, toolkit=guiToolkit("RGtk2"),...) <- value return(obj) }) setReplaceMethod(".defaultWidget", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gWidgetRGtk"), function(obj, toolkit, ..., value) { widget <- getWidget(obj) .defaultWidget(widget, toolkit, ...) <- value return(obj) }) setReplaceMethod(".defaultWidget", signature(toolkit="guiWidgetsToolkitRGtk2",obj="RGtkObject"), function(obj, toolkit, ..., value) { value = as.logical(value) obj['can-default'] <- value obj$grabDefault() # obj['receives-default'] <- value return(obj) }) ## fonts .font.styles = list( family = c("normal","sans","serif","monospace"), style = c("normal","oblique","italic"), weight = c("ultra-light","light","normal","bold","ultra-bold","heavy"), colors = c("black","blue","red","green","brown","yellow","pink") ) ## font sizes ## old defs for .PangoScale are no longer valid as of 10.4 fontSizes <- c( "xx-large"= PANGO_SCALE_XX_LARGE, "x-large" = PANGO_SCALE_X_LARGE, "large" = PANGO_SCALE_LARGE, "medium" = PANGO_SCALE_MEDIUM, "small" = PANGO_SCALE_SMALL, "x-small" = PANGO_SCALE_X_SMALL, "xx-small" = PANGO_SCALE_XX_SMALL ) setMethod("font",signature(obj="gWidgetRGtk"), function(obj, ...) { warning("font() not defined. Set fonts with font<-") return() .font(obj, obj@toolkit,...) }) setMethod(".font", signature(toolkit="guiWidgetsToolkitRGtk2",obj="GtkWindow"), function(obj, toolkit, ...) { print("returning font information not yet implemented.") }) ## font<- setReplaceMethod("font",signature(obj="gWidgetRGtk"), function(obj, ..., value) { .font(obj, obj@toolkit,...) <- .fixFontMessUp(value) return(obj) }) setReplaceMethod(".font", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gWidgetRGtk"), function(obj, toolkit, ..., value) { .font(obj@widget, toolkit, ...) <- value return(obj) }) setReplaceMethod(".font", signature(toolkit="guiWidgetsToolkitRGtk2",obj="RGtkObject"), function(obj, toolkit, ..., value) { ## value might be a vector, we use a list -- from .fixFontMessUp if(!is.list(value)) { tmp = value value = list() for(i in names(tmp)) value[[i]] = tmp[i] } string = "" ## do family, weight, style for(i in c("family", "weight", "style")) { if(!is.null(value[[i]])) { x <- .font.styles[[i]] ind <- charmatch(value[[i]], x) if(!is.na(ind)) { string <- paste(string, x[ind[1]], sep=" ") if(i == "family") string <- paste(string,",", sep="") } } } ## size can be integer or name -- relative to 12pt if(!is.null(value$size)) { ## is it numeric or character? warn <- getOption("warn"); options(warn=2) # hack to avoid warning -- we want an error here out <- try(as.integer(value[['size']]), silent=TRUE) options(warn=warn) if(!inherits(out, "try-error")) string <- Paste(string," ",out) else if (!is.na(ind <- charmatch(value[['size']], names(fontSizes)))) # fuzzy match? string <- Paste(string, " ", paste(ceiling(12*fontSizes[ind[1]]),"px", sep="")) } string <- gsub(",$","",string) # strip , if present if(string != "") { fontDescr = pangoFontDescriptionFromString(string) obj$ModifyFont(fontDescr) } ## colors if(!is.null(value$color)) obj$modifyFg(GtkStateType["normal"], value[['color']]) return(obj) }) ## tag, tag<- setMethod("tag",signature(obj="gWidgetRGtk"), function(obj,i,drop=TRUE, ...) { if(missing(drop)) drop <- TRUE .tag(obj, obj@toolkit,i, drop=drop,...) }) ## dispatch in *this* toolkit, not present in obj setMethod("tag",signature(obj="RGtkObject"), function(obj,i,drop=TRUE, ...) { if(missing(drop)) drop <- TRUE .tag(obj, guiToolkit("RGtk2"),i, drop=drop,...) }) setMethod(".tag", signature(toolkit="guiWidgetsToolkitRGtk2",obj="guiWidget"), function(obj, toolkit, i, drop=TRUE, ...) { if(missing(i)) i = NULL if(missing(drop)) drop <- TRUE .tag(obj@widget,toolkit, i, drop=drop, ...) }) setMethod(".tag", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gWidgetRGtk"), function(obj, toolkit, i, drop=TRUE, ...) { if(missing(i)) i = NULL if(missing(drop)) drop <- TRUE .tag( obj@block,toolkit, i, drop=drop, ...) }) setMethod(".tag", signature(toolkit="guiWidgetsToolkitRGtk2",obj="RGtkObject"), function(obj, toolkit, i, drop=TRUE, ...) { if(missing(i)) i = NULL lst = obj$GetData(".tagKey") if(is.null(i)) return(lst) if(drop) { if(length(i) == 1) return(lst[[i]]) else return(sapply(i, function(j) lst[j])) } else { return(sapply(i, function(j) lst[j])) } }) ## tag <- setReplaceMethod("tag",signature(obj="gWidgetRGtk"), function(obj, i, replace=TRUE, ..., value) { .tag(obj, obj@toolkit,i,replace, ...) <- value return(obj) }) ## dispatch in *this* toolkit, not present in obj setReplaceMethod("tag",signature(obj="RGtkObject"), function(obj,i, replace=TRUE, ..., value) { .tag(obj, guiToolkit("RGtk2"),i, replace, ...) <- value return(obj) }) ## objects can be in many different flavors: guiWIdget, gWidgetRGtk2, RGtkObject setReplaceMethod(".tag", signature(toolkit="guiWidgetsToolkitRGtk2",obj="guiWidget"), function(obj, toolkit, i, replace=TRUE, ..., value) { if(missing(i)) i = NULL .tag(obj@widget,toolkit, i, replace, ...) <- value return(obj) }) setReplaceMethod(".tag", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gWidgetRGtk"), function(obj, toolkit, i, replace=TRUE, ..., value) { if(missing(i)) i = NULL .tag( obj@block, toolkit, i, replace, ...) <- value return(obj) }) setReplaceMethod(".tag", signature(toolkit="guiWidgetsToolkitRGtk2",obj="RGtkObject"), function(obj, toolkit, i, replace=TRUE, ..., value) { if(missing(i) || is.null(i)) { warning("Need to specify a key to the 'i' argument of tag<-") } else { allData = obj$GetData(".tagKey") if(is.null(allData)) allData = list() if(as.logical(replace)) { allData[[i]] <- value } else { allData[[i]] <- c(allData[[i]], value) } obj$SetData(".tagKey", allData) } return(obj) }) ################################################## ## id -- define for "ANY" as well setMethod("id",signature(obj="gWidgetRGtk"), function(obj, ...) { tag(obj,".gtkID") }) setMethod("id",signature(obj="RGtkObject"), function(obj, ...) { tag(obj, ".gtkID", ...) return(obj) }) setMethod("id",signature(obj="ANY"), function(obj, ...) { if(!is.null(theID<- attr(obj,"id"))) { return(theID) } else { if(is.character(obj)) { return(obj[1]) } else { dps = deparse(substitute(obj)) attr(obj,"id") <- dps return(dps) } } }) setMethod(".id", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gWidgetRGtk"), function(obj, toolkit, ...) { tag(obj,".gtkID", ...) }) setMethod(".id", signature(toolkit="guiWidgetsToolkitRGtk2",obj="RGtkObject"), function(obj, toolkit, ...) { return(tag(obj,".gtkID")) }) ## id<- setReplaceMethod("id",signature(obj="gWidgetRGtk"), function(obj, ..., value) { tag(obj,".gtkID", ...) <- value return(obj) }) ## dispatch in *this* toolkit, not present in obj setReplaceMethod("id",signature(obj="RGtkObject"), function(obj, ..., value) { tag(obj, ".gtkID", ...) <- value return(obj) }) setReplaceMethod("id",signature(obj="ANY"), function(obj, ..., value) { attr(obj,"id") <- value return(obj) }) ## we need a .id to handle dispatch from guiWidgets, otherwise, we use id() setReplaceMethod(".id", signature(toolkit="guiWidgetsToolkitRGtk2", obj="gWidgetRGtk"), function(obj, toolkit, ..., value) { id(obj, ...) <- value return(obj) }) ## add method is biggie ## we have several levels of classes here guiWidget -- gWidgetRGkt -- RGtkObject, when ## we get down to that level we can finally add setMethod("add",signature(obj="gWidgetRGtk"), function(obj, value, ...) { .add(obj, obj@toolkit,value,...) }) setMethod(".add", signature(toolkit="guiWidgetsToolkitRGtk2", obj="guiWidget", value="ANY"), function(obj, toolkit, value, ...) { cat(gettext("Can't add without a value\n")) }) setMethod(".add", signature(toolkit="guiWidgetsToolkitRGtk2", obj="gWidgetRGtk", value="try-error"), function(obj, toolkit, value, ...) { gmessage(paste("Error:",value), title="Error adding oject", icon="error") }) ## pushdonw setMethod(".add", signature(toolkit="guiWidgetsToolkitRGtk2", obj="guiWidget", value="guiWidgetORgWidgetRGtkORRGtkObject"), function(obj, toolkit, value, ...) { .add(obj@widget, toolkit, value, ...) }) ## for gWindow setMethod(".add", signature(toolkit="guiWidgetsToolkitRGtk2", obj="gContainerRGtk", value="guiWidget"), function(obj, toolkit, value, ...) { .add(obj, toolkit, value@widget, ...) }) setMethod(".add", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gContainerRGtk", value="gWidgetRGtk"), function(obj, toolkit, value, ...) { .add(obj, toolkit, value@block, ...) }) ## addSPring, addSpace setMethod("addSpring",signature(obj="gWidgetRGtk"), function(obj, ...) { .addSpring(obj, obj@toolkit,...) }) setMethod(".addSpring", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gContainerRGtk"), function(obj, toolkit, ...) { obj@widget$PackStart(gtkHBoxNew(),TRUE,TRUE,0) # expand and fill set to TRUE }) setMethod("addSpace",signature(obj="gWidgetRGtk"), function(obj, value, ...) { .addSpace(obj,obj@toolkit,value,...) }) setMethod(".addSpace", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gContainerRGtk"), function(obj, toolkit, value, ...) { theArgs = list(...) horizontal = ifelse(is.null(theArgs$horizontal), TRUE, as.logical(theArgs$horizontal)) if(horizontal) { tmp = ggroup(); size(tmp) <- c(value,1) } else { tmp = ggroup(); size(tmp) <- c(1, value) } add(obj, tmp) }) ## delete -- get down to two RGtkObjects setMethod("delete",signature(obj="gWidgetRGtk"), function(obj, widget, ...) { .delete(obj, obj@toolkit,widget,...) }) ## push down to RGtk vs RGtk. Can be 9 possiblities! setMethod(".delete", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gContainerRGtk",widget="guiWidget"), function(obj, toolkit, widget, ...) { .delete(obj, toolkit, widget@widget, ...) }) setMethod(".delete", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gContainerRGtk",widget="gWidgetRGtk"), function(obj, toolkit, widget, ...) { .delete(obj@widget, toolkit, widget, ...) }) setMethod(".delete", signature(toolkit="guiWidgetsToolkitRGtk2",obj="RGtkObject",widget="gWidgetRGtk"), function(obj, toolkit, widget, ...) { .delete(obj, toolkit, getBlock(widget), ...) }) setMethod(".delete", signature(toolkit="guiWidgetsToolkitRGtk2",obj="RGtkObject",widget="guiWidget"), function(obj, toolkit, widget, ...) { .delete(obj, toolkit, widget@widget, ...) }) setMethod(".delete", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gWidgetRGtk",widget="RGtkObject"), function(obj, toolkit, widget, ...) { .delete(obj@widget, toolkit, widget, ...) }) setMethod(".delete", signature(toolkit="guiWidgetsToolkitRGtk2",obj="RGtkObject",widget="RGtkObject"), function(obj, toolkit, widget, ...) { ## Remove after checking if(!inherits(obj, "") && !inherits(widget, "") && widget$getParent() == obj) { obj$Remove(widget) } return(TRUE) }) ## dispose -- delete the parent window, or something else setMethod("dispose",signature(obj="gWidgetRGtk"), function(obj, ...) { .dispose(obj, obj@toolkit,...) }) setMethod(".dispose", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gWidgetRGtk"), function(obj, toolkit, ...) { widget = getWidget(obj) if(inherits(widget,"GtkWindow")) { widget$Destroy() return(TRUE) } else { widget = widget$GetParentWindow() if(inherits(widget,"")) return(FALSE) else widget$Destroy() return(TRUE) } }) ## update setMethod("update",signature(object="gWidgetRGtk"), function(object, ...) { .update(object, object@toolkit, ...) }) setMethod(".update", signature(toolkit="guiWidgetsToolkitRGtk2",object="gComponentRGtk"), function(object, toolkit, ...) { object@widget$QueueDraw() }) ## ## ################################################## ################################################## ## handlers ## ## basic handler for adding with a signal. Now exported. setGeneric("addhandler", function(obj, signal, handler, action=NULL, ...) standardGeneric("addhandler")) setGeneric("addHandler", function(obj, signal, handler, action=NULL, ...) standardGeneric("addHandler")) setMethod("addhandler",signature(obj="guiWidget"), function(obj, signal, handler, action=NULL, ...) { .addHandler(obj@widget, obj@toolkit, signal, handler, action, ...) }) setMethod("addhandler",signature(obj="gWidgetRGtk"), function(obj, signal, handler, action=NULL, ...) { .addHandler(obj, obj@toolkit, signal, handler, action, ...) }) setMethod("addhandler",signature(obj="RGtkObject"), function(obj, signal, handler, action=NULL, ...) { .addHandler(obj, guiToolkit("RGtk2"), signal, handler, action, ...) }) setMethod("addHandler",signature(obj="gWidgetRGtk"), function(obj, signal, handler, action=NULL, ...) { .addHandler(obj@widget, obj@toolkit, signal, handler, action, ...) }) setMethod(".addhandler", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gWidgetRGtk"), function(obj, toolkit, signal, handler, action=NULL, ...) { .addHandler(obj, obj@toolkit, signal, handler, action, ...) }) ## method for dispatch setGeneric(".addHandler", function(obj, toolkit, signal, handler, action=NULL, ...) standardGeneric(".addHandler")) setMethod(".addHandler", signature(toolkit="guiWidgetsToolkitRGtk2",obj="guiWidget"), function(obj, toolkit, signal, handler, action=NULL, ...) { .addHandler(obj@widget, toolkit, signal, handler, action, ...) }) setMethod(".addHandler", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gWidgetRGtk"), function(obj, toolkit, signal, handler, action=NULL, ...) { ## need to return logical when an event, not always, ## but gives trouble if not modifyHandler = function(...) { val <- handler(...) if(!is.logical(val)) return(TRUE) else return(val) } theArgs = list(...) ## fix value passed into gWidgets handlers h <- list() h$obj <- obj if(!is.null(theArgs$actualobj)) { h$obj <- theArgs$actualobj theArgs$actualobj <- NULL } if(length(theArgs)) for(i in names(theArgs)) h[[i]] <- theArgs[[i]] h$action <- action callbackID <- gtktry(connectSignal(getWidget(obj), ### issue: getWidget(obj), signal=signal, f=modifyHandler, data=h, user.data.first = TRUE, after = FALSE), silent=FALSE) if(inherits(callbackID,"try-error")) { gwCat(sprintf("Couldn't add signal %s for object of class %s", signal, class(obj)[1]),"\n") return(NA) } else { ## now put handler into object handler.ID = tag(obj, "handler.id") if(is.null(handler.ID)) handler.ID =list() handler.ID[[length(handler.ID)+1]] = callbackID tag(obj, "handler.id") <- handler.ID ## ## addhandlerdestroy(obj, handler=function(h,...) ## removehandler(h$obj,h$action), ## action=ID) ## return ID invisible(callbackID) } }) setMethod(".addHandler", signature(toolkit="guiWidgetsToolkitRGtk2",obj="RGtkObject"), function(obj, toolkit, signal, handler, action=NULL, ..., after=FALSE) { theArgs = list(...) ## need to return FALSE to propogate to next handler on events modifyHandler = function(h,...) { handler(h,...) return(FALSE) } ## fix value passed into gWidgets handlers h <- list() h$obj <- obj if(!is.null(theArgs$actualobj)) { h$obj <- theArgs$actualobj theArgs$actualobj <- NULL } ## pass in extra values, eg addHandlerClicked(obj, f=FUN, extra=value) will h$extra key if(length(theArgs)) for(i in names(theArgs)) h[[i]] <- theArgs[[i]] h$action <- action callbackID <- gtktry(gSignalConnect(obj, signal=signal, f=modifyHandler, data=h, user.data.first = TRUE, after = after), silent=TRUE) ## can't' stuff in handler IDS if(inherits(callbackID,"try-error")) { gwCat(sprintf("Couldn't connect signal: %s for object of class %s\n", signal, class(obj)[1])) return(NA) } else { ## store ID into list lst <- obj$getData("handler.id") if(is.null(lst)) lst <- list() lst <- c(lst,callbackID) obj$setData("handler.id", lst) invisible(callbackID) } }) ## removehandler setMethod("removehandler", signature("gWidgetRGtk"), function(obj, ID=NULL, ...) { .removehandler(obj, obj@toolkit, ID, ...) }) setMethod("removehandler", signature("RGtkObject"), function(obj, ID=NULL, ...) { .removehandler(obj, guiToolkit("RGtk2"), ID, ...) }) ### JV: Need to consolidate this and the next, The difference is the callbackIDS? setMethod(".removehandler", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gWidgetRGtk"), function(obj, toolkit, ID=NULL, ...) { if(missing(ID)) callbackIDs = .tag(obj,toolkit,"handler.id") else callbackIDs = ID ## timeout handler? if(class(callbackIDs) == "GTimeoutId") { out <- sapply(callbackIDs, function(i) { class(i) <- "GTimeoutId" # sapply strips attributes! gSourceRemove(i) }) return(out) } if(!is.null(callbackIDs)) { if(!is.list(callbackIDs)) { callbackIDs = list(callbackIDs) } widget = obj@widget retval = logical(length(callbackIDs)) for(i in 1:length(callbackIDs)) { if(is.list(callbackIDs[[i]])) # recurse if a list for(i in callbackIDs[[i]]) .removehandler(obj, toolkit, i) isCallbackID = gtktry(checkPtrType(callbackIDs[[i]],"CallbackID"),silent=TRUE) if(!inherits(isCallbackID,"try-error")) { retval[i] = gtktry(gSignalHandlerDisconnect(widget, callbackIDs[[1]]), silent=TRUE) # retval[i] = gtktry(gtkObjectDisconnectCallbackHack(widget, callbackIDs[[i]]), # silent=TRUE) } else { gwCat("DEBUG: ID not of callbackID\n") retval[i] = FALSE } } for(i in rev(which(retval==TRUE))) callbackIDs[[i]] <- NULL .tag(obj,toolkit, "handler.id", replace=FALSE) <- callbackIDs return(retval) } else { return(FALSE) } }) ## for RGtkObject setMethod(".removehandler", signature(toolkit="guiWidgetsToolkitRGtk2",obj="RGtkObject"), function(obj, toolkit, ID=NULL, ...) { if(missing(ID)) callbackIDs = .tag(obj,toolkit,"handler.id") else callbackIDs = ID if(!is.null(callbackIDs)) { if(!is.list(callbackIDs)) { callbackIDs = list(callbackIDs) } widget = obj retval = c() for(i in 1:length(callbackIDs)) { if(is.list(callbackIDs[[i]])) # recurse if a list for(i in callbackIDs[[i]]) .removehandler(obj, toolkit, i) isCallbackID = gtktry(checkPtrType(callbackIDs[[i]],"CallbackID"),silent=TRUE) if(!inherits(isCallbackID,"try-error")) { retval[i] = widget$disconnectCallback(callbackIDs[[i]]) #gtkObjectDisconnectCallbackHack(widget, callbackIDs[[i]]) } else { gwCat("DEBUG: ID not of callbackID\n") retval[i] = FALSE } } for(i in rev(which(retval==TRUE))) callbackIDs[[i]] <- NULL .tag(obj,toolkit, "handler.id", replace=FALSE) <- callbackIDs return(retval) } else { return(FALSE) } }) ## blockhandler setMethod("blockhandler", signature("gWidgetRGtk"), function(obj, ID=NULL, ...) { .blockhandler(obj, obj@toolkit, ID, ...) }) setMethod("blockhandler", signature("RGtkObject"), function(obj, ID=NULL, ...) { .blockhandler(obj, guiToolkit("RGtk2"), ID, ...) }) ## caps setMethod("blockHandler", signature("gWidgetRGtk"), function(obj, ID=NULL, ...) { .blockhandler(obj, obj@toolkit, ID, ...) }) setMethod("blockHandler", signature("RGtkObject"), function(obj, ID=NULL, ...) { .blockhandler(obj, guiToolkit("RGtk2"), ID, ...) }) setMethod(".blockhandler", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gWidgetRGtk"), function(obj, toolkit, ID=NULL, ...) { .blockhandler(getWidget(obj),toolkit,ID,...) }) setMethod(".blockhandler", signature(toolkit="guiWidgetsToolkitRGtk2",obj="RGtkObject"), function(obj, toolkit, ID=NULL, ...) { if(is.null(ID)) ID <- tag(obj,"handler.id") lapply(ID, function(i) gSignalHandlerBlock(obj,i)) return() }) ## unblock handler setMethod("unblockhandler", signature("gWidgetRGtk"), function(obj, ID=NULL, ...) { .unblockhandler(obj, obj@toolkit, ID, ...) }) setMethod("unblockhandler", signature("RGtkObject"), function(obj, ID=NULL, ...) { .unblockhandler(obj, guiToolkit("RGtk2"), ID, ...) }) ## camelcase setMethod("unblockHandler", signature("gWidgetRGtk"), function(obj, ID=NULL, ...) { .unblockhandler(obj, obj@toolkit, ID, ...) }) setMethod("unblockHandler", signature("RGtkObject"), function(obj, ID=NULL, ...) { .unblockhandler(obj, guiToolkit("RGtk2"), ID, ...) }) setMethod(".unblockhandler", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gWidgetRGtk"), function(obj, toolkit, ID=NULL, ...) { .unblockhandler(getWidget(obj),toolkit,ID,...) }) setMethod(".unblockhandler", signature(toolkit="guiWidgetsToolkitRGtk2",obj="RGtkObject"), function(obj, toolkit, ID=NULL, ...) { if(is.null(ID)) ID <- tag(obj,"handler.id") sapply(ID, function(i) gSignalHandlerUnblock(obj,i)) return() }) ## addhandlerchanged setMethod("addhandlerchanged",signature(obj="gWidgetRGtk"), function(obj, handler=NULL, action=NULL, ...) { .addhandlerchanged(obj, obj@toolkit, handler, action, ...) }) setMethod("addhandlerchanged",signature(obj="RGtkObject"), function(obj, handler=NULL, action=NULL, ...) { .addhandlerchanged(obj, guiToolkit("RGtk2"), handler, action, ...) }) setMethod("addhandlerchanged",signature(obj="ANY"), function(obj, handler=NULL, action=NULL, ...) { warning("No method addhandlerchanged for object of class",class(obj),"\n") }) ## caps setMethod("addHandlerChanged",signature(obj="gWidgetRGtk"), function(obj, handler=NULL, action=NULL, ...) { .addhandlerchanged(obj, obj@toolkit, handler, action, ...) }) setMethod("addHandlerChanged",signature(obj="RGtkObject"), function(obj, handler=NULL, action=NULL, ...) { .addhandlerchanged(obj, guiToolkit("RGtk2"), handler, action, ...) }) setMethod(".addhandlerchanged", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gWidgetRGtk"), function(obj, toolkit, handler, action=NULL, ...) { .addHandler(obj, toolkit, signal="changed", handler=handler, action=action, ...) }) ## expose: expose-event or realize setMethod("addhandlerexpose",signature(obj="gWidgetRGtk"), function(obj, handler=NULL, action=NULL, ...) { .addhandlerexpose(obj,obj@toolkit,handler, action, ...) }) setMethod("addhandlerexpose",signature(obj="RGtkObject"), function(obj, handler=NULL, action=NULL, ...) { .addhandlerexpose(obj, guiToolkit("RGtk2"), handler, action, ...) }) setMethod(".addhandlerexpose", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gWidgetRGtk"), function(obj, toolkit, handler, action=NULL, ...) { .addHandler(obj, toolkit, signal="expose-event", handler=handler, action=action, ...) }) setMethod(".addhandlerexpose", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gComponentRGtk"), function(obj, toolkit, handler, action=NULL, ...) { .addHandler(obj,toolkit, signal="realize", handler=handler, action=action, ...) }) ## unrealize: unrealize setMethod("addhandlerunrealize",signature(obj="gWidgetRGtk"), function(obj, handler=NULL, action=NULL, ...) { .addhandlerunrealize(obj, obj@toolkit,handler, action, ...) }) setMethod("addhandlerunrealize",signature(obj="RGtkObject"), function(obj, handler=NULL, action=NULL, ...) { .addhandlerunrealize(obj, guiToolkit("RGtk2"),handler, action, ...) }) setMethod(".addhandlerunrealize", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gWidgetRGtk"), function(obj, toolkit, handler, action=NULL, ...) { .addHandler(obj, toolkit, signal="unrealize", handler=handler, action=action, ...) }) ## destroy: destroy setMethod("addhandlerdestroy",signature(obj="gWidgetRGtk"), function(obj, handler=NULL, action=NULL, ...) { .addhandlerdestroy(obj, obj@toolkit,handler, action, ...) }) setMethod("addhandlerdestroy",signature(obj="RGtkObject"), function(obj, handler=NULL, action=NULL, ...) { .addhandlerdestroy(obj, guiToolkit("RGtk2"),handler, action, ...) }) setMethod(".addhandlerdestroy", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gWidgetRGtk"), function(obj, toolkit, handler, action=NULL, ...) { ## See ## http://www.moeraki.com/pygtktutorial/pygtk2tutorial/sec-SteppingThroughHelloWorld.html ## for difference between "destroy" and "delete-event" .addHandler(obj, toolkit, signal="destroy", handler=handler, action=action, ...) }) ## keystroke: changed setMethod("addhandlerkeystroke",signature(obj="gWidgetRGtk"), function(obj, handler=NULL, action=NULL, ...) { .addhandlerkeystroke(obj, obj@toolkit,handler, action, ...) }) setMethod("addhandlerkeystroke",signature(obj="RGtkObject"), function(obj, handler=NULL, action=NULL, ...) { .addhandlerkeystroke(obj, guiToolkit("RGtk2"),handler, action, ...) }) setMethod(".addhandlerkeystroke", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gWidgetRGtk"), function(obj, toolkit, handler, action=NULL, ...) { .addHandler(obj, toolkit, signal="changed", handler=handler, action=action, ...) }) ## clicked: clicked setMethod("addhandlerclicked",signature(obj="gWidgetRGtk"), function(obj, handler=NULL, action=NULL, ...) { .addhandlerclicked(obj, obj@toolkit,handler, action, ...) }) setMethod("addhandlerclicked",signature(obj="RGtkObject"), function(obj, handler=NULL, action=NULL, ...) { .addhandlerclicked(obj, guiToolkit("RGtk2"),handler, action, ...) }) ## caps setMethod("addHandlerClicked",signature(obj="gWidgetRGtk"), function(obj, handler=NULL, action=NULL, ...) { .addhandlerclicked(obj, obj@toolkit,handler, action, ...) }) setMethod("addHandlerClicked",signature(obj="RGtkObject"), function(obj, handler=NULL, action=NULL, ...) { .addhandlerclicked(obj, guiToolkit("RGtk2"),handler, action, ...) }) setMethod(".addhandlerclicked", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gWidgetRGtk"), function(obj, toolkit, handler, action=NULL, ...) { .addHandler(obj, toolkit, signal="clicked", handler=handler, action=action, ...) }) setMethod(".addhandlerclicked", signature(toolkit="guiWidgetsToolkitRGtk2",obj="RGtkObject"), function(obj, toolkit, handler, action=NULL, ...) { .addHandler(obj, toolkit, signal="clicked", handler=handler, action=action, ...) }) ## doubleclick: no default setMethod("addhandlerdoubleclick",signature(obj="gWidgetRGtk"), function(obj, handler=NULL, action=NULL, ...) { .addhandlerdoubleclick(obj,obj@toolkit,handler, action, ...) }) setMethod("addhandlerdoubleclick",signature(obj="RGtkObject"), function(obj, handler=NULL, action=NULL, ...) { .addhandlerdoubleclick(obj,guiToolkit("RGtk2"),handler, action, ...) }) ## caps setMethod("addHandlerDoubleclick",signature(obj="gWidgetRGtk"), function(obj, handler=NULL, action=NULL, ...) { .addhandlerdoubleclick(obj, obj@toolkit,handler, action, ...) }) setMethod("addHandlerDoubleclick",signature(obj="RGtkObject"), function(obj, handler=NULL, action=NULL, ...) { .addhandlerdoubleclick(obj, guiToolkit("RGtk2"),handler, action, ...) }) setMethod(".addhandlerdoubleclick", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gWidgetRGtk"), function(obj, toolkit, handler, action=NULL, ...) { warning("No default handler for double click") }) ## rightclick: button-press-event -- handle separately setMethod("addhandlerrightclick",signature(obj="gWidgetRGtk"), function(obj, handler=NULL, action=NULL, ...) { .addhandlerrightclick(obj,obj@toolkit,handler, action, ...) }) setMethod("addhandlerrightclick",signature(obj="RGtkObject"), function(obj, handler=NULL, action=NULL, ...) { .addhandlerrightclick(obj,guiToolkit("RGtk2"),handler, action, ...) }) ## caps setMethod("addHandlerRightclick",signature(obj="gWidgetRGtk"), function(obj, handler=NULL, action=NULL, ...) { .addhandlerrightclick(obj, obj@toolkit,handler, action, ...) }) setMethod("addHandlerRightclick",signature(obj="RGtkObject"), function(obj, handler=NULL, action=NULL, ...) { .addhandlerrightclick(obj, guiToolkit("RGtk2"),handler, action, ...) }) ## use actualobj=obj to pass in a different obj to h$obj ## use actualobj=obj to pass in a different obj to h$obj setMethod(".addhandlerrightclick", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gWidgetRGtk"), function(obj, toolkit, handler, action=NULL, ...) { .addhandlerrightclick(getWidget(obj), toolkit, handler, action, actualobj=obj,...) }) setMethod(".addhandlerrightclick", # signature(toolkit="guiWidgetsToolkitRGtk2",obj="gWidgetRGtk"), signature(toolkit="guiWidgetsToolkitRGtk2",obj="RGtkObject"), function(obj, toolkit, handler, action=NULL, ..., after=FALSE) { theArgs = list(...) ## fix value passed into gWidgets handlers h <- list() h$handler <- handler h$obj <- obj if(!is.null(theArgs$actualobj)) { h$obj <- theArgs$actualobj theArgs$actualobj <- NULL } ## pass in extra values, eg addHandlerClicked(obj, f=FUN, extra=value) will h$extra key if(length(theArgs)) for(i in names(theArgs)) h[[i]] <- theArgs[[i]] h$action <- action gtktry(connectSignal(getWidget(obj), signal = "button-press-event", f = function(h, w, eventButton,...) { if(isRightMouseClick(eventButton)) { h$handler(h,w, eventButton, ...) } return(FALSE) # stop propagation }, data = h, user.data.first = TRUE, after = after ), silent=TRUE) }) ### Column click things ## click: no default setMethod("addhandlercolumnclicked",signature(obj="gWidgetRGtk"), function(obj, handler=NULL, action=NULL, ...) { .addhandlercolumnclicked(obj,obj@toolkit,handler, action, ...) }) setMethod("addhandlercolumnclicked",signature(obj="RGtkObject"), function(obj, handler=NULL, action=NULL, ...) { .addhandlercolumnclicked(obj,guiToolkit("RGtk2"),handler, action, ...) }) setMethod("addHandlerColumnClicked",signature(obj="gWidgetRGtk"), function(obj, handler=NULL, action=NULL, ...) { .addhandlercolumnclicked(obj, obj@toolkit,handler, action, ...) }) setMethod("addHandlerColumnClicked",signature(obj="RGtkObject"), function(obj, handler=NULL, action=NULL, ...) { .addhandlercolumnclicked(obj, guiToolkit("RGtk2"),handler, action, ...) }) ## doubleclick: no default setMethod("addhandlercolumndoubleclick",signature(obj="gWidgetRGtk"), function(obj, handler=NULL, action=NULL, ...) { .addhandlercolumndoubleclick(obj,obj@toolkit,handler, action, ...) }) setMethod("addhandlercolumndoubleclick",signature(obj="RGtkObject"), function(obj, handler=NULL, action=NULL, ...) { .addhandlercolumndoubleclick(obj,guiToolkit("RGtk2"),handler, action, ...) }) setMethod("addHandlerColumnDoubleclick",signature(obj="gWidgetRGtk"), function(obj, handler=NULL, action=NULL, ...) { .addhandlercolumndoubleclick(obj, obj@toolkit,handler, action, ...) }) setMethod("addHandlerColumnDoubleclick",signature(obj="RGtkObject"), function(obj, handler=NULL, action=NULL, ...) { .addhandlercolumndoubleclick(obj, guiToolkit("RGtk2"),handler, action, ...) }) ## rightclick setMethod("addhandlercolumnrightclick",signature(obj="gWidgetRGtk"), function(obj, handler=NULL, action=NULL, ...) { .addhandlercolumnrightclick(obj,obj@toolkit,handler, action, ...) }) setMethod("addhandlercolumnrightclick",signature(obj="RGtkObject"), function(obj, handler=NULL, action=NULL, ...) { .addhandlercolumnrightclick(obj,guiToolkit("RGtk2"),handler, action, ...) }) setMethod("addHandlerColumnRightclick",signature(obj="gWidgetRGtk"), function(obj, handler=NULL, action=NULL, ...) { .addhandlercolumnrightclick(obj, obj@toolkit,handler, action, ...) }) setMethod("addHandlerColumnRightclick",signature(obj="RGtkObject"), function(obj, handler=NULL, action=NULL, ...) { .addhandlercolumnrightclick(obj, guiToolkit("RGtk2"),handler, action, ...) }) ## focus -- on focus call this setMethod("addhandlerfocus",signature(obj="gWidgetRGtk"), function(obj, handler=NULL, action=NULL, ...) { .addhandlerfocus(obj,obj@toolkit,handler, action, ...) }) setMethod("addhandlerfocus",signature(obj="RGtkObject"), function(obj, handler=NULL, action=NULL, ...) { .addhandlerfocus(obj,guiToolkit("RGtk2"),handler, action, ...) }) setMethod(".addhandlerfocus", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gWidgetRGtk"), function(obj, toolkit, handler, action=NULL, ...) { .addHandler(obj,toolkit, signal="focus-in-event", handler, action, ...) }) ## blur -- leave focus setMethod("addhandlerblur",signature(obj="gWidgetRGtk"), function(obj, handler=NULL, action=NULL, ...) { .addhandlerblur(obj,obj@toolkit,handler, action, ...) }) setMethod("addhandlerblur",signature(obj="RGtkObject"), function(obj, handler=NULL, action=NULL, ...) { .addhandlerblur(obj,guiToolkit("RGtk2"),handler, action, ...) }) setMethod(".addhandlerblur", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gWidgetRGtk"), function(obj, toolkit, handler, action=NULL, ...) { ## blur handler should return FALSE f <- function(h,...) { handler(h,...) return(FALSE) } .addHandler(obj,toolkit, signal="focus-out-event", f, action, ...) }) ## ## mousemotion -- like mouseover setMethod("addhandlermousemotion",signature(obj="gWidgetRGtk"), function(obj, handler=NULL, action=NULL, ...) { .addhandlermousemotion(obj,obj@toolkit,handler, action, ...) }) setMethod("addhandlermousemotion",signature(obj="RGtkObject"), function(obj, handler=NULL, action=NULL, ...) { .addhandlermousemotion(obj,guiToolkit("RGtk2"),handler, action, ...) }) setMethod(".addhandlermousemotion", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gWidgetRGtk"), function(obj, toolkit, handler, action=NULL, ...) { .addHandler(obj,guiToolkit("RGtk2"), signal="enter-notify-event", handler, action, ...) }) ## idle setMethod("addhandleridle",signature(obj="gWidgetRGtk"), function(obj, handler=NULL, action=NULL, interval=1000, ...) { .addhandleridle(obj, obj@toolkit, handler=handler, action=action, interval=interval, ...) }) setMethod("addhandleridle",signature(obj="RGtkObject"), function(obj, handler=NULL, action=NULL, interval=1000, ...) { .addhandleridle(obj, guiToolkit("RGtk2"), handler=handler, action=action, interval=interval, ...) }) setMethod(".addhandleridle", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gWidgetRGtk"), function(obj, toolkit, handler=NULL, action=NULL, interval=1000, ...) { idlehandler = function(h,...) { if(!is.null(h$handler) && is.function(h$handler)) h$handler(h,...) invisible(TRUE) } ## ID = gtkAddTimeout( ID = gTimeoutAdd( interval, idlehandler, data=list(obj=obj, action=action, handler=handler) ) ## tidy up when done .addhandlerdestroy(obj,toolkit, handler=function(h,...) { # gtkRemoveTimeout(h$action) gSourceRemove(h$action) },action=ID) invisible(ID) }) ## addpopumenu setMethod("addpopupmenu",signature(obj="gWidgetRGtk"), function(obj, menulist, action=NULL, ...) { .addpopupmenu(obj, obj@toolkit,menulist, action, ...) }) setMethod("addpopupmenu",signature(obj="RGtkObject"), function(obj, menulist, action=NULL, ...) { .addpopupmenu(obj, guiToolkit("RGtk2"), menulist, action, ...) }) ## this does not get exported addPopupMenuWithSignal = function(obj, toolkit, menulist, action=NULL, signal="button-press-event", ...) { theArgs = list(...) f = function(h, ...) { mb = gmenu(h$action, popup = TRUE) event = gdkEventNew(GdkEventType["button-press"]) mb = tag(mb,"mb") # the real menu bar gtkMenuPopupHack(mb, button = event$GetButton(), activate.time=event$GetTime() ) } ## .addhandler not exported callbackID = .addHandler(obj,toolkit, signal = signal,handler=f, action=menulist) invisible(callbackID) } add3rdMousePopupMenuWithSignal = function(obj, toolkit, menulist, action=NULL, signal="button-press-event", ...) { f = function(h, widget, event,...) { ## Mac use ctrl - button 1 if(isRightMouseClick(event)) { mb = gmenu(h$action$menulist, popup = TRUE, action=h$action$passedaction) mb = tag(mb,"mb") # actual widget gtkMenuPopupHack(mb,button = event$GetButton(), activate.time=event$GetTime() ) return(FALSE) } else { return(FALSE) } } callbackID = .addHandler(obj,toolkit, signal = "button-press-event",handler=f, action=list(menulist=menulist, passedaction=action)) invisible(callbackID) } ### need to deal with action setMethod(".addpopupmenu", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gWidgetRGtk"), function(obj, toolkit, menulist, action=NULL, ...) { addPopupMenuWithSignal(obj, toolkit, menulist, ...) }) ## add3rdmousepopupmenu setMethod("add3rdmousepopupmenu",signature(obj="gWidgetRGtk"), function(obj, menulist, action=NULL, ...) { .add3rdmousepopupmenu(obj, obj@toolkit,menulist, action, ...) }) setMethod("add3rdmousepopupmenu",signature(obj="RGtkObject"), function(obj, menulist, action=NULL,...) { .add3rdmousepopupmenu(obj, guiToolkit("RGtk2"),menulist, action,...) }) setMethod(".add3rdmousepopupmenu", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gWidgetRGtk"), function(obj, toolkit, menulist,action=NULL, ...) { add3rdMousePopupMenuWithSignal(obj, toolkit, menulist, action, ...) }) setMethod(".add3rdmousepopupmenu", signature(toolkit="guiWidgetsToolkitRGtk2",obj="RGtkObject"), function(obj, toolkit, menulist, action=NULL, ...) { add3rdMousePopupMenuWithSignal(obj, toolkit, menulist, action, ...) }) ## "dotmethods" defined in dnd.R ## adddropsource setMethod("adddropsource",signature(obj="gWidgetRGtk"), function(obj, targetType="text", handler=NULL, action=NULL, ...) { .adddropsource(obj, obj@toolkit,targetType=targetType, handler=handler, action=action, ...) }) setMethod("adddropsource",signature(obj="RGtkObject"), function(obj, targetType="text", handler=NULL, action=NULL, ...) { .adddropsource(obj, guiToolkit("RGtk2"),targetType=targetType, handler=handler, action=action, ...) }) ## adddropmotion setMethod("adddropmotion",signature(obj="gWidgetRGtk"), function(obj, handler=NULL, action=NULL, ...) { .adddropmotion(obj, obj@toolkit, handler=handler, action=action, ...) }) setMethod("adddropmotion",signature(obj="RGtkObject"), function(obj, handler=NULL, action=NULL, ...) { .adddropmotion(obj, guiToolkit("RGtk2"), handler=handler, action=action, ...) }) ## adddroptarget setMethod("adddroptarget",signature(obj="gWidgetRGtk"), function(obj, targetType="text", handler=NULL, action=NULL, ...) { .adddroptarget(obj, obj@toolkit,targetType=targetType, handler=handler, action=action, ...) }) setMethod("adddroptarget",signature(obj="RGtkObject"), function(obj, targetType="text", handler=NULL, action=NULL, ...) { .adddroptarget(obj, guiToolkit("RGtk2"),targetType=targetType, handler=handler, action=action, ...) }) ## R Methods setMethod("dim", "gWidgetRGtk", function(x) .dim(x,x@toolkit)) setMethod("length", "gWidgetRGtk", function(x) .length(x,x@toolkit)) setMethod(".length", signature(toolkit="guiWidgetsToolkitRGtk2",x="gWidgetRGtk"), function(x,toolkit) { return(NA) gwCat(sprintf("Define length for x of class: %s\n", class(x)[1])) }) setMethod("dimnames", "gWidgetRGtk", function(x) .dimnames(x,x@toolkit)) setReplaceMethod("dimnames", signature(x="gWidgetRGtk"), function(x,value) { .dimnames(x,x@toolkit) <- value return(x) }) ## as of 2.5.0 this became primiive if(as.numeric(R.Version()$major) <= 2 & as.numeric(R.Version()$minor) <= 4.1) { setGeneric("names") setGeneric("names<-") } setMethod("names", "gWidgetRGtk", function(x) .names(x,x@toolkit)) setReplaceMethod("names", signature(x="gWidgetRGtk"), function(x,value) { .names(x,x@toolkit) <- value return(x) }) #### This may be useful to integrate gWidgets with glade #### ## S3 class for coercing to gWidget as.gWidgetsRGtk2 <- function(widget,...) UseMethod("as.gWidgetsRGtk2") as.gWidgetsRGtk2.default <- function(widget,...) { print(sprintf("No coercion to gWidget available for object of class %s",class(widget))) return(widget) } gWidgetsRGtk2/R/gcommandline.R0000644000175100001440000003215111515621112015675 0ustar hornikusers## command line widget ## toggles between gtext() instances containing text to edit, and output to display. setClass("gCommandlineRGtk", representation=representation("gComponentRGtk", textGroup="guiWidget", editText="guiWidget", showText="guiWidget", textGroupState="character", editButton="guiWidget", clearButton="guiWidget", runButton="guiWidget", historyButton="guiWidget", width="numeric", height="numeric", prompt="character", useGUI = "logical", useConsole="logical"), contains="gComponentRGtk", prototype=prototype(new("gComponentRGtk")) ) ## constructor setMethod(".gcommandline", signature(toolkit="guiWidgetsToolkitRGtk2"), function(toolkit, command = "", assignto=NULL, useGUI = TRUE, useConsole = FALSE, prompt = getOption("prompt"), width = 500, height = .6*width, container = NULL, ...) { force(toolkit) ## adjust command if need be if(nchar(command) > 0 && !is.null(assignto)) command = addAssignto(command, assignto) ## if(useGUI == FALSE) { container = NULL } ## the main widgets group = ggroup(horizontal = FALSE, container = container, ...) toolbarGroup = ggroup(container=group, spacing = 0) textGroup = ggroup() # holds editText or showText add(group, textGroup, expand=TRUE) editText = gtext() showText = gtext() ## set up widget, ## toolbar ## the handlers openFile = function(h,...) { icl = h$action gfile("Select a file to read into command line", type="open", action = icl, handler = function(h,...) { file = h$file tmp = tag(icl,"editText") svalue(tmp) <- readLines(file) if(tag(icl,"textGroupState") != "edit") { delete(tag(icl,"textGroup"), tag(icl,"showText")) add(tag(icl,"textGroup"), tag(icl,"editText"), expand=TRUE) ## adjust buttons enabled(runButton) <- TRUE enabled(historyButton) <- TRUE enabled(clearButton) <- TRUE enabled(editButton) <- FALSE ## set focus on editText?? } }) } saveFile = function(h,...) { icl = h$action win = gwindow("Save buffer contents", toolkit=toolkit) group = ggroup(horizontal=FALSE, container=win) saveFileName = gfilebrowse("",type="save", container = group) gp = ggroup(container=group) glabel("Save which values?", container=gp) saveType = gradio(c("commands","output"), index=FALSE, container=gp) gseparator(container=group) buttonGroup = ggroup(container=group) addSpring(buttonGroup) gbutton("save",handler=function(h,...) { filename = svalue(saveFileName) if(is.empty(filename)) { cat(gettext("Need file to save to\n")) return() } if(svalue(saveType) == "commands") values = svalue(tag(icl,"editText")) else values = svalue(tag(icl,"showText")) ## strop quotes off filename filename = gsub("^'","", filename) filename = gsub("'$","", filename) filename = gsub('^"',"", filename) filename = gsub('"$',"", filename) err = gtktry(writeLines(values, filename),silent=TRUE) if(inherits(err, "try-error")) { cat(sprintf("Saving gave an error: %s\n",err)) } dispose(win) }, container=buttonGroup) } editCode = function(h,...) { icl = h$action ## switch widgets delete(tag(icl,"textGroup"), tag(icl,"showText")) add(tag(icl,"textGroup"), tag(icl,"editText"), expand=TRUE) tag(icl,"textGroupState") <- "edit" enabled(runButton) <- TRUE enabled(historyButton) <- TRUE enabled(clearButton) <- TRUE enabled(editButton) <- FALSE ## set focus on editText? } runCode = function(h,...) { icl = h$action chunk = svalue(tag(icl,"editText")) svalue(icl) <- chunk } selectHistory = function(h,...) { previous = svalue(h$action, index=25) if(length(previous) == 0) { cat(gettext("No previous commandline history\n")) return() } win = gwindow("Select a previous value", visible=TRUE) group = ggroup(horizontal = FALSE, container = win) add(group, glabel("double click selection")) theHistory = gtable(previous, action = h$action, handler = function(h,...) { newcommand = svalue(h$obj) icl = h$action svalue(tag(icl,"editText"), font.attr = c(style="monospace")) <- newcommand ## set focus on editText? dispose(win) }) add(group, theHistory, expand=TRUE) buttonGroup = ggroup(container=group) addSpring(buttonGroup) add(buttonGroup, gbutton("cancel",handler = function(h,...) dispose(win))) } ## pack into widget add(textGroup, editText, expand=TRUE) ## toolbars sourceButton = gbutton("open", container=toolbarGroup) saveButton = gbutton("save", container = toolbarGroup) editButton = gbutton("edit", container = toolbarGroup) clearButton = gbutton("clear",container = toolbarGroup) runButton = gbutton("evaluate", container = toolbarGroup) historyButton = gbutton("history", container= toolbarGroup) obj = new("gCommandlineRGtk", block=group, widget = group, toolkit=toolkit, textGroup = textGroup, editText = editText, showText = showText, textGroupState = "edit", editButton = editButton, clearButton=clearButton, runButton = runButton, historyButton = historyButton, width=width, height=height, prompt =prompt, useGUI = useGUI, useConsole = useConsole) tag(obj,"showText")<-showText tag(obj,"editText")<-editText # delete doesn't work if it makes copis using @ slot tag(obj,"textGroup") <- textGroup tag(obj,"textGroupState") <- "edit" ## add handlers to buttons addhandlerclicked(sourceButton, handler = openFile, action=obj) addhandlerclicked(saveButton, handler = saveFile, action=obj) addhandlerclicked(editButton, handler = editCode, action=obj) addhandlerclicked(clearButton, action=obj, function(h,...) dispose(h$action@editText)) addhandlerclicked(runButton, handler = runCode, action=obj) addhandlerclicked(historyButton, handler = selectHistory, action=obj) ## initialize history tag(obj,"history") <- c() ## initialize state: used to check if swap is needed tag(obj,"textGroupState") <- "edit" ## which text widget? if(command == "") { enabled(editButton) <- TRUE } else { #svalue(editText) <- command svalue(obj) <- command } return(obj) }) ### Methods ## return all previous, or just the index most recent setMethod(".svalue", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gCommandlineRGtk"), function(obj, toolkit, index=NULL, drop=NULL, ...) { theArgs = list(...); commandHistory = tag(obj,"history") if(length(commandHistory) == 0) return(c()) if(is.null(index)) { return(commandHistory) } else { n = length(commandHistory) m = max(1, n - index + 1) return(rev(commandHistory[m:n])) } }) ## evaluate command, store in history, swqp out widgets setReplaceMethod(".svalue", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gCommandlineRGtk"), function(obj, toolkit, index=NULL, ..., value) { ## get commane command = value; assignto = names(value) if(!is.null(assignto)) { command = addAssignto(command, assignto) } if(obj@useGUI) svalue(obj@editText,font.attr = c(style="monospace")) <- command ## add to history tag(obj, "history", replace=FALSE) <- command evalChunk(command, obj@showText, obj@prompt, obj@useConsole, obj@useGUI) ## switch widgets -- if not correct textGroupState = tag(obj,"textGroupState") if(!is.null(textGroupState) && textGroupState == "edit") { delete(tag(obj,"textGroup"), tag(obj,"editText")) add(tag(obj,"textGroup"), tag(obj,"showText"), expand=TRUE) } tag(obj,"textGroupState") <- "text" enabled(tag(obj,"showText")) <- FALSE # no editing of this display enabled(obj@runButton) <- FALSE enabled(obj@historyButton) <- FALSE enabled(obj@editButton) <- TRUE enabled(obj@clearButton) <- FALSE return(obj) }) ## history function setMethod("[", signature(x="gCommandlineRGtk"), function(x, i, j, ..., drop=TRUE) { .leftBracket(x, x@toolkit, i, j, ..., drop=drop) }) setMethod(".leftBracket", signature(toolkit="guiWidgetsToolkitRGtk2",x="gCommandlineRGtk"), function(x, toolkit, i, j, ..., drop=TRUE) { history = tag(x, "history") if(missing(i)) return(history) else history(i) }) ### working functions ## parse command(s) and make assingment on last one. addAssignto = function(command,assignto) { assignto = make.names(assignto) tmp = unlist(strsplit(command, ";")) if(length(tmp)>1) { command = paste(tmp[-length(tmp)], Paste(assignto,"<-",tmp[length(tmp)]), collapse=";", sep=";") } else { command = Paste(assignto,"<-", command) } return(command) } ## taken from Sweave ## takes a chunk, iterweaves command and output evalChunk = function(chunk, widget, prompt = getOption("prompt"), useConsole=FALSE, useGUI = TRUE) { svalue(widget) <- "" # clear out chunkexps <- gtktry(parse(text=chunk), silent=TRUE) if(inherits(chunkexps,"try-error")) { if(useGUI) add(widget, chunkexps, font.attr = c(style="monospace")) # addTextWidget(widget, chunkexps) cat(sprintf("Houston, we have a problem with: %s\n",chunk)) return(c()) } if(length(chunkexps) == 0) return(c()) # output = c() for(nce in 1:length(chunkexps)) { ce <- chunkexps[[nce]] dce <- deparse(ce, width.cutoff=0.75*getOption("width")) command = Paste(prompt, paste(dce,collapse=paste("\n", getOption("continue"), sep="")) ) if(useGUI) add(widget, command, font.attr = c(style="monospace",color="red",weight="italic")) if(useConsole) cat(command,"\n") ## is there output? tmpcon <- file() sink(file=tmpcon) err <- RweaveEvalWithOpt(ce, list(eval=TRUE,print=FALSE,term=TRUE,visible=FALSE)) cat("\n") # make sure final line is complete sink() theOutput <- readLines(tmpcon) close(tmpcon) ## delete empty output if(length(theOutput)==1 & theOutput[1]=="") theOutput <- NULL if(inherits(err, "try-error")) { if(useGUI) add(widget, err, font.attr=c(style="monospace",color="red",weight="bold")) if(useConsole) cat(err,"\n") } else { if(!is.null(theOutput)) { if(useGUI) add(widget, theOutput, font.attr = c(style="monospace")) if(useConsole) cat(paste(theOutput,sep="",collapse="\n"),"\n") } } } } gWidgetsRGtk2/R/gdfedit.R0000644000175100001440000002105613216523547014665 0ustar hornikusers # Constructor for gdfedit widget # # gdfedit is a light-weight interface to RGtk2Extra's excellent data editor widget by Thomas Taverner gdfedit <- function( items = NULL, name = paste(deparse(substitute(items)), "1", sep="."), container = NULL, ... , toolkit=guiToolkit() ) { widget <- .gdfedit (toolkit, items=items, name=name, container=container ,...) obj <- new( 'guiComponent', widget=widget, toolkit=toolkit) return(obj) } # class for the widget setClass("gDfEditRGtk", contains="gComponentRGtk", prototype=prototype(new("gComponentRGtk")) ) # generic for toolkit dispatch setGeneric( '.gdfedit' , function(toolkit, items = NULL, name = paste(deparse(substitute(items)),"1", sep="."), container = NULL, ... ) standardGeneric( '.gdfedit' )) # gWidgetsRGtk2 interface to constructor setMethod(".gdfedit", signature(toolkit="guiWidgetsToolkitRGtk2"), function(toolkit, items=NULL, name, container=NULL,...) { ## main constructor ## should define so that getToolkitWidget() returns the gdfedit object ## load package RGtk2DfEdit and RGtk2 but get passed R CMD check by cheating gtkDfEdit <- NULL if(!do.call("require",list("RGtk2Extras"))) stop(sprintf("Must have %s package installed", "RGtk2Extras")) do.call("require", list("RGtk2")) widget <- gtkDfEdit(items, dataset.name=name) ## how to add obj <- new("gDfEditRGtk", block=widget, widget=widget, toolkit=toolkit) if(!is.null(container)) { if(is.logical(container) && container) { container <- gwindow() add(container, obj) } else { add(container, obj, ...) } } return(obj) }) ## needed when adding as child setOldClass("GtkDfEdit") setMethod(".tag", signature(toolkit="guiWidgetsToolkitRGtk2",obj="GtkDfEdit"), function(obj, toolkit, i, drop=TRUE, ...) { NULL }) ## data frame methods # return selected value setMethod(".svalue", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gDfEditRGtk"), function(obj, toolkit, index=NULL, drop=NULL,...) { object <- getWidget(obj) df <- object$getDataFrame() sel <- object$getSelection() if(!is.null(index) && as.logical(index)) { return(sel$rows) } if(!is.null(drop) && as.logical(drop)) { ## use columns return(df[sel$rows, sel$columns]) } else { return(df[sel$rows, ]) } }) ## ## set by index value selected value ## ## not sure what this is to do? ## setReplaceMethod(".svalue", ## signature(toolkit="guiWidgetsToolkitRGtk2",obj="gDfEditRGtk"), ## function(obj, toolkit, index=NULL, ..., value) { ## ## ??? might just skip this ## return(obj) ## }) setMethod("[", signature(x="gDfEditRGtk"), function(x, i, j, ..., drop=TRUE) { .leftBracket(x, x@toolkit, i, j,..., drop=drop) }) setMethod(".leftBracket", signature(toolkit="guiWidgetsToolkitRGtk2",x="gDfEditRGtk"), function(x, toolkit, i, j, ..., drop=TRUE) { object <- getWidget(x) df <- object$getDataFrame() if(missing(i) && missing(j)) df[,,drop=drop] else if (missing(j)) df[i,,drop=drop] else if(missing(i)) df[,j, drop=drop] else df[i,j, drop=drop] }) ## [<- setReplaceMethod("[", signature(x="gDfEditRGtk"), function(x, i, j,..., value) { x <- .leftBracket(x, x@toolkit, i, j,..., value) return(x) }) # Method for [<- # really needs to have check on column type setReplaceMethod(".leftBracket", signature(toolkit="guiWidgetsToolkitRGtk2",x="gDfEditRGtk"), function(x, toolkit, i, j, ..., value) { ## we could implement -- but only if we do not change the class of the object df <- getWidget(x)$getModel() if(missing(i)) i <- seq_len(dim(x)[1]) if(missing(j)) j <- seq_len(dim(x)[2]) ## logical to index if(is.logical(i)) i <- seq_along(i)[i] if(is.logical(j)) j <- seq_along(j)[j] ## value if vector if(is.null(dim(value))) { if(length(j) != 1) { cat(sprintf("Dimension of value does not match that of j\n")) return(x) } try(df[i, 1 + j] <- value, silent=TRUE) return(x) } ## value is not vector if(dim(value)[1] != length(i) || dim(value)[2] != length(j)) { cat(sprintf("Dimension of value does not match that of i or j\n")) return(x) } ## fill in column by column sapply(seq_along(j), function(l) { try(df[i, 1 + j[l]] <- value[,j], silent=TRUE) }) return(x) }) ## data frame like setMethod(".dim", signature(toolkit="guiWidgetsToolkitRGtk2",x="gDfEditRGtk"), function(x,toolkit) { ## basically: object <- getWidget(x) data.model <- object$getDataFrame() dim(data.model) }) setMethod(".length", signature(toolkit="guiWidgetsToolkitRGtk2",x="gDfEditRGtk"), function(x,toolkit) { d <- dim(x) return(d[2]) }) setMethod(".dimnames", signature(toolkit="guiWidgetsToolkitRGtk2",x="gDfEditRGtk"), function(x, toolkit) { ## object <- getWidget(x) rnames <- object$getRowNames() cnames <- object$getColumnNames() list(rnames, cnames) }) setReplaceMethod(".dimnames", signature(toolkit="guiWidgetsToolkitRGtk2",x="gDfEditRGtk"), function(x, toolkit, value) { object <- getWidget(x) ## rnames <- value[[1]] cnames <- value[[2]] if(!is.null(rnames)) { model <- object$getModel() model[,1] <- rnames } if(!is.null(cnames)) { sapply(seq_along(cnames), function(i) { object$setColumnName(i, cnames[i]) }) } ## x }) setMethod(".names", signature(toolkit="guiWidgetsToolkitRGtk2",x="gDfEditRGtk"), function(x, toolkit) { dimnames(x)[[2]] }) setReplaceMethod(".names", signature(toolkit="guiWidgetsToolkitRGtk2",x="gDfEditRGtk"), function(x, toolkit, value) { object <- getWidget(x) sapply(seq_along(value), function(i) { object$setColumnName(i, value[i]) }) x }) ## handlers to add ## for gdfedit -- change a value # @param handler function to call when column is clicked. Along with usual obj, action, first argument # (typically h) has components df for the data frame, and column.no to return the column number that # was clicked on setMethod(".addhandlercolumnclicked", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gDfEditRGtk"), function(obj, toolkit, handler, action=NULL, ...) { object <- getWidget(obj) f <- function(df, col.idx) { h <- list(obj=obj, action=action, df=df, column.no=col.idx) handler(h) } ## doesn't give back an ID!! object$setColumnClickHandler(f) invisible() }) gWidgetsRGtk2/R/dnd.R0000644000175100001440000002761711726022677014037 0ustar hornikusers # functions to handle DND ## helper, like rawToChar. From R.oo/R/ASCII.R # Alternatively one can do like this. Idea by Peter Dalgaard, # Dept. of Biostatistics, University of Copenhagen, Denmark. ## ASCII <- c("\000", sapply(1:255, function(i) parse(text=paste("\"\\", ## structure(i,class="octmode"), "\"", sep=""))[[1]]) ); ## intToChar = function(i, ...) { ## ASCII[i %% 256 + 1]; ## } ## Brian Ripley says the above will fail as of 2.8.0 version of R. ## So we try this instead intToChar <- function(x) rawToChar(as.raw(x), multiple = TRUE) ## A little buggy right now: drop target had drag-data-received called 2 times ## action argument in addhandler isn't handled properly ## a gross hack to allow objects to be dropped. TARGET.TYPE.TEXT = 80 # TARGET.TYPE.PIXMAP = 81 # NOT IMPLEMENTED TARGET.TYPE.OBJECT = 82 gWidgetTargetTypes = list( text = gtkTargetEntry("text/plain", 0, TARGET.TYPE.TEXT), pixmap = gtkTargetEntry("image/x-pixmap", 0, TARGET.TYPE.PIXMAP), object = gtkTargetEntry("text/plain", 0, TARGET.TYPE.OBJECT) ) ## Part of gross hack to allow objects to be dropped ## hide this list for storing drop information. This is typically a pointer to an RGtkObject ## .gWidgetDropTargetList <- list() .gWidgetDropTargetList <- new.env() .gWidgetDropTargetListKey = ".gWidgetDropTargetListKey" # goes in front DropList <- setRefClass("DropList", fields=list( l="list" ), methods=list( initialize=function(...) { initFields(l=list()) callSuper(...) }, set_key=function(key, value) { l[[key]] <<- value }, get_key=function(key, remove=TRUE) { l[[key]] if(remove) l[[key]] <<- NULL })) ## function used by RGtkObject and gWidgetRGtk addDropSource = function(obj, toolkit, targetType="text", handler=NULL, action=NULL, ...) { ## ver = getRGtk2Version() ## too slow! x <- read.dcf(system.file("DESCRIPTION", package="RGtk2")) version <- x[1,'Version'] ver <- strsplit(version,"\\.")[[1]] names(ver) <- c("major","minor","mini?") tmp = gtkDragSourceSet(getWidget(obj), if(ver['major'] == "2" && as.numeric(ver['minor']) < 10) { GdkModifierType[c("button1-mask","button3-mask")] } else { GdkModifierType["button1-mask"] | GdkModifierType["button3-mask"] }, list(gWidgetTargetTypes[[targetType]]), # targets, GdkDragAction["copy"]) ## uses handler in a closure sourceHandler = function(h, widget, context, selection, targetType, eventTime) { ## what gets set in selection gets passed on to drop target if(targetType == TARGET.TYPE.PIXMAP) { ## this is untested! selection$Set(selection$Target(), 8, paste(svalue(h$obj),collapse="\n")) } else if(targetType == TARGET.TYPE.OBJECT) { ## this is tricky! we want to store an object, but selection ## seemingly only likes to store text. So instead we store the ## name of a component in an invisible list we've snuck into the ## globalenvironment. ## This assumes the object you want to sneak into your ## DND is in action argument if(!is.null(action)) { key = Paste(.gWidgetDropTargetListKey,tempfile()) # why not? ## .gWidgetDropTargetList[[key]] <<- action # tmplst = getFromNamespace(".gWidgetDropTargetList", # "gWidgetsRGtk2") tmplst <- .gWidgetDropTargetList[["gWidgetsRGtk2"]] ## the tmplst is empty!! # tmplst[[key]] <- action # .gWidgetDropTargetList[["gWidgetsRGtk2"]] <- tmplst .gWidgetDropTargetList[["gWidgetsRGtk2"]] <- list(key=key, action=action) ## assignInNamespace(".gWidgetDropTargetList", tmplst, ## "gWidgetsRGtk2") selection$SetText(key) } } else { ## it is TEXT type if(is.null(handler)) { value = svalue(h$obj) } else { value = gtktry(handler(h), silent=TRUE) if(inherits(value,"try-error")) { gwCat(sprintf("Error: handler returns: %s\n",value)) } } ## what gets set here is passed to drop target selection$SetText(str=value) } return(TRUE) } ## this gets drag-data-get signal ## action isn't working! (For "object" action is passed in already) theArgs = list(...) id = .addHandler(obj,toolkit,"drag-data-get",sourceHandler,actualobj=theArgs$actualobj)#action=action) invisible(id) } setMethod(".adddropsource", signature(toolkit="guiWidgetsToolkitRGtk2",obj="RGtkObject"), function(obj, toolkit, targetType="text", handler=NULL, action=NULL, ...) { addDropSource(obj, toolkit, targetType, handler, action, ...) }) setMethod(".adddropsource", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gWidgetRGtk"), function(obj, toolkit, targetType="text", handler=NULL, action=NULL, ...) { addDropSource(obj, toolkit, targetType, handler, action, ...) }) ## motino setMethod(".adddropmotion", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gWidgetRGtk"), function(obj, toolkit, handler=NULL, action=NULL, ...) { .addHandler(obj,toolkit, signal="drag-motion",handler, action, ...) }) setMethod(".adddropmotion", signature(toolkit="guiWidgetsToolkitRGtk2",obj="RGtkObject"), function(obj, toolkit, handler=NULL, action=NULL, ...) { .addHandler(obj,toolkit, signal="drag-motion",handler, action, ...) }) ## target -- how to add for RGtkObjects? addDropTarget = function(obj, toolkit, targetType="text", handler=NULL, action=NULL, actualobj = NULL,...) { ## acutalobj is used by glabel to put target onto evb, use obj for svalue() etc. gtkDragDestUnset(getWidget(obj)) tmp = gtkDragDestSet(getWidget(obj), c("GTK_DEST_DEFAULT_ALL"), #targets, list(gWidgetTargetTypes[[targetType]]), GdkDragAction[c("copy")] ) id = NA ## gets handler for closure drophandler = function( h, widget,context, x, y, selection, targetType, eventTime ) { ## override if(!is.null(h$actualobj)) h$obj = h$actualobj ## we would like to filter by target type, but it doesn't ## work right for us, so instead we hack this in. If the ## text has the key in from do onething, otherwise do the other ## get dropdata if(targetType == TARGET.TYPE.OBJECT || targetType == TARGET.TYPE.TEXT) { dropdata = selection$GetText() if(is.integer(dropdata)) dropdata = Paste(intToChar(dropdata)) else dropdata = rawToChar(dropdata) ## is this an actino thingy, or not? if(length(grep(Paste("^",.gWidgetDropTargetListKey), dropdata)) > 0) { ## Dropdata is key, look up value in .gWidgetDropTargetList lst <- .gWidgetDropTargetList[["gWidgetsRGtk2"]] sourceAction <- lst$action ## clear .gWidgetDropTargetList[["gWidgetsRGtk2"]] <- list(key="", action=NULL) ## XXXX ## ## It is an action thing. An object was dropped, not a text value ## sourceAction = .gWidgetDropTargetList[[dropdata]] ## ## .gWidgetDropTargetList[[dropdata]] <<- NULL ## ## tmplst = getFromNamespace(".gWidgetDropTargetList", "gWidgetsRGtk2") ## tmplst <- .gWidgetDropTargetList[["gWidgetsRGtk2"]] ## tmplst[[dropdata]] <- NULL ## ## assignInNamespace(".gWidgetDropTargetList", tmplst, "gWidgetsRGtk2") ## .gWidgetDropTargetList[["gWidgetsRGtk2"]] <- tmplst ## what to do with handler? if(!is.null(handler)) { h$dropdata = sourceAction; h$x = x; h$y = y out = gtktry( handler(h, widget=widget, context=context, x=x, y=y, selection=selection, targetType=targetType, eventTime=eventTime), silent=TRUE) if(inherits(out,"try-error")) { gwCat(sprintf("Error: handler has issue: %s\n",out)) } } else{ gwCat(gettext("No default handler when action object is passed in\n")) } } else { ## this is text case dropdata = gsub(Paste("^",.gWidgetDropTargetListKey),"", dropdata) ## set drop data into object passed to handlers if(!is.null(handler)) { # handler = function(h,...) h$dropdata = dropdata; h$x = x; h$y = y out = gtktry( handler(h ,widget=widget, context=context, x=x, y=y, selection=selection, targetType=targetType, eventTime=eventTime), silent=TRUE) if(inherits(out,"try-error")) { gwCat(sprintf("Error: handler has issue: %s\n",out)) } } else { svalue(h$obj) <- dropdata } } return(TRUE) } else { gwCat(gettext("Nothing defined for this Target type\n")) } } ## Why is pixmap stuff not working? --later ## else if(targetType == TARGET.TYPE.PIXMAP) { ## dropdata = selection$GetPixbuf() ## if(!is.null(handler)) { ## h$dropdata = dropdata; h$x = x; h$y = y ## handler(h,widget=widget, context=context, x=x, y=y, selection=selection, ## targetType=targetType, ## eventTime=eventTime) ## } else { ## cat("No default handler for pixbuf data.\n") ## } ## } ## else { ## ## TARGET.TYPE.TEXT ## dropdata = selection$GetData() ## if(is.integer(dropdata)) ## dropdata = Paste(intToChar(dropdata)) ## else ## dropdata = rawToChar(dropdata) ## ## set drop data into object passed to handlers ## if(!is.null(handler)) { # handler = function(h,...) ## h$dropdata = dropdata; h$x = x; h$y = y ## handler(h,widget=widget, context=context, x=x, y=y, selection=selection, ## targetType=targetType, ## eventTime=eventTime) ## } else { ## svalue(h$obj) <- dropdata ## } ## return(FALSE) ## } ## } ## now add drop handler and return id id = .addHandler(obj,toolkit,"drag-data-received", drophandler, action=action, actualobj=actualobj) invisible(id) } setMethod(".adddroptarget", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gWidgetRGtk"), function(obj, toolkit, targetType="text", handler=NULL, action=NULL, ...) { addDropTarget(obj, toolkit, targetType, handler, action, ...) }) setMethod(".adddroptarget", signature(toolkit="guiWidgetsToolkitRGtk2",obj="RGtkObject"), function(obj, toolkit, targetType="text", handler=NULL, action=NULL, ...) { addDropTarget(obj, toolkit, targetType, handler, action, ...) }) gWidgetsRGtk2/R/gfile.R0000644000175100001440000001531112041117472014331 0ustar hornikusers## file chooser dialog: creates gfile and gfilebrowser setMethod(".gfile", signature(toolkit="guiWidgetsToolkitRGtk2"), function(toolkit, text="", type=c("open","save","selectdir"), initialfilename = NULL, filter = list( "All files"=list( patterns=c("*") ), "R files"=list( patterns=c("*.R","*.Rdata") ), "text files"=list( mime.types=c("text/plain") ) ), multi=FALSE, ## XXX uncomment at some point handler = NULL, action = NULL, # ... ) { force(toolkit) args = list(...) type = match.arg(type) availTypes = c( "open"="open", "save"="save", "selectdir"="select-folder", "createdir"="create-folder" ) actiontype = GtkFileChooserAction[availTypes[type]] buttonWithId = list( "ok"= c("gtk-ok",GtkResponseType["ok"]), "cancel" = c("gtk-cancel",GtkResponseType["cancel"]) ) whichButtons = switch(type, "save"=c("ok","cancel"), "open"=c("ok","cancel"), "selectdir"=c("ok","cancel") ) okhandler.default = function(h,...) { if(is.gComponent(h$action)) { if(!is.null(args$quote)) svalue(h$action) <- Paste("'",h$file,"'") else svalue(h$action) <- h$file } else { do.call(h$action,list(h$file)) } } ## give a default of printing. if(is.null(handler)) { handler = okhandler.default if(is.null(action)) action="print" } cancelhandler = function(h,...) { dispose(h$obj) return(NA) } filechooser = gtkFileChooserDialogNew(title=text, action=actiontype) filechooser$setSelectMultiple(multi) for(i in whichButtons) filechooser$AddButton(buttonWithId[[i]][1],buttonWithId[[i]][2]) ## add a filter if(!is.null(filter) && type %in% c("open","save")) { if(is.character(filter)) { ## make alist filter <- sapply(names(filter), function(nm) { list(patterns=paste("*.", filter[nm], sep="")) }, simplify=FALSE) filter[[gettext("All files")]]$patterns <- "*.*" } for(i in names(filter)) { filefilter = gtkFileFilterNew() filefilter$SetName(i) if(!is.null(filter[[i]]$patterns)) { for(pattern in filter[[i]]$patterns) filefilter$AddPattern(pattern) } if(!is.null(filter[[i]]$mime.types)) { for(mime.type in filter[[i]]$mime.types) filefilter$AddMimeType(mime.type) } filechooser$AddFilter(filefilter) } } ## initialize if(!is.null(initialfilename)) { if(type == "open") { filechooser$SetFilename(Paste(getwd(),.Platform$file.sep,initialfilename)) } else if(type == "save") { filechooser$setCurrentFolder(getwd()) filechooser$setCurrentName(initialfilename) } } ## this makes it modal response = filechooser$Run() # file=filechooser$GetFilename() ## return a vector of chars for multi select - TT file=unlist(filechooser$GetFilenames()) Encoding(file) <- "UTF-8" h = list(obj=filechooser,action=action,file=file) if(response == GtkResponseType["cancel"]) { ## just close filechooser$Destroy() return(NA) } else if(response == GtkResponseType["ok"]) { filechooser$Destroy() if(!is.null(handler)) handler(h) if(!is.null(args$quote) && as.logical(args$quote)) return(paste("'",file,"'",sep="")) else return(file) } else { filechooser$Destroy() return(NA) } }) ################################################## ## gfilebrowse is not modal, like gfile setClass("gFilebrowseRGtk", contains="gEditRGtk", prototype=prototype(new("gEditRGtk")) ) ## create a browse button -- put value into text box setMethod(".gfilebrowse", signature(toolkit="guiWidgetsToolkitRGtk2"), function(toolkit, text="Select or drag name here...", type="open", quote=TRUE, container=NULL, ...) { theArgs = list(...) if(!is.null(theArgs$expand) && as.logical(theArgs$expand)) group = ggroup(horizontal=FALSE, container=container, expand=TRUE) else group = ggroup(horizontal=FALSE, container=container) g <- ggroup(container =group, horizontal=TRUE, expand=FALSE) # stop growth of button gedit.local <- function(...) gedit(..., expand=TRUE) entry = gedit.local(text=text, container=g, ...) file.cb = function(h,...) { ## called when button is clicked ## pop up a calendar, when date selected, copy to entry ## in this h is gFile object, not gBrowse object val = gfile(text=text, type = type, quote = quote, filter = theArgs$filter, action = function(...) invisible(...) # don't print ) if(!is.na(val)) # check return, set if not NA svalue(entry) <- val } gbutton("browse", handler=file.cb, container=g, expand=FALSE) ## put entry as widget to pick up gEdit methods obj = new("gFilebrowseRGtk", block=group, widget=getWidget(entry), toolkit=toolkit) invisible(obj) }) gWidgetsRGtk2/R/aacR5Classes.R0000644000175100001440000001626013216523445015526 0ustar hornikusers## Some reference classes for clearing up programming ## Observable class sets up objects that can be observed. Inherited by Model Observable <- setRefClass("Observable", fields=list( ..observers="list", ..blocked_observers = "list", ..blocked="logical" ), methods=list( add_observer=function(o, signal="DEFAULT") { "Add an observer. Return id for block/remove/..." if(!is(o, "Observer")) stop("Not an observer") l <- ..observers if(is.null(l[[signal]])) l[[signal]] <- list(o) else l[[signal]] <- c(l[[signal]], o) ..observers <<- l list(signal=signal, o=o) }, remove_observer=function(id) { "Remove observer" if(!is(id$o, "Observer")) stop("Call with an observer id") signal <- id$signal ind <- lapply(..observers[[signal]], function(i) identical(i, id$o)) if(any(unlist(ind)) ) ..observers[[signal]][[which(ind)]] <<- NULL }, block_observer=function(id) { "Block observers. If o missing, block all" if(missing(id) || is.null(id)) { ..blocked <<- TRUE } else { if(is.null(..blocked_observers[[id$signal]])) ..blocked_observers[[id$signal]] <<- list(id$o) else ..blocked_observers[[id$signal]] <<- c(..blocked_observers[[id$signal]], o) } }, unblock_observer=function(id) { "Unblock observer. If id missing, unblock global block" if(missing(id) || is.null(id)) { ..blocked <<- FALSE } else { signal <- id$signal ind <- lapply(..blocked_observers[[signal]], function(i) identical(i, id$o)) if(any(unlist(ind))) ..blocked_observers[[signal]][[which(ind)]] <<- NULL } }, notify_observers=function(..., signal="DEFAULT") { "Call each non-blocked observer" if(length(..blocked) && ..blocked) return() lapply(..observers[[signal]], function(o) { ind <- lapply(..blocked_observers[[signal]], function(i) identical(i, o)) if(!any(unlist(ind))) o$update(...) }) } ) ) ## Observer class is used to observe an observable Observer <- setRefClass("Observer", fields=list( o = "ANY", # want "function", but doesn't work with proto objects obj="ANY", action="ANY" ), methods=list( initialize=function(o, obj, action=NULL) { o <<- o obj <<- obj action <<- action .self }, update=function(...) { "Call self." h <- list(obj=obj, action=action) o(h, ...) } ) ) ## Base class for widgets -- just a widget and block, but could ## put much more here later GWidgetGtk <- setRefClass("GWidgetGtk", contains="Observable", fields=list( widget="ANY", block="ANY" ), methods=list( getWidget=function() widget, getBlock=function() block ) ) ## Base class for widgets using a reference class, as gradio ## This should be moved elsewhere -- once we have more than one setClass("gComponentWithRefClassRGtk", representation=representation(ref_widget="Observable"), contains="gComponentRGtk", prototype=prototype(new("gComponentRGtk")) ) ## Some methods setMethod(".removehandler", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gComponentWithRefClassRGtk"), function(obj, toolkit, ID=NULL, ...) { obj@ref_widget$remove_observer(ID) }) setMethod(".blockhandler", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gComponentWithRefClassRGtk"), function(obj, toolkit, ID=NULL, ...) { obj@ref_widget$block_observer(ID) }) setMethod(".unblockhandler", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gComponentWithRefClassRGtk"), function(obj, toolkit, ID=NULL, ...) { obj@ref_widget$unblock_observer(ID) }) ################################################## ## Base class for gradio, gcheckboxgroup setClass("gComponentWithRefClassWithItemsRGtk", contains="gComponentWithRefClassRGtk", prototype=prototype(new("gComponentWithRefClassRGtk")) ) ## enabled <- enables/disable the block ## ## @param value a logical setReplaceMethod(".enabled", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gComponentWithRefClassWithItemsRGtk"), function(obj, toolkit, ..., value) { block <- obj@ref_widget$block block['sensitive'] <- as.logical(value) return(obj) }) ## visible<- hides or shows the block ## ## @param value a logical setReplaceMethod(".visible", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gComponentWithRefClassWithItemsRGtk"), function(obj, toolkit, ..., value) { block <- obj@ref_widget$block if(as.logical(value)) block$show() else block$hide() return(obj) }) gWidgetsRGtk2/R/ggraphicsnotebook.R0000644000175100001440000002124012236755260016762 0ustar hornikusers## creates a notebook interface tohandle plots setClass("gGraphicsNotebookGtk", representation=representation( width="numeric",height="numeric" ), contains="gNotebookRGtk", prototype=prototype(new("gNotebookRGtk")) ) setMethod(".ggraphicsnotebook", signature(toolkit="guiWidgetsToolkitRGtk2"), function(toolkit, width=dpi*6, height=dpi*6,dpi=75, container = NULL, ...) { ## ... passed onto gnotebook force(toolkit) group = ggroup(horizontal = FALSE, container=container, ...) ## make toolbar toolbargroup = ggroup(horizontal=TRUE, container=group) notebook = gnotebook(closebuttons = TRUE,dontclosethese=1) add(group, notebook, expand=TRUE) ## store both gnotebook obj = new("gGraphicsNotebookGtk", block=group, widget=getWidget(notebook), # gWidgetNotebookRGtk toolkit=toolkit, width=width, height=height) ## ## shove in width, height into notebook ## notebook$width=width; notebook$height=height toolbar = list() if(is.gWindow(container)) { toolbar$Quit$handler = function(h,...) dispose(container) toolbar$Quit$icon = "quit" toolbar$tmp1$separator = TRUE } toolbar$New$handler = function(h,...) { addNewPage(obj) } toolbar$New$icon = "new" toolbar$Close$handler = function(h,...) { ## we need to close the current device -- this was fixed?? ##currentDevice = names(obj)[svalue(obj)] ##currentDevice = as.numeric(gsub("^dev:","",currentDevice)) dispose(obj) ##dev.off(currentDevice) } toolbar$Close$icon = "close" toolbar$tmp2$separator = TRUE toolbar$Print$handler = function(h,...) { printCurrentPage(obj) } toolbar$Print$icon="print" toolbar$Save$handler = function(h,...) { saveCurrentPage(obj) } toolbar$Save$icon="save" toolbar$tmp3$separator = TRUE ## toolbar$Record$handler = function(h,...) { ## recordCurrentPage(obj) ## } ## toolbar$Record$icon = "media-record" toolbar$Replay$handler = function(h,...) { replayAPlot(obj) } toolbar$Replay$icon = "media-play" gtoolbar(toolbar, container=toolbargroup) ## start with a plot, then add handler! addNewPage(obj) ## add handler to raise device when page is changed addhandler(obj, signal="switch-page", function(h,...) { ## we need the new page not the old page ## oldPage = svalue(obj) theArgs = list(...) newPage = theArgs[[3]] + 1 ## gtk thingy plotWidget = notebook[newPage] ## notebook from scope devNo = tag(plotWidget, "device") availDevs = dev.list() availDevs = availDevs[names(availDevs) == "Cairo"] if(!is.null(devNo) && is.numeric(devNo) && devNo %in% availDevs) dev.set(devNo) return(TRUE) }) return(obj) }) ### Two key handlers for when page is raised or lowered ## remove plot device when it is unrealized ## unrealizePage = function(h,...) { ## remove from list of devices ## in the new cairoDevice ths gives errors ## theDevice = h$action$device ## if(!is.null(theDevice) && theDevice > 1) { ## if(.Platform$OS != "windows") ## try(dev.off(theDevice), silent=TRUE) ## ## doesn't work! we get problems with devices here big time ## else ## if(theDevice %in% dev.list()) dev.off(theDevice) ## } ## return(TRUE) ## } ## when a page is entered, we set the plot device ## enterPage = function(h,...) { ## devNo = h$action$device ## if(!is.null(theDevice)) { ## dev.set(theDevice) ## } ## return(TRUE) ## } ## value is ignored addNewPage = function(obj, ...) { theArgs = list(...) # ignored for now width = obj@width;height=obj@height plotwindow = ggraphics(width,height) ## These two are now made obsolete ## addhandlerexpose(plotwindow, ## handler=enterPage, action=list(device=dev.cur())) ## addhandlerunrealize(plotwindow, ## handler=unrealizePage, action=list(device=dev.cur())) noPlots = tag(obj,"noPlots") if(is.null(noPlots)) noPlots = 0 label = paste("plot:",noPlots + 1,sep="",collapse="") tag(obj,"noPlots") = noPlots+1 tag(plotwindow@widget,"device") <- dev.cur() ## add to notebook add(obj, plotwindow, label=label) } printCurrentPage = function(obj,...) { ## do a confirmation dialog first gconfirm("Really print this graph?", ok.handler= function(...) dev.print() ) } ## recordCurrentPage = function(obj,...) { ## ## get variable name, record to this ## ginput(message="Enter a variable to assign recorded plot to:", ## icon="question", ## handler = function(h,...) { ## assign(h$input,recordPlot(),envir=.GlobalEnv) ## }) ## } replayAPlot = function(...) { recordedPlots =c() for(i in ls(envir=.GlobalEnv)) { if(inherits(getObjectFromString(i),"recordedplot")) { recordedPlots = c(recordedPlots, i) } } if(length(recordedPlots) == 0) { gmessage("No recorded plots were found") } else { win = gwindow("Replay plot", visible=TRUE) group = ggroup(horizontal=FALSE, container=win) glabel("Select variable name with recorded plot", container=group) dl = gdroplist(recordedPlots, container = group) buttonGroup = ggroup(container=group) addSpring(buttonGroup) okButton = gbutton("ok",handler = function(h,...) { thePlot = svalue(dl) if(nchar(thePlot) > 0) { replayPlot(getObjectFromString(thePlot)) dispose(win) } else { warning("Select a plot") } }, container=buttonGroup) cancelButton = gbutton("cancel", handler = function(h,...) { dispose(win) }, container=buttonGroup) } } ## dialog to save current page saveCurrentPage = function(obj) { win = gwindow("Save current plot", visible=TRUE) group = ggroup(horizontal=FALSE, container=win) warningMessage = glabel("Saving a plot is currently kind of flaky", container=group) gseparator(container=group) tbl = glayout() knownFileTypes = c("ps","eps","pdf","jpg","jpeg","png") knownFileTypes = c("png") filetype = gdroplist(knownFileTypes) filename = gfilebrowse(".png") saveButton = gbutton("save",handler = function(h,...) { theFileName = svalue(filename) if(nchar(theFileName) == 0) { gmessage("No filename selected") } else { ## get filetype from filename -- not from filetype tmp = unlist(strsplit(theFileName,"\\.")) if(nchar(tmp[1]) == 0) { gmessage("No filename given") } else if(length(tmp) == 1) { gmessage("No filetype selected (based on extension)") } else { theFileType = tmp[length(tmp)] if(theFileType %in% knownFileTypes) { ## use undocumented part of gnotebook # drawarea = getNotebookPageWidget(obj$notebook) drawarea = getNotebookPageWidget(obj) newobj = as.gGd(drawarea) svalue(newobj) <- list(file=theFileName, extension=theFileType) } else { cat(sprintf("***\n Don't know this extension: %s\n",theFileType)) } dispose(win) } } }) addhandlerchanged(filetype, handler = function(h,...) { curFileName = svalue(filename) newFileType = svalue(filetype) tmp = unlist(strsplit(curFileName,"\\.")) if(length(tmp) > 1) tmp[length(tmp)] = newFileType else tmp = c(tmp, newFileType) svalue(filename)<- paste(tmp,collapse=".") # focus(filename)<-TRUE }) tbl[1,1] = glabel("filetype:") tbl[1,2] = filetype tbl[2,1] = glabel("filename:") tbl[2,2:4] = filename visible(tbl, set=TRUE) add(group, tbl, expand=TRUE) buttonGroup = ggroup(container=group) addSpring(buttonGroup) add(buttonGroup,saveButton) add(buttonGroup, gbutton("cancel",handler=function(h,...) dispose(win))) } gWidgetsRGtk2/R/gtoolbar.R0000644000175100001440000002444011406427002015054 0ustar hornikusers## gtoolbar, similar to gmenu setClass("gToolbarRGtk", contains="gComponentRGtk", prototype=prototype(new("gComponentRGtk")) ) ## turn a list into a uimgr object setMethod(".gtoolbar", signature(toolkit="guiWidgetsToolkitRGtk2"), function(toolkit, toolbarlist, style = c("both","icons","text","both-horiz"), action=NULL, container=NULL, ...) { force(toolkit) style = match.arg(style) toolbar = .mapListToToolBar(toolbarlist, style) group = ggroup(spacing=0) svalue(group) <- 0 # border add(group, toolbar, expand=TRUE) obj = new("gToolbarRGtk",block=group, widget=toolbar, toolkit=toolkit) tag(obj,"toolbarlist") <- toolbarlist tag(obj,"toolbar") <- toolbar tag(obj,"style") <- style tag(obj,"group") <- group ## attach to container if (!is.null(container)) { if(is.logical(container) && container == TRUE) container = gwindow(visible=TRUE) add(container, obj, ...) # was expand=TRUE } ## warn if(!is.null(action)) warning("The action argument is not yet defined for gtoolbar.") invisible(obj) }) .mapListToToolBar = function(lst, style, ...) { ## some helper functions for this is.leaf = function(lst) { if(.isgAction(lst) || .isgSeparator(lst) || (is.list(lst) & (!is.null(lst$handler) | !is.null(lst$separator))) ) { return(TRUE) } else { return(FALSE) } } ### XXX ### CHECK THIS toolbar <- gtkToolbar() ## toolbar has no recurse for(i in names(lst)) { itemData <- lst[[i]] if(.isgSeparator(itemData)) itemData <- list(separator = TRUE) if(.isgAction(itemData)) { action <- getToolkitWidget(itemData) item <- action$createToolItem() toolbar$insert(item,pos = -1) } else if(is.list(itemData)) { if(!is.null(itemData$separator)) { ## XX put in separator into toolbar item <- gtkSeparatorToolItemNew() toolbar$insert(item,pos = -1) } else if(!is.null(itemData$handler)) { ## XXX put in value from itemData (label handler, ...) ## JV: need to call this constructor with label, otherwise gtk error pops up item <- gtkToolButtonNew(label=itemData$icon) if(!is.null(itemData$icon)) item$setStockId(getstockiconname(itemData$icon)) gSignalConnect(item,signal="clicked", f = function(a,...) { handler <- a$handler action <- a$action h <- list(action = action) handler(h,...) }, data = itemData, user.data.first=TRUE ) toolbar$insert(item,pos = -1) } } else if(is(itemData,"guiWidget")) { ## can add in a button or popup et widget <- getBlock(itemData) item <- gtkToolItemNew() item$Add(widget) toolbar$insert(item,pos = -1) } } return(toolbar) } ### main function returns toolbar from list ## replaced by above -- simpler, uses older API .mapListToToolBar.old = function(lst, style, ...) { ## some helper functions for this is.leaf = function(lst) { if(is.list(lst) & (!is.null(lst$handler) | !is.null(lst$separator))) { return(TRUE) } else { return(FALSE) } } quiet.cb = function(h,...) {} Cat = function(..., file="", append=FALSE) { cat(Paste(...),file=file,append=append) } ## This function is called recursively to make both the actions and ## the UI. The structure of lst is fairly basic -- lists of ## lists. The terminal nodes contain components name, icon, label, and ## handler. Null values are okay for all but name, handler. ## assigns to str (a string), and actions (a list) which must be defined ## previously make.ui = function(lst,name="root",no=1) { for(i in names(lst)) { if(!is.leaf(lst[[i]])) { ## make item Cat(Paste(rep("\t",no-1)),"\n",file=filename,append=TRUE) ## add action, tooltip actions[[length(actions)+1]] <<- c(i,"gtk-null",i,"","",quiet.cb) ## call recursively make.ui(lst[[i]],i,no+1) ## close tag Cat(Paste(rep("\t",no-1)),"\n",file=filename,append=TRUE) } else { ## UImgr if(!is.null(lst[[i]]$separator)) { ## add a separator here Cat("\n",file=filename, append=TRUE) } else { Cat(Paste(rep("\t",no)),"\n",file=filename,append=TRUE) ## actions tmp = lst[[i]] ## add action ## fill in missing values. Only a handler is needed if(is.null(tmp$icon)) tmp$icon="null" if(is.null(tmp$label)) tmp$label=i if(is.null(tmp$handler)) { tmp$handler = function(h,...) gwCat(i,"in toolbar list needs a handler") } ## tooltip if( is.null(tmp$tooltip)) tmp$tooltip = tmp$label if(!is.function(tmp$handler)) { ## call using ggenericwidget if(is.character(tmp$handler)) { dalst = get(tmp$handler) # called within closure tmp$handler = function(...) do.call("ggenericwidget",list(dalst)) } else if(is.list(tmp$handler)) { dalst = tmp$handler # call within closure tmp$handler = function(...) do.call("ggenericwidget",dalst) } } } ## now add to actions actions[[length(actions)+1]] <<- list(name=i, "stock_id" = getstockiconname(tmp$icon), label = tmp$label, accelerator = "", tooltip = tmp$label, callback = tmp$handler) } } } ## to create the UI and actions ## initialize filename = tempfile() actions = list() Cat("\n\n", file=filename,append=FALSE) ## call function make.ui(lst) ## finish Cat("\n\n", file=filename,append=TRUE) acgrp = gtkActionGroupNew(name="ActionGroup") acgrp$AddActions(entries=actions) uimgr = gtkUIManagerNew() uimgr$InsertActionGroup(acgrp,0) uimgr$AddUiFromFile(filename) unlink(filename) ## menubar toolbar = uimgr$GetWidget(Paste('/',"toolbar")) toolbar$setStyle(style) return(toolbar) } ### methods setMethod(".svalue", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gToolbarRGtk"), function(obj, toolkit, index=NULL, drop=NULL, ...) { tag(obj, "toolbarlist") }) setReplaceMethod(".svalue", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gToolbarRGtk"), function(obj, toolkit, index=NULL, ..., value) { if(!is.list(value)) stop("A toolbar requires a list to define it.") toolbar = .mapListToToolBar(value, tag(obj,"style")) ## swap out delete(tag(obj,"group"), tag(obj,"toolbar") ) add(tag(obj,"group"), toolbar, expand=TRUE) ## replace tag(obj,"toolbar") <- toolbar tag(obj,"toolbarlist") <- value ## all done return(obj) }) ## returns list, or part of list setMethod("[", signature(x="gToolbarRGtk"), function(x, i, j, ..., drop=TRUE) { .leftBracket(x, x@toolkit, i, j, ..., drop=drop) }) setMethod(".leftBracket", signature(toolkit="guiWidgetsToolkitRGtk2",x="gToolbarRGtk"), function(x, toolkit, i, j, ..., drop=TRUE) { lst = tag(x,"toolbarlist") if(missing(i)) return(lst) else return(lst[[i]]) }) setReplaceMethod("[", signature(x="gToolbarRGtk"), function(x, i, j,..., value) { .leftBracket(x, x@toolkit, i, j, ...) <- value return(x) }) setReplaceMethod(".leftBracket", signature(toolkit="guiWidgetsToolkitRGtk2",x="gToolbarRGtk"), function(x, toolkit, i, j, ..., value) { if(!is.list(value)) stop("assignment must be a list defining a (part) of a toolbar.") lst = tag(x,"toolbarlist") if(missing(i)) lst = value else lst[[i]] = value svalue(x) <- lst return(x) }) setMethod(".add", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gToolbarRGtk", value="list"), function(obj, toolkit, value, ...) { svalue(obj) <- c(svalue(obj), value) }) ## (from gmenu) setMethod(".delete", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gToolbarRGtk"), function(obj, toolkit, widget, ...) { ## widget can be gToolBar or a list if(is.character(widget)) { lst = widget # else assume its a character } else if(is(widget,"gComponentRGtk")) { lst = svalue(widget) lst = names(lst) } else if(is.list(widget)) { lst = names(widget) } else { warning("Must be either a vector of names, a list, or a gToolbar instance") return() } cur.list = svalue(obj) for(i in lst) { ## we delete *last* entry with this name, hence this awkwardness theNames = names(cur.list) if(i %in% theNames) { j = max(which(i == theNames)) if(!is.null(cur.list[[j]])) cur.list[[j]] <- NULL } } ## now update toolbar svalue(obj) <- cur.list }) ### no method to set style, use tag(obj,"style")<-"theStyle" instead gWidgetsRGtk2/R/glabel.R0000644000175100001440000002140111461554667014506 0ustar hornikuserssetClass("gLabelRGtk", contains="gComponentRGtk", prototype=prototype(new("gComponentRGtk")) ) ## constructor setMethod(".glabel", signature(toolkit="guiWidgetsToolkitRGtk2"), function(toolkit, text= "", markup = FALSE, editable = FALSE, handler = NULL, action = NULL, container = NULL, ... ) { force(toolkit) label <- gtkLabelNew() obj <- as.gWidgetsRGtk2(label) # obj = new("gLabelRGtk",block=evb, widget=label,toolkit=toolkit) if(markup) tag(obj,"markup")<-TRUE else tag(obj, "markup") <- FALSE svalue(obj) <- text if(editable) { tag(obj,"editable") <- TRUE edit <- gedit() tag(obj, "edit") <- edit editWidget <- getWidget(edit) evb <- getBlock(obj) ## this are almost identical, as we just swap edit and label addHandlerChanged(edit, handler = function(h,...) { svalue(obj) <- svalue(edit) evb$Remove(evb[[1]]) evb$Add(label) }) ##This is for connecting to the third mosue id <- addHandlerClicked(obj, handler=function(h,...) { svalue(edit) <- svalue(obj) evb$Remove(evb[[1]]) evb$Add(editWidget) editWidget$GrabFocus() }) tag(obj, "handler.id") <- id handler <- NULL # no editable with handler } if(!is.null(handler)) { tag(obj,"handler.id") <- addHandlerClicked(obj, handler=handler,action=action) } ## attach? if (!is.null(container)) { if(is.logical(container) && container == TRUE) container = gwindow() add(container, obj,...) } invisible(obj) }) ## coerce gtk object as.gWidgetsRGtk2.GtkLabel <- function(widget,...) { label = widget ## pack into an event box so that we can get signals ## doesn't work if there is already a parent! evb <- gtkEventBoxNew() ## Issue with labels and notebooks can be fixed here, but ## may mask editable event response ## Thanks to Felix A. for this evb$SetVisibleWindow(FALSE) if(is.null(label$GetParent())) evb$Add(label) # else # cat("Can't add gwidget handlers to this label\n") obj <- new("gLabelRGtk", block=evb, widget=label, toolkit=guiToolkit("RGtk2")) ## tag values -- may already be set (asgWidget(getToolkitWidget(widget))) vals <- c("markup"=FALSE) for(i in names(vals)) { if(!is.null(tag(label,i))) tag(obj,i) <- tag(label,i) else tag(obj,i) <- vals[i] } return(obj) } ## methods setMethod(".svalue", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gLabelRGtk"), function(obj, toolkit, index=NULL, drop=NULL, ..) { markup = tag(obj, "markup") if(is.null(markup)) markup = FALSE val = obj@widget$GetText() if(!is.empty(markup) && markup==TRUE) val = gsub("<[^>]*>","",val) # strip off return(val) }) ## svalue<- setReplaceMethod(".svalue", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gLabelRGtk"), function(obj, toolkit, index=NULL, ..., value) { widget <- getWidget(obj) ## set the text markup <- tag(obj, "markup") if(is.null(markup)) markup = FALSE ## if multiline, collapse with \n value <- paste(value, collapse="\n") if(as.logical(markup)==TRUE) widget$SetMarkup(value) else widget$SetText(value) return(obj) }) ## special GTK method for rotation setGeneric(".rotatelabel",function(obj, angle, ...) standardGeneric(".rotatelabel")) setMethod(".rotatelabel", signature("gLabelRGtk"), function(obj, angle, ...) { obj@widget$SetAngle(angle) } ) ################################################## ## handlers ## need to put handler on evb -- not widget setMethod(".addHandler", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gLabelRGtk"), function(obj, toolkit, signal, handler, action=NULL, ...) { f <- function(h,...) { if(h$obj@widget['sensitive']) handler(h,...) } ID = .addHandler(obj@block, toolkit, signal, f, action, actualobj=obj,...) invisible(ID) }) setMethod(".addhandlerclicked", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gLabelRGtk"), function(obj, toolkit, handler, action=NULL, ...) { .addHandler(obj, toolkit, signal="button-press-event", handler=handler, action=action, actualobj=obj,...) }) setMethod(".addhandlerchanged", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gLabelRGtk"), function(obj, toolkit, handler, action=NULL, ...) { edit = tag(obj, "edit") if(!is.null(edit)) { ## we use unrealize here, the addhandlerchanged on edit wasn't ## working for some strage reason return(addhandlerunrealize(edit, handler, action)) } else { ## use addhandlerclicked return(.addhandlerclicked(obj, toolkit, handler, action, ...)) } }) ### need to fuss with evb vs. label setMethod(".adddroptarget", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gLabelRGtk"), function(obj, toolkit, targetType="text", handler=NULL, action=NULL, ...) { ## problem -- we want to add drop target to obj@block evb, ## but have handler refer to obj@widgeg=label. addDropTarget(obj@block, toolkit, targetType, handler, action, actualobj=obj) }) setMethod(".adddropsource", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gLabelRGtk"), function(obj, toolkit, targetType="text", handler=NULL, action=NULL, ...) { ## problem -- we want to add drop target to obj@block evb, ## but have handler refer to obj@widgeg=label. addDropSource(obj@block, toolkit, targetType, handler, action, actualobj=obj) }) ## Put onto block setMethod(".addpopupmenu",signature(toolkit="guiWidgetsToolkitRGtk2", obj="gLabelRGtk"), function(obj, toolkit, menulist, action=NULL, ...) { addPopupMenuWithSignal(obj@block, toolkit , menulist, action, actualobj=obj,...) }) setMethod(".add3rdmousepopupmenu", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gLabelRGtk"), function(obj, toolkit, menulist,action=NULL, ...) { add3rdMousePopupMenuWithSignal(obj@block, toolkit, menulist, action, actualobj=obj,...) }) ################################################## ## internal function -- used by gvariables in gcommandline setGeneric("gaddlabel", function(obj, text="", markup=FALSE, pos=1, container=NULL, ...) standardGeneric("gaddlabel")) setMethod("gaddlabel", signature("guiWidget"), function(obj, text="", markup=FALSE, pos=1, container=NULL, ...) gaddlabel(obj@widget, text, markup, pos, container, ...) ) setMethod("gaddlabel", signature("gWidgetRGtk"), function(obj, text="", markup=FALSE, pos=1, container=NULL, ...) { ## wrap widget into a new package with label if(pos ==2 || pos == 4) { group = ggroup(horizontal=TRUE,container=container, toolkit=obj@toolkit) } else { group = ggroup(horizontal=FALSE,container=container, toolkit=obj@toolkit) } if(pos ==2 || pos == 3) { glabel(text, markup=markup, container=group, toolkit=obj@toolkit) add(group, obj,expand=TRUE) } else { add(group, obj,expand=TRUE) glabel(text, markup=markup, container=group, toolkit=obj@toolkit) } ## group is returned. No methods added here, just a new package return(group) }) gWidgetsRGtk2/R/gimage.R0000644000175100001440000001150211461554370014501 0ustar hornikuserssetClass("gImageRGtk", contains="gComponentRGtk", prototype=prototype(new("gComponentRGtk")) ) ## image use setMethod(".gimage", signature(toolkit="guiWidgetsToolkitRGtk2"), function(toolkit, filename = "", dirname="", size="", handler=NULL, action=NULL, container=NULL, ...) { force(toolkit) ## size if for Stock: one of MENU, SMALL_TOOLBAR, LARGE_TOOLBAR, BUTTON, DND, DIALOG image <- gtkImageNew() if(dirname == "stock") { if(is.null(size)) { size <- GtkIconSize["menu"] } else { size <- switch(toupper(size), "MENU"= GtkIconSize["menu"], "SMALL_TOOLBAR"= GtkIconSize["small-toolbar"], "LARGE_TOOLBAR"= GtkIconSize["large-toolbar"], "BUTTON"= GtkIconSize["button"], "DND"= GtkIconSize["dnd"], "DIALOG"= GtkIconSize["dialog"], GtkIconSize["menu"] ) } filename <- getstockiconname(filename) # in icons.R image$SetFromStock(filename,size=size) } else { if(nchar(dirname) >0 ) filename <- Paste(dirname,"/",filename) # / works for windows and unix? if(!missing(filename) && file.exists(filename)) image$SetFromFile(filename) } ## pack into an event box so that we can get signals evb <- gtkEventBoxNew() evb$SetVisibleWindow(FALSE) evb$Add(image) obj <- as.gWidgetsRGtk2(image, block=evb) # obj = new("gImageRGtk", block=evb, widget=image, toolkit=toolkit tag(obj,"filename") <- filename tag(obj,"doStock") <- dirname=="stock" if(dirname == "stock") { tag(obj,"size") <- size } if(!is.null(handler)) { id <- addhandlerclicked(obj, handler=handler, action=action) } ## attach? if (!is.null(container)) { if(is.logical(container) && container == TRUE) container <- gwindow(visible=TRUE) add(container, obj,...) } invisible(obj) }) as.gWidgetsRGtk2.GtkImage <- function(widget, ...) { theArgs <- list(...) if(!is.null(theArgs$block)) block <- theArgs$block else block <- widget obj <- new("gImageRGtk", block=block, widget=widget, toolkit=guiToolkit("RGtk2")) return(obj) } ### methods ### need to fuss with evb vs. label setMethod(".adddroptarget", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gImageRGtk"), function(obj, toolkit, targetType="text", handler=NULL, action=NULL, ...) { ## problem -- we want to add drop target to obj@block evb, ## but have handler refer to obj@widgeg=label. addDropTarget(obj@block, toolkit, targetType, handler, action, actualobj=obj) }) setMethod(".svalue", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gImageRGtk"), function(obj, toolkit, index=NULL, drop=NULL, ...) { ## return name? return(tag(obj,"filename")) }) setReplaceMethod(".svalue", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gImageRGtk"), function(obj, toolkit, index=NULL, ..., value) { ## value is a full filename if(value != "" & file.exists(value)) { obj@widget$SetFromFile(value) tag(obj,"filename") <- value } else if(value != "" & tag(obj,"doStock")) { iconname <- getstockiconname(value) obj@widget$SetFromStock(iconname,size=tag(obj,"size")) } else { cat(sprintf("File %sdoes not exist nor is a stock name.\n",value)) } return(obj) }) ### handlers ## put onto block setMethod(".addHandler", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gImageRGtk"), function(obj, toolkit, signal, handler, action=NULL, ...) { f <- function(h,...) { if(h$obj@widget['sensitive']) handler(h,...) } .addHandler(obj@block, toolkit, signal, f, action, actualobj=obj, ...) }) setMethod(".addhandlerclicked", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gImageRGtk"), function(obj, toolkit, handler, action=NULL, ...) { addhandler(obj,"button-press-event", handler=handler, action=action,...) }) gWidgetsRGtk2/R/icons.R0000644000175100001440000001136111641411277014364 0ustar hornikusers## add to stock icons ## function to look up stock icons ## ie. ok returns "gtk-ok" ##stockIcons <- list(); stockIcons <- new.env() updateStockIcons <- new.env(); updateStockIcons[['value']] <- TRUE #assignInNamespace("stockIcons",list(), ns = "gWidgetsRGtk2") #assignInNamespace("updateStockIcons",TRUE, ns = "gWidgetsRGtk2") loadGWidgetIcons = function() { ## add the icons ## we use xpm icons gimp can convert iconFullNames = list.files(system.file("images", package="gWidgetsRGtk2")) iconFullNames = iconFullNames[grep("\\.xpm$",iconFullNames)] ## just xpm iconNames = gsub("\\.xpm$","",iconFullNames) ## Loop over all to add here iconFullNames = paste(iconNames,".xpm", sep="") iconFiles = sapply(iconFullNames, function(name) { system.file("images",name, package="gWidgetsRGtk2") }) addToGtkStockIcons(iconNames, iconFiles) } ## add stock icons from files setMethod(".addStockIcons", signature(toolkit="guiWidgetsToolkitRGtk2"), function(toolkit, iconNames, iconFiles, ...) { updateStockIcons[['value']] <- TRUE # assignInNamespace("updateStockIcons",TRUE, ns = "gWidgetsRGtk2") addToGtkStockIcons(iconNames, iconFiles) }) addToGtkStockIcons = function(iconNames, iconFiles) { iconfactory = gtkIconFactoryNew() for(i in seq_along(iconNames)) { iconsource = gtkIconSourceNew() iconsource$SetFilename(iconFiles[i]) iconset = gtkIconSetNew() iconset$AddSource(iconsource) stockName = paste("gWidgetsRGtk2-",iconNames[i],sep="") iconfactory$Add(stockName, iconset) items = list(test=list(stockName, iconNames[i],"","","")) gtkStockAdd(items) } iconfactory$AddDefault() invisible(TRUE) } ## find the stock icons. This includes those added bia loadGWidgetIcons() setMethod(".getStockIcons", signature(toolkit="guiWidgetsToolkitRGtk2"), function(toolkit) { ## if(getFromNamespace("updateStockIcons", ns = "gWidgetsRGtk2")) { if(updateStockIcons[['value']]) { ## create icon list .stockicons <- list() for(i in unlist(gtkStockListIds())) { name <- sub("[a-zA-Z0-9]*-","",i) .stockicons[[name]] = i } stockIcons[["value"]] <- .stockicons updateStockIcons[["value"]] <- FALSE # assignInNamespace("stockIcons", .stockicons, ns = "gWidgetsRGtk2") # assignInNamespace("updateStockIcons",FALSE, ns = "gWidgetsRGtk2") } stockIcons[["value"]] # return(getFromNamespace("stockIcons", ns = "gWidgetsRGtk2")) }) ## name can be a vector ## return NA, if not there getstockiconname <- function(name=NULL) { .stockicons = getStockIcons(toolkit=guiToolkit("RGtk2")) # cache? if(is.null(name)) return(unlist(.stockicons)) if(length(name) == 0) return(character(0)) tmpfun = function(names) { sapply(names, function(name) { ## already a stock name? if(name %in% .stockicons) return(name) if(name %in% names(.stockicons)) { return(.stockicons[[name]]) } else { return(NA) } }) } return(tmpfun(name)) } ################################################# ## functions to deal with icons ## class to icon translation -- return stock name ## with prefix ## find the stock icons. This includes those added bia loadGWidgetIcons() setMethod(".stockIconFromClass", signature(toolkit="guiWidgetsToolkitRGtk2"), function(toolkit,theClass, ...) { default = "symbol_star" if(is.null(theClass) || is.na(theClass) || length(theClass) == 0 ) return(NA) theClass = theClass[1] if(theClass %in% .models) return(getstockiconname("lines")) if(theClass %in% .ts) return(getstockiconname("ts")) if(theClass %in% .functions) return(getstockiconname("function")) ret = switch(theClass, "numeric"= "numeric", "integer"= "numeric", "logical" = "logical", "character"="select-font", "matrix" = "matrix", "data.frame" = "dataframe", "list" = "dataframe", "complex"="numeric", "factor"="factor", "recordedplot" = "plot", NA) return(getstockiconname(ret)) }) setMethod(".stockIconFromObject", signature(toolkit="guiWidgetsToolkitRGtk2"), function(toolkit,obj, ...) { .stockIconFromClass(class(obj)[1]) }) ## ## ##loadGWidgetIcons() gWidgetsRGtk2/R/gmenu.R0000644000175100001440000002537411475470171014400 0ustar hornikuserssetClass("gMenuRGtk", contains="gComponentRGtk", prototype=prototype(new("gComponentRGtk")) ) ## menulist is a list of lists with named components. Each named sub ## is a submenu. a leaf consistis of handler= (required), lab ## override the defaults of Michael gtkMenuPopupHack <-gtkMenuPopup ## gtkMenuPopupHack <- ## function (object, parent.menu.shell = NULL, parent.menu.item = NULL, ## func = NULL, data = NULL, button, activate.time) ## { ## checkPtrType(object, "GtkMenu") ## if (!is.null(parent.menu.shell)) ## checkPtrType(parent.menu.shell, "GtkWidget") ## if (!is.null(parent.menu.item)) ## checkPtrType(parent.menu.item, "GtkWidget") ## if(!is.null(func)) ## func <- as.function(func) ## button <- as.numeric(button) ## activate.time <- as.numeric(activate.time) ## w <- RGtk2:::.RGtkCall("S_gtk_menu_popup", object, parent.menu.shell, ## parent.menu.item, func, data, button, activate.time, ## PACKAGE = "RGtk2") ## return(invisible(w)) ## } ## gtkMenuPopupHack = function (object, parent.menu.shell=NULL, ## parent.menu.item=NULL, func=NULL, ## data = NULL, button, activate.time) ## { ## checkPtrType(object, "GtkMenu") ## # checkPtrType(parent.menu.shell, "GtkWidget") ## # checkPtrType(parent.menu.item, "GtkWidget") ## # func <- as.function(func) ## button <- as.numeric(button) ## activate.time <- as.numeric(activate.time) ## w <- RGtk2:::.RGtkCall("S_gtk_menu_popup", object, parent.menu.shell, ## parent.menu.item, func, data, button, activate.time, ## PACKAGE = "RGtk2") ## return(invisible(w)) ## } ## put menu in group, ## a menubar is a map from a list into a menubar ## constructor setMethod(".gmenu", signature(toolkit="guiWidgetsToolkitRGtk2"), function(toolkit, menulist, popup = FALSE, action = NULL, container=NULL, ...) { force(toolkit) if(popup) { mb = gtkMenuNew() } else { mb = gtkMenuBarNew() } group = ggroup(spacing=0); svalue(group) <- 0 mbgroup = ggroup(spacing=0); svalue(mbgroup) <- 0 if(popup) { obj = new("gMenuRGtk", block=mb, widget=mb, toolkit=toolkit) } else { add(mbgroup, mb, expand=TRUE) add(group, mbgroup, expand=TRUE) obj = new("gMenuRGtk", block=group, widget=mb, toolkit=toolkit) } tag(obj, "menulist") <- menulist tag(obj, "action") <- action tag(obj,"popup") <- popup tag(obj, "mbgroup") <- mbgroup tag(obj, "mb") <- mb # the real menubar .addSubMenu(mb,menulist, action=action) if(!is.null(container)) { if(is.logical(container) && container == TRUE) { add(gwindow(visible=TRUE), obj) } else { add(container, obj,...) } } invisible(obj) }) ### methods setMethod(".svalue", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gMenuRGtk"), function(obj, toolkit, index=NULL, drop=NULL, ...) { tag(obj, "menulist") }) ## three cases for value: list, gMenuRGtk, guiWidget push down ## make a menubar, then replace current -- isn't working for popup case setReplaceMethod(".svalue", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gMenuRGtk", value="list"), function(obj, toolkit, index=NULL, ..., value) { popup = tag(obj, "popup") if(!is.null(popup) && popup == TRUE) mb = gtkMenuNew() else mb = gtkMenuBarNew() mbgroup = ggroup(spacing=0); svalue(mbgroup) <- 0 add(mbgroup, mb, expand=TRUE) menulist = value # value is a list if(!is.list(menulist)) stop("value is not a menubar or a list") .addSubMenu(mb,menulist, action=tag(obj,"action")) delete(obj@block, tag(obj,"mbgroup")) # delete from group() add(obj@block, mbgroup, expand=TRUE) # add to block tag(obj,"mbgroup") <- mbgroup tag(obj,"menulist") <- menulist return(obj) }) ## get list, and then call previous setReplaceMethod(".svalue", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gMenuRGtk", value="gMenuRGtk"), function(obj, toolkit, index=NULL, ..., value) { .svalue(obj,toolkit, index, ...) <- svalue(value) return(obj) }) ## call previous after getting list setReplaceMethod(".svalue", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gMenuRGtk", value="guiWidget"), function(obj, toolkit, index=NULL, ..., value) { .svalue(obj,toolkit,index, ...) <- svalue(value@widget) return(obj) }) setMethod(".add", signature(toolkit="guiWidgetsToolkitRGtk2", obj="gMenuRGtk", value="guiWidget"), function(obj, toolkit, value, ...) { .add(obj, toolkit, value@widget) }) setMethod(".add", signature(toolkit="guiWidgetsToolkitRGtk2", obj="gMenuRGtk", value="gMenuRGtk"), function(obj, toolkit, value, ...) { orig.list = svalue(obj) add.list = svalue(value) new.list = c(orig.list, add.list) svalue(obj) <- new.list }) setMethod(".add", signature(toolkit="guiWidgetsToolkitRGtk2", obj="gMenuRGtk", value="list"), function(obj, toolkit, value, ...) { orig.list = svalue(obj) new.list = c(orig.list, value) svalue(obj) <- new.list }) ## "wdget" is either a gMenu, list or just names to delete setMethod(".delete", signature(toolkit="guiWidgetsToolkitRGtk2", obj="gMenuRGtk", widget="guiWidget"), function(obj, toolkit, widget, ...) { .delete(obj,toolkit,widget@widget,...) }) setMethod(".delete", signature(toolkit="guiWidgetsToolkitRGtk2", obj="gMenuRGtk", widget="gWidgetRGtk"), function(obj, toolkit, widget, ...) { .delete(obj,toolkit,widget@widget, ...) }) setMethod(".delete", signature(toolkit="guiWidgetsToolkitRGtk2", obj="gMenuRGtk", widget="gMenuRGtk"), function(obj, toolkit, widget, ...) { .delete(obj,toolkit,svalue(widget), ...) }) setMethod(".delete", signature(toolkit="guiWidgetsToolkitRGtk2", obj="gMenuRGtk", widget="list"), function(obj, toolkit, widget, ...) { lst = widget # else assume its a character cur.list = svalue(obj) for(i in lst) { ## we delete *last* entry with this name, hence this awkwardness theNames = names(cur.list) if(i %in% theNames) { j = max(which(i == theNames)) if(!is.null(cur.list[[j]])) cur.list[[j]] <- NULL } } ## now update menubar svalue(obj) <- cur.list }) ## give vector notation setMethod("[", signature(x="gMenuRGtk"), function(x, i, j, ..., drop=TRUE) { .leftBracket(x, x@toolkit, i, j, ..., drop=drop) }) setMethod(".leftBracket", signature(toolkit="guiWidgetsToolkitRGtk2",x="gMenuRGtk"), function(x, toolkit, i, j, ..., drop=TRUE) { lst = svalue(x) if(missing(i)) return(lst) else return(lst[i]) }) setReplaceMethod("[", signature(x="gMenuRGtk"), function(x, i, j,..., value) { .leftBracket(x, x@toolkit, i, j, ...) <- value return(x) }) setReplaceMethod(".leftBracket", signature(toolkit="guiWidgetsToolkitRGtk2",x="gMenuRGtk"), function(x, toolkit, i, j, ..., value) { lst = svalue(x) theNames = names(lst) if(is.character(i)) i = max(which(i %in% theNames)) lst[[i]] <- value[[1]] theNames[i] = names(value) names(lst) = theNames svalue(x) <- lst return(x) }) ### ## some helper functions for this .isLeaf = function(lst) { if(.isgAction(lst) || (is.list(lst) & (!is.null(lst$handler) | !is.null(lst$separator))) ) { return(TRUE) } else { return(FALSE) } } ## workhorse for this .addSubMenu = function(subMenu, menu.list, action=NULL, ...) { for(i in names(menu.list)) { data = menu.list[[i]] if(.isgSeparator(data)) { data <- list(separator = TRUE) } if(.isgAction(data)) { action <- getWidget(data) item <- gtkImageMenuItem("") if("always-show-image" %in% names(item)) item['always-show-image'] <- TRUE subMenu$Append(item) ##action$connectProxy(item) item$setRelatedAction(action) } else if(!.isLeaf(data)) { ## do submenu item = gtkMenuItem(i) subMenu$Append(item) newSubMenu = gtkMenu() .addSubMenu(newSubMenu, data) item$SetSubmenu(newSubMenu) } else if(!is.null(data$separator)) { ## add a separator item = gtkSeparatorMenuItem() subMenu$Append(item) } else { ## what name if(!is.null(data$label)) theName = data$label else theName = i ## make a menuitem item <- gtkImageMenuItemNewWithLabel(theName) if(!is.null(data$icon)) { icon = data$icon if(file.exists(icon)) { ## a file on system image = gtkImageNewFromFile(icon) } else { ## assume a stock icon file icon = getstockiconname(icon) image = gtkImageNew() image$SetFromStock(icon,size=GtkIconSize["menu"]) } item$SetImage(image) if("always-show-image" %in% names(item)) # newer GTK item['always-show-image'] <- TRUE } else { item = gtkMenuItem(theName) } subMenu$Append(item) item$AddCallback("activate",data$handler, data=list(action=action)) } } } gWidgetsRGtk2/R/gaction.R0000644000175100001440000000755211511673707014710 0ustar hornikusers## reusuabel chunk of code setClass("gActionRGtk", contains="gComponentRGtk", representation(e = "environment"), prototype=prototype(e=new.env()) ) setMethod(".gaction", signature(toolkit="guiWidgetsToolkitRGtk2"), function(toolkit, label, tooltip = NULL, icon = NULL, key.accel = NULL, handler = NULL, action = NULL, parent = NULL, ...) { force(toolkit) if(!is.null(icon)) icon <- getstockiconname(icon) act <- gtkAction(name = make.names(label), label = label, tooltip = tooltip, stock.id = icon) obj = new("gActionRGtk", block=act, widget=act, toolkit=toolkit) ## add for later use ## should be defined when used in a menu bar. tag(obj,"key.accel") <- key.accel obj@e$buttons <- list() # for svalue<- with buttons, menu items work ## accel buttons if(!is.null(key.accel) && !is.null(parent)) { toplevel <- getBlock(parent)$toplevel ## mask Shift-1, Control-4 alt-8 ## key sprintf("GDK_%s",key) ## flag GtkAccelFlags -- 1 if(grepl("^Control", key.accel) || grepl("^Alt", key.accel) || grepl("^Shift", key.accel)) { tmp <- strsplit(key.accel, "-")[[1]] modifier <- c(Shift="shift-mask", "Control"="control-mask", Alt="mod1-mask")[tmp[1]] key <- sprintf("GDK_%s", tmp[2]) } else { modifier <- "modifier-mask" key <- sprintf("GDK_%s", key.accel) } a <- gtkAccelGroup() toplevel$addAccelGroup(a) a$connect(get(key), modifier, "visible", function(...) { h <- list(action=action) handler(h, ...) TRUE }) } if(!is.null(handler)) addHandlerChanged(obj, handler, action) return(obj) }) ## svalue -- get label setMethod(".svalue", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gActionRGtk"), function(obj, toolkit, index=NULL, drop=NULL, ...) { widget <- getWidget(obj) return(widget['label']) }) ## svalue<- set label setReplaceMethod(".svalue", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gActionRGtk"), function(obj, toolkit, index=NULL, ..., value) { gtkaction <- getWidget(obj) ## for menu, toolbar est label propoerty gtkaction['label'] <- value ## for buttons, we work harder buttons <- obj@e$buttons if(length(buttons) > 0) sapply(buttons, function(i) { if(isExtant(i)) svalue(i) <- value }) return(obj) }) ## enabled -- inherited setMethod(".addhandlerchanged", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gActionRGtk"), function(obj, toolkit, handler, action=NULL, ...) { widget <- getWidget(obj) ID <- gSignalConnect(widget, signal="activate", f = handler, data = list(action = action), user.data.first = TRUE) invisible(ID) }) ## helper functions .isgAction <- function(lst) { is(lst,"guiComponent") && is(lst@widget, "gActionRGtk") || is(lst,"gActionRGtk") } gWidgetsRGtk2/R/glayout.R0000644000175100001440000001332411612427225014734 0ustar hornikuserssetClass("gLayoutRGtk", contains="gContainerRGtk", prototype=prototype(new("gContainerRGtk")) ) ## an gWidget for tables setMethod(".glayout", signature(toolkit="guiWidgetsToolkitRGtk2"), function(toolkit, homogeneous = FALSE, spacing = 10, # amount (pixels) between row, cols, NULL=0 container = NULL, ... ) { force(toolkit) tbl <- gtkTableNew(homogeneous = homogeneous) ## homogeneous spacing tbl$SetRowSpacings(spacing) tbl$SetColSpacings(spacing) obj <- as.gWidgetsRGtk2(tbl) tag(obj, "childlist") <- list() if (!is.null(container)) { if(is.logical(container) && container == TRUE) container = gwindow() add(container, obj,...) } invisible(obj) }) as.gWidgetsRGtk2.GtkTable <- function(widget, ...) { obj = new("gLayoutRGtk", block=widget, widget=widget, toolkit=guiToolkit("RGtk2")) return(obj) } ### The add method is a stub so that this works with same ## approach as gWidgetstcltk setMethod(".add", signature(toolkit="guiWidgetsToolkitRGtk2", obj="gLayoutRGtk", value="gWidgetRGtk"), function(obj, toolkit, value, ...) { ## stub }) ## retrieve values setMethod("[", signature(x="gLayoutRGtk"), function(x, i, j, ..., drop=TRUE) { .leftBracket(x, x@toolkit, i, j, ..., drop=drop) }) setMethod(".leftBracket", signature(toolkit="guiWidgetsToolkitRGtk2",x="gLayoutRGtk"), function(x, toolkit, i, j, ..., drop=TRUE) { l <- tag(x, "childlist") ind <- sapply(l, function(comp) { i[1] %in% comp$x && j[1] %in% comp$y }) if(any(ind)) return(l[ind][[1]]$child) # first else NA }) ## how we populate the table setReplaceMethod("[", signature(x="gLayoutRGtk"), function(x, i, j,..., value) { .leftBracket(x, x@toolkit, i, j, ...) <- value return(x) }) setReplaceMethod(".leftBracket", signature(toolkit="guiWidgetsToolkitRGtk2",x="gLayoutRGtk"), function(x, toolkit, i, j, ..., value) { if(missing(i)) i <- dim(x)[1] + 1 if(missing(j)) { cat(gettext("glayout: [ needs to have a column specified.")) return(x) } ## check that all is good if(is.character(value)) { ## wrap characters into labels value <- glabel(value,...) } ## widgets tbl <- getWidget(x) child <- getBlock(value) theArgs <- list(...) ## get expand, anchor, fill expand <- getWithDefault(theArgs$expand, FALSE) if(!is.null(theArgs$align)) theArgs$anchor <- theArgs$align anchor <- getWithDefault(theArgs$anchor, NULL) if(!is.null(anchor)) { # put in [0,1]^2 anchor <- (anchor+1)/2 # [0,1] anchor[2] <- 1 - anchor[2] # flip yalign } default_fill <- getWithDefault(tag(value, "default_fill"), "both") fill <- getWithDefault(theArgs$fill, default_fill) # "", x, y or both ## we do things differently if there is a gtkAlignment for a block if(is(child, "GtkAlignment")) { if(expand && (fill =="both" || fill == "x")) { child['xscale'] <- 1 } if(expand && (fill == "both" || fill == "y")) { child['yscale'] <- 1 } if(expand && fill == "") { child['xscale'] <- child['yscale'] <- 1 } if(!is.null(anchor)) { child['xalign'] <- anchor[1] child['yalign'] <- anchor[2] } } else { ## in gtkstuff setXYalign(child, getWidget(value), anchor) } ## fix up number of columns d <- dim(x) nr <- max(i); nc <- max(j) if( nr > d[1] || nc > d[2]) tbl$Resize(max(max(i), nr), max(max(j), nc)) if(expand) opts <- c("fill","expand","shrink") else opts <- c("fill") child <- getBlock(value) tbl$Attach(child, min(j)-1, max(j), min(i)-1, max(i), xoptions=opts,yoptions=opts) ## store for [ method l <- tag(x, "childlist") l[[as.character(length(l) + 1)]] <- list(x=i, y=j, child=value) tag(x, "childlist") <- l return(x) }) ## inherits delete method for containers ## replaced ## We like visible, return it. Unlike delete it only hides the widget ## setReplaceMethod(".visible", ## signature(toolkit="guiWidgetsToolkitRGtk2",obj="gLayoutRGtk"), ## function(obj, toolkit, ..., value) { ## gwCat(gettext("visible<- is now redundant for glayout in RGtk2")) ## return(obj) ## }) ## get number of rows and columns setMethod(".dim", signature(toolkit="guiWidgetsToolkitRGtk2",x="gLayoutRGtk"), function(x,toolkit) { tbl <- getWidget(x) return(c(nrow=tbl$GetNrows(), ncol=tbl$GetNcols())) }) gWidgetsRGtk2/R/gdialogs.R0000644000175100001440000004534613216523562015055 0ustar hornikusers## some dialogs for R ## dialogs don't get windows, they make them ## dialogs are modal ## dialogs return their value -- not an object. so source(gfile()) should work setMethod(".gmessage", signature(toolkit="guiWidgetsToolkitRGtk2"), function(toolkit, message, title = "message", icon = c("info","warning","error","question"), parent=NULL, handler = NULL, action = NULL, ... ) { force(toolkit) icon = match.arg(icon) icon = Paste("GTK_MESSAGE_",toupper(match.arg(icon))) button = "GTK_BUTTONS_OK" ## parent if(!is.null(parent)) { parent <- getBlock(parent) if(!is(parent,"GtkWindow")) parent <- parent$GetWindow() if(!is(parent,"GtkWindow")) parent <- NULL # give up } ## use message dialog for Gtk dlg = gtkMessageDialogNew( parent = parent, flags = 0, buttons = button, type=icon, message[1] ) ## secret bit. Needs API! If message has length more than ## 1, use rest for secondary text. if(length(message) > 1) dlg['secondary-text'] <- paste(message[-1], collapse = "\n") dlg$SetTitle(title) dlg$GrabFocus() dlg$GetWindow()$Raise() dlg$setDefaultResponse(GtkResponseType["ok"]) ## run in modal mode response = dlg$Run() h = list(obj=dlg, ref=dlg, action=action) if(response == GtkResponseType["cancel"] || response == GtkResponseType["close"] || response == GtkResponseType["delete-event"]) { dlg$Destroy() invisible(FALSE) } else if(response == GtkResponseType["ok"]) { if(!is.null(handler)) handler(h) dlg$Destroy() invisible(TRUE) } else { gwCat("Don't know this response") print(response) dlg$Destroy() invisible(NA) } }) ## if OK then run handler, else not setMethod(".gconfirm", signature(toolkit="guiWidgetsToolkitRGtk2"), function(toolkit, message, title = "Confirm", icon = c("info", "warning", "error", "question"), parent=NULL, handler = NULL, action = NULL, ... ) { if(missing(icon)) icon="question" icon = match.arg(icon) icon = Paste("GTK_MESSAGE_",toupper(match.arg(icon))) icon = "GTK_MESSAGE_QUESTION" buttons = "GTK_BUTTONS_OK_CANCEL" ## parent if(!is.null(parent)) { parent <- getBlock(parent) if(!is(parent,"GtkWindow")) parent <- parent$GetWindow() if(!is(parent,"GtkWindow")) parent <- NULL # give up } dlg = gtkMessageDialogNew( parent = parent, flags = 0, buttons = buttons, type=icon, message[1] ) ## secret bit. Needs API! If message has length more than ## 1, use rest for secondary text. if(length(message) > 1) dlg['secondary-text'] <- paste(message[-1], collapse = "\n") dlg$SetTitle(title) dlg$GrabFocus() dlg$GetWindow()$Raise() dlg$setDefaultResponse(GtkResponseType["ok"]) # fails -- need to use gtkDialog directly ## add callback to close close.handler = function(h,...) h$obj$Destroy() ## run in modal mode response = dlg$Run() h = list(obj=dlg, action=action) if (response == GtkResponseType["close"] || response == GtkResponseType["delete-event"] || response == GtkResponseType["cancel"]) { dlg$Destroy() invisible(FALSE) } else if(response == GtkResponseType["ok"]) { if(!is.null(handler)) handler(h) dlg$Destroy() invisible(TRUE) } else { gwCat("Don't know this response") print(response) dlg$Destroy() invisible(NA) } }) ## Add input to the above ## h,... in handler has componets action, input (for value) setMethod(".ginput", signature(toolkit="guiWidgetsToolkitRGtk2"), function(toolkit, message, text="", title = "Input", icon = c("info", "warning", "error", "question"), parent=NULL, handler = NULL, action = NULL, ... ) { icon = Paste("GTK_MESSAGE_",toupper(match.arg(icon))) ## parent if(!is.null(parent)) { parent <- getBlock(parent) if(!is(parent,"GtkWindow")) parent <- parent$GetWindow() if(!is(parent,"GtkWindow")) parent <- NULL # give up } ## use message dialog for Gtk dlg = gtkMessageDialogNew( parent = parent, flags = 0, buttons = "GTK_BUTTONS_OK_CANCEL", type=icon, message[1] ) dlg$SetTitle(title) dlg$setDefaultResponse(GtkResponseType["ok"]) ## secret bit. Needs API! If message has length more than ## 1, use rest for secondary text. if(length(message) > 1) dlg['secondary-text'] <- paste(message[-1], collapse = "\n") dlg$GrabFocus() dlg$GetWindow()$Raise() group = ggroup(horizontal=FALSE) # glabel(message, container=group) input = gedit(text,container=group) ## find the area to pack the entry widget ## dlg$GetVbox()[[1]]$PackStart(getBlock(group)) dlg$GetVbox()$PackStart(getBlock(group)) ## dlg$GetVbox()[[2]]$GetWidget()$PackStart(group$ref) ## dlg$GetVbox()$PackStart(group$ref) ## set as default widget <- getWidget(input) widget['can-default'] <- TRUE widget$grabFocus() widget$grabDefault() ## run in modal mode response = dlg$Run() h = list(obj=dlg, ref=dlg, action=action, input=svalue(input)) if(response == GtkResponseType["cancel"] || response == GtkResponseType["close"] || response == GtkResponseType["delete-event"]) { dlg$Destroy() invisible(NA) } else if(response == GtkResponseType["ok"]) { if(!is.null(handler)) handler(h) val = svalue(input) dlg$Destroy() ## input is widget, return value of widget invisible(val) } else { gwCat("Don't know this response") print(response) dlg$Destroy() invisible(NA) } }) ## add a widget to the dialog. This is modal setMethod(".gbasicdialog", signature(toolkit="guiWidgetsToolkitRGtk2"), function(toolkit, title = "Dialog", widget, parent=NULL, handler = NULL, action = NULL, ... ) { ## parent if(!is.null(parent)) { parent <- getBlock(parent) if(!is(parent,"GtkWindow")) parent <- parent$GetWindow() if(!is(parent,"GtkWindow")) parent <- NULL # give up } else { parent <- gtkWindowNew(show=FALSE) } ## button order theArgs <- list(...) buttons <- getWithDefault(theArgs$buttons, c("ok","cancel")) buttonMap <- function(name) { if(name == "ok") list("gtk-ok", GtkResponseType["ok"]) else if(name =="yes") list("gtk-yes", GtkResponseType["ok"]) else if(name == "cancel") list("gtk-cancel", GtkResponseType["cancel"]) else if(name == "close") list("gtk-close", GtkResponseType["close"]) else if(name =="no") list("gtk-no", GtkResponseType["cancel"]) else list("gtk-yes", GtkResponseType["ok"]) } l <- list(title=title, parent=parent, flags=c("modal")) for(i in buttons) { m <- buttonMap(i) l[[length(l) + 1]] <- m[[1]] l[[length(l) + 1]] <- m[[2]] } dlg <- do.call("gtkDialog", l) ## dlg = gtkDialog(title, ## parent=parent, ## c("modal"), ## "gtk-ok", GtkResponseType["ok"], ## "gtk-cancel", GtkResponseType["cancel"] ## ) ## dlg$SetTitle(title) dlg$GrabFocus() dlg$GetWindow()$Raise() tag(widget,"dlg") <- dlg ## group to pack widget in group = ggroup() add(group, widget, expand=TRUE) ## find the area to pack the entry widget dlg$GetVbox()$PackStart(getBlock(group)) ## run in modal mode response = dlg$Run() h = list(obj=widget, action=action) if(response == GtkResponseType["cancel"] || response == GtkResponseType["close"] || response == GtkResponseType["delete-event"]) { ## cancel action dlg$Destroy() return(FALSE) } else if(response == GtkResponseType["ok"]) { if(!is.null(handler)) handler(h) dlg$Destroy() return(TRUE) # was widget, but TRUE now } else { ## default action gwCat("Don't know this response") print(response) dlg$Destroy() invisible(NA) } }) ## with no paret setClass("gBasicDialogNoParentRGtk", contains="gContainerRGtk", prototype=prototype(new("gContainerRGtk")) ) setMethod(".gbasicdialognoparent", signature(toolkit="guiWidgetsToolkitRGtk2"), function(toolkit, title = "Dialog", parent=NULL, handler = NULL, action = NULL, ## do.buttons=TRUE ... ) { ## parent if(!is.null(parent)) { parent <- getBlock(parent) if(!is(parent,"GtkWindow")) parent <- parent$GetWindow() if(!is(parent,"GtkWindow")) parent <- NULL # give up } else { parent <- gtkWindowNew(show=FALSE) } theArgs <- list(...) buttons <- getWithDefault(theArgs$buttons, c("ok","cancel")) buttonMap <- function(name) { if(name == "ok") list("gtk-ok", GtkResponseType["ok"]) else if(name =="yes") list("gtk-yes", GtkResponseType["ok"]) else if(name == "cancel") list("gtk-cancel", GtkResponseType["cancel"]) else if(name == "close") list("gtk-close", GtkResponseType["close"]) else if(name =="no") list("gtk-no", GtkResponseType["cancel"]) else list("gtk-yes", GtkResponseType["ok"]) } l <- list(title=title, parent=parent, flags=c("modal"), show=FALSE) for(i in buttons) { m <- buttonMap(i) l[[length(l) + 1]] <- m[[1]] l[[length(l) + 1]] <- m[[2]] } ## do buttons? do.buttons <- getWithDefault(theArgs$do.buttons, TRUE) if(do.buttons) { dlg <- do.call("gtkDialog", l) } else { dlg <- gtkDialogNew(show=FALSE) dlg$setTransientFor(parent) ## hide separator and button box. Uses internals -- bad idea if widget changes sapply(dlg$getChildren()[[1]]$getChildren(), gtkWidgetHide) } ## dlg = gtkDialog(title, ## parent=parent, ## flags = 0, ## "gtk-ok", GtkResponseType["ok"], ## "gtk-cancel", GtkResponseType["cancel"], ## show=FALSE) dlg$SetTitle(title) dlg$setDefaultResponse(GtkResponseType["ok"]) obj <- new("gBasicDialogNoParentRGtk", block=dlg, widget=dlg, toolkit=guiToolkit("RGtk2")) tag(obj,"handler") <- handler tag(obj,"action") <- action return(obj) }) setMethod(".add", signature(toolkit="guiWidgetsToolkitRGtk2", obj="gBasicDialogNoParentRGtk", value="guiWidget"), function(obj, toolkit, value, ...) { .add(obj, toolkit, value@widget, ...) }) setMethod(".add", signature(toolkit="guiWidgetsToolkitRGtk2", obj="gBasicDialogNoParentRGtk", value="gWidgetRGtk"), function(obj, toolkit, value, ...) { tag(obj,"widget") <- value ## group to pack widget in group <- gtkHBox(spacing=5) group$PackStart(getBlock(value)) ## find the area to pack the entry widget dlg <- getWidget(obj) dlg$GetVbox()$PackStart(group) dlg$GrabFocus() # dlg$GetWindow()$Raise() }) ## dispose of dialog setMethod(".dispose", signature(toolkit="guiWidgetsToolkitRGtk2", obj="gBasicDialogNoParentRGtk"), function(obj, toolkit,...) { dlg <- getWidget(obj) dlg$Destroy() return(TRUE) }) setMethod(".visible", signature(toolkit="guiWidgetsToolkitRGtk2", obj="gBasicDialogNoParentRGtk"), function(obj, toolkit, set=NULL, ...) { if(as.logical(set)) { dlg <- getWidget(obj) handler <- tag(obj,"handler") action <- tag(obj,"action") widget <- tag(obj,"widget") ## run in modal mode dlg$show() response = dlg$Run() h = list(obj=widget, action=action) if(response == GtkResponseType["cancel"] || response == GtkResponseType["close"] || response == GtkResponseType["delete-event"]) { ## cancel action dlg$Destroy() return(FALSE) } else if(response == GtkResponseType["ok"]) { if(!is.null(handler)) handler(h) dlg$Destroy() return(TRUE) # was widget, but TRUE now } else if(response == GtkResponseType["delete-event"]) { ## window manager close return(invisible(FALSE)) } else if(response == GtkResponseType["none"]) { ## dispose() call return(invisible(FALSE)) } else { ## default action message("Don't know this response: ", response) dlg$Destroy() return(invisible(NA)) } } else { gwCat("gbasicdialog: call visible(obj,set=TRUE) to see.\n") return(invisible(NA)) } }) setMethod(".galert", signature(toolkit="guiWidgetsToolkitRGtk2"), function(toolkit, message, title = "message", delay = 3, parent=NULL, ... ) { force(toolkit) ## insert an info bar here? if(is(parent, "gWindow")) { ib <- gtkInfoBar(show=FALSE) ib$setNoShowAll(TRUE) ib$setMessageType("warning") ca <- ib$getContentArea() ca$packStart(gtkLabel(message)) b <- gtkButton(stock.id="cancel") ca$packEnd(b, FALSE) ## add to ibg ibg <- tag(parent, "infobargroup") ourgroup <- ggroup(container=ibg, expand=TRUE, horizontal=FALSE) add(ourgroup, ib, expand=TRUE) visible(ibg) <- TRUE ib$show() closeBar <- function(...) { ib$hide() visible(ibg) <- FALSE delete(ibg, ourgroup) FALSE } gSignalConnect(b, "clicked", closeBar) gTimeoutAdd(delay*1000, closeBar) } else { w <- gwindow(title, width=250, height=100, parent = parent) g <- ggroup(container =w) l <- gbutton(" ", container =g) getToolkitWidget(l)$modifyBg(GtkStateType['normal'], color="red") label <- glabel(message, container =g, expand=TRUE) font(label) <- c("weight"="bold") gimage(filename="close",dirname="stock", container =g, handler = function(h,...) dispose(w)) addHandlerIdle(w, handler = function(h,...) dispose(w), interval = as.numeric(delay)*1000) } invisible(w) }) gWidgetsRGtk2/R/zzz.R0000644000175100001440000000012311725761513014104 0ustar hornikusers.onLoad <- function(...) { } .onAttach <- function(...) { loadGWidgetIcons() } gWidgetsRGtk2/R/gseparator.R0000644000175100001440000000237311406427002015413 0ustar hornikusers################################################## ## add a separator to a container. Needs the container setClass("gSeparatorRGtk", contains="gComponentRGtk", prototype=prototype(new("gComponentRGtk")) ) ## should this return object? setMethod(".gseparator", signature(toolkit="guiWidgetsToolkitRGtk2"), function(toolkit, horizontal = TRUE, container = NULL, ...) { force(toolkit) if(horizontal) { separator = gtkHSeparatorNew() } else { separator = gtkVSeparatorNew() } obj <- as.gWidgetsRGtk2(separator) if (!is.null(container)) { if(is.logical(container) && container == TRUE) container = gwindow(visible=TRUE) add(container, obj,...) } invisible(obj) }) as.gWidgetsRGtk2.GtkHSeparator <- as.gWidgetsRGtk2.GtkVSeparator <- function(widget,...){ obj <- new("gSeparatorRGtk", block=widget, widget=widget, toolkit=guiToolkit("RGtk2")) return(obj) } .isgSeparator <- function(obj) { (is(obj,"guiComponent") && is(obj@widget,"gSeparatorRGtk") ) || is(obj,"gSeparatorRGtk") } gWidgetsRGtk2/R/gbutton.R0000644000175100001440000001436413233652563014745 0ustar hornikuserssetClass("gButtonRGtk", contains="gComponentRGtk", prototype=prototype(new("gComponentRGtk")) ) setMethod(".gbutton", signature(toolkit="guiWidgetsToolkitRGtk2"), function(toolkit, text="", border=TRUE, handler=NULL, action=NULL, container=NULL,... ) { force(toolkit) iconname <- getstockiconname(tolower(text)) if(!is.na(iconname)) { button <- gtkButtonNewFromStock(iconname) button$Show() } else { button <- gtkButtonNewWithLabel(text) } ## look for border request if(border == FALSE) button$SetRelief(2L) obj <- as.gWidgetsRGtk2(button) ## obj <- new("gButtonRGtk", ## block=button, widget=button, toolkit=toolkit) tag(obj, "default_fill") <- "x" ## add to container if (!is.null(container)) { if(is.logical(container) && container == TRUE) container <- gwindow(visible=TRUE, toolkit=toolkit) add(container, obj,...) } ## add handler if (!is.null(handler)) { tag(obj,"handler.id") <- addhandlerclicked(obj,handler,action) } invisible(obj) }) ## coerce gtk object as.gWidgetsRGtk2.GtkButton <- function(widget,...) { parent <- widget$parent if(is.null(parent)) { parent <- gtkAlignmentNew(xscale=1, yscale=0) parent$add(widget) } obj <- new("gButtonRGtk", block=parent, widget=widget, toolkit=guiToolkit("RGtk2")) return(obj) } ## constructor for actions ## proper call is gbutton(action = gaction_instnace, cont = ...) setMethod(".gbutton", signature(toolkit="guiWidgetsToolkitRGtk2", action = "guiComponent"), function(toolkit, text="", border=TRUE, handler=NULL, action=NULL, container=NULL,... ) { if(is(action@widget, "gActionRGtk")) { .gbutton(toolkit, "", border, handler, action@widget, container, ...) } else { callNextMethod(toolkit, text, border, handler, action, container, ...) } }) setMethod(".gbutton", signature(toolkit="guiWidgetsToolkitRGtk2", action = "gActionRGtk"), function(toolkit, text="", border=TRUE, handler=NULL, action=NULL, container=NULL,... ) { force(toolkit) gtkaction <- getWidget(action) button <- gtkButton() obj <- new("gButtonRGtk", block=button, widget=button, toolkit=guiToolkit("RGtk2")) action@e$buttons <- c(action@e$buttons, obj) #gtkaction$connectProxy(button) button$setRelatedAction(gtkaction) button['use-action-appearance'] <- TRUE ## icon icon <- gtkaction['stock-id'] if(!is.null(icon)) { image <- gtkaction$createIcon(GtkIconSize["button"]) button$setImage(image) } ## tooltip tip <- gtkaction['tooltip'] if(!is.null(tip)) tooltip(obj) <- tip if(!is.null(container)) { if(is.logical(container) && container) { container <- gwindow() add(container, obj) } else { add(container, obj, ...) } } return(obj) }) ### methods ## return button text setMethod(".svalue", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gButtonRGtk"), function(obj, toolkit, index=NULL, drop=NULL, ...) { return(obj@widget$GetLabel()) }) ## set button text setReplaceMethod(".svalue", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gButtonRGtk"), function(obj, toolkit, index=NULL, ..., value) { button = obj@widget image = gtkImageNew() if(is.gImage(value)) { filename = tag(value,"filename") if(!is.na(getstockiconname(filename))) { ## stock image$SetFromStock(getstockiconname(filename),size=obj$size) } else { image$SetFromFile(filename) } button$SetImage(image) } else if(is(value,"gLabelRGtk")) { button$SetLabel(value@widget) } else { button$SetLabel(value) } return(obj) }) ## font -- push down to label setReplaceMethod("font",signature(obj="gButtonRGtk"), function(obj, ..., value) { .font(obj, obj@toolkit,...) <- .fixFontMessUp(value) return(obj) }) setReplaceMethod(".font", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gButtonRGtk"), function(obj, toolkit, ..., value) { widget <- getWidget(obj)[[1]] # label is first child or something if(is(widget, "GtkAlignment")) widget <- widget[[1]][[2]] # a real hacke .font(widget, toolkit, ...) <- value invisible(obj) }) ### handlers setMethod(".addhandlerchanged", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gButtonRGtk"), function(obj, toolkit, handler, action=NULL, ...) { addhandlerclicked(obj, handler, action,...) }) setMethod(".addhandlerclicked", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gButtonRGtk"), function(obj, toolkit, handler, action=NULL, ...) { addhandler(obj,"clicked",handler, action,...) }) ## for popup menu setMethod(".addpopupmenu", signature(toolkit="guiWidgetsToolkitRGtk2",obj="gButtonRGtk"), function(obj, toolkit, menulist, action=NULL, ...) { addPopupMenuWithSignal(obj, toolkit, menulist, signal="clicked",...) }) gWidgetsRGtk2/MD50000644000175100001440000001440613246035251013235 0ustar hornikusers023c43c238f84fecd19164e20edc35ed *ChangeLog ea6e2f0659eabd69feae04fdff51f7ae *DESCRIPTION a184b3923492d1f235021e6cc834ef87 *NAMESPACE b48b89d5be9a262b8e6367d445314595 *NEWS 4d497d9ae0d1d01e1e683c967785b080 *R/aaaGenerics.R de4286e642f90463d6bce19d5b8afa8b *R/aabClasses.R bb87606a176ab362d83cefa5d68e1e91 *R/aacR5Classes.R 1398351123167e493e46d9863a781e3a *R/common.R c6805d40793f6552a1913468f721897c *R/dnd.R 77076cb9b1e4b3cfd0e7a80384879999 *R/gaction.R fd791a66c5975219ed2dd2c431ad079d *R/gbutton.R 03ffa9a396b377c6fc49ce87974ffab4 *R/gcalendar.R 4b96bbce1e61d95011d70d85333af20e *R/gcheckbox.R ef13f0164c232755a94b11422b2f10bd *R/gcheckboxgroup.R 1c63fd50d6b9b0ad1e7cfcee54e38e59 *R/gcommandline.R 9b9687aa810318a1a718fb8abd4f0ace *R/gdfedit.R 771b27493f6b75687f943a6fb8814840 *R/gdfnotebook.R 0dcc9b215e2bb5df33029243fbf874d8 *R/gdialogs.R a9a1b54641902cf3f797d2621086e9b7 *R/gdroplist.R a5fe294130e13e01309870b927099ed0 *R/gedit.R 945df5e2c12ac8bbf7a5cea334760950 *R/gexpandgroup.R 65eb87ab0fb7e41bb778fbe78f5bdeea *R/gfile.R a4cf578410a74481538095fb77dc3452 *R/gframe.R 5e3ef2c758c09d6946833185b7f7fa1a *R/ggraphics.R b7067cbd2f67845e1521f4482e6da815 *R/ggraphicsnotebook.R 6b847c0770d335a87a6d46912efcdfe7 *R/ggrid.R 957bebe2bbb316da6304b3840a9bd150 *R/ggroup.R 3181d5f6a30dea7f19344d5c15104da5 *R/ghelp.R 327ef60abd26756bd554101776716f08 *R/ghtml.R 80ecc407a95b622d346b49bcdd623edd *R/gimage.R 3c884e13e493a2868fc898e4fd00eb00 *R/glabel.R 631b8269257ceb128f1449938139e718 *R/glayout.R 7a8eda27bc76fb39eafecb6fba430d47 *R/gmenu.R 1288b59c3e394da87b5c4a89a638b2e2 *R/gnotebook.R 81c446523dea436bb8bae3ee7250d3b6 *R/gpanedgroup.R b49cf61737dfc31bb458012794df854a *R/gradio.R 14f0b50f9d52ae9b27466aeb46e25aa5 *R/gseparator.R a14dcdd39f964b1aa9e22b01a921e5cd *R/gslider.R 45013acf15c5e12c7bc1e9057dce134d *R/gspinbutton.R 011167bc5cc11cfff941a4c3cc4db4c1 *R/gstatusbar.R 40c1c16614644e3d1d7cd3eb6555b4a1 *R/gtext.R a397459439288e3e2a0671e6d0b7f978 *R/gtkStuff.R e4e741c284485a1e913afbaa07f1dded *R/gtoolbar.R 25efbf6d57754b0c0eebc679ce2833f1 *R/gtree.R 6a826fe019c11fccfb948213b94ffe04 *R/gvarbrowser.R 54285e9288bbe89122fc8110c1c2326b *R/gwindow.R 22141f3574edab7c171b918eeb104734 *R/icons.R 83016f23fbd74dc68e6544260d10decc *R/zzz.R da46dd635971ef83d7e6fad8fdc3a582 *inst/examples/t.test.glade 2a0a77b75c7566f417f75fdd8c4c3576 *inst/images/2dlayer.xpm 9216797db68dde4806b2741e2b9f0c7f *inst/images/3dcontour.xpm e70e56694a99aa3f6b52be30fb509bdb *inst/images/arrows.xpm 5549a0718c8348b20d388034629d050a *inst/images/arrows1.xpm 89a81ecdf020f39cc85ee8fda7f17577 *inst/images/barplot.xpm 10cfc98bd7344048b7963bc4f6e4e378 *inst/images/boxplot.xpm 0662b05ce9cd74e471251829ea5d6a94 *inst/images/boxplot1.xpm f1c246f36a3fa633d34910ac39e3e381 *inst/images/bubbles.xpm 8f56f08fb2c398b15595561ba0eea537 *inst/images/calendar.xpm 6dad5e5de2827241be25ec1aa687bbc6 *inst/images/cloud.xpm 60d345d9bbc1373b2f1c04157d768979 *inst/images/contour.xpm cf5348757eaceaa2d1e1346cb26f88d9 *inst/images/curve.xpm 491cc29871a29c3c2b9f0346018d8ae0 *inst/images/darrow.gif fa31030f1b43015447c51d1858d69b94 *inst/images/darrow.xpm 778f43132a1eac487db9b535018b3ab6 *inst/images/dataframe.xpm c71564c0f5c6760ecfccb3358299b1d4 *inst/images/density.xpm 563f90b14ae379e2c4d50c0ebc87bcfe *inst/images/evaluate.xpm 7c12e637d84488587e3f155dc6230cc1 *inst/images/factor.xpm 7e8e7de464d09fda6ae8511f51370fba *inst/images/function.xpm a927efe27be705bb11ca77ca0e8581cd *inst/images/function1.xpm 9ef44dffabcedf1a30dcd2459a569b35 *inst/images/graph.xpm a04cc08329f1fe2d277776751fa23b21 *inst/images/graph2.xpm 5fbd5b430473d27ede7cced864408ef9 *inst/images/hist.xpm d44c572dc124488d16bd73458aed3ee4 *inst/images/integer.xpm 9b0d47b06931ab4bb77cd09110558396 *inst/images/larrow.gif bb500c84dfe37a959a17de1b294aa160 *inst/images/larrow.xpm e2c9bfe34f9b04312993762f7384826e *inst/images/lines.xpm 7fff686de991096399cf74a776b37b53 *inst/images/logical.xpm e165538bbf25368435b31245d32a1529 *inst/images/matrix.xpm 1060eb2bb27efb256c279086e0a58ec4 *inst/images/newplot.xpm d44c572dc124488d16bd73458aed3ee4 *inst/images/numeric.xpm 42f724c869cb40efb3ceef006712c260 *inst/images/pch2.xpm ab2a3a1e10dd8b0e4eb321b8b3442688 *inst/images/plot.xpm 65e516517d4a4c571f8f6d925bf77285 *inst/images/plot1.xpm 735ed8ddcabdbaf0cd5156b5908f1c00 *inst/images/points.xpm 21c0ef56dd08c66e4e4d7240ce3b7887 *inst/images/polar.xpm b4b1778e50c6d53d7cfbbca41e7d886d *inst/images/rarrow.gif b8dfb6780291813fb51c8c7eb2077380 *inst/images/rarrow.xpm 7d7f054aa24c7ba19c6b0b4d351c932e *inst/images/rename.bmp b8ecfe355e5fc982d84d1c11e9d6ea9b *inst/images/rename.jpg 232e358ca522a391b21f9cf987d100f2 *inst/images/rename.xbm 40f369a838d1ae6c39c2f71f79ecc0c3 *inst/images/rename.xpm 8d35a49218bf68da18138d894f44c5e0 *inst/images/scatterplot3d.xpm 0a6ece99efc7c7dd9c115b22f29d9af1 *inst/images/select.xpm e00617543685c48372773505d994f838 *inst/images/spike.xpm b9724b6353d36eb3adcd1e6934742843 *inst/images/subset.xpm 54bcae9d63efc7eebb82975f8257fbbc *inst/images/symbol_circle.xpm 5413b769896cb476dbc14fad3a09e1c4 *inst/images/symbol_cross.xpm 62fddd1003abbfea6faaff29f1f918c7 *inst/images/symbol_diamond.xpm ab4ea2aae18da3e42ccaa2b5307ad518 *inst/images/symbol_dntriangle.xpm cdb23bf1cc3a631ed68d60eef406b352 *inst/images/symbol_dot.xpm 7481a470eea5b13e2696c38f5b2d19fc *inst/images/symbol_impulse.xpm dd040b9f42187e295f4c61a56268d8fe *inst/images/symbol_ltriangle.xpm b3e2119ca72781508b7a8961749b9da4 *inst/images/symbol_none.xpm 9099e61a24490c643655f00fb87f700e *inst/images/symbol_plus.xpm 636b33d46835b3822b67b7689a8fafc0 *inst/images/symbol_rtriangle.xpm 46a301b9625ebc1de4daad91662162ea *inst/images/symbol_square.xpm 97bb6c248fc7d0a57a434e32d491ae20 *inst/images/symbol_star.xpm 94535ad2bf2d2d357d5e7ce6bed4ed2b *inst/images/symbol_uptriangle.xpm 319cb5ed775fcfd5e747418547b857c4 *inst/images/target.xpm b7b1240926dcc68779df37ce30ec0893 *inst/images/ts.xpm 6fa6138a3772e3cfd4f3b6aae7318f70 *inst/images/uarrow.gif b9b35e994d30d3219f0f5e7944d96973 *inst/images/uarrow.xpm f900afb8c7485e59265e9e27b5da5549 *man/as.gWidgetsRGtk2.Rd 0248043ee1a3ee80b60d7381c40ae677 *man/gWidgetsRGtk2-misc.Rd 90722b1a2edff3dfb0b4ed1376a43d0b *man/gWidgetsRGtk2-package.Rd db1f006a3690c4ff713fa1651e3d8b68 *man/gWidgetsRGtk2-undocumented.Rd 939bad23768c5894431b7a118b546196 *man/gdfedit.Rd 783e31fc254f6ed46dbb53c7a70b2b22 *tests/RunTests.R e20ce11d67ecb783e0454feaf118907c *tests/runRUnit.R gWidgetsRGtk2/DESCRIPTION0000644000175100001440000000100713246035251014424 0ustar hornikusersPackage: gWidgetsRGtk2 Version: 0.0-86 Title: Toolkit Implementation of gWidgets for RGtk2 Author: Michael Lawrence, John Verzani Maintainer: John Verzani Depends: methods, grDevices, utils, graphics, RGtk2, gWidgets, cairoDevice Enhances: RGtk2Extras Description: Port of the gWidgets API to the RGtk2 toolkit. License: GPL (>= 2) LazyLoad: yes Packaged: 2018-01-29 17:10:41 UTC; parallels NeedsCompilation: no Repository: CRAN Date/Publication: 2018-03-01 17:38:49 UTC RoxygenNote: 6.0.1 gWidgetsRGtk2/ChangeLog0000644000175100001440000010043311743573702014503 0ustar hornikusers2012-04-18 john verzani * R/aaaGenerics.R: fix to visible method to handle case set=NULL (Thanks to Volker Steiß) 2012-03-07 john verzani * R/dnd.R: attempt to fix dnd for gdf 2012-02-19 john verzani * R/ggraphics.R (daDrawRectangle): put in code to find width and height that should be more robust. We had issue with rubber banding. 2011-12-31 john verzani * R/gfile.R: uncomment multi argument. It is in gWIdgets now. 2011-12-19 john verzani * R/ggraphics.R (.setDevNo): added argument do.rubber.banding through ... to suppress the rubber banding handler 2011-10-25 john verzani * R/gvarbrowser.R (## getObjectFrom_h): change update method to include value of filter. Thanks Stephanie (idleHandler): reverted to idle handler -- as opposed to task callback -- so that all operations cause update 2011-09-30 john verzani * R/icons.R: Remove assignInNamespace bits, replaced with environments 2011-09-26 john verzani * R/gtext.R (.addTags): had commented out them code for insert. Put back in. The code can take awhile, so called first time user requests it, not on startup. 2011-09-14 john verzani * R/ggrid.R (addNewColumnDialog): fixed subset feature. Broken via change to gexpandgroup and height wasn't working. Thanks again to Stephanie! 2011-07-31 john verzani * R/gtkStuff.R (getWidget): Added generics to process $, [[ and [[<- calls for working with undelrying RGtk2 widget. 2011-07-30 john verzani * R/ggrid.R (addTreeViewColumnNoEdit): took out needless call to rownames (was giving error). Thanks Stephanie 2011-07-27 john verzani * R/gdialogs.R (galert): When parent is a gwindow instance, this dialog now uses a GtkInfoBar instance. Requires gWidgets 0.0-46 or later. 2011-07-23 john verzani * R/gdialogs.R (gbasicdialgo): Added do.buttons argument when run with no widget (preferred way). 2011-07-22 john verzani * R/glayout.R (as.gWidgetsRGtk2.GtkTable): fixed bug in dimension 2011-07-13 john verzani * DESCRIPTION (Version): version bump 2011-07-12 john verzani * R/gedit.R (.setCompletion): fixed visible<- method for password use, fixed intial.msg and svalue issue 2011-06-25 john verzani * R/gtext.R (.addTags): reworked fonts. Graham W pointed out slowness and this makes much more sense. 2011-05-13 john verzani * R/aacR5Classes.R: changed class of function to ANY, not function so that proto objects will work. (Thanks Yvonnick and Gabor) 2011-05-03 john verzani * R/ggrid.R: fixed bug with svalue<- method * R/aacR5Classes.R: argument checked added to block_ovserver for R5 widgets 2011-04-22 john verzani * R/aacR5Classes.R: removed sapply with lapply calls. Changes in 2.13 to sapply (actually call to simplify2array) cause issues. (Thanks Stephanie) 2011-03-22 john verzani * R/ggrid.R: svalue<- will scroll to selected value 2011-01-26 john verzani * R/gstatusbar.R: added our own label to work around size issues with newer gtk 2011-01-21 john verzani * R/gedit.R (.setCompletion): check for NULL value to svalue<- (threw RGtk2 warning) (Thanks Hana) * R/gradio.R: Replaced this and gcheckboxgroup with a new design using a backend Reference class. The code is much cleaner, but I still get instability running under gctorture. 2011-01-19 john verzani * R/ggraphicsnotebook.R: quieted down warnings about partial argument matching. 2011-01-17 john verzani * R/gedit.R (.svalue<-): fix to svalue and init_msg 2011-01-10 john verzani * R/gdroplist.R (.as.gWidgetsRGtk2.gdroplist): [<- remembers where it is (if possible) when we replace objects 2011-01-05 john verzani * R/ggrid.R: added columnWidths option to size<- method. Pass in size value as list with this component 2011-01-04 john verzani * R/gaction.R: put in key.accel bit. Needs parent to be passed in. * R/aaaGenerics.R: update tooltip<- to newer GTK style 2010-12-14 john verzani * R/gdroplist.R: fix minimum column width under windows (15 was too narrow a minimum) 2010-12-02 john verzani * R/gtext.R (.addTags): put in check that we aren't redoing a text tag 2010-11-23 john verzani * R/gvarbrowser.R (updateCallback): replace idle handler with taskCallback for update. Seems much nicer, although possibly fragile as a user can remove the callback too easily. 2010-11-10 john verzani * R/glayout.R (as.gWidgetsRGtk2.GtkTable): New logic to handle expand, fill, anchor arguments when widget packed into gtkAlignment container 2010-11-09 john verzani * R/gbutton.R (as.gWidgetsRGtk2.GtkButton): put in gtkAlignmentWidget, along with combobox. Changes behaviour of layout, but implements fill= argument to add method of ggroup 2010-11-07 john verzani * R/gslider.R: packed in alignment widget * R/ggroup.R (as.gWidgetsRGtk2.GtkVBox <- as.gWidgetsRGtk2.GtkHBox): fixes to ".add" method and fill argument 2010-11-01 john verzani * R/gslider.R (gsliderindex): changed so that one can use vector of orderable values. Pass to from argument initially. 2010-10-26 john verzani * R/glabel.R (addHandler): for glabel and gimage -- both use event boxes -- put in check to see if widget is sensitive to events when calling a handler. 2010-10-25 john verzani * R/gvarbrowser.R (idleHandler): hacks to add in auto update option. Really should rewrite this to be faster thoough. 2010-10-15 john verzani * R/gcheckbox.R: add option use.togglebutton=TRUE to use toggle button in place of checkbox. 2010-10-14 john verzani * R/gtree.R (isStillThere): fixes to this -- again. 2010-10-10 john verzani * R/ggroup.R: fill argument added. Before was simply taken as "both". 2010-09-29 john verzani * R/gwindow.R (as.gWidgetsRGtk2.GtkWindow): adjustments to border-width 2010-09-25 john verzani * R/gvarbrowser.R: Fixed bug in isStillThere, added summary column (Thanks to Tom T. and wxffxw); 2010-08-28 john verzani * R/gdialogs.R: Try to make OK button default button. Doesn't work, need to use gtkDialog, not gtkMessageDialog it seems * R/aaaGenerics.R: in 3rd mous popup propogate signal to next handler. (So 3rd mouse will still do selection) 2010-08-26 john verzani * R/gvarbrowser.R (tag(tree, "isStillThere")): check if there are empty values to avoid crash 2010-08-24 john verzani * R/gbutton.R: fixed tooltip issue when adding gaction backend for button 2010-08-21 john verzani * R/ggraphics.R: cleaned up code. Issue with size can be avoided by suppressing drawing of window until after this widget is added. * R/gradio.R (as.gWidgetsRGtk2.GtkRadioButton): fix to allow [<- to shorten length 2010-07-27 john verzani * R/gtext.R: fix insert method and scroll to end 2010-07-26 john verzani * R/gtree.R (isStillThere): Change to index=TRUE in svalue. No longer specifies chosen column, rather returns index. Implemented svalue<- method. * R/gvarbrowser.R: fixes to this suggested by TT. svalue, 2010-07-25 john verzani * R/gtree.R (isStillThere): fix to add this function for update 2010-07-23 john verzani * R/gvarbrowser.R (.inClass): put in multiple argument; can override stockIconFromClass (see gWidgetsRGtk2 page); * R/gtree.R: return NA if no selection 2010-07-16 john verzani * R/glayout.R (as.gWidgetsRGtk2.GtkTable): Added [ method for extraction of widget 2010-07-15 john verzani * R/aaaGenerics.R: fix to font<- (color was using modifyText, not modifyFg) 2010-07-08 john verzani * R/ggraphics.R (.setDevNo): added popupmenu to save graphic to clipboard and to save to a file. 2010-07-06 john verzani * R/ggraphics.R Added rubber-band selection and the method addHandlerChanged to set a callback for when a selection is made. See the ggraphics man page for an example 2010-07-05 john verzani * R/ggraphics.R (.setDevNo): fix to issue with plot.new before drawing. Took trick from playwith (.setDevNo): Put in code to raise graphic device when mouse clicks or mouses over. Not sure latter is right. Perhaps focus event is more natural? 2010-06-28 john verzani * R/gtree.R: bug fix for gtree when icons not set 2010-06-20 john verzani * R/aaaGenerics.R: put in check for delete method 2010-05-27 john verzani * R/gedit.R (.setCompletion): visible(obj)<-FALSE for password entry 2010-05-19 john verzani * R/glabel.R (as.gWidgetsRGtk2.GtkLabel): fix to svalue<-() method when text is character vector with length > 1. 2010-05-11 john verzani * R/gfile.R: add multi=TRUE option to constructor for multiple selection of files 2010-05-05 john verzani * R/glabel.R: fix to this when editable=TRUE (was throwing error) 2010-04-20 verzani * R/gdialogs.R: issue with gbasicdialog with parent object when using as container 2010-04-18 john verzani * R/gcheckboxgroup.R: new option use.table implemented 2010-04-11 john verzani * R/gtree.R: fixed obj[] error if no selection (Thanks Tom) 2010-03-23 john verzani * R/ggrid.R (addTreeViewColumnNoEdit): fix edit.handler to work with visible rows * R/gtext.R (font<-): made change to font<- when no text is selected. Rather than do nothing, it now changes font for entire buffer. 2010-03-22 john verzani * R/gtext.R: Made font.attr argument to constructor apply to entire buffer. To specify font.attr for pieces of text, the add method or the font<- method can be used. 2010-03-16 john verzani * R/ggrid.R (makePaddedDataFrame): minor fixes to handle 0-length icon specification (make.row.names): fix to setReplaceMethod to work when 0ing out data store 2010-03-13 john verzani * R/ggrid.R: allow svalue(obj, index=TRUE) <- 0 to clear selection 2010-03-09 john verzani * R/gdfnotebook.R: fix to saving empty variable, fix to adding new data frame by variable * R/gedit.R (adddroptarget): Fix to make dnd work as expected when overriding default GTK dnd for gedit widget. 2010-03-08 john verzani * R/gmenu.R: fix to get images to display for new gtk versions * R/gtoolbar.R: minor fix to avoid gtk error when gtkToolButton called with label=NULL 2010-03-05 john verzani * R/gmenu.R: fix to SetImage that was not working as advertised 2010-02-17 john verzani * R/gvarbrowser.R: Make "knownTypes" variable, a list with components specifying similar classes, editable by the user. Either pass in argument "knownTypes" to constructor, or set as option. 2010-02-11 john verzani * R/gdfedit.R (gdfedit): put in [<- method -- should check for match in column class, rather than wrap in try. 2010-02-09 john verzani * R/gdfedit.R (gdfedit): new function for RGtk2DfEdit * R/aaaGenerics.R: fixed remove handler for timeout ids. 2010-01-15 john verzani * R/gfile.R: Fix to filter and intialfilename (Thanks Felix) 2010-01-04 john verzani * R/ggrid.R (addTreeViewColumnNoEdit): Put in hidden argument diy with values in c("suppress.key", "suppress.popup") to suppress adding motion handlers or popup on column header click. This allows user to define their own. 2010-01-03 john verzani * R/gnotebook.R: fix to h$pageno -- added 1. Thanks to Y.N. 2010-01-02 john verzani * R/gedit.R: change addHandlerChanged signal to "activate". This way when svalue<- is called, the activate signal can be emitted. 2009-12-29 john verzani * R/aaaGenerics.R: fix to handler.id to store handlers so that we can block/unblock when using svalue<- for gtable 2009-12-18 john verzani * R/gbutton.R (as.gWidgetsRGtk2.GtkButton): fix to font<- method for buttons. 2009-12-17 john verzani * R/ggrid.R: yet one more change to svalue<-. This time be intelligent when setting by value, not index by ensuring index is only if an integer is passed in unless explicit index=TRUE 2009-12-16 john verzani * R/gdroplist.R (.as.gWidgetsRGtk2.gdroplist): not handling svalue(.,index=FALSE) <- value properly. * R/ggrid.R: fix to selection -- wasn't working with index=FALSE. 2009-12-14 john verzani * R/ggrid.R: fix to selection -- forgot to clear out old indices 2009-12-01 john verzani * R/aaaGenerics.R: fixed passing of action into addHandler after some earlier cleanup 2009-11-20 john verzani * R/gradio.R (as.gWidgetsRGtk2.GtkRadioButton): fix to visible<- method 2009-11-14 john verzani * R/aaaGenerics.R: added ColumnClicked, ColumnRightClick, ColumnDoubleClick handlers for ggrid 2009-11-05 john verzani * R/gnotebook.R: added h$pageno to addHandlerChanged to get the current page number. In a handler, GetCurrentPage() is not correct. 2009-09-25 john verzani * R/aaaGenerics.R: added check for ctrl-1 when right button expected (for mac use) 2009-09-08 john verzani * R/gfile.R: fix to gfilebrowse on cancel. (Hana S); added expand=TRUE to gedit instance. Set width with width argument passed to gedit, not size. Fixed issue with height of button by nesting ggroup containers (mix horizontal and vertical) 2009-08-25 john verzani * R/gspinbutton.R (as.gWidgetsRGtk2.GtkSpinButton): added [<- method for this. Need to have regular data 2009-06-30 john verzani * R/gvarbrowser.R (.inClass): fix typo (thanks Albert) 2009-06-29 john verzani * R/gbutton.R (as.gWidgetsRGtk2.GtkButton): Fix to constructor with action argument 2009-06-24 john verzani * R/aaaGenerics.R: fix bug to font with colors 2009-06-15 john verzani * R/gtree.R: fixed bug with column types when hasOffpsring given as second column of offspring 2009-06-11 john verzani * R/ggrid.R (make.row.names): fix to hide error when setting store which doesn't have rownames. (Error in x[[jj]][iseq] <- vjj :) * R/gdialogs.R: fixed bug with this under windows/mac that came up for new RGtk2. Also added subtext if length(message) > 1. 2009-05-07 john verzani * R/gfile.R: fixed return to NA -- not "" if no file 2009-03-02 john verzani * R/gvarbrowser.R (.inClass): put in secret interval argument for gvarbrowser to slow down polling 2009-01-31 john verzani * R/gvarbrowser.R (.inClass): fix to gvarbrowser to list knownTypes better using is(), added POSIXt to data types. How to get a list of these. 2008-12-15 john verzani * R/gdialogs.R: added new feature with gbasicdialog 2008-12-09 john verzani * R/gtext.R (.addTags): if inserting at end, moves scrollbar to bottomS 2008-12-08 john verzani * R/gtext.R (.addTags): added insert method to replace overworked add (.addTags): move to end when adding if at end 2008-11-23 john verzani * R/gdialogs.R: fixed return value of ginput 2008-11-22 john verzani * R/gcalendar.R (lgedit): coerce with failed to be implemented 2008-11-18 john verzani * R/gcheckboxgroup.R: More consistent defn of svalue<- * R/gaction.R: implemented svalue<- 2008-10-28 john verzani * R/gtext.R (.addTags): fixed type calling keystroke handler * R/gdroplist.R: added width= argument through ... Should make this part of gcombobox API * R/gframe.R: fixed expand argument -- was always TRUE 2008-10-21 john verzani * R/ggrid.R: fix to get gtable to work with CO2 data frame (coercion to data.frame, ordered factors) 2008-10-13 john verzani * R/gtext.R (.addTags): fix to tags to get past strict type checking 2008-10-07 john verzani * R/gcheckboxgroup.R: Fixed handler code in gcheckboxgroup to return a vector of IDS, implemented remove, block, unblock 2008-09-23 john verzani * R/gdroplist.R: made wider in windows if small 2008-09-19 john verzani * R/glabel.R (as.gWidgetsRGtk2.GtkLabel): svalue<- will coerce strings with length 2 or greater to single string pasted with "\n" 2008-09-14 john verzani * R/gframe.R (as.gWidgetsRGtk2.GtkFrame): fixed methods for svalue, names, names<- * R/gexpandgroup.R (as.gWidgetsRGtk2.GtkExpander): fixed up svalue method * R/glayout.R (as.gWidgetsRGtk2.GtkTable): Work on anchor argument 2008-09-12 john verzani * R/gtkStuff.R (setXYalign): rewrote to test class of object, not use try() * R/aaaGenerics.R: fixes to defaultWidget<-; * R/gdialogs.R: fixed processing of response in dialog -- was issue when closing out via window manager. Added focus to input box in ginput. 2008-09-11 john verzani * R/gedit.R (.setCompletion): make key-release-event -- not key-press-event for keystroke handler * R/ggrid.R: put in doSort=FALSE so that visible<- works except when sorting is explicitly called 2008-09-02 john verzani * R/ggroup.R (as.gWidgetsRGtk2.GtkVBox <- as.gWidgetsRGtk2.GtkHBox): set default for alignment to be RGtk2 default so no setXYalign call if not requested. (Thanks Felix) * R/gedit.R (.setCompletion): added this function -- if completion is set via [<-, then this gets added otherwise not. Should speed things up. (Thanks Felix) 2008-08-26 john verzani * R/gtkStuff.R: no speed up to gtktry? This is slow, but changes didn't make a difference. * R/common.R: speed fixes by avoiding %in% when ==+|| will do. * R/icons.R: Speed up to getstockicons. Use cache to keep list (avoiding regeneration each time) with flag for when new icons are added. This speeds up gcombobox significantly. * R/gtkStuff.R (setXYalign): New function to speed up ggroup, glayout. The lookup of property names via names(gtkobject) was very slow, so instead we just use try to catch errors 2008-08-22 john verzani * R/gnotebook.R (as.gWidgetsRGtk2.GtkNotebook): fix to event box SetVisibleWindow(FALSE) so that under windows the white background is not covered up. 2008-08-21 john verzani * R/gframe.R: fixed y align value to be .5, not 0 2008-08-20 john verzani * R/gedit.R: fixed width argument * R/gframe.R (names<-.GtkFrame): fixed bug in names<- preventing markup from working 2008-08-06 john verzani * R/ggroup.R (as.gWidgetsRGtk2.GtkVBox <- as.gWidgetsRGtk2.GtkHBox): fixed issue with centering as anchor had mistaken default. 2008-07-15 jverzani * R/gvarbrowser.R: update() method extended to gvarbrowser * R/gtoolbar.R: fixed expand=TRUE in adding toolbar group to container. This can be passed in via ... if desired. * R/gradio.R (as.gWidgetsRGtk2.GtkRadioButton): fixed error with enable<-. Needed to map to all buttons. * R/gpanedgroup.R (as.gWidgetsRGtk2.GtkHPaned <- as.gWidgetsRGtk2.GtkVPaned): typo in svalue<- 2008-05-19 jverzani * NAMESPACE: added addHandlerChanged eg. to fix errors with R-devel check 2008-05-17 jverzani * R/gcheckboxgroup.R: used obj inplace of x in leftbracket def. Made [<- method work to replace values if called obj[]<-newitems. 2008-05-03 jverzani * DESCRIPTION (Depends): put cairoDevice from extends to suggests * man/gWidgetsRGtk2-undocumented.Rd: documentation errors 2008-05-02 jverzani * R/gedit.R: fixed bug in windows with completion. Not all completion properties are available here. 2008-04-23 jverzani * R/gdialogs.R: added parent argument to dialogs 2008-04-19 jverzani * R/ggroup.R (as.gWidgetsRGtk2.GtkVBox <- as.gWidgetsRGtk2.GtkHBox): added anchor arugment to ggroup * R/glayout.R (as.gWidgetsRGtk2.GtkTable): getBlock, not getWidget for alignment 2008-04-13 jverzani * R/gradio.R: fixed handler to call only select part of toggled. (as.gWidgetsRGtk2.GtkRadioButton): fixed up gradio to be able to use as.gWidgetsRGtk2 2008-04-12 jverzani * R/aaaGenerics.R: added blockHandler, unblockHandler to API as in between of add remove 2008-04-06 jverzani * R/glayout.R (as.gWidgetsRGtk2.GtkTable): removed the visible()<- requirement of the old glayout. Now lays ou dynamically 2008-04-01 jverzani * R/gwindow.R: ".add" method works for RGtkObjects too. * R/ggrid.R (make.row.names): fixed names() in leftbracket method. (Olivier Nunez) 2008-03-17 jverzani * R/gtext.R: added addHandlerKeystroke with h$key returning keyvalue 2008-03-11 jverzani * R/gwindow.R: add toolkit=toolkit option in the constructors used within main constructors. This makes toolkit work better. 2008-03-05 jverzani * R/glayout.R: Added expand=TRUE/FALSE argument to [<- method. Should work as expected, default is FALSE. Fixed so that [<- works with RGtk2Object too. We don't dispatch on "value" so we do this by class of value object within [<- and visible methods. 2008-02-15 jverzani * R/glayout.R: put in anchor argument for [i,j,anchor=c(x,y)]<-value 2008-02-14 jverzani * R/aaaGenerics.R: put in defaultWidget method * R/gbutton.R: changed clicked siganl to "clicked" from "pressed" as clicked capture keyboard usage too. 2008-02-12 jverzani * R/gedit.R: fixed completion to popup, not just downarrow 2008-02-07 jverzani * R/ghelp.R: added expand=TRUE to fix size issue due to changes in gwindow(). * R/aaaGenerics.R: implement size() to return c(width, height) 2008-02-04 jverzani * R/gpanedgroup.R: added svalue, svalue<- for paned groups 2008-01-23 jverzani * R/gtext.R: typo in return value from font<-; fixed font so that when changing color attributes all previous *possible* color tags are removed. I don't know how to remove just the ones that were actually applied. 2007-12-05 jverzani * R/gwindow.R: added in ggroup, groups for menu|tool|statusbar. From now on, for consistency, these should be added to the top-level window, although in RGtk2 this won't be deprecated, as it is used in pmg code. 2007-11-03 John Verzani * R/gwindow.R: added location argument to set initial position * R/icons.R: read in icon names from images directory. Just drop new xpm file in images/ directory to add icon 2007-11-01 John Verzani * R/gdroplist.R: Changed so that items can be two-column data.frame. If so, then 2nd column specifies icons to put adjacent to text. For editable they appear on right, on left otherwise. 2007-10-24 John Verzani * R/ggrid.R: fixed filter.fun and [.] <- stuff. Fixed bug with svalue when filtering * R/ghelp.R: trying to fix help under windows issue, fix filtercolumn not working (why?) 2007-10-23 John Verzani * R/gwindow.R: added addHandlerUnrealize to intercept closing by window manager. 2007-10-21 John Verzani * R/gtree.R: Put back in sort feature. Fixed this up. (Hopefully) 2007-10-20 John Verzani * R/gtree.R: took out sort feature. Ughh. Need to figure out sorting in gtree and put this back. 2007-10-11 John Verzani * R/gfile.R: fixed gfilebrowse to get filter passed along via ... 2007-10-09 John Verzani * R/gtree.R: added ... to update method. 2007-09-24 John Verzani * R/ggrid.R: fixed sorting (thanks Michael), colors only if gdf, 2007-09-23 John Verzani * R/gtree.R: fixed coltypes issue that gave issue with example. Define column types before adding possible icon information. 2007-09-13 John Verzani * R/gtree.R: fixed issue with offspring and icons 2007-08-30 John Verzani * R/ggrid.R (make.row.names): Fixed issue with value being a vector in svalue<-; coerce to a data frame * R/ggroup.R: avoid raise.on.dragmotion uner windows -- was causing dnd to flutter away * R/gcommandline.R: fixed writelines bug with quoted filenames * R/gnotebook.R: fixed "[" with 0-length nbs 2007-08-28 John Verzani * R/gwindow.R: fixed dispose method. Broken somehow? 2007-08-14 John Verzani * R/gfile.R: implemented quote argument (... one called from gfilebrowse). * R/aaaGenerics.R: fixed dispose -- GetParentWindow (not GetParent) * R/ggrid.R put 3rd popup on header (better); offset was incorrect; fixed double-click. Didn't like handler on the view.col. 2007-08-13 John Verzani * R/gcommandline.R: fixed @editText -- use tag. THIS COULD BE REWRITTEN. IT IS UGLY!! 2007-08-12 John Verzani * R/ggroup.R: changed raise.on.dragmotion to use focus, not window raise. This was giving issues with windows * R/ggraphics.R: addHandlerClicked returns usr coordinates, not NDC. Conversion is not difficult 2007-08-04 John Verzani * R/dnd.R: added override obj to adddropsoruce. This is so glabel can be a drop source 2007-08-03 John Verzani * R/gcheckboxgroup.R: fixed addhandlerchanged * R/gmenu.R (gtkMenuPopupHack): fixed lacking separator in menu. Use separator=TRUE to add separator. 2007-08-02 John Verzani * R/gradio.R: added length method default handler wasn't right. 2007-07-30 John Verzani * R/gdroplist.R: coerce.with when editable added 2007-07-29 John Verzani * R/ggrid.R: fixed signal handling to depend on gdf or gtable. Fixed addHandlerClicked for gtable to work on change in selection 2007-07-28 John Verzani * R/gdroplist.R: fixed signal handling -- wasn't right 2007-07-01 John Verzani * R/gdialogs.R: fixed ginput to return proper value 2007-05-30 John Verzani * R/gspinbutton.R: fixed digits=0 to have a better default based on by 2007-05-13 John Verzani * R/dnd.R: fixed GdkModifierType to use | in stead of vector 2007-05-06 John Verzani * R/gcheckboxgroup.R: added handler to gcheckboxgroup 2007-04-29 John Verzani * R/glayout.R: fixed so gl[i,j] <- "string" adds a label. * R/icons.R: fixed so getstockiconname needs exact match, not fuzzy 2007-04-15 John Verzani * R/ggraphics.R: changed asCairoDevice call to accomodate new cairoDevice. Still not perfect. I connect to the "map" signal. Likely this will need to change. Take advantage of ".devnum" data when asCairoDevice called to retrieve the device number. * R/ggraphicsnotebook.R: Added handler for "switch-page" that allows device handling to happen at notebook level, not page level. This also led to simplifying the addPage code(). 2007-04-09 John Verzani * R/gbutton.R: added argument relief="none" to turn off relief of buttons. * R/ggroup.R: added argument use.scrollwindow that if TRUE will put group inside a scroll window 2007-04-02 John Verzani * R/gimage.R: savlue<- with stock icon name should work now 2007-02-25 John Verzani * R/gdialogs.R: Fixed buggy with gmessage 2007-02-13 John Verzani * R/ggrid.R: Fixed subsetBy if names had been changed. gridObj[,name] wasn't working, so made name and index via which(name == names(gridObj)) * R/gdfnotebook.R: Fixed save -- names weren't getting applied properly if they had been changed 2007-02-11 John Verzani * R/gnotebook.R: added destroy widget part to removePage calls. This might work with plotnotebook, etc. 2007-02-06 John Verzani * R/gvariables.R: added gunivariatetable, and fixed some things to accomodate this. 2006-09-28 * R/gnotebook.R: put return(TRUE) into close button handler. Was giving ERROR otherwise regrading conversion of logical gWidgetsRGtk2/man/0000755000175100001440000000000013216524046013475 5ustar hornikusersgWidgetsRGtk2/man/as.gWidgetsRGtk2.Rd0000644000175100001440000000563711406427002017021 0ustar hornikusers\name{as.gWidgetsRGtk2} \alias{as.gWidgetsRGtk2} \alias{as.gWidgetsRGtk2.GtkHBox} \alias{as.gWidgetsRGtk2.GtkVBox} \alias{as.gWidgetsRGtk2.GtkImage} \alias{as.gWidgetsRGtk2.GtkLabel} \alias{as.gWidgetsRGtk2.GtkTable} \alias{as.gWidgetsRGtk2.GtkNotebook} \alias{as.gWidgetsRGtk2.GtkHPaned} \alias{as.gWidgetsRGtk2.GtkVPaned} \alias{as.gWidgetsRGtk2.GtkRadioButton} \alias{as.gWidgetsRGtk2.GtkHSeparator} \alias{as.gWidgetsRGtk2.GtkVSeparator} \alias{as.gWidgetsRGtk2.GtkHScale} \alias{as.gWidgetsRGtk2.GtkVScale} \alias{as.gWidgetsRGtk2.GtkSpinButton} \alias{as.gWidgetsRGtk2.GtkStatusbar} \alias{as.gWidgetsRGtk2.GtkTextView} \title{Coerce an RGtk2 object into a gWidgetsRGtk2 object} \description{ This function coerces an RGtk2 object into a gWidgetsRGtk2 object, thereby allowing most of the methods to work on the new object. } \usage{ as.gWidgetsRGtk2(widget, ...) } \arguments{ \item{widget}{An object of class \code{RGtkObject}} \item{\dots}{ Ignored here } } \details{ Many RGtk2 widgets can be coerced into gWidgetsRGtk2 objects. This allows the method of gWidgets to be called. The example shows how one can use glade to layout a dialog, and use gWidget methods for the handlers. } \value{ Returns a \code{gWidgetsRGtk2} object. (This is not a \code{gWidgets} object, so there may be some oddities } \examples{ \dontrun{ ## This requires glade libraries to be installed before compiling RGtk2 options("guiToolkit"="RGtk2") library(RGtk2) library(gWidgets) library(gWidgetsRGtk2) gladeFile <- system.file("examples/t.test.glade",package="gWidgetsRGtk2") GUI <- gladeXMLNew("t.test.glade") w <- GUI$GetWidget("window1") w$Show() # show win <- as.gWidgetsRGtk2(w) gladeXMLGetWidgetNames <- function(obj) { sapply(obj$GetWidgetPrefix(""),gladeGetWidgetName) } gladeXMLGetgWidgetsRGtk2 <- function(obj) { nms <- obj$GetWidgetNames() widgets <- sapply(nms, function(i) obj$GetWidget(i)) widgets <- sapply(widgets, as.gWidgetsRGtk2) return(widgets) } l <- GUI$GetgWidgetsRGtk2() ## val names have similar form valNames <- grep("Val$",GUI$GetWidgetNames()) defHandler <- function(...) { lst <- list() args <- c("x","y", "mu","alt","var.equal","paired","conf.level") for(i in args) { key <- paste(i,"Val",sep="") widget <- l[[key]] val <- svalue(widget) if(!is.null(val) && val != "") lst[[i]] <- val } if(!is.null(lst$x)) { cmd <- "t.test(" argList <- c() for(i in names(lst)) { argList <- c(argList,paste(i,"=",lst[[i]], sep="")) } cmd <- paste(cmd, paste(argList,collapse=", "),")",sep="") print(cmd) } } ## Add handler to each widget sapply(valNames, function(i) addHandlerChanged(l[[i]],handler=defHandler)) ## put handler on dismiss button addHandlerChanged(l[['dismiss']], handler = function(h,...) dispose(win)) } } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{interface} gWidgetsRGtk2/man/gWidgetsRGtk2-misc.Rd0000644000175100001440000000127511406427002017342 0ustar hornikusers\name{gWidgetsRGtk2-misc} \alias{gWidgetsRGtk2-misc} \alias{Paste} \alias{stripWhiteSpace} \alias{rpel} \alias{str1} \alias{str2} \alias{untaintName} \alias{stockIconFromClass} \alias{.stockIconFromClass-methods} \alias{.stockIconFromClass,guiWidgetsToolkitRGtk2-method} \alias{stockIconFromObject} \alias{.stockIconFromObject-methods} \alias{.stockIconFromObject,guiWidgetsToolkitRGtk2-method} \alias{Timestamp} \alias{Timestamp<-} \title{Miscellaneous functions in gWidgetsRGtk} \description{ These functions are hardly worth documenting. They are used by pmg, but are not part of the gWidgets API, nor meant for general consumption. } \keyword{interface}% at least one, from doc/KEYWORDS gWidgetsRGtk2/man/gWidgetsRGtk2-undocumented.Rd0000644000175100001440000014064212236754610021115 0ustar hornikusers\name{gWidgetsRGtk2-undocumented} \alias{gWidgetsRGtk2-undocumented} %% these are by hand \alias{editSubsetDialog} \alias{editSelectDialog} %% These are found using FindAllGenerics.R \alias{[-methods} \alias{[,gWidgetRGtk-method} \alias{[,gCheckboxRGtk-method} \alias{[,gCheckboxgroupRGtk-method} \alias{[,gCheckboxgroupTableRGtk-method} \alias{[,gCommandlineRGtk-method} \alias{[,gDfEditRGtk-method} \alias{[,gDroplistRGtk-method} \alias{[,gEditRGtk-method} \alias{[,GtkTreeView-method} \alias{[,gGridRGtk-method} \alias{[,gLayoutRGtk-method} \alias{[,gMenuRGtk-method} \alias{[,gNotebookRGtk-method} \alias{[,gRadioRGtk-method} \alias{[,RGtkDataFrame-method} \alias{[,gToolbarRGtk-method} \alias{[,gTreeRGtk-method} \alias{[,gVarbrowserRGtk-method} \alias{.delete,gNotebookRGtk,guiWidgetsToolkitRGtk2,ANY-method} \alias{.delete,gToolbarRGtk,guiWidgetsToolkitRGtk2,ANY-method} \alias{.svalue<-,gNotebookRGtk,guiWidgetsToolkitRGtk2,ANY,ANY-method} \alias{.svalue<-,gPanedgroupRGtk,guiWidgetsToolkitRGtk2,ANY,ANY-method} \alias{.svalue<-,gCheckboxgroupTableRGtk,guiWidgetsToolkitRGtk2,ANY,ANY-method} \alias{.svalue<-,gRadioRGtk,guiWidgetsToolkitRGtk2,ANY,ANY-method} \alias{.svalue<-,gSliderRGtk,guiWidgetsToolkitRGtk2,ANY,ANY-method} \alias{.svalue<-,gSpinbuttonRGtk,guiWidgetsToolkitRGtk2,ANY,ANY-method} \alias{.svalue<-,gStatusbarRGtk,guiWidgetsToolkitRGtk2,ANY,ANY-method} \alias{.svalue<-,gTextRGtk,guiWidgetsToolkitRGtk2,ANY,ANY-method} \alias{.svalue<-,gToolbarRGtk,guiWidgetsToolkitRGtk2,ANY,ANY-method} \alias{.svalue<-,gTreeRGtk,guiWidgetsToolkitRGtk2,ANY,ANY-method} \alias{.svalue<-,gAddargRGtk,guiWidgetsToolkitRGtk2,ANY,ANY-method} \alias{.svalue<-,gBivariateRGtk,guiWidgetsToolkitRGtk2,ANY,ANY-method} \alias{.svalue<-,gModelRGtk,guiWidgetsToolkitRGtk2,ANY,ANY-method} \alias{.svalue<-,gWindowRGtk,guiWidgetsToolkitRGtk2,ANY,ANY-method} \alias{.svalue<-,gExpandgroupRGtk,guiWidgetsToolkitRGtk2,ANY,numeric-method} %% %% %% -- .glabel -- %% \alias{.glabel-methods} \alias{.glabel,guiWidgetsToolkitRGtk2-method} %% %% -- .gbutton -- %% \alias{.gbutton-methods} \alias{.gbutton,guiWidgetsToolkitRGtk2-method} \alias{.gbutton,guiWidgetsToolkitRGtk2,ANY,ANY,ANY,ANY-method} \alias{.gbutton,guiWidgetsToolkitRGtk2,ANY,ANY,ANY,gActionRGtk-method} \alias{.gbutton,guiWidgetsToolkitRGtk2,ANY,ANY,ANY,guiComponent-method} %% %% -- .gcheckbox -- %% \alias{.gcheckbox-methods} \alias{.gcheckbox,guiWidgetsToolkitRGtk2-method} %% %% -- .gradio -- %% \alias{.gradio-methods} \alias{.gradio,guiWidgetsToolkitRGtk2-method} %% %% -- .gdroplist -- %% \alias{.gdroplist-methods} \alias{.gdroplist,guiWidgetsToolkitRGtk2-method} %% %% -- .gcheckboxgroup -- %% \alias{.gcheckboxgroup-methods} \alias{.gcheckboxgroup,guiWidgetsToolkitRGtk2-method} %% %% -- .gspinbutton -- %% \alias{.gspinbutton-methods} \alias{.gspinbutton,guiWidgetsToolkitRGtk2-method} %% %% -- .gslider -- %% \alias{.gslider-methods} \alias{.gslider,guiWidgetsToolkitRGtk2-method} %% %% -- .gedit -- %% \alias{.gedit-methods} \alias{.gedit,guiWidgetsToolkitRGtk2-method} %% %% -- .gtext -- %% \alias{.gtext-methods} \alias{.gtext,guiWidgetsToolkitRGtk2-method} %% %% -- .gaction -- %% \alias{.gaction-methods} \alias{.gaction,guiWidgetsToolkitRGtk2-method} %% %% -- .gmenu -- %% \alias{.gmenu-methods} \alias{.gmenu,guiWidgetsToolkitRGtk2-method} %% %% -- .gtoolbar -- %% \alias{.gtoolbar-methods} \alias{.gtoolbar,guiWidgetsToolkitRGtk2-method} %% %% -- .gtable -- %% \alias{.gtable-methods} \alias{.gtable,guiWidgetsToolkitRGtk2-method} %% %% -- .gdf -- %% \alias{.gdf-methods} \alias{.gdf,guiWidgetsToolkitRGtk2-method} %% %% -- .gdfedit -- %% \alias{.gdfedit-methods} \alias{.gdfedit,guiWidgetsToolkitRGtk2-method} %% %% -- .gdfnotebook -- %% \alias{.gdfnotebook-methods} \alias{.gdfnotebook,guiWidgetsToolkitRGtk2-method} %% %% -- .gtree -- %% \alias{.gtree-methods} \alias{.gtree,guiWidgetsToolkitRGtk2-method} %% %% -- .gfile -- %% \alias{.gfile-methods} \alias{.gfile,guiWidgetsToolkitRGtk2-method} %% %% -- .gfilebrowse -- %% \alias{.gfilebrowse-methods} \alias{.gfilebrowse,guiWidgetsToolkitRGtk2-method} %% %% -- .gcalendar -- %% \alias{.gcalendar-methods} \alias{.gcalendar,guiWidgetsToolkitRGtk2-method} %% %% -- .ggraphics -- %% \alias{.ggraphics-methods} \alias{.ggraphics,guiWidgetsToolkitRGtk2-method} %% %% -- .ggraphicsnotebook -- %% \alias{.ggraphicsnotebook-methods} \alias{.ggraphicsnotebook,guiWidgetsToolkitRGtk2-method} %% %% -- .gimage -- %% \alias{.gimage-methods} \alias{.gimage,guiWidgetsToolkitRGtk2-method} %% %% -- .ghtml -- %% \alias{.ghtml-methods} \alias{.ghtml,guiWidgetsToolkitRGtk2-method} %% %% -- .gstatusbar -- %% \alias{.gstatusbar-methods} \alias{.gstatusbar,guiWidgetsToolkitRGtk2-method} %% %% -- .gseparator -- %% \alias{.gseparator-methods} \alias{.gseparator,guiWidgetsToolkitRGtk2-method} %% %% -- .gcommandline -- %% \alias{.gcommandline-methods} \alias{.gcommandline,guiWidgetsToolkitRGtk2-method} %% %% -- .ghelp -- %% \alias{.ghelp-methods} \alias{.ghelp,guiWidgetsToolkitRGtk2-method} %% %% -- .ghelpbrowser -- %% \alias{.ghelpbrowser-methods} \alias{.ghelpbrowser,guiWidgetsToolkitRGtk2-method} %% %% -- .ggenericwidget -- %% \alias{.ggenericwidget-methods} \alias{.ggenericwidget,guiWidgetsToolkitRGtk2-method} %% %% -- .gvarbrowser -- %% \alias{.gvarbrowser-methods} \alias{.gvarbrowser,guiWidgetsToolkitRGtk2-method} %% %% -- .gwindow -- %% \alias{.gwindow-methods} \alias{.gwindow,guiWidgetsToolkitRGtk2-method} %% %% -- .ggroup -- %% \alias{.ggroup-methods} \alias{.ggroup,guiWidgetsToolkitRGtk2-method} %% %% -- .gframe -- %% \alias{.gframe-methods} \alias{.gframe,guiWidgetsToolkitRGtk2-method} %% %% -- .gexpandgroup -- %% \alias{.gexpandgroup-methods} \alias{.gexpandgroup,guiWidgetsToolkitRGtk2-method} %% %% -- .gnotebook -- %% \alias{.gnotebook-methods} \alias{.gnotebook,guiWidgetsToolkitRGtk2-method} %% %% -- .glayout -- %% \alias{.glayout-methods} \alias{.glayout,guiWidgetsToolkitRGtk2-method} %% %% -- .gpanedgroup -- %% \alias{.gpanedgroup-methods} \alias{.gpanedgroup,guiWidgetsToolkitRGtk2-method} %% %% -- .addStockIcons -- %% \alias{.addStockIcons-methods} \alias{.addStockIcons,guiWidgetsToolkitRGtk2-method} %% %% -- .getStockIcons -- %% \alias{.getStockIcons-methods} \alias{.getStockIcons,guiWidgetsToolkitRGtk2-method} %% %% -- svalue -- %% \alias{svalue-methods} \alias{svalue,guiWidget-method} \alias{svalue,gWidgetRGtk-method} \alias{svalue,character-method} \alias{svalue,GtkEntry-method} \alias{svalue,gSubsetbyRGtk-method} \alias{svalue,GtkTreeViewColumn-method} %% %% -- .svalue -- %% \alias{.svalue-methods} \alias{.svalue,character,ANY,ANY,guiWidgetsToolkitRGtk2-method} \alias{.svalue,gActionRGtk,ANY,ANY,guiWidgetsToolkitRGtk2-method} \alias{.svalue,gActionRGtk,guiWidgetsToolkitRGtk2-method} \alias{.svalue,gButtonRGtk,ANY,ANY,guiWidgetsToolkitRGtk2-method} \alias{.svalue,gCalendarRGtk,ANY,ANY,guiWidgetsToolkitRGtk2-method} \alias{.svalue,gCalendarRGtk,guiWidgetsToolkitRGtk2-method} \alias{.svalue,gCheckboxRGtk,ANY,ANY,guiWidgetsToolkitRGtk2-method} \alias{.svalue,gCheckboxgroupRGtk,ANY,ANY,guiWidgetsToolkitRGtk2-method} \alias{.svalue,gCheckboxgroupTableRGtk,ANY,ANY,guiWidgetsToolkitRGtk2-method} \alias{.svalue,gCheckboxgroupTableRGtk,guiWidgetsToolkitRGtk2-method} \alias{.svalue,gCommandlineRGtk,ANY,ANY,guiWidgetsToolkitRGtk2-method} \alias{.svalue,gDfEditRGtk,ANY,ANY,guiWidgetsToolkitRGtk2-method} \alias{.svalue,gDfEditRGtk,guiWidgetsToolkitRGtk2-method} \alias{.svalue,gDroplistRGtk,ANY,ANY,guiWidgetsToolkitRGtk2-method} \alias{.svalue,gEditRGtk,ANY,ANY,guiWidgetsToolkitRGtk2-method} \alias{.svalue,GtkEntry,ANY,ANY,guiWidgetsToolkitRGtk2-method} \alias{.svalue,gExpandgroupRGtk,ANY,ANY,guiWidgetsToolkitRGtk2-method} \alias{.svalue,GtkTreeView,ANY,ANY,guiWidgetsToolkitRGtk2-method} \alias{.svalue,gGridRGtk,ANY,ANY,guiWidgetsToolkitRGtk2-method} \alias{.svalue,gGenericWidgetRGtk,ANY,ANY,guiWidgetsToolkitRGtk2-method} \alias{.svalue,gHelpRGtk,ANY,ANY,guiWidgetsToolkitRGtk2-method} \alias{.svalue,gImageRGtk,ANY,ANY,guiWidgetsToolkitRGtk2-method} \alias{.svalue,gLabelRGtk,ANY,ANY,guiWidgetsToolkitRGtk2-method} \alias{.svalue,gMenuRGtk,ANY,ANY,guiWidgetsToolkitRGtk2-method} \alias{.svalue,gPanedgroupRGtk,ANY,ANY,guiWidgetsToolkitRGtk2-method} \alias{.svalue,gNotebookRGtk,ANY,ANY,guiWidgetsToolkitRGtk2-method} \alias{.svalue,gRadioRGtk,ANY,ANY,guiWidgetsToolkitRGtk2-method} \alias{.svalue,gSliderRGtk,ANY,ANY,guiWidgetsToolkitRGtk2-method} \alias{.svalue,gSpinbuttonRGtk,ANY,ANY,guiWidgetsToolkitRGtk2-method} \alias{.svalue,gStatusbarRGtk,ANY,ANY,guiWidgetsToolkitRGtk2-method} \alias{.svalue,gTextRGtk,ANY,ANY,guiWidgetsToolkitRGtk2-method} \alias{.svalue,gToolbarRGtk,ANY,ANY,guiWidgetsToolkitRGtk2-method} \alias{.svalue,gTreeRGtk,ANY,ANY,guiWidgetsToolkitRGtk2-method} \alias{.svalue,gVarbrowserRGtk,ANY,ANY,guiWidgetsToolkitRGtk2-method} \alias{.svalue,gAddargRGtk,ANY,ANY,guiWidgetsToolkitRGtk2-method} \alias{.svalue,gUnivariateRGtk,ANY,ANY,guiWidgetsToolkitRGtk2-method} \alias{.svalue,gUnivariateTableRGtk,ANY,ANY,guiWidgetsToolkitRGtk2-method} \alias{.svalue,gFileURLRGtk,ANY,ANY,guiWidgetsToolkitRGtk2-method} \alias{.svalue,gBivariateRGtk,ANY,ANY,guiWidgetsToolkitRGtk2-method} \alias{.svalue,gModelRGtk,ANY,ANY,guiWidgetsToolkitRGtk2-method} \alias{.svalue,gLmerRGtk,ANY,ANY,guiWidgetsToolkitRGtk2-method} \alias{.svalue,gWindowRGtk,ANY,ANY,guiWidgetsToolkitRGtk2-method} \alias{.svalue,character,guiWidgetsToolkitRGtk2-method} \alias{.svalue,gButtonRGtk,guiWidgetsToolkitRGtk2-method} \alias{.svalue,gCheckboxgroupRGtk,guiWidgetsToolkitRGtk2-method} \alias{.svalue,gCheckboxRGtk,guiWidgetsToolkitRGtk2-method} \alias{.svalue,gCommandlineRGtk,guiWidgetsToolkitRGtk2-method} \alias{.svalue,gDroplistRGtk,guiWidgetsToolkitRGtk2-method} \alias{.svalue,gEditRGtk,guiWidgetsToolkitRGtk2-method} \alias{.svalue,gExpandgroupRGtk,guiWidgetsToolkitRGtk2-method} \alias{.svalue,gGridRGtk,guiWidgetsToolkitRGtk2-method} \alias{.svalue,gHelpRGtk,guiWidgetsToolkitRGtk2-method} \alias{.svalue,gImageRGtk,guiWidgetsToolkitRGtk2-method} \alias{.svalue,gLabelRGtk,guiWidgetsToolkitRGtk2-method} \alias{.svalue,gMenuRGtk,guiWidgetsToolkitRGtk2-method} \alias{.svalue,gNotebookRGtk,guiWidgetsToolkitRGtk2-method} \alias{.svalue,gPanedgroupRGtk,guiWidgetsToolkitRGtk2-method} \alias{.svalue,gRadioRGtk,guiWidgetsToolkitRGtk2-method} \alias{.svalue,gSliderRGtk,guiWidgetsToolkitRGtk2-method} \alias{.svalue,gSpinbuttonRGtk,guiWidgetsToolkitRGtk2-method} \alias{.svalue,gStatusbarRGtk,guiWidgetsToolkitRGtk2-method} \alias{.svalue,gTextRGtk,guiWidgetsToolkitRGtk2-method} \alias{.svalue,GtkEntry,guiWidgetsToolkitRGtk2-method} \alias{.svalue,GtkTreeView,guiWidgetsToolkitRGtk2-method} \alias{.svalue,gToolbarRGtk,guiWidgetsToolkitRGtk2-method} \alias{.svalue,gTreeRGtk,guiWidgetsToolkitRGtk2-method} \alias{.svalue,gVarbrowserRGtk,guiWidgetsToolkitRGtk2-method} \alias{.svalue,gWindowRGtk,guiWidgetsToolkitRGtk2-method} %% %% -- svalue<- -- %% \alias{svalue<--methods} \alias{svalue<-,guiWidget-method} \alias{svalue<-,gWidgetRGtk-method} %% %% -- .svalue<- -- %% \alias{.svalue<--methods} \alias{.svalue<-,gActionRGtk,guiWidgetsToolkitRGtk2,ANY,ANY-method} \alias{.svalue<-,gButtonRGtk,guiWidgetsToolkitRGtk2,ANY,ANY-method} \alias{.svalue<-,gCheckboxRGtk,guiWidgetsToolkitRGtk2,ANY,ANY-method} \alias{.svalue<-,gCheckboxgroupRGtk,guiWidgetsToolkitRGtk2,ANY,ANY-method} \alias{.svalue<-,gCommandlineRGtk,guiWidgetsToolkitRGtk2,ANY,ANY-method} \alias{.svalue<-,gDroplistRGtk,guiWidgetsToolkitRGtk2,ANY,ANY-method} \alias{.svalue<-,gEditRGtk,guiWidgetsToolkitRGtk2,ANY,ANY-method} \alias{.svalue<-,GtkEntry,guiWidgetsToolkitRGtk2,ANY,ANY-method} \alias{.svalue<-,gExpandgroupRGtk,guiWidgetsToolkitRGtk2,ANY,ANY-method} \alias{.svalue<-,gGraphicsRGtk,guiWidgetsToolkitRGtk2,ANY,ANY-method} \alias{.svalue<-,gGridRGtk,guiWidgetsToolkitRGtk2,ANY,ANY-method} \alias{.svalue<-,gGroupRGtk,guiWidgetsToolkitRGtk2,ANY,ANY-method} \alias{.svalue<-,gImageRGtk,guiWidgetsToolkitRGtk2,ANY,ANY-method} \alias{.svalue<-,gLabelRGtk,guiWidgetsToolkitRGtk2,ANY,ANY-method} \alias{.svalue<-,gMenuRGtk,guiWidgetsToolkitRGtk2,ANY,list-method} \alias{.svalue<-,gMenuRGtk,guiWidgetsToolkitRGtk2,ANY,gMenuRGtk-method} \alias{.svalue<-,gMenuRGtk,guiWidgetsToolkitRGtk2,ANY,guiWidget-method} \alias{.svalue<-,gNotebookRGtk,guiWidgetsToolkitRGtk2-method} \alias{.svalue<-,gRadioRGtk,guiWidgetsToolkitRGtk2-method} \alias{.svalue<-,gSliderRGtk,guiWidgetsToolkitRGtk2-method} \alias{.svalue<-,gSpinbuttonRGtk,guiWidgetsToolkitRGtk2-method} \alias{.svalue<-,gStatusbarRGtk,guiWidgetsToolkitRGtk2-method} \alias{.svalue<-,gTextRGtk,guiWidgetsToolkitRGtk2-method} \alias{.svalue<-,gToolbarRGtk,guiWidgetsToolkitRGtk2-method} \alias{.svalue<-,gAddargRGtk,guiWidgetsToolkitRGtk2-method} \alias{.svalue<-,gBivariateRGtk,guiWidgetsToolkitRGtk2-method} \alias{.svalue<-,gModelRGtk,guiWidgetsToolkitRGtk2-method} \alias{.svalue<-,gWindowRGtk,guiWidgetsToolkitRGtk2-method} %% %% -- .leftBracket -- %% \alias{.leftBracket-methods} \alias{.leftBracket,gCheckboxRGtk,guiWidgetsToolkitRGtk2-method} \alias{.leftBracket,gCheckboxgroupRGtk,guiWidgetsToolkitRGtk2-method} \alias{.leftBracket,gCheckboxgroupTableRGtk,guiWidgetsToolkitRGtk2-method} \alias{.leftBracket,gCommandlineRGtk,guiWidgetsToolkitRGtk2-method} \alias{.leftBracket,gDfEditRGtk,guiWidgetsToolkitRGtk2-method} \alias{.leftBracket,gDroplistRGtk,guiWidgetsToolkitRGtk2-method} \alias{.leftBracket,gEditRGtk,guiWidgetsToolkitRGtk2-method} \alias{.leftBracket,GtkTreeView,guiWidgetsToolkitRGtk2-method} \alias{.leftBracket,gGridRGtk,guiWidgetsToolkitRGtk2-method} \alias{.leftBracket,gLayoutRGtk,guiWidgetsToolkitRGtk2-method} \alias{.leftBracket,gMenuRGtk,guiWidgetsToolkitRGtk2-method} \alias{.leftBracket,gNotebookRGtk,guiWidgetsToolkitRGtk2-method} \alias{.leftBracket,gRadioRGtk,guiWidgetsToolkitRGtk2-method} \alias{.leftBracket,RGtkDataFrame,guiWidgetsToolkitRGtk2-method} \alias{.leftBracket,gSliderRGtk,guiWidgetsToolkitRGtk2-method} \alias{.leftBracket,gToggleButtonRGtk,guiWidgetsToolkitRGtk2-method} \alias{.leftBracket,gToolbarRGtk,guiWidgetsToolkitRGtk2-method} \alias{.leftBracket,gTreeRGtk,guiWidgetsToolkitRGtk2-method} \alias{.leftBracket,gVarbrowserRGtk,guiWidgetsToolkitRGtk2-method} %% %% -- .leftBracket<- -- %% \alias{.leftBracket<--methods} \alias{.leftBracket<-,gCheckboxRGtk,guiWidgetsToolkitRGtk2-method} \alias{.leftBracket<-,gCheckboxgroupRGtk,guiWidgetsToolkitRGtk2-method} \alias{.leftBracket<-,gCheckboxgroupTableRGtk,guiWidgetsToolkitRGtk2-method} \alias{.leftBracket<-,gDfEditRGtk,guiWidgetsToolkitRGtk2-method} \alias{.leftBracket<-,gDroplistRGtk,guiWidgetsToolkitRGtk2-method} \alias{.leftBracket<-,gEditRGtk,guiWidgetsToolkitRGtk2-method} \alias{.leftBracket<-,GtkTreeView,guiWidgetsToolkitRGtk2-method} \alias{.leftBracket<-,gGridRGtk,guiWidgetsToolkitRGtk2-method} \alias{.leftBracket<-,gLayoutRGtk,guiWidgetsToolkitRGtk2-method} \alias{.leftBracket<-,gMenuRGtk,guiWidgetsToolkitRGtk2-method} \alias{.leftBracket<-,gNotebookRGtk,guiWidgetsToolkitRGtk2-method} \alias{.leftBracket<-,gRadioRGtk,guiWidgetsToolkitRGtk2-method} \alias{.leftBracket<-,gSliderRGtk,guiWidgetsToolkitRGtk2-method} \alias{.leftBracket<-,gSpinbuttonRGtk,guiWidgetsToolkitRGtk2-method} \alias{.leftBracket<-,gToggleButtonRGtk,guiWidgetsToolkitRGtk2-method} \alias{.leftBracket<-,gToolbarRGtk,guiWidgetsToolkitRGtk2-method} %% %% -- add -- %% \alias{add-methods} \alias{add,guiWidget-method} \alias{add,gWidgetRGtk-method} %% %% -- .add -- %% \alias{.add-methods} \alias{.add,guiWidget,guiWidgetsToolkitRGtk2,ANY-method} \alias{.add,guiWidget,guiWidgetsToolkitRGtk2,guiWidgetORgWidgetRGtkORRGtkObject-method} \alias{.add,gBasicDialogNoParentRGtk,guiWidgetsToolkitRGtk2,guiWidget-method} \alias{.add,gBasicDialogNoParentRGtk,guiWidgetsToolkitRGtk2,gWidgetRGtk-method} \alias{.add,gContainerRGtk,guiWidgetsToolkitRGtk2,guiWidget-method} \alias{.add,gContainerRGtk,guiWidgetsToolkitRGtk2,gWidgetRGtk-method} \alias{.add,gDfNotebookRGtk,guiWidgetsToolkitRGtk2,ANY-method} \alias{.add,gGroupRGtk,guiWidgetsToolkitRGtk2,gGraphicsRGtk-method} \alias{.add,gGroupRGtk,guiWidgetsToolkitRGtk2,gWidgetRGtk-method} \alias{.add,gGroupRGtk,guiWidgetsToolkitRGtk2,RGtkObject-method} \alias{.add,gHelpRGtk,guiWidgetsToolkitRGtk2,ANY-method} \alias{.add,gHelpbrowserRGtk,guiWidgetsToolkitRGtk2,ANY-method} \alias{.add,gLayoutRGtk,guiWidgetsToolkitRGtk2,ANY-method} \alias{.add,gLayoutRGtk,guiWidgetsToolkitRGtk2,gWidgetRGtk-method} \alias{.add,gMenuRGtk,guiWidgetsToolkitRGtk2,guiWidget-method} \alias{.add,gMenuRGtk,guiWidgetsToolkitRGtk2,gMenuRGtk-method} \alias{.add,gMenuRGtk,guiWidgetsToolkitRGtk2,list-method} \alias{.add,gNotebookRGtk,guiWidgetsToolkitRGtk2,guiWidget-method} \alias{.add,gNotebookRGtk,guiWidgetsToolkitRGtk2,gWidgetRGtk-method} \alias{.add,gPanedgroupRGtk,guiWidgetsToolkitRGtk2,gWidgetRGtk-method} \alias{.add,gTextRGtk,guiWidgetsToolkitRGtk2,character-method} \alias{.add,gTextRGtk,guiWidgetsToolkitRGtk2,guiWidget-method} \alias{.add,gTextRGtk,guiWidgetsToolkitRGtk2,gWidgetRGtk-method} \alias{.add,gToolbarRGtk,guiWidgetsToolkitRGtk2,list-method} \alias{.add,gWindowRGtk,guiWidgetsToolkitRGtk2,RGtkObject-method} \alias{.add,gWindowRGtk,guiWidgetsToolkitRGtk2,gWidgetRGtk-method} \alias{.add,gWindowRGtk,guiWidgetsToolkitRGtk2,gMenuRGtk-method} \alias{.add,gWindowRGtk,guiWidgetsToolkitRGtk2,gToolbarRGtk-method} \alias{.add,gWindowRGtk,guiWidgetsToolkitRGtk2,gStatusbarRGtk-method} \alias{.add,gWidgetRGtk,guiWidgetsToolkitRGtk2,RGtkObject-method} \alias{.add,gWidgetRGtk,guiWidgetsToolkitRGtk2,try-error-method} %% %% -- addSpace -- %% \alias{addSpace-methods} \alias{addSpace,guiWidget-method} \alias{addSpace,gWidgetRGtk-method} %% %% -- .addSpace -- %% \alias{.addSpace-methods} \alias{.addSpace,gContainerRGtk,guiWidgetsToolkitRGtk2-method} %% %% -- addSpring -- %% \alias{addSpring-methods} \alias{addSpring,guiWidget-method} \alias{addSpring,gWidgetRGtk-method} %% %% -- .addSpring -- %% \alias{.addSpring-methods} \alias{.addSpring,gContainerRGtk,guiWidgetsToolkitRGtk2-method} %% %% -- delete -- %% \alias{delete-methods} \alias{delete,guiWidget-method} \alias{delete,gWidgetRGtk-method} %% %% -- .delete -- %% \alias{.delete-methods} \alias{.delete,gContainerRGtk,guiWidgetsToolkitRGtk2,guiWidget-method} \alias{.delete,gContainerRGtk,guiWidgetsToolkitRGtk2,gWidgetRGtk-method} \alias{.delete,RGtkObject,guiWidgetsToolkitRGtk2,gWidgetRGtk-method} \alias{.delete,RGtkObject,guiWidgetsToolkitRGtk2,guiWidget-method} \alias{.delete,RGtkObject,guiWidgetsToolkitRGtk2,RGtkObject-method} \alias{.delete,gWidgetRGtk,guiWidgetsToolkitRGtk2,RGtkObject-method} \alias{.delete,gWindowRGtk,guiWidgetsToolkitRGtk2,gWidgetRGtk-method} \alias{.delete,gWindowRGtk,guiWidgetsToolkitRGtk2,gMenuRGtk-method} \alias{.delete,gWindowRGtk,guiWidgetsToolkitRGtk2,gToolbarRGtk-method} \alias{.delete,gWindowRGtk,guiWidgetsToolkitRGtk2,gStatusbarRGtk-method} \alias{.delete,gMenuRGtk,guiWidgetsToolkitRGtk2,guiWidget-method} \alias{.delete,gMenuRGtk,guiWidgetsToolkitRGtk2,gWidgetRGtk-method} \alias{.delete,gMenuRGtk,guiWidgetsToolkitRGtk2,gMenuRGtk-method} \alias{.delete,gMenuRGtk,guiWidgetsToolkitRGtk2,list-method} \alias{.delete,gNotebookRGtk,guiWidgetsToolkitRGtk2-method} \alias{.delete,gToolbarRGtk,guiWidgetsToolkitRGtk2-method} %% %% -- dispose -- %% \alias{dispose-methods} \alias{dispose,guiWidget-method} \alias{dispose,gWidgetRGtk-method} \alias{dispose,gTextRGtk-method} %% %% -- .dispose -- %% \alias{.dispose-methods} \alias{.dispose,gWidgetRGtk,guiWidgetsToolkitRGtk2-method} \alias{.dispose,gBasicDialogNoParentRGtk,guiWidgetsToolkitRGtk2-method} \alias{.dispose,gHelpRGtk,guiWidgetsToolkitRGtk2-method} \alias{.dispose,gNotebookRGtk,guiWidgetsToolkitRGtk2-method} \alias{.dispose,gTextRGtk,guiWidgetsToolkitRGtk2-method} \alias{.dispose,gWindowRGtk,guiWidgetsToolkitRGtk2-method} %% %% -- .insert -- %% \alias{.insert-methods} \alias{.insert,gTextRGtk,guiWidgetsToolkitRGtk2-method} %% %% -- visible -- %% \alias{visible-methods} \alias{visible,guiWidget-method} \alias{visible,gWidgetRGtk-method} %% %% -- .visible -- %% \alias{.visible-methods} \alias{.visible,gWidgetRGtk,guiWidgetsToolkitRGtk2-method} \alias{.visible,gBasicDialogNoParentRGtk,guiWidgetsToolkitRGtk2-method} \alias{.visible,gExpandgroupRGtk,guiWidgetsToolkitRGtk2-method} \alias{.visible,gGridRGtk,guiWidgetsToolkitRGtk2-method} %% %% -- visible<- -- %% \alias{visible<--methods} \alias{visible<-,guiWidget-method} \alias{visible<-,gWidgetRGtk-method} %% %% -- .visible<- -- %% \alias{.visible<--methods} \alias{.visible<-,gWidgetRGtk,guiWidgetsToolkitRGtk2-method} \alias{.visible<-,gComponentWithRefClassWithItemsRGtk,guiWidgetsToolkitRGtk2,ANY-method} \alias{.visible<-,gEditRGtk,guiWidgetsToolkitRGtk2-method} \alias{.visible<-,gEditRGtk,guiWidgetsToolkitRGtk2,ANY-method} \alias{.visible<-,gExpandgroupRGtk,guiWidgetsToolkitRGtk2-method} \alias{.visible<-,gExpandgroupRGtk,guiWidgetsToolkitRGtk2,ANY-method} \alias{.visible<-,gGraphicsRGtk,guiWidgetsToolkitRGtk2-method} \alias{.visible<-,gGraphicsRGtk,guiWidgetsToolkitRGtk2,ANY-method} \alias{.visible<-,gGridRGtk,guiWidgetsToolkitRGtk2-method} \alias{.visible<-,gGridRGtk,guiWidgetsToolkitRGtk2,ANY-method} \alias{.visible<-,gLayoutRGtk,guiWidgetsToolkitRGtk2-method} \alias{.visible<-,gRadioRGtk,guiWidgetsToolkitRGtk2-method} \alias{.visible<-,gRadioRGtk,guiWidgetsToolkitRGtk2,ANY-method} \alias{.visible<-,gWidgetRGtk,guiWidgetsToolkitRGtk2,ANY-method} \alias{.visible<-,gWindowRGtk,guiWidgetsToolkitRGtk2-method} \alias{.visible<-,gWindowRGtk,guiWidgetsToolkitRGtk2,ANY-method} %% %% -- editable -- %% \alias{editable-methods} \alias{editable,guiWidget-method} %% %% -- .editable -- %% \alias{.editable-methods} \alias{.editable,gWidgetRGtk,guiWidgetsToolkitRGtk2-method} %% %% -- editable<- -- %% \alias{editable<--methods} \alias{editable<-,guiWidget-method} \alias{editable<-,gWidgetRGtk-method} %% %% -- .editable<- -- %% \alias{.editable<--methods} \alias{.editable<-,gWidgetRGtk,guiWidgetsToolkitRGtk2-method} %% %% -- enabled -- %% \alias{enabled-methods} \alias{enabled,guiWidget-method} \alias{enabled,gWidgetRGtk-method} %% %% -- .enabled -- %% \alias{.enabled-methods} \alias{.enabled,GtkWindow,guiWidgetsToolkitRGtk2-method} \alias{.enabled,gWidgetRGtk,guiWidgetsToolkitRGtk2-method} %% %% -- enabled<- -- %% \alias{enabled<--methods} \alias{enabled<-,guiWidget-method} \alias{enabled<-,gWidgetRGtk-method} %% %% -- .enabled<- -- %% \alias{.enabled<--methods} \alias{.enabled<-,gWidgetRGtk,guiWidgetsToolkitRGtk2-method} \alias{.enabled<-,gComponentWithRefClassWithItemsRGtk,guiWidgetsToolkitRGtk2-method} \alias{.enabled<-,RGtkObject,guiWidgetsToolkitRGtk2-method} \alias{.enabled<-,gRadioRGtk,guiWidgetsToolkitRGtk2-method} %% %% -- size -- %% \alias{size-methods} \alias{size,guiWidget-method} \alias{size,gWidgetRGtk-method} %% %% -- .size -- %% \alias{.size-methods} \alias{.size,GtkWindow,guiWidgetsToolkitRGtk2-method} \alias{.size,gWindowRGtk,guiWidgetsToolkitRGtk2-method} \alias{.size,gWidgetRGtk,guiWidgetsToolkitRGtk2-method} \alias{.size,gWidgetRgtk,guiWidgetsToolkitRGtk2-method} \alias{.size,RGtkObject,guiWidgetsToolkitRGtk2-method} %% %% -- size<- -- %% \alias{size<--methods} \alias{size<-,guiWidget-method} \alias{size<-,gWidgetRGtk-method} %% %% -- .size<- -- %% \alias{.size<--methods} \alias{.size<-,gWidgetRGtk,guiWidgetsToolkitRGtk2-method} \alias{.size<-,gGroupRGtk,guiWidgetsToolkitRGtk2-method} \alias{.size<-,gGroupRGtk,guiWidgetsToolkitRGtk2,ANY-method} \alias{.size<-,gGridRGtk,guiWidgetsToolkitRGtk2,ANY-method} \alias{.size<-,gNotebookRGtk,guiWidgetsToolkitRGtk2-method} \alias{.size<-,gNotebookRGtk,guiWidgetsToolkitRGtk2,ANY-method} \alias{.size<-,gWidgetRGtk,guiWidgetsToolkitRGtk2,ANY-method} %% %% -- focus -- %% \alias{focus-methods} \alias{focus,guiWidget-method} \alias{focus,gWidgetRGtk-method} %% %% -- .focus -- %% \alias{.focus-methods} \alias{.focus,gWidgetRGtk,guiWidgetsToolkitRGtk2-method} \alias{.focus,gWindowRGtk,guiWidgetsToolkitRGtk2-method} %% %% -- focus<- -- %% \alias{focus<--methods} \alias{focus<-,guiWidget-method} \alias{focus<-,gWidgetRGtk-method} \alias{focus<-,RGtkObject-method} %% %% -- .focus<- -- %% \alias{.focus<--methods} \alias{.focus<-,gWidgetRGtk,guiWidgetsToolkitRGtk2-method} \alias{.focus<-,gWindowRGtk,guiWidgetsToolkitRGtk2-method} \alias{.focus<-,GtkWindow,guiWidgetsToolkitRGtk2-method} \alias{.focus<-,RGtkObject,guiWidgetsToolkitRGtk2-method} %% %% -- tooltip<- -- %% \alias{tooltip<--methods} \alias{tooltip<-,gWidgetRGtk-method} \alias{tooltip<-,RGtkObject-method} %% %% -- .tooltip<- -- %% \alias{.tooltip<--methods} \alias{.tooltip<-,gWidgetRGtk,guiWidgetsToolkitRGtk2-method} %% %% -- font -- %% \alias{font-methods} \alias{font,guiWidget-method} \alias{font,gWidgetRGtk-method} %% %% -- .font -- %% \alias{.font-methods} \alias{.font,GtkWindow,guiWidgetsToolkitRGtk2-method} %% %% -- font<- -- %% \alias{font<--methods} \alias{font<-,guiWidget-method} \alias{font<-,gWidgetRGtk-method} \alias{font<-,gButtonRGtk-method} %% %% -- .font<- -- %% \alias{.font<--methods} \alias{.font<-,gWidgetRGtk,guiWidgetsToolkitRGtk2-method} \alias{.font<-,RGtkObject,guiWidgetsToolkitRGtk2-method} \alias{.font<-,gButtonRGtk,guiWidgetsToolkitRGtk2-method} \alias{.font<-,gStatusbarRGtk,guiWidgetsToolkitRGtk2-method} \alias{.font<-,gTextRGtk,guiWidgetsToolkitRGtk2-method} \alias{.font<-,gExpandgroupRGtk,guiWidgetsToolkitRGtk2-method} %% %% -- tag -- %% \alias{tag-methods} \alias{tag,guiWidget-method} \alias{tag,gWidgetRGtk-method} \alias{tag,RGtkObject-method} %% %% -- .tag -- %% \alias{.tag-methods} \alias{.tag,guiWidget,guiWidgetsToolkitRGtk2-method} \alias{.tag,gWidgetRGtk,guiWidgetsToolkitRGtk2-method} \alias{.tag,RGtkObject,guiWidgetsToolkitRGtk2-method} \alias{.tag,GtkDfEdit,guiWidgetsToolkitRGtk2-method} %% %% -- tag<- -- %% \alias{tag<--methods} \alias{tag<-,guiWidget-method} \alias{tag<-,gWidgetRGtk-method} \alias{tag<-,RGtkObject-method} %% %% -- .tag<- -- %% \alias{.tag<--methods} \alias{.tag<-,guiWidget,guiWidgetsToolkitRGtk2-method} \alias{.tag<-,gWidgetRGtk,guiWidgetsToolkitRGtk2-method} \alias{.tag<-,RGtkObject,guiWidgetsToolkitRGtk2-method} %% %% -- id -- %% \alias{id-methods} \alias{id,guiWidget-method} \alias{id,gWidgetRGtk-method} \alias{id,RGtkObject-method} \alias{id,ANY-method} \alias{id,GtkTreeViewColumn-method} %% %% -- .id -- %% \alias{.id-methods} \alias{.id,gWidgetRGtk,guiWidgetsToolkitRGtk2-method} \alias{.id,RGtkObject,guiWidgetsToolkitRGtk2-method} %% %% -- id<- -- %% \alias{id<--methods} \alias{id<-,guiWidget-method} \alias{id<-,gWidgetRGtk-method} \alias{id<-,RGtkObject-method} \alias{id<-,ANY-method} \alias{id<-,GtkTreeViewColumn-method} %% %% -- .id<- -- %% \alias{.id<--methods} \alias{.id<-,gWidgetRGtk,guiWidgetsToolkitRGtk2-method} %% -- isExtant -- %% \alias{isExtant-methods} \alias{isExtant,guiWidget-method} \alias{isExtant,gWidgetRGtk-method} %% %% -- .isExtant -- %% \alias{.isExtant-methods} \alias{.isExtant,gWidgetRGtk,guiWidgetsToolkitRGtk2-method} \alias{.isExtant,gGridRGtk,guiWidgetsToolkitRGtk2-method} %% %% -- defaultWidget -- %% \alias{defaultWidget-methods} \alias{defaultWidget,guiWidget-method} \alias{defaultWidget,gWidgetRGtk-method} \alias{defaultWidget,RGtkObject-method} \alias{.defaultWidget,gWidgetRGtk,guiWidgetsToolkitRGtk2-method} %% %% -- defaultWidget<- -- %% \alias{defaultWidget<--methods} \alias{defaultWidget<-,guiWidget-method} \alias{defaultWidget<-,gWidgetRGtk-method} \alias{defaultWidget<-,RGtkObject-method} \alias{.defaultWidget<-,gWidgetRGtk,guiWidgetsToolkitRGtk2-method} \alias{.defaultWidget<-,RGtkObject,guiWidgetsToolkitRGtk2-method} %% %% -- addhandler -- %% \alias{addhandler-methods} \alias{addhandler,guiWidget-method} \alias{addhandler,gWidgetRGtk-method} \alias{addhandler,RGtkObject-method} \alias{addandler,ANY-method} %% %% -- blockhandler -- %% \alias{blockhandler-methods} \alias{blockhandler,guiWidget-method} \alias{blockhandler,gWidgetRGtk-method} \alias{blockhandler,RGtkObject-method} \alias{blockhandler,ANY-method} %% %% -- .blockhandler -- %% \alias{.blockhandler-methods} \alias{.blockhandler,gWidgetRGtk,guiWidgetsToolkitRGtk2-method} \alias{.blockhandler,gComponentWithRefClassRGtk,guiWidgetsToolkitRGtk2-method} \alias{.blockhandler,RGtkObject,guiWidgetsToolkitRGtk2-method} \alias{.blockhandler,gGridRGtk,guiWidgetsToolkitRGtk2-method} \alias{.blockhandler,gCheckboxgroupRGtk,guiWidgetsToolkitRGtk2-method} \alias{.blockhandler,gCheckboxgroupTableRGtk,guiWidgetsToolkitRGtk2-method} \alias{.blockhandler,gRadioRGtk,guiWidgetsToolkitRGtk2-method} %% %% -- unblockhandler -- %% \alias{unblockhandler-methods} \alias{unblockhandler,guiWidget-method} \alias{unblockhandler,gWidgetRGtk-method} \alias{unblockhandler,RGtkObject-method} \alias{unblockhandler,ANY-method} %% %% -- .unblockhandler -- %% \alias{.unblockhandler-methods} \alias{.unblockhandler,gWidgetRGtk,guiWidgetsToolkitRGtk2-method} \alias{.unblockhandler,RGtkObject,guiWidgetsToolkitRGtk2-method} \alias{.unblockhandler,gComponentWithRefClassRGtk,guiWidgetsToolkitRGtk2-method} \alias{.unblockhandler,gCheckboxgroupRGtk,guiWidgetsToolkitRGtk2-method} \alias{.unblockhandler,gCheckboxgroupTableRGtk,guiWidgetsToolkitRGtk2-method} \alias{.unblockhandler,gGridRGtk,guiWidgetsToolkitRGtk2-method} \alias{.unblockhandler,gRadioRGtk,guiWidgetsToolkitRGtk2-method} %% %% -- removehandler -- %% \alias{removehandler-methods} \alias{removehandler,guiWidget-method} \alias{removehandler,gWidgetRGtk-method} \alias{removehandler,RGtkObject-method} \alias{removehandler,GtkTreeViewColumn-method} %% %% -- .removehandler -- %% \alias{.removehandler-methods} \alias{.removehandler,gWidgetRGtk,guiWidgetsToolkitRGtk2-method} \alias{.removehandler,RGtkObject,guiWidgetsToolkitRGtk2-method} \alias{.removehandler,gComponentWithRefClassRGtk,guiWidgetsToolkitRGtk2-method} \alias{.removehandler,gCheckboxgroupRGtk,guiWidgetsToolkitRGtk2-method} \alias{.removehandler,gCheckboxgroupTableRGtk,guiWidgetsToolkitRGtk2-method} \alias{.removehandler,gRadioRGtk,guiWidgetsToolkitRGtk2-method} %% %% %% -- addhandler -- %% \alias{addhandler-methods} \alias{addhandler,guiWidget-method} \alias{addhandler,gWidgetRGtk-method} \alias{addhandler,RGtkObject-method} \alias{addhandler,GtkTreeViewColumn-method} %% %% -- .addhandler -- %% \alias{.addhandler-methods} \alias{.addhandler,gWidgetRGtk,guiWidgetsToolkitRGtk2-method} \alias{.addhandler,RGtkObject,guiWidgetsToolkitRGtk2-method} %% -- addhandlerchanged -- %% \alias{addhandlerchanged-methods} \alias{addhandlerchanged,guiWidget-method} \alias{addhandlerchanged,gWidgetRGtk-method} \alias{addhandlerchanged,RGtkObject-method} \alias{addhandlerchanged,ANY-method} \alias{addhandlerchanged,gSubsetbyRGtk-method} \alias{addhandlerchanged,GtkTreeViewColumn-method} %% %% -- addHandlerChanged -- %% \alias{addHandlerChanged-methods} \alias{addHandlerChanged,guiWidget-method} \alias{addHandlerChanged,gWidgetRGtk-method} \alias{addHandlerChanged,RGtkObject-method} \alias{addHandlerChanged,ANY-method} \alias{addHandlerChanged,gSubsetbyRGtk-method} \alias{addHandlerChanged,GtkTreeViewColumn-method} %% %% -- .addhandlerchanged -- %% \alias{.addhandlerchanged-methods} \alias{.addhandlerchanged,gWidgetRGtk,guiWidgetsToolkitRGtk2-method} \alias{.addhandlerchanged,gActionRGtk,guiWidgetsToolkitRGtk2-method} \alias{.addhandlerchanged,gButtonRGtk,guiWidgetsToolkitRGtk2-method} \alias{.addhandlerchanged,gCheckboxRGtk,guiWidgetsToolkitRGtk2-method} \alias{.addhandlerchanged,gCheckboxgroupRGtk,guiWidgetsToolkitRGtk2-method} \alias{.addhandlerchanged,gCheckboxgroupTableRGtk,guiWidgetsToolkitRGtk2-method} \alias{.addhandlerchanged,gDroplistRGtk,guiWidgetsToolkitRGtk2-method} \alias{.addhandlerchanged,gEditRGtk,guiWidgetsToolkitRGtk2-method} \alias{.addhandlerchanged,gExpandgroupRGtk,guiWidgetsToolkitRGtk2-method} \alias{.addhandlerchanged,gGraphicsRGtk,guiWidgetsToolkitRGtk2-method} \alias{.addhandlerchanged,gGridRGtk,guiWidgetsToolkitRGtk2-method} \alias{.addhandlerchanged,gSubsetbyRGtk,guiWidgetsToolkitRGtk2-method} \alias{.addhandlerchanged,gLabelRGtk,guiWidgetsToolkitRGtk2-method} \alias{.addhandlerchanged,gNotebookRGtk,guiWidgetsToolkitRGtk2-method} \alias{.addhandlerchanged,gRadioRGtk,guiWidgetsToolkitRGtk2-method} \alias{.addhandlerchanged,gSliderRGtk,guiWidgetsToolkitRGtk2-method} \alias{.addhandlerchanged,gSpinbuttonRGtk,guiWidgetsToolkitRGtk2-method} \alias{.addhandlerchanged,gTextRGtk,guiWidgetsToolkitRGtk2-method} \alias{.addhandlerchanged,gTreeRGtk,guiWidgetsToolkitRGtk2-method} %% %% -- addhandlerkeystroke -- %% \alias{addhandlerkeystroke-methods} \alias{addhandlerkeystroke,guiWidget-method} \alias{addhandlerkeystroke,gWidgetRGtk-method} \alias{addhandlerkeystroke,RGtkObject-method} \alias{addhandlerkeystroke,gTextRGtk,guiWidgetsToolkitRGtk2-method} %% %% -- .addhandlerkeystroke -- %% \alias{.addhandlerkeystroke-methods} \alias{.addhandlerkeystroke,gWidgetRGtk,guiWidgetsToolkitRGtk2-method} \alias{.addhandlerkeystroke,gEditRGtk,guiWidgetsToolkitRGtk2-method} \alias{.addhandlerkeystroke,gTextRGtk,guiWidgetsToolkitRGtk2-method} \alias{.addhandlerkeystroke,gDroplistRGtk,guiWidgetsToolkitRGtk2-method} %% %% -- addhandlerclicked -- %% \alias{addhandlerclicked-methods} \alias{addhandlerclicked,guiWidget-method} \alias{addhandlerclicked,gWidgetRGtk-method} \alias{addhandlerclicked,RGtkObject-method} %% %% -- .addhandlerclicked -- %% \alias{.addhandlerclicked-methods} \alias{.addhandlerclicked,RGtkObject,guiWidgetsToolkitRGtk2-method} \alias{.addhandlerclicked,gWidgetRGtk,guiWidgetsToolkitRGtk2-method} \alias{.addhandlerclicked,gButtonRGtk,guiWidgetsToolkitRGtk2-method} \alias{.addhandlerclicked,gCheckboxRGtk,guiWidgetsToolkitRGtk2-method} \alias{.addhandlerclicked,gCheckboxgroupRGtk,guiWidgetsToolkitRGtk2-method} \alias{.addhandlerclicked,gCheckboxgroupTableRGtk,guiWidgetsToolkitRGtk2-method} \alias{.addhandlerclicked,gDroplistRGtk,guiWidgetsToolkitRGtk2-method} \alias{.addhandlerclicked,gGraphicsRGtk,guiWidgetsToolkitRGtk2-method} \alias{.addhandlerclicked,gGridRGtk,guiWidgetsToolkitRGtk2-method} \alias{.addhandlerclicked,gImageRGtk,guiWidgetsToolkitRGtk2-method} \alias{.addhandlerclicked,gLabelRGtk,guiWidgetsToolkitRGtk2-method} \alias{.addhandlerclicked,gRadioRGtk,guiWidgetsToolkitRGtk2-method} \alias{.addhandlerclicked,gTreeRGtk,guiWidgetsToolkitRGtk2-method} %% %% -- addhandlerdoubleclick -- %% \alias{addhandlerdoubleclick-methods} \alias{addhandlerdoubleclick,guiWidget-method} \alias{addhandlerdoubleclick,gWidgetRGtk-method} \alias{addhandlerdoubleclick,RGtkObject-method} %% %% -- .addhandlerdoubleclick -- %% \alias{.addhandlerdoubleclick-methods} \alias{.addhandlerdoubleclick,gWidgetRGtk,guiWidgetsToolkitRGtk2-method} \alias{.addhandlerdoubleclick,gGridRGtk,guiWidgetsToolkitRGtk2-method} \alias{.addhandlerdoubleclick,gTreeRGtk,guiWidgetsToolkitRGtk2-method} %% %% -- addhandlerrightclick -- %% \alias{addhandlerrightclick-methods} \alias{addhandlerrightclick,guiWidget-method} \alias{addhandlerrightclick,gWidgetRGtk-method} \alias{addhandlerrightclick,RGtkObject-method} %% %% -- .addhandlerrightclick -- %% \alias{.addhandlerrightclick-methods} \alias{.addhandlerrightclick,RGtkObject,guiWidgetsToolkitRGtk2-method} \alias{.addhandlerrightclick,gWidgetRGtk,guiWidgetsToolkitRGtk2-method} %% %% -- addhandlerdestroy -- %% \alias{addhandlerdestroy-methods} \alias{addhandlerdestroy,guiWidget-method} \alias{addhandlerdestroy,gWidgetRGtk-method} \alias{addhandlerdestroy,RGtkObject-method} %% %% -- .addhandlerdestroy -- %% \alias{.addhandlerdestroy-methods} \alias{.addhandlerdestroy,gWidgetRGtk,guiWidgetsToolkitRGtk2-method} \alias{.addhandlerdestroy,gWindowRGtk,guiWidgetsToolkitRGtk2-method} %% %% -- addhandlerexpose -- %% \alias{addhandlerexpose-methods} \alias{addhandlerexpose,guiWidget-method} \alias{addhandlerexpose,gWidgetRGtk-method} \alias{addhandlerexpose,RGtkObject-method} %% %% -- .addhandlerexpose -- %% \alias{.addhandlerexpose-methods} \alias{.addhandlerexpose,gWidgetRGtk,guiWidgetsToolkitRGtk2-method} \alias{.addhandlerexpose,gComponentRGtk,guiWidgetsToolkitRGtk2-method} \alias{.addhandlerexpose,gGraphicsRGtk,guiWidgetsToolkitRGtk2-method} \alias{.addhandlerexpose,gNotebookRGtk,guiWidgetsToolkitRGtk2-method} %% %% -- addhandlerunrealize -- %% \alias{addhandlerunrealize-methods} \alias{addhandlerunrealize,guiWidget-method} \alias{addhandlerunrealize,gWidgetRGtk-method} \alias{addhandlerunrealize,RGtkObject-method} %% %% -- .addhandlerunrealize -- %% \alias{.addhandlerunrealize-methods} \alias{.addhandlerunrealize,gWidgetRGtk,guiWidgetsToolkitRGtk2-method} \alias{.addhandlerunrealize,gWindowRGtk,guiWidgetsToolkitRGtk2-method} %% %% -- addhandlerblur -- %% \alias{addhandlerblur-methods} \alias{addhandlerblur,guiWidget-method} \alias{addhandlerblur,gWidgetRGtk-method} \alias{addhandlerblur,RGtkObject-method} %% %% -- .addhandlerblur -- %% \alias{.addhandlerblur-methods} \alias{.addhandlerblur,gWidgetRGtk,guiWidgetsToolkitRGtk2-method} %% %% -- addhandlerfocus -- %% \alias{addhandlerfocus-methods} \alias{addhandlerfocus,guiWidget-method} \alias{addhandlerfocus,gWidgetRGtk-method} \alias{addhandlerfocus,RGtkObject-method} %% %% -- .addhandlerfocus -- %% \alias{.addhandlerfocus-methods} \alias{.addhandlerfocus,gWidgetRGtk,guiWidgetsToolkitRGtk2-method} %% %% -- addhandleridle -- %% \alias{addhandleridle-methods} \alias{addhandleridle,guiWidget-method} \alias{addhandleridle,gWidgetRGtk-method} \alias{addhandleridle,RGtkObject-method} %% %% -- .addhandleridle -- %% \alias{.addhandleridle-methods} \alias{.addhandleridle,gWidgetRGtk,guiWidgetsToolkitRGtk2-method} %% %% -- addpopupmenu -- %% \alias{addpopupmenu-methods} \alias{addpopupmenu,guiWidget-method} \alias{addpopupmenu,gWidgetRGtk-method} \alias{addpopupmenu,RGtkObject-method} %% %% -- .addpopupmenu -- %% \alias{.addpopupmenu-methods} \alias{.addpopupmenu,gWidgetRGtk,guiWidgetsToolkitRGtk2-method} \alias{.addpopupmenu,gButtonRGtk,guiWidgetsToolkitRGtk2-method} \alias{.addpopupmenu,gLabelRGtk,guiWidgetsToolkitRGtk2-method} %% %% -- add3rdmousepopupmenu -- %% \alias{add3rdmousepopupmenu-methods} \alias{add3rdmousepopupmenu,guiWidget-method} \alias{add3rdmousepopupmenu,gWidgetRGtk-method} \alias{add3rdmousepopupmenu,RGtkObject-method} %% %% -- .add3rdmousepopupmenu -- %% \alias{.add3rdmousepopupmenu-methods} \alias{.add3rdmousepopupmenu,gWidgetRGtk,guiWidgetsToolkitRGtk2-method} \alias{.add3rdmousepopupmenu,RGtkObject,guiWidgetsToolkitRGtk2-method} \alias{.add3rdmousepopupmenu,gLabelRGtk,guiWidgetsToolkitRGtk2-method} %% %% -- addmousemotion -- %% \alias{addhandlermousemotion-methods} \alias{addhandlermousemotion,guiWidget-method} \alias{addhandlermousemotion,gWidgetRGtk-method} \alias{addhandlermousemotion,RGtkObject-method} %% %% -- .add3rdmousepopupmenu -- %% \alias{.addhandlermousemotion-methods} \alias{.addhandlermousemotion,gWidgetRGtk,guiWidgetsToolkitRGtk2-method} \alias{.addhandlermousemotion,RGtkObject,guiWidgetsToolkitRGtk2-method} \alias{.addhandlermousemotion,gLabelRGtk,guiWidgetsToolkitRGtk2-method} %% %% -- adddropsource -- %% \alias{adddropsource-methods} \alias{adddropsource,guiWidget-method} \alias{adddropsource,gWidgetRGtk-method} \alias{adddropsource,RGtkObject-method} %% %% -- .adddropsource -- %% \alias{.adddropsource-methods} \alias{.adddropsource,RGtkObject,guiWidgetsToolkitRGtk2-method} \alias{.adddropsource,gWidgetRGtk,guiWidgetsToolkitRGtk2-method} \alias{.adddropsource,gLabelRGtk,guiWidgetsToolkitRGtk2-method} \alias{.adddropsource,gEditRGtk,guiWidgetsToolkitRGtk2-method} %% %% -- adddropmotion -- %% \alias{adddropmotion-methods} \alias{adddropmotion,guiWidget-method} \alias{adddropmotion,gWidgetRGtk-method} \alias{adddropmotion,RGtkObject-method} %% %% -- .adddropmotion -- %% \alias{.adddropmotion-methods} \alias{.adddropmotion,gWidgetRGtk,guiWidgetsToolkitRGtk2-method} \alias{.adddropmotion,RGtkObject,guiWidgetsToolkitRGtk2-method} %% %% -- adddroptarget -- %% \alias{adddroptarget-methods} \alias{adddroptarget,guiWidget-method} \alias{adddroptarget,gWidgetRGtk-method} \alias{adddroptarget,RGtkObject-method} \alias{adddroptarget,gEditRGtk-method} %% %% -- .adddroptarget -- %% \alias{.adddroptarget-methods} \alias{.adddroptarget,gWidgetRGtk,guiWidgetsToolkitRGtk2-method} \alias{.adddroptarget,RGtkObject,guiWidgetsToolkitRGtk2-method} \alias{.adddroptarget,gEditRGtk,guiWidgetsToolkitRGtk2-method} \alias{.adddroptarget,gImageRGtk,guiWidgetsToolkitRGtk2-method} \alias{.adddroptarget,gLabelRGtk,guiWidgetsToolkitRGtk2-method} %% %% -- .galert -- %% \alias{.galert-methods} \alias{.galert,guiWidgetsToolkitRGtk2-method} %% %% -- .gmessage -- %% \alias{.gmessage-methods} \alias{.gmessage,guiWidgetsToolkitRGtk2-method} %% %% -- .ginput -- %% \alias{.ginput-methods} \alias{.ginput,guiWidgetsToolkitRGtk2-method} %% %% -- .gconfirm -- %% \alias{.gconfirm-methods} \alias{.gconfirm,guiWidgetsToolkitRGtk2-method} %% %% -- .gbasicdialog -- %% \alias{.gbasicdialog-methods} \alias{.gbasicdialog,guiWidgetsToolkitRGtk2-method} %% %% -- .gbasicdialognoparent -- %% \alias{.gbasicdialognoparent-methods} \alias{.gbasicdialognoparent,guiWidgetsToolkitRGtk2-method} %% %% -- update -- %% \alias{update-methods} \alias{update,ANY-method} \alias{update,guiWidget-method} \alias{update,gWidgetRGtk-method} \alias{update,gSubsetbyRGtk-method} \alias{update,gTreeRGtk-method} %% %% -- .update -- %% \alias{.update-methods} \alias{.update,gComponentRGtk,guiWidgetsToolkitRGtk2-method} \alias{.update,gVarbrowserRGtk,guiWidgetsToolkitRGtk2-method} \alias{.update,gTreeRGtk,guiWidgetsToolkitRGtk2-method} \alias{.update,gWindowRGtk,guiWidgetsToolkitRGtk2-method} %% %% -- .length -- %% \alias{.length-methods} \alias{.length,gWidgetRGtk,guiWidgetsToolkitRGtk2-method} \alias{.length,gCheckboxgroupRGtk,guiWidgetsToolkitRGtk2-method} \alias{.length,gCheckboxgroupTableRGtk,guiWidgetsToolkitRGtk2-method} \alias{.length,gDfEditRGtk,guiWidgetsToolkitRGtk2-method} \alias{.length,gDroplistRGtk,guiWidgetsToolkitRGtk2-method} \alias{.length,gGridRGtk,guiWidgetsToolkitRGtk2-method} \alias{.length,gNotebookRGtk,guiWidgetsToolkitRGtk2-method} \alias{.length,gHelpRGtk,guiWidgetsToolkitRGtk2-method} \alias{.length,gRadioRGtk,guiWidgetsToolkitRGtk2-method} %% %% -- dim -- %% \alias{dim-methods} \alias{dim,ANY-method} \alias{dim,guiWidget-method} \alias{dim,gWidgetRGtk-method} %% %% -- .dim -- %% \alias{.dim-methods} \alias{.dim,gDfEditRGtk,guiWidgetsToolkitRGtk2-method} \alias{.dim,gGridRGtk,guiWidgetsToolkitRGtk2-method} \alias{.dim,gLayoutRGtk,guiWidgetsToolkitRGtk2-method} %% %% -- .dimnames -- %% \alias{.dimnames-methods} \alias{.dimnames,gGridRGtk,guiWidgetsToolkitRGtk2-method} \alias{.dimnames,gDfEditRGtk,guiWidgetsToolkitRGtk2-method} %% %% -- .dimnames<- -- %% \alias{.dimnames<--methods} \alias{.dimnames<-,gGridRGtk,guiWidgetsToolkitRGtk2-method} \alias{.dimnames<-,gDfEditRGtk,guiWidgetsToolkitRGtk2-method} %% %% -- names -- %% \alias{names-methods} \alias{names,ANY-method} \alias{names,guiWidget-method} \alias{names,gWidgetRGtk-method} \alias{names,gFrameRGtk-method} \alias{names,gExpandgroupRGtk-method} %% %% -- .names -- %% \alias{.names-methods} \alias{.names,gDfEditRGtk,guiWidgetsToolkitRGtk2-method} \alias{.names,gExpandgroupRGtk,guiWidgetsToolkitRGtk2-method} \alias{.names,gFrameRGtk,guiWidgetsToolkitRGtk2-method} \alias{.names,gGridRGtk,guiWidgetsToolkitRGtk2-method} \alias{.names,gNotebookRGtk,guiWidgetsToolkitRGtk2-method} %% %% -- names<- -- %% \alias{names<--methods} \alias{names<-,ANY-method} \alias{names<-,guiWidget-method} \alias{names<-,gWidgetRGtk-method} %% %% -- .names<- -- %% \alias{.names<--methods} \alias{.names<-,gDfEditRGtk,guiWidgetsToolkitRGtk2-method} \alias{.names<-,gExpandgroupRGtk,guiWidgetsToolkitRGtk2-method} \alias{.names<-,gFrameRGtk,guiWidgetsToolkitRGtk2-method} \alias{.names<-,gGridRGtk,guiWidgetsToolkitRGtk2-method} \alias{.names<-,gNotebookRGtk,guiWidgetsToolkitRGtk2-method} %% %% -- .getToolkitWidget -- \alias{.getToolkitWidget,gWidgetRGtk,guiWidgetsToolkitRGtk2-method} %% %% -- [<- \alias{[<-,gWidgetRGtk-method} \alias{[<-,gCheckboxRGtk-method} \alias{[<-,gCheckboxgroupRGtk-method} \alias{[<-,gCheckboxgroupTableRGtk-method} \alias{[<-,gDfEditRGtk-method} \alias{[<-,gDroplistRGtk-method} \alias{[<-,gEditRGtk-method} \alias{[<-,GtkTreeView-method} \alias{[<-,gGridRGtk-method} \alias{[<-,gLayoutRGtk-method} \alias{[<-,gMenuRGtk-method} \alias{[<-,gNotebookRGtk-method} \alias{[<-,gRadioRGtk-method} \alias{[<-,gSliderRGtk-method} \alias{[<-,gSpinbuttonRGtk-method} \alias{[<-,gToolbarRGtk-method} %% -- dimnames \alias{dimnames,gWidgetRGtk-method} \alias{dimnames<-,gWidgetRGtk-method} \alias{length,gWidgetRGtk-method} \alias{length,gDroplistRGtk-method} \alias{length,gSubsetbyRGtk-method} %%% Classes from RGTk2 upgraded to S4 classes \alias{AtkNoOpObjectFactory-class} \alias{AtkObjectFactory-class} \alias{AtkRelationSet-class} \alias{AtkStateSet-class} \alias{GBoxed-class} \alias{GObject-class} \alias{GScanner-class} \alias{GdkDragContext-class} \alias{GdkPixbufLoader-class} \alias{GdkRegion-class} \alias{GtkAboutDialog-class} \alias{GtkAccelGroup-class} \alias{GtkAccelLabel-class} \alias{GtkAction-class} \alias{GtkActionGroup-class} \alias{GtkAdjustment-class} \alias{GtkAlignment-class} \alias{GtkArrow-class} \alias{GtkAspectFrame-class} \alias{GtkBin-class} \alias{GtkBox-class} \alias{GtkButton-class} \alias{GtkButtonBox-class} \alias{GtkCList-class} \alias{GtkCTree-class} \alias{GtkCalendar-class} \alias{GtkCellRenderer-class} \alias{GtkCellRendererCombo-class} \alias{GtkCellRendererPixbuf-class} \alias{GtkCellRendererProgress-class} \alias{GtkCellRendererText-class} \alias{GtkCellRendererToggle-class} \alias{GtkCellView-class} \alias{GtkCheckButton-class} \alias{GtkCheckMenuItem-class} \alias{GtkColorButton-class} \alias{GtkColorSelection-class} \alias{GtkColorSelectionDialog-class} \alias{GtkCombo-class} \alias{GtkComboBox-class} \alias{GtkComboBoxEntry-class} \alias{GtkContainer-class} \alias{GtkCurve-class} \alias{GtkDialog-class} \alias{GtkDrawingArea-class} \alias{GtkEntry-class} \alias{GtkEntryCompletion-class} \alias{GtkEventBox-class} \alias{GtkExpander-class} \alias{GtkFileFilter-class} \alias{GtkFileSelection-class} \alias{GtkFixed-class} \alias{GtkFontButton-class} \alias{GtkFontSelection-class} \alias{GtkFontSelectionDialog-class} \alias{GtkFrame-class} \alias{GtkGammaCurve-class} \alias{GtkHBox-class} \alias{GtkHButtonBox-class} \alias{GtkHPaned-class} \alias{GtkHRuler-class} \alias{GtkHScale-class} \alias{GtkHScrollbar-class} \alias{GtkHSeparator-class} \alias{GtkHandleBox-class} \alias{GtkIMContext-class} \alias{GtkIMContextSimple-class} \alias{GtkIMMulticontext-class} \alias{GtkIconFactory-class} \alias{GtkIconSet-class} \alias{GtkIconSource-class} \alias{GtkIconTheme-class} \alias{GtkIconView-class} \alias{GtkImage-class} \alias{GtkImageMenuItem-class} \alias{GtkInputDialog-class} \alias{GtkInvisible-class} \alias{GtkItem-class} \alias{GtkLabel-class} \alias{GtkLayout-class} \alias{GtkList-class} \alias{GtkListItem-class} \alias{GtkMenu-class} \alias{GtkMenuBar-class} \alias{GtkMenuItem-class} \alias{GtkMenuShell-class} \alias{GtkMisc-class} \alias{GtkNotebook-class} \alias{GtkObject-class} \alias{GtkOptionMenu-class} \alias{GtkPaned-class} \alias{GtkProgress-class} \alias{GtkProgressBar-class} \alias{GtkRadioAction-class} \alias{GtkRadioButton-class} \alias{GtkRange-class} \alias{GtkRcStyle-class} \alias{GtkRuler-class} \alias{GtkScale-class} \alias{GtkScrollbar-class} \alias{GtkScrolledWindow-class} \alias{GtkSeparator-class} \alias{GtkSeparatorMenuItem-class} \alias{GtkSeparatorToolItem-class} \alias{GtkSizeGroup-class} \alias{GtkSocket-class} \alias{GtkSpinButton-class} \alias{GtkStatusbar-class} \alias{GtkStyle-class} \alias{GtkTable-class} \alias{GtkTearoffMenuItem-class} \alias{GtkTextAttributes-class} \alias{GtkTextBuffer-class} \alias{GtkTextChildAnchor-class} \alias{GtkTextTag-class} \alias{GtkTextTagTable-class} \alias{GtkTextView-class} \alias{GtkTipsQuery-class} \alias{GtkToggleAction-class} \alias{GtkToggleButton-class} \alias{GtkToggleToolButton-class} \alias{GtkToolButton-class} \alias{GtkToolItem-class} \alias{GtkToolbar-class} \alias{GtkTooltips-class} \alias{GtkTreeModelSort-class} \alias{GtkTreePath-class} \alias{GtkTreeView-class} \alias{GtkTreeViewColumn-class} \alias{GtkUIManager-class} \alias{GtkVBox-class} \alias{GtkVButtonBox-class} \alias{GtkVPaned-class} \alias{GtkVRuler-class} \alias{GtkVScale-class} \alias{GtkVScrollbar-class} \alias{GtkVSeparator-class} \alias{GtkViewport-class} \alias{GtkWidget-class} \alias{GtkWindow-class} \alias{GtkWindowGroup-class} \alias{PangoAttrList-class} \alias{PangoCairoFcFontMap-class} \alias{PangoCoverage-class} \alias{PangoFcFontMap-class} \alias{PangoFontDescription-class} \alias{PangoFontMap-class} \alias{PangoGlyphString-class} \alias{PangoItem-class} \alias{RGtkDataFrame-class} \title{Undocumented functions in gWidgetsRGtk} \description{ The gWidgetsRGtk package implements the gWidgets API. In gWidgets the primary constructors and methods are documented. The basic idea is that \code{function} in gWidgets calls \code{.function} in gWidgetsRGtk. Hence the many functions here. } \keyword{interface}% at least one, from doc/KEYWORDS \keyword{internal}gWidgetsRGtk2/man/gdfedit.Rd0000644000175100001440000000342712434632036015400 0ustar hornikusers\name{gdfedit} \alias{gdfedit} \alias{.gdfedit} \title{gWidgets interface for RGtk2Extras data editor widget} \description{ An alternative widget for editing a data frame using the RGtk2DfEdit package } \usage{ gdfedit(items = NULL, name = paste(deparse(substitute(items)), "1", sep="."), container = NULL, ..., toolkit = guiToolkit()) } \arguments{ \item{items}{data frame to be edited} \item{name}{Name of data frame to save value to} \item{container}{An optional container to attach widget to} \item{\dots}{Can be used to overide default colors.} \item{toolkit}{Which GUI toolkit to use} } \details{ The \code{gdf} widget is used for editing data frames, but does not have the most natural keyboard handling. The \pkg{RGtk2Extras} package by Tom Taverner provides a more powerful and easier to use interface for editing data frame, and this wraps that widget into gWidgetsRGtk2. The \code{addHandlerColumnClicked} function can be used to add a handler to the event when a column header is clicked. The component of the first argument \code{column.no} contains the column number. This widget is a bit different from the others as it is not imported from gWidgets. As such, it won't exist until this \pkg{gWidgetsRGtk2} package is loaded. In practical terms, you need to realize a widget before this one can be realized. } % \value{} % \references{} % \author{} % \note{} \seealso{\code{gtable}} \examples{ \dontrun{ w<-gwindow() g<-ggroup(cont=w) df<-gdfedit(iris, cont=g) ## check names names(df) names(df)[1]<-"new" rownames(df) colnames(df) ## check [ df[,] df[1,] df[,1] ## no [<- function ## check dim stuff dim(df) length(df) ## handler addHandlerColumnClicked(df, handler<-function(h,...) { print(h$column.no) }) } } \keyword{interface } gWidgetsRGtk2/man/gWidgetsRGtk2-package.Rd0000644000175100001440000001647411463164417020024 0ustar hornikusers\name{gWidgetsRGtk2-package} \alias{gWidgetsRGtk2-package} \alias{gWidgetsRGtk2} \docType{package} \title{ Toolkit implementation of gWidgets for RGtk2 } \description{ Port of gWidgets API to RGtk2 } \details{ This package allows the gWidgets API to use the RGtk2 package allowing the use of the GTK libraries within R. The documentation for the functions in this package are contained in the gWidgets package. As gWidgets is meant to be multi-toolkit, this file documents differences from the API, as defined by the man pages of the \pkg{gWidgets} package. \bold{Containers:}\cr If using a \code{ggraphics} device, one should call \code{gwindow} with the argument \code{visible=FALSE} then after the device is added call the \code{visible<-} method to show the window. To access the underlying gtk container from a \code{gframe} object one uses \code{getToolkitWidget(obj)$getParent()} \cr The gnotebook changed handler has component \code{pageno} to indicate the newly selected page number, as the \code{svalue} method returns the page before the change.\cr \bold{Widgets:}\cr The \code{gbutton} constructor can not be called before \pkg{gWidgetsRGtk2} is loaded. This means that an initial call like \code{gbutton("label", cont=gwindow())} won't work. Instead, either load directly \pkg{gWidgetsRGtk2} (not just \pkg{gWidgets}) or create another widget, like a top-level window. Something similar is the case for the \code{gdfedit} widget. \cr The \code{gradio} widget can now have its items shortened or lengthened via \code{[<-}.\cr For the data frame viewer \code{gtable} when no filtering is requested -- the default -- the column headers can be clicked to sort the values. Setting the index to 0 will clear the selection. In the data frame editor \code{gdf} the \code{subset} option only works if the column names have not been changed. One can suppress the creation of keyboard navigation and the right click popup on the column headers. The hiddern argument \code{diy} (for do it yourself) if left empty will place in both. A value of \code{"suppress.key"} or \code{"suppress.popup"} (or both) will suppress the respective handler. \cr The \code{gaction} constructor produces action objects. The \code{enabled<-} method can be used to set their sensitivity. The objects can be used with \code{gbutton} through the \code{action} argument, and in the lists defining menubars and toolbars. The \code{key.accel} argument (for assigning a keyboard accelerator) of the constructor is ignored for now. The \code{tooltip} is OS sensitive, as it depends on the event loop implementation. \cr The \code{gtoolbar} list can have components that are a) lists with a handler componented, b) lists with a separator component, c) gaction instances d) gWidgets, in which case the widget appears in the toolbar. The latter is not portable to other gWidgets implementations.\cr The \code{gvarbrowser} constructor depends on a variable \code{knownTypes}. A default is provided in the package, but this can be overridden by a) providing a hidden argument \code{knownTypes} to the constructor or b) setting an option \code{knownTypes}. In each case this is a named list whose components are character vectors listing classes of a similar nature. For example, the default value for \code{knownTypes} included \code{"data sets"= c("numeric","logical","factor","character","integer", "data.frame","matrix","list", "table","xtabs", "nfnGroupedData","nffGroupedData","nmGroupedData", "POSIXct","POSIXlt","POSIXt" )}. \cr The function used to map a class to an icon is by default \code{getStockIconFromClass}. This can be changed by assigning a function to the option \code{gWidgetsStockIconFromClass}. This function should take a class and return a stock icon name. (The class passed is the first value only.) The \code{gfile} constructor has the argument \code{multiple}, which if TRUE will allow for multiple selections of files. This feature should be merged into the gWidgets API, but for now is passed in via \code{...}. \cr The \code{ggraphics} constructor provides a means to embed a graphics window inside a GUI. A right mouse popup allows one to copy the graphic to the clipboard or save it to a file. The different file types are limited by the function \code{gdkPixbufSave} whose manual page states that jpg, png, ico and bmp are permissable. A few quirks exist. \enumerate{ \item Drawing a graphic too soon may result in a message about \code{plot.margins too small}. This comes from trying to draw the first graphic before the window is fully realized. \cr One workaround is to initially set the window not visible then when the GUI is done, make the window visible. That is, try: \code{w <- gwindow(visible=FALSE); ggraphics(cont=w); visible(w) <- TRUE; hist(rnorm(100))} \item When there are multiple devices, the standard means of setting a device via \code{dev.set} are supplemented by mouse handlers. Clicking in the graphics window sets the window as the current device. \item The handler for \code{addHandlerClicked} responds to a mouse click. The components \code{x} and \code{y} give the coordinates in "usr" coordinates. \item The handler for \code{addHandlerChanged} responds to the "rubber-banding" effect that comes from trying to trace out a rectangle in the graphic window. The components \code{x} and \code{y} give the coordinates in "usr" coordinates. (These each have two values.) The functions \code{grconvertX} and \code{grconvertY} can convert to other coordinate systems for you. See the \code{ggraphics} help page for an example of how this can be used to update a data frame. } The \code{gbasicdialog} constructor can be used both ways. The hidden argument \code{buttons} can take values \code{ok}, \code{yes}, \code{cancel}, \code{close}, \code{no}, with a default of \code{c("ok","cancel")}. \bold{Methods:}\cr The \code{font} method is not implemented. \cr For widgets which allow markup (\code{gframe}, \code{glabel}) PANGO markup is used. This is not HTML, but is similar to basic HTML.\cr \bold{gWidgetsRGtk2 and the RGtk2 package:}\cr The \pkg{RGtk2} package is imported only so its namespace, which is large, is not loaded by default. To access its functions, load the package. \cr The \pkg{RGtk2} package and \pkg{gWidgetsRGtk2} can be used together in the following ways. First, an \pkg{RGtk2} object can be added to a \pkg{gWidgetsRGtk2} through the \code{add} method of the container. This works for most objects. If you find one that doesn't work, simply place it inside a \code{gtkHBox} container, then add that container. Second, a \pkg{gWidgetsRGtk2} object can be added to to a \pkg{RGtk2} container by adding the return value of the \code{getToolkitWidget} method of the object. Again, this should work, but if not, the \pkg{gWidgetsRGtk2} can be added to a \code{ggroup} container first. In either case, the \pkg{gWidgetsRGtk2} object should not be previsously attached to a container, so in particular the constructor should be called with its \code{container} argument as \code{NULL} (the default). } \author{ Michael Lawrence, John Verzani Maintainer: John Verzani } % \references{} \keyword{ package } \seealso{gWidgets}