#! /usr/bin/tclsh
############################################################################
# UCSD/UCL wrappers.tcl -- Marty Sereno (sourced by csurf,tk{surf/med/reg} )
############################################################################
### recent changes
# squish radios: frame: -padx 0, radiobutton: -bd 0 (def=2)
# changed menubind to allow override hotkey annotation (Mac diff def alt/opt)
# update/simplify to 8.5-style fonts to fix disastrous MacOSX 10.6 appearance
# 26j: arial 12 hfont for tighter hlist/cbx, keep entries looser lucidatypwriter
# helvetica 14,15 bold -> arial bold because Mac Helvetica too thick (old same!)
# lucidatypewriter -> arial (all arial)
# TODO: RH9-compiled w/copied libs antialiased vs F15 compiled is not?!
# font actual <font> => diff results local/remote, compile same code RH9/F15
# helpwin one row longer, add ifont
# add success/fail return to testreplace
# new font mess that checks Mac kernel version
# menuacceltxt just hotkey text (was menubind always overriden), add menuflash
# added possibility of sending text to helpwin via variable (was just file)
# helpwin panel reports helpfile name (if std location)
# add -selectForeground black to wrappers.tcl fixcolors for *.e
# added confirmalert-like non-overlap okreplace name (sphavg change sub err)
# add menurmlast proc for menu adjust (address by name, ignore if not last)
# rm dolighting back compat proc (needed to run tksurfer2000)
# avoid name overlap for okreplace window
# tmpcontrols puts checkbox if variable ends in *flag, accepts var "whitespace"
# helpwin: allow insert one inline (350 wide) or right side (650 tall) gif img
# allow testreplace to accept args for function to use if okreplace says go
# fixcolor controls, extend controls, tmpcontrols to wrapper, multiple OK
# rm lsb_release (buc09 crash!) -- unused find Linux release
# fix fixcolors to (mostly) check widget type w/winfo class
# controls entries/checks: bind Return, locREDRAW|redrawbutton|redraw
# add open/write/close interface cmds log (not really widget wrappers...)
# testreplace uses logcmd (wraps most interface button commands)
# add canwriteormake, foundbywhich, cleanup/reorder/comment
# proc controls does logcmd's
# add shrinkcomboarrows (for Fedora)
# incr okclose win name (crash 2 wins from double-click upper left 'x')
# add shrinkcomboarrows "more" (for tkmedit.tcl), fix /tmp/issue typo (Fedora)
# hack fix for weird giant Helvetica 14 on Fedora (2x size of 13 point!)
#  ---- csurfsrc-140624.tgz ----
# new positionpopup def pos above root win so visible when root in front
#  ---- csurfsrc-150220.tgz ----
# use join to flatten list of args passed by testreplace
# change default helpwin rows from 11 -> 18
#  ---- csurfsrc-150310.tgz ----
# positionpopup returns position
#  ---- csurfsrc-150823.tgz ----
# helpwin: just raise helpwin if already there (was create copy)
# intercept killbox in tmpcontrols so main win not dead after corner kill
# undo intercept killbox in controls (caller should save f, explicitly kill win)
#  ---- csurfsrc-150910.tgz ----
# deprecate tmpcontrols (rm'd from tcl scripts)
# helpwin: fix $loc="varnotfile" broken by just raise add filename to winname
#  ---- csurfsrc-150922.tgz ----
# helpwin -inactiveselectbackground $bgcol to avoid black on de-focus
#  ---- csurfsrc-151010.tgz ----
# allow abs helpfile name -- for tk{surfer,medit,register} in csurf subdir
#  ---- csurfsrc-151120.tgz ----
# add search to help panels (Cmd-f, NEXT==<Ret>==Cmd-g) (40 lines)
# rename ifont->ifontb, add ifont
# move replchar from csurf to here (now needed in helpwin for tksurfer etc)
# helpwin: strip periods from helpfile name (b/c used as window path)
# helpwin: fix alt-f to work on Linux
# helpwin: fix alt-f,g to work on Linux
# helpwin: OK kills search panel like "x"
# helpwin: focus on helptext, position cursor beginning
# helpwin: selected text widget help black on linux
# helpwin: focus on helptext, position cursor beginning
# make xcmd/cmdkey global here (rm in csurf/tk{surf,med,reg,str})
# confirmalert text now selectable (textwidget, $usetextw=0 to revert to orig)
# okreplace indents filename
# confirmalert back to $bgcol w/barely visible frame indicating selectable
#  ---- csurfsrc-151230.tgz ----
# make foundbywhich work with compound paths (fixes File->NOTES linux bug)
# foundbywhich: strip to tail in string match else not found Mac (fix prev)
#  ---- csurfsrc-160130.tgz ----
# rename tmpcontrols => modalcontrols, killbox => killboxOK
# helpwin: add linux/mac find/next help to right of title
# always print report except from csurf
#  ---- csurfsrc-160624.tgz ----
#  ---- csurfsrc-161004.tgz ----
#  ---- csurfsrc-161217.tgz ----
#  ---- csurfsrc-170320.tgz ----
#  ---- csurfsrc-170621.tgz ----
# default testclose (usu. overwritten) so kill win works w/just wrappers.tcl
# positionpopup can now just return position
#  ---- csurfsrc-171018.tgz ----
#  ---- csurfsrc-180125.tgz ----
#  ---- csurfsrc-180621.tgz ----
# linux release also chk /etc/*-release to fix CentOS7 giant menu helv14
# new buttonbar proc for no-arg command list (only one allowed)
#  ---- csurfsrc-190208.tgz ----
# finish quote/eval buttoncmd for cmd w/arg(s)
# add proc backslashspaces
# add proc lbackslashspaces
#  ---- csurfsrc-190722.tgz ----
# add opt confirmalert fixed height (wrapped lines, N.B.: already linecnt-sens)
#  ---- csurfsrc-190722.tgz ----
# add purple/unpurple hack to main button in controls proc
# okreplace w/o altmsg checks whether file exists, changes message
# okreplace debug msgs: if (1) absfilename is dir, (2) parent doesn't exist
# block white text: -selectforeground black for proc controls entry
#  ---- csurfsrc-191216.tgz ----
#  ---- csurfsrc-200629.tgz ----
# click RUNNING in .controls sets new global purplekillcontrols
# helpwin: check already exists again for period subst'd out of win name
# okreplace allows alt "Cancel" button text
# okreplace allows alt "REPLACE" box text (e.g., PROCEED)
#  ---- csurfsrc-210614.tgz ----
# optional title for buttonbar
# allow multiple buttonbar's uniq'ed by first command proc
# new optional arg to buttonbar to bind helpfile
# position buttonbar,controls left of tk panel, helpwin up/right over GLX
# add thin space for buttonbar, helpwin lower
# helpwin: panel moved less right for narrower tksurfer F3, tkmedit GL win
# controls,buttonbar: mv panel below GL win if F3 b/c tksurfer F3 panel to top
# controls,buttonbar: mv panel right of tk panel for far left tkmedit startup
#  ---- csurfsrc-220324.tgz ----
#  ---- csurfsrc-221002.tgz ---- (26oh)
#  ---- csurfsrc-230925.tgz ---- (26oi)
#  ---- csurfsrc-240426.tgz ---- (26oj)
#  ---- csurfsrc-241112.tgz ---- (26ok)
# controls proc: uniq window id from new global: $ctrlswinid
#  ---- csurfsrc-250507.tgz ---- (26ol)
#  ---- csurfsrc-250917.tgz ---- (26om)
# controls proc: allows "whitespace" (use proc null)
#  ---- csurfsrc-260108.tgz ---- (26on)
#  ---- csurfsrc-260502.tgz ---- (26on) (above got off)




