diff options
Diffstat (limited to 'lib/lib')
| -rw-r--r-- | lib/lib/FSnotifications.tcl | 340 | ||||
| -rw-r--r--[-rwxr-xr-x] | lib/lib/Math.tcl | 49 | ||||
| -rw-r--r--[-rwxr-xr-x] | lib/lib/hexeditor.tcl | 311 | ||||
| -rw-r--r--[-rwxr-xr-x] | lib/lib/ihextools.tcl | 38 | ||||
| -rw-r--r--[-rwxr-xr-x] | lib/lib/innerwindow.tcl | 54 | ||||
| -rw-r--r-- | lib/lib/modern_notebook.tcl | 691 | ||||
| -rw-r--r--[-rwxr-xr-x] | lib/lib/settings.tcl | 35 |
7 files changed, 1340 insertions, 178 deletions
diff --git a/lib/lib/FSnotifications.tcl b/lib/lib/FSnotifications.tcl new file mode 100644 index 0000000..be1d477 --- /dev/null +++ b/lib/lib/FSnotifications.tcl @@ -0,0 +1,340 @@ +#!/usr/bin/tclsh + +############################################################################ +# Copyright (C) 2011 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. # +############################################################################ + + +# >>> File inclusion guard +if { ! [ info exists _FSNOTIFICATIONS_TCL ] } { +set _FSNOTIFICATIONS_TCL _ +# <<< File inclusion guard + +# -------------------------------------------------------------------------- +# DESCRIPTION +# Mechanism for watching over a set of files for modifications made to them +# on the storage device where there are stored on. It periodically checks +# modification times of the specified files and generate notifications when +# some of these times changes. +# -------------------------------------------------------------------------- + +namespace eval FSnotifications { + variable watch_interval -1 ;# Int: Interval for periodical mtime checks, in ms + variable watch_timer {} ;# Object: The watch timer + + # List: Watched files, format: + # { + # { # <-- Group of files + # {directory mtime callback} # <-- Directory specification + # { # <-- List of files + # {file mtime callback} # <-- File specification + # ... + # } + # } ... + # } + variable watched_files {} + + + # ---------------------------------------------------------------------- + # "PUBLIC" FUNCTIONS + # ---------------------------------------------------------------------- + + ## Start watching + # @parm Int: interval=1500 - Interval for periodical mtime checks, in ms + # @return void + proc init {{interval 1500}} { + variable watch_timer ;# Int: Interval for periodical mtime checks, in ms + variable watch_interval ;# Object: The watch timer + + set watch_interval $interval + + # Start the watch timer + if {$watch_timer == {}} { + set watch_timer [after $watch_interval [list FSnotifications::timeout]] + } + } + + ## Stop watching + # @return void + proc stop {} { + variable watch_timer ;# Object: The watch timer + + if {$watch_timer != {}} { + catch { + after cancel $watch_timer + } + } + } + + ## Watch over the specified file + # @parm String: filename - Name of the file, or directory, to watch including path + # @parm String: callback - Change notification (some command string) + # @return Bool - true == File actually added; false == something went wrong + proc watch {filename callback} { + variable watched_files ;# List: Watched files + + # Check for existence of the specified file + if {$filename == {} || ![file exists $filename]} { + return 0 + } + + # Watch directory + if {[file isdirectory $filename]} { + # Attempt to find already existing group of files + set group_index -1 + foreach group $watched_files { + incr group_index + + # Local variables + set directory [lindex $group 0] ;# List: Directory specification + set files [lindex $group 1] ;# List: List of files + + # Group found + if {[lindex $directory 0] == $filename} { + # No callback specified -> do nothing + if {$callback == {}} { + return 0 + # Set new callback + } else { + lset watched_files [list $group_index 0 2] $callback + return 1 + } + } + } + + # Group not found, create a new one + lappend watched_files [list [list $filename [file mtime $filename] $callback] [list]] + + # Watch regular file + } else { + # Local variables + set dirname [file dirname $filename] ;# Directory name + set tailname [file tail $filename] ;# File name + + # Attempt to find already existing group of files + set group_index -1 + foreach group $watched_files { + incr group_index + + # Local variables + set directory [lindex $group 0] ;# List: Directory specification + set files [lindex $group 1] ;# List: List of files + + # Group found + if {[lindex $directory 0] == $dirname} { + set file_index -1 + foreach file_spec $files { + incr file_index + + # Local variables + set file_name [lindex $file_spec 0] ;# Name of file + set file_mtime_rec [lindex $file_spec 1];# Time of the last modification + set file_callback [lindex $file_spec 2] ;# Notification callback + + # Set new callback for the specified file + if {$file_name == $tailname} { + lset watched_files [list $group_index 1 $file_index 2] $callback + return 1 + } + } + + # File specification not found, create a new one + lappend files [list $tailname [file mtime $filename] $callback] + + # Alter the corresponding group + lset watched_files [list $group_index 1] $files + return 1 + } + } + + # Group not found, create a new one and create the file specification right away + set dir_spec [list $dirname [file mtime $dirname] {}] + set file_list [list [list $tailname [file mtime $filename] $callback]] + lappend watched_files [list $dir_spec $file_list] + return 1 + } + } + + ## Discontinue watching over the specified file + # @parm String: filename - Name of the file, or directory, including path + # @parm Bool: entire_dir=0 - + # If case the filename is directory, stop watching for the entire + # directory including all files in it + # @return Bool - true == File actually added; false == something went wrong + proc forget {filename {entire_dir 0}} { + variable watched_files ;# List: Watched files + + # File or directory name has not to be empty + if {$filename == {}} { + return 0 + } + + set result 0 + set dirname [file dirname $filename] + set tailname [file tail $filename] + + # Attempt to find the corresponding group of files + set o_size [llength $watched_files] + for {set group_index 0} {$group_index < $o_size} {incr group_index} { + + # Group directory name matches the filename parameter, + #+ so we are about to forget about a directory + if {[lindex $watched_files [list $group_index 0 0]] == $filename} { + + # Remove the entire group if the list of files is empty, that means + #+ that we were watching only the directory itself, not any particular + #+ files in it. Or in case that the removal of the entire directory + #+ has been enforced by entire_dir parameter. + if {![llength [lindex $watched_files [list $group_index 1]]] || $entire_dir} { + set watched_files [lreplace $watched_files $group_index $group_index] + set result 1 + + # If the group is not empty, then remove just the notification + #+ callback for the directory itself. + } else { + lset watched_files [list $group_index 0 2] {} + } + } + + # Group directory name matches the directory of the filename + #+ parameter, so we about to forget about only a file from + #+ that group + if {[lindex $watched_files [list $group_index 0 0]] == $dirname} { + # Attempt to find the file specification in the group's list of files + set fl_size [llength [lindex $watched_files [list $group_index 1]]] + for {set file_index 0} {$file_index < $fl_size} {incr file_index} { + # File specification found + if {[lindex $watched_files [list $group_index 1 $file_index 0]] == $tailname} { + # Remove the designated file specification from the group + set dir_spec [lindex $watched_files [list $group_index 0]] + set file_list [lindex $watched_files [list $group_index 1]] + set file_list [lreplace $file_list $file_index $file_index] + set watched_files [lreplace $watched_files $group_index $group_index [list $dir_spec $file_list]] + set result 1 + } + } + } + } + + return $result + } + + + # ---------------------------------------------------------------------- + # INTERNAL FUNCTIONS + # ---------------------------------------------------------------------- + + ## This function performs the watching itself, it supposed to be called + # by the watch timer. + # @return void + proc timeout {} { + variable watch_timer ;# Object: The watch timer + variable watched_files ;# List: Watched files + variable watch_interval ;# Int: Interval for periodical mtime checks, in ms + + set auto_remove [list] + + # Iterate over the groups + set o_size [llength $watched_files] + for {set group_index 0} {$group_index < $o_size} {incr group_index} { + # Bool: the group is no longer valid, it's directory has + #+ been removed from the file system + set dir_removed_from_FS 0 + # String: Directory of the group + set dir_name [lindex $watched_files [list $group_index 0 0]] + + # The group directory must exists and must be a directory, otherwise, remove the group + if {![file exists $dir_name] || ![file isdirectory $dir_name]} { + set dir_removed_from_FS 1 + lappend auto_remove $dir_name + } + + # If the group is no longer valid, we still have to send + #+ notifications for all the files in it + if {$dir_removed_from_FS} { + set dir_mtime_rec -1 + set dir_mtime_cur -2 + # Get the last known directory modification time and the current one + } else { + set dir_mtime_rec [lindex $watched_files [list $group_index 0 1]] + set dir_mtime_cur [file mtime $dir_name] + } + + # Compare the modification times (detect change in the directory itself) + if {$dir_mtime_rec != $dir_mtime_cur} { + # Update the recorded directory modification time + lset watched_files [list $group_index 0 1] $dir_mtime_cur + # Invoke notification callback + set dir_callback [lindex $watched_files [list $group_index 0 2]] + if {$dir_callback != {}} { + uplevel #0 "$dir_callback {$dir_name}" + } + } + + # Iterate over files in the group + set fl_size [llength [lindex $watched_files [list $group_index 1]]] + for {set file_index 0} {$file_index < $fl_size} {incr file_index} { + set file_removed_from_FS 0 + set file_name [lindex $watched_files [list $group_index 1 $file_index 0]] + set file_name [file join $dir_name $file_name] + + # Check if the file spec. is still valid + if { + !$dir_removed_from_FS + && + ( ![file exists $file_name] || [file isdirectory $file_name] ) + } then { + set file_removed_from_FS 1 + lappend auto_remove $file_name + } + + # If the group is no longer valid, or the file has been removed from the + #+ file system, we still have to send notifications for all the files in it + if {$dir_removed_from_FS || $file_removed_from_FS} { + set file_mtime_rec -1 + set file_mtime_cur -2 + } else { + set file_mtime_rec [lindex $watched_files [list $group_index 1 $file_index 1]] + set file_mtime_cur [file mtime $file_name] + } + + # Compare the modification times (detect change in the file) + if {$file_mtime_rec != $file_mtime_cur} { + # Update the recorded file modification time + lset watched_files [list $group_index 1 $file_index 1] $file_mtime_cur + # Invoke notification callback + set file_callback [lindex $watched_files [list $group_index 1 $file_index 2]] + uplevel #0 "$file_callback {$file_name}" + } + } + } + + # Forget files and directories removed from the file system + foreach file_to_remove $auto_remove { + forget $file_to_remove 1 + } + + # Again start the watch timer + set watch_timer [after $watch_interval [list FSnotifications::timeout]] + } +} + +# >>> File inclusion guard +} +# <<< File inclusion guard diff --git a/lib/lib/Math.tcl b/lib/lib/Math.tcl index bf2be0d..af5e0ae 100755..100644 --- a/lib/lib/Math.tcl +++ b/lib/lib/Math.tcl @@ -1,7 +1,7 @@ #!/usr/bin/tclsh ############################################################################ -# Copyright (C) 2007-2009 by Martin Ošmera # +# Copyright (C) 2007, 2008, 2009, 2010, 2011, 2012 by Martin Ošmera # # martin.osmera@gmail.com # # # # This program is free software; you can redistribute it and#or modify # @@ -20,6 +20,11 @@ # 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. # ############################################################################ + +# >>> File inclusion guard +if { ! [ info exists _MATH_TCL ] } { +set _MATH_TCL _ +# <<< File inclusion guard # -------------------------------------------------------------------------- # DESCRIPTION # Primarily implements convertions between numeric systems and angle units. @@ -51,7 +56,7 @@ # puts [ NumSystem::bin2hex 1111.01 ] ;# --> F.4 # puts [ NumSystem::bin2dec 1111.01 ] ;# --> 15.25 # puts [ NumSystem::bin2oct 1111.01 ] ;# --> 17.2 - # + # # puts [ NumSystem::ascii2dec @ ] ;# --> 64 # puts [ NumSystem::ascii2bin @ ] ;# --> 01000000 # @@ -273,7 +278,7 @@ namespace eval NumSystem { if {[regexp {\.\d+$} $number frac]} { set frac [string range $frac 1 end] set nofrac 0 - } { + } else { set frac {} set nofrac 1 } @@ -334,7 +339,7 @@ namespace eval NumSystem { if {$result != {}} { return [dec2bin $result] } - + return $result } @@ -348,7 +353,7 @@ namespace eval NumSystem { } set result {} scan $number {%c} result - + return $result } @@ -363,7 +368,7 @@ namespace eval NumSystem { proc asserthex {number} { if {![ishex $number]} { error "asserthex: Excepted hexadecimal value but got \"$number\"" - } { + } else { return 1 } } @@ -375,7 +380,7 @@ namespace eval NumSystem { proc assertdec {number} { if {![isdec $number]} { error "assertdec: Excepted decimal value but got \"$number\"" - } { + } else { return 1 } } @@ -387,7 +392,7 @@ namespace eval NumSystem { proc assertoct {number} { if {![isoct $number]} { error "assertoct: Excepted octal value but got \"$number\"" - } { + } else { return 1 } } @@ -399,7 +404,7 @@ namespace eval NumSystem { proc assertbin {number} { if {![isbin $number]} { error "assertbin: Excepted binary value but got \"$number\"" - } { + } else { return 1 } } @@ -466,7 +471,7 @@ namespace eval NumSystem { if {$base == 8} { assertoct $number set char_len 3 - } { + } else { asserthex $number set char_len 4 } @@ -478,7 +483,7 @@ namespace eval NumSystem { if {[regexp {\.[^\.]+$} $number frac]} { set frac [string range $frac 1 end] set nofrac 0 - } { + } else { set frac {} set nofrac 1 } @@ -486,7 +491,7 @@ namespace eval NumSystem { # compute int. part if {$base == 8} { set int [expr "0$int"] - } { + } else { set int [expr "0x$int"] } @@ -513,7 +518,7 @@ namespace eval NumSystem { if {$base == 8} { set v3 $v0 - } { + } else { set v3 [expr {$v0 / 2}] } set v2 [expr {$v3 / 2}] @@ -569,7 +574,7 @@ namespace eval NumSystem { set mod_1 2 set padding {} set convCmd {oct_to_bin} - } { + } else { set modulo 4 set mod_1 3 set padding {0} @@ -581,7 +586,7 @@ namespace eval NumSystem { if {[regexp {\.\d+$} $number frac]} { set frac [string range $frac 1 end] set nofrac 0 - } { + } else { set frac {} set nofrac 1 } @@ -670,7 +675,7 @@ namespace eval NumSystem { if {[regexp {\.\d+$} $number frac]} { set frac [string range $frac 1 end] set nofrac 0 - } { + } else { set frac {} set nofrac 1 } @@ -817,7 +822,7 @@ namespace eval NumSystem { return 0 } - # 3rd condition (dot must not be at the begining or end) + # 3rd condition (dot must not be at the beginning or end) if {[regexp {^\.} $number]} {return 0} if {[regexp {\.$} $number]} {return 0} @@ -940,7 +945,11 @@ namespace eval Angle { } # is negative or something else ? - if {$angle < 0} {set minus 1} {set minus 0} + if {$angle < 0} { + set minus 1 + } else { + set minus 0 + } # adjust angle value set angle [expr {$angle / $base}] @@ -952,3 +961,7 @@ namespace eval Angle { return $angle } } + +# >>> File inclusion guard +} +# <<< File inclusion guard diff --git a/lib/lib/hexeditor.tcl b/lib/lib/hexeditor.tcl index ceb9192..fc3c5e6 100755..100644 --- a/lib/lib/hexeditor.tcl +++ b/lib/lib/hexeditor.tcl @@ -2,7 +2,7 @@ # Part of MCU 8051 IDE ( http://mcu8051ide.sf.net ) ############################################################################ -# Copyright (C) 2007-2009 by Martin Ošmera # +# Copyright (C) 2007, 2008, 2009, 2010, 2011, 2012 by Martin Ošmera # # martin.osmera@gmail.com # # # # This program is free software; you can redistribute it and#or modify # @@ -21,31 +21,43 @@ # 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. # ############################################################################ +# >>> File inclusion guard +if { ! [ info exists _HEXEDITOR_TCL ] } { +set _HEXEDITOR_TCL _ +# <<< File inclusion guard + # -------------------------------------------------------------------------- # DESCRIPTION -# This class provides simple hexeditor with selectable view mode +# This class provides simple hex editor with selectable view mode # and optional ascii view. See constructor and section # "GENERAL PUBLIC INTERFACE" for more details. # -------------------------------------------------------------------------- class HexEditor { - common DEBUG 0 ;# Bool: More secure input data checking # Font for editor text widget(s) - normal size - common view_font_n [font create \ - -family $::DEFAULT_FIXED_FONT \ - -size -15 \ - ] + if {!$::MICROSOFT_WINDOWS} { + common view_font_n [font create \ + -family $::DEFAULT_FIXED_FONT \ + -size [expr {int(-15 * $::font_size_factor)}] \ + ] + } else { + common view_font_n [font create \ + -family $::DEFAULT_FIXED_FONT \ + -size [expr {int(-15 * $::font_size_factor)}] \ + -weight bold \ + ] + } # Font for editor headers - normal size - common header_font_n [font create \ - -family $::DEFAULT_FIXED_FONT \ - -size -15 \ - -weight bold \ + common header_font_n [font create \ + -family $::DEFAULT_FIXED_FONT \ + -size [expr {int(-15 * $::font_size_factor)}] \ + -weight bold \ ] # Font for editor headers - small size - common header_font_s [font create \ - -family $::DEFAULT_FIXED_FONT \ - -size -12 \ - -weight bold \ + common header_font_s [font create \ + -family $::DEFAULT_FIXED_FONT \ + -size [expr {int(-12 * $::font_size_factor)}] \ + -weight bold \ ] common view_font_s $header_font_s ;# Font for editor text widget(s) - small size common header_bg {#9999FF} ;# Background color for headers @@ -103,7 +115,7 @@ class HexEditor { private variable in_cell 0 ;# Bool: mouse pointer in cell (see code below) private variable motion_binding 0 ;# Bool: Bindings for special mouse events set private variable view_mode ;# Current view mode (one of {dec hec oct bin}) - private variable ascii_view ;# Bool: Ascii view avaliable + private variable ascii_view ;# Bool: Ascii view available private variable address_length ;# Int: Length of addresses on left address bar private variable physical_height ;# Int: Height of view in rows private variable width ;# Int: Number of cells in left view in one row @@ -162,7 +174,7 @@ class HexEditor { if {$small} { set view_font $view_font_s set header_font $header_font_s - } { + } else { set view_font $view_font_n set header_font $header_font_n } @@ -189,6 +201,11 @@ class HexEditor { catch { destroy $main_frame } + + # Remove find dialog window if exists + if {[winfo exists $find_dialog_win]} { + destroy $find_dialog_win + } } ## Create popup menu (for left & right view) @@ -210,14 +227,17 @@ class HexEditor { "find_next" {1downarrow} {}} {command {Find previous} {Shift+F3} 8 "find_prev" {1uparrow} {}} - } $popup_menu 0 "$this " 0 {} + {separator} + {command {Fill with pseudo-random values} {} 0 + "text_random" {} {}} + } $popup_menu 0 "$this " 0 {} [namespace current] # Configure menu entries $popup_menu entryconfigure [::mc "Find next"] -state disabled $popup_menu entryconfigure [::mc "Find previous"] -state disabled } - ## Create all hexeditor widgets expect popup menu + ## Create all hex editor widgets expect popup menu # @return void private method create_gui {} { # Determinate width of left view text widget and cell width @@ -240,13 +260,16 @@ class HexEditor { } # Create button "Select All" in left top corner - set left_top_button [button $main_frame.left_top_button \ - -bg $header_bg -bd 0 -padx 0 -pady 0 \ - -activebackground white -relief flat \ - -highlightthickness 0 \ - -command "$main_frame.left_view tag add sel 1.0 end" \ - ] - DynamicHelp::add $main_frame.left_top_button -text [mc "Select all"] + if {!$::MICROSOFT_WINDOWS} { + set left_top_button [button $main_frame.left_top_button \ + -bg $header_bg -bd 0 -padx 0 -pady 0 \ + -activebackground white -relief flat \ + -highlightthickness 0 \ + -command "$main_frame.left_view tag add sel 1.0 end" \ + ] + DynamicHelp::add $main_frame.left_top_button -text [mc "Select all"] + grid $left_top_button -row 0 -column 0 -sticky nsew + } # Create left address bar set left_address_bar [text $main_frame.left_address_bar \ -height $physical_height -width $address_length \ @@ -256,7 +279,6 @@ class HexEditor { -yscrollcommand "$this scrollSet" \ -cursor left_ptr \ ] - grid $left_top_button -row 0 -column 0 -sticky nsew grid $left_address_bar -row 1 -column 0 -sticky ns # Create horizontal header for left view @@ -315,7 +337,7 @@ class HexEditor { grid rowconfigure $main_frame 1 -weight 1 } - ## Create event bindings for all hexeditor widgets (except popup menu) + ## Create event bindings for all hex editor widgets (except popup menu) # @return void private method create_bindings {} { ## LEFT PART @@ -363,6 +385,8 @@ class HexEditor { } { bind $left_view $key "[bind Text $key]; break" } + bind $left_view <Double-Button-1> {break} + bind $left_view <Triple-Button-1> {break} bind $left_view <Button-4> "$this scroll scroll -3 units" bind $left_view <Button-5> "$this scroll scroll +3 units" @@ -430,6 +454,8 @@ class HexEditor { } { bind $right_view $key "[bind Text $key]; break" } + bind $right_view <Double-Button-1> {break} + bind $right_view <Triple-Button-1> {break} bind $right_view <Button-4> "$this scroll scroll -3 units" bind $right_view <Button-5> "$this scroll scroll +3 units" @@ -449,31 +475,35 @@ class HexEditor { -background $current_full_bg \ -foreground {#000000} # Cursor position for active view and inactive view - foreach widget [list $left_header $left_view] { + foreach widget [list $left_header $left_view] \ + font [list $header_font $view_font] \ + { $widget tag configure tag_current_full \ - -font $header_font \ + -font $font \ -background $current_full_bg \ -foreground {#000000} $widget tag configure tag_current_half \ - -font $header_font \ + -font $font \ -background $current_half_bg \ -foreground {#000000} } # Nth row backrgound - $left_view tag configure tag_n_row -background $n_row_bg + $left_view tag configure tag_n_row \ + -background $n_row_bg \ + -font $view_font # Cell highlight $left_view tag configure tag_hg \ -foreground $highlight_fg \ - -font $header_font + -font $view_font $left_view tag configure tag_bg_hg \ -background $highlight_bg \ - -font $header_font + -font $view_font $left_view tag configure tag_bg_hg1 \ -background $highlight_bg1 \ - -font $header_font + -font $view_font $left_view tag configure tag_bg_hg2 \ -background $highlight_bg2 \ - -font $header_font + -font $view_font # Other tags $left_view tag configure normal_font \ -font $view_font @@ -525,28 +555,30 @@ class HexEditor { # Cursor position for active view $right_view tag configure tag_current_full \ - -font $header_font \ + -font $view_font \ -background $current_full_bg # Cursor position for inactive view $right_view tag configure tag_current_half \ - -font $header_font \ + -font $view_font \ -background $current_half_bg # Nth row backrgound - $right_view tag configure tag_n_row -background $n_row_bg + $right_view tag configure tag_n_row \ + -background $n_row_bg \ + -font $view_font # Cell highlight $right_view tag configure tag_hg \ -foreground $highlight_fg \ - -font $header_font + -font $view_font $right_view tag configure tag_bg_hg \ -background $highlight_bg \ - -font $header_font + -font $view_font $right_view tag configure tag_bg_hg1 \ -background $highlight_bg1 \ - -font $header_font + -font $view_font $right_view tag configure tag_bg_hg2 \ -background $highlight_bg2 \ - -font $header_font + -font $view_font # Other tags $right_view tag configure normal_font \ @@ -638,7 +670,7 @@ class HexEditor { $left_header delete 1.0 end if {$view_mode == {hex}} { set space { } - } { + } else { $left_header insert end { } set space { } } @@ -704,7 +736,7 @@ class HexEditor { if {$cell} { if {$view_mode != {hex}} { set start_col [expr {$cell * 4}] - } { + } else { set start_col [expr {$cell * 3}] } } @@ -713,7 +745,7 @@ class HexEditor { set end_col $start_col if {$view_mode != {hex}} { incr end_col 3 - } { + } else { incr end_col 2 } @@ -730,13 +762,13 @@ class HexEditor { if {$view == {left}} { if {$view_mode != {hex}} { set step 4 - } { + } else { set step 3 } scan [$left_view index $index] {%d.%d} row col set cell [expr {($col / $step)}] # Right view - } { + } else { scan [$right_view index $index] {%d.%d} row cell } @@ -751,7 +783,7 @@ class HexEditor { private method col_to_start_end {col} { if {$view_mode != {hex}} { set step 4 - } { + } else { set step 3 } @@ -835,7 +867,7 @@ class HexEditor { if {($col % 4) == 3} { set index [$left_view index "$index+1c"] } - } { + } else { if {($col % 3) == 2} { set index [$left_view index "$index+1c"] } @@ -854,7 +886,7 @@ class HexEditor { scan [$right_view index insert] {%d.%d} row cell if {$view_mode != {hex}} { set step 4 - } { + } else { set step 3 } set cursor_address_original $cursor_address @@ -933,6 +965,43 @@ class HexEditor { } } + ## Fill the selected are with random values + # @return void + public method text_random {} { + # + if {$selected_view == {left}} { + set view_widget $left_view + + } elseif {$ascii_view && $selected_view == {right}} { + set view_widget $right_view + + } else { + return + } + + # + if {![llength [$view_widget tag nextrange sel 0.0]]} { + return + } + + # + set start_address [index_to_address $selected_view [$view_widget index sel.first]] + set end_address [index_to_address $selected_view [$view_widget index sel.last]] + + # + for {set i $start_address} {$i <= $end_address} {incr i} { + if {$i >= $total_capacity} { + break + } + + set value [expr {int(256 * rand()) & 0x0ff}] + setValue $i $value + if {$cell_value_changed_cmd_set} { + eval "$cell_value_changed_cmd $i $value" + } + } + } + ## Synchronize selection in right view with left view # Binding for event <<Selection>> # @return void @@ -944,7 +1013,7 @@ class HexEditor { if {![llength [$right_view tag nextrange sel 0.0]]} { set selection_sync_in_P 0 set anything_selected 0 - } { + } else { set anything_selected 1 } @@ -968,7 +1037,7 @@ class HexEditor { if {$view_mode != {hex}} { set step 4 - } { + } else { set step 3 } @@ -1033,7 +1102,7 @@ class HexEditor { eval $scroll_action_cmd } - update idle + update idletasks set scroll_in_progress 0 } @@ -1050,7 +1119,7 @@ class HexEditor { if {![llength [$left_view tag nextrange sel 0.0]]} { set selection_sync_in_P 0 set anything_selected 0 - } { + } else { set anything_selected 1 } @@ -1106,7 +1175,7 @@ class HexEditor { # Get clipboard contents if {[catch { set text [clipboard get] - }]} { + }]} then { set text {} } # If clipboard empty then return @@ -1316,7 +1385,7 @@ class HexEditor { } } - ## Invoke hexeditor popup menu + ## Invoke hex editor popup menu # @parm String side - "left" or "right" # @parm Int x - Relative mouse pointer position # @parm Int y - Relative mouse pointer position @@ -1328,7 +1397,7 @@ class HexEditor { if {$selected_view == {left}} { set widget $left_view left_view_move_insert $x $y - } { + } else { set widget $right_view } @@ -1343,16 +1412,16 @@ class HexEditor { # Configure popup menu if {[llength [$widget tag nextrange sel 0.0]]} { $popup_menu entryconfigure [::mc "Copy"] -state normal - } { + } else { $popup_menu entryconfigure [::mc "Copy"] -state disabled } if {[catch { if {[string length [clipboard get]]} { $popup_menu entryconfigure [::mc "Paste"] -state normal - } { + } else { $popup_menu entryconfigure [::mc "Paste"] -state disabled } - }]} { + }]} then { $popup_menu entryconfigure [::mc "Paste"] -state disabled } @@ -1449,7 +1518,7 @@ class HexEditor { if {($val < 127) && [string is print -strict $char]} { $right_view insert $cell $char $right_view tag remove tag_np $cell "$cell+1c" - } { + } else { $right_view insert $cell {.} $right_view tag add tag_np $cell "$cell+1c" } @@ -1459,7 +1528,7 @@ class HexEditor { # Adjust insertion cursor if {($row == $height) && ($col >= ($left_view_width - 1))} { left_view_adjust_cursor - } { + } else { left_view_movement 0 Right } } @@ -1541,7 +1610,7 @@ class HexEditor { } if {$col == $col_s} { set correction {-2c} - } { + } else { set correction {-1c} } } @@ -1552,7 +1621,7 @@ class HexEditor { } if {$col == $col_e} { set correction {+2c} - } { + } else { set correction {+1c} } } @@ -1599,10 +1668,10 @@ class HexEditor { # Adjust selection if {!$select} { set cur_idx [$left_view index insert] - } { + } else { if {[$left_view compare $cur_idx <= insert]} { $left_view tag add sel $cur_idx insert - } { + } else { $left_view tag add sel insert $cur_idx } } @@ -1687,7 +1756,7 @@ class HexEditor { scan $index {%d.%d} row col if {$view_mode != {hex}} { set step 4 - } { + } else { set step 3 } @@ -1730,13 +1799,13 @@ class HexEditor { return $popup_menu } - ## Get list of values from hexeditor + ## Get list of values from hex editor # @parm Int start - Start address # @parm Int end - End address # @return List - List of decimal values (e.g. {0 226 {} {} 126 {} 6 8}) public method get_values {start end} { # Check for allowed address range - if {$DEBUG} { + if {${::DEBUG}} { if {$end >= $total_capacity} { error "Address out of range" } @@ -1764,7 +1833,7 @@ class HexEditor { if {$view_mode != {hex}} { set step 4 set len 3 - } { + } else { set step 3 set len 2 } @@ -1813,7 +1882,7 @@ class HexEditor { if {$start == $end} { return [lindex $result 0] - } { + } else { return $result } } @@ -1837,7 +1906,7 @@ class HexEditor { $left_view delete $row.$start_col $row.$end_col if {$view_mode != {hex}} { $left_view insert $row.$start_col { } - } { + } else { $left_view insert $row.$start_col { } } $left_view mark set insert $index @@ -1854,7 +1923,7 @@ class HexEditor { if {$cursor_address == $address} { if {$selected_view == {left}} { left_view_adjust_cursor - } { + } else { right_view_adjust_cursor } } @@ -1867,7 +1936,7 @@ class HexEditor { } # Validate input address and value - if {$DEBUG} { + if {${::DEBUG}} { if {$address >= $total_capacity} { error "Address out of range" } @@ -1926,7 +1995,7 @@ class HexEditor { if {($original_value < 127) && [string is print -strict $value]} { $right_view insert $row.$cell $value $right_view tag remove tag_np $row.$cell "$row.$cell+1c" - } { + } else { $right_view insert $row.$cell {.} $right_view tag add tag_np $row.$cell $row.$end_col } @@ -1945,7 +2014,7 @@ class HexEditor { if {$cursor_address == $address} { if {$selected_view == {left}} { left_view_adjust_cursor - } { + } else { right_view_adjust_cursor } } @@ -1962,7 +2031,7 @@ class HexEditor { } if {$selected_view == {left}} { focus $right_view - } { + } else { focus $left_view } } @@ -1994,7 +2063,7 @@ class HexEditor { # @return void public method set_bg_hg {address bool type} { # Validate input address - if {$DEBUG} { + if {${::DEBUG}} { if {$address >= $total_capacity} { error "Address out of range" } @@ -2020,7 +2089,7 @@ class HexEditor { set tag {tag_bg_hg2} } } - if {[subst "\$${arr}($address)"] == $bool} { + if {[subst -nocommands "\$${arr}($address)"] == $bool} { return } set ${arr}($address) $bool @@ -2035,7 +2104,7 @@ class HexEditor { # Create highlight if {$bool} { set bool {add} - } { + } else { set bool {remove} } $left_view tag $bool $tag $row.$start_col $row.$end_col @@ -2050,7 +2119,7 @@ class HexEditor { # @return void public method setHighlighted {address bool} { # Validate input address - if {$DEBUG} { + if {${::DEBUG}} { if {$address >= $total_capacity} { error "Address out of range" } @@ -2077,7 +2146,7 @@ class HexEditor { # Create highlight if {$bool} { set bool {add} - } { + } else { set bool {remove} } $left_view tag $bool tag_hg $row.$start_col $row.$end_col @@ -2152,7 +2221,7 @@ class HexEditor { $left_view mark set insert $row.$start_col $left_view see insert left_view_adjust_cursor - } { + } else { $right_view mark set insert $row.$cell $right_view see insert right_view_adjust_cursor @@ -2177,7 +2246,7 @@ class HexEditor { # Adjust cursor if {$selected_view == {left}} { $left_view see $row.$start_col - } { + } else { $right_view see $row.$cell } } @@ -2256,7 +2325,7 @@ class HexEditor { [index_to_address {left} [$left_view index sel.first+1c]] \ [index_to_address {left} [$left_view index sel.last-1c]] \ ] - } { + } else { return {} } } @@ -2340,13 +2409,13 @@ class HexEditor { foreach val $values { if {!$first} { $left_view insert $lineend { } - } { + } else { set first 0 } if {$val == {}} { $left_view insert $lineend $space continue - } { + } else { set val [string trimleft $val 0] if {$val == {}} { set val 0 @@ -2358,7 +2427,7 @@ class HexEditor { set val [expr "0x$val"] # HEX -> OCT - } { + } else { set val [expr "0x$val"] set val [format {%o} $val] } @@ -2369,7 +2438,7 @@ class HexEditor { set val [format %X $val] # DEC -> OCT - } { + } else { set val [format %o $val] } } @@ -2380,7 +2449,7 @@ class HexEditor { set val [format %X $val] # OCT -> DEC - } { + } else { set val [expr "0$val"] } } @@ -2418,31 +2487,39 @@ class HexEditor { } } - ## Set hexeditor enabled/disabled state + ## Set hex editor enabled/disabled state # @parm Bool bool - 1 == enabled; 0 == disabled # @return void public method setDisabled {bool} { set disabled $bool - # Set state for left view if {$bool} { - $left_view configure -state disabled + set state {disabled} + } else { + set state {normal} + } + + # Set state for the left view + $left_view configure -state $state + if {$bool} { $left_view configure -bg {#F8F8F8} -fg {#999999} ;#DDDDDD - } { - $left_view configure -state normal + } else { $left_view configure -bg {#FFFFFF} -fg {#000000} } - # Set state for right view + # Set state for the right view if {$ascii_view} { + $right_view configure -state $state if {$bool} { - $right_view configure -state disabled $right_view configure -bg {#F8F8F8} -fg {#999999} ;#DDDDDD - } { - $right_view configure -state normal + } else { $right_view configure -bg {#FFFFFF} -fg {#000000} } } + + # Set state for certain menu entries + $popup_menu entryconfigure [::mc "Paste"] -state $state + $popup_menu entryconfigure [::mc "Fill with pseudo-random values"] -state $state } ## Get reference of left view text widget @@ -2481,7 +2558,7 @@ class HexEditor { } } - ## Find next occurence of search string + ## Find next occurrence of search string # @return Bool - 0 == Invalid call; 1 == Valid call public method find_next {} { if {$last_find_index == {}} { @@ -2489,13 +2566,13 @@ class HexEditor { } if {$find_opt(bw)} { set result [find_FIND $last_find_index-[string length $text_to_find]c] - } { + } else { set result [find_FIND $last_find_index] } return $result } - ## Find previous occurence of search string + ## Find previous occurrence of search string # @return Bool - 0 == Invalid call; 1 == Valid call public method find_prev {} { if {$last_find_index == {}} { @@ -2507,7 +2584,7 @@ class HexEditor { if {$find_opt(bw)} { set result [find_FIND $last_find_index-[string length $text_to_find]c] - } { + } else { set result [find_FIND $last_find_index] } @@ -2518,10 +2595,12 @@ class HexEditor { ## Invoke dialog: Find string # @return Bool - 1 == string found; 0 == string not found public method find_dialog {} { - # Create toplevel find_dialog_window + # Remove previous find dialog windows if {[winfo exists $find_dialog_win]} { destroy $find_dialog_win } + + # Create toplevel find_dialog_window incr find_dialog_count set find_dialog_win [toplevel .hex_editor_find_dialog_$find_dialog_count] @@ -2579,13 +2658,13 @@ class HexEditor { -compound left \ -image ::ICONS::16::ok \ -command "$this find_FIND" \ - ] -side left + ] -side left -padx 2 pack [ttk::button $buttonFrame.cancel \ -text [mc "Cancel"] \ -compound left \ -image ::ICONS::16::button_cancel \ -command "$this find_CANCEL" \ - ] -side left + ] -side left -padx 2 # Events binding (Enter == Find; Escape == Cancel) bind $find_dialog_win <KeyRelease-Return> "$this find_FIND; break" @@ -2594,7 +2673,7 @@ class HexEditor { # Pack dialog frames pack $top_frame -fill both -anchor nw -padx 5 -pady 5 - pack $buttonFrame -side bottom -anchor e -padx 5 + pack $buttonFrame -side bottom -anchor e -padx 5 -pady 5 # Window manager options -- modal find_dialog_window wm iconphoto $find_dialog_win ::ICONS::16::find @@ -2613,7 +2692,7 @@ class HexEditor { tkwait window $find_dialog_win if {$last_find_index == {}} { return 0 - } { + } else { return 1 } } @@ -2629,18 +2708,18 @@ class HexEditor { set start_index [lindex $args 0] if {$where_to_search == {left}} { set widget $left_view - } { + } else { set widget $right_view } if {$find_opt(bw)} { set direction {-backwards} - } { + } else { set direction {-forwards} } if {$start_index == {}} { if {$find_opt(fc)} { set start_index [$widget index insert] - } { + } else { set start_index 1.0 } } @@ -2663,13 +2742,13 @@ class HexEditor { set result 1 # String not found - } { + } else { $popup_menu entryconfigure [::mc "Find next"] -state disabled $popup_menu entryconfigure [::mc "Find previous"] -state disabled if {[winfo exists $find_dialog_win]} { set parent $find_dialog_win - } { + } else { set $main_frame } tk_messageBox \ @@ -2703,3 +2782,7 @@ array set ::HexEditor::find_opt { fc 1 bw 0 } + +# >>> File inclusion guard +} +# <<< File inclusion guard diff --git a/lib/lib/ihextools.tcl b/lib/lib/ihextools.tcl index 071b178..458f799 100755..100644 --- a/lib/lib/ihextools.tcl +++ b/lib/lib/ihextools.tcl @@ -2,7 +2,7 @@ # Part of MCU 8051 IDE ( http://mcu8051ide.sf.net ) ############################################################################ -# Copyright (C) 2007-2009 by Martin Ošmera # +# Copyright (C) 2007, 2008, 2009, 2010, 2011, 2012 by Martin Ošmera # # martin.osmera@gmail.com # # # # This program is free software; you can redistribute it and#or modify # @@ -21,6 +21,11 @@ # 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. # ############################################################################ +# >>> File inclusion guard +if { ! [ info exists _IHEXTOOLS_TCL ] } { +set _IHEXTOOLS_TCL _ +# <<< File inclusion guard + # -------------------------------------------------------------------------- # DESCRIPTION # Provides some tools for manipulating IHEX8, binary and sim files. @@ -100,7 +105,7 @@ namespace eval IHexTools { set index 0 ;# Last search result # Get number of LF chracters - while 1 { + while {1} { set index [string first "\n" $data $index] if {$index == -1} {break} incr index @@ -217,7 +222,7 @@ namespace eval IHexTools { # Return result if {$error_count} { return 0 - } { + } else { return 1 } } @@ -276,15 +281,19 @@ namespace eval IHexTools { # Adjust input data regsub -all {\r\n?} $data "\n" data ;# Any EOL to LF - regsub -all -line {\s*#.*$} $data {} data ;# Remove comments - regsub {^[^\n]+\n} $data {} data ;# Discard the first line + regsub -all {\s*#[^\n]*\n} $data {} data ;# Remove comments - set lineNum 0 ;# Line number + set lineNum -1 ;# Line number # Iterate over lines in the given data foreach line [split $data "\n"] { incr lineNum ;# Increment line number + # Discard the first line + if {!$lineNum} { + continue + } + # Skip empty lines if {$line == {}} {continue} @@ -330,7 +339,7 @@ namespace eval IHexTools { # Return result if {$error_count} { return 0 - } { + } else { return 1 } } @@ -356,12 +365,12 @@ namespace eval IHexTools { # Convert it to binary value if {$hex == {}} { append pad "\0" - } { + } else { if {$pad != {}} { append result $pad set pad {} } - append result [subst "\\x$hex"] + append result [subst -nocommands "\\x$hex"] } # Increment address incr addr @@ -446,6 +455,7 @@ namespace eval IHexTools { # Append EOF and return result append result {:00000001FF} + append result "\n" return $result } @@ -474,7 +484,7 @@ namespace eval IHexTools { set result $content($addr) if {$result == {}} { return -1 - } { + } else { return $result } } @@ -510,7 +520,7 @@ namespace eval IHexTools { } ## Append error message to error_string - # @parm Int line - Number of line where the error occured + # @parm Int line - Number of line where the error occurred # @parm String - Error message # @return void proc Error {line string} { @@ -518,6 +528,10 @@ namespace eval IHexTools { variable error_string ;# Error messages incr error_count - append error_string [mc "Error at line %s:\t" $line] $string "\n" + append error_string [mc "Error at %s:\t" $line] $string "\n" } } + +# >>> File inclusion guard +} +# <<< File inclusion guard diff --git a/lib/lib/innerwindow.tcl b/lib/lib/innerwindow.tcl index f1d2505..4195e2d 100755..100644 --- a/lib/lib/innerwindow.tcl +++ b/lib/lib/innerwindow.tcl @@ -2,7 +2,7 @@ # Part of MCU 8051 IDE ( http://mcu8051ide.sf.net ) ############################################################################ -# Copyright (C) 2007-2009 by Martin Ošmera # +# Copyright (C) 2007, 2008, 2009, 2010, 2011, 2012 by Martin Ošmera # # martin.osmera@gmail.com # # # # This program is free software; you can redistribute it and#or modify # @@ -21,6 +21,11 @@ # 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. # ############################################################################ +# >>> File inclusion guard +if { ! [ info exists _INNERWINDOW_TCL ] } { +set _INNERWINDOW_TCL _ +# <<< File inclusion guard + # -------------------------------------------------------------------------- # DESCRIPTION @@ -87,7 +92,7 @@ class InnerWindow { ttk::style map InnerWindow_Active.TButton \ -background [list active $active_titclr] \ -relief [list active raised] - + ttk::style configure InnerWindow_Inactive.TButton \ -background $inactive_titclr \ -padding 0 \ @@ -96,7 +101,7 @@ class InnerWindow { ttk::style map InnerWindow_Inactive.TButton \ -background [list active $inactive_titclr] \ -relief [list active raised] - + # Set object variables set max_X 1000 set max_Y 1000 @@ -201,27 +206,27 @@ class InnerWindow { } ## Get and/or set window geometry including frame and title bar - # @parm Int = {} - Width - # @parm Int = {} - Height - # @parm Int = {} - Relative position -- X - # @parm Int = {} - Relative position -- Y + # @parm Int w={} - Width + # @parm Int h={} - Height + # @parm Int x={} - Relative position -- X + # @parm Int y={} - Relative position -- Y # Note: If you want to set only certain attributes then set others as {} # @return Current window geometry {W H X Y} - public method geometry args { + public method geometry {{w {}} {h {}} {x {}} {y {}}} { # Set geometry - if {[llength $args]} { - if {[string length [lindex $args 0]]} { - place $win -width [lindex $args 0] + if {$w != {} || $h != {} || $x != {} || $y != {}} { + if {[string length $w]} { + place $win -width $w } - if {[string length [lindex $args 1]]} { - place $win -height [lindex $args 1] - set win_height [lindex $args 1] + if {[string length $h]} { + place $win -height $h + set win_height $h } - if {[string length [lindex $args 2]]} { - place $win -x [lindex $args 2] + if {[string length $x]} { + place $win -x $x } - if {[string length [lindex $args 3]]} { - place $win -y [lindex $args 3] + if {[string length $y]} { + place $win -y $y } update } @@ -252,6 +257,10 @@ class InnerWindow { ## Event handler: window frame <FocusOut> # @return void public method focusout {} { + if {![winfo exists $win]} { + return + } + update foreach widget [list $title_bar $title_label $win] { $widget configure -bg $inactive_titclr @@ -259,7 +268,6 @@ class InnerWindow { foreach widget [list $close_button $coll_exp_but] { $widget configure -style InnerWindow_Inactive.TButton } - update } @@ -275,7 +283,7 @@ class InnerWindow { pack forget $main_frame place $win -height [expr {[winfo height $win.title_bar] + 4}] # Unshade - } { + } else { set image _1uparrow pack $main_frame -fill both -expand 1 place $win -height $win_height @@ -335,7 +343,7 @@ class InnerWindow { focus $win if {!$menu_created} { - menuFactory $MENU $menu 0 "$this " 0 {} + menuFactory $MENU $menu 0 "$this " 0 {} [namespace current] set menu_created 1 } @@ -358,3 +366,7 @@ class InnerWindow { } } } + +# >>> File inclusion guard +} +# <<< File inclusion guard diff --git a/lib/lib/modern_notebook.tcl b/lib/lib/modern_notebook.tcl new file mode 100644 index 0000000..a9760ed --- /dev/null +++ b/lib/lib/modern_notebook.tcl @@ -0,0 +1,691 @@ +#! /usr/bin/tclsh +# Part of MCU 8051 IDE ( http://mcu8051ide.sf.net ) + +############################################################################ +# Copyright (C) 2012 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. # +############################################################################ + +proc ModernNoteBook {pathname args} { + if {[llength $args]} { + return [ModernNoteBookClass #auto $pathname $args] + } else { + return [ModernNoteBookClass #auto $pathname] + } +} +class ModernNoteBookClass { + common font_size 12 + common button_font [font create -family {helvetica} -size [expr {int(-$font_size * $::font_size_factor)}] -weight {normal}] + + private variable button_counter 0 + private variable tab_but_enter_cmd {} + private variable tab_but_leave_cmd {} + private variable event_bindings [list] + private variable common_tab_but_width 0 + private variable common_tab_but_height 0 + private variable scroll_buttons_visible 0 + private variable total_tabbar_width 0 + private variable last_width -1 + + private variable pages [list] + private variable options + + private variable current_page -1 + private variable tabbar_hidden 0 + + private variable main_frame + private variable tab_bar_frame + private variable pages_area_frame + private variable pages_area_frame_f + private variable tab_bar_frame_left + private variable tab_bar_frame_middle + private variable tab_bar_frame_middle_sc + private variable tab_bar_frame_right + private variable tab_bar_frame_left_b + private variable tab_bar_frame_right_b + + constructor {pathname args} { + set options(pathname) $pathname + set options(homogeneous) 0 + set options(autohide) 0 + set options(tabpady) 0 + set options(nomanager) 0 + + set args [lindex $args 0] + set length [llength $args] + for {set i 0; set j 1} {$i < $length} {incr i 2; incr j 2} { + set attr [lindex $args $i] + set val [lindex $args $j] + + switch -- $attr { + {-homogeneous} { + if {![string is boolean $val]} { + error "Argument to option $attr must be a boolean." + } + set options(homogeneous) $val + } + {-autohide} { + if {![string is boolean $val]} { + error "Argument to option $attr must be a boolean." + } + set options(autohide) $val + } + {-tabpady} { + if {![string is digit $val]} { + error "Argument to option $attr must be an integer." + } + set options(tabpady) $val + } + {-nomanager} { + if {![string is boolean $val]} { + error "Argument to option $attr must be a boolean." + } + set options(nomanager) $val + } + {-font} { + set button_font $val + set font_size [expr {abs([font configure $val -size])}] + } + default { + error "Unknown argument: $attr" + } + } + } + + set main_frame [frame $pathname] + set tab_bar_frame [frame $main_frame.tab_bar_frame] + set pages_area_frame_f [frame $main_frame.pages_area_frame -bd 1 -relief raised] + pack $pages_area_frame_f -side bottom -fill both -expand 1 + set pages_area_frame [PagesManager $pages_area_frame_f.pages_manager] + + set tab_bar_frame_right [frame $tab_bar_frame.right_frame] + set tab_bar_frame_middle [frame $tab_bar_frame.middle_frame] + + if {!$options(autohide)} { + pack $tab_bar_frame -side top -fill both -before $pages_area_frame_f + } else { + set tabbar_hidden 1 + $pages_area_frame_f configure -bd 0 + } + if {!$options(nomanager)} { + pack $pages_area_frame -side bottom -fill both -expand 1 + } else { + pack forget $pages_area_frame_f + } + + pack $tab_bar_frame_right -side right -fill y + pack $tab_bar_frame_middle -fill x -expand 1 -side left -after $tab_bar_frame_right + + set tab_bar_frame_middle [ScrollableFrame $tab_bar_frame_middle.inner_frame -height $common_tab_but_height] + set tab_bar_frame_middle_sc [$tab_bar_frame_middle getframe] + pack $tab_bar_frame_middle -fill x + + set tab_bar_frame_left [ttk::button \ + $tab_bar_frame_right.button_l \ + -style Flat.TButton \ + -image ::ICONS::16::1leftarrow \ + -command [list $tab_bar_frame_middle xview scroll -10 units] \ + ] + set tab_bar_frame_right [ttk::button \ + $tab_bar_frame_right.button_r \ + -style Flat.TButton \ + -image ::ICONS::16::1rightarrow \ + -command [list $tab_bar_frame_middle xview scroll 10 units] \ + ] + } + + + public method show_pages_area {} { + if {$options(nomanager)} { + pack $pages_area_frame -side bottom -fill both -expand 1 + set options(nomanager) 0 + } + } + public method hide_pages_area {} { + if {!$options(nomanager)} { + pack forget $pages_area_frame + set options(nomanager) 1 + } + } + public method deselect_tab_button {} { + set current_page -1 + redraw_tab_bar + } + + public method get_nb {} { + return $options(pathname) + } + + public method itemconfigure {page args} { + set idx [lsearch -index 0 -ascii -exact $pages $page] + if {$idx == -1} { + error "No such page: $page" + return + } + set page_spec [lindex $pages $idx] + + set arg_createcmd [lindex $page_spec 1] + set arg_image [lindex $page_spec 2] + set arg_leavecmd [lindex $page_spec 3] + set arg_raisecmd [lindex $page_spec 4] + set arg_state [lindex $page_spec 5] + set arg_text [lindex $page_spec 6] + set arg_helptext [lindex $page_spec 7] + set length [llength $args] + for {set i 0; set j 1} {$i < $length} {incr i 2; incr j 2} { + set attr [lindex $args $i] + set val [lindex $args $j] + + switch -- $attr { + {-createcmd} { + set arg_createcmd $val + } + {-image} { + set arg_image $val + } + {-leavecmd} { + set arg_leavecmd $val + } + {-raisecmd} { + set arg_raisecmd $val + } + {-state} { + if {$val == {normal}} { + set val 0 + } elseif {$val == {disabled}} { + set val 1 + } else { + error "Possible values of $attr are: \"normal\" and \"disabled\"." + } + set arg_state $val + } + {-text} { + set arg_text $val + } + {-helptext} { + set arg_helptext $val + } + default { + error "Unknown argument: $attr" + } + } + } + + set pages [lreplace $pages $idx $idx [list $page $arg_createcmd $arg_image $arg_leavecmd $arg_raisecmd $arg_state $arg_text $arg_helptext {} 0]] + redraw_tab_bar_completely + } + + private method redraw_tab_bar_completely {} { + set common_tab_but_width 0 + set common_tab_but_height 0 + redraw_tab_bar 1 + redraw_tab_bar + handle_resize + } + + public method insert {index page args} { + set arg_createcmd {} + set arg_image {} + set arg_leavecmd {} + set arg_raisecmd {} + set arg_state 0 + set arg_text {} + set arg_helptext {} + set length [llength $args] + for {set i 0; set j 1} {$i < $length} {incr i 2; incr j 2} { + set attr [lindex $args $i] + set val [lindex $args $j] + + switch -- $attr { + {-createcmd} { + set arg_createcmd $val + } + {-image} { + set arg_image $val + } + {-leavecmd} { + set arg_leavecmd $val + } + {-raisecmd} { + set arg_raisecmd $val + } + {-state} { + if {$val == {normal}} { + set val 0 + } elseif {$val == {disabled}} { + set val 1 + } else { + error "Possible values of $attr are: \"normal\" and \"disabled\"." + } + set arg_state $val + } + {-text} { + set arg_text $val + } + {-helptext} { + set arg_helptext $val + } + default { + error "Unknown argument: $attr" + } + } + } + + if {[lsearch -ascii -exact -index 0 $pages $page] != -1} { + error "Page already exists: $page" + } + + if {$current_page != -1} { + set current_page_id [lindex $pages [list $current_page 0]] + } + set pages [linsert $pages $index [list $page $arg_createcmd $arg_image $arg_leavecmd $arg_raisecmd $arg_state $arg_text $arg_helptext 0 {} 0]] + $pages_area_frame add $page + [$pages_area_frame getframe $page] configure -bg ${::COMMON_BG_COLOR} -padx 5 -pady 5 + if {$current_page != -1} { + set current_page [lsearch -index 0 -ascii -exact $pages $current_page_id] + if {$current_page != -1} { + $this see $current_page_id + } + } + + redraw_tab_bar_completely + + if {$options(autohide) && ([llength $pages] > 1)} { + show_hide_tabbar 1 + } + + return [$pages_area_frame getframe $page] + } + public method bindtabs {event command} { + if {$event == {<Enter>}} { + set tab_but_enter_cmd $command + } elseif {$event == {<Leave>}} { + set tab_but_leave_cmd $command + } else { + set idx [lsearch -ascii -exact -index 0 $event_bindings $event] + if {$idx == -1} { + lappend event_bindings [list $event $command] + } else { + set event_bindings [lreplace $event_bindings $idx $idx [list $event $command]] + } + reset_event_bindings + } + } + + public method see {page} { + set idx [lsearch -index 0 -ascii -exact $pages $page] + if {$idx == -1} { + error "No such page: $page" + return + } + + $tab_bar_frame_middle see [lindex $pages [list $idx end-1]] + } + public method getframe {page} { + return [$pages_area_frame getframe $page] + } + + public method move {page index} { + set idx [lsearch -index 0 -ascii -exact $pages $page] + if {$idx == -1} { + error "No such page: $page" + return + } + if {$index != {end} && $index >= [llength $pages]} { + error "Index out of range: $index" + return + } + + if {$current_page != -1} { + set current_page_id [lindex $pages [list $current_page 0]] + } + set page_spec [lindex $pages $idx] + set pages [lreplace $pages $idx $idx] + set pages [linsert $pages $index $page_spec] + if {$current_page != -1} { + set current_page [lsearch -index 0 -ascii -exact $pages $current_page_id] + if {$current_page != -1} { + $this see $current_page_id + } + } + redraw_tab_bar + } + public method pages {} { + set result [list] + foreach page_spec $pages { + lappend result [lindex $page_spec 0] + } + return $result + } + public method index {page} { + return [lsearch -index 0 -ascii -exact $pages $page] + } + public method delete {page} { + set idx [lsearch -index 0 -ascii -exact $pages $page] + if {$idx == -1} { + error "No such page: $page" + return + } + $pages_area_frame delete $page + if {($current_page != -1) && ($current_page != $idx)} { + set current_page_id [lindex $pages [list $current_page 0]] + } + set pages [lreplace $pages $idx $idx] + if {![llength $pages]} { + set current_page -1 + } elseif {$current_page == $idx} { + set current_page -1 + } elseif {$current_page != -1} { + set current_page [lsearch -index 0 -ascii -exact $pages $current_page_id] + if {$current_page != -1} { + $this see $current_page_id + } + } + if {$options(autohide) && ([llength $pages] < 2)} { + show_hide_tabbar 0 + } else { + redraw_tab_bar_completely + } + } + public method show_hide_tabbar {{show {}}} { + if {$show == {}} { + return $tabbar_hidden + } + + if {![string is boolean $show]} { + error "show must be a boolean ({$show} given)" + } + + if {$show && $tabbar_hidden} { + # Show it + if {$options(nomanager)} { + pack $tab_bar_frame -side top -fill both + } else { + pack $tab_bar_frame -side top -fill both -before $pages_area_frame_f + } + set tabbar_hidden 0 + $pages_area_frame_f configure -bd 1 + } elseif {!$show && !$tabbar_hidden} { + # Hide it + pack forget $tab_bar_frame + set tabbar_hidden 1 + $pages_area_frame_f configure -bd 0 + } + } + + public method raise {{page {}} {by_click 0}} { + if {$page == {}} { + if {$current_page == -1} { + return {} + } + return [lindex $pages [list $current_page 0]] + } + + set idx [lsearch -index 0 -ascii -exact $pages $page] + if {$idx == -1} { + error "No such page: $page" + return + } + if {$current_page == $idx || [lindex $pages [list $idx 5]]} { + return + } + + if {$current_page != -1 && $current_page < [llength $pages]} { + uplevel #0 [lindex $pages [list $current_page 3]] + set_tab_but_bg_color n [lindex $pages [list $current_page end-1]] + } + + $pages_area_frame raise $page + $this see $page + + set current_page $idx + if {$by_click} { + set_tab_but_bg_color ae [lindex $pages [list $current_page end-1]] + } else { + set_tab_but_bg_color a [lindex $pages [list $current_page end-1]] + } + if {![lindex $pages [list $current_page end]]} { + lset pages [list $current_page end] 1 + set createcmd [lindex $pages [list $current_page 1]] + if {$createcmd != {}} { + uplevel #0 $createcmd + } + } + set raisecmd [lindex $pages [list $current_page 4]] + if {$raisecmd != {}} { + uplevel #0 $raisecmd + } + } + + private method redraw_tab_bar {{only_compute 0}} { + if {!$only_compute} { + destroy $tab_bar_frame_middle + ScrollableFrame $tab_bar_frame_middle -height $common_tab_but_height + set tab_bar_frame_middle_sc [$tab_bar_frame_middle getframe] + pack $tab_bar_frame_middle -fill x -expand 1 + + bind $tab_bar_frame_middle <Configure> [list $this handle_resize] + } + + set total_tabbar_width 0 + set i -1 + foreach page_spec $pages { + incr i + set tab_but [draw_button $tab_bar_frame_middle_sc $i [lindex $page_spec 6] [lindex $page_spec 2] [lindex $page_spec 7] $only_compute] + lset pages [list $i end-1] $tab_but + + if {$only_compute} { + continue + } + + pack $tab_but -side left + if {![lindex $page_spec 5]} { + bind $tab_but <Button-1> [format "%s\n%s" update [list $this raise [lindex $page_spec 0] 1]] + } + } + } + + private method draw_button {target page_idx {text {}} {image {}} {helptext {}} {only_compute 0}} { + set label_width [font measure $button_font $text] + set image_width 0 + set image_height 0 + if {$image != {}} { + set image_width [image width $image] + set image_height [image height $image] + } else { + set image_height 16 + } + set canvas_width [expr {$label_width + $image_width + 15}] + set canvas_height [expr {(($font_size > $image_height) ? $font_size : $image_height) + 6 + $options(tabpady)}] + if {$image_width} { + incr canvas_width 5 + } + + if {$options(homogeneous)} { + if {$canvas_width > $common_tab_but_width} { + set common_tab_but_width $canvas_width + } else { + set canvas_width $common_tab_but_width + } + } + if {$canvas_height > $common_tab_but_height} { + set common_tab_but_height $canvas_height + } else { + set canvas_height $common_tab_but_height + } + + if {$only_compute} { + return {} + } + + set cnv [canvas $target.b_$button_counter -bg {#E0E0E0} -width $canvas_width -height $canvas_height \ + -bd 0 \ + -highlightthickness 0 \ + ] + + set x 7 + set y [expr {1 + int($canvas_height / 2)}] + if {$image != {}} { + $cnv create image $x $y -image $image -anchor w + incr x $image_width + incr x 5 + if {$image_height > $canvas_height} { + incr y [expr {int(ceil(($image_height - $canvas_height) / 2))}] + } + } + $cnv create text $x $y -font $button_font -anchor w -justify left -text $text -tags txt + + $cnv create line 1 0 [expr {$canvas_width - 1}] 0 -tags bg1 + $cnv create line 1 1 [expr {$canvas_width - 1}] 1 -tags bg2 + $cnv create line 0 1 0 $canvas_height -tags bg1 + $cnv create line 1 1 1 $canvas_height -tags bg2 + $cnv create line [expr {$canvas_width - 1}] 1 [expr {$canvas_width - 1}] $canvas_height -tags bg1 + $cnv create line [expr {$canvas_width - 2}] 1 [expr {$canvas_width - 2}] $canvas_height -tags bg3 + if {[lindex $pages [list $page_idx 5]]} { + set_tab_but_bg_color d $cnv + } elseif {$page_idx == $current_page} { + set_tab_but_bg_color a $cnv + } else { + set_tab_but_bg_color n $cnv + } + + if {$helptext != {}} { + DynamicHelp::add $cnv -text $helptext + } + + bind $cnv <Enter> +[list $this tab_but_enter $page_idx] + bind $cnv <Leave> +[list $this tab_but_leave $page_idx] + set_event_bindings $cnv $page_idx + + incr button_counter + incr total_tabbar_width $canvas_width + return $cnv + } + + private method set_event_bindings {but page_idx} { + foreach env_cmd $event_bindings { + bind $but [lindex $env_cmd 0] [format "%s %s" [lindex $env_cmd 1] [lindex $pages $page_idx 0]] + } + } + + private method reset_event_bindings {} { + set i -1 + foreach page_spec $pages { + incr i + set_event_bindings [lindex $page_spec end-1] $i + } + } + + public method handle_resize {} { + if {$tabbar_hidden || ![winfo exists $tab_bar_frame_middle] || ![winfo viewable $tab_bar_frame_middle]} { + return + } + set current_width [winfo width $tab_bar_frame_middle] + if {$current_width == $last_width} { + return + } + set last_width $current_width + + if {($current_width < $total_tabbar_width) && !$scroll_buttons_visible} { + set scroll_buttons_visible 1 + pack $tab_bar_frame_left -side left + pack $tab_bar_frame_right -side left + } elseif {($current_width >= $total_tabbar_width) && $scroll_buttons_visible} { + set scroll_buttons_visible 0 + pack forget $tab_bar_frame_left + pack forget $tab_bar_frame_right + } + } + + private method set_tab_but_bg_color {code but} { + switch -- $code { + {a} { + set bg0 {#E0E0FF} + set bg1 {#9999FF} + set bg2 {#AAAAFF} + set bg3 {#CFCDFF} + set txt_fg {#000000} + } + {ae} { + set bg0 {#CCCCFF} + set bg1 {#9999FF} + set bg2 {#AAAAFF} + set bg3 {#CFCDFF} + set txt_fg {#000000} + } + {n} { + set bg0 ${::COMMON_BG_COLOR} + set bg1 {#BBBBBB} + set bg2 {#EEEBE7} + set bg3 {#CFCDC8} + set txt_fg {#000000} + } + {ne} { + set bg0 {#CCCCFF} + set bg1 {#9999CC} + set bg2 {#AAAADD} + set bg3 {#CFCDC8} + set txt_fg {#000000} + } + {d} { + set bg0 ${::COMMON_BG_COLOR} + set bg1 {#BBBBBB} + set bg2 {#EEEBE7} + set bg3 {#CFCDC8} + set txt_fg {#888888} + } + default { + error "ModernNoteBookClass::set_tab_but_bg_color: Invalid argument: code={$code}" + } + } + + $but configure -bg $bg0 + $but itemconfigure bg1 -fill $bg1 + $but itemconfigure bg2 -fill $bg2 + $but itemconfigure bg3 -fill $bg3 + $but itemconfigure txt -fill $txt_fg + } + + public method tab_but_enter {page_idx} { + set but [lindex $pages [list $page_idx end-1]] + if {[lindex $pages [list $page_idx 5]]} { + return + } elseif {$current_page == $page_idx} { + set_tab_but_bg_color ae $but + } else { + set_tab_but_bg_color ne $but + } + if {$tab_but_enter_cmd != {}} { + uplevel #0 [format "%s %s" $tab_but_enter_cmd [lindex $pages $page_idx 0]] + } + } + + public method tab_but_leave {page_idx} { + set but [lindex $pages [list $page_idx end-1]] + if {[lindex $pages [list $page_idx 5]]} { + return + } elseif {$current_page == $page_idx} { + set_tab_but_bg_color a $but + } else { + set_tab_but_bg_color n $but + } + if {$tab_but_leave_cmd != {}} { + uplevel #0 [format "%s %s" $tab_but_leave_cmd [lindex $pages $page_idx 0]] + } + } +} diff --git a/lib/lib/settings.tcl b/lib/lib/settings.tcl index 3c50466..8dd1c53 100755..100644 --- a/lib/lib/settings.tcl +++ b/lib/lib/settings.tcl @@ -2,7 +2,7 @@ # Part of MCU 8051 IDE ( http://mcu8051ide.sf.net ) ############################################################################ -# Copyright (C) 2007-2009 by Martin Ošmera # +# Copyright (C) 2007, 2008, 2009, 2010, 2011, 2012 by Martin Ošmera # # martin.osmera@gmail.com # # # # This program is free software; you can redistribute it and#or modify # @@ -21,6 +21,11 @@ # 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. # ############################################################################ +# >>> File inclusion guard +if { ! [ info exists _SETTINGS_TCL ] } { +set _SETTINGS_TCL _ +# <<< File inclusion guard + # -------------------------------------------------------------------------- # DESCRIPTION # Implements interface to program settings (which are stored in a file) @@ -28,7 +33,7 @@ class Settings { common dir_sep [file separator] ;# Directory separator (eg. '/') - common count 0 ;# Counter of instances + common settings_count 0 ;# Counter of instances private variable isEmpty 1 ;# Is settings array empty private variable isReady 0 ;# Is interface ready @@ -42,10 +47,10 @@ class Settings { # @parm String configDir - Path to directory with settings file # @parm String configFileName - Name of file with settings constructor {configDir configFileName} { - incr count ;# increment instance conter + incr settings_count ;# increment instance conter # Incalize object variables - set configArray "::Settings::S$count" ;# Array of settings + set configArray "::Settings::S${settings_count}" ;# Array of settings set directory [string trimright $configDir "/\/"] ;# Path to directory with settings file set filename [string trimleft $configFileName "/\/"] ;# Name of file with settings set fileFullPath "${directory}${dir_sep}${filename}" ;# Full name of settings file @@ -54,7 +59,7 @@ class Settings { if {![file exists $fileFullPath]} { if {[catch { file mkdir $directory - close [open $fileFullPath w 420] + close [open $fileFullPath w 0640] }]} then { return } else { @@ -65,7 +70,7 @@ class Settings { } else { if {$::MICROSOFT_WINDOWS || ([file readable $fileFullPath] && [file writable $fileFullPath])} { set isReady 1 - } { + } else { return } } @@ -129,7 +134,7 @@ class Settings { # Set variable isEmpty if {[array size $configArray] != 0} { set isEmpty 0 - } { + } else { set isEmpty 1 } @@ -147,7 +152,7 @@ class Settings { } # Local variables - set configFile [open $fileFullPath w 420] ;# ID of config file chanel + set configFile [open $fileFullPath w 0640] ;# ID of config file chanel set categories {general} ;# Name of current category # Determinate list of categories @@ -172,7 +177,7 @@ class Settings { # Determinate key regsub {^[^/]*/} $fullKey {} key # Determinate value - set value [subst "\$$configArray\(\$fullKey\)"] + set value [subst -nocommands "\$$configArray\(\$fullKey\)"] regsub -all "\n" $value "\a" value # Save key and value puts $configFile "$key=\"$value\"" @@ -212,7 +217,7 @@ class Settings { if {[i_contains $key]} { unset "$configArray\($key\)" return 1 - } { + } else { return 0 } } @@ -233,7 +238,7 @@ class Settings { private method i_contains {key} { if {[array names $configArray -exact $key] == {}} { return 0 - } { + } else { return 1 } } @@ -258,8 +263,8 @@ class Settings { # Check if the given key is defined if {[i_contains $key]} { - return [subst "\$$configArray\(\$key\)"] - } { + return [subst -nocommands "\$$configArray\(\$key\)"] + } else { return $default } } @@ -291,3 +296,7 @@ class Settings { return 1 } } + +# >>> File inclusion guard +} +# <<< File inclusion guard |