# jprompts.tcl - various panels to ask the user for something
#
######################################################################
# 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.     #
######################################################################

### TO DO
###   make a real j:prompt_font
###   eval tcl commands at the global level
###   checkbox to display output of unix or tcl command

######################################################################
# global variables:
#
global J_PREFS env
j:default J_PREFS(autoposition) 0
j:default J_PREFS(confirm) 1
#
######################################################################


######################################################################
# j:prompt ?options? - prompt the user for information
# options are:
#   -text (default "Enter a value:"
#   -default (default "")
#   -cancelvalue (default "")
#   -file (default 0)
#   -title (default "Prompt")
# if $file, then the Tab key will do filename completion
######################################################################

proc j:prompt { args } {
  j:parse_args {
    {text "Enter a value:"}
    {default ""}
    {cancelvalue ""}
    {file 0}
    {title title:prompt}
  }
  
  set text [uplevel 1 [list j:ldb $text]]
  set title [uplevel 1 [list j:ldb $title]]
  
  global j_prompt

  set old_focus [focus]			;# so we can restore original focus

  toplevel .pr
  wm title .pr $title
  
  message .pr.msg -width 300 -anchor w -text $text
  entry .pr.field -width 40
  j:buttonbar .pr.b -default ok -buttons [format {
    {ok OK {set j_prompt(result) [.pr.field get]; destroy .pr}}
    {cancel Cancel {set j_prompt(result) {%s}; destroy .pr}}
  } $cancelvalue]

  pack .pr.msg -side top -fill both -expand yes -padx 10
  pack .pr.field -side top -padx 10 -pady 10
  pack .pr.b -side bottom -fill x
  pack [j:rule .pr -width 200] -side bottom -fill x

  .pr.field delete 0 end
  .pr.field insert end $default
  
  j:dialogue .pr			;# position in centre of screen

  if $file {
    j:tk3 {
      bind .pr.field <Tab> {
        set f [%W get]
        %W delete 0 end
        %W insert end [j:expand_filename $f]
      }
    }
    j:tk4 {
      bind .pr.field <Tab> {
        set f [%W get]
        %W delete 0 end
        %W insert end [j:expand_filename $f]
        %W xview end
        focus %W			;# work around Tk4 "all" binding
        break
      }
    }
  }
  j:default_button .pr.b.ok .pr.field
  j:cancel_button .pr.b.cancel .pr.field

  focus .pr.field
  update
  grab .pr
  tkwait window .pr
  j:tk3 {focus $old_focus}
  j:tk4 {focus -force $old_focus}	;# can't figure out a better way...
  return $j_prompt(result)
}

######################################################################
# j:prompt_font ?options? - prompt for a font (via xfontsel)
# options are:
#   -prompt (default "Font:", but currently ignored)
#   -pattern (default "*")
# usage of xfontsel (`quit' button) not obvious!
######################################################################

proc j:prompt_font { args } {
  j:parse_args {
    {prompt "Font:"}
    {pattern "*"}
  }
  # set prompt [uplevel 1 [list j:ldb $prompt]]	;# currently ignored
  
  return [exec xfontsel -pattern $pattern -print]
}

######################################################################
# j:prompt_tcl - prompt for a tcl command and execute it
######################################################################