#TODO: 1) fix fixcolors to also explicitly set label/frame/Menu defaults
#TODO: 2) explicit col args here/csurf/tk{reg/med/surf} -> avoid fixcolors!

#############################################################################
# globals (non-font/color): tmpdir, prompt, program, log, cmdkey
#############################################################################
### report
set p 1
if { [info exists program] && $program == "csurf" } { set p 0 }
if {$p} {puts "wrappers.tcl: fonts/entries/radios/menus/popups defaults (26oo)"}
unset p

### check global tmpdir
if { [info exists subjtmpdir] && ![file writable $subjtmpdir] } {
  set subjtmpdir /tmp/surfer.tmp.$env(USER)   ;# $env(USER)-[pid]
  if { ![file exists $subjtmpdir] } { exec mkdir $subjtmpdir } ;# else exists
}

### 7 other globals
if ![info exists promptflag] { set promptflag 0 }
if ![info exists program] { set program unknown }  ;# set by interface code
set logid -1      ;# optional log of tcl equiv of interface commands
set xcmd Alt      ;# arg for tk bind
set cmdkey Alt    ;# public name of key
if { [exec uname] == "Darwin" } { set xcmd Meta; set cmdkey Cmd }
set purplekillcontrols 0
set ctrlswinid 0  ;# for uniq-named popup windows

#############################################################################
# global interface fonts
#############################################################################
### uncomment/set fonts here to override font-choosing mess below
## thin fonts
#set sfont   {helvetica -10}             ;#scaleentries, oth
#set ffont   {helvetica -12}             ;#entries/chkbuts
#set hfont   {helvetica -12}             ;#hlist/cbx/cfgbuts
#set mfont   {helvetica -14}             ;#menu
#set ifont   {helvetica -12 italic}      ;#allhelp
## bold fonts
#set ffontb  {helvetica -12 bold}        ;#boldbuts
#set ffontbb {helvetica -15 bold}        ;#bigboldbut
#set pfont   {helvetica -14 bold}        ;#process
#set tfont   {helvetica -12 bold}        ;#tixlabelentry
#set ifontb  {helvetica -12 bold italic} ;#combotitles

### fonts (after: tix resetoptions TixGray 12Point)
# [tix option get bold_font] =>
#   tixwish4.1.7.4:       -*-helvetica-bold-r-normal-*-12-*-*-*-*-*-*-*
#   wish8.5+libTix8.4.3:  helvetica -12 bold   ;#neg->pix!pts, =tixwish8.1.8.4
# [tix option get italic_font] =>
#   tixwish4.1.7.4:       -*-helvetica-bold-o-normal-*-12-*-*-*-*-*-*-*
#   wish8.5+libTix8.4.3:  helvetica -12 bold italic

### sys (Linux,Darwin), kern (Linux:2,3 Mac:8,9,10,11), release (Fedora,Ubuntu)
set mainsyst [exec uname]
set mainkvers \
  [string range [exec uname -r] 0 [expr [string first . [exec uname -r]] - 1]]
set mainrelease Unknown  ;# N.B.: value for all Mac
if {$mainsyst == "Linux"} {
  set rellist "/etc/issue [glob /etc/*-release]"
  set found 0
  foreach f $rellist { if [file exists $f] { set found 1; break } }
  if {$found} {
    if ![catch { eval exec grep Fedora   $rellist }] {set mainrelease Fedora  }
    if ![catch { eval exec grep CentOS   $rellist }] {set mainrelease CentOS  }
    if ![catch { eval exec grep Ubuntu   $rellist }] {set mainrelease Ubuntu  }
    if ![catch { eval exec grep Debian   $rellist }] {set mainrelease Debian  }
    if ![catch { eval exec grep Mint     $rellist }] {set mainrelease Mint    }
    if ![catch { eval exec grep Mageia   $rellist }] {set mainrelease Mageia  }
    if ![catch { eval exec grep OpenSUSE $rellist }] {set mainrelease OpenSUSE}
  }
  unset rellist f found
}

### choose fonts
if { $tcl_version > 8.3 } { ;# new tk8 font mess
  ## default (safe:Tk->Helvetica/Times/Courier,Xft->sans-serif/serif/monospace)
  set defthinfont helvetica
  set defboldfont helvetica
  ## Linux (TODO: would req detect kernel sub-sub-version: 2.6.38...)
  if {$mainsyst == "Linux"} {
    set defthinfont arial
    set defboldfont arial
  }
  ## Mac 10.4
  if {$mainsyst == "Darwin" && $mainkvers == 8} {
    set defthinfont helvetica
    set defboldfont helvetica
  }
  ## Mac 10.5, 10.6
  if {$mainsyst == "Darwin" && $mainkvers >= 9 && $mainkvers <= 10} {
    set defthinfont arial   ;# Xft+Helvetica -> extremely over-bold
    set defboldfont arial
  }
  ## Mac 10.7
  if {$mainsyst == "Darwin" && $mainkvers == 11} {
    set defthinfont arial
    set defboldfont helvetica
  }
  ## Xft not compiled into tk: uses bitmap (most reliable!) -- override above
  if { [catch {::tk::pkgconfig get fontsystem} xft] } {
    set defthinfont helvetica
    set defboldfont helvetica
  }
  ## do thin
  if { $defthinfont == "helvetica" } {
    if ![info exists sfont] {set sfont {helvetica -10} } ;#scaleentries,othsm
    if ![info exists ffont] {set ffont {helvetica -12} } ;#entries/chkbuts
    if ![info exists hfont] {set hfont {helvetica -12} } ;#hlist/cbx/cfgbuts
    if ![info exists mfont] {set mfont {helvetica -14} } ;#menu
    if ![info exists ifont] {set ifont {helvetica -12 italic} } ;#allhelp
  }
  if { $defthinfont == "arial" } {
    if ![info exists sfont] {set sfont {arial -10} } ;#scaleentries,othsm
    if ![info exists ffont] {set ffont {arial -12} } ;#entries/chkbuts
    if ![info exists hfont] {set hfont {arial -12} } ;#hlist/cbx/cfgbuts
    if ![info exists mfont] {set mfont {arial -14} } ;#menu
    if ![info exists ifont] {set ifont {arial -12 italic} } ;#allhelp
  }
  ## do bold
  if { $defboldfont == "helvetica" } {
    if ![info exists ffontb]  {set ffontb  {helvetica -12 bold} } ;#boldbuts
    if ![info exists ffontbb] {set ffontbb {helvetica -15 bold} } ;#bigboldbuts
    if ![info exists pfont] {set pfont {helvetica -14 bold} } ;#process
    if ![info exists tfont] {set tfont {helvetica -12 bold} } ;#tixlabelentry
    if ![info exists ifontb] {set ifontb {helvetica -12 bold italic}};#combotitl
  }
  if { $defboldfont == "arial" } {
    if ![info exists ffontb]  {set ffontb  {arial -12 bold} } ;#boldbuts
    if ![info exists ffontbb] {set ffontbb {arial -15 bold} } ;#bigboldbuts
    if ![info exists pfont] {set pfont {arial -14 bold} } ;#process
    if ![info exists tfont] {set tfont {arial -12 bold} } ;#tixlabelentry
    if ![info exists ifontb] {set ifontb {arial -12 bold italic}};#combotitles
  }
} else {  ;### old tk4.0 font mess
  if ![info exists sfont] { set sfont \
    -b&h-lucidatypewriter-medium-r-normal-sans-10-100-75-75-m-60-iso8859-* }
  if ![info exists ffont] { set ffont \
    -b&h-lucidatypewriter-medium-r-normal-sans-12-120-75-75-m-70-iso8859-* }
  if ![info exists ffontb] { set ffontb \
    -b&h-lucidatypewriter-bold-r-normal-sans-12-120-75-75-m-70-iso8859-* }
  if ![info exists ffontbb] { set ffontbb \
    -*-helvetica-bold-o-normal-*-15-*-*-*-*-*-*-* }   ;#large (italic/oblique)
  if ![info exists mfont] { set mfont \
    -*-helvetica-medium-r-normal-*-13-*-*-*-*-*-*-* } ;#menu: 12bold,13med,14med
  if ![info exists ifont] { set ifont \
    -*-helvetica-bold-o-normal-*-12-*-*-*-*-*-*-* }   ;#std (italic/oblique)
  if ![info exists pfont] { set pfont \
    -*-helvetica-bold-r-normal-*-14-*-*-*-*-*-*-* }   ;#process, some OK's, hemi
  if ![info exists tfont] { set tfont \
    -*-helvetica-bold-r-normal-*-12-*-*-*-*-*-*-* }   ;#tixLabelEntry default
  if ![info exists ifontb] { set ifontb \
    -*-helvetica-bold-o-normal-*-12-*-*-*-*-*-*-* }   ;#combo titles
  ## check/substitute missing
  label .fonttestwidget
  if [catch { .fonttestwidget config -font [set sfont] } ] {
    set sfont -b&h-lucidatypewriter-medium-r-normal-sans-10-*-*-*-*-*-*-*
  }
  if [catch { .fonttestwidget config -font [set ffont] } ] {
    set ffont -b&h-lucidatypewriter-medium-r-normal-sans-12-*-*-*-*-*-*-*
  }
  if [catch { .fonttestwidget config -font [set ffontb] } ] {
    set ffontb -b&h-lucidatypewriter-bold-r-normal-sans-12-*-*-*-*-*-*-*
  }
  if [catch { .fonttestwidget config -font [set sfont] } ] {
    set sfont -b&h-lucidatypewriter-medium-r-normal-sans-11-*-*-*-*-*-*-*
  }
  if [catch { .fonttestwidget config -font [set ffont] } ] {
    set ffont -b&h-lucidatypewriter-medium-r-normal-sans-11-*-*-*-*-*-*-*
  }
  if [catch { .fonttestwidget config -font [set ffontb] } ] {
    set ffontb -b&h-lucidatypewriter-bold-r-normal-sans-11-*-*-*-*-*-*-*
  }
  # large
  if [catch { .fonttestwidget config -font [set ffontbb] } ] {
    set ffontbb -*-helvetica-bold-o-normal-*-14-*-*-*-*-*-*-*
  }
  if [catch { .fonttestwidget config -font [set mfont] } ] {
    set mfont -*-helvetica-medium-r-normal-*-14-*-*-*-*-*-*-*
  }
  set hfont $ffont
  destroy .fonttestwidget
}

