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