REBOL [
    Title: "Patches"
    Date: 3-Jul-2002
    Name: Patches
    Version: 1.0.0
    File: %Patches.r
    Author: "Andrew Martin"
    Purpose: "Various patches to Rebol."
    Email: Al.Bri@xtra.co.nz
    Web: http://valley.150m.com
    Category: [util 5]
]

; Wraps throw-on-error around 'function body.
if not equal? second third :function [catch] [
    Function: func
    head insert/only at load mold third :function 2 [catch]
    compose/deep [
        throw-on-error [
            (copy/deep second :function)
            ]
        ]
    ]

; Fixes 'append so it works correctly with 'path! and doesn't evaluate 'Value.
if found? find mold second :append "insert tail series" [
    Append: func [
        {Appends a value to the tail of a series
        and returns the series head.}
        Series [series! port! path! word!]
        Value [any-type!]
        /Only "Appends a block value as a block."
        ][
        head either Only [
            insert/only tail :Series :Value
            ][
            insert tail :Series :Value
            ]
        ]
    ]

; Fixes 'repend so it works correctly with 'path!.
if any [
    unset? get/any 'repend  ; Early Rebel/Core versions don't have repend.
    found? find mold second :repend "insert tail series"
    ][
    Repend: func [
        {Appends a reduced value to a series
        and returns the series head.}
        Series [series! port! path! word!]
        Value [any-type!]
        /Only "Appends a block value as a block."
        ][
        head either Only [
            insert/only tail :Series reduce :Value
            ][
            insert tail :Series reduce :Value
            ]
        ]
    ]

; A better choice for http user-agent.
if not found? find system/schemes/http/user-agent "Mozilla" [
    system/schemes/http/user-agent: rejoin [
        "Mozilla" "/" "4.0"
        " (Compatible; REBOL " rebol/version ")"
        ]
    ]

; Holger's patch to ftp protocol to eliminate multi-line return bug.
change/only skip find pick find second get in system/schemes/ftp/handler 'open
to-set-word 'parse-dir-list 4 'transfer-check -2 'net-utils/confirm/multiline

; Replaces 'days with 'weekdays, to match /weekdays refinement for date! values.
rebol/Locale: make object! [
    Months: rebol/locale/months
    Weekdays: rebol/locale/days
    ]

; Modifies Extract to work with series! and adds /Only refinement.
Extract: function [
    "Extracts every N-th value from a Series."
    Series [series!]
    N [integer!]
    /Only   "Appends a block value as a block."
    ][
    New
    ][
    New: make Series (length? Series) / N
    do compose/deep [
        forskip Series N [
            (either Only ['insert/only]['insert]) tail New first Series
            ]
        ]
    New
    ]

; Adds 'Alter function to Rebol/Core, which is present in Rebol/View.
if not value? 'alter [
    Alter: function [
        {If a value is not in the list, append it. Otherwise, remove it.}
        List
        Value
        ] [
        Temp
        ] [
        either Temp: find List Value [
            remove Temp
            ][
            append List Value
            ]
        ]
    ]

; Fixes 'array function.
Array: func [
    "Makes and initializes a series of a given size."
    size [integer! block!] "Size or block of sizes for each dimension"
    /initial "Specify an initial value for all elements"
    value "Initial value"
    /local block rest
    ] [
    if not initial [
        value: none
        ]
    rest: none
    if block? size [
        rest: next size
        if tail? rest [
            rest: none
            ]
        size: first size
        if not integer? size [
            make error! "Integer size required"
            ]
        ]
    block: make block! size
    either not rest [
        either series? value [
            loop size [
                insert/only block copy/deep value
                ]
            ] [
            insert/dup block value size
            ]
        ] [
        loop size [
            block: insert/only block array/initial rest value
            ]
        ]
    head block
    ]

; Removes 'plus-to-space from 'decode-cgi.
Decode-CGI: function [
    {Converts CGI argument string to a block of set-words and value strings.}
    Args [any-string!]  "Starts at first argument word."
    ] [
    Block Name Value
    ] [
    Block: make block! 10
    parse/all Args [
        any [
            copy Name to #"=" skip (
                append Block to-set-word Name
                )
            [
                #"&" (
                    append Block copy ""
                    )
                | [copy Value to "&" "&" | copy Value to end] (
                    append Block either none? Value [
                        copy ""
                        ] [
                        replace/all dehex replace/all Value #"+" #" " CRLF newline
                        ]
                    )
                ]
            ]
        end
        ]
    Block
    ]