OpenACS

andrewg
committed
MAIN:andrewg:20041129050521
on 29 Nov 04
Committing an uncommitted change, so that we can have a clean record of the next change, which I'm about to make.
openacs-4/.../tcl/deprecated-procs.tcl (+13 -13)
211 211     as opposed to URL variables, which is the default.
212 212
213 213     @param exclude takes a list of names of variables you don't want exported, even though
214 214     they might be listed in the args. The names take the same form as in the args list.
215 215
216 216     @param override takes a list of the same format as args, which will get exported no matter
217 217     what you have excluded.
218 218
219 219     @author Lars Pind (lars@pinds.com)
220 220     @creation-date 21 July 2000
221 221
222 222     @see export_vars
223 223 } {
224 224
225 225     ####################
226 226     #
227 227     # Build up an array of values to export
228 228     #
229 229     ####################
230 230
231       array set export [list]
  231     array set export {}
232 232
233 233     set override_p 0
234 234     foreach argument { include override } {
235 235         foreach arg [set $argument] {
236 236             if { [llength $arg] == 1 } {
237 237                 if { $override_p || $arg ni $exclude } {
238 238                     upvar $arg var
239 239                     if { [array exists var] } {
240 240                         # export the entire array
241 241                         foreach name [array names var] {
242 242                             if { $override_p || "${arg}($name)" ni $exclude } {
243 243                                 set export($arg.$name) $var($name)
244 244                             }
245 245                         }
246 246                     } elseif { [info exists var] } {
247 247                         if { $override_p || $arg ni $exclude } {
248 248                             # if the var is part of an array, we'll translate the () into a dot.
249 249                             set left_paren [string first "(" $arg]
250 250                             if { $left_paren == -1 } {
251 251                                 set export($arg) $var
 
266 266                             # convert the parenthesis into a dot before setting
267 267                             set export([string range $arg 0 $left_paren-1].[string range $arg $left_paren+1 end-1]) \
268 268                                 [lindex [uplevel list \[subst [list $value]\]] 0]
269 269                         }
270 270                     }
271 271                 }
272 272             } else {
273 273                 return -code error "All the exported values must have either one or an even number of elements"
274 274             }
275 275         }
276 276         incr override_p
277 277     }
278 278    
279 279     ####################
280 280     #
281 281     # Translate this into the desired output form
282 282     #
283 283     ####################
284 284    
285 285     if { !$form_p } {
286           set export_list [list]
  286         set export_list {}
287 287         foreach varname [array names export] {
288 288             lappend export_list "[ns_urlencode $varname]=[ns_urlencode $export($varname)]"
289 289         }
290 290         return [join $export_list &]
291 291     } else {
292           set export_list [list]
  292         set export_list {}
293 293         foreach varname [array names export] {
294 294             lappend export_list "<input type=\"hidden\" name=\"[ns_quotehtml $varname]\"\
295 295             value=\"[ns_quotehtml $export($varname)]\" >"
296 296         }
297 297         return [join $export_list \n]
298 298     }
299 299 }
300 300
301 301 ad_proc -deprecated export_form_vars {
302 302     -sign:boolean
303 303     args
304 304 } {
305 305     Exports a number of variables as hidden input fields in a form.
306 306     Specify a list of variable names. The proc will reach up in the caller's name space
307 307     to grab the value of the variables. Variables that are not defined are silently ignored.
308 308     You can append :multiple to the name of a variable. In this case, the value will be treated as a list,
309 309     and each of the elements output separately.
310 310     <p>
311 311     export_vars is now the preferred interface.
312 312     <p>
 
798 798 } {
799 799     return [ad_header_with_extra_stuff -focus $focus $page_title $extra_stuff_for_document_head]
800 800 }
801 801
802 802 ad_proc -deprecated ad_header_with_extra_stuff {
803 803     {-focus ""}
804 804     page_title
805 805     {extra_stuff_for_document_head ""}
806 806     {pre_content_html ""}
807 807 } {
808 808     This is the version of the ad_header that accepts extra stuff for the document head and pre-page content html
809 809
810 810     @see  Documentation on the site master template for the proper way to standardize page headers
811 811 } {
812 812     set html "<html>
813 813 <head>
814 814 $extra_stuff_for_document_head
815 815 <title>$page_title</title>
816 816 </head>
817 817 "
818       array set attrs [list]
  818     array set attrs {}
819 819     set attrs(bgcolor) [parameter::get -package_id [ad_acs_kernel_id] -parameter bgcolor -default "white"]
820 820     set attrs(text)    [parameter::get -package_id [ad_acs_kernel_id] -parameter textcolor -default "black"]
821 821
822 822     if { $focus ne "" } {
823 823         template::add_body_script -script [subst {
824 824             window.addEventListener('load', function () {document.${focus}.focus()}, false);
825 825         }]
826 826     }
827 827     foreach attr [array names attrs] {
828 828         lappend attr_list "$attr=\"$attrs($attr)\""
829 829     }
830 830     append html "<body [join $attr_list]>\n"
831 831
832 832     append html $pre_content_html
833 833     return $html
834 834 }
835 835
836 836 ad_proc -deprecated ad_footer {
837 837     {signatory ""}
838 838     {suppress_curriculum_bar_p 0}
 
1756 1756       <li> datadef is the table definition as in ad_table.
1757 1757       <li> type is select or radio (only select is implemented now)
1758 1758       <li> return_url is the return url passed through to the page that validates and saves the
1759 1759          sort customization.
1760 1760       <li> item_group is a string identifying the customization "ticket_tracker_main_sort" for example.
1761 1761       <li> item is the user entered identifier
1762 1762       <li> sort_spec is the sort specifier as in ad_new_sort_by
1763 1763       <li>  allowed is the list of all the columns allowed, if empty all are allowed.
1764 1764     </ul>
1765 1765     <p>
1766 1766     An example from the ticket system:
1767 1767     <pre>
1768 1768       ad_table_sort_form $tabledef select $return_url ticket_tracker_main_sort $ticket_sort $orderby
1769 1769     </pre>
1770 1770 } {
1771 1771     # first build a map of all available columns
1772 1772     set sel_list [ad_table_column_list -sortable t $datadef $allowed]
1773 1773    
1774 1774     # build the map of currently selected columns
1775 1775     set full_column [split $sort_spec ","]
1776       set sel_columns [list]
1777       set direction [list]
  1776     set sel_columns {}
  1777     set direction {}
1778 1778     foreach col $full_column {
1779 1779         regexp {([^*,]+)([*])?} $col match coln dirn
1780 1780         if {$dirn eq "*"} {
1781 1781             set dirn desc
1782 1782         } else {
1783 1783             set dirn asc
1784 1784         }
1785 1785         lappend sel_columns $coln
1786 1786         lappend direction $dirn
1787 1787     }
1788 1788    
1789 1789     set max_columns 4
1790 1790     set n_sel_columns [llength $sel_columns]
1791 1791
1792 1792     set html {}
1793 1793     if {$item eq "CreateNewCustom" } {
1794 1794         set item {}
1795 1795     }
1796 1796     # now spit out the form fragment.
1797 1797     if {$item ne ""} {
 
2136 2136     sets the variable named $u-name in the calling environment
2137 2137     to that union, and also returns that union.</p>
2138 2138 } {
2139 2139     upvar $u-name u
2140 2140
2141 2141     foreach ve $v {
2142 2142         if { ![set_member? $u $ve] } {
2143 2143             lappend u $ve
2144 2144         }
2145 2145     }
2146 2146
2147 2147     return $u
2148 2148 }
2149 2149
2150 2150
2151 2151
2152 2152
2153 2153 ad_proc -deprecated set_intersection { u v } {
2154 2154     <p>Returns the intersection of sets $u and $v.</p>
2155 2155 } {
2156       set result [list]
  2156     set result {}
2157 2157    
2158 2158     foreach ue $u {
2159 2159         if { [set_member? $v $ue] } {
2160 2160             lappend result $ue
2161 2161         }
2162 2162     }
2163 2163
2164 2164     return $result
2165 2165 }
2166 2166
2167 2167 ad_proc -deprecated set_intersection! { u-name v } {
2168 2168     <p>Computes the intersection of the set stored in the variable
2169 2169     named $u-name in the calling environment and the set v,
2170 2170     sets the variable named $u-name in the calling environment
2171 2171     to that intersection, and also returns that intersection.</p>
2172 2172 } {
2173 2173     upvar $u-name u
2174       set result [list]
  2174     set result {}
2175 2175    
2176 2176     foreach ue $u {
2177 2177         if { [set_member? $v $ue] } {
2178 2178             lappend result $ue
2179 2179         }
2180 2180     }
2181 2181
2182 2182     set u $result
2183 2183     return $result
2184 2184 }
2185 2185
2186 2186 ad_proc -deprecated set_difference { u v } {
2187 2187     <p>Returns the difference of sets $u and $v.  (i.e. The set of all
2188 2188     members of u that aren't also members of $v.)</p>
2189 2189 } {
2190       set result [list]
  2190     set result {}
2191 2191
2192 2192     foreach ue $u {
2193 2193         if { ![set_member? $v $ue] } {
2194 2194             lappend result $ue
2195 2195         }
2196 2196     }
2197 2197
2198 2198     return $result   
2199 2199 }
2200 2200
2201 2201 ad_proc -deprecated set_difference! { u-name v } {
2202 2202     <p>Computes the difference of the set stored in the variable
2203 2203     named $u-name in the calling environment and the set v,
2204 2204     sets the variable named $u-name in the calling environment
2205 2205     to that difference, and also returns that difference.</p>
2206 2206 } {
2207 2207     upvar $u-name u
2208       set result [list]
  2208     set result {}
2209 2209
2210 2210     foreach ue $u {
2211 2211         if { ![set_member? $v $ue] } {
2212 2212             lappend result $ue
2213 2213         }
2214 2214     }
2215 2215
2216 2216     set u $result
2217 2217     return $result
2218 2218 }
2219 2219
2220 2220 ########################################################################
2221 2221 # from tcl/navigation-procs.tcl
2222 2222 ########################################################################
2223 2223
2224 2224 ad_proc -deprecated -public ad_context_bar_ws args {
2225 2225     Returns a Yahoo-style hierarchical navbar. Use ad_context_bar instead.
2226 2226
2227 2227     @param list of url desc ([list [list url desc] [list url desc] ... "terminal"])
2228 2228     @return an html fragment generated by ad_context_bar_html
 
2646 2646             set transfer_encoding base64
2647 2647         } else {
2648 2648             set transfer_encoding binary
2649 2649         }
2650 2650
2651 2651         append payload --$boundary \
2652 2652             \r\n \
2653 2653             "Content-Disposition: form-data; " \
2654 2654             "name=\"$name\"; filename=\"$filename\"" \
2655 2655             \r\n \
2656 2656             "Content-Type: $mime_type" \
2657 2657             \r\n \
2658 2658             "Content-transfer-encoding: $transfer_encoding" \
2659 2659             \r\n \
2660 2660             \r\n \
2661 2661             $data \
2662 2662             \r\n
2663 2663     }
2664 2664
2665 2665
2666       set variables [list]
  2666     set variables {}
2667 2667     switch -- $mode {
2668 2668         array {
2669 2669             set variables $formvars
2670 2670         }
2671 2671
2672 2672         formvars {
2673 2673             foreach formvar [split $formvars &] {
2674 2674                 set formvar [split $formvar  =]
2675 2675                 set key [lindex $formvar 0]
2676 2676                 set val [join [lrange $formvar 1 end] =]
2677 2677                 lappend variables $key $val
2678 2678             }
2679 2679         }
2680 2680
2681 2681         ns_set {
2682 2682             for {set i 0} {$i < [ns_set size $formvars]} {incr i} {
2683 2683                 set key [ns_set key $formvars $i]
2684 2684                 set val [ns_set value $formvars $i]
2685 2685                 lappend variables $key $val
2686 2686             }