# jmore.tcl - text display panel
#
######################################################################
# 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
###   j:more:button to add a button to the buttonbar
###   fix focus problems

######################################################################
# global variables:
#
global J_PREFS env
j:default J_PREFS(autoposition) 0
j:default J_PREFS(confirm) 1
j:default 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)
#   -annotation (default "")
#   -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 {}}
    {annotation {}}
    {wrap char}
    {height 24}
    {width 80}
    {font default}
    {class More}
  }
  
  set title [uplevel 1 [list j:ldb $title]]
  
  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 more:done {}}
    {save more:save {}}
    {print more:print {}}
    {find more: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 -command "j:find -replace 0 $w.t"
  
  scrollbar $w.sb -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 [list $font]
  
  pack \
    $w.b \
    -side bottom -fill x
  pack \
    $w.sb \
    -side $J_PREFS(scrollbarside) -fill y
  pack \
    $w.t \
    -expand yes -fill both
  
  $w.t insert end $text
  
  if [string length $annotation] {
    j:tag:set_annotation $w.t $annotation
    j:tag:configure_display_tags $w.t
    j:more:configure_fonts $w.t
  }
  
  $w.t mark set insert 1.0
  $w.t yview 1.0
  $w.t tag remove sel 1.0 end
  
  $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"
  
  # "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
  
  # in Tk3, simulate focus-follows-pointer:
  j:tk3 [list bind $w <Any-Enter> [list catch [list focus $w.t]]]
  # restore old focus when window is destroyed (note that the [focus]
  #   is evaluated _now_)
  j:tk3 {bind $w <Destroy> [list catch [list focus [focus]]]}
  j:tk4 {bind $w <Destroy> [list catch catch [list focus -force [focus]]]}
  
  catch [list focus $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 [j:ldb confirm:print "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 <raines@bohr.physics.upenn.edu>
######################################################################

proc j:more:pageup { t } {
  j:tk3 {
    set sb "[winfo parent $t].sb"
    $t mark set insert "[lindex [$sb get] 3].0"
    $t yview insert
  }
  j:tk4 {
    $t yview scroll 1 page
    $t mark set insert @0,0
    $t see insert
  }
}

######################################################################
# j:more:pagedown t - scrolls text widget t down
#   requires scrollbar to be sibling named "sb"
#   based on procedure by Paul Raines <raines@bohr.physics.upenn.edu>
######################################################################

proc j:more:pagedown { t } {
  j:tk3 {
    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
  }
  j:tk4 {
    $t yview scroll -1 page
    $t mark set insert @0,0
    $t see insert
  }
}

######################################################################
# jedit:font:configure_fonts w - set rich-text fonts
#   should look at preferences - should be shared with other apps
######################################################################

proc j:more:configure_fonts { w } {
  j:rt:textfonts $w {
    {roman {
        -adobe-helvetica-medium-r-normal-*-*-120-*-*-*-*-*-*
      }
    }
    {italic {
        -adobe-helvetica-medium-o-normal-*-*-120-*-*-*-*-*-*
      }
    }
    {bold {
       -adobe-helvetica-bold-r-normal-*-*-120-*-*-*-*-*-*
      }
    }
    {bolditalic {
        -adobe-helvetica-bold-o-normal-*-*-120-*-*-*-*-*-*
      }
    }
    {typewriter {
        -adobe-courier-medium-r-normal-*-*-120-*-*-*-*-*-*
      }
    }
    {heading0 {
        -b&h-lucida-bold-i-normal-*-*-240-*-*-*-*-*-*
        -adobe-helvetica-bold-o-normal-*-*-240-*-*-*-*-*-*
      }
    }
    {heading1 {
        -b&h-lucida-bold-i-normal-*-*-180-*-*-*-*-*-*
        -adobe-helvetica-bold-o-normal-*-*-180-*-*-*-*-*-*
      }
    }
    {heading2 {
        -b&h-lucida-bold-i-normal-*-*-140-*-*-*-*-*-*
        -adobe-helvetica-bold-o-normal-*-*-140-*-*-*-*-*-*
      }
    }
    {heading3 {
        -b&h-lucida-bold-i-normal-*-*-120-*-*-*-*-*-*
        -adobe-helvetica-bold-o-normal-*-*-120-*-*-*-*-*-*
      }
    }
    {heading4 {
        -b&h-lucida-bold-i-normal-*-*-100-*-*-*-*-*-*
        -adobe-helvetica-bold-o-normal-*-*-100-*-*-*-*-*-*
      }
    }
    {heading5 {
        -b&h-lucida-bold-i-normal-*-*-80-*-*-*-*-*-*
        -adobe-helvetica-bold-o-normal-*-*-80-*-*-*-*-*-*
      }
    }
  }
}


