# jrichtext.tcl - procedures for dealing with rich text
#
######################################################################
# Copyright 1992-1999 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.     #
######################################################################

# the import IS A BIG PROBLEM until this whole file gets wrapped in its own
# namespace:

catch {
  package require jldb
  namespace import ::jldb::shortcuts::*
}

# CHANGES:
#   dual usage; j:rt:textfonts with a text widget vs. full rich-text

# j:tagged_insert w text args - insert tagged text into a text widget
# j:rt text dest - prepare to write rich text to text widget dest
# j:rt:type - return type of current rich text destination (text, TeX)
# j:rt:destination - return current rich text destination (widget, file)
# j:rt:textfonts {style font}... - set fonts for text widget
# j:rt:done - finish writing rich text (clear vars, close files)
# j:rt:rm text - write rich text (roman)
# j:rt:it text - write rich text (italic)
# j:rt:bf text - write rich text (bold face)
# j:rt:bi text - write rich text (bisexual)
# j:rt:tt text - write rich text (typewriter - monospaced)
# j:rt:hl text - write rich text (`headline' - larger bold)
# j:rt:tab - tab in rich text
# j:rt:cr - line break in rich text
# j:rt:par - paragraph break in rich text
# j:rt:mkabbrevs - make shorter convenience procs, for text-intensive apps
# rm - dummy do-nothing procedure to prevent unknown from calling /bin/rm
#   if you forget to j:rt:mkabbrevs

catch {
  package require jldb
}

######################################################################
# j:tagged_insert - append to a text widget with a particular tag
#   (lifted from mkStyles.tcl demo, where it was insertWithTags)
######################################################################

# The procedure below inserts text into a given text widget and
# applies one or more tags to that text.  The arguments are:
#
# w		Window in which to insert
# text		Text to insert (it's inserted at the "insert" mark)
# args		One or more tags to apply to text.  If this is empty
#		then all tags are removed from the text.

proc j:tagged_insert {w text args} {
  set start [$w index insert]
  $w insert insert $text
  foreach tag [$w tag names $start] {
    $w tag remove $tag $start insert
  }
  foreach i $args {
    $w tag add $i $start insert
  }
}

######################################################################
# j:rt text dest - prepare to write rich text to text widget dest
#   future versions will support PostScript, TeX, maybe canvas, etc.
######################################################################

proc j:rt { {type {}} {destination stdout} } {
  global j_rt
  
  case $type in {
    {text} {			;# output to a text widget
      set j_rt(type) $type
      set j_rt(destination) $destination
      $j_rt(destination) delete 0.0 end
      $j_rt(destination) configure -wrap word
      catch {
        $j_rt(destination) configure -font \
          -adobe-helvetica-medium-r-normal--*-120-*
        $j_rt(destination) tag configure richtext:font:roman -font \
          -adobe-helvetica-medium-r-normal--*-120-*
        $j_rt(destination) tag configure richtext:font:italic -font \
          -adobe-helvetica-medium-o-normal--*-120-*
        $j_rt(destination) tag configure richtext:font:bold -font \
          -adobe-helvetica-bold-r-normal--*-120-*
        $j_rt(destination) tag configure richtext:font:bolditalic -font \
          -adobe-helvetica-bold-o-normal--*-120-*
        $j_rt(destination) tag configure richtext:font:typewriter -font \
          -adobe-courier-medium-r-normal--*-120-*
        $j_rt(destination) tag configure richtext:font:heading0 -font \
          -adobe-helvetica-bold-o-normal--*-240-*
        $j_rt(destination) tag configure richtext:font:heading1 -font \
          -adobe-helvetica-bold-o-normal--*-180-*
        $j_rt(destination) tag configure richtext:font:heading2 -font \
          -adobe-helvetica-bold-o-normal--*-140-*
        $j_rt(destination) tag configure richtext:font:heading3 -font \
          -adobe-helvetica-bold-o-normal--*-120-*
        $j_rt(destination) tag configure richtext:font:heading4 -font \
          -adobe-helvetica-bold-o-normal--*-100-*
        $j_rt(destination) tag configure richtext:font:heading5 -font \
          -adobe-helvetica-bold-o-normal--*-80-*
      }
    }
    default {
      error [= richtext:unsupportedtype \
        "j:rt type \"$type\" is not supported."]
    }
  }
}

