#!/usr/local/bin/wish4.0
# jlaunchpad - terminal launcher
#
######################################################################
# Copyright 1992-1995 by Jay Sekora.  This file may be freely        #
# distributed, modified or unmodified, for any purpose, provided     #
# that this copyright notice is retained verbatim in all copies and  #
# no attempt is made to obscure the authorship of this file.  If you #
# distribute any modified versions, I ask, but do not require, that  #
# you clearly mark any changes you make as such and that you provide #
# your users with instructions for getting the original sources.     #
######################################################################
## begin boiler_header

if {[info exists env(JSTOOLS_LIB)]} {
  set jstools_library $env(JSTOOLS_LIB)
} else {
  set jstools_library /usr/local/lib/jstools
}

# add the jstools library to the library search path:

set auto_path [concat [list $jstools_library] $auto_path]

# check for ~/.tk and prepend it to the auto_path if it exists.
# that way the user can override and customise the jstools libraries.

if {[file isdirectory ~/.tk]} then {
  set auto_path [concat [list [glob ~/.tk]] $auto_path]
}

## end boiler_header

if {[lindex $argv 0] == "-v"} {
  set orientation vertical		;# SHOULD BE IN DEFAULTS!
} else {
  set orientation horizontal		;# SHOULD BE IN DEFAULTS!
}

catch {tk colormodel . color}           ;# colour even on a 2-bit display

wm title . launchpad

bind . <Control-q> {exit}
bind . <Meta-q> {exit}
bind . <Control-c> {exit}
bind . <Control-period> {exit}

set tk_strictMotif 1

set colours(toolBackground) \
  [option get . toolBackground ToolBackground]
if {$colours(toolBackground) == ""} \
  {set colours(toolBackground) gray80}
set colours(toolActiveBackground) \
  [option get . toolActiveBackground ToolActiveBackground]
if {$colours(toolActiveBackground) == ""} \
  {set colours(toolActiveBackground) gray80}
set colours(toolReversedBackground) \
  [option get . toolReversedBackground ToolReversedBackground]
if {$colours(toolReversedBackground) == ""} \
  {set colours(toolReversedBackground) black}

set colours(toolForeground) \
  [option get . toolForeground ToolForeground]
if {$colours(toolForeground) == ""} \
  {set colours(toolForeground) black}
set colours(toolActiveForeground) \
  [option get . toolActiveForeground ToolActiveForeground]
if {$colours(toolActiveForeground) == ""} \
  {set colours(toolActiveForeground) black}
set colours(toolReversedForeground) \
  [option get . toolReversedForeground ToolReversedForeground]
if {$colours(toolReversedForeground) == ""} \
  {set colours(toolReversedForeground) gray80}

option add {*background} $colours(toolBackground)
option add {*activeBackground} $colours(toolActiveBackground)
option add {*foreground} $colours(toolForeground)
option add {*Scrollbar*foreground} $colours(toolBackground)
option add {*activeForeground} $colours(toolActiveForeground)

######################################################################
# FOR CLOCK

global delay

set delay 15000				;# ms between checking mailbox (15s)

proc jlp:checktime {} {
  global delay
  set time [exec date]
  .clock configure -text [format "%s %s %s" \
    [string range [lindex $time 3] 0 4] \
    [lindex $time 1] \
    [lindex $time 2] \
  ]
  after 15000 jlp:checktime		;# every fifteen seconds
}

button .clock \
  -width 12 \
  -font -*-lucidatypewriter-medium-r-normal-sans-10-100-*-*-m-*-*-* \
  -text {} \
  -relief sunken \
  -borderwidth 1 \
  -command jlp:checktime

after 1 jlp:checktime

######################################################################
# FOR BIFF
global nomail newmail mboxsize mboxtime mail delay colours

set nomail "no new mail"
set newmail "new mail"
set mail /usr/mail/js

# set delay 30000				;# ms between checking mailbox
#	(shared with clock procedures)

