REBOL [ Title: "Patches" Author: "Brett Handley" Date: 12-Nov-2003 Version: 1.1.7 History: [ 1.1.7 [12-Nov-2003 "Added FTP Patch for multiline transfer check on close." "Brett Handley"] 1.1.6 [11-Nov-2003 "Version 1.1.6 was created and then withdrawn again." "Brett Handley"] 1.1.5 [5-May-2002 "Add replacments of svvf/check/redraw by Romano Paolo Tenca." "Brett Handley"] 1.1.4 [24-Mar-2002 "Added replacements or win-offet? and screen-offset? by Romano Paolo Tenca." "Brett Handley"] 1.1.3 [23-Mar-2002 "Added patch to LAYOUT to solve problem with PANEL style." "Brett Handley"] 1.1.2 [10-Mar-2002 "Modified FTP patch to apply to View 1.2.1 and lower." "Brett Handley"] 1.1.1 [19-Feb-2002 "Replace DEBASE function to avoid crash." "Brett Handley"] 1.1.0 [8-Feb-2002 "ctx-text/back-field to cycle properly." "Brett Handley"] 1.0.0 [16-May-2001 "Checking FTP Scheme for 226 multiline server response bug." "Brett Handley"] ] Comment: { Using this script will change the behaviour of your programs and thus people not using the patches will see different behaviours. If you feel you need to use a patch or patches with a script that you are sharing then the safest way is to include only those that you need inside of your scripts that you distibute. If you are using the patches in an end-user situation, that is so that the problems are fixed once and for all, then be aware the patches may change the behaviour of downloaded scripts - particularly those which have been written in a way that assumes the existence of a bugs that these patches fix. } Rights: { Copyright (C) 2003 Brett Handley All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. Neither the name of the author nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS 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 THE COPYRIGHT OWNER OR 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. } ] patch-log: {} append patch-log {Replace DEBASE to avoid crash - } either all [ equal? "View" first parse to-string system/product "/" find/match form system/version "1.2.1." ] [ debase: function [ {Converts a string from a different base representation to binary. Note: This is a patched version.} value [any-string!] "The string to convert" /base {Allow a selection of a different base for conversion} base-value [integer!] "The base to convert from: 64, 16, or 2" ] [tmp] [ if not base [base-value: system/options/binary-base] if not found? find [64 16 2] base-value [return none] tmp: either string? value [copy value] [to-string value] RETURN first load/all append insert tmp compose [(base-value) "#{"] "}" ] append patch-log {Applied.^/} ] [append patch-log {Not Applied.^/}] append patch-log {FTP Scheme for 226 multiline server response bug - } either any [ all [(equal? "View" first parse to-string system/product "/") (system/version <= 1.2.1.255.255)] all [(equal? "Core" first parse to-string system/product "/") (system/version <= 2.5.0.255.255)] ][ ; FTP Scheme fix. ; Unnecessary error on receipt of "226 Quotas Off" server response line. ; Fix suggested by feedback@rebol.com use [ftp-open multiline-confirm change-cursor] [ ftp-open: second get in system/schemes/ftp/handler 'open multiline-confirm: first first find/tail ftp-open [not cached] change-cursor: skip third find/tail ftp-open to-set-word 'parse-dir-list 17 if equal? mold first change-cursor "net-utils/confirm" [ ; Paranoid test change/only change-cursor :multiline-confirm append patch-log {Applied.^/} ] ] ][append patch-log {Not Applied.^/}] append patch-log {FTP Scheme for 226 multiline server response bug 2 - } ; (Feedback Id #3bbm29070) use [code][ code: second get in system/schemes/ftp/handler 'close either equal? code/5/3 'net-utils/confirm [ insert tail code/5/3 'multiline append patch-log {Applied.^/} ][append patch-log {Not Applied.^/}] ] append patch-log {ctx-text/back-field to cycle properly - } either any [ all [ (equal? "View" first parse to-string system/product "/") (value? 'ctx-text) (8230563 = checksum mold get in ctx-text 'back-field) ] ][ set in ctx-text 'back-field func [face /local item] [ all [ item: find face/parent-face/pane face while [ if head? item [item: tail item] face <> first (item: back item) ] [ if all [object? item/1 flag-face? item/1 tabbed] [return item/1] ] ] none ] append patch-log {Applied.^/} ][append patch-log {Not Applied.^/}] append patch-log {Patch LAYOUT to fix PANEL - } either any [ all [ (equal? "View" first parse to-string system/product "/") (value? 'layout) (1202930 = checksum mold :layout) ] ][ use [ layout-function code-to-move block-to-change removal-point insertion-point ] [ ; Code to search for code-to-move: [ if :var [set :var new new/var: to-word :var var: none] ] ; The actual function definition (in context) layout-function: second :layout ; Find the block to change and the the point of change block-to-change: second third find layout-function 'while removal-point: find block-to-change code-to-move insertion-point: find block-to-change 'break ; Copy the code to just before the BREAK - ie after INIT has been processed. insert insertion-point copy/part removal-point length? code-to-move ; Remove the code from it's original position remove/part removal-point length? code-to-move ] append patch-log {Applied.^/} ][append patch-log {Not Applied.^/}] append patch-log {Replace svvf/check/redraw function (Romano's fix) - } either any [ all [ (equal? "View" first parse to-string system/product "/") (in system/view/vid/vid-feel 'check) (13056759 = checksum mold get in svvf/check 'redraw) ] ] [ system/view/vid/vid-feel/check/redraw: func ["patched by ana" face act pos] [ all [pos: find face/effect 'cross remove pos] if face/data [insert face/effect 'cross] if face/colors [face/color: pick face/colors not face/data] if face/effects [face/effect: pick face/effects not face/data] ] append patch-log {Applied.^/} ] [append patch-log {Not Applied.^/}] append patch-log {Replace win-offset? function to include edge (Romano's fix) - } either any [ all [ (equal? "View" first parse to-string system/product "/") (value? 'layout) (778225 = checksum mold :win-offset?) ] ] [ win-offset?: func [ {Given any face, returns its window offset. Patched by Ana} face [object!] /local xy ] [ xy: 0x0 if face/parent-face [ xy: face/offset while [face: face/parent-face] [ if face/parent-face [ xy: xy + face/offset + either face/edge [face/edge/size] [0x0] ] ] ] xy ] append patch-log {Applied.^/} ] [append patch-log {Not Applied.^/}] append patch-log {Replace screen-offset? function to include edge (Romano's fix) - } either any [ all [ (equal? "View" first parse to-string system/product "/") (value? 'layout) (2703331 = checksum mold :screen-offset?) ] ] [ screen-offset?: func [ {Given any face, returns its screen absolute offset. Patched by Ana} face [object!] /local xy ] [ xy: face/offset while [face: face/parent-face] [ xy: xy + face/offset + either face/edge [face/edge/size] [0x0] ] xy ] append patch-log {Applied.^/} ] [append patch-log {Not Applied.^/}]