# FILE: bkgdlogger.tcl
#
# Message handler for background processes
#
# Note: This is a "static" class, i.e., this no instance Constructor or
# any methods.  Just common variables and procs.

# There are two "Log" procs within this class: DisplayLog and FileLog.
# The DisplayLog is meant for use by processes (or interp threads) that
# has a display and want a one-at-a-time interactive display of
# messages.  This is typically used by the interface half of background
# processes like Oxs or mmArchive.  The alternative FileLog is used
# by processes without a display, but want all messages logged to
# a file.  This could be used by the backend of processes like Oxs
# or mmArchive.

# The global errorCode variable is set by Tcl when an error
# is thrown; the error may be generated by Tcl, or raised
# directly by the code via the Tcl "error" command or by
# a "return -code error ..."  In all cases, errorCode should
# be a list.  The first item on the list should be a category
# identifier.  At present, there are two errorCode categories
# generated by OOMMF code:
#
#   OC src
#   OOMMF msg_src msg_id maxcount
#
# The first type (OC) is generated by errors thrown inside Oc_Classes
# (and perhaps a few other standalone modules).  The second "src" field
# is used by the Oc_Log class for dispatch purposes.  All such sources
# should be registered with the Oc_Log class through the Oc_Log
# AddSource proc.  (The registration is automatically done by the
# Oc_Class infrastructure for each Oc_Class; the most common src values
# are Oc_Class names.)
#
# The second type (OOMMF) was introduced in May 2008 with the
# introduction of the Ow_BkgdLogger class.  errorCode's of the OOMMF
# variety have a list length of four.  As with the OC category, the
# second field is a messsage source.  However, msg_src is intended for
# human consumption as a debugging aid.  It is not used for message
# dispatch by Oc_Log or for other program flow control.  The third
# field, msg_id, is an identifier for the message class.  The
# Ow_BkgdLogger allows the user or the program code to disable messages
# by msg_id.  The fourth field, maxcount, is the recommended maximum
# number of messages of this type (where "type" is defined by msg_id) to
# log.  This value is intended for use by non-interactive loggers like
# the FileLog proc in Ow_BkgdLogger.  Interactive loggers like
# DisplayLog in Ow_BkgdLogger ignore this field in preference to
# allowing the user to specify when to disable particular messages.
#

