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 {}
}
2024-05-31 FB I am actively updating this script and will backport the changes here when it is tested stable again. Added artwork to MKV files, images onto the buttons, and more error handling and console support.
[Category movie] [Category Matroska]