Jump to content

A simple TCL/TK program

- - - - -

This topic has been archived. This means that you cannot reply to this topic.
2 replies to this topic

#1
debtboy

debtboy

    Programming God

  • Members
  • PipPipPipPipPipPipPip
  • 916 posts
A few weeks back, I was playing with tcl/tk scripting
and made this little GUI program which displays a wealth
of information about a Linux system.
Give it a try...

#!/usr/bin/env tclsh

package require Tk


#Started messing w/ TCL/TK scripting and wrote this

#little info access program for any Linux Distro

#Debtboy (Rick)


#NOTE: Only tested on Gentoo, Fedora and Mint so far

#To run it, you must have tcl/tk installed

#copy this code into a file with a .tcl extension, something like proc.tcl

#then make that file executable and just run it

#no special permissions needed.


#The program displays various information about the system

#as well as key configuration files.

#All the important Linux in one place, point and click

 


proc listbox_Select {window} {


   set sel_index1 [$window curselection]

   set selected1 [$window get $sel_index1]

   set sel_name [string trim $selected1]


   #set page_display1 [exec cat $selected_file1]

   #set line_count [exec cat $selected_file1 | wc -l]


   if {$sel_name == "modules"} {

        set page_display1 [exec lsmod]

   } elseif {$sel_name == "pci-devices"} {

        set page_display1 [exec lspci]

   } elseif {$sel_name == "uptime"} {

        set page_display1 [exec uptime]

   } elseif {$sel_name == "cpuinfo"} {

        set fpath "/proc/" 

        if {[file exists "/proc/$sel_name"]} {

             set page_display1 [exec cat "/proc/$sel_name"]

        } else {tk_messageBox -message "/proc/$sel_name does not exists on your system"

             set page_display1 " "

        }

   } elseif {$sel_name == "version"} {

        if {[file exists "/proc/$sel_name"]} {

             set page_display1 [exec cat "/proc/$sel_name"]

        } else {tk_messageBox -message "/proc/$sel_name file does not exists on your system"

             set page_display1 " "

        }

   } elseif {$sel_name == "filesystems"} {

        if {[file exists "/proc/$sel_name"]} {

             set page_display1 [exec cat "/proc/$sel_name"]

        } else {tk_messageBox -message "/proc/$sel_name file does not exists on your system"

             set page_display1 " "

        }

   } elseif {$sel_name == "iomem"} {

        if {[file exists "/proc/$sel_name"]} {

             set page_display1 [exec cat "/proc/$sel_name"]

        } else {tk_messageBox -message "/proc/$sel_name file does not exists on your system"

             set page_display1 " "

        }

   } elseif {$sel_name == "meminfo"} {

        if {[file exists "/proc/$sel_name"]} {

             set page_display1 [exec cat "/proc/$sel_name"]

        } else {tk_messageBox -message "/proc/$sel_name file does not exists on your system"

             set page_display1 " "

        }

   } elseif {$sel_name == "partitions"} {

        if {[file exists "/proc/$sel_name"]} {

             set page_display1 [exec cat "/proc/$sel_name"]

        } else {tk_messageBox -message "/proc/$sel_name file does not exists on your system"

             set page_display1 " "

        }

   } elseif {$sel_name == "swaps"} {

        if {[file exists "/proc/$sel_name"]} {

             set page_display1 [exec cat "/proc/$sel_name"]

        } else {tk_messageBox -message "/proc/$sel_name file does not exists on your system"

             set page_display1 " "

        }

   } elseif {$sel_name == "diskstats"} {

        if {[file exists "/proc/$sel_name"]} {

             set page_display1 [exec cat "/proc/$sel_name"]

        } else {tk_messageBox -message "/proc/$sel_name file does not exists on your system"

             set page_display1 " "

        }

   } elseif {$sel_name == "devices"} {

        if {[file exists "/proc/$sel_name"]} {

             set page_display1 [exec cat "/proc/$sel_name"]

        } else {tk_messageBox -message "/proc/$sel_name file does not exists on your system"

             set page_display1 " "

        }

   } elseif {$sel_name == "smb.conf"} {

        if {[file exists "/etc/samba/$sel_name"]} {

             set page_display1 [exec cat "/etc/samba/$sel_name"]

        } else {tk_messageBox -message "/etc/samba/$sel_name file does not exists on your system"

             set page_display1 " "

        }  

   } elseif {$sel_name == "fonts.conf"} {

        if {[file exists "/etc/fonts/$sel_name"]} {

             set page_display1 [exec cat "/etc/fonts/$sel_name"]

        } else {tk_messageBox -message "/etc/fonts/$sel_name file does not exists on your system"

             set page_display1 " "

        }

   } else {

        if {[file exists "/etc/$sel_name"]} {

             set page_display1 [exec cat "/etc/$sel_name"]

        } else {tk_messageBox -message "/etc/$sel_name file does not exists on your system"

             set page_display1 " "

        }

   }


   .text1 delete 1.0 end

   .text1 insert end $page_display1

   #.listbox1 selection clear 0 end

}


