Movie Metadata editor

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"
                log "writing $n"
        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

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}
# 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
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
                        # 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
        # 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)}
# 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 {}