proc j:prompt_tcl {} {
  global j_prompt_tcl
  append j_prompt_tcl(RESULT) {}
  
  set prompt [j:ldb prompt:tcl "Tcl Command:"]
  set title_short [j:ldb title:tcl:result_short "Tcl result"]
  set title [j:ldb title:tcl:result "Result of Tcl command"]
  
  set prompt_result [j:prompt \
    -text $prompt -default $j_prompt_tcl(RESULT)]
  if {$prompt_result != {}} then {
    set j_prompt_tcl(RESULT) $prompt_result
    set result [uplevel #0 $j_prompt_tcl(RESULT)]
    set length [string length $result]
    if {$length == 0} {
      return
    }
    if {$length < 40 && ! [string match "*\[\t\r\]*" $result]} {
      j:alert -title $title_short -text $result
      return
    } else {
      j:more -title $title -text $result
      return
    }
  }
}

######################################################################
# j:prompt_unix - prompt for a unix command and execute it
######################################################################

proc j:prompt_unix {} {
  global j_prompt_unix
  append j_prompt_unix(RESULT) {}
  
  set prompt [j:ldb prompt:unix {Unix Command:}]
  set title_short [j:ldb title:unix:result_short {Command output}]
  
  set prompt_result [j:prompt \
    -text $prompt -default $j_prompt_unix(RESULT)]
  if {$prompt_result != {}} then {
    set j_prompt_unix(RESULT) $prompt_result
    set command $prompt_result
    set result [uplevel #0 exec $command < /dev/null]
    set length [string length $result]
    if {$length == 0} {
      j:alert -text "No output from $command."
      return
    }
    if {$length < 40 && ! [string match "*\[\t\r\]*" $result]} {
      j:alert -title $title_short -text $result
      return
    } else {
      set title [j:ldb title:unix:result "Output of $command"]
      j:more -title $title -text $result
      return
    }
  }
}

######################################################################
# j:prompt_colour_name - prompt for a colour name
######################################################################
### PROBLEM: LOCATION OF /usr/lib/X11/rgb.txt IS HARDCODED!
### Also, should open and process without forking off an awk
### Also, getting $w into strings is done in an ugly manner

j:ldb:set_defaults {
  {prompt:colour_name {Choose a colour:}}
  {title:colour_name {Colour Name Selector}}
}

proc j:prompt_colour_name { args } {
  j:parse_args {
    {prompt prompt:colour_name}
    {title title:colour_name}
  }
  
  set prompt [uplevel 1 [list j:ldb $prompt]]
  set title [uplevel 1 [list j:ldb $title]]
  
  global j_prompt
  global J_PREFS
  if {[lsearch [array names J_PREFS] {scrollbarside}] == -1} {
    set J_PREFS(scrollbarside) right ;# make sure it's defined
  }
  
  set old_focus [focus]			;# so we can restore original focus
  
###   if {[info exists j_prompt(count)]} then {
###     set j_prompt(count) [expr {$j_prompt(count) + 1}]
###   } else {
###     set j_prompt(count) 0
###   }
### 
###   set w ".prompt$j_prompt(count)"

  set w ".prompt_colour_name"
  toplevel $w
  wm title $w $title
  
  set rgbfile /usr/lib/X11/rgb.txt
  if [file isfile $rgbfile] {
    set colourlist [lsort [exec awk { NF == 4 { print $4 } } $rgbfile]]
  } else {
    set colourlist {
      aquamarine bisque black blue brown burlywood coral crimson cyan
      firebrick gold goldenrod green grey grey25 grey33 grey50 grey66
      grey75 khaki lavender magenta maroon navy orange orchid pink plum
      purple red salmon tan tomato turquoise white yellow
    }
  }
  
  set j_prompt(colour) {}
  
  label $w.l -text $prompt
  j:buttonbar $w.b -default ok -orient vertical -buttons [list \
    [list ok OK [format {
        catch {set j_prompt(colour) [%s.list get [%s.list curselection]]}
        destroy %s
      } $w $w $w] \
    ] \
  ]
  frame $w.frame -width 100 -height 100 \
    -background bisque -relief raised -borderwidth 2
  frame $w.list
  scrollbar $w.list.sb -command "$w.list.lb yview"
  listbox $w.list.lb -yscroll "$w.list.sb set" -relief flat -setgrid true
  ####### following supports both tk3.6 and 4.0:
  if [catch {$w.list.lb configure -geometry 20x20}] {
    $w.list.lb configure -width 20 -height 20
  }
  
  pack $w.list.sb [j:rule $w.list] \
    -side $J_PREFS(scrollbarside) -fill y
  pack $w.list.lb -in $w.list -side left -expand yes -fill both
  
  pack $w.l [j:rule $w] -side top -fill x
  pack $w.list [j:rule $w] -side left -expand yes -fill both
  pack $w.frame -side top -fill both -expand yes -padx 10 -pady 10
  pack $w.b -side bottom -fill x
  pack [j:rule $w] -side bottom -fill x
  
  # Fill the listbox with a list of several useful colours:
  
  foreach i $colourlist {
    $w.list.lb insert end $i
  }
  
  # Set up bindings for the browser.
  
  bind $w.list.lb <Control-q> "destroy $w"
  bind $w.list.lb <Control-c> "destroy $w"
  focus $w.list.lb
  j:tk3 {
    bind $w.list.lb <Button-1> "
      $w.list.lb select from \[$w.list.lb nearest %y\]
      catch {
        set j_prompt(colour) \[$w.list.lb get \[$w.list.lb curselection\]\]
      }
      $w.frame config -background \$j_prompt(colour)
    "
  }
  j:tk4 {
    bind $w.list.lb <Button-1> "
      $w.list.lb selection clear 0 end
      $w.list.lb selection set \[$w.list.lb nearest %y\]
      catch {
        set j_prompt(colour) \[$w.list.lb get \[$w.list.lb curselection\]\]
      }
      $w.frame config -background \$j_prompt(colour)
    "
  }
  bind $w.list.lb <Double-Button-1> "
    $w.b.ok invoke
  "
  j:tk4 {
    bind $w.list.lb <Double-Button-1> "+\nbreak\n"
  }
  j:default_button $w.b.ok $w
  focus $w
  j:dialogue $w
  tkwait window $w
  j:tk3 {focus $old_focus}
  j:tk4 {focus -force $old_focus}	;# can't figure out a better way...
  if {$j_prompt(colour) == ""} {set j_prompt(colour) bisque}
  return $j_prompt(colour)
}

proc j:prompt_color_name \
  [info args j:prompt_colour_name] \
  [info body j:prompt_colour_name]

######################################################################
# j:prompt_colour_rgb - prompt for a colour RGB value
#   An eviscerated version of selcol.tcl by Sam Shen <sls@aero.org>,
#   which also let you choose HSV values
######################################################################

j:ldb:set_defaults {
  {prompt:colour_rgb {Choose a colour:}}
  {title:colour_rgb {Colour Colour Selector}}
}

proc j:prompt_colour_rgb { args } {
  j:parse_args {
    {prompt prompt:colour_rgb}
    {title title:colour_rgb}
  }
  
  set prompt [uplevel 1 [list j:ldb $prompt]]
  set title [uplevel 1 [list j:ldb $title]]
  
  global j_prompt
  
  set j_prompt(red) 255
  set j_prompt(blue) 196
  set j_prompt(green) 228
  set j_prompt(flag) 0
  
  set old_focus [focus]			;# so we can restore original focus
  
  set w .prompt_rgb
  toplevel $w
  wm title $w $title
  wm minsize $w 100 100
  wm maxsize $w [winfo screenwidth $w] [winfo screenheight $w]
  
  label $w.l -text $prompt

  frame $w.patch -width 100 -height 100 -relief raised -borderwidth 2
  entry $w.value -width 12
  bind $w.value <1> {%W select from @0; %W select to end}
  frame $w.scales
  set j_prompt(flag) 1
  j:prompt_colour_rgb:make_scale $w $w.scales.red red 255 Red
  j:prompt_colour_rgb:make_scale $w $w.scales.green green 255 Green
  j:prompt_colour_rgb:make_scale $w $w.scales.blue blue 255 Blue
  pack $w.scales.red $w.scales.green $w.scales.blue \
    -side left -fill y -expand yes
  set j_prompt(flag) 0
  
  j:buttonbar $w.b -default ok -orient vertical -buttons {
    {
      ok OK { }
    }
  }
  
  $w.b.ok configure -command "
    set j_prompt(return) \[$w.value get\]
    destroy $w
  "
  
  pack $w.l
  pack [j:rule $w] -fill x
  pack $w.scales -expand yes -side left -fill y
  pack [j:rule $w] -side left -fill y
  pack $w.value -fill both
  pack $w.patch -expand yes -fill both -padx 10 -pady 10
  pack [j:rule $w] -fill x
  pack $w.b -fill x
  
  j:prompt_colour_rgb:update_colour $w red $j_prompt(red)
  
  j:default_button $w.b.ok $w
  focus $w
  j:dialogue $w
  tkwait window $w
  j:tk3 {focus $old_focus}
  j:tk4 {focus -force $old_focus}	;# can't figure out a better way...
  return $j_prompt(return)
}

proc j:prompt_colour_rgb:make_scale {w name var to title} {
  global j_prompt
  
  frame $name
  scale $name.scale -to $to \
    -command "j:prompt_colour_rgb:update_colour $w $var"
  $name.scale set [set j_prompt($var)]
  label $name.label -text $title
  pack $name.label -in $name
  pack $name.scale -in $name -expand yes -fill y
}

proc j:prompt_colour_rgb:update_colour {w var value} {
  global j_prompt

  if {$j_prompt(flag) == 1} {return}
  set j_prompt(flag) 1
  set j_prompt($var) $value
  set colour [format "#%02x%02x%02x" \
    $j_prompt(red) $j_prompt(green) $j_prompt(blue)]
  catch {}
  $w.patch configure -background $colour
  $w.value delete @0 end
  $w.value insert 0 $colour
  set j_prompt(flag) 0
}

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

proc j:prompt_color_rgb \
  [info args j:prompt_colour_rgb] \
  [info body j:prompt_colour_rgb]