Oc_Class Ow_BkgdLogger {

   # The message_queue contains an ordered list of messages waiting to
   # be displayed.  Each item of the list is itself a list, with the
   # following elements:
   #
   #      message id
   #      message timestamp
   #      message text
   #      message stack
   #      message source
   #      message type (error, warning, ...)
   #
   # Here the id is an identifier of the message type.  Some messages
   # are received with an id, for others an id is constructed (see the
   # Log procs).  Messages of a given id can be disabled by the user
   # (see the disabled_message array).
   #
   # The timestamp is the time at which the message was received by the
   # Log proc; this is the value returned by the Tcl 'clock seconds'
   # command.
   #
   # Message text is self explanatory.
   #
   # The message stack is the value of the errorInfo global when the Log
   # proc is called.
   #
   # The message source is extracted from the errorCode global when the
   # Log proc is called.  The "message source" is intended mainly as an
   # aid to debugging.  Note that this "source" is not necessarily the
   # same as the "source" used by the Oc_Log class.  In this class,
   # sources are arbitrary text strings used only for display to the
   # user.  They are not registered with the logging mechanism, and are
   # generally ignored by the processing code.  (One exception: the
   # source may be used in generating a message id for a message that is
   # sent to the Log proc without an id.)
   #
   # When a message id is disabled by the user, and entry is placed in
   # the disabled_messages array.  The message id is used as the index
   # (element "name").  The value associated with the index is set to
   # "1", but at present that value is not used; rather it is the
   # existence or not of the index that is used to determine whether or
   # not the id is disabled.
   #
   private common message_queue {}
   private array common disabled_messages

   # The display_window variable holds the name of the interactive
   # display window.  This is non-empty if and only if a window is
   # currently displayed.  If no messages are available for display then
   # this window is destroyed and the display_window variable is set to
   # the empty string.
   #
   private common display_window {}
   private common display_window_title "Error Messages"
   private common display_window_width 12c
   private common display_window_height
   private common display_window_bitmap "warning"

   ClassConstructor {
   }

   ClassDestructor {
      if {![string match {} $display_window] && \
             [winfo exists $display_window]} {
         destroy $display_window
      }
   }

   proc Reset {} {
      catch {unset disabled_messages }
   }

   private proc GetMsgId { msg } {
      global errorCode
      if {[llength $errorCode]>=3 && \
             [string match OOMMF [lindex $errorCode 0]]} {
         # "OOMMF" errorCodes have the following structure:
         #   OOMMF {msg source} {msg id} {max display count}
         set id [lindex $errorCode 2]
      } else {
         # Form id by computing CRC of errorCode + message
         set text "$errorCode : $msg"
         set crc [Nb_ComputeCRCBuffer text]
         set id "crc:$crc"
      }
      return $id
   }

   private proc BuildQueueItem { msg type src einfo ecode timestamp } {
      # Each entry on the message_queue is a list with the
      # following elements:
      #      message id
      #      message timestamp
      #      message text
      #      message stack
      #      message source
      #      message type (error, warning, ...)
      # These fields are described above in the preamble
      # to the Ow_BkgdLogger class.

      # To build stack trace, strip error message from head of einfo
      set header [string trim $msg]
      regsub -- "\n\\(\[^()\]*\\)\$" $header {} header
      set headlen [string length $header]
      set stack [string trim $einfo]
      if {[string compare -length $headlen $header $stack] == 0} {
         set stack [string trim [string range $stack $headlen end]]
         set subhead "while executing"
         if {[string compare -length [string length $subhead] \
                 $subhead $stack] == 0} {
            set stack "Error $stack"
         }
      }

      if {[llength $ecode]>=2 && \
             ([string match OOMMF [lindex $ecode 0]] || \
                 [string match OC [lindex $ecode 0]])} {
         set source [lindex $ecode 1]
      } else {
         set source $src
      }

      set id [Ow_BkgdLogger GetMsgId $msg]
      
      return [list $id $timestamp $msg $stack $source $type]
   }

   # Log is a wrapper around AddMessage that is suitable
   # for calling using the Oc_Log protocol.  AddMessage can
   # be called directly if errorInfo, errorCode, and timestamp
   # have been previously recorded.

   proc AddMessage { msg type src einfo ecode timestamp } {
      set entry [Ow_BkgdLogger BuildQueueItem $msg $type $src \
                    $einfo $ecode $timestamp]
      set id [lindex $entry 0]
      if {![info exists disabled_messages($id)]} {
         # Message not disabled; append to queue
         lappend message_queue $entry
         if {[string match {} $display_window]} {
            after idle [list Ow_BkgdLogger CreateMessageWindow]
         }
      }
   }

   proc Log { msg type src } {
      global errorInfo errorCode
      set timestamp [clock seconds]
      Ow_BkgdLogger AddMessage $msg type src $errorInfo $errorCode $timestamp
   }

   private proc DisableMessage { msg_id } {
      set disabled_messages($msg_id) 1
      set newqueue {}
      foreach elt $message_queue {
         if {[string compare $msg_id [lindex $elt 0]]!=0} {
            lappend newqueue $elt
         }
      }
      set message_queue $newqueue
   }

   private proc CreateMessageWindow {} {

      set parent [focus]    ;# Position dialog over toplevel with focus.
      if {[string match {} $parent]} {
         set parent "."
      } else {
         set parent [winfo toplevel $parent]
      }

      # Create top-level display window
      if {![string match {} $display_window] && \
             [winfo exists $display_window]} {
         destroy $display_window
      }
      set display_window .owBkgdLoggerDisplayWindow
      set display_window_width [winfo pixels . $display_window_width]
      if {![info exists display_window_height]} {
         set display_window_height [expr {int(ceil(0.5*$display_window_width))}]
      }
      set display_window_height [winfo pixels . $display_window_height]
      set window [toplevel $display_window \
                    -width $display_window_width \
                    -height $display_window_height]
      wm group $window $parent
      if {![info exists $display_window_title]} {
         set title [wm title .]
         if {![string match {} $title]} {
            append title ": "
         }
         append title "Error Messages"
         set display_window_title $title
      }
      wm title $window $display_window_title
      Ow_PositionChild $window $parent

      pack propagate $window 0 ;# keep initial size as specified above

      # Create and pack subwindows
      frame $window.top    -bd 5
      frame $window.bottom -bd 5
      label $window.top.bitmap -bitmap $display_window_bitmap
      pack $window.top.bitmap -side left -anchor w -padx 2m

      # Setup text display.  Use a canvas widget instead of a text
      # widget so we can determine the size of the message without
      # actually bringing it up on the display (via update idletasks).
      # The downside is that the canvas doesn't supply default bindings
      # to enable selections.
      set msg [canvas $window.top.msg -confine 1 \
                  -borderwidth 2 -relief flat \
                  -highlightthickness 0 -selectborderwidth 0 \
                  -width 0 -height 0]
      
      # Crop height and add vertical scrollbar
      $msg create rectangle 0 0 1 1 -outline {} ;# Space holder
      ## just to make sure 0 0 is in the bbox.
      set yscroll [scrollbar $window.top.yscroll -orient vertical \
                      -command [list $msg yview]]
      foreach {xmin ymin xmax ymax} [$msg bbox all] break
      set ymax [expr {$ymax+4}]
      $msg configure -yscrollcommand [list $yscroll set] -relief ridge \
         -yscrollincrement 0 -scrollregion [list $xmin $ymin $xmax $ymax]
      pack $msg -side left -fill both -expand 1
      pack $yscroll -side left -fill y
      pack $window.top -side top -fill both -expand 1
      # Add "power" scrolling.  This will be enabled after the first
      # <Configure> event, which will occur at display time.
      bind $msg <Configure> {+
         bind %W <B1-Leave><B1-Motion> {
            if {%%y<0} {
               %%W yview scroll -1 units
            } elseif {%%y>%h} {
               %%W yview scroll 1 units
            }
         }
      }

      # Add selection bindings to text in msg canvas.  These use the
      # mouse to set the PRIMARY selection
      $msg bind text <Button-1> {
         %W select clear
         %W select from current @[%W canvasx %x],[%W canvasy %y]
      }
      $msg bind text <B1-Motion> {
         %W select to current @[%W canvasx %x],[%W canvasy %y]
      }
      # Keystrokes to copy the PRIMARY selection into the clipboard.
      # Needed primarily for windows.
      bind $window <Control-c> _Ow_CopyPrimarySelectionToClipboard
      bind $window <Control-Insert> _Ow_CopyPrimarySelectionToClipboard

      # Add control buttons
      button $window.bottom.btnOK -text "OK" \
         -command {Ow_BkgdLogger PopAndDisplayMessage}
      button $window.bottom.btnAbort -text "Abort" \
         -command {Ow_BkgdLogger Abort}
      button $window.bottom.btnIgnoreMsgId -text "Ignore this\nmessage id" \
         -command {Ow_BkgdLogger IgnoreMsgId}
      foreach btn_name [list OK Abort IgnoreMsgId] {
         set btn $window.bottom.btn${btn_name}
         bind $btn <Key-Return> "$btn invoke"
         pack $btn -side left -expand 1 -padx 5
      }
      pack $window.bottom -side bottom -fill x -expand 0 -before $window.top
   
      # Code to make a "default" frame around the OK button.
      set dbtn $window.bottom.btnOK
      set fout [frame $window.bottom.defaultouter -bd 2 -relief sunken]
      lower $fout
      pack $fout -before $dbtn -side left -expand 1 -padx 5
      pack forget $dbtn
      pack $dbtn -in $fout -padx 3 -pady 3
      # Give this button the keyboard focus
      focus $dbtn
      wm protocol $window WM_DELETE_WINDOW "$dbtn invoke"

      Ow_SetIcon $window

      update idletasks
      bind $window <Configure> {+ Ow_BkgdLogger ChangeDisplaySize %W %w %h}
      Ow_BkgdLogger ShowMessage
   }

   private proc DestroyMessageWindow {} {
      catch {destroy $display_window}
      set display_window {}
   }

   callback proc ShowMessage {} {
      if {[string match {} $display_window] || \
             ![winfo exists $display_window]} {
         # This shouldn't happen...
         return
      }
      if {[llength $message_queue]<1} {
         Ow_BkgdLogger DestroyMessageWindow
         return
      }

      set msg [lindex $message_queue 0]
      foreach {id timestamp text stack source} $msg break
      set timestamp [clock format $timestamp]

      # In Tk 4.1 up to at least 8.5.5, the canvas widget
      # doesn't properly handle text strings that have too
      # many lines.  Also, it is not clear that it is helpful
      # to anyone to dump an error message that is thousands
      # of lines long.  So, for both reasons, truncate $text
      # and $stack if too long.  How long is too long?
      # Try 500.
      set textlist [split $text "\n"]
      if {[llength $textlist]>500} {
         set text [join [lrange $textlist 0 500] "\n"]
         append text "\n..."
      }
      set stacklist [split $stack "\n"]
      if {[llength $stacklist]>500} {
         set stack [join [lrange $stacklist 0 500] "\n"]
         append stack "\n..."
      }

      append text "\n\n--------------\n\n"
      append text "Message time: $timestamp\n"
      append text "Message   id: $id\n"
      append text "Message  src: $source"
      append text "\n\n--------------\n\n"
      append text "STACK TRACE:\n"
      append text "$stack"

      set msgwin $display_window.top.msg
      set textwidth [expr {[winfo width $msgwin] - 8}]
      $msgwin delete text
      $msgwin create text 4 4 -anchor nw -font [Oc_Font Get bold] \
         -text $text -width $textwidth -tags text
      foreach {xmin ymin xmax ymax} [$msgwin bbox all] break
      set ymax [expr {$ymax+4}]
      $msgwin configure -scrollregion [list $xmin $ymin $xmax $ymax]
   }

   callback proc ChangeDisplaySize { win newwidth newheight } {
      if {[string compare $display_window $win]==0} {
         # Track size changes
         set display_window_width $newwidth
         set display_window_height $newheight
         # Update message display
         Ow_BkgdLogger ShowMessage
      }
   }

   callback proc PopAndDisplayMessage {} {
      # Pop top message from queue, and show
      # next message on list.
      set message_queue [lreplace $message_queue 0 0]
      Ow_BkgdLogger ShowMessage
   }

   callback proc Abort {} {
      exit 1
   }

   callback proc IgnoreMsgId {} {
      set msg [lindex $message_queue 0]
      set msg_id [lindex $msg 0]
      Ow_BkgdLogger DisableMessage $msg_id
      Ow_BkgdLogger ShowMessage
   }

}

