Import Upstream version 1.3.7

1 files changed, 620 insertions, 0 deletions

diff --git a/lib/leftpanel/sfrwatches.tcl b/lib/leftpanel/sfrwatches.tcl
new file mode 100755
index 0000000..ba47dc5
--- /dev/null
+++ b/lib/leftpanel/sfrwatches.tcl
@@ -0,0 +1,620 @@
+#!/usr/bin/tclsh
+# Part of MCU 8051 IDE ( http://mcu8051ide.sf.net )
+
+############################################################################
+#    Copyright (C) 2007-2009 by Martin Ošmera                              #
+#    martin.osmera@gmail.com                                               #
+#                                                                          #
+#    This program is free software; you can redistribute it and#or modify  #
+#    it under the terms of the GNU General Public License as published by  #
+#    the Free Software Foundation; either version 2 of the License, or     #
+#    (at your option) any later version.                                   #
+#                                                                          #
+#    This program is distributed in the hope that it will be useful,       #
+#    but WITHOUT ANY WARRANTY; without even the implied warranty of        #
+#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the         #
+#    GNU General Public License for more details.                          #
+#                                                                          #
+#    You should have received a copy of the GNU General Public License     #
+#    along with this program; if not, write to the                         #
+#    Free Software Foundation, Inc.,                                       #
+#    59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.             #
+############################################################################
+
+# --------------------------------------------------------------------------
+# DESCRIPTION
+# Provides SFR watches for left panel
+# --------------------------------------------------------------------------
+
+class SFRWatches {
+
+	## COMMON
+	 # Font for addresses and register names
+	common main_font	[font create	\
+		-family $::DEFAULT_FIXED_FONT	\
+		-size -14			\
+		-weight bold			\
+	]
+	 # Just another font but not bold
+	common roman_font	[font create	\
+		-family $::DEFAULT_FIXED_FONT	\
+		-size -14			\
+	]
+	 # Fonr for register entry boxes
+	common entry_font	[font create	\
+		-family $::DEFAULT_FIXED_FONT	\
+		-size -12			\
+		-weight bold			\
+	]
+
+	## PRIVATE
+	private variable text_widget			;# Widget: Text widget containing SFR watches
+	private variable scrollbar			;# Widget: Scrollbar for $text_widget
+	private variable search_entry			;# Widget: Search entry box at the bottom of the panel
+	private variable search_clear_but		;# Widget: Button "Clear" at the bottom of the panel
+	private variable main_left_frame		;# Widget: Frame containing $text_widget and its header label
+	private variable entry_count		0	;# Int: Number of SFRs
+	private variable validation_ena		1	;# Bool: SFR entry box validation enabled
+	private variable haddr2idx			;# Array: $haddr2idx($hex_addr) --> row_in_text_widget - 1
+	private variable addr2idx			;# Array: $addr2idx($dec_addr) --> row_in_text_widget - 1
+	private variable reg2idx			;# Array: $addr2idx($register_name_upppercase) --> row_in_text_widget - 1
+	private variable last_selected_line	0	;# Int: Selected row in the text widget
+	private variable search_ena		1	;# Bool: Search enabled
+	private variable menu				;# Widget: Popup menu for the text widget
+
+	# Variables related to object initialization
+	private variable parent				;# Parent GUI object (tempotary variable)
+	private variable gui_initialized	0	;# GUI ready
+
+	constructor {} {
+	}
+
+	destructor {
+		if {$gui_initialized} {
+			menu_Sbar_remove $menu
+		}
+	}
+
+	## Prepare object for creating its GUI
+	 # @parm Widget _parent - parent container (some frame)
+	 # @return void
+	public method PrepareSFRWatches {_parent} {
+		set parent $_parent
+		set gui_initialized 0
+	}
+
+	## Initialize SFR watches GUI
+	 # @return void
+	public method CreateSFRWatchesGUI {} {
+		if {$gui_initialized} {return}
+		set gui_initialized 1
+
+		set validation_ena 0
+		create_GUI
+		fill_gui
+		set validation_ena 1
+
+		if {![$this is_frozen]} {
+			sfr_watches_disable
+		}
+	}
+
+	## Create entry box to embedd in the text widget
+	 # @parm Int i		- Entry index (row - 1)
+	 # @parm String type	- Entry type (hex or dec)
+	 # @parm Int addr	- SFR address (128..255)
+	 # @parm String reg	- SFR name (e.g. PSW)
+	 # @return Widget - Created entry box
+	private method create_entry {i type addr reg} {
+		# Determinate entry box width
+		if {$type == {hex}} {
+			set width 2
+		} {
+			set width 3
+		}
+
+		# Create entry widget
+		set entry [entry $text_widget.${type}_entry_${i}		\
+			-width $width 		-font $entry_font		\
+			-bg {#FFFFFF}		-validate all			\
+			-takefocus 0		-highlightthickness 0		\
+			-disabledbackground {#FFFFFF}				\
+			-vcmd "$this sfr_watches_validate ${type} $addr %P"	\
+			-bd 0			-justify right			\
+		]
+
+		# Perform name correction for accumulators
+		if {$reg == {A} || $reg == {B}} {
+			append reg {_hex}
+		}
+
+		# Set event bindins
+		bind $entry <Motion>	{help_window_show %X %Y}
+		bind $entry <Leave>	{help_window_hide}
+		bind $entry <FocusIn>	"$this unmark_entry $addr"
+		bind $entry <Enter>	"$this create_help_window_ram $reg"
+		bind $entry <Button-1>	"$this sfr_watches_select_line 0 [expr {$i + 1}] $type"
+		bind $entry <Key-Up>	"$this sfr_watches_up $type 1"
+		bind $entry <Key-Down>	"$this sfr_watches_down $type 1"
+		bind $entry <Key-Next>	"$this sfr_watches_down $type 4"
+		bind $entry <Key-Prior>	"$this sfr_watches_up $type 4"
+		bind $entry <Button-4>	"$text_widget yview scroll -5 units"
+		bind $entry <Button-5>	"$text_widget yview scroll +5 units"
+		if {$type == {hex}} {
+			bind $entry <Key-Right>	"
+				focus $text_widget.dec_entry_${i}
+				$text_widget.dec_entry_${i} selection clear
+				update
+				$text_widget.dec_entry_${i} icursor 0"
+		} {
+			bind $entry <Key-Left>	"
+				focus $text_widget.hex_entry_${i}
+				$text_widget.hex_entry_${i} selection clear
+				update
+				$text_widget.dec_entry_${i} icursor end"
+		}
+
+		return $entry
+	}
+
+	## Complite GUI initialization (load all SFRs into the text widget)
+	 # @return void
+	private method fill_gui {} {
+		set entry_count 0
+		set validation_ena 0
+
+		# Iterate over defined SFRs ({{addr name} ... })
+		foreach reg [$this simulator_get_sfrs] {
+			# Determinate hexadecimal address
+			set addr [lindex $reg 0]
+			set hex_addr [format %X $addr]
+			if {[string length $hex_addr] == 1} {
+				set hex_addr "0$hex_addr"
+			} elseif {[string length $hex_addr] == 3} {
+				set hex_addr [string replace $hex_addr 0 0]
+			}
+			# Determinate register name and make it 8 characters long
+			set reg [lindex $reg 1]
+			set reg_org $reg
+			switch -- $reg {
+				SBUFR {
+					set reg {SBUF R}
+				}
+				SBUFT {
+					set reg {SBUF T}
+				}
+				default {
+					set reg $reg
+				}
+			}
+			append reg [string repeat { } [expr {8 - [string length $reg]}]]
+
+			# Register this SFR
+			set haddr2idx($hex_addr) $entry_count
+			set addr2idx($addr) $entry_count
+			set reg2idx($reg_org) $entry_count
+
+			# Insert address and name into the text widget
+			$text_widget insert end $hex_addr
+			$text_widget insert end { }
+			$text_widget insert end $reg
+
+			# Set highlighting tags
+			set line [expr {int([$text_widget index insert])}]
+			$text_widget tag add tag_addr $line.0 $line.2
+			$text_widget tag add tag_name $line.3 $line.11
+
+			# Create and insert embedded entry boxes
+			set entry [create_entry $entry_count hex $addr $reg_org]
+			$entry insert 0 [$this getSfr $addr]
+			$text_widget window create end -window $entry -pady 0
+			$text_widget insert end { }
+			set entry [create_entry $entry_count dec $addr $reg_org]
+			$entry insert 0 [$this getSfrDEC $addr]
+			$text_widget window create end -window $entry -pady 0
+
+			# Finalize this row
+			$text_widget insert end "\n"
+			incr entry_count
+		}
+
+		# Remove the last line (empty line) and disable the text widget
+		$text_widget delete end-1l end
+		set validation_ena 1
+	}
+
+	## Set value of SFR at current line to the specified value
+	 # @parm String value - Hexadecimal value
+	 # @return void
+	public method sfr_watches_set_current_to {value} {
+		set idx [expr {$last_selected_line - 1}]
+		set addr [lindex [$this simulator_get_sfrs] [list $idx 0]]
+
+		$this setSfr $addr $value
+		$this Simulator_GUI_sync S $addr
+	}
+
+	## Create GUI elements of this panel
+	 # @return void
+	private method create_GUI {} {
+		# Create and pack panel frames
+		set main_frame [frame $parent.main_frame]
+		set main_left_frame [frame $main_frame.left]
+		pack $main_left_frame -side left -fill both -expand 1
+		pack $main_frame -fill both -expand 1
+
+		# Create text widget and its header
+		pack [label $main_left_frame.header_label	\
+			-anchor w -justify left -pady 0 -padx 2	\
+			-fg ${::Simulator_GUI::small_color}	\
+			-font ${::Simulator_GUI::smallfont}	\
+			-text "[mc {Register}]		[mc {HEX}]    [mc {DEC}]" -width 1	\
+		] -fill x -pady 0 -anchor nw
+		set text_widget [text $main_left_frame.text		\
+			-bg {#FFFFFF} -font $roman_font -bd 2		\
+			-width 0 -height 0 -wrap none			\
+			-yscrollcommand "$this sfr_watches_scroll_set"	\
+			-cursor left_ptr				\
+		]
+
+		# Create popup menu for the text widget
+		set menu $text_widget.menu
+		menuFactory {
+			{command	{Set to 0x00}	{}	9	"sfr_watches_set_current_to 00"
+				{}	"Set this register to 0"}
+			{command	{Set to 0xFF}	{}	9	"sfr_watches_set_current_to FF"
+				{}	"Set this register to 255"}
+		} $menu 0 "$this " 0 {}
+
+		# Set event bindings for the text widget
+		bindtags $text_widget $text_widget
+		foreach event {
+			<ButtonRelease-1>	<B1-Enter>	<B1-Leave>
+			<B2-Motion>		<Button-5>	<Button-4>
+			<MouseWheel>
+		} {
+			bind $text_widget $event [bind Text $event]
+		}
+		bind $text_widget <Button-1>	\
+			"$this sfr_watches_select_line 0 \[expr {int(\[%W index @%x,%y\])}\] hex"
+		bind $text_widget <ButtonRelease-3>	\
+			"$this sfr_watches_select_line 0 \[expr {int(\[%W index @%x,%y\])}\] hex
+			tk_popup $menu %X %Y"
+
+		# Pack the text widget and create its scrollbar
+		pack $text_widget -fill both -expand 1
+		set scrollbar [ttk::scrollbar $main_frame.scrollbar	\
+			-orient vertical -command "$text_widget yview"	\
+		]
+
+		# Create bottom frame (search bar)
+		set search_frame [frame $parent.top]
+		pack [label $search_frame.lbl	\
+			-text [mc "Search:"]	\
+		] -side left
+		set search_entry [ttk::entry $search_frame.entry		\
+			-width 0						\
+			-validate all						\
+			-validatecommand "$this sfr_watches_search_validate %P"	\
+		]
+		pack $search_entry -side left -fill x -expand 1
+		set search_clear_but [ttk::button $search_frame.button	\
+			-style Flat.TButton				\
+			-state disabled					\
+			-image ::ICONS::16::clear_left			\
+			-command "$search_entry delete 0 end"		\
+		]
+		pack $search_clear_but -side right -after $search_entry
+		pack $search_frame -fill x
+
+		# Create highlighting tags for the text widget
+		$text_widget tag configure tag_addr	\
+			-foreground {#000000} -font $main_font
+		$text_widget tag configure tag_name	\
+			-foreground {#0000DD} -font $main_font
+		$text_widget tag configure tag_curLine	\
+			-background ${::RightPanel::selection_color_dark}
+	}
+
+	## Adjust scrollbar
+	 # @parm Float frac0 - 1st fraction
+	 # @parm Float frac1 - 2nd fraction
+	 # @return void
+	public method sfr_watches_scroll_set {frac0 frac1} {
+		# Hide scrollbar
+		if {$frac0 == 0 && $frac1 == 1} {
+			if {[winfo ismapped $scrollbar]} {
+				pack forget $scrollbar
+			}
+		# Show scrollbar
+		} {
+			if {![winfo ismapped $scrollbar]} {
+				pack $scrollbar			\
+					-side left		\
+					-fill y			\
+					-after $main_left_frame
+			}
+			$scrollbar set $frac0 $frac1
+		}
+	}
+
+	## Validate content of search entry box at the bottom bar
+	 # @parm String string - String to validate
+	 # @return Bool - Always 1
+	public method sfr_watches_search_validate {string} {
+		# Check if searching is enabled
+		if {!$search_ena} {return 1}
+
+		# Adjust state of clear button (+ clear selection on the text widget)
+		if {$string == {}} {
+			$search_clear_but configure -state disabled
+			$search_entry configure -style TEntry
+			sfr_watches_select_line 1 0 hex
+			return 1
+		} {
+			$search_clear_but configure -state normal
+		}
+
+		set string [string toupper $string]
+
+		# Perform case insensitive search for the given chunk of SFR name and address
+		foreach arr {reg2idx haddr2idx} {
+			foreach str [lsort -ascii -increasing [array names $arr]] {
+				# Search successful
+				if {![string first $string $str]} {
+					$search_entry configure -style StringFound.TEntry
+					sfr_watches_select_line 1 [expr {[subst "\${${arr}(${str})}"] + 1}] hex
+					return 1
+				}
+			}
+		}
+
+		# Search failed
+		$search_entry configure -style StringNotFound.TEntry
+		return 1
+	}
+
+	## Select line in the text widget
+	 # @parm Bool search	- Invoked form search validator (do not clear search entry box)
+	 # @parm Int line	- Target line
+	 # @parm String type	- Entry box to select (hex or dec)
+	 # @return void
+	public method sfr_watches_select_line {search line type} {
+
+		# Unselect the last selected line and determinate cursor position
+		if {$last_selected_line} {
+			$text_widget tag remove tag_curLine 0.0 end
+			$this simulator_reg_label_set_highlighted $last_selected_line 0
+			incr last_selected_line -1
+			foreach tp {dec hex} {
+				$text_widget.${tp}_entry_$last_selected_line selection clear
+				$text_widget.${tp}_entry_$last_selected_line configure	\
+					-bg {#FFFFFF} -disabledbackground {#FFFFFF}
+			}
+			set cursor [$text_widget.${type}_entry_$last_selected_line index insert]
+		} {
+			set cursor 0
+		}
+
+		# Adjust last selected line (if 0 the return)
+		set last_selected_line $line
+		if {!$line} {
+			return
+		}
+
+
+		# Highlight this line as selected in the text widget
+		$text_widget tag add tag_curLine	\
+			$last_selected_line.0		\
+			$last_selected_line.0+1l
+		$text_widget see $last_selected_line.0
+
+		# Highlight SFR on this line in simulator control panel
+		$this simulator_reg_label_set_highlighted $last_selected_line 1
+
+		# Adjust background color for entry boxes at this line
+		incr line -1
+		$text_widget.dec_entry_$line configure			\
+			-fg ${Simulator::normal_color}			\
+			-bg ${::RightPanel::selection_color_dark}	\
+			-disabledbackground ${::RightPanel::selection_color_dark}
+		$text_widget.hex_entry_$line configure			\
+			-fg ${Simulator::normal_color}			\
+			-bg ${::RightPanel::selection_color_dark}	\
+			-disabledbackground ${::RightPanel::selection_color_dark}
+
+		# Clear search entry box and focus and entry box at this line
+		if {!$search} {
+			$text_widget.${type}_entry_$line icursor $cursor
+			$text_widget.${type}_entry_$line selection range 0 end
+			focus $text_widget.${type}_entry_$line
+			set search_ena 0
+			$search_entry delete 0 end
+			set search_ena 1
+		}
+	}
+
+	## Validator for SFR value entry boxes
+	 # @parm String type	- Entry box type (hex or dec)
+	 # @parm Int addr	- Register address
+	 # @parm String value	- String to validate
+	 # @return Bool - Validation result
+	public method sfr_watches_validate {type addr value} {
+		# Prevent recursion
+		if {!$validation_ena} {return 1}
+		set validation_ena 0
+
+		# Validate value
+		if {$value == {}} {
+			set value 0
+		}
+		if {$type == {hex}} {
+			if {![string is xdigit $value]} {
+				set validation_ena 1
+				return 0
+			}
+			set value [expr "0x$value"]
+		} {
+			if {![string is digit $value]} {
+				set validation_ena 1
+				return 0
+			}
+		}
+		if {$value > 255 || $value < 0} {
+			set validation_ena 1
+			return 0
+		}
+
+		# Synchronize with engine and simulator control panel
+		$this setSfr $addr [format %X $value]
+		$this SimGUI_disable_sync
+		$this Simulator_GUI_sync S $addr
+		$this SimGUI_enable_sync
+
+		# Synchronize with the other one entry box
+		if {$type == {hex}} {
+			$text_widget.dec_entry_$addr2idx($addr) delete 0 end
+			$text_widget.dec_entry_$addr2idx($addr) insert 0 $value
+		} {
+			set value [format %X $value]
+			if {[string length $value] == 1} {
+				set value "0$value"
+			}
+			$text_widget.hex_entry_$addr2idx($addr) delete 0 end
+			$text_widget.hex_entry_$addr2idx($addr) insert 0 $value
+		}
+
+		# Done
+		set validation_ena 1
+		return 1
+	}
+
+	## Remove all SFRs for the text widget and unregister them
+	 # @return void
+	private method clear_gui {} {
+		if {!$gui_initialized} {return}
+
+		# Clear SFR name label highlight in simultor contol panel
+		if {$last_selected_line} {
+			$this simulator_reg_label_set_highlighted $last_selected_line 0
+		}
+
+		# Reset object variables
+		array unset haddr2idx
+		array unset addr2idx
+		array unset reg2idx
+		set last_selected_line 0
+		set entry_count 0
+
+		# Clear the text widget
+		$text_widget delete 1.0 end
+		foreach wdg [$text_widget window names] {
+			destroy $wdg
+		}
+	}
+
+	## Set new value of certain SFR in this panel
+	 # @parm Int addr	- SFR address
+	 # @parm Int new_val	- New SFR value
+	 # @return void
+	public method sfr_watches_sync {addr new_val} {
+		if {!$gui_initialized} {return}
+
+		# Prevent recursion
+		if {!$validation_ena} {return}
+		set validation_ena 0
+
+		# Check if this SFR is avaliable here
+		if {[lsearch [array names addr2idx] $addr] == -1} {
+			set validation_ena 1
+			return
+		}
+
+		# Determinate references of HEX and DEC entry boxes
+		set hex_entry $text_widget.hex_entry_$addr2idx($addr)
+		set dec_entry $text_widget.dec_entry_$addr2idx($addr)
+
+		# Highlight entry boxes
+		set org_val [$dec_entry get]
+		if {$org_val != $new_val} {
+			$hex_entry configure -fg ${::Simulator_GUI::hcolor}
+			$dec_entry configure -fg ${::Simulator_GUI::hcolor}
+		}
+
+		# Set decimal value
+		$dec_entry delete 0 end
+		$dec_entry insert 0 $new_val
+
+		# Set hexadecimal value
+		set new_val [format %X $new_val]
+		if {[string length $new_val] == 1} {
+			set new_val "0$new_val"
+		}
+		$hex_entry delete 0 end
+		$hex_entry insert 0 $new_val
+
+		# Reenable entry box value validations
+		set validation_ena 1
+	}
+
+	## Enable this panel
+	 # @return vois
+	public method sfr_watches_enable {} {
+		if {!$gui_initialized} {return}
+		$menu entryconfigure [::mc "Set to 0x00"] -state normal
+		$menu entryconfigure [::mc "Set to 0xFF"] -state normal
+		for {set i 0} {$i < $entry_count} {incr i} {
+			$text_widget.hex_entry_$i configure -state normal
+			$text_widget.dec_entry_$i configure -state normal
+		}
+	}
+
+	## Disable this panel
+	 # @return vois
+	public method sfr_watches_disable {} {
+		if {!$gui_initialized} {return}
+		$menu entryconfigure [::mc "Set to 0x00"] -state disabled
+		$menu entryconfigure [::mc "Set to 0xFF"] -state disabled
+		for {set i 0} {$i < $entry_count} {incr i} {
+			$text_widget.hex_entry_$i configure -state disabled
+			$text_widget.dec_entry_$i configure -state disabled
+		}
+	}
+
+	## This function shuld be call after processor was changed
+	 # Reload avaliable SFRs
+	 # @return void
+	public method sfr_watches_commit_new_sfr_set {} {
+		if {!$gui_initialized} {return}
+		clear_gui
+		fill_gui
+	}
+
+	## Move selected line up
+	 # @parm String type	- Which entry box should be selected (hex or dec)
+	 # @parm Int lines	- Number of lines to move by
+	 # @return void
+	public method sfr_watches_up {type lines} {
+		set line $last_selected_line
+		incr line -$lines
+		if {$line <= 0} {
+			set line $entry_count
+		}
+
+		sfr_watches_select_line 0 $line $type
+	}
+
+	## Move selected line down
+	 # @parm String type	- Which entry box should be selected (hex or dec)
+	 # @parm Int lines	- Number of lines to move by
+	 # @return void
+	public method sfr_watches_down {type lines} {
+		set line $last_selected_line
+		incr line $lines
+		if {$line >= $entry_count} {
+			set line 0
+		}
+
+		sfr_watches_select_line 0 $line $type
+	}
+}