Unnamed Fossil Project

Check-in [57098b6804]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:initial version
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:57098b68040f0e504e7f489ac443fb07b60223cc
User & Date: arnulf 2013-09-15 13:53:02
Context
2013-09-15
13:58
new code for treeview and new class tagset check-in: 1e7da3b02d user: arnulf tags: trunk
13:53
initial version check-in: 57098b6804 user: arnulf tags: trunk
11:56
new code for treeview check-in: cfbbd6aa79 user: arnulf tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Added library/ntkTagSet.tcl.



























































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
#---------------------------------------------------------------------------
# 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