ad_library {
Provides procedures to spit out the navigational parts of the site.
@cvs-id $Id: navigation-procs.tcl,v 1.45 2018/07/17 13:32:18 hectorr Exp $
@author philg@mit.edu
@creation-date 11/5/98 (adapted originally from the Cognet server)
}
# edited February 28, 1999 by philg to include support for a
# Yahoo-style navigation system (showing users where they are in a
# hierarchy)
ad_proc -public ad_context_bar_html {
-separator
context
} {
Generate the an html fragment for a context bar.
This is the function that takes a list in the format
[list [list url1 text1] [list url2 text2] ... "terminal text"]
and generates the html fragment. In general the higher level
proc ad_context_bar should be
used, and then only in the sitewide master rather than on
individual pages.
@param separator The text placed between each link
@param context list as with ad_context_bar
@return html fragment
@see ad_context_bar
} {
# Get the separator from subsite parameter
if { ![info exists separator] } {
set subsite_id [ad_conn subsite_id]
set separator [parameter::get -package_id $subsite_id -parameter ContextBarSeparator -default ":"]
}
set out {}
foreach element [lrange $context 0 [llength $context]-2] {
lassign $element href label
append out [subst {[ns_quotehtml $label] $separator }]
}
append out [ns_quotehtml [lindex $context end]]
return $out
}
ad_proc ad_context_node_list {
{-from_node ""}
node_id
} {
Starting with the given node_id, return a list of
[list url instance_name] items for parent nodes.
@option from_node The top-most node_id for which we'll show context bar. This can be used with
the node_id of the nearest subsite to get the context-bar only up to the nearest subsite.
@author Peter Marklund
} {
set context [list]
while { $node_id ne "" } {
array set node [site_node::get -node_id $node_id]
# JCD: Provide something for the name if the instance name is
# absent. name is the tail bit of the url which seems like a
# reasonable thing to display.
if {$node(instance_name) eq ""
&& [info exists node(name)]} {
set node(instance_name) $node(name)
}
# Don't collect link for nodes without an object underneath
# (e.g. empty site folders), as they would just be dead links
if {$node(object_id) ne ""} {
set context [list [list $node(url) [ns_quotehtml $node(instance_name)]] {*}$context]
}
# We have the break here, so that 'from_node' itself is included
if {$node_id eq $from_node} {
break
}
set node_id $node(parent_id)
}
return $context
}
ad_proc -public ad_context_bar_multirow {
{-from_node ""}
{-node_id ""}
{-multirow "context"}
context
} {
Returns a Yahoo-style hierarchical navbar. Includes "Administration"
if applicable, and the subsite if not global. 'args' can be either
one or more lists, or a simple string.
@param node_id If provided work up from this node, otherwise the current node
@param from_node If provided do not generate links to the given node and above.
@param separator The text placed between each link (passed to ad_context_bar_html if provided)
@return an html fragment generated by ad_context_bar_html
@see ad_context_bar_html
} {
if {![parameter::get -package_id [ad_conn subsite_id] -parameter ShowContextBarP -default 1]} {
return ""
}
if { $node_id eq "" } {
set node_id [ad_conn node_id]
}
set temp_node_id [util_current_location_node_id]
if { $temp_node_id eq "" } {
# not a site host_node
set node_id_url ""
set node_id_url_end 0
} else {
set from_node $temp_node_id
set node_id_url [site_node::get_url -node_id ${temp_node_id} -notrailing]
set node_id_url_end [string length $node_id_url]
}
template::multirow create $multirow url label
foreach elm [ad_context_node_list -from_node $from_node $node_id] {
lassign $elm elm_0 elm_1
if { $node_id_url_end > 0 && [string match -nocase $node_id_url [string range $elm_0 0 ${node_id_url_end}-1] ] } {
set elm_0 [string range $elm_0 $node_id_url_end end]
}
template::multirow append $multirow $elm_0 $elm_1
}
if { [string match "admin/*" [ad_conn extra_url]] } {
template::multirow append $multirow "[ad_conn package_url]admin/" "[_ acs-tcl.Administration]"
}
if { [llength $context] == 0 } {
# fix last element to just be literal string
template::multirow set $multirow [template::multirow size $multirow] url {}
} else {
foreach elm [lrange $context 0 end-1] {
template::multirow append $multirow [lindex $elm 0] [lindex $elm 1]
}
template::multirow append $multirow {} [lindex $context end]
}
}
ad_proc -public ad_context_bar {
{-from_node ""}
{-node_id ""}
-separator
args
} {
Returns a Yahoo-style hierarchical navbar. Includes "Administration"
if applicable, and the subsite if not global. 'args' can be either
one or more lists, or a simple string.
@param node_id If provided work up from this node, otherwise the current node
@param from_node If provided do not generate links to the given node and above.
@param separator The text placed between each link (passed to ad_context_bar_html if provided)
@return an html fragment generated by ad_context_bar_html
@see ad_context_bar_html
} {
if {![parameter::get -package_id [ad_conn subsite_id] -parameter ShowContextBarP -default 1]} {
return ""
}
if { $node_id eq "" } {
set node_id [ad_conn node_id]
}
set context [ad_context_node_list -from_node $from_node $node_id]
if { [string match "admin/*" [ad_conn extra_url]] } {
lappend context [list "[ad_conn package_url]admin/" \
[_ acs-tcl.Administration]]
}
if {[llength $args] == 0} {
# fix last element to just be literal string
lset context end [lindex $context end 1]
} else {
if {![string match "\{*" $args]} {
# args is not a list, transform it into one.
set args [list $args]
}
}
lappend context {*}$args
if { [info exists separator] } {
return [ad_context_bar_html -separator $separator $context]
} else {
return [ad_context_bar_html $context]
}
}
ad_proc -public ad_navbar args {
produces navigation bar. notice that navigation bar is different
than context bar, which displays packages in the site map. Navbar will
only generate HTML for those links passed to it.
@param args list of url desc ([list [list url desc] [list url desc]])
@return html fragment
@see ad_context_bar_html
} {
set counter 0
foreach arg $args {
lappend link_list [subst {[ns_quotehtml [lindex $element 1]]}]
incr counter
}
if { $counter } {
return "\[[join $link_list " | "]\]"
} else {
return ""
}
}
ad_proc -public ad_choice_bar { items links values {default ""} } {
Displays a list of choices (Yahoo style), with the currently selected one highlighted.
@see ad_navbar
} {
set count 0
set return_list [list]
foreach value $values {
if { $default eq $value } {
lappend return_list "[lindex $items $count]"
} else {
lappend return_list [subst {[ns_quotehtml [lindex $items $count]]}]
}
incr count
}
if { [llength $return_list] > 0 } {
return "\[[join $return_list " | "]\]"
} else {
return ""
}
}
ad_proc -public util_current_location_node_id { } {
returns node_id of util_current_location. Useful for hostnode mapped sites using ad_context_bar
} {
util::split_location [util_current_location] .proto location_hostname .port
if { [string match -nocase "www.*" $location_hostname] } {
set location_hostname [string range $location_hostname 4 end]
}
db_0or1row -cache_key util-${location_hostname}-node-id get_node_id_from_hostname {
select node_id from host_node_map where host = :location_hostname
}
if { ![info exists node_id ] } {
set node_id ""
}
return $node_id
}
# directories that should not receive links to move up one level
proc ad_no_uplevel_patterns {} {
set regexp_patterns [list]
lappend regexp_patterns "*/pvt/home.tcl"
# Tcl files in the root directory
lappend regexp_patterns "^/\[^/\]*\.tcl\$"
lappend regexp_patterns "/admin*"
}
# determines if java_script should be enabled
proc java_script_capabilities {} {
set user_agent ""
set version 0
set internet_explorer_p 0
set netscape_p 0
# get the version
set user_agent [ns_set get [ad_conn headers] User-Agent]
regexp -nocase "mozilla/(\[^\.\ \]*)" $user_agent match version
# IE browsers have MSIE and Mozilla in their user-agent header
set internet_explorer_p [regexp -nocase "msie" $user_agent match]
# Netscape browser just have Mozilla in their user-agent header
if {$internet_explorer_p == 0} {
set netscape_p [regexp -nocase "mozilla" $user_agent match]
}
set java_script_p 0
if { ($netscape_p && ($version >= 3)) || ($internet_explorer_p && ($version >= 4)) } {
set java_script_p 1
}
return $java_script_p
}
# netscape3 browser has a different output
proc netscape3_browser {} {
set user_agent ""
set version 0
set internet_explorer_p 0
set netscape_p 0
# get the version
set user_agent [ns_set get [ad_conn headers] User-Agent]
regexp -nocase "mozilla/(\[^\.\ \]*)" $user_agent match version
# IE browsers have MSIE and Mozilla in their user-agent header
set internet_explorer_p [regexp -nocase "msie" $user_agent match]
# Netscape browser just have Mozilla in their user-agent header
if {$internet_explorer_p == 0} {
set netscape_p [regexp -nocase "mozilla" $user_agent match]
}
set netscape3_p 0
if { $netscape_p && $version == 3 } {
set netscape3_p 1
}
return $netscape3_p
}
# creates the generic javascript/nonjavascript
# select box for the submenu
proc menu_submenu_select_list {items urls {highlight_url "" }} {
set return_string ""
set counter 0
set selectid id[clock clicks -microseconds]
append return_string [subst {
\n"
}
# --
# apisano 2016-12-01: this proc is obsolete and currently broken, as
# ad_naked_html_patterns is not defined anywhere on the
# system. Therefore, I am commenting it out.
# --
# this incorporates HTML designed by Ben (not adida, some other guy)
# proc ad_menu_header {{section ""} {uplink ""}} {
# set section [string tolower $section]
# # if it is an excluded directory, just return
# set url_stub [ad_conn url]
# set full_filename "$::acs::pageroot$url_stub"
# foreach naked_pattern [ad_naked_html_patterns] {
# if { [string match $naked_pattern $url_stub] } {
# # want the global admins with no menu, but not the domain admin
# return ""
# }
# }
# # title is the title for the title bar
# # section is the highlight for the menu
# set menu_items [menu_items]
# set java_script_p [java_script_capabilities]
# # Ben has a different table structure for netscape 3
# set netscape3_p [netscape3_browser]
# set return_string ""
# if { $java_script_p } {
# append return_string "
# "
# } else {
# append return_string "
# "
# }
# # We divide up the screen into 4 areas top to bottom:
# # + The top table which is the cognet logo and search stuff.
# # + The next table down is the CogNet name and area name.
# # + The next area is either 1 large table with 2 sub-tables, or two tables (NS 3.0).
# # The left table is the navigation table and the right one is the content.
# # + Finally, the bottom table holds the bottom navigation bar.
# append return_string "[ad_body_tag]"
# if {$netscape3_p} {
# append return_string "
# "
# } else {
# append return_string "
#
# |
# "
# }
# append return_string "
# |
# Search |
# |
# "
# } else {
# append return_string "
# |
#
#
#
"
# }
# append return_string "
#
# | "
# set uplevel_string " |
"
# foreach url_pattern [ad_no_uplevel_patterns] {
# if { [regexp $url_pattern $url_stub match] } {
# set uplevel_string ""
# }
# }
# append return_string $uplevel_string
# append return_string "
"
# if {$netscape3_p} {
# append return_string ""
# } else {
# append return_string "
#
# "
# }
# # Navigation Table
# foreach item $menu_items {
# if { $item == [menu_highlight $section] } {
# append return_string " | "
# } else {
# append return_string " | "
# }
# }
# append return_string "
#
#
#
# [menu_subsection $section]
#
# |
# "
# if {$netscape3_p} {
# append return_string ""
# } else {
# append return_string "
# "
# }
# append return_string ""
# }
# --
# apisano 2017-02-08: this proc is obsolete and currently broken, as
# ad_naked_html_patterns is not defined anywhere on the
# system. Therefore, I am commenting it out.
# --
# proc ad_menu_footer {{section ""}} {
# # if it is an excluded directory, just return
# set url_stub [ad_conn url]
# set full_filename "$::acs::pageroot$url_stub"
# foreach naked_pattern [ad_naked_html_patterns] {
# if { [string match $naked_pattern $url_stub] } {
# return ""
# }
# }
# set netscape3_p 0
# if {[netscape3_browser]} {
# set netscape3_p 1
# }
# append return_string " | "
# # close up the table
# if {$netscape3_p != 1} {
# append return_string " |
# "
# }
# # bottom bar
# append return_string "
# "
# return $return_string
# }
# Local variables:
# mode: tcl
# tcl-indent-level: 4
# indent-tabs-mode: nil
# End:
|