- Publicity: Public Only All
tagcloud-procs.tcl
Procs to generate a tag cloud for a given category tree.
- Location:
- packages/categories/tcl/tagcloud-procs.tcl
- Created:
- Sun Oct 2 16:58:34 2005
- Author:
- Matthew Burke <matt-oacs@bluedino.net>
- CVS Identification:
$Id: tagcloud-procs.tcl,v 1.8.2.1 2019/03/15 13:28:50 antoniop Exp $
Procedures in this file
- category::tagcloud::get_tags (public)
- category::tagcloud::tagcloud (public)
Detailed information
category::tagcloud::get_tags (public)
category::tagcloud::get_tags -tree_id tree_id
Returns a list of categories and their weights (number of objects mapped to each category) for a give category tree. This is a memoized function which caches for two hours.
- Switches:
- -tree_id
(required)- Author:
- Matthew Burke <matt-oacs@bluedino.net>
- Created:
- Oct 1, 2005
- See Also:
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- category_object_mapping
category::tagcloud::tagcloud (public)
category::tagcloud::tagcloud -tree_id tree_id
Generate a tag cloud for the categories in the given category tree.
- Switches:
- Options:
- -tree_id
(required)
- -tree_id
- tree_id of the tree for which to generate the cloud.
- Returns:
- HTML fragment for the tag cloud.
- Author:
- Matthew Burke <matt-oacs@bluedino.net>
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- category_object_mapping
Content File Source
# /Users/matthewburke/development/web/bitdojo/packages/categories/tcl/tagcloud-procs.tcl ad_library { Procs to generate a tag cloud for a given category tree. @author Matthew Burke (matt-oacs@bluedino.net) @creation-date Sun Oct 2 16:58:34 2005 @cvs-id $Id: tagcloud-procs.tcl,v 1.8.2.1 2019/03/15 13:28:50 antoniop Exp $ } namespace eval category::tagcloud {} d_proc -private category::tagcloud::get_minmax_tagweights { -tag_list:required } { Returns a list with the minimum and maximum weight values in the given list. @author Matthew Burke (matt-oacs@bluedino.net) } { set max_weight 0 set min_weight [lindex $tag_list 0 1] foreach tag $tag_list { set tag_weight [lindex $tag 1] if {$tag_weight < $min_weight} { set min_weight $tag_weight } if {$tag_weight > $max_weight} { set max_weight $tag_weight } } return [list $min_weight $max_weight] } d_proc -private category::tagcloud::scale_weight { -weight:required -extremes:required } { Returns the weight as a font-size between 10px and 36px scaled between the min and max weights passed in. @author Matthew Burke (matt-oacs@bluedino.net) } { set denominator [expr {[lindex $extremes 1] - [lindex $extremes 0]}] if {$denominator != 0} { set multiplier [expr {($weight * 1.0)/$denominator}] } else { set multiplier 0 } set result [expr {10 + round($multiplier*(36-10))}] return $result } d_proc -public category::tagcloud::tagcloud { -tree_id:required } { Generate a tag cloud for the categories in the given category tree. @option tree_id tree_id of the tree for which to generate the cloud. @return HTML fragment for the tag cloud. @author Matthew Burke (matt-oacs@bluedino.net) } { set html_fragment "<div class=\"tagcloud\">\n" set tag_list [category::tagcloud::get_tags -tree_id $tree_id] # now build the frag set weights [category::tagcloud::get_minmax_tagweights -tag_list $tag_list] # and what if category package isn't mounted at /category? foreach tag $tag_list { append html_fragment "<a href=\"/categories/categories-browse?tree_ids=$tree_id&category_ids=[lindex $tag 0]\" style=\"font-size: [category::tagcloud::scale_weight -weight [lindex $tag 1] -extremes $weights]px;\" class=\"tag\">[lindex $tag 2]</a>\n" } append html_fragment "</div>" return $html_fragment } d_proc -private category::tagcloud::get_tags_no_mem { -tree_id:required } { Returns a list of categories and their weights (number of objects mapped to each category) for a give category tree. @author Matthew Burke (matt-oacs@bluedino.net) @creation-date Oct 1, 2005 } { set user_locale [ad_conn locale] set user_id [ad_conn user_id] set default_locale [parameter::get -parameter DefaultLocale -default en_US] ns_log Warning "def loc $default_locale" # this whole locale thing isn't handled well. # categories get inserted in the site's default_locale and # the category creator's locale (?) # so we should check for the reader's locale and use that # or the default_locale, but ... set tag_list [db_list_of_lists tagcloud_get_keys { select category_id, count(com.object_id), min(trans.name) from categories natural left join category_object_map com natural join category_trees natural join category_translations trans where tree_id = :tree_id and trans.locale = :default_locale and acs_permission.permission_p(com.object_id, :user_id, 'read') group by category_id }] } d_proc -public category::tagcloud::get_tags { -tree_id:required } { Returns a list of categories and their weights (number of objects mapped to each category) for a give category tree. This is a memoized function which caches for two hours. @author Matthew Burke (matt-oacs@bluedino.net) @creation-date Oct 1, 2005 @see category::tagcloud::get_tags_no_mem } { return [util_memoize [list category::tagcloud::get_tags_no_mem -tree_id $tree_id] 7200] } # Local variables: # mode: tcl # tcl-indent-level: 4 # indent-tabs-mode: nil # End: