Rebol [
    Title: "Setup Anton"
    File: %setup-anton.r
    Date: 10-May-2009
    Version: 1.1.4
    Status: "Should be working or nearly working. Tested on View 2.7.6.4.2 and Wine+R3-2.100.37.3.1"
    Needs: []
    Author: "Anton Rolls"
    Language: 'English
    Purpose: {Set up user.r the way I like it. (For my personal use.)
        Appends a call to anton-user.r to user.r, and adds a bookmark to the view desktop.
    }
    History: [
        1.0.0 [16-Sep-2001 {First version} "Anton"]
        1.0.1 [8-Nov-2001 {moved site} "Anton"]
        1.0.2 [3-Jan-2002 {added "Remote" folder to bookmarks.r, added a new gui} "Anton"]
        1.0.3 [4-Jan-2002 {} "Anton"]
        1.0.4 [8-Apr-2002 {reworked, cleaned up} "Anton"]
        1.0.5 [9-Apr-2002 {added site, added intention message to gui} "Anton"]
        1.0.6 [4-Sep-2002 {made call to anton-user.r optional, added note to manually wrap
            user.r in error-trapping code} "Anton"]
        1.0.7 [8-May-2003 {added my-launch} "Anton"]
        1.0.8 [19-Sep-2003 {new site determination code (also in add-call-to-anton-user.r)} "Anton"]
        1.0.9 [20-Sep-2003 {added some more icons to add-bookmarks} "Anton"]
        1.1.0 [9-Jan-2004 {wrapped err into use context} "Anton"]
        1.1.1 [29-Jan-2006 {updated an information message to be more accurate ("anton-user.r" already found)
            replaced this line:
                use [args][if args: system/options/args [do first args]] ; the old way
            with this:
                use [args mark][
                    if all [
                        args: system/options/args
                        parse first args ["do-anton-user?:" "true" any " " mark: to end]
                    ][
                        remove/part first args mark
                        do-anton-user?: true
                    ]
                ]

            SITE variable also silently falls back to a default.
        } "Anton"]
        1.1.2 [15-Aug-2006 {updated site from lexicon -> anton.wildit.net.au} "Anton"]
        1.1.3 [24-Mar-2009 {Does R2 GUI code when R2+View, otherwise does command processor in the console.
            Several bits of conditional code added to workaround R2/R3 differences and R3 bugs.} "Anton"]
        1.1.4 [10-May-2009 {Fixed bug introduced by system/user object missing since Rebol3-a46} "Anton"]
    ]
    ToDo: {
    - Incorporate better the note to add error-trapping in add-call-to-anton-user.r
    - Support SET-NET and SET-USER-NAME equivalents.
      - They don't exist in Rebol3
      - In older Rebols (eg. Rebol2, these two commands are added to the end of this file automatically by Desktop
        user preferences app (if I remember correctly).
      - Do the R3 equivalent operation conditionally.
        - DONE: SET-USER-NAME
        - SET-NET <------
    - Undo.
    - Could be better to use and propose this system:
        system/options/args: ["user.r-options [do-anton-user]"]
      so that scripts can safely ignore the stuff only meant to be processed in user.r
    - R3 bugs awaiting fixes:
      - Command line option -- (and --DO) isn't working in R3. This prevents DO-ANTON-USER? being set in R3,
        and thus anton-user.r is not done by user.r. <----------
      - SELECT ignores the length of its VALUE argument when choosing the next value. (Reported to CureCode.)
    }
    Notes: {
        Keep changes to user.r concurrent with add-call-to-anton-user.r

        I have noticed that system/options/args is available "earlier"
        than system/script/args.
        You can access system/options/args in user.r, but not system/script/args
        until after user.r has been run.

        Following are the notes that I added to user.r - they should be
        automatically added as well.

        ------------------------------------
        Of course, all the customizations here are lost when installing
        a fresh new rebol. So try to get them all into anton-user.r

        Changing the section delimited with ";---- ----"
        should be made in the source - setup-anton.r

        native command-line usage to enable the running of anton-user.r,
        with all my customizations in it:

            rebol.exe -- "do-anton-user?: true"
        -----------------------------------
    }
]

if not value? 'load-thru [load-thru: :load] ; <-- Just alias LOAD-THRU to LOAD for R3.

;site: select load-thru http://www.rebol.net/reb/index.r [folder "Anton"] ; <- SELECT is broken in R3 2.100.37
site: third find load-thru http://www.rebol.net/reb/index.r [folder "Anton"] ; <- Compatible R2/R3. THIRD FIND works around bug in SELECT.
clear find site %index.r

r2?: does [system/version < 2.100.31]
r3?: does [not r2?]

text-section: {
;---- Start section auto-added by setup-anton.r ----
use [err] [
    if error? set/any 'err try [
    
        ;   Rebol3 compatibility.
        
        ; SET-NET and SET-USER-NAME don't exist in Rebol3 (in 2.100.33 at least)
        ; But a SET-NET and a SET-USER-NAME line may be appended to this script by Viewtop preferences.
        ; So set those missing functions when R3 is detected.
        if system/version >= 2.100.31 [ ; Test for Rebol 3.
            set-net: none ; <-- Do nothing for now. (Could at least set system/user/email ...)
            set-user-name: func [str [string!]][system/user/name: str] ; <- Source copied from R2.
        ]
        if system/version >= 2.100.46 [ ; Test for Rebol 3 alpha where system/user went missing ("the great system reorg of alpha 46" -- BrianH).
            if none? in system 'user [
                set-user-name: func [str][] ; <-- Do nothing for now.
                ; I *could* do this, but it could lead to more confusion.
                ;append system 'user
                ;system/user: context [user: "Anton Rolls" ... etc.]
            ]
        ]
        ;set-user-name "Anton Rolls"  ; <- This may also be automatically appended to the end of this script by Viewtop.
        ;system/user/name: "Anton Rolls" ; <- Compatible with R2/R3.
        
        ;   Linux compatibility.
        
        if system/options/home = %/home/anton/ [system/options/home: %/home/anton/dev/rebol/view/] ; as on linux
        
        ;   DO-ANTON-USER?
        
        use [args mark][
            if all [
                args: system/options/args
                parse first args ["do-anton-user?:" "true" any " " mark: to end]
            ][
                remove/part first args mark ; Unfortunately I can't also remove the part from system/script/args,
                ; so it's up to the script to be able to skip over it.
                do-anton-user?: true
            ]
        ]
        if value? 'do-anton-user? [
            use [site contents url] [
                ;site: select load-thru http://www.rebol.net/reb/index.r [folder "Anton"]
                site: http://anton.wildit.net.au/rebol/ ; default
                if contents: load-thru http://www.rebol.net/reb/index.r [ ; <-- LOAD-THRU has no value in Rebol3 (in 2.100.33 at least)
                    site: select contents [folder "Anton"]
                ] 
                clear find site %index.r
                either contents: load-thru url: site/anton-user.r [ ; <--
                    do contents
                ] [
                    print ["Couldn't load-thru" url]
                ]
            ]

            ;   Trace Rebol's boot.
            ;trace on
            ;echo %boot-trace.txt
            ; Remember afterwards to  TRACE OFF ECHO NONE  when console prompt appears.

            ;   Launch limit workaround. (Added during early R2 versions.)
            my-launch: :launch ; Romano's idea
            
            ;   R2 VIEW tweaks.
            
            if object? system/view [
                if system/version < 2.100.31 [ ; Test for Rebol 2.
                    ; SCREEN-FACE doesn't exist in Rebol3 (in 2.100.33 at least. It has SCREEN-GOB instead.)
                    system/view/screen-face/options: none 
                ]
            ]
        ]
    ] [print "Error in %user.r:" probe disarm err]
] 
;---- End section auto-added by setup-anton.r ----
}

do-full-setup: func [{Full setup. (Does all the following commands below.)}][
    add-call-to-anton-user.r
    add-bookmarks
]

add-call-to-anton-user.r: func [{Modify user.r so it does anton-user.r.}
    /local file report
][
    {; Old R2-only code.
    view/new center-face layout append either find read file "anton-user.r" [
        [h1 {"anton-user.r" already found in" file " No alteration to user.r made.}]
    ][
        either error? try [write/append file text-section][
            [h1 "There was a problem appending to the user.r file."]
        ][
            [h1 "Appended to user.r successfully."]
        ]
    ][across button "View user.r" [editor file] button "OK" [unview]]}
    
    ;file: view-root/user.r ; <- VIEW-ROOT has no value in R3.
    file: system/options/home/user.r ; Compatible with R2/R3.

    report: func [value][ ; Helper function.
        either all [r2? view?][ ; Only open a window to display message when R2 + View is detected. (Not on R3.)
            ; Open a window to display the message.
            view/new center-face layout append append [h3] reform value [
                across button "View user.r" [editor file] button "OK" [unview]
            ]
        ][
            ; Send the message to the console.
            print reform :value
        ]
    ]

    ; Previously altered?
    either find to-string read file "anton-user.r" [ ; <- TO-STRING necessary in R3 (not necessary in R2).
        report [{"anton-user.r" already found in"} file {" No alteration to user.r made.}]
    ][
        ; Attempt to modify user.r
        either error? try [write/append file text-section][
            report "There was a problem appending to the user.r file."
        ][
            report "Appended to user.r successfully."
        ]
    ]
]