### system-dependent squish combobox arrows
proc shrinkcomboarrows { {amount some} } {  ;# defheight=18, defwidth=15
  global mainrelease

  if {$amount == "some"} {  ;# tksurfer.tcl
    set height 17
    set width 13
    if { $mainrelease == "Fedora" ||
         $mainrelease == "CentOS" } { set height 14 }
  }
  if {$amount == "more"} {  ;# tkmedit.tcl
    set height 15
    set width 11
    if { $mainrelease == "Fedora" ||
         $mainrelease == "CentOS" } { set height 13 }
  }
  foreach win [info commands .*] {
    if [string match *:root $win] { continue }  ;# winfo: bad window path name
    set wclass [winfo class $win]
    if { $wclass == "TixComboBox" } {
      $win subwidget arrow config -height $height
      $win subwidget arrow config -width $width
    }
  }
}

#############################################################################
# global interface colors
#############################################################################
#set tk_strictMotif 1
set bgcol       #c5c5bd    ;# tan (slightly yellow) (#ccccbd)
set actbgcol    #ececec    ;# default=#ececec(gray)
set hilbgcol    #c5c5bd    ;# same as bg
set hilcol      #333333    ;# offblack selcol
set selcol      green      ;# check/radio itself
if {$tcl_version > 7.9} {
  set selcol    white      ;# black check/radio on this background
}
set selbgcol    lightgreen ;# lightblue, lightgreen
set entbgcol    #e9e9e9    ;# dfdfdf=origtoodark, e9e9e9=good, f3f3f3=gray95
set runbgcol    #b365ff    ;# darkor, #982dff(pr), #b365ff(lpr)
set runactbgcol #cc9aff    ;# orang, #b365ff(lpr), #cc9aff(llpr)
set menubg      $entbgcol
set menuactbg   #b2c2b2    ;# #d7afff(lllpr), selbgcol, #85a385, #b2c2b2(grygrn)
set menuchk     green      ;# bounded box in menu, #006000(dkgrn), green
if {$tcl_version > 7.9} {
  set menuchk   black      ;# black check (green check not visible)
}

### adjust colors after widgets made, lookup widget class
proc fixcolors { } {
  global bgcol actbgcol hilbgcol hilcol selcol selbgcol entbgcol
  foreach win [info commands .*] {
    if [string match *:root $win] { continue }  ;# winfo: bad window path name
    set wclass [winfo class $win]
    ### winfo classes after filter :root
    # tk: Checkbutton, Radiobutton, Entry, Button
    # tk: Tk, Frame, Label, Listbox, Text, Scale, Scrollbar, Menubutton, Menu
    # tix: Csurf, TixComboBox, TixLabelFrame, TixScrolledListBox, TixSelect 
    if [string match .mbar* $win] { continue }  ;# skip only some class "Menu"
    if [string match *.shell $win] { continue } ;# cbx: no -highlightbackground
    $win config \
      -background $bgcol -highlightbackground $hilbgcol -highlightcolor $hilcol 
    if { $wclass == "Checkbutton" } {
      $win config -selectcolor $selcol
    }
    if { $wclass == "Radiobutton" } {
      $win config -selectcolor $selcol
    }
    if { $wclass == "Entry" } {
      $win config -background $entbgcol -selectbackground $selbgcol \
        -selectforeground black  ;# last:linux
    }
    if { $wclass == "Button" } {
      $win config -activebackground $actbgcol
    }
  }
}

#############################################################################
# tksurfer lights: uncomment to reset default lights brightness,position
#############################################################################
## background gray
#set offset 0.30
## from eye
#set light0   0.4   ;# (0.4) brightness
#set light0x  0.0   ;# (0.0) x position
#set light0y  0.0   ;# (0.0) y position
#set light0z  1.0   ;# (1.0) z position
## from behind brain
#set light1   0.0   ;# (0.0) brightness (OFF!)
#set light1x  0.0   ;# (0.0) x position
#set light1y  0.0   ;# (0.0) y position
#set light1z -1.0   ;#(-1.0) z position
## from upper right
#set light2   0.8   ;# (0.8) brightness
#set light2x  0.6   ;# (0.6) x position
#set light2y  0.6   ;# (0.6) y position
#set light2z  1.6   ;# (1.6) z position
## from left
#set light3   0.2   ;# (0.2) brightness
#set light3x -1.0   ;#(-1.0) x position
#set light3y  0.0   ;# (0.0) y position
#set light3z  0.0   ;# (0.0) z position

