tkgoodstuff/tcl/Pager.tcl

#  Pager, a Client for TkGoodstuff
#
#  Some code by  Eric Kahler(ekahler@mars.superlink.net) 

proc PagerDeclare {} {
    set Prefs_taborder(:Clients,Pager) "Misc Colors"
    TKGDeclare Pager(minpagewidth) 12 -typelist [list Clients Pager Misc]\
	-label "Minimum width per page (in pixels)"
    TKGDeclare Pager(minpageheight) 12 -typelist [list Clients Pager Misc]\
	-label "Minimum height per page (in pixels)"
    TKGColorDeclare Pager(ActiveBackground) \#87ceff\
	[list Clients Pager Colors]\
	"Color of current page"
    TKGColorDeclare Pager(Background) {}\
	[list Clients Pager Colors]\
	"Color of other pages"\
	$TKG(panelcolor)
    TKGDeclare Pager(Desks) 1 -typelist [list Clients Pager Misc]\
	-label "Number of desktops"
    TKGDeclare Pager(border) 3 -typelist [list Clients Pager Misc]\
	-label "Width in pixels of border around desktops"
}

proc PagerDoOnLoad {} {
    if ![info exists Fvwm(outid)] {
	TKGError "Pager client will not work unless
fvwm starts tkgoodstuff as an fvwm module." exit
    }
}

proc PagerStart {} {uplevel \#0 {
    foreach v [concat PagerW\
		   [info vars Pager_Page*]] {
	catch "unset $v"
    }
}}

proc PagerSuspend {} {
    global Pager Pager_Windows
    set Pager(suspended) 1
    for {set d 0} {$d < $Pager(Desks)} {incr d} {
	destroy $Pager_Windows($d)
    }
}

# PagerCreateWindow --
# We first wait until the Fvwm client has learned what page we're on.
# Then create the desks, leaving the pages until we're exposed.
proc PagerCreateWindow {} {
    global Pager Pager_Windows FvwmW

    if {(![info exists FvwmW(maxpagey)]) || ($FvwmW(maxpagey) == "")} {
	after 20000 {
	    if {(![info exists FvwmW(maxpagey)]) || ($FvwmW(maxpagey) == "")} {
		TKGError "Can't initialize Pager; didn't get page size from fvwm." exit
	    }
	}	    
	vwait FvwmW(maxpagey)
	if {$FvwmW(maxpagey) == ""} {vwait FvwmW(maxpagey)}
    }

    set Pager(ResX) [winfo vrootwidth .]
    set Pager(ResY) [winfo vrootheight .]

    set Pager(Columns) [expr 1 + $FvwmW(maxpagex)/$Pager(ResX)]
    set Pager(Rows) [expr 1 + $FvwmW(maxpagey)/$Pager(ResY)]
    set Pager(minheight) [expr $Pager(Rows) * $Pager(minpageheight)] 
    set Pager(minwidth)  [expr $Pager(Columns) * $Pager(minpagewidth)]

    for {set d 0} {$d < $Pager(Desks)} {incr d} {
	TKGGrid [TKGLabelBox Pager$d]
	global Pager${d}_window
	set Pager_Windows($d) [set Pager[set d]_window]
	$Pager_Windows($d) configure -borderwidth $Pager(border) \
	    -height 1 -width 1
    }

    bind $Pager_Windows(0) <Expose> {
	bind $Pager_Windows(0) <Expose> ""
	PagerCreateWindow-2
    }

    # In tk8.0, the id of a toplevel is one less than the window manager thinks
    set Pager(ourpanelid) \
	[format 0x%x [expr [winfo id [winfo toplevel $Pager0_window]] + 1]]
}

proc PagerCreateWindow-2 {} {
    global Pager Pager_Windows Fvwm

    set w $Pager_Windows(0)

    set Pager(W) [expr [winfo width $w] - 2*$Pager(border)]
    set Pager(H) [expr [winfo height $w] - 2*$Pager(border)]
    # Ensure we're over minimum size
    if {$Pager(W) < $Pager(minwidth)} {set Pager(W) $Pager(minwidth)}
    if {$Pager(H) < $Pager(minheight)} {set Pager(H) $Pager(minheight)}

    # Now autoscale
    set deskw [expr $Pager(ResX) * $Pager(Columns)]
    set deskh [expr $Pager(ResY) * $Pager(Rows)]
    set ratio [expr ($deskw+0.0)/$deskh]
    if {((0.0 + $Pager(W))/$deskw) >= ((0.0 + $Pager(H))/$deskh)} {
	regexp (.*)\\..* [expr $Pager(W) / $ratio ] Pager(H) Pager(H)
    } else {
	regexp (.*)\\..* [expr $Pager(H) * $ratio ] Pager(W) Pager(W)
    }
    # Correct the scale
    set Pager(PageWidth) [expr $Pager(W) / $Pager(Columns) - 1]
    set Pager(PageHeight) [expr $Pager(H) / $Pager(Rows) - 1]

    for {set D 0} {$D < $Pager(Desks)} {incr D} {
	set w $Pager_Windows($D)
    	for {set X 0} {$X < $Pager(Columns) } {incr X } {
	    grid columnconfigure $w $X -weight 1 -minsize $Pager(PageWidth)
	    for {set Y 0} {$Y < $Pager(Rows) } {incr Y } {
		set ww [set Pager_Windows($D,$X,$Y) $w.page($D,$X,$Y)]
		grid rowconfigure $w $Y -weight 1 -minsize $Pager(PageHeight)
		frame $ww -relief raised -borderwidth 1 \
		    -background $Pager(Background)\
		    -width $Pager(PageWidth) -height $Pager(PageHeight)
		grid $ww -in $w -sticky nsew -column $X -row $Y
		bind $ww <Button-1> "Pager_Goto $D $X $Y;break"
	    }
	}
    }
    update idletasks
    GoneToPage

    # Request messages
    global Fvwm_NewPage_hook
    if {![info exists Fvwm_newpage_hook] || ![In GoneToPage $Fvwm_NewPage_Hook]} {
	TKGAddToHook Fvwm_NewPage_hook GoneToPage
	TKGAddToHook Fvwm_NewDesk_hook GoneToPage
	TKGAddToHook Fvwm_ConfigureWindow_hook MarkPage
	TKGAddToHook Fvwm_FocusChange_hook PagerFocus
	TKGAddToHook Fvwm_DestroyWindow_hook UnMarkPage
    }
    catch {unset Pager(suspended)}
    fvwm send $Fvwm(outid) "Send_WindowList"
}

