REBOL [
    Title: "HTML Edits" 
    Date: 31-Oct-2000
    File: %html-edits.r 
    Author: "Brett Handley"
    Email: brett@codeconscious.com 
    Purpose: "Some manipulations of html using html-tools.r"
    History:    [
        1.0.0 [31-Oct-2000 { Original code }  "Brett Handley"]
        1.0.1 [3-Nov-2000 {
            Slight block value ordering of extract-links.
            Added some manipulation functions - not working right yet and a bit verbose.
        }  "Brett Handley"]
    ]
]
    
if not :use-script [use-script: :do]   ; Use-script is my script manager

use-script %html-tools.r

edit-link-lowercase: func [link ][
    either select link 'href [
        if not find/match/case link/href lowercase copy link/href [
            lowercase link/href
        ]
    ][
        if select link 'src [
            if not find/match/case link/src lowercase copy link/src [
                lowercase link/src
            ]
        ]
    ]
    link
]

edit-links: function [
    "Makes all href and src type links in the html block lowercase."
    html-block "Block is modified."
    link-edit [any-function!] "A function that takes the link block as an argument and modifies it."
    /statistics "Returns statistics instead of block."
][change-count link-copy][
    change-count: 0
    foreach link tags/attribute html-block 'href [
        link-copy: copy/deep link
        if not find/match/case select link-edit link 'href link-copy/href [
            change-count: add change-count 1
        ]
    ]
    foreach link tags/attribute html-block 'src [
        link-copy: copy/deep link
        if not find/match/case select link-edit link 'src link-copy/src [
            change-count: add change-count 1
        ]
    ]
    either statistics [
        reduce [change-count]
    ][
        html-block
    ]
]

tidy-web-files: function [
    "Given a list of file names goes through each one - returns a block of modified files."
    file-list
    /fix-links "Edits all .htm, .html files to ensure links are lowercase."
][change-stats result-block html-block][
    file-modifications: copy []
    if fix-links [
        foreach f filter :html-file? file-list [
            change-stats: edit-links/statistics html-block: load-html f :edit-link-lowercase
            if greater? change-stats/1 0 [
                write f form-html html-block
                insert tail file-modifications f
            ]
        ]
    ]
    foreach f file-list [
        if not find/match/case f lowercase copy f [
            rename f lowercase f
            insert tail file-modifications f
        ]
    ]
    unique file-modifications
]

extract-links: function [
    "Given a list of html files goes through each one finding the links."
    file-list
][result-block html-block][
    result-block: copy []
    foreach f file-list [
        html-block: load-html f
        foreach link tags/attribute html-block 'href [
            insert/only tail result-block reduce [f link/1 link/href ]
        ]
        foreach link tags/attribute html-block 'src [
            insert/only tail result-block reduce [f link/1 link/src ]
        ]
        foreach link tags/attribute html-block 'action [
            insert/only tail result-block reduce [f link/1 link/action ]
        ]
    ]
    result-block
]

; An example function
change-all-image-links: func [
    "Changes all image links of all the .html of the current directory."
    match-path-string "The file path to match."
    replacement-path-string "The new path string."
][
    foreach f html-files %. [
        h: load-html f
        the-tags: tags/name/attribute/value h 'img 'src match-path-string
        foreach t the-tags [
            replace t/src match-path-string replacement-path-string
        ]
        write f form-html h
    ]
]