Movie metadata editor for Windows, to display and edit metadata of MP4 and MKV video files. It uses external applications to read and write metadata to/from movie files. On startup the script looks for three external applications: AtomicParsley.exe, mkvpropedit.exe, mkvinfo.exe
For MP4 video: Atomic Parsley, from sourceforge For MKV video: mkvinfo (to read) and mkvpropedit (to write), from MKVToolNix
It has issues with writing metadata containing the symbols & and " atomicparsley refuses to modify tags on large files over 2.9 GB with message "doesn't have full 64-bit support"
Not my prettiest code but it functions well enough for my uses so I thought to share it.
# workaround for images that wont display with error: Failed to create temporary file
set env(JPEGMEM) 1000M
foreach t {Img} {
if {[catch {package require $t} result]} {
puts "- $t package failed to load: $result"
} else {
puts "+ $t package loaded"
}
}
wm minsize . 150 150
wm title . "Movie Metadata Editor - by Frank Bannon (2024)"
catch {wm iconbitmap . -default Metadata.ico}
set dir [file dirname [info script]]
array set var {}
set var(MP4_EDIT) [file join $dir AtomicParsley.exe]
set var(MKV_EDIT) [file join $dir mkvpropedit.exe]
set var(MKV_INFO) [file join $dir mkvinfo.exe]
set var(overwrite) 1
set var(gumball_delay) 2000
set var(display_thumb) 1
# check external apps exist
foreach {lbl exe vrb} {
AtomicParsley AtomicParsley.exe MP4_EDIT
MKVInfo mkvinfo.exe MKV_INFO
MKVPropEdit mkvpropedit MKV_EDIT
} {
if {![file exists $var($vrb)]} {
set filetypes {
{{Executable Files} {.exe} }
{{All Files} *}
}
set f [tk_getOpenFile -title "Find $lbl" -filetypes $filetypes -initialfile $exe]
if {[string length $f] && [file exists $f]} {set var($vrb) $f}
}
}
# toggles to lock metadata values to apply to later files
array set lock {}
# metadata read from file or entered in gui to save back to file
array set data {}
# tooltip balloon help
proc tooltip {w h} {
global val
bind $w <Any-Enter> "after 500 [list tooltip:show %W [list $h]]"
bind $w <Any-Leave> "destroy %W.tooltip"
}
proc tooltip:show {w arg} {
if {[eval winfo containing [winfo pointerxy .]]!=$w} {return}
set top $w.tooltip
catch {destroy $top}
toplevel $top -bd 1 -bg gray
wm overrideredirect $top 1
set font TkDefaultFont
if {$::tcl_platform(platform) == "unix"} {set font fixed}
pack [message $top.txt -aspect 10000 -bg lightyellow -font $font -width 450 -text $arg]
set wmx [winfo rootx $w]
set wmy [expr {[winfo rooty $w] + [winfo height $w]}]
wm geometry $top [winfo reqwidth $top.txt]x[winfo reqheight $top.txt]+$wmx+$wmy
raise $top
}
# create GUI
set f .f1
frame $f
pack $f -side top -anchor nw
button $f.choosedir -text "Select directory" -command choose_dir
tooltip $f.choosedir "Choose a folder of files to tag"
button $f.refresh -text "Refresh" -command {
# separate mp4 and mkv
set filelist [list [lsort -dict [glob -types f -nocomplain *.mp4]] [lsort -dict [glob -types f -nocomplain *.mkv]]]
set filelist [join $filelist]
# set filelist [lsort -dict [glob -types f -nocomplain *.mp4 *.mkv]]
}
tooltip $f.refresh "Refresh file list"
# intended to apply all LOCKED fields to all the files in the current folder
button $f.writeall -text "Tag All Files" -command {
set stop 0
for {set n 0} {$n <= [.f2.f1.list size]} {incr n} {
.f2.f1.list selection clear 0 end
.f2.f1.list selection set $n
if {$stop} {break}
log clear
log "----"
log "reading file list item $n"
read_file
log "writing $n"
write_file
}
}
tooltip $f.writeall "Write tags to all files in list\nUseful when some fields are Locked\nLike Movie, Genre, Comments"
button $f.stop -text "Stop" -command {set stop 1}
tooltip $f.stop "Stop tagging all files"
label $f.pad1 -text { -> }
label $f.pad2 -text { <- }
# write all metadata back to file, overwriting
button $f.write -text "Write tags" -command write_file -borderwidth 4
tooltip $f.write "Write tag fields to file"
# remove all metadata from file, used when tool throws error on read, to allow edits to succeed
button $f.clear -text "Clear tags" -command {write_file clear}
tooltip $f.clear "Remove all metadata tags from file"
# read file and send to console all discovered metadata
button $f.alltags -text "File Metadata" -command full_info
tooltip $f.alltags "Show all metadata of file in Console"
grid $f.choosedir $f.refresh $f.pad1 $f.write $f.pad2 $f.clear $f.alltags $f.writeall $f.stop -padx 3
set f .f2
frame $f
pack $f -side top -anchor nw -expand 1 -fill both
# filename listing
set f .f2.f1
frame $f
pack $f -side left -anchor nw -fill both -expand 1
scrollbar $f.x -orient horizontal -command "$f.list xview"
scrollbar $f.y -orient vertical -command "$f.list yview"
listbox $f.list -listvariable filelist -xscrollcommand "$f.x set" -yscrollcommand "$f.y set" -width 40
grid $f.list $f.y -sticky nsew
grid $f.x -sticky nsew
grid rowconfigure $f $f.list -weight 1
grid columnconfigure $f $f.list -weight 1
bind $f.list <<ListboxSelect>> read_file
# column container to right of listbox
set f .f2.f2
frame $f
pack $f -side top -anchor nw
label $f.filename -textvariable data(filename) -font {-size 12}
pack $f.filename -side top
set f .f2.f3
frame $f
pack $f -side top -anchor nw -fill x
# file type tags supported by MP4 only, not MKV
foreach {num txt} {0 Movie 1 Normal 2 Audiobook 6 "Music Video" 9 "Short Film" 10 "TV Show"} {
radiobutton $f.type$num -text $txt -variable data(stik) -value $txt \
-indicatoron 0 -relief raised -bd 1 -highlightthickness 0 -anchor c \
-selectcolor green3
pack $f.type$num -side left -padx 3
}
checkbutton $f.lock -text "L" -variable lock(stik) \
-indicatoron 0 -relief raised -bd 1 -highlightthickness 0 -anchor c \
-selectcolor green3 -command "set_lockdata stik"
tooltip $f.lock "Lock this value"
pack $f.lock -side left
# metadata table
set f .f2.f4
frame $f
pack $f -side top -anchor nw
set count 1
foreach {lbl tag} {
Title @nam
Artist @ART
Album @alb
Grouping @grp
Genre @gen
Year @day
Track track
Disc disc
Comments @cmt
Encoder @too
TVNetwork tvnn
TVShowName tvsh
TVEpisode tven
TVSeasonNum tvsn
TVEpisodeNum tves
} {
label $f.lbl$count -text $lbl
entry $f.ent$count -textvariable data($tag) -width 40
checkbutton $f.lock$count -text "L" -variable lock($tag) \
-indicatoron 0 -relief raised -bd 1 -highlightthickness 0 -anchor c \
-selectcolor green3 -command "set_lockdata $tag"
tooltip $f.lock$count "Lock this value"
button $f.clr$count -text "X" -command "set data($tag) {}"
tooltip $f.clr$count "Clear field"
if {$tag == "@nam"} {
# TITLE FIELD
button $f.copy -text "C" -command filename_to_title
tooltip $f.copy "Copy filename to here"
button $f.rename -text "Ren" -command rename_file
tooltip $f.rename "Make filename match Title"
grid $f.lbl$count $f.ent$count $f.lock$count $f.clr$count $f.copy $f.rename -sticky w
} else {
grid $f.lbl$count $f.ent$count $f.lock$count $f.clr$count -sticky w
}
incr count
}
# save or clear lock data from table
proc set_lockdata {v} {
global data lock lockdata
if {$lock($v)} {
set lockdata($v) $data($v)
puts "locked $v: $data($v)"
} else {
set lockdata($v) ""
puts "unlocked $v"
}
}
# artwork hack
set tag artw
button $f.lbl$count -text Artwork -command {
set f [tk_getOpenFile -title "Select JPG file" -filetypes {{{JPEG Files} {.jpg}}
{{PNG Files} {.png} }
{{All Files} *}} ]
if {[file exists $f]} {set data(artw) $f}
}
tooltip $f.lbl$count "Select artwork file to embed"
label $f.ent$count -textvariable data($tag) -width 40
button $f.clr$count -text "X" -command "set data($tag) {}"
tooltip $f.clr$count "Clear field"
grid $f.lbl$count $f.ent$count x $f.clr$count
# console
set f .f4
frame $f
scrollbar $f.x -orient horizontal -command [list $f.txt xview]
scrollbar $f.y -orient vertical -command [list $f.txt yview]
text $f.txt -width 80 -height 8 -bg white -wrap word \
-undo 0 -maxundo 0 -font {Courier 8} \
-xscrollcommand [list $f.x set] -yscrollcommand [list $f.y set]
pack [ttk::sizegrip $f.grip] -side right -anchor se
pack $f.x -side bottom -fill x
pack $f.y -side right -fill y
pack $f.txt -side left -fill both -expand 1
pack $f -side bottom -fill x -anchor nw
# MAIN LOG ADD ALL KNOWN COLORS AS TAGS
foreach {tag fg bg} {
debug black gray70
ok black white
warn black yellow
err red white
} {
$f.txt tag configure $tag -foreground $fg -background $bg
}
proc choose_dir {args} {
global filelist
set tmp [tk_chooseDirectory]
if {[string length $tmp] < 1} {return}
if {[catch {cd $tmp} result]} {return}
set filelist [list [lsort -dict [glob -types f -nocomplain *.mp4]] [lsort -dict [glob -types f -nocomplain *.mkv]]]
set filelist [join $filelist]
}
# write to console and to text widget
proc log {{str ""} {tag ""}} {
if {$str == "clear"} {.f4.txt delete 1.0 end; return}
puts $str
.f4.txt insert end "$str" $tag
.f4.txt insert end "\n"
}
# update write status gumball
proc status {{str "Write tags"} {fg SystemButtonText} {bg SystemButtonFace}} {
if {[catch {.f1.write configure -text $str -foreground $fg -background $bg} result]} {
puts $result}
update
}
# RETURN NICELY-FORMATTED FILE SIZE STRING WITH KB MB GB TB EB
# BROKEN ABOVE ABOUT 9223372030000000000 (7.9 EB) when number is 34 characters long
proc nice_size {num {decimals 1} {fullname 0}} {
set remainder 1
if {$decimals > 0} {set remainder [expr {pow(10,$decimals) + 0.0}]}
foreach {n short long} {80 YB YottaByte 70 ZB ZettaByte 60 EB ExaByte 50 PB PetaByte 40 TB TeraByte 30 GB GigaByte 20 MB MegaByte 10 KB KiloByte} {
set amount [expr {pow(2,$n)}]
if {$fullname} {set long " ($long)"} else {set long ""}
if {$num >= $amount} {return "[expr {int($num * $remainder / $amount) / $remainder}] $short$long"}
}
return $num
}
# RETURN A FORMATTED NUMBER WITH DESIRED DECIMAL POINTS
proc decimals {n d} {
global tcl_precision
set decpts [expr {pow(10,$d)}]
if {$d < 1} {
set x [string first "." $n]
# number is float, has decimal point
if {$x > -1} {
incr x -1
incr x $d
return [string range $n 0 $x]}
}
# number is whole, no decimal
set result [expr {wide($decpts * $n) / $decpts}]
}
# rename filename to match Title field, useful to recover mangled filenames
proc rename_file {args} {
global data
if {![file exists $data(filename)]} {log "File not found: $data($filename)" err; return}
set newname $data(@nam)[file extension $data(filename)]
if {[catch {file rename $data(filename) $newname} result]} {
log $result err
} else {
log "Renamed $data(filename) to $newname"
catch {.f1.refresh invoke}
}
}
# write to console full output from metadata reader on selected file
proc full_info {args} {
global var data
if {[info exists data(filename)]} {set filename $data(filename)} else {log "no filename given"; return}
log clear
log "See Console for all metadata in $filename"
set ext [string trimleft [string tolower [file extension $filename]] .]
switch -- $ext {
mp4 {catch {exec $var(MP4_EDIT) $filename -t} result}
mkv {catch {exec $var(MKV_INFO) $filename} result}
default {set result "unknown file type $ext"}
}
puts $result
}
proc display_photo {filename} {
set w .image
if {![winfo exists $w.c]} {
# create window
toplevel $w -background black
canvas $w.c -background black -width 600 -height 600
label $w.t -background black -foreground white -font {* 14}
pack $w.c -fill both -expand 1
pack $w.t -fill x
}
if {[file readable $filename]} {
# display file
catch {image delete pic}
image create photo pic -file $filename
$w.c create image 1 1 -image pic -anchor nw -tag image
$w.t configure -text "$filename"
}
}
proc read_file {args} {
global var data lock lockdata filelist
# get filename from list
set n [.f2.f1.list curselection]
if {[string length $n] < 1} {return}
# clear old data first
foreach tag [array names data] {set data($tag) ""}
log clear
set data(filename) [lindex $filelist $n]
puts "----"
log $data(filename)
if {![file exists $data(filename)]} {log "File not found $data(filename)"; return}
log "File size: [nice_size [file size $data(filename)]]"
status "Reading tags"
set ext [string trimleft [string tolower [file extension $data(filename)]] .]
# delete thumbnail
catch {image delete pic}
# use appropriate tool for the file type mp4/mkv
switch -- $ext {
mp4 {
log "MP4 container"
if {[catch {exec $var(MP4_EDIT) $data(filename) -t} result]} {
log "error: $result"
# disable tag fields
# auto clear exisiting tags to allow write of new tags
write_file clear
return
}
# enable tag fields
# parse tags
foreach str [split $result "\n"] {
# handle itunes ---- tags
regsub -all {"\)} $str {"} str
if {[string first Atom $str] > -1} {
set atom [lindex $str 1]
set cont [string range $str [string first contains: $str]+10 end]
# remove junk
regsub [binary format c "-62"] $atom "" atom
regsub [binary format c "-87"] $atom "@" atom
# sub
if {$atom == "gnre"} {set atom "@gen"}
set data($atom) $cont
log "$atom : $cont"
}
}
# attempt artwork extract to file
if {![catch {exec $var(MP4_EDIT) $data(filename) --extractPix} result]} {
set pix [string trim [lindex [split $result ":"] 1]]
if {[info exists var(display_thumb)] && $var(display_thumb)} {
if {[file exists $pix]} {display_photo $pix}
}
}
}
mkv {
log "Matroska container"
if {[catch {exec $var(MKV_INFO) $data(filename)} result]} {
log "error: $result"
status "error reading" black red
after $var(gumball_delay) status
}
# tags section, tag data on second line
foreach {str tag} {"Name: DATE_RELEASED" @day "+ Title:" @nam "+ Date:" @day "+ Writing application:" @too "Multiplexing application:" @too "Pixel height:" @grp} {
set idx1 [string first $str $result]
if {$idx1 > -1} {
set idx1 [expr $idx1 + [string length $str] + 1]
set idx2 [string first "\n" $result $idx1]
if {$idx2 < 0} {set idx2 end} else {incr idx2 -1} ;# remove newline
set data($tag) [string range $result $idx1 $idx2]
log "$str: $data($tag)"
}
}
if {[string length $data(@day)] > 3} {
# make date format YYYY-mm-ddTHH:MM:SS+zz:zz
set data(@day) [clock format [clock scan $data(@day)] -format "%Y-%m-%dT%H:%M:%S+00:00"]
}
}
default {
log "unknown file type $ext"
}
}
# if title is empty, copy filename
if {[string length $data(@nam)] < 1} {
log "Title field (@nam) empty." warn
filename_to_title
}
# restore locked data over anything read from file
foreach v [array names data] {
if {[info exists lock($v)] && [info exists lockdata($v)]} {
if {$lock($v)} {set data($v) $lockdata($v)}
}
}
status
}
# copy filename into title field, minus year if present
proc filename_to_title {args} {
global data
set f $data(filename)
# find year
set idx [string last ( $f]
if {($idx > -1) && ([string index $f $idx+5] == ")")} {
set year [string range $f $idx+1 $idx+4]
if {[string is integer $year]} {
set data(@day) $year
set data(@nam) [string trim [string range $f 0 $idx-1]]
}
} else {
set data(@nam) [string trim [file rootname $f]]
}
log "copied filename to Title field" warn
}
# write file tags
proc write_file {args} {
global var data lock lockdata
if {[info exists data(filename)]} {set filename $data(filename); unset data(filename)} else {log "no filename given"; return}
if {$args == "clear"} {log "Clearing existing tags..." warn}
log "Writing tags to $filename"
set time1 [clock seconds]
set ext [string trimleft [string tolower [file extension $filename]] .]
. configure -cursor watch
log clear
set err 0
status "Writing..." black yellow
# use appropriate tool for the file type mp4/mkv
switch -- $ext {
mp4 {
if {$var(overwrite)} {set params "--overWrite"} else {set params ""}
foreach v [array names data] {
# replace tag with parameter for parsley
# omit if data is blank, but then how to remove a tag?
switch -- $v {
@nam {append params " --title \"$data($v)\""}
@ART {append params " --artist \"$data($v)\""}
@alb {append params " --album \"$data($v)\""}
@grp {append params " --grouping \"$data($v)\""}
gnre {append params " --genre \"$data($v)\""}
@gen {append params " --genre \"$data($v)\""}
@day {append params " --year \"$data($v)\""}
@cmt {append params " --comment \"$data($v)\""}
@too {append params " --encodingTool \"$data($v)\""}
disc {append params " --disk \"$data($v)\""}
track {append params " --tracknum \"$data($v)\""}
stik {append params " --stik \"$data($v)\""}
tvnn {append params " --TVNetwork \"$data($v)\""}
tvsh {append params " --TVShowName \"$data($v)\""}
tven {append params " --TVEpisode \"$data($v)\""}
tvsn {append params " --TVSeasonNum \"$data($v)\""}
tves {append params " --TVEpisodeNum \"$data($v)\""}
bpm {append params " --bpm \"$data($v)\""}
cprt {append params " --copyright \"$data($v)\""}
artw { # only add artwork if filename present
if {[string length $data($v)]} {
append params " --artwork \"$data($v)\""
}
}
filename {}
default {log "unknown how to assign tag $v"}
}
}
if {$args == "clear"} {set params "-P --overWrite"}
puts "$var(MP4_EDIT) $filename $params"
# write to bat file then exec it, to support variable number of parameters
set fout [open update.bat w]
puts $fout "rem Script to update movie metadata, okay to delete"
puts $fout "\"$var(MP4_EDIT)\" \"$filename\" $params"
close $fout
if {[catch {exec update.bat} result]} {
log "error: $result" err
status "error writing" black red
after $var(gumball_delay) status
set err 1
} else {
log "success writing tags" ok
status "Success writing" black green2
after $var(gumball_delay) status
}
}
mkv {
# make date format YYYY-mm-ddTHH:MM:SS+zz:zz
set datelen [string length $data(@day)]
if {$datelen < 1} {set data(@day) [clock format [clock seconds] -format "%Y-%m-%dT%H:%M:%S+00:00"]}
if {$datelen == "4"} {append data(@day) [clock format [clock seconds] -format "-%m-%dT%H:%M:%S+00:00"]}
if {[catch {exec $var(MKV_EDIT) $filename --edit info --set "title=$data(@nam)" --set "writing-application=$data(@too)" --set "date=$data(@day)"} result]} {
log "error: $result" err
status "error writing" black red
after $var(gumball_delay) status
set err 1
} else {
log "success writing tags" ok
status "Success writing" black green2
after $var(gumball_delay) status
}
}
default {
log "unknown file type $ext"
}
}
set time2 [clock seconds]
set timed [expr {$time2 - $time1}]
if {$timed > 2} {log "elapsed time $timed seconds"}
# confirm by re-reading file
if {!$err} {read_file}
# delete bat file
catch {file delete update.bat}
. configure -cursor {}
}