Unnamed Fossil Project

#---------------------------------------------------------------------------
# ntkWidget ntkTagSet.tcl --
#
# This file contains a ntkWidget TagSet commands implementation
#
# this code is derived from the tile/ttk implementation written by
# Joe English
#
# Copyright (c) 2007-2013 by Arnulf P. Wiedemann
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# @(#) $Id: ntkTagSet.tcl
#--------------------------------------------------------------------------

namespace eval ::ntk::classes {

::itcl::extendedclass tagset {
   public proc TagSetValues {corePtr tagsetVar}
   public proc TagSetApplyStyle {handle first last total}
}

#================================ TagSetValues ============================
# Tag values
#=========================================================================

::itcl::body tagset::TagSetValues {tagTableVar tagSet record} {
    upvar $tagsetVar tagsetable
puts stderr "tagset::TagSetValues!"
    set LOWEST_PRIORITY 0x7FFFFFFF

    set i 0
    while {[dict get [lindex [dict get $tagTable optionSpecs] $i] type] ne "optionEnd"} {
        set optionSpec [lindex [dict get $tagTable optionSpecs] $i]
        set offset [dict get $optionSpec objOffset]
        set prio $LOWEST_PRIORITY

        set j 0
        while {$j < [dict get $tagSet nTags]} {
            set tag [lindex [dict get $tagSet tags] $j]
#            if (OBJ_AT(tag->tagRecord, offset) != 0 && tag->priority < prio) {
#                OBJ_AT(record, offset) = OBJ_AT(tag->tagRecord, offset);
                set prio [dict get $tag priority]
#            }
        }
        incr i
    }
    
}

#================================ TagSetApplyStyle ============================
# TagSetApplyStyle --
#=========================================================================

::itcl::body tagset::TagSetApplyStyle {tagTable style state record} {
puts stderr "tagset::TagSetApplyStyle!"
   set optionSpec [lindex [dict get $tagTable optionSpecs] 0]

    set i 1
    while {[dict get $optionSpec type] ne "optionEnd"} {
        set offset [dict get $optionSpec objOffset]
        set optionName [dict get $optionSpec optionName]
        set val [::ntk::classes::theme::StyleMap $style $optionName $state]
        if {$val ne ""} {
#            OBJ_AT(record, offset) = val;
        } else {
#            if (OBJ_AT(record, offset) == 0) {
#                OBJ_AT(record, offset) = Ttk_StyleDefault(style, optionName);
#            }
        }
        incr i
        set optionSpec [lindex [dict get $tagTable optionSpecs] $i]
    }
}

} ; # end namespace ::ntk::classes