REBOL [ Title: "Desktop" file: %active-viewtop.r date: 2005-08-31 library: [ level: 'intermediate platform: 'all type: [tool] domain: [ui] tested-under: [winxp] ] Basedon: [view 1.3.1] Author: ["RT" "Ingo Hohmann"] License: { REBOL/View Desktop License 1.0 ------------------------------ This software is Copyright REBOL Technologies. All rights reserved. REBOL is a registered trademark of REBOL Technologies. Redistribution and use of this software, in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions in source code must retain the above copyright notice, this list of conditions, and the following disclaimer. 2. Redistributions in binary form must display the above copyright notice on program startup, and the documentation and/or other materials provided with the distribution must also reproduce the above copyright, this list of conditions, and the following disclaimer. 3. The right to distribute this software or to use it for any purpose does not give you the right to use Trademarks of REBOL Technologies. 4. If any files are modified, the modified files must carry prominent notices stating that you changed the files and the date changed. Disclaimer THIS SOFTWARE IS PROVIDED "AS IS" AND ANY EXPRESSED OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL REBOL TECHNOLOGIES OR ITS CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. } Purpose: { Add some mor dynamic capabilities to the Rebol desktop, specifically: - startup folder, e.g. put this in your user.r desktop-startup-folder: %local/ and on startup your local folder is displayed - dynamic folders: add dynamic: true to your index.r header, and the index file will first be 'COMPOSEd - actions, e.g. put this in your index.r action "Click me" [ alert "hi" [Text "This will be displayed within the desktop" [alert "ho"]] ; the return value wil be 'LAYOUTed, if it's a block, or just ; displayed in the desktop folder, if it's a string! ; If you have no return value, then nothing will be displayed ] - app scripts, these run within the same process as the desktop, so they share lessened security settings, and can return values to be displayed in the desktop. Just put x-desktop-launch: app into the header of your scripts - strings returned from app/actions will be displayed in the desktop folder area, block will be used as layout blocks, and displayed in the desktop folder area. - icon groups, e.g. group "Group1" effect [multiply red] icon "Group1\Icon1" %hkhkjh icon "Group2\Icon1" %lkjljl icon "Group1\Icon2" %lkjljl all icons of group1 will be displayed in red, and sorted into one line - you can add a app pane, e.g. to display a calendar alongside your folders put } Usage: { %user.r: if view? [ desktop-startup-folder: %local/ ; when starting desktop, first read this file (located in your view-root dir) insert second :desktop [if error? set/any 'err try [do %view-root/desktop.r][alert join "Can't open desktop.r^/ error: " mold disarm err]] ; start desktop when no script on windows if all [none? system/options/script 3 = system/version/4][ desktop ] ] %index.r: REBOL [Title: "Local Index" Type: 'index dynamic: true] title "Local Files" app: 0.3 ; your main pane will be devided 70% for folders, 30% for app group "A" effect [multiply red] file "I&Starter" %../toollist.r file "Librarian" %../../.Doc/Rebol/library/run-librarian.r file "A&Vim" %gvim.r edge effect [multiply green ] ( if system/network/host = "secoh" [ [ service "A&MediaMonkey" #media do [call form "c:\Programme\Mediamonkey\Mediamonkey.exe"] file "A&DOpus" %dopus.r service "A&DOpus H:" do [call ["C:\Programme\GPSoftware\Directory Opus\DOpus.exe" "h:\.Win\"]] service "ShowMe" do [call compose ["C:\Programme\XnView\xnview.exe" ( join "-slide " form to-local-file request-file/filter/file/only "win-*.sld" %/e/Bilder/)]] ] ] ) action "A&Squeak" #squeak do [call form to-local-file clean-path %Squeak/squeak.exe ] action "I&Thunder" #thunder do [call form to-local-file clean-path %MozillaThunderbird/thunderbird.exe] action "I&Fire" #fire do [call form to-local-file clean-path %MozillaFirefox/firefox.exe "done"] %dopus.r REBOL [ x-desktop-launch: 'app ; runs in the same thread, as the desktop, shares security settings ] call ["C:\Programme\GPSoftware\Directory Opus\DOpus.exe" "/autolister"] ; value returned will be displayed in the folder area "Done" } Fixme: { - is the group divider #"\" a good idea? (not used in normal names, understandable as a divider in non-pached desktops?) } changes: [ 2005-08-31 "added action-icon" ] ] ctx-viewtop: [ ;;; (iho) added this block, to make services a little more dynamic services: [ goto [goto-view] help [help-view] console [halt-view] quit [quit] ] ;;; (iho) new add-service: func [name [word!] action [block!]][ insert tail services name insert/only tail services action ] add-service 'app [alert "app setup ..."] ;;; (iho) added groups to make a list of used groups groups: copy [] init-desktop-files: has [paths path files] [ this-path: none history-file: view-root/desktop/history.r paths: [ %desktop/ %local/ %desktop/icons/ %desktop/skins/ %desktop/sounds/ %desktop/tools/ ] foreach path paths [if not exists? view-root/:path [attempt [make-dir/deep view-root/:path]]] if not exists? path: view-root/desktop/filetypes.r [ write path join {REBOL [Title: "File Types"] } mold/only suffix-map ] files: [ %desktop/bookmarks.r { ^-^-^-REBOL [Title: "Bookmarks" Type: 'index] ^-^-^-folder "REBOL" http://www.rebol.com/index.r ^-^-^-info "REBOL.com primary REBOL/View reb-site" ^-^-^-folder "Public" http://www.rebol.com/view/public.r ^-^-^-info "Public sites, links, and programs" ^-^-^-folder "Local" %local/index.r ^-^-^-info "Local links and files" ^-^-^-file "Console" console icon console ^-^-^-info "Open the REBOL console" ^-^-} %desktop/services.r { ^-^-^-REBOL [Title: "Services" Type: 'index] ^-^-^-service "Goto" goto ^-^-^-service "Help" help ^-^-^-service "Quit" quit ^-^-} %local/index.r { ^-^-^-REBOL [Title: "Local Index" Type: 'index] ^-^-^-title "Local Files" ^-^-^-file "Info" %info.txt ^-^-} %local/info.txt { ^-^-^-Local scripts can be placed in this folder. To do so, edit ^-^-^-your local/index.r file to include the filenames for the ^-^-^-files that you want to include. You can right click on the ^-^-^-local folder icon to edit or reload it. ^-^-} ] foreach [file text] files [ if not exists? path: view-root/:file [write path trim/auto text] ] if not exists? history-file [ save history-file [ http://www.rebol.com/index.r http://www.rebol.com/index.html ] ] ] default-icon: load #{ 89504E470D0A1A0A0000000D49484452000000300000003008060000005702F9 870000001374455874536F667477617265005245424F4C2F566965778FD91678 0000063549444154789CED97696C545514C7C9B474A15FDA54BAD396325D4629 281A68D16AC4E02E460C34620C21424B01C560341091902E369026267C118DC6 188D894BB4FB4AF77DA3D0165A4A57A0053ADD67A650DA72BCFFEBDCC9E3512A C9DC897C9897FCF2DEBCDE77DEF9FFCFB9F7DD2E59623FEC87FDF8AFC32D3636 B6302E2EEE24888F8F4F057BF7EEFD0A2424241C67E7249CCD1C651CDBB76FDF 178CC3663E07FBF7EFFFF4C0810387D8F913763E585155BF2DAFB4F5746553EF FBB61410A5D16868D9B2651C5757D7FB707171B90F6767E707E2E4E4C4D1681C 68C3C64DE4E8B8740F7B4F34E349869774013A9D8EE6E7E7A5131818424ECECE 77973A39DD75F7F034BDFCEA96EF7CFD56C49885044A153037372705242EAE9F 58FD14257C9C483FFF594B014C8CC6C181B4613AFD7B1FEC7E83BD771D23F891 13A044F7F85ADAF9E161FAE9F75ACA29EBA6DCF22E72707024FF80C011FF1541 51ECDDDA4756C02C2342B786B6EF3848A7BECDA75FFF6EA6C2EA012AAAE967F3 C485C275AB3B5D5C5CD74B1110111161930A844744D2DB5BE329F9E46FF4CD8F C5F4474E2B95340C5141752FB1F7D2FAE8E70FB173A81401B3B3B352B9736796 0B7873CB6E3A72EC073AF1F55FF4FD2F15945ED841952D7A7A6CB9372DF7F299 0C080CF69622606666463A5AAD8E3644BF465BDE89E7ADB42BEE281DFCEC047D 99729A8E1C3F450E8E8E14BB63578C3401B76FDF96CA9EB88F2872CD068A5C1B 454F3FF31C6D7C7613C5BCB0995E7CE975DAFCCA5BBC8DD83725D96A01E1E1E1 74EBD62DCEF4F4B4744CD3A67F3118C9683491C13045A36323141814848FE74E 29024C2613C76834DA0483718A0C535334C5AE2726C6E9E6CD9B141010406E6E 6EDBA50830180C9C29BC6411262727493F3242838343D4DFDF4FDDDDDD343030 4043D7AFD3C8E8E822CF4ED2249E678C8D8DD18D1B37848058290226262638E3 E3E30F6478584F3D3D3D74E1C2056A6D6DA5B6B6367E16E07E5F5F1F8D30818B C5D1EBF5CC80417915080B0BE3AE8051E6A21A2474EDDA204FF0DCB973165A5A 5AE8ECD9B31C5C0B30EE3AABC842B100DAE7EAD5ABF22A101A1ACA930470470D DC82C322D9E6E6667EC6BD8B172F527B7B3BFF0D511D1D1D1C88409B2C140FE2 D076D204A002C3C3C3DC19BC54097A1DC9343634506363A385A6A626DEFF786E 6868883A3B3B5995AEF1DF00AD0621EA7800E37A7B7BB900B60A59DF42A8005C 01705B4977770F35B0E4EBEBEB2DD4D5D5F17B5D5D5D0B2608200A55C19C50C7 84FB972F5F267F7F7F0890D34222387A5309DAA3A6A6866A6B6BEF0122E03A44 235924247E035400635005754C88BA74E99210B0CD6A01AB56ADA22B57AE70B0 342A41AB54565672AAAAAA2C545757F3FE473BC0515406F7C4EA04917806F345 1D13AD8767FDFCFCE45400021018CEC0392548AAA2A282CACBCB2D67718D4491 3CFA19E3C47DE578DC57C744EBE159B300EBE78056ABE581E10C822BA9AAAAA6 9292124E6969E93D60D58168B40FDC56FF1DCFA0FDD431D156E7CF9F275F5F5F 390250012481E0E8632568853367CE50717131EF69B40492C53D4C52E1281CC7 18251883C9AE8E89550DDF0B6915080909E181C5FAAD04BD5D5858C885600C26 1FCA0F77B19C0A47E138C615151571C43504AB63629E606EA1021A8DE65D2902 94C19520013889170A073101CBCACA2CA2F01CC6E4E7E75BC8CBCBE322D12AEA 98701FC6F8F8F8604BBDD56A012B57AEE4CB259C556E15C476017D8C84F17724 0FE79124EEE3379282DBB9B9B99C9C9C1C2E0049AAE3019802F16601D6570002 9004DC12DB0525701F0290245A05C9656767534141017719EE23F1ACAC2C0E04 882574A1783000AB9359C046AB050407075B3666CAED8212B8091148302323E3 814008926F506D3D946031C0126B161025A502700B4E2BB70C6AF062B10221D1 CCCC4C4A4F4FE7A2D0525879E02CC62D1647B4A4B7B73704444BA9009C816BEA 2D832DC0971CAD67AE801C01C26138686BD03EA896B90272E6009217EED81A7C F4D086D204040505F1E4D19B622F634BC4474F6A0590BCD890D91AF43F96602F 2F2F7973E07F1460AF0017202616BEB2B606C9E32C4D00FEB94E4B4BA3949414 4A4C4CE424252559AE65939C9C4CA9A9A9E4E9E929A585D67978781070777727 E5F5C3A07C4E7DEF619E63EFF7B75680FDB01FF6E3113EFE019BCFC626CDE04D DD0000000049454E44AE426082 } reblet-icon: load #{ 89504E470D0A1A0A0000000D49484452000000300000003008060000005702F9 870000001374455874536F667477617265005245424F4C2F566965778FD91678 0000068949444154789CED587B4C9357145F7CBF791508AF32DE14D1A53C44C2 5B5A9E0206253EA21040E6930D04B685CC16D6044216EB0821AB8F418142D68F 88DAC5C4A69FC4DAF26AB180D1F207901023C4880F322603D60BBBA7190C9032 1F2DEC8F9EE4265FEE77BFDBF3BBF79CDFF99D7EF699D18C6634A319CD6846FB D7DA150F39377F1373ABEB88CAABD50DBCEBFC065E6D3D5179537487DBDAAEE0 ACB67F4B9A52D5C3BA56435414B07E141C4EFF5AC43C70820C8D3E280DDA9720 0FDAB75F1ECA4C9232E292C99463E9A29CBCEF04FCBAFA8AEEEE1ED66AFBADB5 6BB58DE5A9670B09E6813432203C5EE9ED13A476A7EDEE7772F118747472790A C3C9C57DD0CD6367FFCE5D74B55F408832921147A69FFC9210D43794AF9AE30F 5A3A38F96C2E3FFA60A6D82F385A054EDB3950872814CB97262626A3DBB76FFF 7DDBB66D6330E019E62C28949776760E43AE6E1EFD741F5F5554549498CD2EE2 2B95CA950D2D49B3BC343D9B250C8F3F2ADB490FE8B5B5A30E9B9A9ABDD9BA75 EB1F9B366DFA73C3860D93EBD7AF9F5AB76EDD5F30E019E6E01DAC81B53636B6 C3349A576F7070B02C33335378EFDEBDD21571FE41AB8293FE155B18C438D8E6 46DB356069693502A7BC71E3C6097074EDDAB59A356BD6A0A506BC8335B016BE C1B735E2ECEC32B077EFDEB653A74E093B3A3A0C7F13DFFEF0537544FC31991B ED8B01730BCAABCD9B378FFF97E3BA80C0B7E6E6E6AF9C9D9D07E026D86C76B5 419DFF45D0541E937252EC4D0FECB5B4B41ED1E53C9E47478E1C41050505283F 3F1FA5A6A66AE7CDCCCC50525212BA74E912AAADADD56465654D5958588C5328 94114F4FCF5EC889BABA3AC324B6F261372B2B874DF885C4AA6C1DA8C31002BA 4EDEDADA1AE1C444333333DAF1E4C913141919894422111A1F1F9F9B9F9C9CD4 70389CA91D3B768CD9D8D80CD3E974D599336788AEAE2EFD532CBFA1A9222A39 9DF4F0F6E93333377F0D71AC2B6CF0894EB7B5B54DCF3AFAF6ED5BF4FCF9F339 C7E70F3CAFF1F5F59DC0B7F3DAD5D5B58FC96492376EDCA8D03B800BDF970902 F7252AECA89F0F0193C0E9EB8A71002097CBA7173BFBECD9B377008C8D8DA190 909029D8D3D6D676C8DFDF5F515C5C2CD0ABF3AD1D9D9CC399B9226FDF2035F0 3CD0E17249BB1400A15088B073686060600180C6C646646A6AAA813D713EBCA4 D168EAE3C78F8BF4CA48A23B126EECA10C89BB974FBF8989E92870FA722CB318 C0F0F030F2F3F3D3BE633018A8B9B919A9D56AC4E3F190838383761EF68462E7 E2E2D29F989828118BC55CBD01E0D7375686C5A6489D5D69835055970B9FA500 F4F4F4C0DC7C1A45F8C4177C037BC2DE8E8E8E8318A4F4F6EDDB957A03F0F3F5 3A5E302351E6E8E4FA14D807AAEB72007028CCCC07F0F8F16384E37BD9DA007B C2DEF8469E464444C87022F3F406E06A9580171C112F0361B6520070CEE80F40 03D154191E95240585B95408E16A0A21F04900E68710A65269535393FE42886C 9672E30E1C95B879EE5A90C4542A155DBE7C196121866A6A6AB42CF3B100E627 71424282E4EEDDBBFA4BE2F60E25E744E65991D76EDF391AC54E6A70A22DA0C4 478F1E217C82408BD31F02002879318DE242A85F61C72A2E11F807852B6CEDA9 DA428699626A7474F49DC274FAF469B465CB9669994CF6DE00F0E9839CD016B2 808000051675FA2D64600DBF12157109C9A4ABBB671F94FDB0B0B089172F5E68 1603484B4BD3026869699903005A4817807F4E7F029FBE564AC4C4C4900441E8 5F4AA8BABA5917F2BE21E8743F1534235656566357AE5C994208CD81B87FFF3E C2F35ACE5728147300FAFAFA90BDBDBD4E590DEC332BE6CE9F3F4FA8542AC3F4 CB426163F9FE844431485F90C058758E1716164EDDBA754BC3E57291BBBBBBD6 31EC10C2AA12959595A1929212949B9B8B7088E8EC0966E5344E5E3196D986ED 934B4B4BAB43434365D0844033020E6065FAC90D0D703F1671866D68C030BB70 7093228436107E184EEFE35B4ACA08EC111818D8969D9D2D6C6D6D5D99E69E24 C9520001A706570FF18BA9F3039A7AD337F00D7C8BD94C76EEDC3921ECB922CE CF1ADC04363EC42D241F1420A041E0729D7FABE077B006D6C23758758A71D8F0 F5CEF91F62D0C3E6E5E511B1B1B1E49E3D7B945088C0419004A06B60C033CC79 7979A971B828E3E2E2C89C9C1CC2E009FBBED6D9D9C9AAAAAAAAB878F1A200AA 68CAA143240624654631E5B851974747454B939393C98C8C0C51515191003B5E 6130AAFC546B6F6FE7808E0131068A12775C3C2C8D2B251209B7BBBBFBFFF9E7 AED18C6634A319CD68AB657F032F07F6B3564609540000000049454E44AE4260 82 } folder-icon: load #{ 89504E470D0A1A0A0000000D49484452000000300000003008060000005702F9 870000001374455874536F667477617265005245424F4C2F566965778FD91678 0000067D49444154789CED997F4C556518C74B4018611B88BF2ACD4C06645682 A482B299A924F91B8716EA149C848A337FA0945348A5088D65A290D3CD446C36 14A7D26ABA7EA85BE6E6D472B6969B5B456BB3B5C6CC1FE4DBF379C77377C27B B957BD5EFAE3BEDB77E73DE7DE73EEF3799FEFF39C73E08107822338822338FE D7A3BEA678F5BE3DDB4CD5871F586DD8556D55BDAFD64A8FA3FDC74FB56C6D38 7C5AE60D9BDF5B53B66CF5DAD9A22499477754F065042F01984F0F6C3197CED5 98AF8EAD3055E50556851B4A5C40DB0F7F6D1ABFBD602520561C0392CF975554 5D149875A2C480042F016F2468A41004DDB03BC79C3A92ED12FB95EF4E35C5A5 B3CC8C25F9046A0357298C4A3204D0999CA52B8BE49AB1F72B78BBF2E8DAB593 564DBF56DAD527D0F9F9A3CDC2BC674D517EB2A9DD3AD20533797C9CE9D6BB87 499F3ADEE4BF59664AB7D599B29DF53668271059623E2937EFBA64A4564046DE 73D0E2DB38497789E87BFC2C17362B96E4D855AFDBB1D8060F444B4BADD5C58B 15F6B85DFDE5632C105BF63797A559C879391956644656DC05A540C061432410 9744EB4443EF0A60D5FBE59B576D5CFFCFA1B327EC2AE15D2ECC6AF64BE86757 363E39D14C9B9C6A8354A09B37AAED1620E60AC89C637C4F6D0654EAE8443370 F80856DF5E5F33A46A6D0C4DA26A51BACF00B90B16E5BD3475DADF9F9C3F644E FE75C6AABEA9D1EC3C6D3D6B7F6CD4F499F6C701422386C5FF07E8FCD9521794 823881F88CACC53D196DCF9D9DDDDF9E4FA6C938BFE304224BB2FD598E97C8E7 3DDA0590E09E1E973DC31CFCE133F3F94DF77202610727101962CB0A63A7B659 72C2004A561076A39638476DA8402C1A4DA1D5762D62C35AB1648A4788E1192F 36EF6868341F9D3B64F65D3E62034647AE1EF409085BA48E7DC15A0D18569AC2 6E0BE484D1E6E0EA6602A0406CD9274B6A39B9F6154FF14744778BBD5254BEC5 A6D1294D29C1224F500A848F59390A57B34486D43A40B903D2BA21437CA60D81 4EC779D4A36CCF790278303C32F2E8DCD7DFB80DC093BC412910DF7307A450D4 02C112BC8220408005822C709E00347AB450587878CDCB33E6F80CE00B142080 A91D15085FB7B51D3080280040C02900DF1180ED1E0122A31E9AF9DCB05453BE ABEE9E20DC013933E40E88EF9221B2C2CAEBBD462DA790B2BFCC23C0C3313151 8352D36F9554EDF21B002BAD77646F40B44D8A9F820680028E8C8AB050640A0B 492626790460240E1ADCB47443A5DF003C41E95CED06045B56590B9CD5A72D13 3C76034EDA6852BB00313DBB7F99BB7CCD7D05F094213240A7D1768AFFD9622D B597DC237AB70BD025A6EBDE57172C379BEA1A0206A120D88BD526681E3BB80F E07F0740CB3BC5733BB50BD0B57BECFA8C69AF988DB5FB030AA0F58155085ADB 27162278C0A41E2EB71B3CA34F42DFD1E99999A662F7C180036021EE177A7FE0 06060050584B00BEF10A30745442FF018393CD5BD57B021A3C2BCC4A33078002 0680CE03006D548ED77B0528989B15316048925959511D30DBE07FBA0F41B2CF 9C027602B095E3955E01182963C6FDB16A53B5A9FCF8FEDB481F33B00A775B8E 01C2C31C35A06F77B450A98B429F00FAC427FCB4686D59400054044DE102C3F3 920230D7162AF780B13E01F47CBCD7D1ACBC85B7B61E3816301BB1D200F0C84C C0CC69A3CC7925E58E2C2DF4119F009E1AD4BB6062EEAC6B5C1C7FEA4B45DBC7 027FA9F505DF16AEFE658380B10D40AD2DF4AA4FC133A49093A5689AB910FE53 B1AFF2278CF67F5A27B5C00B9202F05BAD2DD4E37BC06DA3AABCA08F9CD0AC9D 011F6A9B7307E4AFECD0690896B9FE11C116B8C420F1ECF519A0BEA6384AFC96 265D61BEF37D577F400BCB09E4EFECE8E2713DE612C3049F019C20A214C9C840 B1559678F484F34F2C0AD4363BEE60EE1488E0B585B6BE07F856C0DE46DD8EC5 71929D4CC94EA1C0B4E8AB617B76BBD3EC50135C876B721D164D7E2FC22F00CE 21D98994ECA4C9236E9AAC5091805C7507E409A63D206D9DA3B2A69867860E33 7E0FDED310A024B9E1909D5A09E047ED26BED8CD09C477A263A3CD84EC29727E FCD98001B41D62B71EBC064A56CA04E60BD95E07684846A699386FA199BEA0D0 CC59B9C62C2ADD645E5BFDB60B4C0106A63C4F26D23A0CC0DD107B253EF644DF D9DD7AF63ADE253AFAF7D0D0D0E6B0B0CE37C23A77BE3172D2646B1FAC47F644 DF097460FEA77017A3AF28593458942FBA101A16F64B48484873A790903FC323 C27E1380791D1AE11D8C48517F5177D1A3A25EA2D00E8D283882233882C3EBF8 179291C86D1CD18EC00000000049454E44AE426082 } ; (iho) action-icon ; TODO: how do I use just 'load ??? action-icon: make image! [32x32 #{ 000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000000000000000000000 FF0000F8091DF8091DF7091DF7081E000000000000000000000000000000 000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000000000000000000000 000000F8071CF8091DF8091DF8091DF8091DF8091DF7081B000000000000 000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000000000000000000000 000000000000F70820F8091CF8091DF8091DF8091DF8091DF8091DF8081C 000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000000000000000000000 000000000000000000FF1122F80A1DF8091DF8091DF8091DF8091DF8091D F8091DF8091C000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000000000000000000000 000000000000000000000000FF0000F80A1DF8091DF8091DF8091DF8091D F8091DF8091DF8091DF8091D000000000000000000000000000000000000 000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000F8091CF8091DF8091DF8091D F8091DF8091DF8091DF8091DF8091DF7091D000000000000000000000000 000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000FF1122F8091DF8091D F8091DF8091DF8091DF8091DF8091DF8091DF8091DF7091E000000000000 000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000000000000000F8091C F8091DF8091DF8091DF8091DF8091DF8091DF8091DF8091DF8091DF9081C 000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000000000000000000000 F7091AF8091DF8091DF8091DF8091DF8091DF8091DF8091DF8091DF8091D F8091DF9091C000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000000000000000000000 000000000000F70A1DF8091DF8091DF8091DF8091DF8091DF8091DF8091D F8091DF8091DF8091DFF0015000000000000000000000000000000000000 000000000000000000000000000000000000000000000000000000000000 000000000000000000000000F8091DF8091DF8091DF8091DF8091DF8091D F8091DF8091DF8091DF8091DF7091D000000000000000000000000000000 000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000F6091FF8091DF8091DF8091DF8091D F8091DF8091DF8091DF8091DF8091DF8091DF90A1D000000000000000000 000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000F8091DF8091DF8091D F8091DF8091DF8091DF8091DF8091DF8091DF8091DF8091DFF002B000000 000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000000000000000F8091D F8091DF8091DF8091DF8091DF8091DF8091DF8091DF8091DF8091DF9081D 000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000000000000000000000 FF001CF8091DF8091DF8091DF8091DF8091DF8091DF8091DF8091DF8091D F8091DFF001C000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000000000000000000000 000000000000F90C1DF8091DF8091DF8091DF8091DF8091DF8091DF8091D F8091DF8091DF7081C000000000000000000000000000000000000000000 000000000000000000000000000000000000000000000000000000000000 000000000000000000000000F9091CF8091DF8091DF8091DF8091DF8091D F8091DF8091DF8091DF7091DFF0000000000000000000000000000000000 000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000F9091DF8091DF8091DF8091D F8091DF8091DF8091DF8091DF8091DF8071D000000000000000000000000 000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000000000FA0A1DF8091D F8091DF8091DF8091DF8091DF8091DF8091DF7091E000000000000000000 000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000000000000000000000 FF0F1EF8091DF8091DF8091DF8091DF8091DF8091DF9081C000000000000 000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000000000000000000000 000000000000000000F8091DF8091DF8091DF8091DF8091EF6091B000000 000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000FF0000F9081CF8091DF8091DFF0020 000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000000000000000000000 000000000000000000000000F6091CF8091DF8081DF8091DF7081C000000 000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000F7081EF8091DF8091DF8091DF8091D F8091DF7081E000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000F7091DF8091DF8091D F8091DF8091DF8091DF8091DFF002B000000000000000000000000000000 000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000000000000000F8091E F8091DF8091DF8091DF8091DF8091DF8091DFA0B1B000000000000000000 000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000000000000000000000 000000F8091DF8091DF8091DF8091DF8091DF8091DF8091DFF1122000000 000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000000000000000000000 000000000000000000F6091FF8091DF8091DF8091DF8091DF8091DF8091D 000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000FA091CF8091CF80A1DF8091D F9081EFF002B000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000000000000000000000 000000000000000000000000 } #{ FFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFF FE8C3B34A2FFFFFFFFFF FFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFF FFDC3B00000005BFFFFF FFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFF FFFFE016000000000066 FFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFF FFFFFFF12A0000000000 0043FFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFF FFFFFFFFFC4500000000 00000022FFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFF94000000 000000000035FFFFFFFF FFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFF11400 000000000000005BFFFF FFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFF77 00000000000000000082 FFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFF E2080000000000000000 00ADFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFF FFFF7A00000000000000 00000AF4FFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFF FFFFFFFF210000000000 0000000057FFFFFFFFFF FFFFFFFFFFFFFFFFFFFF FFFFFFFFFFC600000000 000000000000B1FFFFFF FFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFF6B0000 0000000000000010FAFF FFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFF20 00000000000000000086 FFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFF F7010000000000000000 1DF7FFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFF FFFFD400000000000000 0000A4FFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFF FFFFFFFFAE0000000000 00000034FFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFA8000000 0000000014DDFFFFFFFF FFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFCB00 000000000007C4FFFFFF FFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFF EF000000000002A5FFFF FFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFF FFFFFF7000000027C7FF FFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFE82748FF8 FFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFF FFFFFFFFC9512B51C1FF FFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFF FFFFFFFFFFBD02000000 01A2FFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFF340000 0000000FFAFFFFFFFFFF FFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFF0D 000000000000D0FFFFFF FFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFF FF3D000000000002F1FF FFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFF FFFFFFC604000000006B FFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFCA420E24 87FAFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFF FFFFFFFF }] dtw-open: true dtw-top: dtw-b1: dtw-sid: dtw-mid: ;;; (iho) add an app pane to folders dtw-app: dtw-b2: dtw-bot: none ; (iho) current folder ; FIXME: remember WHY I introduced it, and then use it appropriately ;-) this-folder: none ;app: 0 app: context [ size: 0 pane: none draw: redraw: none active?: false ] dtw-face: layout [ origin 0x0 space 0x0 dtw-top: box 640x24 dtw-b1: box 640x1 dtw-sid: box 0x0 dtw-mid: box 640x400 with [effect: none] ; (iho) app pane dtw-app: box 0x0 with [effect: none] dtw-b2: box 640x1 dtw-bot: box 640x48 ] dtw-sid/pane: [] dtm-logo: dtm-services: none dtm-face: layout [ size 640x24 origin 0x0 space 8x0 across dtm-logo: image 100x24 logo.gif [toggle-dtw] dtm-services: box 20x20 ] dtw-top/pane: dtm-face/pane dts-proto: none dts-face: layout [ origin 0x2 dts-proto: vtext "User" bold center middle [view-prefs] ] dti-stat: dti-info: none dti-face: layout [ origin 0x0 space 8x0 across dti-stat: box 100x48 dtw-skin/status-color dti-info: txt bold base-color / 2 middle 440x48 return ] dtw-bot/pane: dti-face/pane dtp-progress: dtp-status: dtp-what: none dtp-face: layout [ size 100x48 origin 0x0 space 0 pad 2 dtp-progress: progress 100x12 100.100.100 button-color dtp-status: vtext 100x14 center font-size 10 "Local" [connect-view] dtp-what: txt 100 center font-size 10 [help-view] ] dti-stat/pane: dtp-face/pane dtp-progress/show?: no dte-name: dte-server: dte-status: dte-comps: dte-msg: dte-license: none dte-header-txt: rejoin ["Welcome to REBOL/" system/product] dte-face: layout [ across h2 dte-header-txt dtw-skin/base-text-color return space 0x0 style txt text bold right 90 dtw-skin/base-text-color txt "User:" dte-name: text bold 300 dtw-skin/over-text-color return txt "Status:" dte-status: text bold 300 dtw-skin/over-text-color return txt "License:" dte-license: text bold 440x36 dtw-skin/over-text-color either (system/product = 'view) [[browse http://www.rebol.com/view-sales.html]] ['bold] return txt "Components:" dte-comps: text bold 300x300 coal return pad 0x4 dte-msg: box 500x300 return ] dtf-icons: dtf-back: dtf-path: dtf-slide: none dtf-face: layout/offset [ origin 0x0 space 0x8 across origin 0x10 dtf-back: box 24x24 effect [arrow 160.0.0 rotate 270] [back-folder] feel [ over: func [face act] [face/effect/2: pick [240.0.0 160.0.0] act show face] ] pad 0x1 dtf-path: box 800x22 [] [show-folder-options] return indent 12 dtf-icons: box [] [show-folder-options] with [effect: none] at dtf-icons/offset + 400x0 dtf-slide: slider 14x200 [scroll-icons value] ] 0x0 dtg-path: none dtg-face: layout/offset [ origin 0x1 dtg-path: h3 font-size 12 800x22 "Path" middle [back-folder] font [color: dtw-skin/base-text-color colors: reduce [dtw-skin/base-text-color dtw-skin/over-text-color]] ] 0x0 dtg-face/feel/over: none dtg-face/color: none dtf-path/pane: dtg-face dtc-icon: none dtc-face: layout/offset [ origin 0x0 dtc-icon: icon "none" ] 0x0 dtc-face/color: none dtc-icon/font: make dtc-icon/font [ color: dtw-skin/base-text-color shadow: none colors: [dtw-skin/base-text-color complement dtw-skin/base-text-color] ] dtf-icons/pane: dtc-face detect-dtw: does [ dtw-face/options: [resize] dtw-face/feel: make dtw-face/feel [ detect: func [face event /local code] [ switch event/type [ resize [ if dtw-open [ resize-dtw user-prefs/window-size: dtw-face/size ctx-prefs/save-prefs show dtw-face ] return true ] offset [ either dtw-open [ user-prefs/window-offset: dtw-face/offset ] [ user-prefs/icon-offset: dtw-face/offset ] ctx-prefs/save-prefs ] key [ if not code: all [user-prefs/keymap select user-prefs/keymap event/key] [ code: select dtw-keymap event/key ] if code [do code return true] ] scroll-line [page-icons event/offset/y * 16] scroll-page [page-icons event/offset/y * dtf-icons/size/y] close [ if any [user-prefs/always-close not dtw-open] [quit] toggle-dtw return true ] ] event ] ] ] make-bkg: func [full-size /local user-fx usr-img simple-face] [ simple-face: make face [ size: full-size font: feel: para: edge: none ] user-fx: copy [] if dtf-face/user-data [ if dtf-face/user-data/image [ usr-img: load-safe-image dtf-face/user-data/image ] append user-fx dtf-face/user-data/effect ] attempt [ to-image make simple-face [ color: dtw-skin/main-color image: dtw-skin/main-image effect: bind compose [ fit (dtw-skin/main-effect) ] 'full-size pane: make simple-face [ color: all [dtf-face/user-data dtf-face/user-data/color] image: usr-img effect: bind user-fx 'full-size ] ] ] ] reskin-dtw: func [skin] [ dtw-mid/color: skin/main-color ; (iho) app ;dtw-app/color: skin/main-color + 20.20.20 dtw-top/color: any [skin/top-bar-color skin/main-color] dtw-bot/color: any [skin/bottom-bar-color skin/main-color] dtw-top/effect: dtw-bot/effect: bar-effect dtw-b1/color: skin/main-color - 100.100.100 dtw-b2/color: skin/main-color + 60.60.60 dtw-sid/image: skin/side-image dtw-sid/color: skin/side-color dtw-sid/effect: skin/side-effect dtc-icon/font/colors: skin/base-text-color dtg-path/font/colors: reduce [skin/base-text-color complement skin/base-text-color] dti-info/font/color: skin/info-text-color ] resize-dtw: has [size] [ ;dbg/print 'resize-dtw ;dbg/probe app/size size: dtw-face/size dtw-sid/size/y: dtw-mid/size/y: max 0 size/y - dtw-top/size/y - dtw-bot/size/y - 2 dtw-bot/offset/y: 1 + dtw-b2/offset/y: dtw-mid/offset/y + dtw-mid/size/y ; (iho) dtw-app/size/y: dtw-mid/size/y dtw-app/offset/y: dtw-mid/offset/y if size/y > 74 [ foreach face dtw-face/pane [face/size/x: size/x] dti-info/size/x: size/x - dti-info/offset/x dtw-sid/size/x: 100 dtw-mid/offset/x: 100 ; (iho) dtw-app/size/x: size/x - 100 * app/size dtw-mid/size/x: size/x - 100 - dtw-app/size/x ; (iho) dtw-app/offset/x: 100 + dtw-mid/size/x dtf-face/size: dtw-mid/size dtc-face/size: dtf-icons/size: dtf-face/size - dtf-icons/offset dtc-face/size/x: dtf-icons/size/x: dtc-face/size/x - dtf-slide/size/x - 4 dtf-slide/offset/x: dtf-icons/offset/x + dtf-icons/size/x + 5 dtf-slide/size/y: dtf-icons/size/y last-folder: none if value? 'layout-icons [layout-icons dtc-face/pane] ] dtw-mid/image: make-bkg dtw-mid/size ;dtw-app/image: make-bkg dtw-app/size ] iconize-dtw: does [ unview/only dtw-face dtw-face/size: 100x74 dtw-face/offset: any [user-prefs/icon-offset 30x30] dtw-face/offset: min dtw-face/offset system/view/screen-face/size - dtw-face/size resize-dtw view/new/options/title dtw-face [] "Icon" detect-dtw ] windowize-dtw: does [ dtw-face/size: any [user-prefs/window-size 640x480] if not dtw-face/offset: user-prefs/window-offset [center-face dtw-face] if dtw-open [ unview/only dtw-face resize-dtw view/new/options/title dtw-face [resize] "Viewtop IHO" detect-dtw ] ] toggle-dtw: does [ browse http://www.rebol.com ] show-status: func [str] [ if alive? [ dtp-status/text: str show dtp-status ] ] show-main-status: func [str] [ dti-info/text: dte-status/text: str show [dti-info dte-status] ] tell: func [str] [ dti-info/text: str if system/view/focal-face = dti-info [unfocus] show dti-info ] teller: func [str arg] [ tell reform ["ERROR -" str any [arg ""]] ] show-welcome: does [ dte-name/text: user-prefs/name dtw-mid/pane: dte-face/pane show dtw-face ] show-id: func [str] [ dtp-what/text: either str [copy str] [rejoin [system/product " " system/version]] show dtp-what ] show-progress: func [length count /no-status] [ if count >= length [hide dtp-progress show-status "" return true] if not no-status [show-status "loading"] dtp-progress/data: count / max 1 length show dtp-progress true ] hide-progress: does [ hide dtp-progress ] show-icons: does [ dtw-mid/pane: dtf-face show dtw-mid ] show-path: func [str /local tmp] [ dtg-path/text: str dtg-path/size/x: 1024 dtg-path/size/x: either tmp: size-text dtg-path [tmp/x + 20] [1] show dtg-path ] scroll-icons: func [value /local slid-y] [ slid-y: negate to-integer (value * (dtf-slide-max - dtf-icons/size/y)) if slid-y <> dtc-face/offset/y [ dtc-face/offset/y: slid-y show dtf-icons ] ] page-icons: func [y] [ if find dtf-face/pane dtf-slide [ scroll-icons dtf-slide/data: min 1 max 0 (y / dtf-slide-max + dtf-slide/data) show dtf-slide ] ] pro-features: [ shell library crypt dhdsa rsa bignum sound fastcgi mysql oracle odbc ssl ] show-modules: has [product] [ dte-license/text: replace/all any [system/user-license/message copy ""] "*** " "" if system/user-license/id [dte-license/feel: make dte-license/feel [over: none]] dte-comps/text: reform ["Core" system/core] product: pick [" (View/Pro)" " (Command)"] (system/product = 'view) foreach [name comp ignore] system/components [ append dte-comps/text rejoin [ newline comp/title " " comp/version either find pro-features name [product] [""] ] ] ] this-path: none folder-stack: [] show-folder: func [folder /local path] [ if none? folder [alert "Folder has no path." exit] path: folder if any [url? path file? path] [ path: full-path path if (last path) = #"/" [path: path/index.r] ; (iho) added this-folder either folder: load-index path [this-folder: folder this-path: path] [ alert reform ["Cannot open folder:" path] exit ] if path <> pick folder-stack 1 [insert folder-stack path] ;?? folder ;?? path show-path any [folder/title path] ] clear dtc-face/pane dtg-path/font/color: any [folder/text-color black] dtg-path/font/colors: reduce [dtg-path/font/color any [folder/over-color complement dtg-path/font/color]] dtf-face/user-data: reduce ['color folder/color 'image folder/image 'effect any [folder/effect copy []]] dtf-face/color: none if all [dtf-face/user-data/effect not find dtf-face/user-data/effect 'fit] [append dtf-face/user-data/effect 'fit] if any [dtf-face/user-data/color dtf-face/user-data/image dtf-face/user-data/effect] [ dtw-mid/image: make-bkg dtf-face/size ] if folder/icons [ foreach icon folder/icons [append dtc-face/pane make-icon icon] ] layout-icons dtc-face/pane show-icons ; (iho) app ; dbg/print "got here" show-app ] back-folder: does [ remove folder-stack this-path: pick folder-stack 1 either this-path [show-folder this-path] [app/size: 0 resize-dtw show-welcome] ] show-bookmarks: func [folder /local path xy] [ clear dtw-sid/pane path: full-path folder if not folder: load-index path [ alert reform ["Cannot open bookmarks:" path] exit ] dtw-sid/color: folder/color if folder/image [dtw-sid/image: load-safe-image folder/image] if folder/effect [dtw-sid/effect: any [folder/effect copy []]] if not find dtw-sid/effect 'fit [append dtw-sid/effect 'fit] if folder/icons [ xy: 18x14 foreach icon folder/icons [ append dtw-sid/pane icon: make-icon icon if not word? icon/user-data/item [ icon/user-data/item: full-path icon/user-data/item ] icon/offset: xy xy: icon/size * 0x1 + (icon-space * 0x1) + xy ] ] show dtw-sid ] show-services: func [file /local path services f x] [ clear next dts-face/pane x: dts-face/pane/1/size/x path: full-path file ;dbg/?? path if all [services: load-index path services/icons] [ ;dbg/?? services foreach icon services/icons [ ;dbg/help icon if icon/type = 'service [ f: make-face dts-proto f/text: icon/name f/size: 200x20 f/line-list: none f/action: compose/deep [ ;dbg/print "been here" do-file (either word? icon/item [to-lit-word icon/item] [icon/item]) (if icon/stats [reduce [icon/stats]]) ] f/size/x: 4 + first size-text f x: x + 8 f/offset/x: x x: x + f/size/x append dts-face/pane f ] ] ] dtm-services/pane: dts-face/pane dtm-services/size: dts-face/size dtm-services/size/x: x show dtm-services ] ;;; (iho) show the app ; FIXME: redraw ??? show-app: func[][ if app/active? [ ;dbg/?? 'show-app either not none? in app 'redraw [ app/redraw app/pane ][ app/draw app/pane ] app/pane/pane/size: app/pane/size show app/pane/pane ] ] full-path: func [file] [ if not any [file? file url? file] [return none] if any [url? file #"/" = pick file 1] [return file] if none? this-path [return view-root/:file] join first split-path this-path file ] reload-folder: does [ ;dbg/?? this-path if this-path [ if read-binary this-path none [show-folder this-path] ] ] show-folder-options: does [ if confirm "Do you want to reload this folder?" [reload-folder] ] icon-space: 6 dtf-slide-max: 10 image-cache: [] make-icon: func [ico /local icon text-height] [ icon: make-face dtc-icon icon/user-data: ico icon/text: ico/name if (length? ico/name) > 32 [ icon/text: append copy/part ico/name 32 "..." ] icon/font/valign: 'bottom icon/para/wrap?: true icon/para/origin: 0x48 if ico/color [icon/font: make icon/font [color: ico/color]] icon/pane: make icon/pane [ if all [word? ico/image url? user-prefs/desktop-url] [ ico/image: rejoin [dirize user-prefs/desktop-url "icons/" ico/image ".gif"] ] image: load-safe-image ico/image if not image [ image: case [ ico/type = 'folder [folder-icon] ico/type = 'link [load-desktop-icon 'html] ico/type = 'email [load-desktop-icon 'email] ; folder icon ico/type = 'action [action-icon] email? ico/item [load-desktop-icon 'email] true [load-default-icon ico/item] ] ] if not image [image: default-icon] feel: none color: none effect: any [ico/effect [key 174.154.122 shadow smooth]] ] if icon/pane/image [ icon/pane/size: 64x48 icon/pane/offset: 0x0 if not outside? icon/pane/size icon/pane/image/size [ icon/pane/size: icon/pane/image/size icon/pane/offset: 64x48 - icon/pane/image/size / 2 if not ico/edge [ icon/pane/edge/effect: none icon/pane/edge/size: none ] ] ] text-height: second size-text make face [size: 70x250 text: icon/text font: icon/font] icon/size/y: 50 + text-height icon ] load-safe-image: func [ file "Local file or remote URL" /update "Force update from source site" /clear "Purge the entire cache" /local image ] [ if not any [file? file url? file] [return none] if clear [system/words/clear image-cache recycle] file: full-path file if any [update not image: select image-cache file] [ if all [update image] [remove/part find image-cache file 2] image: load-binary file not update repend image-cache [file image] ] all [image? image image] ] to-icon-path: func [name [word!]] [ join view-root/desktop/icons ["/" name ".gif"] ] load-desktop-icon: func [file-type /local data url] [ if file-type = 'rebol [return reblet-icon] data: load-safe-image to-icon-path file-type if not data [ url: dirize any [user-prefs/desktop-url http://www.rebol.com/view/icons/desktop] data: load-safe-image rejoin [url "icons/" file-type ".gif"] if data [write/binary to-icon-path file-type data] ] data ] load-default-icon: func [file /local n] [ if all [ any [file? file url? file] file: attempt [second split-path file] n: map-suffix file ] [ load-desktop-icon n ] ] ;;; (iho) added group layout ;;; TODO: I'd like to add text-lists ;(iho) group layout-icons: function [icons] [xy maxy group] [ ; (iho) sort/compare icons func [a b] [(reform [a/user-data/group to char! 255 a/text]) < (reform[ b/user-data/group to char! 255 b/text])] xy: dtc-icon/offset maxy: 0 foreach icon icons [ if icon/style = 'icon [ ; (iho) if any [ (first xy + icon/size) > dtc-face/size/x all [icon/user-data icon/user-data/group <> group] ][ ; (iho) group: icon/user-data/group xy: (xy + maxy + icon-space * 0x1) + (dtc-icon/offset * 1x0) maxy: 0 ] icon/offset: xy xy: icon/size * 1x0 + xy + (icon-space * 1x0) maxy: max maxy icon/size/y ] ] dtc-face/size/y: dtf-slide-max: xy/y + maxy dtf-slide/data: 0.0 dtc-face/offset/y: 0 remove find dtf-face/pane dtf-slide if dtf-slide-max > dtf-icons/size/y [ append dtf-face/pane dtf-slide dtf-slide/redrag dtf-icons/size/y / dtf-slide-max ] ] dtc-icon/feel: make dtc-icon/feel [ over: func [f a pos of /local str] [ either a [ f/font/color: dtw-skin/over-text-color if f/user-data/color [f/font/color: complement f/user-data/color] if f/user-data/over-color [f/font/color: f/user-data/over-color] show f f/font/color: any [f/user-data/color dtw-skin/base-text-color black] if f/user-data/info [tell f/user-data/info] ] [ show f tell "" ] ] engage: func [face action event /local icon] [ icon: face/user-data switch action [ down [face/state: on] alt-down [face/state: on] up [ if face/state [ if none? icon/type [icon/type: 'file] dbug ["Icon do" third icon] switch icon/type [ file [do-file icon/item any [icon/stats true]] link [if icon/item [browse full-path icon/item]] folder [show-folder icon/item] ; (iho) added actions action [icon do-action any [icon/item icon/name "unnamed"] icon/action any [icon/stats true]] ] ] face/state: off ] alt-up [ dbug ["Icon info" third icon] if all [face/state icon] [show-icon-info icon] face/state: off ] over [face/state: on] away [face/state: off] ] cue face action show face ] ] ii-object: ii-name: ii-type: ii-item: ii-info: ii-size: ii-date: ii-path: ii-image: none info-styles: stylize [ rt: text bold 80x22 middle right font-size 11 ff: info 250x22 font-size 11 para [] snow fl: ff tgl: toggle 75x22 font-size 11 middle rtr: rotary 75x22 font-size 11 middle ] ii-lay: center-face layout [ across origin 6 backeffect base-effect styles info-styles space 2x4 h2 "Icon Information:" return rt "Name:" ii-name: fl return rt "Type:" ii-type: ff 80 rt "Size:" 46 ii-size: ff 120 return rt "Date:" ii-date: ff return rt "Path:" ii-path: ff return rt "Info:" ii-info: fl 250x80 wrap return space 8x4 rt pad -6x6 across btn-enter 75 "Edit" #"e" [ hide-icon-info either any [file? ii-path/text url? ii-path/text] [ read-binary ii-path/text any [ii-object/stats true] editor path-thru ii-path/text ] [ alert reform ["Cannot edit:" ii-path/text] ] ] btn 75 "Reload" #"r" [hide-icon-info read-binary ii-path/text none] btn-cancel 75 "Cancel" escape [hide-icon-info] ] view-req: func [lay] [view/new/title lay "Request"] show-icon-info: func [v /local file size] [ ;dbg/help v hide-icon-info unfocus ii-object: v ii-name/text: v/name ii-size/text: ii-date/text: "Not loaded" either 'action = v/type [ ii-path/text: this-path ][ ii-path/text: v/item ] if word? v/item [ii-date/text: "internal"] if all [any [url? v/item file? v/item] find [file folder] v/type] [ file: path-thru ii-path/text: full-path v/item if all [file? file exists? file] [ size: size? file tsize: form either size > 10240 [size / 1024] [size] if find tsize "." [clear next next find tsize "."] ii-size/text: join tsize pick [" KB" " bytes"] size > 10240 ii-date/text: modified? file ] ] ii-type/text: v/type ii-info/text: v/info ii-name/para/scroll: 0x0 ii-size/para/scroll: 0x0 view-req ii-lay ] hide-icon-info: does [unview/only ii-lay] init-desktop-files: has [paths path files] [ this-path: none history-file: view-root/desktop/history.r paths: [ %desktop/ %local/ %desktop/icons/ %desktop/skins/ %desktop/sounds/ %desktop/tools/ ] foreach path paths [if not exists? view-root/:path [attempt [make-dir/deep view-root/:path]]] if not exists? path: view-root/desktop/filetypes.r [ write path join {REBOL [Title: "File Types"] } mold/only suffix-map ] files: [ %desktop/bookmarks.r { ^-^-^-REBOL [Title: "Bookmarks" Type: 'index] ^-^-^-folder "REBOL" http://www.rebol.com/index.r ^-^-^-info "REBOL.com primary REBOL/View reb-site" ^-^-^-folder "Public" http://www.rebol.com/view/public.r ^-^-^-info "Public sites, links, and programs" ^-^-^-folder "Local" %local/index.r ^-^-^-info "Local links and files" ^-^-^-file "Console" console icon console ^-^-^-info "Open the REBOL console" ^-^-} %desktop/services.r { ^-^-^-REBOL [Title: "Services" Type: 'index] ^-^-^-service "Goto" goto ^-^-^-service "Help" help ^-^-^-service "Quit" quit ^-^-} %local/index.r { ^-^-^-REBOL [Title: "Local Index" Type: 'index] ^-^-^-title "Local Files" ^-^-^-file "Info" %info.txt ^-^-} %local/info.txt { ^-^-^-Local scripts can be placed in this folder. To do so, edit ^-^-^-your local/index.r file to include the filenames for the ^-^-^-files that you want to include. You can right click on the ^-^-^-local folder icon to edit or reload it. ^-^-} ] foreach [file text] files [ if not exists? path: view-root/:file [write path trim/auto text] ] if not exists? history-file [ save history-file [ http://www.rebol.com/index.r http://www.rebol.com/index.html ] ] ] index-cache: [] reb-folder: context [ title: summary: updated: expires: notice: image: color: effect: text-color: over-color: icons: none ; (iho) plugin-pane ;plugin-pane: none ;plugin-size: none ;plugin-draw: none ;plugin-resize: none ] reb-icon: context [ type: item: name: color: over-color: stats: info: image: edge: effect: folder: group: ; (iho) Icon groups in folders action: ; (iho) actions in an index file none ] ;;;(iho) added dynamic index load-index: func [path /local page here] [ dbug ["Loading index" path] page: read-binary path here: found? find index-cache path if none? page [return none] if not here [append index-cache path] if error? try [page: load/all to-string page] [return none] ; (iho) if all [file? path 'true = select page/2 to set-word! 'dynamic][ if not attempt [page: compose page][return none] ] ; (iho) marker for local files parse-index page file? path ] index-file?: func [blk] [ all [ blk/1 = 'rebol block? blk/2 'index = select blk/2 to-set-word 'type ] ] ;;; (iho) added dynamic index ; (iho) marker for local files ; FIXME: handle the app more intelligently ... parse-index: func [spec local? /local val f i fspec fbody app-old] [ ; (iho) reset the app-pane to nothing ;dbg/print 'parse-index ;dbg/probe spec app-old: app/size app/size: 0 app/active?: false if not index-file? spec [return none] f: make reb-folder [icons: copy []] ;dbg/?? spec parse spec [ 2 skip any [ 'title set val string! (f/title: val) | 'summary set val string! (f/summary: val) | 'updated set val date! (f/updated: val) | 'expires set val date! (f/expires: val) | 'notice set val string! (f/notice: val) | 'text-color set val tuple! (f/text-color: val) [set val tuple! (f/over-color: val) | none] | 'backdrop [ some [ set val 'tile (f/effect: [tile]) | set val [file! | url!] (f/image: val) | set val path! (if 'view-root = first :val [f/image: val]) | set val tuple! (f/color: val) | set val block! (f/effect: val) ] ] ; (iho) app | 'app set val number! (app/size: val resize-dtw) ] ;(dbg/print 'header-done) any [ ;hhere: (dbg/print ":::::: " dbg/print copy/part hhere 2) (i: make reb-icon [color: f/text-color over-color: f/over-color]) ; (iho) group added / action added set val ['file | 'folder | 'link | 'service | 'group | 'action] (i/type: val) some [ ;hhere: (dbg/print "...... " dbg/print mold copy/part hhere 2) ; (iho) app as service .... its broken! ; FIXME: dynamically add service names ... set val [file! | url! | email! | 'goto | 'help | 'console | 'quit ] (i/item: val) ; (iho) 2 full lines | set val issue! (i/item: to word! form val) ;| 'do set val block! (if all[ 'service = i/type local?] [i/item: head insert val i/item] ) | 'do set val block! (if all[ 'action = i/type local?] [i/action: val] ) ; (iho) parse group\name | set val string! (val: parse/all val "\" either i/name: val/2 [i/group: val/1][i/name: val/1 i/group: ""]) | set val tuple! (i/color: val) | set val date! (i/stats: reduce [val]) | set val into [any [integer! | date!]] (i/stats: val) | set val path! (if 'view-root = first :val [i/item: val]) | 'info set val string! (i/info: val) | 'edge (i/edge: true) | 'icon set val [file! | url! | word! | path!] ( if all [path? :val 'view-root = first :val] [val: val] i/image: val ) | 'effect set val block! (i/effect: val) ; (iho) app --- yes, it's a mess | 'app-redraw set fspec block! set fbody block! ( app/redraw: func fspec fbody ) | 'app-draw set fspec block! set fbody block! ( app/draw: func fspec fbody app/pane: dtw-app app/active?: 0 <> app/size app/draw dtw-app ) | 'app-file set val [file! url!] ; for security reasons, I don't allow urls here ... maybe add trusted urls? ( if file? val [ app/draw: do/args file [viewtop: true size/size] app/pane: dtw-app app/active?: 0 <> app/size app/draw dtw-app ] ) ; (iho) dynamic services ... ;| set val word! (i/item: val) ] ( ;dbg/help i if none? i/name [i/name: to-string i/item] ;append f/icons i ; (iho) either ;dbg/?? this-path either 'group = i/type [ append groups reduce [i/name i] ][ if all [i/group <> "" val: select groups i/group][ all [ none? i/effect i/effect: val/effect ] ;append copy any[val/effect []] any[ i/effect []]] all [ none? i/image i/image: val/image] all [ none? i/edge i/edge: val/edge] ] append f/icons i ] ) | none skip ] | end ] ; (iho) I need it to get the app-pane redrawn ... FIXME: if app-old <> app/size [resize-dtw] f ] ;;; (iho) added actions do-action: func [name action stats][ ;dbg/?? action either error? set/any 'retval try action [ alert reform ["Sorry, unable to run: " name "^/error: " mold disarm retval] ][ if not value? 'retval [retval: none] display-action name retval ] exit ] do-file: func [path stats /local orig] [ ;dbg/?? path if none? path [exit] orig: path ; (iho) if block? - action if block? path [ either error? set/any 'retval try next path [ alert reform ["Sorry, unable to run: " path "^/error: " mold disarm retval] ][ if not value? 'retval [retval: none] display-action path retval ] exit ] ; (iho) if word? nearly completely changed if word? path [ either error? set/any 'retval try [ switch path services][ alert reform ["Sorry, unable to run: " path "^/error: " mold disarm retval] ][ display-action path retval ] exit ] if email? path [emailer/to path exit] if not any [url? path (first path) = #"/"] [path: full-path path] either not read-binary path stats [ alert reform ["Missing file:" path] ] [ switch/default map-suffix to-file path [ rebol [start path] text [editor path-thru path] image [show-image path] ] [ either url? orig [browse orig] [browse path-thru path] ] ] ] ;;; (iho) added action start: function [path] [p file loaded retval] [ tell reform ["Launching" path] if url? path [ either any [error? try [launch/secure-cmd path-thru path]] [ alert reform ["Cannot launch application:" path] ] exit ] if file? path [ if not exists? path [alert reform ["File does not exist:" path] exit] ; (iho) loaded: load/header path if all[ find first loaded/1 'x-desktop-launch 'app = loaded/1/x-desktop-launch] [ either error? set/any 'retval try [do path][ alert reform ["Got error from script:" path] ][ display-action path retval ] exit ] if error? try [launch/secure-cmd path] [ alert reform ["Cannot launch application:" path] ] ] ] ;;; (iho) new function display-action: func [ "display action return value" name value /local face lay ][ if any [block? value string? value][ lay: [ origin 5x5 space 8x8 across dtf-back: box 24x24 effect [arrow 160.0.0 rotate 270] [reload-folder] feel [ over: func [face act] [face/effect/2: pick [240.0.0 160.0.0] act show face] ] text bold (form name) [reload-folder] return ] either block? value [ face: layout/offset compose head insert tail copy lay value 0x0 ][ value: form value face: layout/offset compose head insert tail copy lay [text as-is (value)] 0x0 ] face effect: ['fit] face/size: dtw-mid/pane/size dtw-mid/pane: face show dtw-mid ] ] show-image: func [path /local face] [ path: load-binary path true if image? path [ view/new center-face make-face/spec 'image [ image: path size: min image/size system/view/screen-face/size ] ] ] read-binary: func [url info] [ dbug ["Read-binary" url info] return either any [not alive? all [info exists-thru?/check url info]] [ if all [url? url not alive? not exists-thru? url] [return none] show-progress 1 0 info: read-thru/progress/expand url :show-progress show-progress 1 1 info ] [ show-progress 1 0 info: read-thru/progress/expand/check/update url :show-progress info show-progress 1 1 info ] ] load-binary: func [url fresh] [ if url: read-binary url fresh [ if error? try [url: load url] [return none] return url ] ] do-local: has [files] [ files: request-file/keep if none? files [exit] foreach file files [do-file file none] ] halt-view: does [ unview/all about halt ] map-suffix: func [file] [ all [ file? file n: find/last file "." n: find suffix-map n n: find n word! pick n 1 ] ] goto-url: func [url [url!] /local page script] [ url: copy url if script: find/match url "file:" [ if find/match script "//" [remove script] script: to-file script if attempt [script? read script] [launch script] [browse script] exit ] if not page: attempt [read-binary url none] [ if %.r <> suffix? url [url: append dirize url "index.r"] page: read-binary url none ] either page [ page: to-string page either script? page [ either not error? try [script: load/all page] [ either index-file? script [show-folder url] [launch-thru url] ] [ alert reform ["Invalid REBOL URL:" url] ] ] [ browse url ] ] [ alert reform ["Cannot find:" url] ] ] goto-view: has [gt-url gt-list gtface h enter-url urls result] [ if error? try [urls: load history-file] [urls: []] gt-face: center-face layout [ origin 8 backeffect base-effect space 6x4 h4 bold "Goto a URL (REBOL, Web, or local file):" across gt-url: field 300 [enter-url value] btn-enter 80 "Goto" [if result: enter-url gt-url/text [unview goto-url result]] return gt-list: text-list 300x200 data urls [enter-url value] h: at below at h guide pad 98 btn 80 "Find..." [if value: request-file/only/keep [enter-url join file:/ value]] btn 80 "Sort" [sort gt-list/data show gt-list] btn 80 "Clear All" [attempt [delete history-file] unview] btn-cancel 80 "Close" escape [unview] ] enter-url: func [url /local val] [ url: copy url if not url? url [ if error? try [val: load/all url val: val/1] [val: none] if not url? :val [ insert url http:// if error? try [val: load/all url val: val/1] [val: none] ] if not url? :val [alert "Invalid URL." return none] url: val ] insert clear gt-url/text url remove find gt-list/data url insert gt-list/data url clear gt-list/picked show [gt-url gt-list] save history-file gt-list/data url ] focus gt-url view/new/title gt-face "Goto a URL" ] help-view: does [ view/new/title center-face layout [ style text text 300 bold style btn btn 80 style arw box 20x20 effect [arrow 120.0.0 rotate 90] backdrop dtw-skin/main-color effect [grid 150.170.150] across space 0x0 image logo.gif box 320x24 effect [merge gradmul 0.0.0 128.128.128] space 3x10 return pad 23x14 text as-is either system/user-license/id [ reform [ pick ["REBOL/View/Pro" "REBOL/Command/View"] (system/product = 'view) system/version "^/Licensed to:" system/user-license/name ] ] [ reform [pick ["REBOL/View" "REBOL/Command/View"] (system/product = 'view) system/version] ] pad 0x3 btn-cancel 80 "Close" [unview] return box 300x2 maroon return arw text { ^-^-^-To check for updates... ^-^-} btn "Updates" [launch-thru/update http://www.rebol.com/view/updates.r] return arw text { ^-^-^-For documentation about REBOL... ^-^-} btn "Documents" [browse http://www.rebol.com/docs.html] return arw text { ^-^-^-Using the Viewtop and creating Reb-sites.... ^-^-} btn "Viewtop" [browse http://www.rebol.com/docs/desktop.html] return arw text { ^-^-^-Help support REBOL, visit our store... ^-^-} btn "Store" [launch-thru/update http://www.rebol.com/view/store.r] return arw text { ^-^-^-To report a problem or request an enhancement... ^-^-} btn "RAMBO" [launch-thru/update http://www.rebol.com/view/rambo.r] return arw text { ^-^-^-To contact REBOL Technologies... ^-^-} btn "Feedback" [launch-thru/update http://www.rebol.com/view/feedback.r] return pad 23 text font-size 9 {Copyright 2001-2005 REBOL Technologies. All rights reserved. ^-^-^-REBOL is a trademark of REBOL Technologies.} ] "View Help Information" ] ctx-prefs-gui: [ prefs-to-face: does [ if function? get in system/schemes/default/proxy 'user [ system/schemes/default/proxy/user: system/schemes/default/proxy/pass: none ] foreach [field value] [ field-name [safe-copy user-prefs/name] check-connect user-prefs/auto-connect check-desk user-prefs/desktop field-email [either email? system/user/email [form system/user/email] [copy ""]] field-smtp [safe-copy system/schemes/default/host] field-pop [safe-copy system/schemes/pop/host] choice-ptype [ select reduce [none "None" 'none "None" 'generic "Generic" 'socks4 "Socks 4" 'socks "Socks 5"] system/schemes/default/proxy/type ] field-phost [safe-copy system/schemes/default/proxy/host] field-pport [either integer? system/schemes/default/proxy/port-id [form system/schemes/default/proxy/port-id] [copy ""]] field-puser [safe-copy system/schemes/default/proxy/user] field-ppass [safe-copy system/schemes/default/proxy/pass] ] [ set-face get field do value ] ] safe-copy: func [value] [copy either string? value [value] [""]] safe-to-block: func [value] [any [attempt [to block! value] []]] type-check: func [field rule /local value] [ parse safe-to-block get-face field bind rule 'value :value ] face-to-prefs: has [user pass] [ system/user/name: user-prefs/name: safe-copy get-face field-name user-prefs/auto-connect: to logic! get-face check-connect user-prefs/desktop: to logic! get-face check-desk system/user/email: type-check field-email [set value email!] system/schemes/default/host: safe-copy get-face field-smtp system/schemes/pop/host: safe-copy get-face field-pop system/schemes/default/proxy/type: select reduce [ "None" none "Generic" 'generic "Socks 4" 'socks4 "Socks 5" 'socks ] get-face choice-ptype either system/schemes/default/proxy/type [ system/schemes/default/proxy/host: safe-copy get-face field-phost system/schemes/default/proxy/port-id: type-check field-pport [set value integer!] user: safe-copy get-face field-puser pass: safe-copy get-face field-ppass if all [not empty? user not empty? pass] [ system/schemes/default/proxy/user: user system/schemes/default/proxy/pass: pass ] ] [ system/schemes/default/proxy/host: system/schemes/default/proxy/port-id: system/schemes/default/proxy/user: system/schemes/default/proxy/pass: none ] ] field-name: check-connect: check-desk: field-email: field-smtp: field-pop: choice-ptype: field-phost: field-pport: field-puser: field-ppass: none slide-face: tmp: none width: 540 user-settings: 0 email-settings: negate width proxy-settings: negate width * 2 slide-to: func [offset] [ if offset = slide-face/offset/x [exit] slide-face/user-data: context [ dest: offset midpoint: offset + slide-face/offset/x / 2 speed: sign? offset - slide-face/offset/x accel: (abs offset - slide-face/offset/x) / 50 * speed op: either dest < slide-face/offset/x [:lesser-or-equal?] [:greater-or-equal?] ] slide-face/rate: 25 show slide-face ] slide-engage: func [face action event] [ if action = 'time [ face/offset/x: face/offset/x + face/user-data/speed if face/user-data/op face/offset/x face/user-data/dest [ face/rate: none face/offset/x: face/user-data/dest show face exit ] if face/user-data/op face/offset/x face/user-data/midpoint [ face/user-data/accel: negate face/user-data/accel ] face/user-data/speed: face/user-data/speed + face/user-data/accel show face ] ] prefs-face: layout [ style tog tog of 'slide 100 snow 255.255.200 backeffect base-effect origin 10 across h2 "REBOL Preferences" pad 30 tmp: tog "User settings" [slide-to user-settings] do [tmp/data: tmp/state: on] tog "Email settings" [slide-to email-settings] tog "Proxy settings" [slide-to proxy-settings] below slide-face: panel 540x220 [ size 1620x220 style rtxt text 100x24 bold middle right style cmt text 230x24 italic middle style field field 190 edge [color: dtw-skin/main-color] style drop-down drop-down 190 edge [color: dtw-skin/main-color] style h2 h2 200x32 space 4 backdrop dtw-skin/main-color effect dtw-skin/main-effect across at 20x15 guide h2 "User settings:" return rtxt "User name:" field-name: field cmt "Enter your name here" return pad 6x12 rtxt check-desk: check-line on bold "Open desktop on startup" return pad 6x-4 rtxt check-connect: check-line on bold "Auto-connect on startup" return at 560x15 guide h2 "Email settings:" return rtxt "Email address:" field-email: field cmt "In order to send email" return rtxt "SMTP server:" field-smtp: field cmt "Your email server: mail.example.com" return rtxt "POP server:" field-pop: field cmt "Often the same as above" return rtxt cmt "All fields are optional." at 1100x15 guide h2 "Proxy settings:" return rtxt "Proxy type:" choice-ptype: drop-down "None" "Generic" "Socks 4" "Socks 5" return pad 0x10 rtxt "Proxy server:" field-phost: field cmt "Example: proxy.example.com" return rtxt "Proxy port:" field-pport: field cmt "Port number. Example: 1080" return pad 0x10 rtxt "Username:" field-puser: field cmt "Optional proxy username" return rtxt "Password:" field-ppass: field hide cmt "Optional proxy password" return ] edge [size: 0x1 color: base-color effect: 'ibevel] feel [engage: :slide-engage] do [slide-face/offset/x: 0] do [slide-face/size/x: width * 3] across pad 10 text 100 navy underline "Help" [browse http://www.rebol.com/docs/desktop.html] pad 220 btn-enter 72 "Save" [do-save] btn-cancel 72 "Cancel" [hide-popup] ] prefs-face/size/x: width do-save: does [ face-to-prefs if error? try [ctx-prefs/save-prefs] [alert "Unable to save settings in your prefs.r file."] ctx-prefs/save-user hide-popup ] view-prefs: does [ prefs-to-face inform prefs-face ] ] view-prefs: does [ if block? ctx-prefs-gui [ctx-prefs-gui: context ctx-prefs-gui] ctx-prefs-gui/view-prefs ] set 'set-user :view-prefs connecting: none connect-view: has [info] [ if connecting [connecting: false exit] connecting: true show-status "connecting" show-progress/no-status 100 1 dbug ["Connected?" connected?] either all [ connected? any [find [socks socks5 generic] system/schemes/default/proxy/type find-site "www.rebol.com"] info: read-thru/progress/update/expand http://www.rebol.com/view/update.r :show-progress ] [ dbug "Online" show-progress 1 1 alive?: true clear index-cache if error? try [do as-string info] [ alert {Error on connection. Please report this on www.REBOL.com. Thank you.} ] show-main-status reform ["Connected to the Internet at" now/time] show-status "" ] [ dbug "Offline" show-progress 1 1 show-main-status "Cannot connect. Working offline." tell {Click on "Local" to connect.} show-status "Local" alive?: false ] ] find-site: func [host [string!] /local ip dport n secs] [ if error? try [dport: open/no-wait dns:///async] [ return read to-url rejoin ["dns://" host] ] insert dport host n: 0 secs: any [user-prefs/connect-wait 60] while [error? try [ip: copy dport]] [ wait [dport 1] n: n + 1 show-progress/no-status secs n if any [not connecting n >= secs] [ip: none break] ] connecting: false close dport ip ] ;;; (iho) added automatic startup folder init-desktop: has [product] [ dbug ["Desktop boot" now] windowize-dtw dtf-face/user-data: none resize-dtw reskin-dtw dtw-skin view/new/options/title dtw-face [resize] "Viewtop IHO" detect-dtw show-id none show-modules ;show-welcome ;resize-dtw ;trace on ; (iho) if ; FIXME: I need show-modules/-welcome for painting the desktop show dtw-face init-desktop-files load-file-types if not exists? ctx-prefs/prefs-file [ alert {Preferences are not set. Please click the User button and set them.} ] show-main-status either user-prefs/auto-connect [ "Connecting to the Internet..." ] [ {Working offline. Click "Local" to connect.} ] show-services view-root/desktop/services.r if user-prefs/auto-connect [connect-view] show-bookmarks view-root/desktop/bookmarks.r if all [ value? 'desktop-startup-folder file? desktop-startup-folder][ show-folder either #"/" = desktop-startup-folder/1 [desktop-startup-folder] [view-root/:desktop-startup-folder] ] true ] load-file-types: has [data] [ if error? try [data: load view-root/desktop/filetypes.r] [exit] suffix-map: data ] ]