Index: openacs-4/packages/xotcl-core/tcl/01-debug-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-core/tcl/01-debug-procs.tcl,v diff -u -r1.17 -r1.18 --- openacs-4/packages/xotcl-core/tcl/01-debug-procs.tcl 8 Jun 2007 17:32:24 -0000 1.17 +++ openacs-4/packages/xotcl-core/tcl/01-debug-procs.tcl 22 Jun 2007 13:26:45 -0000 1.18 @@ -27,6 +27,39 @@ my requireNamespace namespace eval [self] $cmds } + namespace eval ::xo { + Class create ::xo::Attribute \ + -parameter { + {name "[namespace tail [::xotcl::self]]"} + {domain "[lindex [regexp -inline {^(.*)::slot::[^:]+$} [::xotcl::self]] 1]"} + {multivalued false} + {required false} + default + type + spec + pretty_name + {pretty_plural ""} + {datatype "text"} + {sqltype "text"} + {min_n_values 1} + {max_n_values 1} + } + + } +} else { + namespace eval ::xo { + Class create ::xo::Attribute \ + -superclass ::xotcl::Attribute \ + -parameter { + spec + pretty_name + {pretty_plural ""} + {datatype "text"} + {sqltype "text"} + {min_n_values 1} + {max_n_values 1} + } + } } ::xotcl::Object instforward db_1row -objscope Index: openacs-4/packages/xotcl-core/tcl/30-widget-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-core/tcl/30-widget-procs.tcl,v diff -u -r1.16 -r1.17 --- openacs-4/packages/xotcl-core/tcl/30-widget-procs.tcl 19 Jun 2007 11:18:37 -0000 1.16 +++ openacs-4/packages/xotcl-core/tcl/30-widget-procs.tcl 22 Jun 2007 13:26:45 -0000 1.17 @@ -313,7 +313,6 @@ -instproc get-slots {} { set slots [list -[my name]] lappend slots [list -[my name].src [my src]] - lappend slots [list -[my name].href ""] foreach att {width height border title alt} { if {[my exists $att]} { lappend slots [list -[my name].$att [my $att]] @@ -324,32 +323,38 @@ return $slots } + Class ImageAnchorField \ + -superclass ::xo::Table::ImageField \ + -instproc get-slots {} { + return [concat [next] -[my name].href ""] + } + Class ImageField_EditIcon \ - -superclass ImageField -parameter { + -superclass ImageAnchorField -parameter { {src /resources/acs-subsite/Edit16.gif} {width 16} {height 16} {border 0} {title "[_ xotcl-core.edit_item]"} {alt "edit"} } # for xotcl 1.4.0: {title [_ xotcl-core.edit_item]} {alt "edit"} Class ImageField_AddIcon \ - -superclass ImageField -parameter { + -superclass ImageAnchorField -parameter { {src /resources/acs-subsite/Add16.gif} {width 16} {height 16} {border 0} {title "Add Item"} {alt "add"} } Class ImageField_ViewIcon \ - -superclass ImageField -parameter { + -superclass ImageAnchorField -parameter { {src /resources/acs-subsite/Zoom16.gif} {width 16} {height 16} {border 0} {title "View Item"} {alt "view"} } Class ImageField_DeleteIcon \ - -superclass ImageField -parameter { + -superclass ImageAnchorField -parameter { {src /resources/acs-subsite/Delete16.gif} {width 16} {height 16} {border 0} {title "Delete Item"} {alt "delete"} } # export table elements - namespace export Field AnchorField Action ImageField \ + namespace export Field AnchorField Action ImageField ImageAnchorField \ ImageField_EditIcon ImageField_ViewIcon ImageField_DeleteIcon ImageField_AddIcon \ BulkAction } @@ -538,6 +543,15 @@ Class create TABLE::ImageField \ -superclass TABLE::Field \ -instproc render-data {line} { + html::a -href $href -style "border-bottom: none;" { + html::img [$line attlist [my name] {src width height border title alt}] {} + } + $line render_localizer + } + + Class create TABLE::ImageAnchorField \ + -superclass TABLE::Field \ + -instproc render-data {line} { set href [$line set [my name].href] if {$href ne ""} { html::a -href $href -style "border-bottom: none;" { @@ -604,6 +618,7 @@ Class create TABLE2::Field -superclass TABLE::Field Class create TABLE2::AnchorField -superclass TABLE::AnchorField Class create TABLE2::ImageField -superclass TABLE::ImageField + Class create TABLE2::ImageAnchorField -superclass TABLE::ImageAnchorField Class create TABLE2::BulkAction -superclass TABLE::BulkAction Class TABLE3 \ @@ -619,6 +634,7 @@ Class create TABLE3::Field -superclass TABLE::Field Class create TABLE3::AnchorField -superclass TABLE::AnchorField Class create TABLE3::ImageField -superclass TABLE::ImageField + Class create TABLE3::ImageAnchorField -superclass TABLE::ImageAnchorField Class create TABLE3::BulkAction -superclass TABLE::BulkAction } Index: openacs-4/packages/xotcl-core/tcl/generic-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-core/tcl/generic-procs.tcl,v diff -u -r1.70 -r1.71 --- openacs-4/packages/xotcl-core/tcl/generic-procs.tcl 8 Jun 2007 12:01:00 -0000 1.70 +++ openacs-4/packages/xotcl-core/tcl/generic-procs.tcl 22 Jun 2007 13:26:45 -0000 1.71 @@ -179,9 +179,13 @@ CrClass instproc create_attributes {} { if {[my cr_attributes] ne ""} { my instvar object_type + set slot [self]::slot + if {[info command $slot] eq ""} { + ::xotcl::Object create $slot + } set o [::xo::OrderedComposite new -contains [my cr_attributes]] $o destroy_on_cleanup - set parameters [list] + foreach att [$o children] { $att instvar attribute_name datatype pretty_name sqltype default set column_spec [::xo::db::sql map_datatype $sqltype] @@ -197,14 +201,34 @@ -pretty_name $pretty_name \ -column_spec [string trim $column_spec] } + #if {![info exists default]} { + # set default "" + #} + #lappend parameters [list $attribute_name $default] + #unset default + } + #my log "--parameter [self] parameter [list $parameters]" + #my parameter $parameters + + # TODO the following will not be needed, when we enforce xotcl 1.5.0+ + set parameters [list] + foreach att [$o children] { + $att instvar attribute_name datatype pretty_name sqltype default + set slot_obj [self]::slot::$attribute_name + my log "--cr ::xo::Attribute create $slot_obj" + ::xo::Attribute create $slot_obj if {![info exists default]} { set default "" } + $slot_obj datatype $datatype + $slot_obj pretty_name $pretty_name + $slot_obj default $default lappend parameters [list $attribute_name $default] unset default } - #my log "--parameter [self] parameter [list $parameters]" - my parameter $parameters + if {$::xotcl::version < 1.5} { + my parameter $parameters + } } } @@ -623,6 +647,7 @@ {nls_language en_US} {publish_status ready} } + CrItem instproc initialize_loaded_object {} { # dummy action, to be refined } @@ -839,7 +864,10 @@ # we have an autonamed item, use a unique value for the name set name [expr {[my exists __autoname_prefix] ? "[my set __autoname_prefix]$revision_id" : $revision_id}] - if {$title eq ""} {set title $name} + if {$title eq ""} { + set title [expr {[my exists __title_prefix] ? + "[my set __title_prefix] ($name)" : $name}] + } } set item_id [eval ::xo::db::sql::content_item new [[self class] set content_item__new_args]] if {$storage_type eq "file"} { @@ -1241,7 +1269,7 @@ set object_name [expr {[$data exists name] ? [$data set name] : ""}] #my log "-- $data, cl=[$data info class] [[$data info class] object_type]" - #my log "--e [my name] final fields [my fields]" + my log "--e [my name] final fields [my fields]" set exports [list [list object_type $object_type] \ [list folder_id $folder_id] \ [list __object_name $object_name]]