proc MarkPage { id } {
    global FvwmW PagerW Pager Pager_Windows
    if [info exists Pager(suspended)] return
    set D $FvwmW($id,t)
    set X $FvwmW($id,npagex)
    set Y $FvwmW($id,npagey)

    if [info exists PagerW($id,npagex)] {
	set oldD $PagerW($id,t)
	set oldX $PagerW($id,npagex)
	set oldY $PagerW($id,npagey)
	if {[list $oldX $oldY $oldD] == [list $X $Y $D]} return
	UnMarkPage $id
    }
    upvar \#0 Pager_Page-$X-$Y-$D P
    if {$id != $Pager(ourpanelid)} { 
	if {[array names P] == {}} {
	    if {$D < $Pager(Desks)} {
		$Pager_Windows($D,$X,$Y) configure -background $Pager(ActiveBackground)
	    }
	}
	set P($id) 1 
	set PagerW($id,t) $D
	set PagerW($id,npagex) $X
	set PagerW($id,npagey) $Y
    } 
}

proc UnMarkPage { id } {
    global FvwmW PagerW Pager_Windows Pager
    if [info exists Pager(suspended)] return
    if ![info exists PagerW($id,t)] return
    set D $PagerW($id,t)
    set X $PagerW($id,npagex)
    set Y $PagerW($id,npagey)
    upvar \#0 Pager_Page-$X-$Y-$D P
    catch {unset P($id)}
    if {[array names P] == {}} {
	if {$D < $Pager(Desks)} {
	    $Pager_Windows($D,$X,$Y) configure -background $Pager(Background)
	}
    }
    catch {unset PagerW($id,t) PagerW($id,npagex) PagerW($id,npagey)}
    return
}

# called on a click on a page
# we try to go to the same window as last time, unless user
# clicked on current page, in which case we cycle
proc Pager_Goto {D X Y} {
    global Fvwm FvwmW Pager
    upvar \#0 Pager_Page-$X-$Y-$D P
    upvar \#0 Pager(NextLast-$D-$X-$Y) NL
    if ![info exists NL] {
	set NL 0
    }
    if {($D != $FvwmW(desktop))
	|| ($X != $FvwmW(npagex))
	|| ($Y != $FvwmW(npagey))} {
	fvwm send $Fvwm(outid) "Desk 0 $D"
	fvwm send $Fvwm(outid) "GotoPage $X $Y"
    } else {
	incr NL
    }
    set wins [lsort -decreasing [array names P]]
    set l [llength $wins]
    for {set i 0} {$i < $l} {incr i} {
	set w [lindex $wins [expr ($NL+$i)%$l]]
	if !$FvwmW($w,iconic) {
	    set NL [expr ($NL+$i)%$l]
	    FvwmGoto $w
	    break
	}
    }
}

proc PagerFocus {w} {
    global FvwmW Pager
    if !$w return
    if [string match $FvwmW($w,resclass) Tkgoodstuff] return
    set X $FvwmW($w,npagex)
    set Y $FvwmW($w,npagey)
    set D $FvwmW($w,t)
    upvar \#0 Pager_Page-$X-$Y-$D P
    upvar \#0 Pager(NextLast-$D-$X-$Y) NL
    set NL [lsearch [lsort -decreasing [array names P]] $w]
}

proc GoneToPage {} {
    global Pager Pager_Windows FvwmW

    if [info exists Pager(suspended)] return

    set X $FvwmW(npagex)
    set Y $FvwmW(npagey)
    set D $FvwmW(desktop)

    if [info exists Pager(last,D)] {
	$Pager_Windows($Pager(last,D),$Pager(last,X),$Pager(last,Y)) configure -relief raised
    }

    if {(![info exists Pager_Windows($D,$X,$Y)]) \
	    || (![winfo exists $Pager_Windows($D,$X,$Y)])} return
    $Pager_Windows($D,$X,$Y) configure -relief sunken

    set Pager(last,D) $D
    set Pager(last,X) $X
    set Pager(last,Y) $Y
    return
}

DEBUG "Loaded Pager.tcl"