[Tcladdressbook-commits] Contribs/Alpha/CardBrowser/AAB AAB-Card.tcl,NONE,1.1

SourceForge Headquarters 1320 Columbia Street Suite 310 San Diego, CA 92101 +1 (858) 422-6466

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
}