######################################################################
# j:rt:textfonts w {{style fontlist}...} - set fonts for text widget w
#   style is one of {roman italic bold bolditalic typewriter} or
#   {heading0, ..., heading5}; font is list of X fonts, in order of
#   decreasing preference (cf ::aq::configure_tag_font in jtkutils.tcl).
######################################################################

proc j:rt:textfonts { w list } {
  foreach pair $list {
    set tag "richtext:font:[lindex $pair 0]"
    set fontlist [lindex $pair 1]
    ::aq::configure_tag_font $w $tag $fontlist
  }
}

######################################################################
# j:rt:type - return type of current rich text destination (text, TeX)
######################################################################

proc j:rt:type {} {
  global j_rt
  
  if { (! [info exists j_rt(type)])} {
    # this might be considered an error
    return {}
  } else {
    return $j_rt(type)
  }
}

######################################################################
# j:rt:destination - return current rich text destination (widget, file)
######################################################################

proc j:rt:destination {} {
  global j_rt
  
  if { (! [info exists j_rt(destination)]) } {
    # this might be considered an error
    return {}
  } else {
    return $j_rt(destination)
  }
}

######################################################################
# j:rt:done - finish writing rich text (clear vars, close files)
######################################################################

proc j:rt:done {} {
  global j_rt

  # to start, would close files if appropriate
  
  set j_rt(type) {}
  set j_rt(destination) {}
}
  
######################################################################
# CREATE PROCEDURES FOR:
# j:rt:rm text - write rich text (roman)
# j:rt:it text - write rich text (italic)
# j:rt:bf text - write rich text (bold face)
# j:rt:bi text - write rich text (bold italic)
# j:rt:tt text - write rich text (typewriter - monospaced)
# j:rt:hl text - write rich text (`headline' - larger bold)
######################################################################

set tmp_body {
  set type [j:rt:type]
  
  case $type in {
    {text} {			;# output to a text widget
      j:tagged_insert [j:rt:destination] $text $tag
    }
    default {
      error [subst [= richtext:unsupportedtype \
        {j:rt type "$type" is not supported.}]]
    }
  }
}

foreach pair {
  {rm roman}
  {it italic}
  {bf bold}
  {bi bolditalic}
  {tt typewriter}
  {hl heading1}
  {h0 heading0}
  {h1 heading1}
  {h2 heading2}
  {h3 heading3}
  {h4 heading4}
  {h5 heading5}
} {
  set command [lindex $pair 0]
  set style [lindex $pair 1]
  proc j:rt:$command {text} "  set tag richtext:font:$style\n$tmp_body"
}

######################################################################
# j:rt:tab - tab in rich text
######################################################################

proc j:rt:tab {} {
  j:rt:rm "\t"
}

######################################################################
# j:rt:cr - line break in rich text
######################################################################

proc j:rt:cr {} {
  j:rt:rm "\n"
}

######################################################################
# j:rt:par - paragraph break in rich text
######################################################################

proc j:rt:par {} {
  j:rt:rm "\n\n"
}

######################################################################
# j:rt:mkabbrevs - make shorter convenience procs, for text-intensive apps
######################################################################

# this creates shorter aliases rm, it, bf, bi, tt, hl, tab, cr, and
# par identical to the corresponding procedures starting with "j:rt:"

proc j:rt:mkabbrevs {} {
  foreach proc {rm it bf bi tt hl tab cr par} {
    proc $proc [info args j:rt:$proc] [info body j:rt:$proc]
  }
}

######################################################################
# rm - dummy do-nothing procedure to prevent unknown from calling /bin/rm
#   if you forget to j:rt:mkabbrevs
######################################################################

proc rm {args} {
  error [= richtext:rm \
    "Called `rm' without calling `j:rt:mkabbrevs'."]
}
