[Tcladdressbook-commits] Contribs/Alpha/CardBrowser/AAB AAB-Card.tcl,NONE,1.1
Status: Alpha
Brought to you by:
bdesgraupes
|
From: Bernard D. <bde...@us...> - 2004-08-24 06:01:00
|
Update of /cvsroot/tcladdressbook/Contribs/Alpha/CardBrowser/AAB In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv2444/Contribs/Alpha/CardBrowser/AAB Added Files: AAB-Card.tcl Log Message: First checkin --- NEW FILE: AAB-Card.tcl --- package require AAB 0.2 # At this point it is assumed that the file AAB.tcl has been sourced, # creating the namespace ::AAB and defining the standard procs. unset -nocomplain AAB::staticCardParameters set AAB::staticCardParameters(keys) [list \ First Last Organization Address.home.Street Address.home.City Address.home.ZIP \ Address.home.province Address.home.state Address.home.country \ Phone.home Phone.mobile Phone.work Phone.fax Email.home Email.work \ HomePage Birthday Note \ ] set AAB::staticCardParameters(headKeys) [list First Last] set AAB::staticCardParameters(listWidth) 30 set AAB::staticCardParameters(cardWidth) 80 set AAB::staticCardParameters(cardHeight) 17 set AAB::staticCardParameters(phoneNames) \ [list "Phone (home)" "Phone (work)" "Phone (mobile)"] set AAB::staticCardParameters(searchTemplate) \ [file join $CardBrowserBetaPath CardBrowser AAB searchTemplate] source [file join $CardBrowserBetaPath CardBrowser AAB aabMenu.tcl] # # # # # Show all cards... # proc AAB::run {} { # variable _dynamicCardParameters # variable staticCardParameters # set _dynamicCardParameters(matchingUIDs) [addressbook persons -ids] # set _dynamicCardParameters(len) [llength $AAB::_dynamicCardParameters(matchingUIDs)] # set _dynamicCardParameters(matchIndex) 0 # set _dynamicCardParameters(currentCard) [addressbook getme] # set _dynamicCardParameters(entryList) [list ] # foreach uid $_dynamicCardParameters(matchingUIDs) { # set entry "" # catch { append entry "[addressbook set $uid First] " } # catch { append entry "[addressbook set $uid Last] " } # set entry [format "%-*.*s" $S(listWidth) $S(listWidth) $entry] # lappend _dynamicCardParameters(entryList) $entry # } # # # displayFirstCard AAB # } proc AAB::printCard { UID } { set M [getRecord $UID] set pKeys [keylkeys M] # set keyLength [expr {[longestEntry $::staticCardParameters(keys)] + 3}] set keyLength 20 set pad [string repeat { } $keyLength] set company 0 # Write the company flag if it exists if { ![catch { set ABPF [keylget M ABPersonFlags] }] } { if { $ABPF } { set company 1 append txt [format "%*s" 80 "COMPANY"] if { [lcontain $pKeys Organization] } { append txt \r append txt [format "%*s" $keyLength "Organization: "] append txt "[keylget M Organization]\r" } } } append txt "\r" # Write the name, if it exists if { [lsearch -regexp $pKeys (First|Last)] != -1 } { append txt [format "%*s" $keyLength "Name: "] catch { append txt "[keylget M First] " } catch { append txt "[keylget M Last]" } append txt \r\r } if { [lcontain $pKeys Address] } { set places [keylkeys M Address] # Write the addresses, if any foreach p {home work} { if { [lcontain $places $p] } { append txt [format "%*s" $keyLength "Address ($p): "] set A [keylget M Address.$p] if { [lcontain [keylkeys A] Street] } { set chunk [keylget A Street] append txt [regsub -all {[\r\n]} $chunk "\r$pad"] } append txt "\r$pad" foreach c {ZIP City Province State} { if { [lcontain [keylkeys A] $c] } { append txt [keylget A $c] " " } } if { [lcontain [keylkeys A] Country] } { append txt [keylget A Country] \r } } } } ; # end of "Address" append txt \r if { [lcontain $pKeys Phone] } { set places [keylkeys M Phone] # Write the phone numbers, if any foreach p {home mobile work fax} { if { [lcontain $places $p] } { append txt [format "%*s" $keyLength "Phone ($p): "] set ph [keylget M Phone.$p] append txt $ph append txt "\r$pad" } regsub -- "$pad$" $txt "" txt } } ; # end of "Phone" append txt \r if { [lcontain $pKeys Email] } { set places [keylkeys M Email] # Write the email addresses, if any foreach p {home work} { if { [lcontain $places $p] } { append txt [format "%*s" $keyLength "Email ($p): "] set email [keylget M Email.$p] append txt $email append txt "\r$pad" } regsub -- "$pad$" $txt "" txt } } ; # end of "Email" # Write the HomePage, if any if { [lcontain $pKeys HomePage] } { append txt [format "%*s" $keyLength "HomePage: "] set chunk [keylget M HomePage] append txt $chunk append txt "\r$pad" } ; # end of "HomePage" append txt \r # Write the birthday, if any if { [lcontain $pKeys Birthday] } { append txt [format "%*s" $keyLength "Birthday: "] append txt [keylget M Birthday] append txt "\r$pad" } ; # end of "Birthday" append txt \r # Write the groups that this person is member of, if any set groupIDs [addressbook parents $UID] if { [llength $groupIDs] } { append txt "Groups: " foreach G $groupIDs { set R [addressbook record $G] set groupName [keylget R GroupName] append txt $groupName " " } append txt "\r" } # Write the note, if any if { [lcontain $pKeys Note] } { # The following substitution is probably just a personal problem set chunk [regsub -all -- {\13} [keylget M Note] \r] append txt "Note: " append txt $chunk append txt "\r$pad" } ; # end of "Note" variable staticCardParameters set vspace [expr $staticCardParameters(cardHeight) - [regexp -all \r $txt] -1] append txt [string repeat \r $vspace] catch { append bottomline "Created: [keylget M Creation], " } catch { append bottomline "Modified: [keylget M Modification]" } catch { append txt [format "%*s" 80 $bottomline] } return $txt } proc AAB::init { args } { global aabMenu insertMenu $aabMenu } proc AAB::properClose { args } { global aabMenu removeMenu $aabMenu } Bind 'a' <P> { ::Card::run ::AAB } # source [file join $CardBrowserBetaPath AAB aabMenu.tcl] proc AAB::thisIsACompany {} { set client [Card::clientOfWindow] upvar #0 ::${client}::_dynamicCardParameters D set uid $D(currentCard) set rec [${client}::getRecord $uid] if { [lcontain [keylkeys rec] "ABPersonFlags"] && [keylget rec ABPersonFlags] } { keylset ABPFrec ABPersonFlags 0 } else { keylset ABPFrec ABPersonFlags 1 } if { [catch { ${client}::setRecord $uid $ABPFrec } err] } { error "Error saving record: $err" } Card::reloadCurrentCard ::AAB } proc Card::putAddressInClipboard {} { if { ![string equal [clientOfWindow] "::AAB"] } { return } putScrap [::AAB::formatAddress [currentCard ::AAB]] status::msg "Address put in the Clipboard" } proc AAB::printLabelsForTheseCards {} { set client [clientOfWindow] if { ![string equal $client "::AAB"] } { return } upvar #0 ::${client}::_dynamicCardParameters D foreach uid $D(matchingUIDs) { if { [catch {append txt [::AAB::formatAddress $uid]}] } { set name [string trim [Card::_headKeyIncludingSpacePadding ::AAB $uid]] alertnote "No address found for $name" } append txt "\r\r" } new -n Labels insertText $txt goto [minPos] } proc AAB::addCollectionToGroup {} { if { ![string equal [::Card::clientOfWindow] "::AAB"] } { return } set groups [addressbook groups] foreach G $groups { lappend groupNames [lindex $G 1] } if { [catch {set i [listpick -p "Add collection to which group?" \ -indices $groupNames]}] } { return } # Remove this when the -indices flag works: set i [lsearch -exact $groupNames $i] upvar #0 ::AAB::_dynamicCardParameters D foreach uid $D(matchingUIDs) { addressbook add [lindex $groups $i 0] $uid } addressbook save Card::displayCollection ::AAB $D(matchingUIDs) -sort } # When addressbook parents learns to return also the name, then # the following must be adjusted... proc AAB::removeFromGroup {} { if { ![string equal [::Card::clientOfWindow] "::AAB"] } { return } set UID [::Card::currentCard ::AAB] set groups [addressbook parents $UID] if { [llength $groups] == 0 } { status::msg "No member of any group" return } elseif { [llength $groups] == 1 } { addressbook remove [lindex $groups 0] $UID } else { set groupNames [list ] foreach G $groups { lappend groupNames [addressbook set $G GroupName] } if { [catch {set i [listpick -p "Remove card from which group?" \ -indices $groupNames]}] } { return } # Remove this when the -indices flag works: set i [lsearch -exact $groupNames $i] addressbook remove [lindex $groups $i] $UID } addressbook save Card::reloadCurrentCard ::AAB } proc AAB::showGroup { {groupID "" } } { # if { ![string equal [::Card::clientOfWindow] "::AAB"] } { # return # } if { ![string length $groupID] } { set groups [addressbook groups] foreach G $groups { lappend groupNames [lindex $G 1] } if { [catch {set i [listpick -p "Pick a group:" \ -indices $groupNames]}] } { return } # Remove this when the -indices flag works: set i [lsearch -exact $groupNames $i] set groupID [lindex $groups $i 0] } # Card::displayCollection ::AAB [addressbook persons -ingroup -ids $groupID] Card::displayCollection ::AAB [allPersonsInGroupRecursively $groupID] } proc AAB::allPersonsInGroupRecursively { groupID } { set res [addressbook persons -ingroup -ids $groupID] foreach childGroup [addressbook groups -ingroup -ids $groupID] { set res [concat $res [allPersonsInGroupRecursively $childGroup]] } return $res } proc AAB::showAll {} { ::Card::displayCollection ::AAB [listAllRecords] } proc AAB::newGroup {} { if { [catch { set str [prompt "Name for new group: " ""] } ] } { return } variable groups [addressbook groups] variable groupNames [list ] foreach G $groups { lappend groupNames [lindex $G 1] } if { [lcontain $groupNames $str] } { alertnote "Group name \'$str\' already taken. Please give a new name." newGroup return } if { [catch {set parent [listpick -p "Make group \'$str\' a subgroup of another group?:" \ -indices $groupNames]}] } { set cmd [list addressbook create group $str] } else { set i [lsearch -exact $groupNames $parent] set cmd [list addressbook create group $str -ingroup [lindex $groups $i 0]] } eval $cmd addressbook save set groups [addressbook groups] set groupNames [list ] foreach g $groups { lappend groupNames [lindex $g 1] } # Rebuild the Groups menu menu::buildSome Groups } proc AAB::sendEmail {} { set uid [Card::currentCard :AAB] set R [getRecord $uid] set emailList [keylget R Email] set places [keylkeys emailList] if { [llength $places] == 0 } { status::msg "No email address found" } elseif { [llength $places] == 1 } { set place [lindex $places 0] set email [keylget emailList $place] } else { if { [catch {set placeEmail [listpick -p "Which email address to use?:" \ $emailList]}] } { return } set email [lindex $placeEmail 1] } Card::sendEmail $email } |