+
- Example: + Example:
plsql_utility::format_pieces -indent 3 -delim " => " \ - [list [list object_type group] [list group_id -2] [list group_name "Reg users"]] + [list [list object_type group] [list group_id -2] [list group_name "Reg users"]]returns:
@@ -85,101 +83,101 @@
group_name => Reg users
- @author Michael Bryzek (mbryzek@arsdigita.com)
- @creation-date 11/2000
+ @author Michael Bryzek (mbryzek@arsdigita.com)
+ @creation-date 11/2000
@param pieces a list of lists where each element is a key/value pair
} {
- # Find max length of first column
- set max_length -1
- foreach pair $pieces {
- if { [string length [lindex $pair 0]] > $max_length } {
- set max_length [string length [lindex $pair 0]]
- }
- }
- if { $max_length == -1 } {
- # no elements... return
- return ""
- }
- set indent_text ""
- for { set i 0 } { $i < $indent } { incr i } {
- append indent_text " "
- }
+ # Find max length of first column
+ set max_length -1
+ foreach pair $pieces {
+ if { [string length [lindex $pair 0]] > $max_length } {
+ set max_length [string length [lindex $pair 0]]
+ }
+ }
+ if { $max_length == -1 } {
+ # no elements... return
+ return ""
+ }
+ set indent_text ""
+ for { set i 0 } { $i < $indent } { incr i } {
+ append indent_text " "
+ }
- # Generate text
- set text ""
- set col_width [expr {$max_length + $num_spaces}]
- foreach pair $pieces {
- lassign $pair left right
- while { [string length $left] < $col_width } {
- append left " "
- }
- if { $text ne "" } {
- append text "$line_term\n$indent_text"
- }
- append text "${left}${delim}${right}"
- }
- return $text
-
+ # Generate text
+ set text ""
+ set col_width [expr {$max_length + $num_spaces}]
+ foreach pair $pieces {
+ lassign $pair left right
+ while { [string length $left] < $col_width } {
+ append left " "
+ }
+ if { $text ne "" } {
+ append text "$line_term\n$indent_text"
+ }
+ append text "${left}${delim}${right}"
+ }
+ return $text
+
}
- ad_proc -public generate_oracle_name {
- { -max_length 30 }
- { -include_object_id "f" }
- stem
+ ad_proc -public generate_oracle_name {
+ { -max_length 30 }
+ { -include_object_id "f" }
+ stem
} {
- Returns an object name of max_length characters, in lower
- case, beginning with stem but without any unsafe characters. Only
- allowed characters are numbers, letter, underscore, dash and space,
- though the returned word will start with a letter. Throws an
- error if no safe name could be generated.
-
- To almost guarantee uniqueness, you can use the next object_id
- from acs_object_id_seq as the tail of the name we return.
+ Returns an object name of max_length characters, in lower
+ case, beginning with stem but without any unsafe characters. Only
+ allowed characters are numbers, letter, underscore, dash and space,
+ though the returned word will start with a letter. Throws an
+ error if no safe name could be generated.
- @author Michael Bryzek (mbryzek@arsdigita.com)
- @creation-date 11/2000
+ To almost guarantee uniqueness, you can use the next object_id
+ from acs_object_id_seq as the tail of the name we return.
+ @author Michael Bryzek (mbryzek@arsdigita.com)
+ @creation-date 11/2000
+
} {
-
- if { $include_object_id == "t" } {
- set id [db_nextval "acs_object_id_seq"]
- set suffix "_$id"
- } else {
- set suffix ""
- }
- # Leave only letters, numbers, underscores, dashes, and spaces
- regsub -all {[^ _\-a-z0-9]} [string tolower $stem] "" stem
- # Make sure it starts with a letter
- regsub {^[^a-z]} $stem "" stem
- # change spaces to underscores
- regsub -all {\s+} $stem "_" stem
- #Trim to fit in $max_length character limit
- set max_length_without_suffix [expr {$max_length - [string length $suffix]}]
- if { [string length $stem] >= $max_length_without_suffix } {
- set stem [string range $stem 0 $max_length_without_suffix-1]
- }
- if { $stem eq "" } {
- error "generate_oracle_name failed to generate a safe oracle name from the stem \"$stem\"\n"
- }
- return "$stem$suffix"
+ if { $include_object_id == "t" } {
+ set id [db_nextval "acs_object_id_seq"]
+ set suffix "_$id"
+ } else {
+ set suffix ""
+ }
+ # Leave only letters, numbers, underscores, dashes, and spaces
+ regsub -all {[^ _\-a-z0-9]} [string tolower $stem] "" stem
+ # Make sure it starts with a letter
+ regsub {^[^a-z]} $stem "" stem
+ # change spaces to underscores
+ regsub -all {\s+} $stem "_" stem
+ #Trim to fit in $max_length character limit
+ set max_length_without_suffix [expr {$max_length - [string length $suffix]}]
+ if { [string length $stem] >= $max_length_without_suffix } {
+ set stem [string range $stem 0 $max_length_without_suffix-1]
+ }
+ if { $stem eq "" } {
+ error "generate_oracle_name failed to generate a safe oracle name from the stem \"$stem\"\n"
+ }
+ return "$stem$suffix"
+
}
ad_proc -public parse_sql { sql_query } {
- Replaces bind variables with their Double Apos'd values to aid in
- debugging. Throws error if any bind variable is undefined in the
- calling environment.
-
- Limits: Only handles letter, numbers, and _ or - in bind variable names + Replaces bind variables with their Double Apos'd values to aid in + debugging. Throws error if any bind variable is undefined in the + calling environment. -
Example: +
Limits: Only handles letter, numbers, and _ or - in bind variable names + +
Example:
set group_id -2
set sql {select acs_group.name(:group_id) from dual}
@@ -190,130 +188,130 @@
select acs_group.name('-2') from dual
- @author Michael Bryzek (mbryzek@arsdigita.com)
- @creation-date 11/2000
+ @author Michael Bryzek (mbryzek@arsdigita.com)
+ @creation-date 11/2000
} {
-
- while { 1 } {
- if { ![regexp -- {:([a-zA-Z0-9_-]+)} $sql_query match var] } {
- break
- }
- # Use $var as the target to get nice error messages
- upvar 1 $var $var
- if { ![info exists $var] } {
- error "Cannot find value for bind variable \"$var\"\n\n"
- }
- regsub -- "\:$var" $sql_query [::ns_dbquotevalue [set $var]] sql_query
- }
- return $sql_query
+
+ while { 1 } {
+ if { ![regexp -- {:([a-zA-Z0-9_-]+)} $sql_query match var] } {
+ break
+ }
+ # Use $var as the target to get nice error messages
+ upvar 1 $var $var
+ if { ![info exists $var] } {
+ error "Cannot find value for bind variable \"$var\"\n\n"
+ }
+ regsub -- "\:$var" $sql_query [::ns_dbquotevalue [set $var]] sql_query
+ }
+ return $sql_query
}
- ad_proc -public generate_attribute_parameters {
- { -indent "9" }
- attr_list
+ ad_proc -public generate_attribute_parameters {
+ { -indent "9" }
+ attr_list
} {
- Generates the arg list to a pl/sql function or procedure
+ Generates the arg list to a pl/sql function or procedure
- @author Michael Bryzek (mbryzek@arsdigita.com)
- @creation-date 11/2000
+ @author Michael Bryzek (mbryzek@arsdigita.com)
+ @creation-date 11/2000
} {
- set pieces [list]
- foreach triple $attr_list {
- set table [string toupper [string trim [lindex $triple 0]]]
- set attr [string toupper [string trim [lindex $triple 1]]]
- if { [lindex $triple 2] eq "" } {
- set default_string ""
- } else {
- set default_string " DEFAULT [lindex $triple 2]"
- }
- lappend pieces [list $attr "IN ${table}.${attr}%TYPE${default_string}"]
- }
- return [format_pieces -indent $indent $pieces]
+ set pieces [list]
+ foreach triple $attr_list {
+ set table [string toupper [string trim [lindex $triple 0]]]
+ set attr [string toupper [string trim [lindex $triple 1]]]
+ if { [lindex $triple 2] eq "" } {
+ set default_string ""
+ } else {
+ set default_string " DEFAULT [lindex $triple 2]"
+ }
+ lappend pieces [list $attr "IN ${table}.${attr}%TYPE${default_string}"]
+ }
+ return [format_pieces -indent $indent $pieces]
}
- ad_proc -public generate_attribute_parameter_call_from_attributes {
- { -prepend "" }
- { -indent "9" }
- attr_list
+ ad_proc -public generate_attribute_parameter_call_from_attributes {
+ { -prepend "" }
+ { -indent "9" }
+ attr_list
} {
- Wrapper for generate_attribute_parameter_call that formats
- default attribute list to the right format.
+ Wrapper for generate_attribute_parameter_call that formats
+ default attribute list to the right format.
- @author Michael Bryzek (mbryzek@arsdigita.com)
- @creation-date 11/2000
+ @author Michael Bryzek (mbryzek@arsdigita.com)
+ @creation-date 11/2000
} {
- set the_list [list]
- foreach row $attr_list {
- lappend the_list [list [lindex $row 1] [lindex $row 3]]
- }
- return [generate_attribute_parameter_call -prepend $prepend -indent $indent $the_list]
+ set the_list [list]
+ foreach row $attr_list {
+ lappend the_list [list [lindex $row 1] [lindex $row 3]]
+ }
+ return [generate_attribute_parameter_call -prepend $prepend -indent $indent $the_list]
}
ad_proc -public generate_attribute_parameter_call {
- { -prepend "" }
- { -indent "9" }
- pairs
+ { -prepend "" }
+ { -indent "9" }
+ pairs
} {
- Generates the arg list for a call to a pl/sql function or procedure
+ Generates the arg list for a call to a pl/sql function or procedure
- @author Michael Bryzek (mbryzek@arsdigita.com)
- @creation-date 11/2000
+ @author Michael Bryzek (mbryzek@arsdigita.com)
+ @creation-date 11/2000
} {
- set pieces [list]
- foreach row $pairs {
- set attr [string trim [lindex $row 0]]
- set attr_value [string trim [lindex $row 1]]
- if { $attr_value eq "" } {
- set attr_value $attr
- }
- lappend pieces [list "$attr" "$prepend$attr_value"]
- }
- return [format_pieces -delim " => " -indent $indent $pieces]
+ set pieces [list]
+ foreach row $pairs {
+ set attr [string trim [lindex $row 0]]
+ set attr_value [string trim [lindex $row 1]]
+ if { $attr_value eq "" } {
+ set attr_value $attr
+ }
+ lappend pieces [list "$attr" "$prepend$attr_value"]
+ }
+ return [format_pieces -delim " => " -indent $indent $pieces]
}
- ad_proc -public generate_attribute_dml {
- { -start_with_comma "t" }
- { -prepend "" }
- { -ignore "" }
- table_name
- attr_list
+ ad_proc -public generate_attribute_dml {
+ { -start_with_comma "t" }
+ { -prepend "" }
+ { -ignore "" }
+ table_name
+ attr_list
} {
- Generates the string for a sql insert... e.g. ",col1, col2"
+ Generates the string for a sql insert... e.g. ",col1, col2"
- @author Michael Bryzek (mbryzek@arsdigita.com)
- @creation-date 11/2000
+ @author Michael Bryzek (mbryzek@arsdigita.com)
+ @creation-date 11/2000
} {
- set ignore [string toupper $ignore]
- set this_columns [list]
- set table_name [string toupper [string trim $table_name]]
- foreach triple $attr_list {
- set table [string toupper [string trim [lindex $triple 0]]]
- set column [string toupper [string trim [lindex $triple 1]]]
- if {[string toupper $column] in $ignore} {
- # Ignore this column
- continue
- }
- if {$table eq $table_name} {
- lappend this_columns "$prepend$column"
- }
- }
+ set ignore [string toupper $ignore]
+ set this_columns [list]
+ set table_name [string toupper [string trim $table_name]]
+ foreach triple $attr_list {
+ set table [string toupper [string trim [lindex $triple 0]]]
+ set column [string toupper [string trim [lindex $triple 1]]]
+ if {[string toupper $column] in $ignore} {
+ # Ignore this column
+ continue
+ }
+ if {$table eq $table_name} {
+ lappend this_columns "$prepend$column"
+ }
+ }
- if { [llength $this_columns] == 0 } {
- return ""
- }
- set return_value [join $this_columns ", "]
- if { $start_with_comma == "t" } {
- return ", $return_value"
- }
- return $return_value
+ if { [llength $this_columns] == 0 } {
+ return ""
+ }
+ set return_value [join $this_columns ", "]
+ if { $start_with_comma == "t" } {
+ return ", $return_value"
+ }
+ return $return_value
}
Index: openacs-4/packages/acs-subsite/tcl/rel-segments-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/tcl/rel-segments-procs.tcl,v
diff -u -N -r1.7 -r1.7.2.1
--- openacs-4/packages/acs-subsite/tcl/rel-segments-procs.tcl 7 Jun 2018 16:52:40 -0000 1.7
+++ openacs-4/packages/acs-subsite/tcl/rel-segments-procs.tcl 16 May 2019 09:27:52 -0000 1.7.2.1
@@ -1,5 +1,3 @@
-# /packages/mbryzek-subsite/tcl/rel-segments-procs.tcl
-
ad_library {
Helpers for relational segments
@@ -27,12 +25,12 @@
} {
if { [ad_conn isconnected] } {
- if { $creation_user eq "" } {
- set creation_user [ad_conn user_id]
- }
- if { $creation_ip eq "" } {
- set creation_ip [ad_conn peeraddr]
- }
+ if { $creation_user eq "" } {
+ set creation_user [ad_conn user_id]
+ }
+ if { $creation_ip eq "" } {
+ set creation_ip [ad_conn peeraddr]
+ }
}
return [db_exec_plsql create_rel_segment {}]
@@ -50,11 +48,11 @@
} {
# First delete dependent constraints.
db_foreach select_dependent_constraints {
- select c.constraint_id
- from rel_constraints c
- where c.required_rel_segment = :segment_id
+ select c.constraint_id
+ from rel_constraints c
+ where c.required_rel_segment = :segment_id
} {
- db_exec_plsql constraint_delete {}
+ db_exec_plsql constraint_delete {}
}
db_exec_plsql rel_segment_delete {}
Index: openacs-4/packages/acs-subsite/tcl/relation-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/tcl/relation-procs.tcl,v
diff -u -N -r1.20.2.1 -r1.20.2.2
--- openacs-4/packages/acs-subsite/tcl/relation-procs.tcl 10 Mar 2019 22:01:42 -0000 1.20.2.1
+++ openacs-4/packages/acs-subsite/tcl/relation-procs.tcl 16 May 2019 09:27:52 -0000 1.20.2.2
@@ -1,5 +1,3 @@
-# /packages/mbryzek-subsite/tcl/relation-procs.tcl
-
ad_library {
Helpers for dealing with relations
@@ -54,43 +52,43 @@
@param extra_vars An ns_set of extra variables
- @param variable_prefix Only form elements that begin with the
+ @param variable_prefix Only form elements that begin with the
specified prefix will be processed.
@param creation_user The user who is creating the relation
@param creation_ip
@param member_state Only used for membership_relations.
- See column membership_rels.member_state
+ See column membership_rels.member_state
for more info.
@return The rel_id of the new relation
} {
# First check if the relation already exists, and if so, just return that
- set existing_rel_id [db_string rel_exists {
+ set existing_rel_id [db_string rel_exists {
select rel_id
- from acs_rels
- where rel_type = :rel_type
+ from acs_rels
+ where rel_type = :rel_type
and object_id_one = :object_id_one
and object_id_two = :object_id_two
} -default {}]
-
+
if { $existing_rel_id ne "" } {
return $existing_rel_id
}
set var_list [list \
- [list object_id_one $object_id_one] \
- [list object_id_two $object_id_two]]
+ [list object_id_one $object_id_one] \
+ [list object_id_two $object_id_two]]
- # Note that we don't explicitly check whether rel_type is a type of
- # membership relation before adding the member_state variable. The
+ # Note that we don't explicitly check whether rel_type is a type of
+ # membership relation before adding the member_state variable. The
# package_instantiate_object proc will ignore the member_state variable
# if the rel_type's plsql package doesn't support it.
if {$member_state ne ""} {
- lappend var_list [list member_state $member_state]
+ lappend var_list [list member_state $member_state]
}
# We initialize rel_id, so it's set if there's a problem
@@ -101,29 +99,29 @@
db_transaction {
- set rel_id [package_instantiate_object \
- -creation_user $creation_user \
- -creation_ip $creation_ip \
- -start_with "relationship" \
- -form_id $form_id \
- -extra_vars $extra_vars \
- -variable_prefix $variable_prefix \
- -var_list $var_list \
- $rel_type]
+ set rel_id [package_instantiate_object \
+ -creation_user $creation_user \
+ -creation_ip $creation_ip \
+ -start_with "relationship" \
+ -form_id $form_id \
+ -extra_vars $extra_vars \
+ -variable_prefix $variable_prefix \
+ -var_list $var_list \
+ $rel_type]
- # Check to see if constraints are violated because of this new
- # relation
+ # Check to see if constraints are violated because of this new
+ # relation
- # JCD: this is enforced by trigger so no longer check explicitly
- # see membership_rels_in_tr
- #
- # set violated_err_msg [db_string select_rel_violation {} -default ""]
- #
- # if { $violated_err_msg ne "" } {
- # error $violated_err_msg
- # }
+ # JCD: this is enforced by trigger so no longer check explicitly
+ # see membership_rels_in_tr
+ #
+ # set violated_err_msg [db_string select_rel_violation {} -default ""]
+ #
+ # if { $violated_err_msg ne "" } {
+ # error $violated_err_msg
+ # }
} on_error {
- return -code error $errmsg
+ return -code error $errmsg
}
return $rel_id
@@ -147,7 +145,7 @@
# acs_rels. Note the outer joins since the segment may not exist.
if { ![db_0or1row select_rel_info_rm {}] } {
# Relation doesn't exist
- return 0
+ return 0
}
# Check if we would violate some constraint by removing this relation.
@@ -161,9 +159,9 @@
# acs_rels to find the group and rel_type for this relation.
if { $segment_id ne "" } {
- if { [relation_segment_has_dependent -segment_id $segment_id -party_id $party_id] } {
- error "Relational constraints violated by removing this relation"
- }
+ if { [relation_segment_has_dependent -segment_id $segment_id -party_id $party_id] } {
+ error "Relational constraints violated by removing this relation"
+ }
}
db_exec_plsql relation_delete {}
@@ -190,14 +188,14 @@
} {
if { $rel_id ne "" } {
- if { ![db_0or1row select_rel_info {}] } {
- # There is either no relation or no segment... thus no dependents
- return 0
- }
+ if { ![db_0or1row select_rel_info {}] } {
+ # There is either no relation or no segment... thus no dependents
+ return 0
+ }
}
if { $segment_id eq "" || $party_id eq "" } {
- error "Both of segment_id and party_id must be specified in call to relation_segment_has_dependent"
+ error "Both of segment_id and party_id must be specified in call to relation_segment_has_dependent"
}
return [db_string others_depend_p {}]
@@ -208,25 +206,25 @@
{ -group_id "" }
rel_type
} {
- Returns 1 if group $group_id allows elements through a relation of
+ Returns 1 if group $group_id allows elements through a relation of
type $rel_type, or 0 otherwise.
If there are no relational constraints that prevent $group_id from being
on side one of a relation of type $rel_type, then 1 is returned.
@author Oumi Mehrotra (oumi@arsdigita.com)
@creation-date 2000-02-07
-
+
@param group_id - if unspecified, then we use
[application_group::group_id_from_package_id]
@param rel_type
} {
if {$group_id eq ""} {
- set group_id [application_group::group_id_from_package_id]
+ set group_id [application_group::group_id_from_package_id]
}
return [db_string rel_type_valid_p {}]
-
+
}
@@ -246,7 +244,7 @@
datasource indicates whether the type is a valid one for $group_id.
If -group_id is not specified or is specified null, then the current
- application_group will be used
+ application_group will be used
(determined from [application_group::group_id_from_package_id]).
Includes fields that are useful for
@@ -263,7 +261,7 @@
@param datasource_name
@param start_with
- @param group_id - if unspecified, then
+ @param group_id - if unspecified, then
[application_group::group_id_from_package_id] is used.
} {
@@ -291,20 +289,20 @@
Also returns a list containing the most essential information.
} {
if {$group_id eq ""} {
- set group_id [application_group::group_id_from_package_id]
+ set group_id [application_group::group_id_from_package_id]
}
template::multirow create $datasource_name \
- segment_id group_id rel_type rel_type_enc \
- rel_type_pretty_name group_name join_policy
+ segment_id group_id rel_type rel_type_enc \
+ rel_type_pretty_name group_name join_policy
set group_rel_type_list [list]
db_foreach select_required_rel_segments {} {
- template::multirow append $datasource_name $segment_id $group_id $rel_type [ad_urlencode $rel_type] $rel_type_pretty_name $group_name $join_policy
+ template::multirow append $datasource_name $segment_id $group_id $rel_type [ad_urlencode $rel_type] $rel_type_pretty_name $group_name $join_policy
- lappend group_rel_type_list [list $group_id $rel_type]
+ lappend group_rel_type_list [list $group_id $rel_type]
}
return $group_rel_type_list
}
@@ -327,13 +325,13 @@
{-multiple:boolean}
} {
Return the object_id of object one if a relation of rel_type exists between the supplied object_id_two and it.
-
+
@param multiple_p If set to "t" return a list instead of only one object_id
} {
if {$multiple_p} {
- return [db_list select_object_one {}]
+ return [db_list select_object_one {}]
} else {
- return [db_string select_object_one {} -default {}]
+ return [db_string select_object_one {} -default {}]
}
}
@@ -343,13 +341,13 @@
{-multiple:boolean}
} {
Return the object_id of object two if a relation of rel_type exists between the supplied object_id_one and it.
-
+
@param multiple_p If set to "t" return a list instead of only one object_id
} {
if {$multiple_p} {
- return [db_list select_object_two {}]
+ return [db_list select_object_two {}]
} else {
- return [db_string select_object_two {} -default {}]
+ return [db_string select_object_two {} -default {}]
}
}
@@ -361,16 +359,16 @@
Return the list of object_ids if a relation of rel_type exists between the supplied object_id and it.
} {
if {$object_id_one eq ""} {
- if {$object_id_two eq ""} {
+ if {$object_id_two eq ""} {
ad_return_error \
[_ acs-subsite.Missing_argument] \
[_ acs-subsite.lt_You_have_to_provide_a]
ad_script_abort
- } else {
- return [relation::get_object_one -object_id_two $object_id_two -rel_type $rel_type -multiple]
- }
+ } else {
+ return [relation::get_object_one -object_id_two $object_id_two -rel_type $rel_type -multiple]
+ }
} else {
- return [relation::get_object_two -object_id_one $object_id_one -rel_type $rel_type -multiple]
+ return [relation::get_object_two -object_id_one $object_id_one -rel_type $rel_type -multiple]
}
}
Index: openacs-4/packages/acs-subsite/tcl/subsite-callback-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/tcl/subsite-callback-procs.tcl,v
diff -u -N -r1.10 -r1.10.2.1
--- openacs-4/packages/acs-subsite/tcl/subsite-callback-procs.tcl 11 Apr 2018 21:01:42 -0000 1.10
+++ openacs-4/packages/acs-subsite/tcl/subsite-callback-procs.tcl 16 May 2019 09:27:52 -0000 1.10.2.1
@@ -1,5 +1,3 @@
-# /packages/acs-subsite/tcl/group-callback-procs.tcl
-
ad_library {
Procs to support a simple callback mechanism that allows other
@@ -17,7 +15,7 @@
event_type
object_id
} {
- Executes any registered callbacks for this object.
+ Executes any registered callbacks for this object.
Example:
Index: openacs-4/packages/acs-subsite/tcl/subsite-navigation-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/tcl/subsite-navigation-procs.tcl,v
diff -u -N -r1.5 -r1.5.2.1
--- openacs-4/packages/acs-subsite/tcl/subsite-navigation-procs.tcl 30 Jun 2018 21:08:42 -0000 1.5
+++ openacs-4/packages/acs-subsite/tcl/subsite-navigation-procs.tcl 16 May 2019 09:27:52 -0000 1.5.2.1
@@ -1,5 +1,3 @@
-# /packages/subsite/tcl/subsite-procs.tcl
-
ad_library {
Procs to manage the default template's navigation multirow.
@@ -134,8 +132,8 @@
} {
set info(url) "[string range $info(url) 0 [string last / $info(url)]]."
}
-
- if { [ad_conn node_id] ==
+
+ if { [ad_conn node_id] ==
[site_node::closest_ancestor_package -include_self \
-node_id [site_node::get_node_id_from_object_id -object_id $subsite_id] \
-package_key [subsite::package_keys] \
@@ -145,7 +143,7 @@
# Need to prepend the path from the subsite to this package
set current_url [string range [ad_conn url] [string length $base_url] end]
}
-
+
set info(url) [file join $info(folder) $info(url)]
regsub {\.$} $info(url) "" info(url)
@@ -169,7 +167,7 @@
}
# DRB: Expr thinks "-" is a subtraction operator thus this caveman if...
- if { $selected_p } {
+ if { $selected_p } {
set navigation_id ${group}-navigation-active
} else {
set navigation_id ""
@@ -179,7 +177,7 @@
if {[string index $info(url) end] eq "/"} {
append joined_url /
}
-
+
template::multirow append $multirow \
$group $info(label) $joined_url \
"" $info(title) "" $info(accesskey) "" $navigation_id [template::multirow size $multirow] \
@@ -254,7 +252,7 @@
if {$subsite_id eq ""} {
set subsite_id [ad_conn subsite_id]
}
-
+
set pageflow $initial_pageflow
set subsite_node_id [site_node::get_node_id_from_object_id -object_id $subsite_id]
set subsite_url [site_node::get_element -node_id $subsite_node_id -element url]
@@ -279,13 +277,13 @@
}
if { $show_applications_p } {
-
+
set index_redirect_url [parameter::get -parameter "IndexRedirectUrl" -package_id $subsite_id]
set index_internal_redirect_url [parameter::get -parameter "IndexInternalRedirectUrl" -package_id $subsite_id]
regsub {(.*)/packages} $index_internal_redirect_url "" index_internal_redirect_url
regexp {(/[-[:alnum:]]+/)(.*)$} $index_internal_redirect_url dummy index_internal_redirect_url
set child_urls [lsort -ascii [site_node::get_children -node_id $subsite_node_id -package_type apm_application]]
-
+
foreach child_url $child_urls {
array set child_node [site_node::get_from_url -exact -url $child_url]
if { $child_url ne $index_redirect_url &&
Index: openacs-4/packages/acs-subsite/tcl/subsite-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/tcl/subsite-procs.tcl,v
diff -u -N -r1.68.2.4 -r1.68.2.5
--- openacs-4/packages/acs-subsite/tcl/subsite-procs.tcl 16 May 2019 09:18:48 -0000 1.68.2.4
+++ openacs-4/packages/acs-subsite/tcl/subsite-procs.tcl 16 May 2019 09:27:52 -0000 1.68.2.5
@@ -111,7 +111,7 @@
#
#TODO: adjust sitenode hierarchy?
#TODO: permissions on main subsite (has to be always world readable)
- #TODO: memberships on site / subsite
+ #TODO: memberships on site / subsite
#TODO: address implications on permission management when hierarchy flips around
#TODO: test caching implications
#TODO: probably more