#############################################################################
# tabbed tk widget wrappers
#############################################################################
### tabbed row or column of labeled entries
proc edlabval { frame label defvalue rwflag tab width {rowcol col} } {
  global ffont ffontb
  set f [frame $frame.$label]
  if { $rowcol == "row" } { set side left }
  if { $rowcol == "col" } { set side top  }
  pack $f -side $side -fill x -padx 2
  if { ![string match none* $label] } {
    label $f.la -text $label: -width $tab -anchor e -font $ffont
    pack $f.la -side left
  }
  entry $f.e -font $ffont -width $width ;# -textvariable textvariable
  $f.e config -selectbackground green -insertbackground black
  $f.e insert 0 $defvalue
  pack $f.e -side left -fill x
  if { $rwflag == "rw" } {
    button $f.br -text READ -font $ffontb -pady 0
    pack $f.br -side left
    button $f.bw -text WRITE -font $ffontb -pady 0
    pack $f.bw -side right
  }
  if {$rwflag == "w"} {
    button $f.bw -text WRITE -font $ffontb -pady 0
    pack $f.bw -side right
  }
  if {$rwflag == "r"} {
    button $f.br -text READ -font $ffontb -pady 0
    pack $f.br -side left
  }
  if {$rwflag == "s"} {
    button $f.bs -text SET -font $ffontb -pady 0
    pack $f.bs -side right
  }
  if {$rwflag == "n"} {
    return
  }
}

### tabbed row or column of radiobuttons
proc radios { frame title radiolabel variable value titlewidth rowcol } {
  global ffont ffontb tfont tcl_version
  if { $rowcol == "row" } { set side left }
  if { $rowcol == "col" } { set side top  }
  set f [frame $frame.a$radiolabel]  ;# 'a' prefix to force lower case
  pack $f -side $side -fill x -padx 0  ;# was -padx 2
  if { [string length $title] > 0 } {
    if {$tcl_version > 8.3} {
      label $f.la -text $title: -width $titlewidth -anchor e -font $tfont
    } else {
      label $f.la -text $title: -width $titlewidth -anchor e -font $ffontb
    }
    pack $f.la -side $side
  }
  set rbd 0
  if {$tcl_version < 7.9} { set rbd 2 }
  radiobutton $f.ra -text $radiolabel -variable $variable -value $value \
     -font $ffont -bd $rbd   ;# default (-bd 2) -> -bd 0 for denser
  pack $f.ra -side $side -anchor w
}

### tabbed row or column of checkbuttons
proc checks { frame title checklabel variable rowcol } {
  global ffont ffontb
  if { $rowcol == "row" } { set side left }
  if { $rowcol == "col" } { set side top }
  set f [frame $frame.a$checklabel]   ;# lower case
  pack $f -side $side -fill x -padx 2  ;# should toggle w/rowcol, also anchor
  if { [string length $title] > 0 } {  ;# used only once!
    label $f.la -text $title: -width 12 -anchor e -font $ffontb ;# fixed width
    pack $f.la -side $side
  }
  checkbutton $f.ck -text $checklabel -variable $variable -font $ffont
  if { $rowcol == "col" } { $f.ck config -anchor w }
  pack $f.ck -side $side -fill x
}

### tabbed row or column of buttons
proc buttons { frame buttonlabel function rowcol {pady 2} {padx 11} } {
  global ffontb
  if { $rowcol == "row" } { set side left }
  if { $rowcol == "col" } { set side top }
  set f [frame $frame.a$buttonlabel]  ;# lower case
  pack $f -side $side -fill x
### works, but butt-rename-len-chg bad for gen butt row, mv->controls (1-butt)
#  # purple/disable/rename butt b/c takes a while
#  global bgcol runbgcol
#  set origfunction $function
#  set function \
#    "$f.bu config -text RUNNING \
#      -background $runbgcol -disabledforeground black -state disabled; \
#    update idletasks; \
#    $origfunction; \
#    $f.bu config -text $buttonlabel -background $bgcol -state normal"
  button $f.bu -text $buttonlabel -font $ffontb -command "$function" \
     -pady $pady -padx $padx
  pack $f.bu -side $side
}

#############################################################################
# popups
#############################################################################
### placeholder funct typically overwritten w/version w/app-specific tests
proc testclose { } {
  destroy .
  exit
}

### popup to allow cancel overwrite, alt msg/lab, midbut for generic interrupt
proc okreplace { absfilename {altmsg none} {altretlabel none} {midbut none}
                {altcancellabel none } {altboxlabel none } } {
  global userok pfont ffontbb bgcol entbgcol

  # HOWTO use for simple confirm overwrite
  #   default msg: "This file: $filename already exists. Replace it?"
  #   if [okreplace /tmp/somefile] { overwrite }
  # HOWTO use for confirm overwrite with alt message :
  #   if [okreplace /tmp/somefile "A different message"] { overwrite }
  # HOWTO use for do-it/cancel panel for one action:
  #   if [okreplace "" "OK to Do?" "Do-Button Text"] { action } else { cancel }
  # HOWTO use for do-it/cancel panel for one action w/alt cancel button:
  #   if [okreplace ""
  #       "OK to Skip?" "OK to Do" none "Skip" ] { action } else { cancel }
  # HOWTO use for 3-way action, alternate action, cancel:
  #   set resp [okreplace "" "message" "action1rightbutt" "action2midbutt"]
  #   if {$resp == 0} { ; }  ;# cancel
  #   if {$resp == 1} { ; }  ;# action1
  #   if {$resp == 2} { ; }  ;# action2

  set fileexistsflag 0
  set parentexistsflag 0
  set parent [file dirname $absfilename]  ;# N.B.: file dirname "" -> "."
  if [file exists $absfilename] {
    set parentexistsflag 1
    set fileexistsflag 1
    if [file isdirectory $absfilename] {
      confirmalert "okreplace: ### $absfilename is a directory, not a file"
      set userok 0
      return $userok
    }
  } else {
    if [file exists $parent] {
      set parentexistsflag 1
    }
  }
  if {$altmsg == "none" && !$parentexistsflag} {
    confirmalert "okreplace: ### $absfilename parent doesn't exist"
    set userok 0
    return $userok
  }

  set nm .okreplace
  while {[info commands $nm] == "$nm"} {set nm ${nm}x}
  set f [toplevel $nm -borderwidth 10]
  positionpopup $f
  wm protocol $f WM_DELETE_WINDOW killboxOK
  set boxlabel REPLACE
  if {$altboxlabel != "none"} { set boxlabel $altboxlabel }
  label \
    $f.la -text $boxlabel -font $ffontbb -bd 2 -relief groove -padx 7 -pady 7 
  if {$altmsg == "none"} {
    if {$fileexistsflag} {
      set msgtext "The file:\
               \n\n    $absfilename\
               \n\nalready exists.\
               \n\nReplace it?"
    } else {
      set msgtext "The file:\
               \n\n    $absfilename\
               \n\ndoesn't exist.\
               \n\nCreate it?"
      $f.la config -text CREATE
    }
  } else {
    set msgtext $altmsg  ;# N.B.: caller should check if files exists
  }
  message $f.msg -text $msgtext -font $pfont -width 420 -padx 25 -pady 20
  set b [frame $f.buttons -borderwidth 10]
  pack $f.la -side top -anchor w
  pack $f.msg $f.buttons -side top -fill x
  set cancelbut Cancel
  if {$altcancellabel != "none"} { set cancelbut $altcancellabel }
  button $b.cancel -text "$cancelbut" -font $pfont -command {set userok 0} \
    -highlightbackground $bgcol
  if {$midbut != "none"} {
    button $b.mid -text "$midbut" -font $pfont -command {set userok 2} \
      -highlightbackground $bgcol
  }
  if {$altretlabel == "none"} {
    if {$fileexistsflag} { set rettext Replace } else { set rettext Create }
  } else {
    set rettext $altretlabel
  }
  button $b.replace -text "$rettext" -font $pfont -command {set userok 1} \
    -highlightbackground $bgcol
  pack $b.replace -side right -padx 5 -anchor e
  if {$midbut != "none"} {pack $b.mid -side right -padx 5 -anchor e}
  pack $b.cancel -side right -padx 5 -anchor e
  bind .okreplace <Control-c> {set userok 0}
  bind .okreplace <Return> {set userok 1}
  foreach win "$f $f.msg $f.buttons" { $win configure -background $bgcol }
  foreach win "$f.la $b.cancel $b.replace" { $win configure -bg $entbgcol }
  if {$midbut != "none"} {$b.mid configure -bg $entbgcol}
  tkwait visibility $f
  wm protocol . WM_DELETE_WINDOW killboxOK  ;# rootwin kill is cancel
  if { [exec uname] != "Linux" } { raise $f }
  focus $f
  grab $f
  tkwait variable userok
  grab release $f
  destroy $f
  wm protocol . WM_DELETE_WINDOW testclose  ;# re-arm rootwin
  return $userok
}

