2
# $Id: cmdfunc.tcl 796 2007-11-08 01:14:02Z mikes@u.washington.edu $
3
# ========================================================================
4
# Copyright 2006 University of Washington
6
# Licensed under the Apache License, Version 2.0 (the "License");
7
# you may not use this file except in compliance with the License.
8
# You may obtain a copy of the License at
10
# http://www.apache.org/licenses/LICENSE-2.0
12
# ========================================================================
16
# Purpose: CGI script to serve as single location for menu/command
17
# function definitions
19
# OPTIMIZE: have servlet interpreter grok/exec these?
26
proc WPTFTitle {{context {some page}} {newmail {}} {nologo 0} {aboutcancel {}}} {
29
cgi_table border=0 cellspacing=0 cellpadding=0 width="100%" class=title {
32
cgi_table_data valign=top align=left height=$_wp(titleheight) {
34
if {[string length $aboutcancel]} {
35
cgi_put [cgi_url [cgi_imglink smalllogo] wp.tcl?page=help&topic=about&oncancel=$aboutcancel class=navbar target=_top]
37
cgi_put [cgi_imglink smalllogo]
42
# work in new mail here
43
if {[llength $newmail]} {
44
cgi_table_data align=center {
45
WPTFStatusTable $newmail
49
cgi_table_data align=right valign=middle height=$_wp(titleheight) {
50
cgi_put [cgi_span "style=margin-right: 8; color: $_wp(titlecolor)" "$context"]
56
proc WPTFStatusTable {msgs {iconlink {0}} {style {}}} {
59
cgi_table width=100% border=0 cellpadding=0 cellspacing=0 $style {
60
cgi_table_row align=right {
62
if {[info exists _wp(statusicons)] && $_wp(statusicons)} {
63
set img [cgi_imglink bang]
66
if {[string length [lindex $m 1]]} {
67
set img [cgi_imglink [lindex $m 1]]
68
if {$iconlink && [string length [lindex $m 2]]} {
69
set img [cgi_url $img wp.tcl?page=view&uid=[lindex $m 2] target=body]
82
cgi_table_data align=center class="statustext" {
87
if {[array exists lastmsg] && [info exists lastmsg([lindex $m 0])]} {
88
incr lastmsg([lindex $m 0])
92
if {0 == [string compare [string range [lindex $m 0] 0 20] "Alert received while "]} {
93
set style "style=border: 1px solid red ; background-color: pink; padding: 2; width: 80%;"
94
} elseif {!([info exists _wp(statusicons)] && $_wp(statusicons))} {
95
set style "style=color: white ; background-color: $_wp(menucolor); padding-left:8px; padding-right:8px; white-space: nowrap;"
100
if {$iconlink && [string length [lindex $m 2]] && !([info exists _wp(statusicons)] && $_wp(statusicons))} {
101
set txt [cgi_url [lindex $m 0] wp.tcl?page=fr_view&uid=[lindex $m 2] target=body "style=text-decoration: none; color: white"]
103
set txt [lindex $m 0]
106
cgi_division "style=\"padding-bottom: 1px\"" {
107
cgi_puts [cgi_span $style $txt]
110
set lastmsg([lindex $m 0]) 1
114
if {[info exists _wp(statusicons)] && $_wp(statusicons)} {
115
cgi_table_data align=left {
124
proc WPTFImageButton {args} {
125
return [cgi_buffer {eval cgi_image_button $args border=0}]
128
proc WPTFCommandMenu {s_menu c_menu} {
132
if {[string length $s_menu]} {
133
upvar $s_menu specificmenu
134
if {[llength $specificmenu]} {
135
lappend clist $specificmenu
139
if {[string length $c_menu]} {
140
upvar $c_menu commonmenu
141
if {[llength $commonmenu]} {
142
if {[llength $clist]} {
145
lappend clist $commonmenu
149
cgi_table border=0 bgcolor=$_wp(menucolor) cellpadding=0 cellspacing=0 width=112 "style=\"padding: 8 0 8 4\"" {
150
foreach menulist $clist {
151
switch [llength $menulist] {
160
foreach item $menulist {
161
if {[llength $item] == 0} {
169
if {[llength $item] == 1} {
172
eval [lindex $item 0]
177
if {[string length [lindex $item 0]]} {
178
if {[uplevel [lindex $item 0]] == 0} {
184
foreach l [lindex $item 1] {
185
cgi_table_data align=left valign=middle class=navbar {
197
proc WPTFScript {scrpt {dflt ""}} {
206
WPCmd PEInfo set wp_body_script $src
210
WPCmd PEInfo set wp_body_script $src
213
if {[catch {WPCmd PEInfo set wp_body_script} src]} {
215
catch {WPCmd PEInfo set wp_body_script $src}
222
set src fr_queryquit.tcl
228
set src fldrbrowse.tcl
231
set src fldrsavenew.tcl
234
set src fr_querydelfldr.tcl
237
set src fr_compose.tcl
240
set src fr_addrbrowse.tcl
243
set src fr_fldrbrowse.tcl
246
set src fr_fldrsavenew.tcl
252
set src fr_takeedit.tcl
255
set src fr_takesame.tcl
258
set src fr_ldapbrowse.tcl
273
set src conf_process.tcl
276
set src fr_resume.tcl
279
set src fr_spellcheck.tcl
282
set src fr_queryauth.tcl
285
set src fr_queryexpunge.tcl
288
set src fr_queryattach.tcl
291
set src fr_ldapquery.tcl
294
set src fr_querycreate.tcl
297
set src fr_queryprune.tcl
315
if {[regexp {.*\.tcl$} $scrpt s]} {
317
} elseif {[string length $dflt]} {
320
error "Unrecognized script abbreviation: $scrpt"
325
return [file join $_wp(cgipath) $_wp(appdir) $src]
328
proc WPTFSaveDefault {{uid 0}} {
329
# "size" rather than "number" to work around temporary alpined bug
331
|| [catch {WPCmd PEMessage $uid size} n]
333
|| [catch {WPCmd PEMessage $uid savedefault} savedefault]} {
334
if {[WPCmd PEFolder isincoming 0]} {
340
return [list $colid "saved-messages"]
346
if {$_wp(keybindings)} {
347
proc WPTFKeyEquiv {kl {exclusions {}} {frame window}} {
348
if {[llength $kl] > 0} {
351
append js "function bindListener(o,f)\{"
353
append js "o.addEventListener('keypress',f, false);\n"
354
set cancelkeystroke "e.preventDefault(); return false;"
356
append js "o.onkeydown = f;\n"
357
set cancelkeystroke "return false;"
359
append js "o.onkeydown = f;"
360
append js "o.captureEvents(Event.KEYDOWN);\n"
361
set cancelkeystroke "return false;"
365
append js "function nobubble(e)\{"
367
append js " e.stopPropagation();"
369
append js " event.cancelBubble = true;"
373
append js "function keyed(e)\{"
374
if {[isW3C] && [llength $exclusions]} {
376
foreach o $exclusions {
377
if {[string length $ex]} {
381
append ex "e.target == $o"
383
append js "if (e.target && ($ex)) return true;"
385
append js " var c = getKeyStr(e);"
386
append js " if(getControlKey(e))\{"
387
append js " switch(c)\{"
388
append js " case 'n' : window.status = 'New window creation disabled in WebPine.' ; $cancelkeystroke"
392
append js " switch(c)\{"
394
append js " case '[lindex $kb 0]' : ${frame}.webpinelink = 1; [lindex $kb 1] ; $cancelkeystroke"
399
set onload "bindListener(document,keyed);"
402
foreach o $exclusions {
403
append onload "bindListener($o,nobubble);"
416
# add given folder name to the cache of saved-to folders
417
proc WPTFAddSaveCache {f_name} {
420
if {[catch {WPSessionState save_cache} flist] == 0} {
421
if {[set i [lsearch -exact $flist $f_name]] < 0} {
422
set flist [lrange $flist 0 [expr {$_wp(save_cache_max) - 2}]]
424
set flist [lreplace $flist $i $i]
427
set flist [linsert $flist 0 $f_name]
429
set flist [list $f_name]
432
catch {WPSessionState save_cache $flist}
435
# return the list of cached saved-to folders and make sure given
436
# default is somewhere in the list
437
proc WPTFGetSaveCache {{def_name ""}} {
439
if {![string length $def_name]} {
440
set savedef [WPTFSaveDefault 0]
441
set def_name [lindex $savedef 1]
446
if {[catch {WPSessionState save_cache} flist] == 0} {
448
if {[string compare $def_name $f] == 0} {
452
if {[string length $f] && [lsearch -exact $seen $f] < 0} {
460
if {!([info exists options] && [info exists def_listed])} {
461
lappend options $def_name
462
lappend options $def_name
465
if {[catch {WPCmd set wp_cache_folder} wp_cache_folder]
466
|| [string compare $wp_cache_folder [WPCmd PEMailbox mailboxname]]} {
467
# move default to top on new folder
468
switch -- [set x [lsearch -exact $options $def_name]] {
472
set options [lreplace $options $x [expr {$x + 1}]]
475
set options [linsert $options 0 $def_name]
476
set options [linsert $options 0 $def_name]
480
catch {WPCmd set wp_cache_folder [WPCmd PEMailbox mailboxname]}
483
lappend options "\[ folder I type in \]"
484
lappend options "__folder__prompt__"
486
lappend options "\[ folder in my folder list \]"
487
lappend options "__folder__list__"
492
# add given folder name to the visited folder cache
493
proc WPTFAddFolderCache {f_col f_name} {
496
if {$f_col != 0 || [string compare [string tolower $f_name] inbox]} {
497
if {0 == [catch {WPSessionState folder_cache} flist]} {
499
if {[catch {WPSessionState left_column_folders} fln]} {
500
set fln $_wp(fldr_cache_def)
503
for {set i 0} {$i < [llength $flist]} {incr i} {
504
set f [lindex $flist $i]
505
if {$f_col == [lindex $f 0] && 0 == [string compare [lindex $f 1] $f_name]} {
510
if {$i >= [llength $flist]} {
511
set flist [lrange $flist 0 $fln]
513
set flist [lreplace $flist $i $i]
516
set flist [linsert $flist 0 [list $f_col $f_name]]
517
# let users of data know it's changed (cheaper than hash)
518
WPScriptVersion common 1
521
lappend flist [list $f_col $f_name] [list [WPTFSaveDefault 0]]
523
WPScriptVersion common 1
526
catch {WPSessionState folder_cache $flist}
530
# return the list of cached visited folders and make sure given
531
# default is somewhere in the list
532
proc WPTFGetFolderCache {} {
533
if {[catch {WPSessionState folder_cache} flist]} {
535
lappend flist [WPTFSaveDefault 0]
536
catch {WPSessionState folder_cache $flist}
542
proc WPExitOnClose {{frame window}} {
545
cgi_script type="text/javascript" language="JavaScript" {
546
cgi_put "function wpLink(){"
547
cgi_put " ${frame}.webpinelink = 1;"
548
cgi_put " return true;"
550
cgi_put "function wpLoad(){"
551
cgi_put " ${frame}.webpinelink = 0;"
553
cgi_put "function wpUnLoad(){"
554
cgi_put " if(!${frame}.webpinelink){"
555
cgi_put " window.open('[cgi_root]/$_wp(appdir)/ripcord.tcl?t=10&cid=[WPCmd PEInfo key]','Depart','width=350,height=200');"
562
# tweak some cgi_* procs for global effect
563
if {0 == [catch {rename cgi_url _wp_orig_cgi_url}]} {
564
proc cgi_url {args} {
565
lappend newargs [lindex $args 0]
566
foreach a [lrange $args 1 end] {
567
if {[regexp "^(onClick)=(.*)" $a dummy attr str]} {
569
lappend newargs "${attr}=wpLink();${str}"
575
if {![info exists onclicked]} {
576
lappend newargs "onClick=wpLink();"
579
return [eval "_wp_orig_cgi_url $newargs"]
583
if {0 == [catch {rename cgi_area _wp_orig_cgi_area}]} {
584
proc cgi_area {args} {
585
lappend newargs [lindex $args 0]
586
foreach a [lrange $args 1 end] {
587
if {[regexp "^(onClick)=(.*)" $a dummy attr str]} {
589
lappend newargs "${attr}=\"wpLink();${str}\""
595
if {![info exists onclicked]} {
596
lappend newargs "onClick=\"return wpLink();\""
599
return [eval "_wp_orig_cgi_area $newargs"]
603
if {0 == [catch {rename cgi_form _wp_orig_cgi_form}]} {
604
proc cgi_form {args} {
605
foreach a [lrange $args 0 [expr [llength $args]-2]] {
606
if {[regexp "^onSubmit=(.*)" $a dummy str]} {
608
lappend newargs "onSubmit=wpLink(); ${str}"
614
if {![info exists onsubmitted]} {
615
lappend newargs "onSubmit=return wpLink();"
618
lappend newargs [lindex $args end]
620
uplevel 1 "_wp_orig_cgi_form $newargs"
626
proc WPTFIndexWidthRatio {fields field} {
627
# should be formula based on total fields
628
# and number of "wider" fields
629
switch [string toupper $field] {
636
SUBJECT { return 1.25 }
added
removed
web/cgi/alpine/cmdfunc.tcl