add-bookmarks: func [{Add bookmarks to the VIEWTOP desktop.}
    /local bookmarks contents
][
    ;bookmarks: view-root/desktop/bookmarks.r ; <- VIEW-ROOT has no value in R3.
    bookmarks: system/options/home/desktop/bookmarks.r ; Compatible with R2/R3.
    contents: to-string read bookmarks ; <- TO-STRING necessary in R3 (not necessary in R2).

    print "Examining bookmarks.r file..."

    foreach [icon url] reduce [
        {folder "Local" } %local/index.r ; <- Created when the Viewtop desktop is opened.
        {folder "Remote" } site/index.r
        {file "Search" } http://proton.cl-ki.uni-osnabrueck.de/REBOL/rebsearch.r
        {file "Find Objects" } site/util/find-objects.r
        {file "Translate" } site/web/babel-translator.r
        {file "Remind" } site/util/remind-client.r
    ][
        print ["Looking for" icon]
        either find contents icon [
            print [icon "already exists - no action."]
        ][
            print [icon "not found - attempting to add it."]

            print either error? try [
                write/append bookmarks (join newline [icon url])
            ]["There was an error appending to bookmarks file."]["Appended to bookmarks OK."]
        ]
    ]
]

halt-setup: func [{Halt.}][unview/all halt]
quit-setup: func [{Quit. (Closes console).}][quit]


commands: [do-full-setup add-call-to-anton-user.r add-bookmarks halt-setup quit-setup]

either all [r2? view?][

    ;   Open a window to display the setup options.

    spec: [
        style button button 160x45 effect [merge luma -15] font [color: black colors: [black] style: [bold] shadow: none]
        h1 "setup-anton.r" across
    ]
    ;foreach cmd commands [
    ;   append spec compose/deep [
    ;       button (first third get :cmd) [(cmd)] return
    ;   ]
    ;]
    append spec [
        add-call-chk: check on text "Modify user.r so it does anton-user.r" return
        add-bookmarks-chk: check on text "Add bookmarks to the VIEWTOP desktop." return
        button "Apply changes." [
            if add-call-chk/data [add-call-to-anton-user.r]
            if add-bookmarks-chk/data [add-bookmarks]
        ] pad 40
        button "Halt." [halt-setup] button "Quit. (Closes console.)" [quit-setup]
    ]
    view center-face window: layout spec

][
    ;   Console command processor.
    
    print-commands: has [n-cmd] [
        n-cmd: 0
        foreach cmd commands [
            n-cmd: n-cmd + 1
            print rejoin [" " n-cmd "  " (first third get :cmd)] ; number of command, function doc string.
        ]
        print ""
    ]
    command-loop: has [cmd][
        print-commands
        forever [
            cmd: ask "setup> "
            either all [
                cmd: attempt [to-integer cmd]
                cmd >= 1
                cmd <= length? commands
            ][
                ;print "Good command."
                print commands/:cmd
                do get commands/:cmd ; <- GET necessary for R3 (in version 2.100.37 anyway)
            ][
                print "Bad command."
            ]
        ]
    ]
    print {
         -------------------
        |   Setup-anton.r   |
         -------------------
    }
    command-loop
]