### popup to allow cancel save edited file (curr use: only tkmed/reg testclose)
proc okclose { absfilename } {
  global userok pfont ffontbb bgcol entbgcol

  set file [file tail $absfilename]
  set dir [file dirname $absfilename]
  set nm .okclose
  while {[info commands $nm] == "$nm"} {set nm ${nm}x}
  set f [toplevel $nm -borderwidth 10]
  positionpopup $f
  wm protocol $f WM_DELETE_WINDOW killboxOK
  label $f.la -text CLOSE -font $ffontbb -bd 2 -relief groove -padx 7 -pady 7 
  set msgtext "Save changes to $file?"
  #message $f.msg -text $msgtext -font $pfont -width 280 -padx 50 -pady 20
  message $f.msg -text $msgtext -font $pfont -width 370 -padx 30 -pady 20
  set b [frame $f.buttons -borderwidth 10]
  pack $f.la -side top -anchor w
  pack $f.msg $f.buttons -side top -fill x
  button $b.cancel -text "Cancel" -font $pfont -command {set userok 0} \
    -highlightbackground $bgcol
  button $b.dontsave -text "Don't Save" -font $pfont -command {set userok 1} \
    -highlightbackground $bgcol
  button $b.save -text "Save" -font $pfont -command {set userok 2} \
    -highlightbackground $bgcol
  pack $b.save $b.dontsave $b.cancel -side right -padx 5 -anchor e
  bind $f <Control-c> {set userok 0}
  bind $f <Return> {set userok 2}
  foreach win "$f $f.msg $f.buttons" { $win config -background $bgcol }
  foreach win "$f.la $b.cancel $b.dontsave $b.save" {$win config -bg $entbgcol}
  tkwait visibility $f
  wm protocol . WM_DELETE_WINDOW killboxOK  ;# rootwin kill is cancel
  if {[exec uname] != "Linux"} {raise $f} ;# 4dwm mouse focus (rootwin killbox)
  focus $f
  grab $f
  tkwait variable userok
  grab release $f
  destroy $f
  wm protocol . WM_DELETE_WINDOW testclose  ;# re-arm rootwin
  return $userok
}

### no-action message popup
proc confirmalert { msg {fixedhei -1} } {
  global userok pfont ffontbb bgcol entbgcol
  global selbgcol ffontbb

  set nm .confirm
  while {[info commands $nm] == "$nm"} {set nm ${nm}x}
  set f [toplevel $nm -borderwidth 10]
  positionpopup $f
  wm protocol $f WM_DELETE_WINDOW killboxOK  ;# killbox break hang sends userok
  label $f.la -text ALERT -font $ffontbb -bd 2 -relief groove -padx 7 -pady 7 
  pack $f.la -side top -anchor w
  ## text (selectable) vs. orig label
  set usetextw 1  ;# 0 to revert
  if {$usetextw} { ;#count CRs overrides min hei, inactive/selectable textwidget
    set hei 6
    set j [string first "\n" $msg 0]
    if {$j != -1} {
      set i 0
      while {$j != -1 } { set j [string first "\n" $msg [incr j]]; incr i }
      if {$i > 5} { set hei [expr $i + 2] }
    }
    if {$fixedhei != -1} { set hei $fixedhei }  ;# override linecnt sens: wrap
    # alt: -bg lightgray -highlightbackground $bgcol
    text $f.msg -width 55 -height $hei -font $ffontbb -borderwidth 3 \
      -bg $bgcol -selectbackground $selbgcol -highlightbackground darkgray \
      -inactiveselectbackground $selbgcol -selectforeground black \
      -relief flat -highlightthickness 1 -yscrollcommand "$f.scroll set" -bd 10
    scrollbar $f.scroll -command "$f.msg yview" -highlightbackground $bgcol
    pack $f.scroll -side right -fill y
    $f.msg insert end $msg
    $f.msg config -state disabled
    pack $f.msg -side top -fill x -padx 10 -pady 10
  } else {  ;# orig
    message $f.msg -text $msg -font $pfont -width 500 -padx 20 -pady 10 ;# 30,20
    pack $f.msg -side top -fill x
    $f.msg config -bg $bgcol
  }
  set b [frame $f.buttons -borderwidth 10]
  pack $f.buttons -side top -fill x
  button $b.cancel -text "OK" -font $pfont -command {set userok 0} \
    -highlightbackground $bgcol
  pack $b.cancel -side right -padx 5 -anchor e
  bind $f <Control-c> {set userok 0}
  bind $f <Return> {set userok 0}
  foreach win "$f $b" { $win config -background $bgcol }
  foreach win "$f.la $b.cancel" { $win config -background $entbgcol }
  tkwait visibility $f
  wm protocol . WM_DELETE_WINDOW killboxOK  ;# rootwin kill is cancel
  if { [exec uname] != "Linux" } { raise $f }
  focus $f
  #grab $f   ;# errors if another app grabs
  tkwait variable userok
  #grab release $f
  destroy $f
  wm protocol . WM_DELETE_WINDOW testclose  ;# re-arm rootwin
  return $userok
}

