Version 0 of TkLauncher

Updated 2015-02-03 11:29:41 by paskali

Hi, i wrote a simple desktop launcher for linux mainly for a window manager that emulates the amiga gui (amiwm), below the main.tcl code:

############################################################
# TkLauncher 1.0 - a simple desktop launcher for GNU/Linux #
############################################################

# Copyright (C) 2015 Pasquale Frega
# All rights reserved

# Released under the semplified BSD license

# last edit: 31-jan-2015

# begin

# Check command line arguments

if {$argc != 0} {
        switch [lindex $argv 0] {
                {-r} {
                        catch {exec pkill -o -f $argv0};
                        exec $argv0 &;
                        exit 0;
                }
                {-v} {
                        puts "TkLauncher version 1.0\n\nCopyright (c) 2015, Pasquale Frega\n\nAll rights reserved.\n\nRedistribution and use in source and binary forms, with or without\nmodification, are permitted provided that the following conditions are met:\n\n1. Redistributions of source code must retain the above copyright notice, this\n   list of conditions and the following disclaimer.\n2. Redistributions in binary form must reproduce the above copyright notice,\n   this list of conditions and the following disclaimer in the documentation\n   and/or other materials provided with the distribution.\n\nTHIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS \"AS IS\" AND\nANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED\nWARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE\nDISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR\nANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES\n(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;\nLOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND\nON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT\n(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS\nSOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.";
                        exit 0;
                }
                default {
                        puts "Usage: [file tail $argv0] \[option\]\nOption could be:\n\t-r\tReset process\n\t-v\tShow version and license\n\t-h\tShow this message";
                        exit 0;
                }
        }
}

# Load package Tk and hide the main window

package require Tk;
wm iconify .;

# Show the error message

proc ErrMsg {} {
        tk_messageBox -icon error -message {Program error};
        exit 1;
}

# Load and start package starkit

package require starkit;
starkit::startup;

# Create the configuration file in home directory if it does not exist

if {![file exist ~/.TkLauncherrc]} {
        if {[catch {file copy $starkit::topdir/resources/TkLauncherrc ~/.TkLauncherrc}]} {
                ErrMsg;
        }
}

# Open and process the configuration file

if {![catch {open ~/.TkLauncherrc} chid]} {
        set icon_number 0;
        
        while {![eof $chid]} {
                set got_list [gets $chid];
                switch [lindex $got_list 0] {
                        {Background} {
                                set background [lindex $got_list 1];
                        }
                        {Foreground} {
                                set foreground [lindex $got_list 1];
                        }
                        {ActiveForeground} {
                                set activeforeground [lindex $got_list 1];
                        }
                        {CompactMode} {
                                set compact_mode [lindex $got_list 1];
                        }
                        {Height} {
                                set height [lindex $got_list 1];
                        }
                        {Icon} {
                                set icon_file($icon_number) [lindex $got_list 1];
                                set to_exec($icon_number) "exec [lindex $got_list 2] >/dev/null &";
                                set label($icon_number) [lindex $got_list 3];
                                incr icon_number;
                        }
                }
        }
        
        close $chid;

} else {
        ErrMsg;
}

# If bad configuration file

proc BadConf {} {
        tk_messageBox -icon warning -message {Check configuration file};
        exit 0;
}        

# Check the value of height option

if {![string is integer $height]} {
        BadConf;
}

# Load package tkpng

lappend auto_path $starkit::topdir/lib;
package require tkpng;

# Create icons, show an error message if any file does not exist

for {set idx 0} {$idx < $icon_number} {incr idx} {
        if {[catch {set icon($idx) [image create photo -file $icon_file($idx) -width $height -height $height]}]} {
                tk_messageBox -icon warning -message "$icon_file($idx) does not exist";
                exit 0
        }
}

# Create the main icon

if {[catch {set main_icon [image create photo -file $starkit::topdir/resources/TkL.png]}]} {
        ErrMsg;
}

# Create the main button

menubutton .main_button -direction left -image $main_icon -padx 0 -pady 0 -menu .main_button.main_menu;

# Create the main menu

if {[catch {menu .main_button.main_menu -background $background -activebackground $background -foreground $foreground -activeforeground $activeforeground -borderwidth 1 -activeborderwidth 0 -tearoff 0}]} {
        BadConf;
}
for {set idx 0} {$idx < $icon_number} {incr idx} {
        if {[catch {.main_button.main_menu add command -image $icon($idx) -command "catch {$to_exec($idx)}" -label $label($idx) -compound top -columnbreak 1 -hidemargin $compact_mode}]} {
                BadConf;
        }
}

# Set the main window

wm deiconify .;
wm overrideredirect . yes;
wm attributes . -topmost yes;
wm geometry . +[expr {[winfo screenwidth .] - 18}]+[expr {[winfo screenheight .] - 34}];

# Pack the main button and the main menu

pack .main_button;

# end

More infos to: http://web.tiscali.it/paskali80/TkLauncher/TkLauncher.htm