#
# Console
# ----------------------------------------------------------------------
# Implements a console display widget using primitive widgets as the building
# blocks.  
#
#   PUBLIC ATTRIBUTES:
#
#
#   METHODS:
#
#     config ....... used to change public attributes
#     insert ....... inserts text in the text widget
#     einsert ...... inserts error text in the text widget
#     command ...... run a command and print output
#
#     PRIVATE METHODS
#
#     previous ..... recalls the previous command
#     next ......... recalls the next command
#     last ......... recalls the last command in the history list
#     first ........ recalls the first command in the history list
#
#   X11 OPTION DATABASE ATTRIBUTES
#
#
# ----------------------------------------------------------------------
#   AUTHOR:  Martin M. Hunt	hunt@cygnus.com     
#            Cygnus Solutions   
#


itcl_class Console {
  # ------------------------------------------------------------------
  #  CONSTRUCTOR - create new console window
  # ------------------------------------------------------------------
  constructor {config} {
    #
    #  Create a window with the same name as this object
    #
    set class [$this info class]
    @@rename $this $this-tmp-
    @@frame $this -class $class 
    @@rename $this $this-win-
    @@rename $this-tmp- $this
    @@tixScrolledText $this.stext -scrollbar y
    set twin [$this.stext subwidget text]

#    $twin config -wrap none
    $twin tag configure prompt_tag -foreground DarkGreen
    $twin tag configure err_tag -foreground red
#    $twin configure -font 9x15

    #
    # bind editing keys for console window
    #
    bind $twin <Return> "$this invoke; break"

    # History control.
    bind $twin <Control-p> "$this previous; break"
    bind $twin <Up> "$this previous; break"
    bind $twin <Control-n> "$this next; break"
    bind $twin <Down> "$this next; break"
    bind $twin <Meta-less> "$this first; break"
    bind $twin <Home> "$this first; break"
    bind $twin <Meta-greater> "$this last; break"
    bind $twin <End> "$this last; break"

    # Don't let left arrow or ^B go over the prompt
    bind $twin <Control-b> {
      if {[%W compare insert <= {cmdmark + 1 char}]} then {
	break
      }
    }
    bind $twin <Left> [bind $twin <Control-b>]

    # Don't let Control-h, Delete, or Backspace back up over the prompt.
    bind $twin <Control-h> {
      if {[%W compare insert <= {cmdmark + 1 char}]} then {
	break
      }
    }
    bind $twin <BackSpace> [bind $twin <Control-h>]
    bind $twin <Delete> {
      if {[pref get console deleteLeft]
	  && [%W compare insert <= cmdmark]} then {
	break
      }
    }

    # Control-a moves to start of line.
    bind $twin <Control-a> {
      %W mark set insert {cmdmark + 1 char}
      break
    }

    # Control-u deletes to start of line.
    bind $twin <Control-u> {
      %W delete {cmdmark + 1 char} insert
    }
    
    # Control-w deletes previous word.
    bind $twin <Control-w> {
      if {[%W compare {insert -1c wordstart} > cmdmark]} then {
	%W delete {insert -1c wordstart} insert
      }
    }

    # Don't allow key motion to move insertion point outside the command
    # area.  This is done by fixing up the insertion point after any key
    # movement.  We only need to do this after events we do not
    # explicitly override.  Note that since the edit line is always the
    # last line, we can't possibly go past it, so we don't bother
    # checking that.
    foreach event [bind Text] {
      if {[string match *Key* $event] && [bind $twin $event] == ""} then {
	bind $twin $event {
	  if {[%W compare insert <= {cmdmark + 1 char}]} then {
	    %W mark set insert {cmdmark + 1 char}
	  }
	}
      }
    }

    # Don't allow mouse to put cursor outside command line.  For some
    # events we do this by noticing when the cursor is outside the
    # range, and then saving the insertion point.  For others we notice
    # the saved insertion point.
    set ins [list _saved_insertion]
    bind $twin <1> [format {
      if {[%%W compare [tkTextClosestGap %%W %%x %%y] <= cmdmark]} then {
	set %s [%%W index insert]
      } else {
	set %s {}
      }
    } $ins $ins]
    bind $twin <B1-Motion> [format {
      if {"$%s" != ""} then {
	%%W mark set insert $%s
      }
      set %s {}
    } $ins $ins $ins]
    bind $twin <ButtonRelease-1> [format {
      if {"$%s" != ""} then {
	%%W mark set insert $%s
      }
      set %s {}
    } $ins $ins $ins]
    
    # don't allow inserting text outside the command line
    bind $twin <ButtonRelease-2> {
      if {(!$tkPriv(mouseMoved))
	  && [%W compare [tkTextClosestGap %W %x %y] <= cmdmark]} then {
	break
      }
    }
    
    setprompt
    pack append $this $this.stext {left expand fill}
    focus $twin
  }

  # ------------------------------------------------------------------
  #  DESTRUCTOR - destroy window containing widget
  # ------------------------------------------------------------------
  destructor {
    set top [winfo toplevel $this]
    destroy $this
    destroy $top
  }

  # ------------------------------------------------------------------
  #  METHOD:  config - used to change public attributes
  # ------------------------------------------------------------------
  method config {config} {}
    
  # ------------------------------------------------------------------
  #  METHOD:  insert - insert new text in the text widget
  # ------------------------------------------------------------------
  method insert {line} {
    if {$_needNL} then {
      $twin insert {insert linestart} "\n"
    }
    $twin insert {insert -1 line lineend} $line
    set _needNL 0
  }
  
  #-------------------------------------------------------------------
  #  METHOD:  einsert - insert error text in the text widget
  # ------------------------------------------------------------------
  method einsert {line} {
    if {$_needNL} then {
      $twin insert {insert linestart} "\n"
    }
    $twin insert {insert -1 line lineend} $line err_tag
    set _needNL 0
  }

  #-------------------------------------------------------------------
  #  METHOD:  previous - recall the previous command
  # ------------------------------------------------------------------
  method previous {} {
    if {$_histElement == -1} then {
      # Save partial command.
      set _partialCommand [$twin get {cmdmark + 1 char} {cmdmark lineend}]
    }
    incr _histElement
    set text [lindex $_history $_histElement]
    if {$text == ""} then {
      # No dice.
      incr _histElement -1
      # FIXME flash window.
    } else {
      $twin delete {cmdmark + 1 char} {cmdmark lineend}
      $twin insert {cmdmark + 1 char} $text
    }
  }

  #-------------------------------------------------------------------
  #  METHOD:  next - recall the next command (scroll forward)
  # ------------------------------------------------------------------
  method next {} {
    if {$_histElement == -1} then {
      # FIXME flash window.
      return
    }
    incr _histElement -1
    if {$_histElement == -1} then {
      set text $_partialCommand
    } else {
      set text [lindex $_history $_histElement]
    }
    $twin delete {cmdmark + 1 char} {cmdmark lineend}
    $twin insert {cmdmark + 1 char} $text
  }

  #-------------------------------------------------------------------
  #  METHOD:  last - get the last history element
  # ------------------------------------------------------------------
  method last {} {
    set _histElement 0
    next
  }

  #-------------------------------------------------------------------
  #  METHOD:  first - get the first (earliest) history element
  # ------------------------------------------------------------------
  method first {} {
    set _histElement [expr {[llength $_history] - 1}]
    previous
  }



  #-------------------------------------------------------------------
  #  METHOD:  setprompt - put a prompt at the beginning of a line
  # ------------------------------------------------------------------
  method setprompt {} {
    if {$_invoking} then {
      set prompt ""
    } else {
      set prompt [pref get console prompt]
    }
    $twin insert {insert linestart} $prompt prompt_tag
    $twin mark set cmdmark "insert -1 char"
    $twin see insert
  }

  #-------------------------------------------------------------------
  #  METHOD:  activate - run this after a command is run
  # ------------------------------------------------------------------
  method activate {} {
    if {$_invoking > 0} then {
      incr _invoking -1
      setprompt
    }
  }

  #-------------------------------------------------------------------
  #  METHOD:  invoke - invoke a command
  # ------------------------------------------------------------------
  method invoke {} {
    incr _invoking
    set text [$twin get {cmdmark + 1 char} {cmdmark lineend}]
    if {$text == ""} then {
      set text [lindex $_history 0]
      $twin insert {insert lineend} $text
    }
    $twin mark set insert {insert lineend}
    $twin insert {insert lineend} "\n"

    
    # Only push new nonempty history items.
    if {$text != "" && [lindex $_history 0] != $text} then {
      lvarpush _history $text
    }
    
    set index [$twin index insert]
    
    # Clear current history element, and current partial element.
    set _histElement -1
    set _partialCommand ""
    
    # Need a newline before next insert.
    set _needNL 1
    
    # run command
    set result [catch {gdb_cmd "$text"} message]
    if {$result} then {
      if {[pref get gdb debugMode]} then {
	global errorInfo
	$twin insert $index "Error: $errorInfo\n" err_tag
      } else {
	$twin insert $index "Error: $message\n" err_tag
      }
    } elseif {$message != ""} then {
      $twin insert $index "$message\n"
    }

    # Make the prompt visible again.
    activate
    
    # Make sure the insertion point is visible.
    $twin see insert
  }

  
  #
  #  PUBLIC DATA
  #
  common _saved_insertion
  #
  #  PROTECTED DATA
  #    twin .......... the text subwidget
  #
  protected twin
  protected _invoking 0
  protected _needNL 1
  protected _history {}
  protected _histElement -1
  protected _partialCommand ""
}

#fixme.  move this somewhere else
proc lvarpush {listVar element {index 0}} {
  upvar $listVar var
  if {![info exists var]} then {
    lappend var $element
  } else {
    set var [linsert $var $index $element]
  }
}