proc jlp:getmboxsize {} {
  global nomail newmail mboxsize mboxtime mail delay colours

  if [file exists $mail] {
    return [file size $mail]
  } else {
    return 0
  }
}

proc jlp:getmboxtime {} {
  global nomail newmail mboxsize mboxtime mail delay colours

  if [file exists $mail] {
    return [file mtime $mail]
  } else {
    return 0
  }
}

proc jlp:getname {} {
  # get last username in $mail file
  global nomail newmail mboxsize mboxtime mail delay colours

  if [file exists $mail] {
    set address [exec awk {/^From / { print $2 }} $mail | tail -1 ]
	# following is to take care of eg From: @BIFFVM.BIFF.EDU:BIFF@BIFFVM
    regsub {@[A-Z.]*:} $address {} address
    regsub {[@%].*} $address {} address
    regsub {.*[:!]} $address {} address
    set address [string trim $address {<>!:@ }
    return [exec tr {ABCDEFGHIJKLMNOPQRSTUVWXYZ} \
                    {abcdefghijklmnopqrstuvwxyz} << $address]
  } else {
    puts stdout "Error!  Looking for name in nonexistent file $mail!\n"
    return 1
  }
}

# MH version - get last username in user's inbox:
proc jlp:getname {} {
  global nomail newmail mboxsize mboxtime mail delay colours
  
  set address "no mail"
  
  catch {
    set address [exec scan +inbox last -format {%(addr{from})} ]
  }
  # following is to take care of eg From: @BIFFVM.BIFF.EDU:BIFF@BIFFVM
  regsub {@[A-Z.]*:} $address {} address
  regsub {[@%].*} $address {} address
  regsub {.*[:!]} $address {} address
  set address [string trim $address {<>!:@ }
  set address [exec tr {ABCDEFGHIJKLMNOPQRSTUVWXYZ} \
                  {abcdefghijklmnopqrstuvwxyz} << $address]

  return $address
}


proc jlp:flagup {} {
  global nomail newmail mboxsize mboxtime mail delay colours

###
# .biff configure -text $newmail
###
  .biff configure -text [jlp:getname]
  .biff configure -relief raised
  .biff configure -background $colours(toolReversedBackground)
  .biff configure -foreground $colours(toolReversedForeground)
  
  set mboxsize [jlp:getmboxsize]
  set mboxtime [jlp:getmboxtime]
}

proc jlp:flagdown {} {
  global nomail newmail mboxsize mboxtime mail delay colours

  .biff configure -text $nomail
  .biff configure -relief sunken -borderwidth 1
  .biff configure -background $colours(toolBackground)
  .biff configure -foreground $colours(toolForeground)
  set mboxsize [jlp:getmboxsize]
  set mboxtime [jlp:getmboxtime]
}

proc jlp:checkmail {} {
  global mboxtime delay

  if {[jlp:getmboxtime] != $mboxtime} {
    if {[jlp:getmboxsize] > $mboxsize} {
      jlp:flagup
    } else {
      jlp:flagdown
    }
  }
  after $delay jlp:checkmail
}

set mboxsize [jlp:getmboxsize]
set mboxtime [jlp:getmboxtime]

# MH version
proc jlp:checkmail {} {
  global delay
  
  jlp:flagup
  after $delay jlp:checkmail
}

button .biff \
  -width 12 \
  -text $nomail \
  -relief sunken \
  -borderwidth 1 \
  -command jlp:flagdown

# MH version:

.biff configure -command jlp:flagup

### # if {$mboxsize > 0} {
### #   jlp:flagup
### # } else {
### #   jlp:flagdown
### # }

after $delay jlp:checkmail
jlp:flagup

######################################################################
# FOR HOSTMENU:
# problem: xauth, xterm must be in remote PATH, DISPLAY must have FQDN

proc jlp:rlogin { host } {
  global env
  
  if [catch {
    # first try to set permissions:
    catch {
      exec xauth extract - $env(DISPLAY) | rsh $host xauth merge -
    }
        
    # now try to rsh an xterm:
    exec rsh $host xterm -name $host -title $host -display $env(DISPLAY) \
      < /dev/null >& /dev/null &
  }] {
    telnet $host
  }
}

proc jlp:telnet { host } {
  global env
  
  exec xterm -name $host -title $host -e telnet $host &
}

######################################################################
# FOR TODO

global env

j:jstools_init jlaunchpad

menubutton .launchpad -text "Launchpad" -menu .launchpad.m
menu .launchpad.m
.launchpad.m add command -label {Issue Tcl Command . . .} \
  -accelerator {[T]} -command {j:prompt_tcl}
.launchpad.m add command -label {Issue Unix Command . . .} \
  -accelerator {[U]} -command {j:prompt_unix}
.launchpad.m add separator
.launchpad.m add command -label "Restart Launchpad" -command {
  # BOGUS - DOESN'T HANDLE POSITIONING, VERTICAL, ARGS, ETC.
  exec jlaunchpad -title jlaunchpad -name jlaunchpad -geometry +0+0 &
  exit 0
}
.launchpad.m add separator
.launchpad.m add command -label Quit -accelerator {[q]} -command {exit 0}

######################################################################

frame .menu -borderwidth 2 -relief raised
raise .clock
raise .biff
raise .launchpad

if {$orientation == "vertical"} {
  pack .clock -in .menu -side top -fill x
  pack .biff -in .menu -side top -fill x
  pack .launchpad -in .menu -side top -fill x
  pack .menu -in . -side top -fill x
} else {
  pack .clock -in .menu -side left -ipadx 6
  pack .biff -in .menu -side left -ipadx 6
  pack .launchpad -in .menu -side left -ipadx 6
  pack .menu -in . -side left
}

proc hostmenu {name list} {
  global orientation
  menubutton .menu.m$name -text $name -menu .menu.m$name.m
  menu .menu.m$name.m
  foreach line [split $list "\n"] {
    set line [string trim $line]
    if {"x$line" == "x"} then {continue}
    set host [lindex [split $line] 0]
    if {$host == "-"} {
      .menu.m$name.m add separator
    } else {
      .menu.m$name.m add command -label $line \
        -command "after 1 jlp:rlogin $host"
    }
  }
  if {$orientation == "vertical"} {
    pack .menu.m$name -in .menu -side top -fill x
  } else {
    pack .menu.m$name -in .menu -side left -ipadx 6
  }
}

proc cmdmenu {name list} {
  global orientation
  menubutton .menu.m$name -text $name -menu .menu.m$name.m
  menu .menu.m$name.m
  foreach line [split $list "\n"] {
    set line [string trim $line]
    if {"x$line" == "x"} then {continue}
    if {$line == "-"} {
      .menu.m$name.m add separator
    } else {
      .menu.m$name.m add command -label $line -command "exec $line &"
    }
  }
  if {$orientation == "vertical"} {
    pack .menu.m$name -in .menu -side top -fill x
  } else {
    pack .menu.m$name -in .menu -side left -ipadx 6
  }
}

j:tk3 {
  # create a new proc side_mbPost like tk_mbPost, except popping the 
  # menu up _next_ to the menubutton:
  #
  regsub -all \
    {\[winfo rootx \$w\] \[expr \[winfo rooty \$w\]\+\[winfo height \$w\]\]} \
    [info body tk_mbPost] \
    {[expr [winfo rootx $w]+[winfo width $w]] [winfo rooty $w]} \
    newBody
  
  proc side_mbPost {w} $newBody
  
  # ...and substitute it for the original, if orientation is vertical:
  
  if {$orientation == "vertical"} {
    rename tk_mbPost bottom_mbPost
    rename side_mbPost tk_mbPost
  }
}


#
# read in user's menu definitions:
#
if [file isfile ~/.tk/jlaunchpadrc.tcl] {
  source ~/.tk/jlaunchpadrc.tcl
}

focus .
catch {focus default .}			;# caught for Tk 4.0