proc menu_proc_clicked {no opt} {

   .listbox1 delete 0 end

   .text1 delete 1.0 end

   .listbox1 insert end "  cpuinfo" "  version" "  filesystems" \

                     "  uptime" "  iomem" "  meminfo" \

                     "  partitions" "  swaps" "  diskstats" \

                     "  devices" "  modules" "  pci-devices"

}


proc menu_config_clicked {no opt} { 

   .listbox1 delete 0 end

   .text1 delete 1.0 end

   .listbox1 insert end "  passwd" "  resolv.conf" "  hosts" "  host.conf" \

                     "  hosts.allow" "  hosts.deny" "  smb.conf" \

                     "  crontab" "  anacrontab" "  profile" "  protocols" \

                     "  adduser.conf" "  fstab" "  fonts.conf"

}


frame .frame_top

frame .frame_left 

frame .frame_right


font create .font1 -size 12 -family "Courier" -weight "normal" -underline "false"

font create .font2 -size 12 -family "Courier" -weight "bold" -underline "false"

font create .font3 -size 16 -family "Courier" -weight "bold" -underline "true"

font create .font4 -size 14 -family "Courier" -weight "bold" -underline "false"


label .label1 -text "FILE NAMES" -font ".font3"

label .label2 -text "FILE CONTENTS" -font ".font3"

label .label3 -text "Debtboy's Linux System Info Program" -font ".font4" -foreground "blue"

label .label4 -text "Just playing around with TCL/TK" -font ".font4" -foreground "blue"


text .text1 -width 80 -height 25 -wrap none -font ".font1"

.text1 configure -yscrollcommand {.scrollbar2 set} 

.text1 configure -xscrollcommand {.scrollbar3 set}

scrollbar .scrollbar2 -command {.text1 yview} -orient v

scrollbar .scrollbar3 -command {.text1 xview} -orient h


listbox .listbox1 -selectmode single -height 20 -font ".font2"

scrollbar .scrollbar1 -command {.listbox1 yview}

.listbox1 configure -yscrollcommand {.scrollbar1 set}

bind .listbox1 <<ListboxSelect>> {listbox_Select .listbox1}



#Declare that there is a menu

menu .menu1

. config -menu .menu1


#The Main Buttons

.menu1 add cascade -label "File" -underline 0 -menu [menu .menu1.file -tearoff 0]

.menu1 add cascade -label "Help" -underline 0 -menu [menu .menu1.help -tearoff 0]


## File Menu ##

set m .menu1.file

$m add command -label "System Info" -underline 0 -command {menu_proc_clicked 1 "System"}

$m add command -label "Config Files" -underline 0 -command {menu_config_clicked 1 "Config"}

$m add separator

$m add command -label "Exit" -underline 1 -command exit


## Help ##

set m .menu1.help

$m add command -label "About" -command { 

        tk_messageBox -message "Debtboy Programming"

        }


pack .frame_top -side "top"

pack .frame_left -side "left" -padx 10 -pady 10

pack .frame_right -side "right" -padx 10 -pady 10


pack .label3 -in .frame_top

pack .label4 -in .frame_top

pack .label1 -in .frame_left

pack .listbox1 .scrollbar1 -in .frame_left -side left -expand "true" -fill both

pack .label2 -in .frame_right  

pack .text1 .scrollbar2 -in .frame_right -side right -expand "true" -fill both

pack configure .text1 .scrollbar3 -in .frame_right -side top -fill x



#2
Guest_Jordan_*

Guest_Jordan_*
  • Guests
Nicely done! I don't have the opportunity to try it out but I will as soon as I get to a Linux box. Thanks for sharing! +rep

#3
debtboy

debtboy

    Programming God

  • Members
  • PipPipPipPipPipPipPip
  • 916 posts

Jordan said:

Nicely done! I don't have the opportunity to try it out but I will as soon as I get to a Linux box. Thanks for sharing! +rep
Thanks for the rep...

Here it is running on my system:

Posted Image

The length of the Listbox (on the left) seems to very slightly between linux systems.