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.1 -r1.2 --- openacs-4/packages/xotcl-core/tcl/generic-procs.tcl 11 Oct 2005 08:41:18 -0000 1.1 +++ openacs-4/packages/xotcl-core/tcl/generic-procs.tcl 14 Dec 2005 15:55:29 -0000 1.2 @@ -8,25 +8,24 @@ namespace eval ::Generic { - # We do not want to re-source all of the user-data-models, - # when small things in the definition of the CrClass change. Normally, - # sourcing of this file causes CrClass do be destroyed with - # the consequence, that instances of CrClass loose their - # class-releationship. - Class CrClass -superclass Class -parameter { pretty_name pretty_plural {supertype content_revision} table_name id_column - sql_attributes + {cr_attributes {}} + {sql_attribute_names {}} + form + edit_form {name_method ""} - {description ""} + {description " "} {mime_type text/plain} {nls_language ""} - {text ""} + {text " "} {storage_type "text"} + {folder_id -100} + {object_type [self]} } -ad_doc {

The meta class CrClass serves for a class of applications that mostly store information in the content repository and that use a few @@ -43,30 +42,31 @@ (requires that all instances of this type are deleted).

-

Each content item is retrieved though the method - get, - added through the method - add, - edited (updated) throught the - method - edit, - and deleted though the the method - delete.

+

Each content item can be retrieved either through the + general method + + CrItem instantiate or through the "instantiate" method of + every subclass of CrItem. -

This Class provides generic methods for these purposes. For more - complex applications, these methods will be most probably overwritten - by defining subclasses with (some of) these methods or by object - specific methods.

+

This Class is a meta-class providing methods for Classes + manageing CrItems.

} + proc package_id_from_package_key { key } { + set id [apm_version_id_from_package_key $key] + set mount_url [site_node::get_children -all -package_key $key -node_id $id] + array set site_node [site_node::get -url $mount_url] + return $site_node(package_id) + } + CrClass instproc unknown { obj args } { my log "unknown called with $obj $args" } - CrClass set query_atts { + CrClass set common_query_atts { item_id creation_user creation_date last_modified object_type } - CrClass set insert_atts {title description mime_type nls_language text} + CrClass set common_insert_atts {title description mime_type nls_language text} CrClass instproc object_types { {-subtypes_first:boolean false} @@ -79,20 +79,10 @@ $order_clause "] } - + CrClass instproc edit_atts {} { - concat [[self class] set insert_atts] [my atts] + concat [[self class] set common_insert_atts] [my sql_attribute_names] } - CrClass instproc atts {} { - set atts [list [my id_column]] - if {[my exists sql_attributes]} { - foreach att [my sql_attributes] { - lappend atts [lindex $att 0] - } - } - return $atts - } - CrClass instproc object_type_exists {} { my instvar object_type @@ -101,39 +91,65 @@ object_type = :object_type }]} } - + + CrClass ad_instproc folder_type { + -folder_id + operation + } { + register the current object type for folder_id. If folder_id + is not specified, use the instvar of the class instead. + } { + if {$operation ne "register" && $operation ne "unregister"} { + error "[self] operation for folder_type must be '\ + register' or 'unregister'" + } + my instvar object_type + if {![info exists folder_id]} { + my instvar folder_id + } + db_1row register_type "select content_folder__${operation}_content_type(\ + $folder_id,:object_type,'t')" + } + CrClass ad_instproc create_object_type {} { Create an oacs object_type and a table for keeping the additional attributes. } { my instvar object_type supertype pretty_name pretty_plural \ table_name id_column name_method - my log "[self proc] $object_type" - set st [my info superclass] - if {$st ne "::xotcl::Object"} { - set supertype [string trimleft $st :] + set supertype [my info superclass] + switch -- $supertype { + ::xotcl::Object - + ::Generic::CrItem {set supertype content_revision} } + my log "--supertype = $supertype" + db_transaction { - if {[my exists sql_attributes]} { - set sql_atts [list] - lappend sql_atts "$id_column integer primary key \ - references cr_revisions(revision_id)" - foreach {att spec} [my sql_attributes] { - lappend sql_atts "$att $spec" - } - - db_dml table_add "create table $table_name (\n[join $sql_atts ,\n])" - my log "adding table explicitely" - } db_1row create_type { - select content_type__create_type(:object_type,:supertype, - :pretty_name, :pretty_plural, - :table_name, :id_column, :name_method) + select content_type__create_type( + :object_type,:supertype,:pretty_name, :pretty_plural, + :table_name, :id_column, :name_method + ) } - db_1row register_type { - select content_folder__register_content_type(-100,:object_type,'t') + if {[my cr_attributes] ne ""} { + set o [Object new -volatile -contains [my cr_attributes]] + foreach att [$o info children] { + $att instvar attribute_name datatype pretty_name + db_1row create_att { + select content_type__create_attribute( + :object_type,:attribute_name,:datatype, + :pretty_name,null,null,null,'text' + ) + } + #content::type::attribute::new \ + -content_type $object_type \ + -attribute_name [$att attribute_name] \ + -datatype [$att datatype] \ + -pretty_name [$att pretty_name] + } } + my folder_type register } } @@ -144,156 +160,162 @@ } { my instvar object_type table_name db_transaction { - db_1row unregister_type { - select content_folder__unregister_content_type(-100,:object_type,'t') - } + my folder_type unregister db_1row drop_type { select content_type__drop_type(:object_type,'t','t') } } } + CrClass ad_instproc require_folder { + {-parent_id -100} + -package_id + -name + } { + Get folder_id for a community id or the actual package. + If everything fails, return -100 + + @return folder_id + } { + my instvar object_type table_name + if {[info exists package_id]} { + set cid $package_id + } elseif {[ad_conn isconnected]} { + set cid "" + if {[info command dotlrn_community::get_community_id_from_url] ne ""} { + set cid [dotlrn_community::get_community_id_from_url -url [ad_conn url]] + } + if {$cid eq ""} { + set cid [ad_conn package_id] + } + } else { + set cid -100 + } + set fullname "$name: $cid" + + if {[info command content::item::get_id_by_name] eq ""} { + set folder_id "" + db_0or1row get_id_by_name "select item_id as folder_id from cr_items \ + where name = :fullname and parent_id = :parent_id" + } else { + set folder_id [content::item::get_id_by_name \ + -name $fullname -parent_id $parent_id] + } + if {$folder_id eq ""} { + set folder_id [content::folder::new -name $fullname -parent_id $parent_id] + } + return $folder_id + } + + CrClass instproc getFormClass {} { + set nsform [ns_getform] + set item_id [ns_set get $nsform item_id] ;# item_id should be be hardcoded + set confirmed_p [ns_set get $nsform __confirmed_p] + set new_p [ns_set get $nsform __new_p] + my log "-- item_id '$item_id', confirmed_p '$confirmed_p', new_p '$new_p'" + if {$item_id ne "" && $new_p ne "1" && [my exists edit_form]} { + return [my edit_form] + } else { + return [my form] + } + } + CrClass instproc init {} { - my instvar object_type - set object_type [string trimleft [self] :] - if {[my info superclass] ne "::xotcl::Object"} { + my log "-- " + my instvar object_type sql_attribute_names + if {[my info superclass] ne "::Generic::CrItem"} { my set superclass [[my info superclass] set object_type] } + set sql_attribute_names [list] + set o [Object new -volatile -contains [my cr_attributes]] + foreach att [$o info children] { + lappend sql_attribute_names [$att attribute_name] + } + my log "-- attribute_names <$sql_attribute_names> [$o info children]" + if {![my object_type_exists]} { my create_object_type } my set object_type_key [db_list get_tree_sortkey { select tree_sortkey from acs_object_types where object_type = :object_type }] + my log "-- type key = [my set object_type_key]" next } - CrClass ad_instproc get { - -item_id:required - } { - Retrieve the live revision of a content item with all attributes. - The retrieved attributes are strored in the instance variables in - class representing the object_type. + CrClass ad_instproc lookup { + -title:required + -parent_id:required + } { + Check, whether an content item with the given title exists. + If not, return 0. - @param item_id id of the item to be retreived. + @return item_id } { - my instvar title table_name - set raw_atts [concat [[self class] set query_atts] [my edit_atts]] - set atts [list data] - foreach v $raw_atts { - catch {my instvar $v} - lappend atts n.$v + my instvar table_name + + if {[db_0or1row entry_exists_select " + select n.item_id from cr_items ci, ${table_name}i n + where n.title = :title and + n.[my id_column] = ci.live_revision and ci.parent_id = :parent_id"]} { + return $item_id } - - db_1row note_select " - select [join $atts ,] from cr_items ci, ${table_name}i n - where ci.item_id = :item_id - and n.[my id_column] = ci.live_revision - " - my set text $data - my set item_id $item_id + return 0 } - - CrClass ad_instproc add { - form - } { - Insert a new item to the content repository and makes - it the live revision. This method obtains the values of - the new content item from the specified form. - @param form form-object (instance of ::Generic::Form) from where the values are obtained - @return item_id of the new note. + CrClass ad_instproc fetch_object { + -item_id:required + {-revision_id 0} + -object:required } { - my instvar object_type table_name storage_type + Load a content item into the specified object. If revision_id is + provided, the specified revision is returned, otherwise the live + revision of the item_id. - set atts [list item_id revision_id] - foreach v [[self class] set insert_atts] { - my instvar $v - lappend atts $v + @return cr item object + } { + #my log "-- [self args]" + my instvar table_name + $object instvar parent_id + set raw_atts [concat [[self class] set common_query_atts] [my edit_atts]] + set atts [list data] + foreach v $raw_atts { + catch {$object instvar $v} + lappend atts n.$v } - - set form_vars [list] - foreach var [$form form_vars] {lappend form_vars $var [uplevel set $var]} - foreach var [$form form_vars] {set $var [uplevel set $var]} - - db_transaction { - set item_id [db_exec_plsql note_insert { - select content_item__new(:title,-100,null,null,null,null,null,null, - 'content_item',:object_type,:title, - :description,:mime_type, - :nls_language,:text,:storage_type) - }] - - set revision_id [db_nextval acs_object_id_seq] - - db_dml revision_add " - insert into ${table_name}i ([join $atts ,]) - values (:[join $atts ,:])" - - my update_main_table -revision_id $revision_id -form_vars $form_vars - - db_exec_plsql make_live { - select content_item__set_live_revision(:revision_id) - } + if {$revision_id} { + db_1row note_select " + select [join $atts ,], i.parent_id from [my set table_name]i n, cr_items i + where n.revision_id = :revision_id and i.item_id = :item_id" + } else { + db_1row note_select " + select [join $atts ,], i.parent_id from cr_items i, [my set table_name]i n + where i.item_id = :item_id + and n.[my id_column] = i.live_revision" } - return $item_id + $object set text $data + $object set item_id $item_id + return $object } - - CrClass instproc update_main_table { - -revision_id - -form_vars - } { - my instvar table_name - if {[llength [my atts]]>1} { - set vars [list] - foreach a [lrange [my atts] 1 end] {lappend vars $a} - catch {my instvar $vars} - foreach {att val} $form_vars {set $att $val} - if {[llength $vars]>1} { - db_dml main_table_update " - update $table_name set ([join $vars ,]) = (:[join $vars ,:]) - where [my id_column] = :revision_id" - } else { - db_dml main_table_update " - update $table_name set $vars = :$vars - where [my id_column] = :revision_id" - } - } - } - CrClass ad_instproc edit { - form + + CrClass ad_instproc instantiate { + -item_id + {-revision_id 0} } { - Updates an item in the content repository and makes - it the live revision. We insert a new revision instead of - changing the current revision. + Retrieve either the live revision or a specified revision + of a content item with all attributes. + The retrieved attributes are strored in the instance variables in + class representing the object_type. - @param form form-object (instance of ::Generic::Form) from where the values are obtained + @param item_id id of the item to be retrieved. + @param revision_id revision-id of the item to be retrieved. } { - my instvar table_name item_id - - set atts [concat [list item_id revision_id] [[self class] set insert_atts]] - catch {eval my instvar $atts} - - set form_vars [list] - foreach var [$form form_vars] {lappend form_vars $var [uplevel set $var]} - foreach var [$form form_vars] {set $var [uplevel set $var]} - - db_transaction { - set revision_id [db_nextval acs_object_id_seq] - - db_dml revision_add " - insert into ${table_name}i ([join $atts ,]) - values (:[join $atts ,:])" - - db_exec_plsql make_live { - select content_item__set_live_revision(:revision_id) - } - my update_main_table -revision_id $revision_id -form_vars $form_vars - } + set o [my create ::[expr {$revision_id ? $revision_id : $item_id}]] + my fetch_object -object $o -item_id $item_id -revision_id $revision_id } - + CrClass ad_instproc delete { -item_id:required } { @@ -308,16 +330,24 @@ CrClass ad_instproc instance_select_query { {-select_attributes ""} {-order_clause ""} + {-where_clause ""} {-with_subtypes:boolean true} {-count:boolean false} + {-folder_id} } { returns the SQL-query to select the CrItems of the specified object_type @select_attributes attributes for the sql query to be retrieved, in addion - to ci.item_id acs_objects.object_type + to ci.item_id acs_objects.object_type, which are always returned @param order_clause clause for ordering the solution set + @param where_clause clause for restricting the answer set + @param with_subtypes return subtypes as well + @param count return the query for counting the solutions + @param folder_id parent_id @return sql query } { my instvar object_type_key + if {![info exists folder_id]} {my instvar folder_id} + set attributes [list ci.item_id acs_objects.object_type] foreach a $select_attributes { if {$a eq "title"} {set a cr.title} @@ -328,61 +358,233 @@ '$object_type_key' and tree_right('$object_type_key')" : "acs_object_types.tree_sortkey = '$object_type_key'"}] set attribute_selection [expr {$count ? "count(*)" : [join $attributes ,]}] + if {$where_clause ne ""} { + set where_clause "and $where_clause" + } return "select $attribute_selection from acs_object_types, acs_objects, cr_items ci, cr_revisions cr where $type_selection and acs_object_types.object_type = ci.content_type - and ci.live_revision = cr.revision_id and - acs_objects.object_id = cr.revision_id $order_clause" + and ci.live_revision = cr.revision_id + and parent_id = $folder_id + and acs_objects.object_id = cr.revision_id $where_clause $order_clause" } + CrClass ad_instproc instantiate_all { + {-select_attributes ""} + {-order_clause ""} + {-where_clause ""} + {-with_subtypes:boolean true} + {-folder_id} + } { + Return all instances of an content type class matching the + specified clauses. + } { + set __result [::xo::OrderedComposite new] + uplevel #1 [list $__result volatile] + $__result proc destroy {} {my log "-- "; next} + + set __attributes [list] + foreach a [concat [list ci.item_id acs_objects.object_type] \ + $select_attributes] { + lappend __attributes [lindex [split $a .] end] + } + + db_foreach instance_select \ + [my instance_select_query \ + -folder_id $folder_id \ + -select_attributes $select_attributes \ + -with_subtypes $with_subtypes \ + -where_clause $where_clause \ + -order_clause $order_clause] { + set __o [$object_type create ${__result}::$item_id] + $__result add $__o + #my log "-- $__result add $__o, $object_type $item_id" + foreach __a $__attributes {$__o set $__a [set $__a]} + } + return $__result + } + + + Class create Attribute -parameter {attribute_name datatype pretty_name} + # create new objects as child of the callers namespace + #Attribute proc new args { + # eval next -childof [uplevel namespace current] $args + #} + + Class create CrItem + + CrItem ad_proc instantiate { + -item_id + {-revision_id 0} + } { + Instantiate the live revision or the specified revision of an + CrItem. + @return object containing the attributes of the CrItem + } { + db_1row get_class "select content_type as object_type from cr_items \ + where item_id=$item_id" + if {![string match ::* $object_type]} {set object_type ::$object_type} + set o [$object_type create ::[expr {$revision_id ? $revision_id : $item_id}]] + $object_type fetch_object \ + -item_id $item_id -revision_id $revision_id -object $o + #my log "-- fetched $o of type $object_type" + return $o + } + + + CrItem ad_proc delete { + -item_id + } { + Delete a CrItem in the database + } { + db_1row get_class_and_folder \ + "select content_type as object_type from cr_items where item_id = $item_id" + $object_type delete -item_id $item_id + } + + CrItem ad_proc lookup { + -title:required + -parent_id:required + } { + Lookup CR item from title and folder (parent_id) + @return item_id or 0 if not successful + } { + if {[db_0or1row entry_exists_select " + select i.item_id from cr_revisions r, cr_items i + where revision_id = i.live_revision and r.title = :title + and i.parent_id = :parent_id" ]} { + #my log "-- found $item_id for $title in folder '$parent_id'" + return $item_id + } + #my log "-- nothing found for $title in folder '$parent_id'" + return 0 + } + + CrItem ad_instproc save {} { + Updates an item in the content repository and makes + it the live revision. We insert a new revision instead of + changing the current revision. + } { + set __atts [concat [list item_id revision_id] [[my info class] edit_atts]] + eval my instvar $__atts + + db_transaction { + set revision_id [db_nextval acs_object_id_seq] + + db_dml revision_add " + insert into [[my info class] set table_name]i ([join $__atts ,]) + values (:[join $__atts ,:])" + + db_exec_plsql make_live { + select content_item__set_live_revision(:revision_id) + } + } + return $item_id + } + + CrItem ad_instproc save_new {} { + Insert a new item to the content repository and make + it the live revision. + } { + set __class [my info class] + my instvar parent_id item_id + + set __atts [list item_id revision_id] + foreach __var [$__class edit_atts] { + my instvar $__var + lappend __atts $__var + if {![info exists $__var]} {set $__var ""} + } + + db_transaction { + $__class instvar mime_type storage_type object_type + $__class folder_type -folder_id $parent_id register + set item_id [db_exec_plsql note_insert " + select content_item__new(:title,$parent_id,null,null,null,null,null,null, + 'content_item',:object_type,:title, + :description,:mime_type, + :nls_language,:text,:storage_type)"] + + set revision_id [db_nextval acs_object_id_seq] + my log "-- NEW item_id = $item_id, revision_id = $revision_id" + db_dml revision_add " + insert into [$__class set table_name]i ([join $__atts ,]) + values (:[join $__atts ,:])" + + db_exec_plsql make_live { + select content_item__set_live_revision(:revision_id) + } + my log "-- end object_type == $object_type" + } + return $item_id + } + + CrItem ad_instproc delete {} { + Delete the item from the content repositiory with the item_id taken from the + instance variable. + } { + # delegate deletion to the class + [my info class] delete [my set instance_id] + } + # # Form template class # Class Form -parameter { fields - object_type + data + {folder_id -100} {name {[namespace tail [self]]}} add_page_title edit_page_title + {validate ""} {with_categories false} + {submit_link "."} } -ad_doc { Class for the simplified generation of forms. This class was designed together with the content repository class ::Generic::CrClass. - This class can be parameterized with + } Form instproc init {} { + set level [template::adp_level] + my forward var uplevel #$level set + + my instvar data folder_id + set class [$data info class] + set folder_id [$data set parent_id] + if {![my exists add_page_title]} { - my set add_page_title "Add [[my object_type] pretty_name]" + my set add_page_title "New [$class pretty_name]" } if {![my exists edit_page_title]} { - my set edit_page_title "Edit [[my object_type] pretty_name]" + my set edit_page_title "Edit [$class pretty_name]" } + # check, if the specified fields are available from the data source # and ignore the unavailable entries set checked_fields [list] - set available_atts [[my object_type] edit_atts] - lappend available_atts [[my object_type] id_column] item_id - foreach varspec [my fields] { - set var [lindex [split [lindex $varspec 0] :] 0] - if {[lsearch -exact $available_atts $var] == -1} continue - lappend checked_fields $varspec - } - my fields $checked_fields + set available_atts [$class edit_atts] + #my log "-- available atts <$available_atts>" + lappend available_atts [$class id_column] item_id + + if {![my exists fields]} {my mkFields} + #my log --fields=[my fields] } Form instproc form_vars {} { @@ -392,13 +594,62 @@ } return $vars } - Form instproc get_vars {object_type} { - foreach var [my form_vars] { - uplevel [list set $var [$object_type set $var]] + Form instproc new_data {} { + my instvar data + my log "--- new_data ---" + foreach __var [my form_vars] { + $data set $__var [my var $__var] } + $data save_new + return [$data set item_id] } + Form instproc edit_data {} { + my log "--- edit_data ---" + my instvar data + foreach __var [my form_vars] { + $data set $__var [my var $__var] + } + $data save + return [$data set item_id] + } + Form instproc request {privelege} { + my instvar page_title context + auth::require_login + permission::require_permission -object_id [ad_conn package_id] -privilege $privelege + set page_title [my add_page_title] + set context [list $page_title] + } + Form instproc new_request {} { + my log "--- new_request ---" + my request create + } + Form instproc edit_request {item_id} { + my instvar data + my log "--- edit_request ---" + my request write + foreach var [[$data info class] edit_atts] { + my var $var [list [$data set $var]] + } + } - + Form instproc on_validation_error {} { + my instvar page_title context + my log "-- " + set page_title [my edit_page_title] + set context [list $page_title] + } + Form instproc after_submit {item_id} { + my instvar data + my log "-- item_id=$item_id [$data set item_id]" + set link [my submit_link] + if {$link ne "." && ![string match {*[?]*} $link]} { + set link [export_vars -base $link {item_id}] + } + ns_log notice "-- redirect to $link // [string match *\?* $link]" + ad_returnredirect $link + ad_script_abort + } + Form ad_instproc generate { {-template "formTemplate"} } { @@ -409,21 +660,31 @@ } { # set form name for adp file uplevel set $template [my name] - - ad_form -name [my name] -form [my fields] \ - -export [list [list object_type [my object_type]]] + my instvar data folder_id + set object_type [[$data info class] object_type] + my log "-- $data, cl=[$data info class] [[$data info class] object_type]" - set new_data [subst -novariables {[my object_type] add [self]}] - set edit_data [subst -novariables {[my object_type] edit [self]}] + #my log "--final fields [my fields]" + ad_form -name [my name] -form [my fields] \ + -export [list [list object_type $object_type] [list folder_id $folder_id]] + + set new_data "set item_id \[[self] new_data\]" + set edit_data "set item_id \[[self] edit_data\]" + set new_request "[self] new_request" + set edit_request "[self] edit_request \$item_id" + set after_submit "[self] after_submit \$item_id" + set on_validation_error "[self] on_validation_error" set on_submit {} if {[my with_categories]} { - upvar item_id item_id + set coid [expr {[$data exists item_id] ? [$data set item_id] : ""}] category::ad_form::add_widgets -form_name [my name] \ -container_object_id [ad_conn package_id] \ - -categorized_object_id [value_if_exists item_id] + -categorized_object_id $coid + append new_data { category::map_object -remove_old -object_id $item_id $category_ids + ns_log notice "-- new data category::map_object -remove_old -object_id $item_id $category_ids" db_dml insert_asc_named_object \ "insert into acs_named_objects (object_id,object_name,package_id) \ values (:item_id, :title, :package_id)" @@ -432,6 +693,7 @@ db_dml update_asc_named_object \ "update acs_named_objects set object_name = :title, \ package_id = :package_id where object_id = :item_id" + ns_log notice "-- edit data category::map_object -remove_old -object_id $item_id $category_ids" category::map_object -remove_old -object_id $item_id $category_ids } append on_submit { @@ -440,30 +702,14 @@ } } + ns_log notice "-- ad_form new_data=<$new_data> edit_data=<$edit_data>" + # action blocks must be added last ad_form -extend -name [my name] \ + -validate [my validate] \ -new_data $new_data -edit_data $edit_data -on_submit $on_submit \ - -new_request [subst -novariables { - auth::require_login - permission::require_permission \ - -object_id [ad_conn package_id] \ - -privilege create - set page_title "[my add_page_title]" - set context \[list $page_title\] - }] -edit_request [subst -novariables { - auth::require_login - permission::require_write_permission -object_id $item_id - [my object_type] get -item_id $item_id - my get_vars [my object_type] - set page_title "[my edit_page_title]" - set context \[list $page_title\] - }] -on_validation_error [subst -novariables { - set page_title "[my edit_page_title]" - set context \[list $page_title\] - }] -after_submit { - ad_returnredirect "." - ad_script_abort - } + -new_request $new_request -edit_request $edit_request \ + -on_validation_error $on_validation_error -after_submit $after_submit } # @@ -477,7 +723,9 @@ {with_subtypes true} {name {[namespace tail [self]]}} {edit_link edit} + {view_link view} {delete_link delete} + {folder_id -100} } -ad_doc { Class for the simplified generation of lists. This class was designed together with the content repository class @@ -500,10 +748,10 @@ defaults to the object name
  • edit_link: link to edit content item (default: edit)
  • delete_link: link to delete content item (default: delete) +
  • view_link: link to view content item (default: view) } - List ad_instproc actions {} { actions is a method to compute the actions of the list depending on the object types. It can be easily overwritten @@ -514,7 +762,7 @@ foreach object_type $object_types { lappend actions \ "Add [$object_type pretty_name]" \ - [export_vars -base [my edit_link] {object_type}] \ + [export_vars -base [my edit_link] {object_type folder_id}] \ "Add a new item of kind [$object_type pretty_name]" } return $actions @@ -550,6 +798,17 @@ sub_class narrow } } + VIEW { + lappend elements view { + link_url_col view_url + display_template { + view + } + sub_class narrow + } + } default { lappend elements $e $spec } @@ -579,7 +838,7 @@ set select_attributes [list] foreach {e spec} [my fields] { - if {[lsearch -exact {item_id object_type EDIT DELETE} $e] == -1} { + if {[lsearch -exact {item_id object_type EDIT DELETE VIEW} $e] == -1} { lappend select_attributes $e } } @@ -593,12 +852,18 @@ -extend { edit_url delete_url + view_url } $template instance_select [$object_type instance_select_query \ + -folder_id [my folder_id] \ -select_attributes $select_attributes \ -with_subtypes $with_subtypes \ -order_clause $order_clause] { - set edit_url [export_vars -base [my edit_link] {item_id object_type}] - set delete_url [export_vars -base [my delete_link] {item_id object_type}] + set view_url [export_vars -base [my view_link] {item_id}] + set edit_url [export_vars -base [my edit_link] {item_id}] + set delete_url [export_vars -base [my delete_link] {item_id}] } } + + namespace export CrItem } +namespace import -force ::Generic::*