Monday 5 November 2012

File renamer

Here a very powerful file renamer, you can selcet files, paths, hidden files and so on:
Here the source file:
REBOL [
    Title: "Files Renamer"
    Date: 09-09-2011
    Version: 0.8.7
    File: %files-renamer.r
    Author: "Marco Antoniazzi"
    Copyright: "(C) 2011 Marco Antoniazzi. All Rights reserved"
    Purpose: "Rename files"
    eMail: [luce80 AT libero DOT it]
    History: [
        0.5.0 [28-05-2011 "First version"]
        0.5.1 [02-06-2011 "Minor bug fixes"]
        0.5.2 [03-06-2011 "Bug fixes"]
        0.5.3 [04-06-2011 "Bug fixes"]
        0.5.4 [04-06-2011 "Bug fixes, use selection list also as file browser"]
        0.5.5 [05-06-2011 "Bug fixes, handle links (on Win), hide unreadable files"]
        0.6.1 [08-06-2011 "Horizontal scrollers, change case, minor bug fixes"]
        0.6.2 [10-06-2011 "Scrollers instead of sliders, minor bug fixes"]
        0.7.1 [12-06-2011 "Invert filter, select to tail, check empties and duplicates"]
        0.8.1 [14-06-2011 "Undo, Num. of modified"]
        0.8.2 [18-06-2011 "multi-select with mouse overing and shift, select invert, bug fixes"]
        0.8.3 [24-06-2011 "Bug fixes"]
        0.8.5 [15-07-2011 "insert file's date, minor bug fixes"]
        0.8.6 [26-07-2011 "Minor bug fixes"]
        0.8.7 [09-09-2011 "Added insert after autonum."]
    ]
    comment: {.GUI Automatically generated by VID_build. Author: Marco Antoniazzi}
    Help: {
    INSTRUCTIONS:
        1.1) unselect "Show folders" to hide folders
        1.2) select "Show all" to show unreadable files
        1.3) press "<<", "<" or "^^" to select the folder containing the files to be renamed
        1.4) insert a text with wildcards in "Filter" field to show only some files
            eg. "*.jpg" to show jpegs, "a*" to show files starting with "a", "*" to show all
            choose "Invert" to show the files not filtered
        1.5) press "Select all" to select all currently shown files
        1.6) double click on a folder (or link) name to browse it
        1.7) click on a file name to select it, press also <Ctrl> or <Shift> or move mouse to multi-select
        2) to change the name of selected files use the panel on the right.
            Renaming is done with the use of an "imaginary" cursor that is controlled
            by the various gadgets.
        2.1) use "Trim" to remove some characters
        2.2) use "goto", "find" and "skip" to move the cursor (possibly from the tail of the name)
        2.3) use "select to" and "select" to select some characters
            beware the selection always goes from left to right.
        2.4) choose to "cut" or "copy" the selection.
            If you see some characters disappear you know you are "cutting"
        2.5) use "goto", "find" and "skip" to move the cursor (possibly from the tail of the name)
        2.6) select "Paste" to insert selected text into current position
        2.7) use "Insert" to insert additional text into current position
        2.8) select "Insert file's date" to insert the last modified date of the file in one of the
            two formats into current position
        2.9) select "Insert number" to insert auto-numbering into current position
            You can decide the starting number, the increment and a padding text
        2.10) select "Change case to" and choose type to change characters case.
        2.11) press "Reset to defaults" to put all values to their initial state.
        2.12) select "Include extension" to rename also the files suffices
           
        3) press "Execute renaming of selected files" to rename files.
       
        4) press "Undo last renaming operation" to restore previous file names
            warning: you can undo ONLY ONE operation
    }
    Todo: {
        - various types of initial sorting
        - "multi-pass" renaming
    }
    Category: [util vid files]
    library: [
        level: 'intermediate
        platform: 'all
        type: 'tool
        domain: [gui files]
        tested-under: [View 2.7.8.3.1]
        support: none
        license: 'GPL2
        see-also: none
    ]
]
; files
    suffix?: func [
        {Return the suffix (ext) of a filename or url, else tail of it.}
        path [any-string!]
        /local
        suff
        ][
        either all [
            suff: find/last path #"."
            not find suff #"/"
        ] [suff] [tail path]
    ]
    dir?: func [file [file!]] [#"/" = last file]
    is-link?: func [file [file!] /local str] [; WARNING: THIS IS A DIRTY HACK!
        if all [
            equal? suffix? file %.lnk
            System/version/4 = 3 ;Win
            attempt [str: read file]
            equal? head str find str #{4C000000}
        ] [str]
    ]
   
    parent-dir: func [file [file!]] [
        if equal? length? file 1 [return %/]
        file: head remove back tail dirize file
        head remove/part find/tail/last file %/ tail file
    ]
    push-path: func [file [file!]] [paths-list: back insert tail paths-list file]
   
    filter_and_sort: func [list [block!] /local temp-list temp-dir-list temp-files-list] [
        temp-list: copy list
        if not get-face check-show-all [remove-each item temp-list [error? try [read/part path-name/:item 1]]]
        remove-each item temp-list [equal? found? find/any/match item get-face field-filter get-face check-filter]
        temp-dir-list: copy temp-list
        remove-each item temp-dir-list [not dir? item]
        sort temp-dir-list
        temp-files-list: copy temp-list
        remove-each item temp-files-list [dir? item]
        sort temp-files-list
        clear temp-list
        if get-face check-show-folders [insert temp-files-list temp-dir-list]
        temp-files-list
    ]
    rename_selected: func [/local done item old-file new-file] [
        if empty? old-list/picked [exit]
        if not confirm "Are you sure?" [exit]
        done: true
        new-file-list: head new-file-list
        forall new-file-list [
            if spc <> item: first new-file-list [
                old-file: pick old-file-list index? new-file-list
                if not-equal? undo-file old-file [ ; avoid renaming undo.file !
                    old-file: join path-name old-file
                    new-file: item
                    if error? try [rename old-file new-file] [done: false]
                ]
            ]
        ]
        reset_all
        undo-list: copy modified-list
        unghost btn-undo
        replace_file-list path-name
        alert either done ["DONE"] ["An error occured. NOT ALL FILES RENAMED"]
    ]
    undo: func [/local done undo-path old-file new-file] [
        if empty? undo-list [if error? try [undo-list: load undo-file] [alert "Unable to load undo file. UNDO IS NOT POSSIBLE!" exit]]
       
        undo-path: take undo-list
        done: true
        forskip undo-list 2 [
            old-file: join undo-path second undo-list
            new-file: first undo-list
            if error? try [rename old-file new-file] [done: false]
        ]
        reset_all
        clear undo-list
        attempt [save undo-file []]
        ghost btn-undo
        replace_file-list undo-path
        alert either done ["DONE"] ["An error occured. NOT ALL FILES RENAMED"]
    ]
;
; update lists
    update_info: func [/local info empties duplicates modified temp-list] [
        set-face info-nums rejoin [length? old-list/data " files shown , " length? old-list/picked " files selected"]
        empties: 0 foreach item new-file-list [if item = suffix? item [empties: empties + 1]]
        clear modified-list
        temp-list: copy old-file-list
        new-file-list: head new-file-list
        forall new-file-list [
            item: first new-file-list
            if all [not-equal? item spc not-equal? item %""] [
                if all [not find modified-list item not find temp-list item] [insert modified-list reduce [first temp-list item]]
                change temp-list item
            ]
            temp-list: next temp-list
        ]
        temp-list: head temp-list
        duplicates: (length? old-list/data) - length? unique temp-list
        modified: duplicates + ((length? modified-list) / 2)
        insert modified-list path-name
        info-errs/color: either (empties + duplicates) > 0 [red + 80] [green + 80]
        set-face info-errs rejoin [modified " modified , " empties " empties , " duplicates " duplicates"]
    ]
    update_text-list: func [list [object!] file-list [block!]] [
        clear list/data
        clear list/picked
        ; update and redraw file names text-list
        append list/data file-list
        show list/update
    ]
    scroller-redrag: func [scroller [object!] list [object!] file-list [block!] /local temp-list max-line-length] [
        temp-list: copy file-list
        forall temp-list [temp-list/1: join to-local-file temp-list/1 newline]
        size-text-face/text: form temp-list
        max-line-length: first size-text size-text-face
        scroller/redrag list/size/x - 30 / max 1 max-line-length
        show scroller
        max-line-length
    ]
    update_old-file-list: func [] [
        old-file-list: filter_and_sort orig-file-list
        update_text-list old-list old-file-list
        max-line-length-old: scroller-redrag scroller-old-list old-list old-file-list
    ]
    update_new-file-list: func [] [
        clear new-file-list
        recycle
        new-file-list: array/initial length? old-file-list spc
        foreach item old-list/picked [
            change at new-file-list index? find old-file-list item copy item
        ]
        do_rename
        update_text-list new-list new-file-list
        max-line-length-new: scroller-redrag scroller-new-list new-list new-file-list
        update_info
    ]
    update_lists: func [/reset] [
        if /reset [ ; reset starting lines and scroller of lists
            old-list/sn: new-list/sn: old-list/sld/data: new-list/sld/data: scroller-old-list/data: scroller-new-list/data: 0
            do-face scroller-old-list 0
            do-face scroller-new-list 0
        ]
        update_old-file-list
        update_new-file-list
    ]
    replace_file-list: func [dir-name [file! none!] /local fl] [
        if error? try [read dir-name] [return false]
        path-name: dir-name
        clear orig-file-list
        if all [object? main-win not get-face check-show-all] [fl: flash/with "reading directory..." main-win]
        orig-file-list: read dir-name
        update_lists/reset
        if fl [unview/only fl]
        set-face info-path to-local-file dir-name
        true
    ]
;
; select
    select_all: func [] [
        if empty? old-list/data [exit]
        clear old-list/picked
        old-list/picked: copy old-list/data
        show old-list
        update_info
        update_new-file-list
    ]
    select_invert: func [] [
        if empty? old-list/data [exit]
        foreach item old-list/data [alter old-list/picked item]
        show old-list
        update_info
        update_new-file-list
    ]
;
do_rename: func [/local item extensions file-date padded autonum step padding cond1 cond2 pos str select-end copied] [
    if empty? new-file-list [exit]
    extensions: copy []
    if not get-face check-ext [
        foreach item new-file-list [append extensions take/part suffix? item tail item]
    ]
   
    file-date: func [the-file [file!] date-format [string!] sep [string!] /local modified-date ext] [
        ext: either get-face check-ext [%""] [pick extensions index? find head new-file-list the-file]
        if modified-date: modified? rejoin [path-name the-file ext] [
            return switch date-format [
                "dd mm yyyy" [rejoin [padded modified-date/day "00" sep padded modified-date/month "00" sep modified-date/year]]
                "yyyy mm dd" [rejoin [modified-date/year sep padded modified-date/month "00" sep padded modified-date/day "00"]]
            ]
        ]
        ""
    ]
    autonum: to-integer get-face field-start
    step: to-integer get-face field-step
    padded: func [numb paddin] [reverse head change reverse paddin reverse form numb]
    padding: copy get-face field-pad
    forall new-file-list [
        cond1: true
        cond2: true
        pos: 1
        if spc <> item: copy first new-file-list [
            if "" <> str: get-face field-trim [item: trim/with item str]
            cond1: cond1 and ((1 + length? item) >= pos: to-integer get-face text-goto1)
            either get-face check-last1 [item: skip tail item negate pos] [item: at head item pos]
            pos: 0
            if "" <> str: get-face field-find1 [
                cond1: cond1 and found? found: either get-face check-rev1 [find/reverse item str] [find item str]
                item: any [found head item]
                pos: either found [index? found] [0]
            ]
            select-end: item
            if pos > 0 [
                cond1: cond1 and ((1 + length? item) >= pos: to-integer get-face text-skip1)
                item: skip item pos
                select-end: item
                if "" <> str: get-face field-select [
                    cond2: cond2 and found? found: either get-face check-select [find/tail item str] [find item str]
                    select-end: any [found item]
                ]
            ]
            if cond2 [select-end: skip select-end to-integer get-face text-select]
           
            copied: copy/part item select-end
            if get-face radio-cut [remove/part item select-end]
            cond1: cond1 and ((1 + length? item) >= pos: to-integer get-face text-goto2)
            either get-face check-last2 [item: skip tail item 1 + negate pos] [item: at head item pos]
            if "" <> str: get-face field-find2 [
                cond1: cond1 and found? found: either get-face check-rev2 [find/reverse item str] [find item str]
                item: any [found head item]
            ]
            cond1: cond1 and ((1 + length? item) >= pos: to-integer get-face text-skip2)
            item: skip item pos
            if get-face check-paste [item: insert item copied]
            if cond1 [item: insert item get-face field-insert]
            if get-face check-date [item: insert item file-date first new-file-list either get-face radio-date-dd ["dd mm yyyy"] ["yyyy mm dd" ] "-"]
            if get-face check-autonum [
                item: insert item padded autonum padding
                autonum: autonum + step
            ]
           
            if get-face check-case [
                item: head item
                lowercase item
                if get-face radio-case-first [uppercase/part item 1]
                if get-face radio-case-up [uppercase item]
            ]
            if cond1 [item: insert item get-face field-insert2]
            change new-file-list head item
        ]
    ]
    if not get-face check-ext [
        foreach item new-file-list [append item first extensions extensions: next extensions]
    ]
]
reset_all: func [/local vals] [
    vals: reduce [
        check-ext no
        field-trim ""
        text-goto1 "1"
        scroller-goto1 0
        check-last1 no
        field-find1 ""
        check-rev1 no
        text-skip1 "0"
        scroller-skip1 0
        field-select ""
        check-select no
        text-select "0"
        scroller-select 0
        radio-cut on
        radio-copy no
        text-goto2 "1"
        scroller-goto2 0
        check-last2 no
        field-find2 ""
        check-rev2 no
        text-skip2 "0"
        scroller-skip2 0
        check-paste no
        field-insert ""
        check-date no
        radio-date-dd on
        radio-date-yy no
        check-autonum no
        field-start "1"
        field-step "1"
        field-pad "0000"
        field-insert2 ""
        check-case no
        radio-case-low on
        radio-case-up no
        radio-case-first no
    ]
    forskip vals 2 [set-face first vals second vals]
]
ghost: func [face] [box-ghost/offset: face/offset + panel-lists/offset box-ghost/size: face/size show box-ghost]
unghost: func [face] [box-ghost/size: -1x-1 show box-ghost]
main-win: [
    do [sp: 4x4] origin sp space sp
    style text text feel none
    style text-list text-list font-name font-fixed para [wrap?: false]
    style info info edge [size: 1x1]
    Across
    btn "<<" [replace_file-list %/ push-path %/]
    btn " < " [if (length? head paths-list) > 1 [replace_file-list pick paths-list: back remove paths-list 1]]
    btn " ^^ " [
        if not none? path-name [
            replace_file-list parent-dir path-name
            push-path path-name
        ]
    ]
    text "Path:"
    info-path: info bold "" 370
    pad 316
    btn "?" sky keycode [f1] [
        ssh: System/script/header
        if not value? 'help-win [; avoid opening win more then once
            help-win: view/new layout [ below space sp
                text 500 bold center ssh/Title
                text 500 center rejoin ["Version: " ssh/Version " , " ssh/Date ". Copyright: " ssh/Copyright]
                text 500 bold center "USE AT YOUR OWN RISK"
                across
                info-help: info 580x300 as-is trim/auto ssh/Help wrap edge [size: 1x1]
                pad -20
                slider info-help/size/y * 0x1 + 16x0 with [append init [redrag 250 / 300]] [scroll-para info-help face]
                key (escape) (- sp) [unview]
            ]
        ]
    ]
    return
    check-show-folders: check-line "Show folders" on [update_lists]
    check-show-all: check-line "Show all" [
        if get-face face [
            if not confirm "Showing hidden files makes reading folders faster but anyway you will not be able to rename them. Really show them?" [set-face face off]
        ]
        update_lists
    ]
    text "Filter:"
    field-filter: field "*" 80 [update_lists]
    check-filter: check-line "Invert" no [update_lists]
    btn "Select All" [select_all]
    btn "Invert selection" [select_invert]
    return
    ; LISTS
    panel-lists: panel [
        across origin 0 space sp
        text bold "Current file name" 240 center
        text bold "New file name" 250 center
        return
        old-list: text-list 260x338 [update_info update_new-file-list scroller-new-list/data: 0 do-face scroller-new-list 0] with [
            append init [
                iter/feel: make iter/feel [
                    redraw-super: :redraw
                    redraw: func [f a i /local fil] [
                        redraw-super f a i
                        fil: to-file iter/text
                        iter/font/color: case [
                            equal? #"/" pick tail fil -1 [blue]
                            is-link? path-name/:fil [navy]
                            true [black]
                        ]
                    ]
                    combine: func [block [block!] value] [if not find block value [append block value]]
                    picked-num-s: picked-num: old-overed: 0
                    engage-super: :engage
                    engage: func [face action event /local path str overed] [
                        engage-super face action event
                        if event/double-click [
                            if empty? path: get-face old-list [exit]
                            path: last path
                            if dir? path [
                                if replace_file-list path-name/:path [push-path path-name]
                            ]
                            if str: is-link? path-name/:path [; WARNING: THIS IS A DIRTY HACK!
                                str: back find/any/last str "?:" ; find a: b: c: etc. drive letters
                                str: trim/with/all mold copy/part str find str #{00000000} "{^^@}" ; trim 0s
                                if replace_file-list dirize to-rebol-file str [push-path path-name]
                            ]
                            exit
                        ]
                        if action = 'down [
                            overed: index? find data last picked
                            either event/shift [picked-num-s: overed] [picked-num: overed]
                            if all [event/shift greater? picked-num 0 greater? picked-num-s 0 not-equal? picked-num picked-num-s] [
                                for n picked-num picked-num-s sign? (picked-num-s - picked-num) [
                                    combine picked pick data n
                                ]
                            ]
                            do-face slf none
                        ]
                        if action = 'away [
                            if not event/shift [
                                overed: round/floor event/offset/y / face/size/y
                                if old-overed <> overed [
                                    old-overed: overed
                                    overed: picked-num + overed
                                    if all [overed > sn (overed - sn) <= lc] [combine picked pick data overed]
                                    do-face slf none
                                ]
                            ]
                        ]
                    ]
                ]
            ]
        ]
        indent -16 - 4 ; hide scroller
        new-list: text-list old-list/size with [
            update: func [/local tot-rows visible-rows] [
                tot-rows: length? data visible-rows: lc
                sld/redrag visible-rows / max 1 tot-rows
                either visible-rows >= tot-rows [
                    sld/step: 0.0
                ][sld/step: 1 / (tot-rows - visible-rows) ]
                self
            ]
            append init [
                iter/feel/engage: none ; disable selection
                sld/action: func [face value] [;patched
                    if sn = value: max 0 to-integer value * ((length? slf/data) - lc) [exit] ; I always hated that "1 +" !
                    old-list/sn: sn: value ; keep lists syncronized
                    show [old-list sub-area]
                ]
            ]
        ]
        return
        pad 0x-4
        scroller-old-list: scroller old-list/size * 1x0 + -16x16 [old-list/iter/para/scroll: -1x0 * abs round old-list/size/x - 30 - max-line-length-old * value show old-list]
        pad -4
        scroller-new-list: scroller new-list/size * 1x0 + -16x16 [new-list/iter/para/scroll: -1x0 * abs round new-list/size/x - 30 - max-line-length-new * value show new-list]
        return
        info-nums: info "0 files shown , 0 files selected" old-list/size * 1x0 + -16x20
        pad -4
        info-errs: info "0 modified , 0 empties , 0 duplicates" new-list/size * 1x0 + 0x20
        return
        btn "Execute renaming of selected files" old-list/size/x - 16 - 2 yellow [rename_selected]
        btn-undo: btn "Undo last renaming operation" new-list/size/x [undo]
    ]
    do [btn-undo/parent-face: panel-lists]
    ; COMMANDS
    panel-commands: panel [
        style txt text
        style text text 154 right
        style field field 100x22 [update_new-file-list]
        style check-line check-line [update_new-file-list]
        style radio-line radio-line [update_new-file-list]
        style scroller scroller 100x20 0.0 edge [size: 2x2] with [
            min: 1
            max: 50
            target: none
            words: reduce [
                'min func [new args] [new/min: second args next args]
                'max func [new args] [new/max: second args new/step: 1 / (new/max - new/min) next args]
                'target func [new args] [new/target: second args next args]
            ]
        ] [set-face face/target round face/max - face/min * value + face/min update_new-file-list]
        Across origin sp space sp
        btn "Reset to defaults" [reset_all update_new-file-list]
        ;return
        pad 54
        check-ext: check-line "Include extension"
        return
        ;pad 0x9
        text "Trim:"
        field-trim: field
        return
        text "Go to" 40
        text-goto1: text "1" 30 bold
        text "th character:" 77
        scroller-goto1: scroller target text-goto1
        check-last1: check-line "from last"
        return
        text "Find:"
        field-find1: field
        check-rev1: check-line "reverse"
        return
        text "Skip " 50
        text-skip1: text "0" 30 bold
        text "characters:" 66
        scroller-skip1: scroller target text-skip1 min 0
        return
        text "Select to:"
        field-select: field
        check-select: check-line "included" no
        return
        text "Select " 50
        text-select: text "0" 30 bold
        text "characters:" 66
        scroller-select: scroller 175 target text-select min 0 max 120
        return
        radio-cut: radio-line "Cut" on
        radio-copy: radio-line "Copy"
        return
        text "Go to" 40
        text-goto2: text "1" 30 bold
        text "th character:" 77
        scroller-goto2: scroller target text-goto2
        check-last2: check-line "from last"
        return
        text "Find:"
        field-find2: field
        check-rev2: check-line "reverse"
        return
        text "Skip " 50
        text-skip2: text "0" 30 bold
        text "characters:" 66
        scroller-skip2: scroller target text-skip2 min 0
        return
        check-paste: check-line "Paste"
        return
        text "Insert:"
        field-insert: field [remove-each char face/text [find {\/:*?"<>|} char] show face update_new-file-list]
        return
        check-date: check-line "Insert file's date"
        radio-date-dd: radio-line "dd-mm-yyyy" of 'date on
        radio-date-yy: radio-line "yyyy-mm-dd" of 'date
        return
        check-autonum: check-line "Insert number from"
        field-start: field "1" 30 with [append init [deflag-face self tabbed]] [if error? try [to-integer face/text] [face/text: "1" show face] update_new-file-list]
        txt "step"
        field-step: field "1" 30 [if error? try [to-integer face/text] [face/text: "1" show face] update_new-file-list]
        txt "pad"
        field-pad: field "0000" 50 [remove-each char face/text [find {\/:*?"<>|} char] show face update_new-file-list]
        return
        text "Insert:"
        field-insert2: field [remove-each char face/text [find {\/:*?"<>|} char] show face update_new-file-list]
        return
        check-case: check-line "Change case to"
        radio-case-low: radio-line "lower" of 'case on
        radio-case-up: radio-line "UPPER" of 'case
        radio-case-first: radio-line "First upper" of 'case
        return
    ] edge [size: 1x1]
    return
    ;FIXME: partial renaming btn "Rename"
    at -100x-100 ; put out of sight
    key (escape) (- sp) [if confirm "Exit now?" [quit]]
    box-ghost: box 1x1 effect [merge blur blur] ; used to ghost (aka disable) face
    size-text-face: text font [name: reduce [font-fixed]] para [wrap?: false] ; used to measure text size
]
; main
    spc: " "
    max-line-length-old: max-line-length-new: 1
    path-name: none
    paths-list: copy []
    modified-list: copy []
    undo-file: %files-renamer-undo.rbl
    undo-list:
    orig-file-list:
    old-file-list:
    new-file-list: []
   
    append paths-list what-dir
    insert-event-func func [face event] [
        switch event/type reduce [
            'close [
                if event/face = main-win [
                    if confirm "Exit now?" [
                        if not empty? undo-list [
                            if error? try [save undo-file undo-list] [alert "Unable to save undo file. UNDO IS DISABLED!"]
                        ]
                        quit
                    ]
                    return none
                ]
                if event/face = help-win [unset 'help-win]
                event
            ]
            'scroll-line [either event/offset/y < 0 [scroll-drag/back new-list/sld] [scroll-drag new-list/sld]]
        ]
        event
    ]
    main-win: layout main-win
    replace_file-list first paths-list
    if any [
            error? try [undo-list: load undo-file]
            empty? undo-list
        ] [ghost btn-undo ]
    view/new/title/options main-win "Files Renamer" []
   
    do-events

No comments:

Post a Comment