# jrichtext.tcl - procedures for dealing with rich text
# 
# 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.
# 
# 
# these procedures are required by
#     help.tk
#     edit.tk
#     browser.tk
#     people.tk
# they may be located in the file "~/.tk/jrt.tcl" (where they will
# be source'd by those applications on startup), or in the site-wide
# tk library directory, where they will be found (and loaded) by the
# default tk  unknown  procedure.
######################################################################

package provide stead 2.0

# te:tagged_insert w text args - insert tagged text into a text widget
# te:rt text dest - prepare to write rich text to text widget dest
# te:rt:type - return type of current rich text destination (text, TeX)
# te:rt:destination - return current rich text destination (widget, file)
# te:rt:textfonts {style font}... - set fonts for text widget
# te:rt:done - finish writing rich text (clear vars, close files)
# te:rt:rm text - write rich text (roman)
# te:rt:it text - write rich text (italic)
# te:rt:bf text - write rich text (bold face)
# te:rt:bi text - write rich text (bisexual)
# te:rt:tt text - write rich text (typewriter - monospaced)
# te:rt:hl text - write rich text (`headline' - larger bold)
# te:rt:tab - tab in rich text
# te:rt:cr - line break in rich text
# te:rt:par - paragraph break in rich text
# te: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 te:rt:mkabbrevs

######################################################################
# te: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 te: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
  }
}

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

proc te: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-*-*-*-*-iso8859-*
        $j_rt(destination) tag configure te:rt:rm -font \
          -adobe-helvetica-medium-r-normal--*-120-*-*-*-*-iso8859-*
        $j_rt(destination) tag configure te:rt:it -font \
          -adobe-helvetica-medium-o-normal--*-120-*-*-*-*-iso8859-*
        $j_rt(destination) tag configure te:rt:bf -font \
          -adobe-helvetica-bold-r-normal--*-120-*-*-*-*-iso8859-*
        $j_rt(destination) tag configure te:rt:bi -font \
          -adobe-helvetica-bold-o-normal--*-120-*-*-*-*-iso8859-*
        $j_rt(destination) tag configure te:rt:tt -font \
          -adobe-courier-medium-r-normal--*-120-*-*-*-*-iso8859-*
        $j_rt(destination) tag configure te:rt:hl -font \
          -adobe-helvetica-bold-o-normal--*-180-*-*-*-*-iso8859-*
      }
    }
    default {
      error "te:rt $type $destination: only type \"text\" is supported."
    }
  }
}


######################################################################
# te:rt:textfonts {style font}... - set fonts for text widget
#   style is one of {rm it bf bi tt hl}; font is an X font
#   future versions will support PostScript, TeX, maybe canvas, etc.
######################################################################

proc te:rt:textfonts { args } {
  case [te:rt:type] in {
    {text} {			;# output to a text widget
      set w [te:rt:destination]
      foreach pair $args {
        set tag "te:rt:[lindex $pair 0]"
        set font [lindex $pair 1]
        catch {$w tag configure $tag -font $font}
        if {$tag == "te:rt:rm"} {
          # configure text widget itself, so it sizes properly
          catch {$w configure -font $font}
        }
      }
    }
    default {
      error "te:rt:textfonts called when type of output was [te:rt:type]."
    }
  }
}

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

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

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

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

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

proc te:rt:done {} {
  global j_rt

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

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

foreach style {rm it bf bi tt hl} {
  proc te:rt:$style {text} "  set tag te:rt:$style$tmp_body"
}

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

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

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

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

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

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

######################################################################
# te: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 "te:rt:"

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

######################################################################
# rm - dummy do-nothing procedure to prevent unknown from calling 
# /bin/rm if you forget to te:rt:mkabbrevs
# 
# diam 14/12/99 : I WANT user /bin/rm from stead ! 
# So I comment that code
######################################################################

# proc rm {args} {
#   error "Called `rm' without calling `te:rt:mkabbrevs'."
# }

