Import Upstream version 1.3.7

1 files changed, 632 insertions, 0 deletions

diff --git a/lib/bottompanel/messages.tcl b/lib/bottompanel/messages.tcl
new file mode 100755
index 0000000..51c96ce
--- /dev/null
+++ b/lib/bottompanel/messages.tcl
@@ -0,0 +1,632 @@
+#!/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
+# Implements messages text for the bottom panel of the project tab
+# --------------------------------------------------------------------------
+
+class Messages {
+
+	## COMMON
+	common set_shortcuts	{}		;# Currently set shortcut bindigs for messages text
+	common shortcuts_cat	{messages}	;# Key shortcut categories related to messages text
+	# Normal font for messages text
+	common messages_normal_font [font create	\
+		-family $::DEFAULT_FIXED_FONT		\
+		-size -12]
+	# Bold font for messages text
+	common messages_bold_font [font create	\
+		-family $::DEFAULT_FIXED_FONT	\
+		-size -12			\
+		-weight bold]
+	# Definition of popup menu for messages text
+	common MESSAGESMENU {
+		{command	{Select all}	{Ctrl+A}		0	"select_all_messages_text"
+			{}		"Select all text in this TextBox"}
+		{command	{Copy}		{Ctrl+C}		0	"copy_messages_text"
+			{editcopy}	"Copy selected text into clipboard"}
+		{command	{Clear}		{$messages:clear_mess}	1	"clear_messages_text"
+			{editdelete}	"Clear all messages"}
+		{separator}
+		{command	{Find}		{$messages:mess_find}	0	"messages_text_find_dialog"
+			{find}		{}}
+		{command	{Find next}	{$messages:mess_find_n}	5	"messages_text_find_next"
+			{down0}		{}}
+		{command	{Find previous}	{$messages:mess_find_p}	8	"messages_text_find_prev"
+			{up0}		{}}
+	}
+
+	private variable main_frame			;# Widget: Main frame
+	private variable messages_text			;# Widget: text widget
+	private variable menu			{}	;# Widget: popup menu
+	private variable hyperlink_line_start		;# TextIndex: Active hyperlink line start index
+
+	# Variables related to object initialization
+	private variable parent				;# Widget: parent widget
+	private variable gui_initialized	0	;# Bool: GUI initialized
+
+	# Variables related to search bar
+	private variable search_frame			;# Widget: Search bar frame
+	private variable last_find_index	{}	;# String: Index of last found occurence of the search string
+	private variable search_string			;# String: Search string
+	private variable search_string_length		;# Int: Length of the search string
+	private variable search_entry			;# Widget: Search bar entry box
+	private variable search_find_next		;# Widget: Button "Next"
+	private variable search_find_prev		;# Widget: Button "Prev"
+
+	constructor {} {
+	}
+
+	destructor {
+		# Remove status bar help for popup menus
+		if {$menu != {}} {
+			menu_Sbar_remove $menu
+		}
+	}
+
+	## Prepare object for creating its GUI
+	 # @parm Widget _parent	- GUI parent widget
+	 # @return void
+	public method PrepareMessages {_parent} {
+		set parent $_parent
+		set gui_initialized 0
+	}
+
+	## Inform this tab than it has became active
+	 # @return void
+	public method MessagesTabRaised {} {
+		focus $messages_text
+	}
+
+	## Create GUI of messages tab
+	 # @return void
+	public method CreateMessagesGUI {} {
+		if {$gui_initialized} {return}
+		set gui_initialized 1
+
+		## Create GUI of main frame
+		set main_frame [frame $parent.main_frame]
+		# Create messages text and its scrollbar
+		set messages_text [text $main_frame.messages_text	\
+			-state disabled -cursor xterm			\
+			-yscrollcommand "$main_frame.msg_text_scrl set"	\
+			-font $messages_normal_font -wrap word		\
+			-tabstyle wordprocessor				\
+		]
+		set messages_text_scrl [ttk::scrollbar $main_frame.msg_text_scrl	\
+			-command "$messages_text yview" -orient vertical		\
+		]
+		# Text tags for messages text
+		$messages_text tag configure error	\
+			-foreground #FF0000		\
+			-underline 1			\
+			-font $messages_bold_font
+		$messages_text tag configure error_nu	\
+			-foreground #FF0000		\
+			-underline 0			\
+			-font $messages_bold_font
+		$messages_text tag configure warning	\
+			-foreground #FF8800		\
+			-underline 1			\
+			-font $messages_bold_font
+		$messages_text tag configure warning_nu	\
+			-foreground #FF8800		\
+			-underline 0			\
+			-font $messages_bold_font
+		$messages_text tag configure successful	\
+			-foreground #00DD00		\
+			-font $messages_bold_font
+		$messages_text tag configure hyper_link_over	\
+			-foreground #0055FF -underline 0	\
+			-font $messages_bold_font
+		$messages_text tag raise hyper_link_over
+
+		$messages_text tag bind error	<ButtonPress-1>	"$this messages_text_anchor %x %y"
+		$messages_text tag bind error	<Enter>		"$this messages_text_hyperlink_enter %x %y"
+		$messages_text tag bind error	<Leave>		"$this messages_text_hyperlink_leave"
+		$messages_text tag bind error	<Motion>	"$this messages_text_hyperlink_motion %x %y"
+		$messages_text tag bind warning	<ButtonPress-1> "$this messages_text_anchor %x %y"
+		$messages_text tag bind warning	<Enter>		"$this messages_text_hyperlink_enter %x %y"
+		$messages_text tag bind warning	<Leave>		"$this messages_text_hyperlink_leave"
+		$messages_text tag bind warning	<Motion>	"$this messages_text_hyperlink_motion %x %y"
+		# Popup menu for messages text
+		set menu $messages_text.messages_text_menu
+		messages_text_makePopupMenu
+		# Bindings for messages text
+		bind $messages_text <ButtonPress-1>	"focus $messages_text"
+		bind $messages_text <Control-a>		"$this select_all_messages_text"
+		bind $messages_text <ButtonRelease-3>	"tk_popup $menu %X %Y; break"
+		bind $messages_text <Key-Menu>		"$this messages_text_key_menu; break"
+		# Pack parts of main frame
+		pack $messages_text -fill both -expand 1 -side left
+		pack $messages_text_scrl -fill y -side right
+		pack $main_frame -fill both -expand 1
+
+		## Create GUI components in search bar frame
+		set search_frame [frame $parent.search_frame]
+		 # Search entry box
+		set search_entry [ttk::entry $search_frame.entry		\
+			-width 30						\
+			-validate all						\
+			-validatecommand "$this messages_text_search %P"	\
+		]
+		bind $search_entry <Key-Escape> "$this messages_text_hide_find_dialog"
+		 # Button: "Next"
+		set search_find_next [ttk::button $search_frame.find_next_but	\
+			-image ::ICONS::16::down0				\
+			-style Flat.TButton					\
+			-command "$this messages_text_find_next"		\
+			-state disabled						\
+		]
+		DynamicHelp::add $search_frame.find_next_but \
+			-text [mc "Find next occurence of search string"]
+		 # Button: "Prev"
+		set search_find_prev [ttk::button $search_frame.find_prev_but	\
+			-image ::ICONS::16::up0					\
+			-style Flat.TButton					\
+			-command "$this messages_text_find_prev"		\
+			-state disabled						\
+		]
+		DynamicHelp::add $search_frame.find_prev_but \
+			-text [mc "Find previous occurence of search string"]
+		 # Button: "Close"
+		pack [ttk::button $search_frame.close_but			\
+			-image ::ICONS::16::button_cancel			\
+			-style Flat.TButton					\
+			-command "$this messages_text_hide_find_dialog"		\
+		] -side left
+		DynamicHelp::add $search_frame.close_but \
+			-text [mc "Hide search bar"]
+		 # Separator
+		pack [ttk::separator $search_frame.sep	\
+			-orient vertical		\
+		] -fill y -padx 5 -side left -pady 2
+		 # Label: "Find"
+		pack [label $search_frame.find_lbl	\
+			-text [mc "Find:"]		\
+		] -side left
+		 # Pack entry and buttons next and prev
+		pack $search_entry -side left
+		pack $search_find_next -side left -padx 5
+		pack $search_find_prev -side left
+		 # Checkbutton: "Match case"
+		pack [checkbutton $search_frame.match_case_chb	\
+			-text [mc "Match case"]			\
+			-variable ::Todo::match_case		\
+			-command "$this messages_text_perform_search 1 1.0"	\
+		] -side left -padx 5
+
+
+		messages_text_shortcuts_reevaluate
+		unset parent
+	}
+
+	## Select all text in messages text
+	 # @return void
+	public method select_all_messages_text {} {
+		if {!$gui_initialized} {CreateMessagesGUI}
+		$messages_text tag add sel 1.0 end
+	}
+
+	## Copy selected text in messages text into clipboard
+	 # @return void
+	public method copy_messages_text {} {
+		if {!$gui_initialized} {CreateMessagesGUI}
+		clipboard clear
+		if {[llength [$messages_text tag nextrange sel 1.0]]} {
+			clipboard append [$messages_text get sel.first sel.last]
+		} {
+			clipboard append [$messages_text get 1.0 end]
+		}
+	}
+
+	## Create bindings for defined key shortcuts for messages text
+	 # @return void
+	public method messages_text_shortcuts_reevaluate {} {
+		if {!$gui_initialized} {CreateMessagesGUI}
+
+		# Unset previous configuration
+		foreach key $set_shortcuts {
+			bind $messages_text <$key> {}
+		}
+		set set_shortcuts {}
+
+		# Iterate over shortcuts definition
+		foreach block ${::SHORTCUTS_LIST} {
+			# Determinate category
+			set category	[lindex $block 0]
+			if {[lsearch $shortcuts_cat $category] == -1} {continue}
+
+			# Determinate definition list and its length
+			set block	[lreplace $block 0 2]
+			set len		[llength $block]
+
+			# Iterate over definition list and create bindings
+			for {set i 0; set j 1} {$i < $len} {incr i 2; incr j 2} {
+				# Determinate key sequence
+				set key [lindex $block $i]
+				if {[catch {
+					set key $::SHORTCUTS_DB($category:$key)
+				}]} then {
+					continue
+				}
+				if {$key == {}} {continue}
+
+				# Create and register new binding
+				lappend set_shortcuts $key
+				set cmd [subst [lindex $block [list $j 1]]]
+				append cmd {;break}
+				bind $messages_text <$key> $cmd
+				bind $search_entry <$key> $cmd
+			}
+		}
+	}
+
+	## Define popup menu for messages text
+	 # @return void
+	public method messages_text_makePopupMenu {} {
+		if {!$gui_initialized} {return}
+		if {[winfo exists $menu]} {
+			destroy $menu
+		}
+		menuFactory $MESSAGESMENU $menu 0 "$this " 0 {}
+		$menu entryconfigure [::mc "Find next"] -state disabled
+		$menu entryconfigure [::mc "Find previous"] -state disabled
+	}
+
+	## Handles event: 'Menu' on messages text -- invoke popup menu
+	 # @return void
+	public method messages_text_key_menu {} {
+		$messages_text see insert
+		set bbox [$messages_text bbox [$messages_text index insert]]
+		tk_popup $menu	\
+			[expr {[winfo rootx $messages_text] + [lindex $bbox 0] + 10}]	\
+			[expr {[winfo rooty $messages_text] + [lindex $bbox 1] + 10}]
+	}
+
+	## Clear all content of messages text
+	 # @return void
+	public method clear_messages_text {} {
+		if {!$gui_initialized} {CreateMessagesGUI}
+
+		$messages_text configure -state normal
+		$messages_text delete 0.0 end
+		$messages_text configure -state disabled
+	}
+
+	## Goto line (in editor) which is somehow related to some tag in messages text
+	 # @parm int x	- relative x coordinate in messages text widget
+	 # @parm int y	- relative y coordinate in messages text widget
+	 # @return void
+	public method messages_text_anchor {x y} {
+		# Determinate line number for editor
+		set idx [$messages_text index @$x,$y]
+		set line [$messages_text get "$idx linestart" "$idx lineend"]
+		# Focus on editor and goto that line
+
+		# Message from As31 assembler
+		if {[regexp {^(Error)|(Warning)\, line \d+} $line line]} {
+			if {![regexp {\d+$} $line lineNum]} {
+				set lineNum 0
+			}
+
+			if {$lineNum} {
+				$this editor_procedure {} focus_in {}
+				$this editor_procedure {} goto $lineNum
+			}
+
+		# Message from ASEM-51 assembler
+		} elseif {[regexp {^([^\(\)]+\(\d+(\,\d+)?\)\: \w+)} $line line]} {
+			if {![regexp {\(\d+(\,\d+)?\):} $line lineNum]} {
+				set lineNum 0
+			} {
+				set lineNum [string range $lineNum 1 end-2]
+				set lineNum [lindex [split $lineNum {,}] 0]
+			}
+			if {[regexp {^.+\(\d+(\,\d+)?\):} $line target_filename]} {
+				set target_filename [regsub {\(\d+(\,\d+)?\):$} $target_filename {}]
+				set current_filename [lindex [$this editor_procedure {} getFileName {}] 1]
+				if {$target_filename != $current_filename} {
+					if {![$this fucus_specific_editor $target_filename 0]} {
+						return
+					}
+				}
+			}
+			if {$lineNum} {
+				$this editor_procedure {} focus_in {}
+				$this editor_procedure {} goto "$lineNum"
+			}
+
+		# GNU error message (from SDCC or ASL)
+		} elseif {[regexp {\:\d+\:} $line linenum]} {
+			if {[regexp {[^\:]+\:} $line target_filename]} {
+				set target_filename [string trim [string range $target_filename 0 {end-1}]]
+				set current_filename [lindex [$this editor_procedure {} getFileName {}] 1]
+				if {$target_filename != $current_filename} {
+					if {![$this fucus_specific_editor $target_filename 0]} {
+						return
+					}
+				}
+			}
+
+			set linenum [string trim $linenum {:}]
+			$this editor_procedure {} focus_in {}
+			$this editor_procedure {} goto $linenum
+
+		# Message from MCU8051IDE assembler
+		} elseif {[regexp {at \d+ in [^\:]+\:} $line line]} {
+			if {[regexp { in [^\:]+\:} $line target_filename]} {
+				set target_filename [string trim [string range $target_filename 4 {end-1}] "\""]
+				set current_filename [lindex [$this editor_procedure {} getFileName {}] 1]
+				if {$target_filename != $current_filename} {
+					if {![$this fucus_specific_editor $target_filename 0]} {
+						return
+					}
+				}
+			}
+
+			regexp {\d+} $line lineNum
+			$this editor_procedure {} focus_in {}
+			$this editor_procedure {} goto $lineNum
+		}
+	}
+
+	## Append text at the end of messages text
+	 # @parm String txt - Text to append
+	 # @return Bool - True if error occured
+	public method messages_text_append {txt} {
+		if {!$gui_initialized} {CreateMessagesGUI}
+
+		# Enable the messages text widget
+		$messages_text configure -state normal
+
+		set ern 0	;# The text is some error, but text should not be underlined and linked to certain line
+		set err 0	;# The text is some error
+		set war 0	;# The text is some warning which points to specific line in source code
+		set warn 0	;# The text is some warning
+		set suc 0	;# The text is success message
+
+		foreach text [split $txt "\n"] {
+			set ern		0
+			set err		0
+			set war		0
+			set warn	0
+			set suc		0
+
+			# Determinate number of the last line in the widget
+			set row [expr {int([$messages_text index end]) - 1}]
+
+			## Determinate what kind of text will be inserted
+
+			 # check for error which points to specific line in source code
+			if {[regexp {^(\|EL\|.*)|^(Compilation error at \d+ in [^\:]+\:)|^(Syntax error at \d+ in [^\:]+\:)|^(Error at\s+\d+ in [^\:]+\:)|^(.+:\d+: .*error.*)|^(.+\(\d+(\,\d+)?\): \w+.*)|^(Error\, line \d+)} $text error]} {
+				set len [string length $error]
+				set err 1
+
+			 # check for an error
+			} elseif {[regexp {^(\|EN\|.*)|^(File access error:)|^(FAILED)|^(Compilation FAILED)|^(Pre-processing FAILED !)|^(Error:)|(^@@@@@ .+ @@@@@$)|(^.*returned errorcode.*)|^(Cannot open input file)|^(Cannot open file)|^(Errors in pass1, assembly aborted)|^(Errors in pass2, assembly aborted)} $text error]} {
+				set len [string length $error]
+				set ern 1
+
+			 # check for warning which points to specific line in source code
+			} elseif {[regexp {^(\|WL\|.*)|^(Notice at \d+ in [^\:]+\:)|^(Warning at \d+ in [^\:]+\:)|^(.+:\d+: warning.*)|^(Warning\, line \d+)} $text warning]} {
+				set len [string length $warning]
+				set war 1
+
+			 # check for a warning
+			} elseif {[regexp {^(\|WN\|.*)|^(.*: Warning:.*)|^(Warning:)} $text warning]} {
+				set len [string length $warning]
+				set warn 1
+
+			 # check for success
+			} elseif {[regexp {^(\|SN\|.*)|^((Dec|C)ompilation successful)|(Successful)|(Starting compiler ...)} $text success]} {
+				set len [string length $success]
+				set suc 1
+
+			 # check for error which points to specific line in source code
+			} elseif {[regexp {^(\|EL\|.*)|^(.+:\d+: .*)} $text error]} {
+				set len [string length $error]
+				set err 1
+			}
+
+			regsub {^(\|[EWS][LN]\|)} $text {} text
+
+			# Insert specified text
+			$messages_text insert end $text
+			$messages_text insert end "\n"
+
+
+			# Insert appropriate text tags
+			if {$err || $ern || $war || $warn || $suc} {
+				# Insert error tag
+				if {$ern} {
+					set tag {error_nu}
+				# Insert error tag
+				} elseif {$err} {
+					set tag {error}
+				# Insert warning tag
+				} elseif {$warn} {
+					set tag {warning_nu}
+				# Insert warning tag
+				} elseif {$war} {
+					set tag {warning}
+				# Insert success tag
+				} elseif {$suc} {
+					set tag successful
+				}
+				$messages_text tag add $tag $row.0 $row.$len
+			}
+		}
+
+		$messages_text see end
+		$messages_text configure -state disabled
+
+		return [expr {$err || $ern}]
+	}
+
+	## Hide search bar
+	 # @return void
+	public method messages_text_hide_find_dialog {} {
+		if {[winfo ismapped $search_frame]} {
+			pack forget $search_frame
+		}
+	}
+
+	## Show search bar
+	 # @return void
+	public method messages_text_find_dialog {} {
+		if {![winfo ismapped $search_frame]} {
+			pack $search_frame -before $main_frame -side top -anchor w
+			$search_entry delete 0 end
+			focus -force $search_entry
+		} {
+			focus -force $search_entry
+		}
+	}
+
+	## Search for the given string within the text
+	 # @parm String string - Text to find
+	 # @return Bool - Always 1
+	public method messages_text_search {string} {
+		if {$string == {}} {
+			$search_entry configure -style TEntry
+			$search_find_next configure -state disabled
+			$search_find_prev configure -state disabled
+			$menu entryconfigure [::mc "Find next"] -state disabled
+			$menu entryconfigure [::mc "Find previous"] -state disabled
+			return 1
+		}
+		set search_string $string
+		messages_text_perform_search 1 1.0
+
+		return 1
+	}
+
+	## Perform search for $search_string in the text widget
+	 # @parm Bool forw__back	- 1 == Search forwards; 0 == Search backard
+	 # @parm String from		- Start index
+	 # @return void
+	public method messages_text_perform_search {forw__back from} {
+		if {$search_string == {}} {return}
+
+		if {$forw__back} {
+			set direction {-forwards}
+		} {
+			set direction {-backwards}
+		}
+		if {${::Todo::match_case}} {
+			set last_find_index [$messages_text search $direction -- $search_string $from]
+		} {
+			set last_find_index [$messages_text search $direction -nocase -- $search_string $from]
+		}
+		if {$last_find_index == {}} {
+			$search_entry configure -style StringNotFound.TEntry
+			$search_find_next configure -state disabled
+			$search_find_prev configure -state disabled
+			$menu entryconfigure [::mc "Find next"] -state disabled
+			$menu entryconfigure [::mc "Find previous"] -state disabled
+		} {
+			$search_entry configure -style StringFound.TEntry
+			$search_find_next configure -state normal
+			$search_find_prev configure -state normal
+			$menu entryconfigure [::mc "Find next"] -state normal
+			$menu entryconfigure [::mc "Find previous"] -state normal
+
+			set search_string_length [string length $search_string]
+			$messages_text see $last_find_index
+			catch {
+				$messages_text tag remove sel 0.0 end
+			}
+			$messages_text tag add sel $last_find_index $last_find_index+${search_string_length}c
+		}
+	}
+
+	## Find next occurence of the search string
+	 # @return void
+	public method messages_text_find_next {} {
+		if {![winfo ismapped $search_frame]} {
+			pack $search_frame -before $main_frame -side top -anchor w
+		}
+		if {$last_find_index == {}} {
+			return
+		}
+		messages_text_perform_search 1 $last_find_index+${search_string_length}c
+	}
+
+	## Find previous occurence of the search string
+	 # @return void
+	public method messages_text_find_prev {} {
+		if {![winfo ismapped $search_frame]} {
+			pack $search_frame -before $main_frame -side top -anchor w
+		}
+		if {$last_find_index == {}} {
+			return
+		}
+		messages_text_perform_search 0 $last_find_index
+	}
+
+	## Enter hyperlink
+	 # @parm Int x - Relative pointer position
+	 # @parm Int x - Relative pointer position
+	 # @return void
+	public method messages_text_hyperlink_enter {x y} {
+		set hyperlink_line_start [$messages_text index [list @$x,$y linestart]]
+		hyperlink_active
+	}
+
+	## Leave hyperlink
+	 # @return void
+	public method messages_text_hyperlink_leave {} {
+		$messages_text config -cursor xterm
+		$messages_text tag remove hyper_link_over 0.0 end
+	}
+
+	## Enter pointer motion
+	 # @parm Int x - Relative pointer position
+	 # @parm Int x - Relative pointer position
+	 # @return void
+	public method messages_text_hyperlink_motion {x y} {
+		set line_start [$messages_text index [list @$x,$y linestart]]
+		if {$hyperlink_line_start == $line_start} {
+			return
+		}
+		set hyperlink_line_start $line_start
+		$messages_text tag remove hyper_link_over 0.0 end
+		hyperlink_active
+	}
+
+	## Highlight hyperlink on line $hyperlink_line_start
+	 # @return void
+	private method hyperlink_active {} {
+		set range [$messages_text tag nextrange error $hyperlink_line_start [list $hyperlink_line_start lineend]]
+		if {![llength $range]} {
+			set range [$messages_text tag nextrange warning $hyperlink_line_start [list $hyperlink_line_start lineend]]
+		}
+		if {![llength $range]} {
+			return
+		}
+		$messages_text config -cursor hand2
+		$messages_text tag add hyper_link_over [lindex $range 0] [lindex $range 1]
+	}
+}