CD Actual 3/CD ACTUAL 3.iso/linux/incoming/jstools-.6v3/jstools-/jstools-tk3.6v3.0/lib/jmore.tcl

Text File | 1995-02-09 | 5.4 KB | 184 lines

# jmore.tcl - text display panel
#
# Copyright 1992-1994 by Jay Sekora.  All rights reserved, except
# that this file may be freely redistributed in whole or in part
# for non-profit, noncommercial use.
######################################################################

### TO DO
###   j:more:button to add a button to the buttonbar
###   fix focus problems

######################################################################
# global variables:
#
global J_PREFS env
if {! [info exists J_PREFS(autoposition)]} {set J_PREFS(autoposition) 0}
if {! [info exists J_PREFS(confirm)]} {set J_PREFS(confirm) 1}
if {! [info exists J_PREFS(printer)]} {set J_PREFS(printer) lp}
#
######################################################################


######################################################################
# j:more ?options? ?-title hdr? ?-text txt? - displays text in window
# options include
#   -title (default "Output")
#   -text (default "" - not really optional)
#   -height (default 24)
#   -width (default 80)
#   -font (default "default")
#   -class (default "More")
# this unfortunately forces focus-follows-pointer in these windows
######################################################################

proc j:more { args } {
  global J_PREFS
  if {[lsearch [array names J_PREFS] {scrollbarside}] == -1} {
    set J_PREFS(scrollbarside) right ;# make sure it's defined
  }

  j:parse_args {
    {title Output}
    {text {}}
    {wrap char}
    {height 24}
    {width 80}
    {font default}
    {class More}
  }

  global j_more

  if {[info exists j_more(count)]} then {
    set j_more(count) [expr {$j_more(count) + 1}]
  } else {
    set j_more(count) 0
  }

  set w ".more$j_more(count)"

  toplevel $w -class $class
  wm title $w $title

  # using j:buttonbar for visual consistency, although we can't (easily)
  # set the commands with it (because they depend on the window name):

  j:buttonbar $w.b -default ok -buttons {
    {ok Done {}}
    {save Save {}}
    {print Print {}}
    {find {Find . . .} {}}
  }
  $w.b.ok configure -command "destroy $w"
  $w.b.save configure -command "j:more:save $w"
  $w.b.print configure -command "j:more:print $w"
  $w.b.find configure -width 8 -command "j:find -replace 0 $w.t"

  scrollbar $w.sb -relief flat -command "$w.t yview"
  text $w.t -yscrollcommand "$w.sb set" -setgrid true -wrap word \
    -height $height -wrap $wrap -width $width
  j:configure_font $w.t $font

  pack \
    $w.b \
    [j:rule $w] \
    -side bottom -fill x
  pack \
    $w.sb \
    [j:rule $w] \
    -side $J_PREFS(scrollbarside) -fill y
  pack \
    $w.t \
    -expand yes -fill both

  $w.t insert end $text

  $w.t mark set insert 1.0

  $w.t configure -state disabled ;# prevent its being edited

  # FOLLOWING BINDINGS SHOULD BE GENERALISED! and check J_PREFS(bindings)!
  #
  bind $w.t <Next> "j:more:pageup $w.t"
  bind $w.t <space> "j:more:pageup $w.t"
  bind $w.t <Control-v> "j:more:pageup $w.t"

  bind $w.t <Prior> "j:more:pagedown $w.t"
  bind $w.t <b> "j:more:pagedown $w.t"
  bind $w.t <Escape><v> "j:more:pagedown $w.t"

  bind $w <Any-Enter> "focus $w.t"

  # "cancel" and "ok" amount to the same thing for this window:
  j:default_button $w.b.ok $w.t
  j:cancel_button $w.b.ok $w.t

  return $w.t            ;# so caller can insert things in it
}

######################################################################
# j:more:save w - prompts to save the content of a j:more window
#   NOTE: this adds a newline!  should check if ends in newline alr.
######################################################################

proc j:more:save { w } {
  set filename [j:fs]
  if {$filename == {}    } {
    return 1
  }
  # should do error checking
  set file [open $filename {w}]
  puts $file [$w.t get 1.0 end]
  close $file
}

######################################################################
# j:more:print w - prompts to print the content of a j:more window
#   command to use should be a preference!
# uses J_PREFS(printer)
######################################################################

proc j:more:print { w } {
  global env J_PREFS

  append J_PREFS(printer) {}            ;# make sure it's defined
  if {"x$J_PREFS(printer)" == "x"} then {set J_PREFS(printer) "lp"}

  if [j:confirm -priority 100 -text "Print using lpr to $J_PREFS(printer)?"] {
    # should do error checking
    set file [open "|lpr -P$J_PREFS(printer)" {w}]
    puts $file [$w.t get 1.0 end] nonewline
    close $file
  }
}

######################################################################
# j:more:pageup t - scrolls text widget t up
#   requires scrollbar to be sibling named "sb"
#   based on procedure by Paul Raines <[e-mail]>
######################################################################

proc j:more:pageup { t } {
  set sb "[winfo parent $t].sb"
  $t mark set insert "[lindex [$sb get] 3].0"
  $t yview insert
}

######################################################################
# j:more:pagedown t - scrolls text widget t down
#   requires scrollbar to be sibling named "sb"
#   based on procedure by Paul Raines <[e-mail]>
######################################################################

proc j:more:pagedown { t } {
  set sb "[winfo parent $t].sb"
  set currentstate [$sb get]

  # following is buggy if lines wrap:
  #
  set newlinepos [expr {[lindex $currentstate 2]-[lindex $currentstate 1]}]
  $t mark set insert "$newlinepos.0-2lines"
  $t yview insert
}