[tk] パスを表示するプログラム

何でも良いのでTcl/Tkのプログラムが一つ欲しかったので、前職で欲しかったツールをTcl/Tk作ってみました。環境変数PATHから無効なPATHと重複しているPATHを色分けして表示してくれます。不要なPATHを削除したり、実行ファイルのドラッグ＆ドロップでパスを追加するような機能まで考えていたのですが、ここで力尽きたのでできたところまで公開します。

重複しているPATHは青、指定されたディレクトリに実行ファイルが無いPATHは赤で表示しています。

# utility
# container の中に 要素 elememt があるとき1を返す。無い時は0を返す。
proc member { container elememt } {
    upvar $container upver_container
    
    if [array exists upver_container] {
        # array の処理
        if {[array get upver_container $elememt] != ""}  { return 1 } else { return 0}
    }
    
    # list の処理
    if {[lsearch -exact -ascii $upver_container $elememt] != -1} {return 1} else {return 0}
}

# Listの要素の最大長を返す
proc max_len { l } {
    set max 0
    foreach e $l {
	set len [string length $e]
	if { $len > $max } {
	    set max $len
	}
    }
    return $len
}

# Listの中に複数あるPathをリストで返す。
proc find_duplicate { l } {
    set dup ""
    foreach e $l {
	set elem [list $e]
	set ret [lsearch -exact -ascii -all $l $e]
	if { [llength $ret] > 1 } {
	    lappend dup $e
	}
    }
    return $dup
}

# dirや実行ファイルが存在しないパスのリストを返す
proc find_invalidpath { l } {
    set invalid ""
    foreach e $l {
	if { [file exists $e] == 0 } {
	    lappend invalid $e
	} else {
	    set files [glob -directory $e -nocomplain  {*.{exe,bat}} ]
	    if { $files == "" } { 
		lappend invalid $e
	    }
	}
    }
    return $invalid
}

# PATH情報の取得
set pathlist     [split $env(PATH) ";"]
set dup_path     [find_duplicate $pathlist]
set invalid_path [find_invalidpath $pathlist]

puts "dup path $dup_path"

# GUI 設定
option add *font "Consolas 12"
wm title . "Path"
set listbox_w [max_len $pathlist]

# ディレクトリー名をリストボックスに表示
set w ".fp"
frame $w
listbox $w.listbox -listvariable pathlist -width [expr $listbox_w * 2] -relief raised -borderwidth 2 \
    -yscrollcommand "$w.scroll set" -height 30 
scrollbar $w.scroll -command "$w.listbox yview"
pack $w.listbox $w.scroll -side left -fill y
button .b -text "Quit" -command { destroy . }

pack .fp .b

# 色の変更
set i 0
foreach path $pathlist {
    if [member dup_path $path] {
	.fp.listbox itemconfigure $i -foreground blue
    }
    if [member invalid_path $path] {
	.fp.listbox itemconfigure $i -foreground red
    }
    incr i
}