### help window, maybe containing image (loc=std/varnotfile,impos=inline/right)
proc helpwin { helpfile \
                 {cols 50} {rows 18} {loc std} {imgfile none} {impos right} } {
  global env ffont ffontbb pfont program bgcol entbgcol selbgcol
  global find currtxtind xcmd cmdkey tksurferinterface tkmeditinterface

  set varflag 0
  set boxlab HELP
  if {$loc == "std"} {
    set nm .help-$helpfile
    if [winfo exists .help-$helpfile] { raise .help-$helpfile; return }
    if [string match /* $helpfile] {
      set boxlab "$boxlab  ([file tail $helpfile])"
    } else {
      set boxlab "$boxlab  ($helpfile)"
      set helpfile $env(CSURF_DIR)/lib/help/$program/$helpfile
    }
    if {"$imgfile" != "none"} {
      set imgfile $env(CSURF_DIR)/lib/help/$program/$imgfile  
    }
  } elseif {$loc == "varnotfile"} {
    set nm .help
    while {[info commands $nm] == "$nm"} {set nm ${nm}x}
    set varflag 1
  } else {
    set nm .help-$helpfile
    if [winfo exists .help-$helpfile] { raise .help-$helpfile; return }
    set boxlab "$boxlab  ($helpfile)"
    set helpfile $loc/$helpfile
    if {"$imgfile" != "none"} { set imgfile $loc/$imgfile }
  }
  if {!$varflag} { if [catch {open $helpfile} ret] { return } }
  set nm [replchar $nm "." "_"]        ;# strip periods b/c tcl winpath
  set nm [string replace $nm 0 0 "."]  ;# restore init period
  if [winfo exists $nm] { raise $nm; return }  ;# again, in case subst'd

  set f [toplevel $nm -borderwidth 10]
  positionpopup $f
  wm resizable $f 0 1
  frame $f.ti -bg $bgcol
  frame $f.ti.l -bg $bgcol
  frame $f.ti.r -bg $bgcol
  pack $f.ti -side top -anchor w -fill x
  pack $f.ti.l -side left -anchor w -fill x
  pack $f.ti.r -side right
  label $f.ti.l.la -text $boxlab -font $ffontbb -bd 2 -relief groove \
    -padx 7 -pady 7 -bg $entbgcol
  pack $f.ti.l.la -side left -anchor w
  label $f.ti.r.la -text "(find: $cmdkey-F)" -font $ffont -bg $bgcol -pady 0
  label $f.ti.r.la2 -text "(next: $cmdkey-G)" -font $ffont -bg $bgcol -pady 0
  pack $f.ti.r.la $f.ti.r.la2 -side top -pady 0

  frame $f.t
  text $f.t.txt -width $cols -height $rows -font $ffont \
    -borderwidth 3 -relief flat -setgrid true -selectbackground $selbgcol \
    -yscrollcommand "$f.t.scroll set" -highlightbackground black -bg white \
    -inactiveselectbackground $selbgcol -selectforeground black
  scrollbar $f.t.scroll -command "$f.t.txt yview" -highlightbackground $bgcol
  pack $f.t.scroll -side right -fill y
  pack $f.t.txt -side left -expand true -fill y
  pack $f.t -side top -expand true -fill y
  $f.t.txt config -state normal
  if {$varflag} {
    $f.t.txt insert end $helpfile
  } else {
    set id [open $helpfile]
    $f.t.txt insert end [read $id]
    if {$imgfile != "none" && $impos == "inline" && [file exists $imgfile] } {
      set img [image create photo -file $imgfile]  ;# 350 pix wide gif
      $f.t.txt image create end -image $img
    }
    close $id
  }
  if {$imgfile != "none" && $impos == "right" && [file exists $imgfile] } {
    set img [image create photo -file $imgfile]  ;# 650 pix high gif
    label $f.t.img -image $img
    pack $f.t.img -side right
  }
  set b [frame $f.but -borderwidth 1]
  pack $b -side right
  button $b.ok -text "OK" -font $pfont -command "destroy $f .onefindpanel" \
    -highlightbackground $bgcol -bg $entbgcol -padx 10 -pady 1
  pack $b.ok -side right -padx 5 -anchor e
  foreach win "$f $f.but $f.t.scroll" { $win config -bg $bgcol }
  bind $nm <Return> "destroy $f"
  bind $nm <Control-C> "destroy $f"
  set currtxtind 1.0  ;# init search to top, at help panel create
  set find ""         ;# init search patt
  bind $f.t.txt <$xcmd-f> "onefindpanel $f.t.txt"
  wm protocol $f WM_DELETE_WINDOW "destroy $f .onefindpanel"
  focus $f.t.txt
  $f.t.txt mark set insert 1.0  ;# so xcmd-f works immediately
  tkwait visibility $f
  # move right,up from positionpop to cover less (e.g. geom 319x254+670+645)
  set g [split [wm geometry $f] "+x"]
  wm geometry $f +[expr [lindex $g 2]+400]+[expr [lindex $g 3]-340]
  # move less right for narrower F3 panel so not offscreen
  if { [info exists tksurferinterface] && $tksurferinterface == "macro" } {
    wm geometry $f +[expr [lindex $g 2]+200]+[expr [lindex $g 3]-340]
  }
  # move less right for smaller tkmedit GL win
  if { [info exists tkmeditinterface] } {
    wm geometry $f +[expr [lindex $g 2]+320]+[expr [lindex $g 3]-340]
  }

  return $nm
}

### one find panel (make, else just raise/move/reattach-to-new-textwidget)
proc onefindpanel { tw } {
  global find ffont ffontb bgcol entbgcol selbgcol xcmd
 
  set f .onefindpanel
  set geom +[expr [winfo rootx $tw] + 115]+[expr [winfo rooty $tw] - 61]
  if ![winfo exists $f] {
    toplevel $f -borderwidth 5 -bg $bgcol
    wm geometry $f $geom  ;# here, too, to avoid init corner flash
    wm title $f ""
    label $f.la -text "find:" -font $ffont -bg $bgcol
    entry $f.e -width 23 -font $ffont -textvariable find \
      -background $entbgcol -selectbackground $selbgcol -selectforeground black
    button $f.bu -text NEXT -font $ffontb -pady 2 -padx 11
    pack $f.la $f.e $f.bu -side left -padx 3
    wm resizable $f 0 0
  }
  raise $f
  wm geometry $f $geom
  $f.bu config -command "findnext $tw"
  bind $f <$xcmd-g> "findnext $tw"
  bind $f.e <Return> "findnext $tw"
  focus $f.e
}

### find/color next occurrence (pattern in global $find) for curr help panel
proc findnext { tw } {   ;# pass existing text widget
  global find currtxtind

  set cnt 0
  set ind [$tw search -count cnt $find $currtxtind]  ;# ignores cursor
  if {$cnt} {
    set currend [$tw index "$ind + $cnt c"]  ;# end of found
    $tw tag remove sel 0.0 end               ;# clear all
    $tw tag add sel $ind $currend            ;# highlight new
    $tw see $ind                             ;# move to see it
    set currtxtind $currend
  }
}

### modal entries-only popup (N.B.: if GLX win process, tkwait hangs it!)
proc modalcontrols { title variablelist {entwidth 5} } { ;#wait READY,then kill
  global userok

  set f [controls $title $variablelist "READY" "set userok 1" $entwidth]
  wm protocol $f WM_DELETE_WINDOW killboxOK  ;# killbox userok=>0 to unhang GLX
  tkwait variable userok
  destroy $f
  return $userok
}

### non-modal popup, just buttons (no-arg commands only)
proc buttonbar { buttonnamelist buttoncmdlist {orient def} {title none} \
                 {helpfile none} } {
  global ffontb ffont bgcol selcol selbgcol entbgcol
  global tksurferinterface tkmeditinterface

  if { [llength $buttonnamelist] != [llength $buttoncmdlist] } { return } 
  #set nm .buttonbar
  #if { [info commands $nm] == "$nm"} { return }  ;# only one for now
  set nm .buttonbar-[lindex $buttoncmdlist 0]
  if [winfo exists $nm] { raise $nm; return }
  set f [toplevel $nm -borderwidth 1 -bg $bgcol]
  wm title $f ""
  wm resizable $f 0 0
  positionpopup $f

  if {"$title" != "none"} {
    label $f.la -text $title -font $ffont -bg $bgcol
    if {"$orient" == "hor"} { pack $f.la -side left }
    if {"$orient" == "ver"} { pack $f.la -side top }
  }
  set i 0
  if {"$orient" == "def" } { set orient hor } ;# min ver width 3 titlebar butts
  foreach butt $buttonnamelist {
    if { "$butt" == "whitespace" } {
      frame $f.bu$i -height 6 -width 6 -bg $bgcol
    } else {
      button $f.bu$i -text "$butt" -font $ffontb -pady 2 -padx 2 -bg $bgcol \
        -command "[lindex $buttoncmdlist $i]"  ;# quote for global context
    }
    if {"$orient" == "hor"} { pack $f.bu$i -side left }
    if {"$orient" == "ver"} { pack $f.bu$i -side top }
    incr i
  }
  if {"$helpfile" != "none" } {
    bind $f <ButtonRelease-3> "helpwin $helpfile"
  }

  tkwait visibility $f
  # move left,down from positionpop location (e.g. popup geom 319x254+670+645)
  set g [split [wm geometry $f] "+x"]
  wm geometry $f +[expr [lindex $g 2]-[lindex $g 0]-50]+[expr [lindex $g 3]+13]
  # move below GL window b/c narrow F3 panel goes to top of GL
  if { [info exists tksurferinterface] && $tksurferinterface == "macro" } {
    wm geometry \
      $f +[expr [lindex $g 2]-[lindex $g 0]-50]+[expr [lindex $g 3]+640]
  }
  # move to right of tkmedit tk panel for far left tkmedit startup position
  if { [info exists tkmeditinterface] } {
    set g [split [wm geometry .] "+x"]  ;# tk win
    wm geometry $f +[expr [lindex $g 2]+[lindex $g 0]+5]+[lindex $g 3]
  }
  return $f
}

### non-modal popup (flags, entries, 1butt w/cmd) for adj parms, killbox armed
proc controls { title variablelist buttonname buttoncmd {entwidth 5} } {
  global ffontb ffont bgcol selcol selbgcol entbgcol runbgcol
  global purplekillcontrols tksurferinterface tkmeditinterface ctrlswinid

  set nm .controls[incr ctrlswinid]     ;# unique win name
  set f [toplevel $nm -borderwidth 10 -bg $bgcol]
  wm title $f ""
  positionpopup $f
  set purplekillcontrols 0

  ## killbox armed, for prog kill, calling proc should save ret'd win in global
  #wm protocol $f WM_DELETE_WINDOW killboxOK  ;# don't block upper-left kill

  if {$title != ""} {
    label $f.la -text $title -font $ffontb -bg $bgcol
    pack $f.la -side top -pady 5
  }
  set longest 0
  foreach var $variablelist {
    if ![string match *flag $var] {
      if {[string length $var] > $longest} {set longest [string length $var]}
    }
  }
  set i 0
  set j 0
  set entrycnt 0
  foreach var $variablelist {
    if {$var == "whitespace"} {
      frame $f.div$j -height 7 -bg $bgcol
      pack $f.div$j -side top
      incr j
    } else {  ;# tickbox/checkbutton or entry
      if [string match *flag $var] {  ;# checkbutton (redraw on change state!)
        checkbutton $f.ck$i -variable $var -font $ffont -text $var \
           -bg $bgcol -selectcolor $selcol -highlightbackground $bgcol
        set rdcmd ""
        set rdrep ""
        if { $buttonname == "REDRAW" && "$buttoncmd" != "none" } {
          set rdcmd "$buttoncmd"
          set rdrep "logcmd \"$buttoncmd\""
        } elseif { [info commands redrawbutton] != "" } {
          set rdcmd redrawbutton  ;# logs
        } elseif { [info commands redraw] != "" } {
          set rdcmd redraw
          set rdrep "logcmd redraw"
        } else {  }
        bind $f.ck$i <ButtonRelease-1> \
          "logcmd \"set $var \[set $var\]\"; $rdcmd; $rdrep" ;# non-idiomatic
        pack $f.ck$i -side top -fill none -anchor w
        incr i
     } else {  ;# entry (redraw on Return)
        incr entrycnt
        #edlabval $f $var 0 n [expr $longest+2] $entwidth
        edlabval $f $var 0 n $longest $entwidth  ;# Dec 2023
        $f.$var config -bg $bgcol 
        $f.$var.e config -textvariable $var -background $entbgcol \
          -selectbackground $selbgcol -highlightbackground $bgcol \
          -selectforeground black  ;# last: linux
        set rdcmd ""
        set rdrep ""
        if { $buttonname == "REDRAW" && "$buttoncmd" != "none" } {
          set rdcmd "$buttoncmd"
          set rdrep "logcmd \"$buttoncmd\""
        } elseif { [info commands redrawbutton] != "" } {
          set rdcmd redrawbutton  ;# logs
        } elseif { [info commands redraw] != "" } {
          set rdcmd redraw
          set rdrep "logcmd redraw"
        } else {  }
        if {$entrycnt == 1 && "$buttoncmd" != "none"} { ;#1parm: Ret->clickbutt
          bind $f.$var.e <Return> \
        "logcmd \"set $var \[set $var\]\"; eval \"$buttoncmd\"; $rdcmd; $rdrep"
        } else {
          bind $f.$var.e <Return> \
            "logcmd \"set $var \[set $var\]\"; $rdcmd; $rdrep"
        }
        $f.$var.la config -bg $bgcol
      }
    }
  }
  frame $f.white -height 7 -bg $bgcol
  pack $f.white -side top
  # bottom butt (N.B.: doesn't log: do_funct proc bound to button must log!)
  if {"$buttonname" != "none" && "$buttoncmd" != "none"} {

    ### purple/rename/unpurple/un-rename button in case cmd takes time: no kill
    set origbuttoncmd $buttoncmd
    # pass backslashed quotes for possible spaces in cmd when eventually called
    set buttoncmd "\
      \"$f.a$buttonname.bu\" config -text RUNNING \
        -background $runbgcol -disabledforeground black -state disabled; \
      update idletasks; \
      $origbuttoncmd; \
      catch {
        \"$f.a$buttonname.bu\" config -text \"$buttonname\" \
          -background $bgcol -state normal; \
        update idletasks
      }"  ;# catch unpurp b/c buttoncmd maybe already killed this controls win!
    ### end purple/unpurple

    buttons $f "$buttonname" $buttoncmd col
    $f.a$buttonname config -bg $bgcol

    ### begin purplekill (N.B.: .controls button must be "RUN SCRIPT" to kill!)
    bind "$f.a$buttonname.bu" <ButtonRelease-1> { ;#N.B.: next in global context
      update idletasks  ;# else button name query stale
      if { [info commands ".controls.aRUN SCRIPT.bu"] != "" &&
           [".controls.aRUN SCRIPT.bu" cget -text] == "RUNNING" } {
          set  purplekillcontrols 1
      }
      if { [info commands ".controlsx.aRUN SCRIPT.bu"] != "" &&
           [".controlsx.aRUN SCRIPT.bu" cget -text] == "RUNNING" } { ;# if 2nd
          set  purplekillcontrols 1
      }
    }
    ### end purplekill
  }
  #fixcolors  ;# col opts incl'd here (fixcolors uncolors labelalpha entry bg)
  tkwait visibility $f
  # move left,down from positionpop to unoverlap (e.g. geom 319x254+670+645)
  set g [split [wm geometry $f] "+x"]  ;# popup
  wm geometry $f +[expr [lindex $g 2]-[lindex $g 0]-50]+[expr [lindex $g 3]+13]
  # move below tksurfer GL window b/c narrow F3 panel goes to top of GL
  if { [info exists tksurferinterface] && $tksurferinterface == "macro" } {
    wm geometry \
      $f +[expr [lindex $g 2]-[lindex $g 0]-50]+[expr [lindex $g 3]+640]
  }
  # move to right of tkmedit tk panel for far left tkmedit startup position
  if { [info exists tkmeditinterface] } {
    set g [split [wm geometry .] "+x"]  ;# tk win
    wm geometry $f +[expr [lindex $g 2]+[lindex $g 0]+5]+[lindex $g 3]
  }
  update idletasks  ;# else focus problem (N.B.: focus *cmd* doesn't help)
  return $f
}

### where to put modal popups (rel->tkroot, controls/buttonbar/helpwin adjust)
proc positionpopup { win {size {}} } {
  set winx [expr [winfo rootx .]+45]
  #set winx [expr [winfo rootx .]-5]   ;# popup left visible w/fronted main
  #set winy [expr [winfo rooty .]+25]
  set winy [expr [winfo rooty .]-35]   ;# popup higher visible w/fronted main
  if {"$win" != "justgetposition"} { wm geometry $win $size+${winx}+${winy} }
  return $size+${winx}+${winy}
}

### command for wm to intercept killbox WM_DELETE_WINDOW
proc killboxOK { } {
  global userok
  set userok 0
}

#############################################################################
# menu wrappers
#############################################################################
### setup menu bar (call once)
proc menusetup { mbar } {
  global Menu menubg mfont
  frame $mbar -borderwidth 1 -relief raised -background $menubg
  pack $mbar -side top -anchor w -fill x
  set Menu(mbar) $mbar
  set Menu(uid) 0
}

### address last menu item to rm by name, ignore if not last
proc menurmlast { label } {
  global Menu
  if {"$Menu(mbar).mb[expr $Menu(uid)-1].me" != "$Menu(menu,$label)"} {return}
  incr Menu(uid) -1
  destroy $Menu(mbar).mb$Menu(uid)
  unset Menu(menu,$label)
}

### setup one menu head
proc menuhead { label side {accelindex -1}} {
  global Menu menubg menuactbg mfont mainrelease
  if [info exists Menu(menu,$label)] { return }
  set name $Menu(mbar).mb$Menu(uid)
  set mname $name.me
  incr Menu(uid)
  set mb [menubutton $name -text $label -menu $mname -padx 4 -pady 3 \
         -background $menubg -activebackground $menuactbg -font $mfont \
         -activeforeground black]
  if {$accelindex >= 0} {$mb config -underline $accelindex}
  set padx 2
  if { $mainrelease == "Fedora" ||
       $mainrelease == "CentOS" } { set padx 0 }  ;# giant helv 14, Fed/Cent7
  pack $mb -side $side -padx $padx
  # new -activeborderwidth 0 like old 2
  set menu [menu $mname -tearoff 0 -background $menubg \
    -activebackground $menuactbg -activeforeground black]
  set Menu(menu,$label) $menu
}

### add menu command
proc menucmd { mname label cmd {accelindex -1}} {
  global Menu menubg menuactbg mfont
  if [catch {set Menu(menu,$mname)} menu] { return }
  $menu add command -label $label -command $cmd \
     -background $menubg -activebackground $menuactbg -font $mfont
  if {$accelindex >= 0} {$menu config -underline $accelindex}
  #$menu config -activeborderwidth 10  ;# done in csurf
}

### add menu checkbutton
proc menucheck { mname label var {cmd {}} } {
  global Menu menubg menuactbg mfont menuchk
  if [catch {set Menu(menu,$mname)} menu] { return }
  $menu add check -label $label -command $cmd -variable $var -font $mfont \
       -background $menubg -activebackground $menuactbg -selectcolor $menuchk
}
 
### add menu separator line
proc menusepar { mname } {
  global Menu
  if [catch {set Menu(menu,$mname)} menu] { return }
  $menu add separator
}

### bind additional action to menu (not used)
proc menubind { what sequence mname label { accelseq none } } {
  global Menu
  if [catch {set Menu(menu,$mname)} menu] { return }
  if [catch {$menu index $label} index] { return }
  set cmd [$menu entrycget $index -command]
  bind $what $sequence $cmd
  if {$accelseqname != "none"} { set sequence $accelseqname }
  $menu entryconfigure $index -accelerator $sequence
}

### change acceleration text (used with bind to whole window)
proc menuacceltxt { mname label accelseqname } {
  global Menu
  if [catch {set Menu(menu,$mname)} menu] { return }
  if [catch {$menu index $label} index] { return }
  $menu entryconfigure $index -accelerator $accelseqname
}

### flash menu
proc menuflash { mname } {
  global Menu menuactbg menubg
  if [catch {set Menu(menu,$mname)} menu] { return }
  set mhead [file rootname $menu]   ;# strip .me
  $mhead config -bg $menuactbg
  after 100 "$mhead config -bg $menubg"
}

### disable menu (not used)
proc menudisable { mname label } {
  global Menu
  if [catch {set Menu(menu,$mname)} menu] { return }
  if [catch {$menu index $label} index] { return }
  $menu entryconfigure $index -state disabled
}

### enable menu (not used)
proc menuenable { mname label } {
  global Menu
  if [catch {set Menu(menu,$mname)} menu] { return }
  if [catch {$menu index $label} index] { return }
  $menu entryconfigure $index -state normal
}

#############################################################################
# utility procedures
#############################################################################
### always flush pipe (don't hang tk interface), maybe print prompt char
proc prompt { } {
  global promptflag
  if { $promptflag } { puts -nonewline "% " }
  flush stdout
}

### binary found on path (N.B.: tcsh/bash aliases *not* followed)
proc foundbywhich { somebinary } {
  catch {eval exec /usr/bin/which $somebinary} ret
  # (1) MacOSX,Debian, (2,3) RedHat,Fedora (error reports tail), (4) older
  if { [string match "" $ret] ||
       [string match "*no $somebinary*" $ret] ||
       [string match "*no [file tail $somebinary]*" $ret] ||
       [string match "*child process exited abnormally*" $ret] } {
    return 0
  } else {
    return 1
  }
}

### replace all instances of a char (backslash brackets/braces)
proc replchar { str oldc newstr } {
  set i 0
  set len [string length $str]
  set outstr ""
  while {$i < $len} {
    set c [string index $str $i]
    if {$c == $oldc} {
      set outstr "${outstr}${newstr}"
    } else {
      set outstr "${outstr}${c}"
    }
    incr i
  }
  return $outstr
}

### backslash spaces in path
proc backslashspaces { str } {
  set i 0
  set len [string length $str]
  set newstr ""
  while {$i < $len} {
    set c [string index $str $i]
    if {$c == " "} {
      set newstr "${newstr}\\ "
    } else {
      set newstr "${newstr}${c}"
    }
    incr i
  }
  return $newstr
}

### backslash spaces in list of paths, return sh-usable list arg string
proc lbackslashspaces { list } {
  set str ""
  foreach memb $list {
    set bsmemb [backslashspaces $memb]
    set str "$str $bsmemb"
  }
  return $str
}

### test if can make or overwrite file (N.B.: *false* if path is existing dir!)
proc canwriteormakefile { path } {
  if [file exists $path] {
    if { [file isfile $path] && [file writable $path] } {
      return 1
    } else { return 0 }
  } else {
    set parent [file dirname $path]
    if { [file isdirectory $parent] && [file writable $parent] } {
      return 1
    } else { return 0 }
  }
}

### warn overwrite, passed overwrite function, possibly w/args, maybe log
proc testreplace { file function {args {}} } {
  if { [file exists $file] } {
    if { [okreplace $file] } {
      if {"$args" != ""} {
        eval [join [list $function $args]]
        logcmd "$function $args"
      } else {
        $function
        logcmd "$function"
      }
      return 1
    } else {
      return 0
    }
  } else {
    if {"$args" != ""} {
      eval [join [list $function $args]]
      logcmd "$function $args"
    } else {
      $function
      logcmd "$function"
    }
    return 1
  }
}

#############################################################################
# tcl interface cmd log
#############################################################################
### open log (global logid) to save tcl equivalents of interface actions
proc logopen { logfile } {
  global logid isession subject
  if {$logid != -1} { puts "logopen: ### log already open"; return }
  set logid [open $logfile w 0666]
  exec chmod ugo+rw $logfile   ;# umask overrides above
  puts $logid "### $logfile: tcl cmdlog opened: [exec date]"
  if [info exists subject] { puts $logid "# subject: $subject" }
  if [info exists isession] { puts $logid "# session: $isession" }
  flush $logid
}

### write to log if open
proc logcmd { cmd } {
  global logid
  if {$logid == -1} { return }
  puts $logid "$cmd"
  flush $logid
}

### close/date log (flushed log autoclosed w/o date if parent killed)
proc logclose { } {
  global logid
  if {$logid == -1} { return }
  puts $logid "### tcl cmdlog closed: [exec date]"
  close $logid
  set logid -1  ;# flag
}

