if 0 {
Larry Smith Weedesk - a wee little desktop environment in tcl/tk.
Weedesk is an idea I've been noodling over for several days, and the sudden appearance of Desktop Environment shows me I'm not the only one wishing for a simple, extensible, portable desktop environment.
The Desktop Environment page lists a number of applications, but all of these are designed to stand alone. Ideally apps for the wee desktop would be new and designed just for it.
In my prototype code I've decided to go for a Macintosh-like system - the menubar goes across the top of the screen and changes as you select various windows. However, I've not integrated tkMenuMgr from Menus Even Easier yet, so all there is is a place-holding button that exits the desktop.
I picture a desktop with a number of lightweight, scriptable, applications: weeEdit is used for all text editing, weeCalc is the spreadsheet, weePage is a page layout app - takes text from weeEdit files and allows you to insert them into a web page - there would be no "weeWord", just weeEdit and weePage, which together serve the same purpose using html as an internal file format. Some other apps would be weeBrowse, weeMail, weeProg (an IDE/debugger for developing scripts) weeData (the database), weeChat, and so on. Also, the environment would support services - weeweb httpd, etc.
I visualize it running in a starkit. Installation = copy.
Here's some code to play with. Right now it's sort of an mdi on steroids. To the Internal Movable Windows code I've added various window buttons and functions (iconize not yet implemented), resizing and so on. }
proc winMove { win { state "" } } {
upvar _win$win offset
switch -exact $state {
start {
winSelect $win
set offset(x) [winfo pointerx .]
set offset(y) [winfo pointery .]
raise $win
} default {
set wmX [winfo pointerx .]
set wmY [winfo pointery .]
set xDiff [expr {$wmX - $offset(x)}]
set yDiff [expr {$wmY - $offset(y)}]
array set placeInfo [place info $win]
set placeX [expr {$placeInfo(-x) + $xDiff}]
set placeY [expr {$placeInfo(-y) + $yDiff}]
place $win -x $placeX -y $placeY
set offset(x) $wmX
set offset(y) $wmY
}
}
}
frame .rubberband -bd 3 -relief ridge
set rbx ""
set rby ""
proc winResize { win { state "" } } {
global rbx rby
switch -exact $state {
start {
winSelect $win
set w [ winfo width $win ]
set h [ winfo height $win ]
set rbx [ winfo x $win ]
set rby [ winfo y $win ]
set r [ expr $rbx + $w ]
set b [ expr $rby + $h ]
event generate . <Motion> -warp 1 -x $r -y $b
.rubberband configure -width $w -height $h
place .rubberband -x $rbx -y $rby
raise .rubberband
} done {
place forget .rubberband
set basex [ winfo x . ]
set basey [ winfo y . ]
set w [ expr [ winfo pointerx $win ] - $basex - $rbx ]
set h [ expr [ winfo pointery $win ] - $basey - $rby ]
place $win -width $w -height $h
} default {
set basex [ winfo x . ]
set basey [ winfo y . ]
set w [ expr [ winfo pointerx $win ] - $basex - $rbx ]
set h [ expr [ winfo pointery $win ] - $basey - $rby ]
.rubberband configure -width $w -height $h
}
}
}
proc iconize { w } {
puts "iconize"
}
proc grow_shrink { win } {
global wingeo
if [ string equal "normal" $wingeo($win,state) ] {
set wingeo($win,w) [winfo width $win]
set wingeo($win,h) [winfo height $win]
set wingeo($win,x) [winfo x $win]
set wingeo($win,y) [winfo y $win]
set x 0
set y 30
set w [ winfo width . ]
set h [ expr [ winfo height . ] - $y ]
place $win -x $x -y $y -width $w -height $h
set wingeo($win,state) maxed
} else {
set w $wingeo($win,w)
set h $wingeo($win,h)
set x $wingeo($win,x)
set y $wingeo($win,y)
place $win -x $x -y $y -width $w -height $h
set wingeo($win,state) normal
}
}
proc winClose { win } {
global prevwin
if [ string equal $prevwin $win ] {
set prevwin ""
}
destroy $win
place forget .help
}
label .help -bd 1 -fg black -bg lightyellow -font fixed -text "default help"
set btn3 0
proc popballoon {} {
global btn3
if { !$btn3 } { place forget .help }
}
proc help {w help} {
bind $w <Any-Enter> "after 1000 balloon %W $help; after 3000 popballoon"
bind $w <Any-Leave> "popballoon"
bind $w <ButtonPress-3> "set btn3 1; balloon %W $help"
bind $w <ButtonRelease-3> "set btn3 0; popballoon"
}
proc balloon { w args } {
.help configure -text $args
regexp {^\.[A-Za-z0-9]*} $w parent
if { [ catch { set x [ expr [ winfo x $w ] + [ winfo x $parent ] + 10 ] } ] == 0 } {
set y [ expr [ winfo y $w ] + [ winfo y $parent ] - 10 ]
place .help -x $x -y $y
raise .help
}
}
proc btn { name text cmd args } {
set btn [button $name -text $text -padx 1 -pady 0 -bd 1 \
-command $cmd -cursor top_left_arrow ]
pack $btn -side right
help $btn $args
}
proc winNew {win title txt} {
global wingeo
frame $win -bd 1 -relief raised
set wingeo($win,state) normal
pack [frame $win.titlebar -bd 1 -relief raised -cursor fleur] -side top -fill x
pack [label $win.titlebar.title -text $title ] -side left
help $win.titlebar "Click/Drag to Move"
help $win.titlebar.title "Click/Drag to Move"
btn $win.titlebar.done x "winClose $win" Exit
btn $win.titlebar.resize \u2198 "" "Click/Drag to Resize"
btn $win.titlebar.iconize . "iconize $win" Iconize
btn $win.titlebar.grow \u2195 "grow_shrink $win" Grow/Shrink
# btn $win.titlebar.lower \u2193 "lower $win" Lower
btn $win.titlebar.lower \u2193 "lower $win" Lower
pack [text $win.t -width 20 -height 3] -side top -fill both -expand 1
$win.t insert end $txt
bind $win.titlebar <ButtonPress-1> "winMove $win start"
bind $win.titlebar <B1-Motion> "winMove $win"
bind $win.titlebar.title <ButtonPress-1> "winMove $win start"
bind $win.titlebar.title <B1-Motion> "winMove $win"
bind $win.t <ButtonPress-1> "winSelect $win"
bind $win.titlebar.resize <ButtonPress-1> "winResize $win start"
bind $win.titlebar.resize <ButtonRelease-1> "winResize $win done"
bind $win.titlebar.resize <B1-Motion> "winResize $win"
return $win
}
set prevwin ""
proc winSelect { win } {
global prevwin
if ![ string equal $prevwin "" ] {
$prevwin.titlebar configure -bg gray
$prevwin.titlebar.title configure -bg gray
bind $win.t <ButtonPress-1> "winSelect $win"
}
$win.titlebar configure -bg red
$win.titlebar.title configure -bg red
bind $win.t <ButtonPress-1>
focus $win
raise $win
set prevwin $win
}
pack propagate . 0
wm focusmodel . active
# set width [ winfo screenwidth . ]
# set height [ winfo screenheight . ]
set width 500
set height 500
. config -width $width -height $height -bg blue
focus -force .
# wm overrideredirect . 1
update
# grab -global .
pack [button .l -text Desktop -command exit ] -side top
place [winNew .win1 "1st Window" "Hello World"] -x 10 -y 40
place [winNew .win2 "2nd Window" "Hello Person"] -x 300 -y 50