PortAuthority

The Aquahig package

The aquahig package implements some Mac OS X-specific configurations to selected Tk megawidgets to make them better fit in visually with Mac interface conventions, similar to iTunes and other Mac applications. Currently supported widgets are the BWidgets Tree, the BWidgets ListBox, and Tablelist. 

Using the Aquahig Package

The aquahig package is invoked by calling package require aquahig. It implements Mac styling for widgets in the form of arrays: 

* aquahig::treeopts: These options add a Mac-style "disclosure triangle" to the BWidget Tree, remove the lines for tree nodes (which is more charactertistic of Windows), and add a light blue background and a blue highlight foreground (similar to iTunes). They also specify the correct font size and spacing. 

* aquahig::listopts: These options add a light blue background and a blue highlight foreground (similar to iTunes) to the BWidget ListBox. They also specify the correct font size and spacing. 

* aquahig::tableopts: These options add a light blue stripe, a blue highlight foreground color, and vertical rules (similar to iTunes) to TableList. 

Usage of the package would look something like this: 

foreach {key value} [array get aquahig::treeopts] { 
$w configure -$key $value 
} 

Note: the aquahig package depends on the TkImg or TkPNG packages, as the Mac-style disclosure triangles are pngs. To use another image format, such as .gif, you will need to edit the source code accordingly. 

License

The aquahig package is licensed under the same license as Tcl/Tk itself. See http://www.tcl.tk/software/tcltk/license.html for the current license. 

#aquahig: provides sane OS X UI configs for BWidget Tree, BWidget ListBox, and Tablelist. (c) 2007 WordTech Communications LLC. License: standard Tcl license, http://www.tcl.tk/software/tcltk/license.html

package provide aquahig 1.2

namespace eval aquahig {

    if {![info exists library]} {
	variable library [file dirname [info script]]
    }



## usage, cf for BWidget Tree: 
##        foreach {key value} [array get aquahig::treeopts] {
##               $w configure -$key $value
##          }

##create Mac-style "disclosure triangle" for tree view
    image create bitmap hig_triangleright -file [file join $aquahig::library triangleright.xbm]
    image create bitmap hig_triangledown -file [file join $aquahig::library triangledown.xbm]



##configuration options for BWidget Tree
    array set [namespace current]::treeopts {

	selectbackground   #84a6cb
	selectforeground   white
	deltay             17
	showlines	   0
	crossopenimage	   hig_triangledown
	crosscloseimage    hig_triangleright
	background         #e3e9f1
	highlightcolor     #e3e9f1 
	highlightthickness .1
	relief             flat
	selectfill         1
	borderwidth        0

    }

##configuration options for Bwidget ListBox    
    array set [namespace current]::listopts {

	selectbackground  #84a6cb
	selectforeground   white
	deltay             21
	background         #e3e9f1 
	highlightcolor     #e3e9f1 
	relief             flat
	selectfill         1

    }

 ##configuration options for Tablelist
    array set [namespace current]::tableopts {

	selectbackground   RoyalBlue1
	selectforeground   white
	stretch	           all
	stripebackground   #EDF3FE
	relief             flat
	border             0
	showseparators     yes
	takefocus          0
        setfocus           1
        activestyle        none
    }

    namespace export *
}

# Tcl package index file, version 1.1
# This file is generated by the "pkg_mkIndex" command
# and sourced either when an application starts up or
# by a "package unknown" script.  It invokes the
# "package ifneeded" command to set up package-related
# information so that packages will be loaded automatically
# in response to "package require" commands.  When this
# script is sourced, the variable $dir must contain the
# full path name of this file's directory.

package ifneeded aquahig 1.2 [list source [file join $dir aquahig.tcl]]

#define triangledown_width 13
#define triangledown_height 13
static unsigned char triangledown_bits[] = {
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0x03, 0xf8, 0x03, 0xf8, 0x03,
   0xf0, 0x01, 0xf0, 0x01, 0xe0, 0x00, 0x60, 0x00, 0x40, 0x00, 0x00, 0x00,
   0x00, 0x00 };

#define triangleright_width 13
#define triangleright_height 13
static unsigned char triangleright_bits[] = {
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x0c, 0x00, 0x7c, 0x00, 0xfc, 0x00,
   0xfc, 0x03, 0xfc, 0x00, 0x7c, 0x00, 0x1c, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00 };

 * The Tcl/Tk GUI toolkit. Website: [http://www.tcl.tk]. License: [http://www.tcl.tk/software/tcltk/license.html]
 * The tcllib and tklib libraries for Tcl/Tk. Website and license: [http://tcllib.sourceforge.net].
 * The BWidget GUI library for Tcl/Tk. Website and license: [http://tcllib.sourceforge.net].
 * The MacPorts software management system. Website and license: [http://www.macports.org].
 * The cocoaprint package for native printing. Website and license: [http://fossil.codebykevin.com].
 * The TclServices package. Website and license: [http://fossil.codebykevin.com].
 * The Aquahig package for OS X. Website and license: [http://fossil.codebykevin.com].
 * App icon from the Gnome project. Website: [http://www.gnome.org]. License: [http://creativecommons.org/licenses/by-sa/3.0/].
 * Icon fonts from Iconic project. Website and license: [https://github.com/somerandomdude/Iconic].
 * Help viewer by Keith Vetter: [http://wiki.tcl.tk/19649].
 * aem package for AppleScript support. Website and license: [http://fossil.codebykevin.com].

-------------------
title: PortAuthority Version History
alias: History





'''7.9 (April 20, 2018):'''
 * Migrate to new source code server. 
 * Minor bug fixes.

'''7.8 (December 1, 2017):'''
 * UI enhancements.

title: License
alias: License
 
'''The MIT License (MIT)'''

PortAuthority source code: [https://www.codebykevin.com/fossil.cgi/portauthority/]

Copyright (c) 2018 WordTech Communications LLC

Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions:

The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.

THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

  package ifneeded portauthority 7.9 [list source [file join $dir portauthority.tcl]]

# PortAuthority: GUI for MacPorts.  

#Copyright (C) 2018 WordTech Communications LLC

#MIT license.


#initialize package requirements

package require tablelist_tile
package require regproc
package require machelp
package require BWidget
package require softwareupdate
package require aquahig
package require appname
package require urltext
package require tclservices
package require cocoaprint
package require Tclapplescript
package require tclgrowl
package require aem

package require xplat

    global folder_development
    global portauthority_growl
    global showstatus
    global datadir
    global mynode

    set mynode ""

    
    #Create window title
    wm title . "PortAuthority"

    bind . <Command-W> {wm state .  withdrawn}
    bind . <Command-w> {wm state .  withdrawn}
    wm protocol . WM_DELETE_WINDOW {wm withdraw .} 


    set searchterm "" 

    ttk::style configure Toolbutton -font {Iconic 22} 

    #create menu bar
    menu .mb

    #apple menu
    menu .mb.apple
    .mb.apple add command -label "About PortAuthority" -command tkAboutDialog

    bind all <Command-u> {updateBase}

    bind all <Command-k> {killPorts}
    bind all <Command-K> {killPorts}


    #create ttk style for search entry
    set glass {
	iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAAGXRFWHRTb2Z0d2Fy
	ZQBBZG9iZSBJbWFnZVJlYWR5ccllPAAAAI9JREFUOMulkoENwCAIBBnBEToCIziC
	IziKmzhSR2EEq4lNvqmCtiSfGPEeJBDNw1XlKqkqoHZ3kBE8AFEtF7XKCKcq35Ug
	J7NOEsBsdJdHBqeWHBR5xZ3wioFfMQhfDXa+INqAmuJkiLgTUxgfha5Mz11wFqwt
	Eq/AAjMp/ZywMhkw00LEP/DIZBtGk234AlcgZp9b9UdLAAAAAElFTkSuQmCC
    }

    image create photo glass -data $glass
    
    #entry field for specific man page with image
    ttk::style layout ImgEntry {
	Entry.field -children {
	    ImgEntry.icon -side left
	    Entry.padding -children {
		Entry.textarea
	    }
	}
    }

    ttk::style element create ImgEntry.icon image glass \
	-sticky "" -padding [list 20 0 0 0]


    #create frame for toolbar
    pack [ttk::frame .tool] -side top -fill both -expand no

    #create toolbar
    pack [ttk::frame .tool.toolbar] -side top -fill both -expand no

    pack [ttk::frame .tool.toolbar.frame -padding 5] -side top -fill both -expand no
    pack [ttk::separator .tool.toolbar.sep -orient vertical] -side bottom -fill both -expand no




    ttk::button .tool.toolbar.frame.cog -text \u2699 -style Toolbutton -command installPort -takefocus 0
    pack .tool.toolbar.frame.cog -side left  -expand no
    DynamicHelp::register .tool.toolbar.frame.cog  balloon "Install a MacPorts port"

    ttk::button .tool.toolbar.frame.denied -text  \u26d4 -style Toolbutton -command removePort -takefocus 0
    pack .tool.toolbar.frame.denied -side left  -expand no
    DynamicHelp::register .tool.toolbar.frame.denied balloon "Remove a MacPorts port"

    ttk::button .tool.toolbar.frame.info -text \u2139 -style Toolbutton -command showInformation -takefocus 0
    pack .tool.toolbar.frame.info -side left  -expand no
    DynamicHelp::register .tool.toolbar.frame.info balloon "Show information about a port"

    ttk::button .tool.toolbar.frame.x -text \u2713 -style Toolbutton -command killPorts -takefocus 0
    pack .tool.toolbar.frame.x -side left  -expand no
    DynamicHelp::register .tool.toolbar.frame.x balloon "Terminate a running process"

    ttk::entry .tool.toolbar.frame.entry -textvariable searchterm -width 30 -style ImgEntry

    pack .tool.toolbar.frame.entry -side right -fill both -expand no

    #additional bindings
    bind .tool.toolbar.frame.entry <Return> {portSearch}

    tclservices::registerservicewidget .tool.toolbar.frame.entry 
    bind .tool.toolbar.frame.entry <ButtonRelease-1>  checkEntrySelection

    #list of port categories
    set portlist [list  aqua archivers audio benchmarks blinkenlights cad chat chinese comms compression cross crypto databases devel editors electronics emulators erlang fonts framework games genealogy gnome gnustep graphics irc java kde lang mail math mono multimedia net news palm parallel pdf perl php pim print python ruby russian scheme science security shells spelling squeak sysutils tex textproc unicode vnc win32 www x11 x11-wm zope]

    array set treelabel {
	aqua  \ue059
	archivers \ue06b
	audio \ue072
	benchmarks \ue078
	blinkenlights \ue079
	cad \ue059
	chat \ue05e
	chinese \ue000
	comms \ue079
	compression \ue06b 
	cross \ue078
	crypto \ue075
	databases  \ue078
	devel  \ue078
	editors \ue000
	electronics \ue06e
	emulators \ue06e
	erlang  \ue078
	fonts \ue000
	framework  \ue078
	games \ue06e
	genealogy \ue000
	gnome \ue059
	gnustep \ue059 
	graphics \ue027
	irc \ue05e
	java  \ue078
	kde \ue059
	lang  \ue078
	mail \u2709
	math \ue023
	mono \ue059
	multimedia \ue072
	net \ue079
	news \u2709
	palm \ue06e 
	parallel \ue059
	pdf \ue000
	perl  \ue078
	php  \ue078
	pim \ue06c
	print  \ue078
	python  \ue078
	ruby  \ue078
	russian \ue000
	scheme  \ue078
	science \ue023
	security  \ue075
	shells \ue059
	spelling \ue000
	squeak  \ue078
	sysutils \ue059
	tex \ue000
	textproc \ue000
	unicode \ue000
	vnc \ue059
	win32  \ue078
	www \ue079
	x11 \ue059
	x11-wm \ue059
	zope  \ue078
    }


    
    # ttk::separator .bottomsep1 -orient vertical 
    # pack .bottomsep1 -side bottom -fill both -expand no -side bottom

    pack .t.left -fill both -expand yes


    #tree display for categories
    Tree .t.left.tree -selectfill 1 -yscrollcommand [list .t.left.scroll set]

    #get default values for tree options
    foreach {key value} [array get aquahig::treeopts] {
	.t.left.tree configure -$key $value
    } 
    
    pack .t.left.tree -fill both -side left -expand yes

    scrollbar .t.left.scroll -command [list .t.left.tree yview]
    pack .t.left.scroll -side right -fill y -expand no

    .t.left.tree insert end root All -font {Iconic} -text "\ue059 All"
    .t.left.tree insert end root Installed -font {Iconic} -text "\ue059 Installed"
    .t.left.tree insert end root Search -font {Iconic} -text "\ue074 Search"
    .t.left.tree insert end root Ports -font {Iconic} -text "\ue059 Ports"

    
    foreach item $portlist {
	.t.left.tree insert end Ports $item -font {Iconic} -text "$treelabel($item) $item"  
    }

    bind .t.left.tree <<TreeSelect>> {selectCat}

    bind .t.left.tree.c <MouseWheel> {%W yview scroll [expr {- (%D)}] units}

    #more data display

    scrollbar .t.right.upper.frame.row.vsb -orient vertical -command [list .t.right.upper.frame.listbox yview]
    pack .t.right.upper.frame.row.vsb -side bottom -fill y -expand 1

    #main data display
    tablelist::tablelist .t.right.upper.frame.listbox -columns {10 "Installed" 40 "Port"  20 "Version"   30 "Category" } -width 110 -yscrollcommand [list .t.right.upper.frame.row.vsb set] 

    #get default table options
    foreach {key value} [array get aquahig::tableopts] {
	.t.right.upper.frame.listbox configure -$key $value
    }


    .t.right.upper.frame.listbox configure -labelcommand tablelist::sortByColumn
    
    pack .t.right.upper.frame.listbox -side left -fill both -expand yes

    .t.right add .t.right.lower

    .t add .t.left
    .t add .t.right

    wm geometry . 950x700

    wm iconphoto . -default icon-main

}


#put up busy cursor, display progress bar
proc showProgress {} {
    global log 

#hide progress bar, notify user action is done, reset cursor
proc endProgress {} {
    global log 
    

    . configure -cursor arrow
    wm iconphoto . -default icon-main

    .bottom.progress stop
    pack forget .bottom.progress
    bgGetAllPorts
}

#show all available ports

    global portpath 
    global verboselevel 
    global installicon
    

    clearData
    showProgress
    wm iconphoto . -default icon-running

    #error handling
    if {[.t.right.upper.frame.listbox curselection] == ""} {	
	tk_messageBox -title "Wrong Selection" -icon warning -message "Please make a selection from the main table." -detail "This will start the installation process." -parent . 
	set status ""
	endProgress
	selectCat

    global portpath 
    global verboselevel 
    global installicon
    

    clearData
    showProgress
    wm iconphoto . -default icon-running

    set new $variantport
    set status "Installing $new"
    
    set script "$portpath $verboselevel install $new +$variantname > [file join $::env(TMPDIR) portauthority.txt] 2>&1 & echo $! > [file join $::env(TMPDIR) pid.txt] &"

    set scripterr {   

    global deleteicon
    global portauthority_growl
    global playsound
    global showstatus

    clearData
    showProgress
    wm iconphoto . -default icon-running
    
    #error handling
    if {[.t.right.upper.frame.listbox curselection] == ""} {
	tk_messageBox -title "Wrong Selection" -icon warning -message "Please make a selection from the main table." -detail "This will start the removal process." -parent .
	set status ""
	endProgress
	selectCat

	tk_messageBox -title "Wrong Selection" -icon warning -message "Please make a selection from the main table." -detail "This will start the upgrade process." -parent . 
	set status "Done"
	return
    } else {
	set item [lindex [.t.right.upper.frame.listbox get [.t.right.upper.frame.listbox curselection]] 1]
	set new [lindex [split $item] 0]
	showProgress
	wm iconphoto . -default icon-running
	set status "Upgrading $new"
	
	set script "$portpath $verboselevel upgrade $new > [file join $::env(TMPDIR) portauthority.txt] 2>&1 & echo $! > [file join $::env(TMPDIR) pid.txt] &"

	set scripterr {   
	    AppleScript execute "

    global status 
    global portpath 
    global verboselevel 
    global installicon
    
    clearData
    showProgress
    wm iconphoto . -default icon-running
    set status "Upgrading all installed ports"

    
    set script "$portpath $verboselevel upgrade installed  > [file join $::env(TMPDIR) portauthority.txt] 2>&1 & echo $! > [file join $::env(TMPDIR) pid.txt] &"

    set scripterr {   
	AppleScript execute "

    global verboselevel 
    global installicon
    
    
    clearData
    set status "Getting updated ports"
    showProgress
    wm iconphoto . -default icon-running

    
    set script "$portpath $verboselevel sync > [file join $::env(TMPDIR) portauthority.txt] 2>&1 & echo $! > [file join $::env(TMPDIR) pid.txt]  &"

    set scripterr {   
	AppleScript execute "

    global portpath 
    global verboselevel 
    global installicon
    

    clearData
    showProgress
    wm iconphoto . -default icon-running
    after 500
    set status "Updating MacPorts"
    set script "$portpath $verboselevel selfupdate > [file join $::env(TMPDIR) portauthority.txt] 2>&1 & echo $! > [file join $::env(TMPDIR) pid.txt] &"

    set scripterr {   
	AppleScript execute "

    global playsound
    global showstatus
    
    #create gui
    toplevel .preferences
    wm title .preferences "PortAuthority Preferences"
    
    set n [NoteBook .preferences.n -background gray95]
    pack $n -side top -fill both -expand yes
    
    $n insert 0 pathpref -text Paths
    $n insert 1 copytext -text Copy 
    $n insert 2 fontpref -text Font  

    $n raise pathpref

    ttk::frame $fontpane.font
    pack $fontpane.font -fill both -expand yes
    
    
    ttk::frame $fontpane.font.title 
    pack $fontpane.font.title -side left -fill both -expand yes
    
    listbox $fontpane.font.title.list  -yscrollcommand [list $fontpane.font.title.scrollbar set] -font {-size 12} -relief flat -bd 0 -selectbackground  #84a6cb -selectforeground white -background #e3e9f1 -highlightbackground #e3e9f1
    
    pack $fontpane.font.title.list -side left -fill both -expand yes
    
    
    #get all fonts on system
    set families [font families]
    set sorted [lsort $families]

#"about application" command
proc tkAboutDialog {} {
    aboutWindow
}


proc aboutWindow {} {
 tk_messageBox -parent . -icon info -title "About PortAuthority" -message "PortAuthority: GUI for MacPorts" -detail "Version 7.9\n(c)2018 WordTech Communications LLC"

}


#initialization routines on startup
proc startUp {} {

    if {![file exists $datadir/portauthority.rc]} {
	checkPref
    }    
    
    if { [file exists  $datadir/portauthority.rc]} {
	catch [list source $datadir/portauthority.rc ] 
	appname::setAppName PortAuthority 7.9
	softwareupdate::setVersion $appname::name $appname::version
	machelp::setAppName $appname::name $appname::version
	checkMacPorts
	drawGUI
	setPref
	getAllPorts
	catch {toggleCopyText}
	after 1000
	.t.left.tree selection set All
	.t.left.tree opentree Ports
    }

      	after 50 
	regproc::readLic $appname::name $appname::version
}

#load images into memory
proc makeImage {} {
   
    set imagedir [file join [file dirname [info script]] images]

    source $imagedir/images.tcl
    
    set growlicon  [file join [softwareupdate::findCurrentInstallation] "Contents/Resources/PortAuthority.icns"]

    growl::growlicon $growlicon

    softwareupdate::setIcon icon-update


	
	#icon-main, icon-running

    
}


#save output to text file
proc saveLog {} {
    global log

package provide portauthority 7.9

source [file join [file dirname [info script]] portauthority-main.tcl]

# Tcl package index file, version 1.1
# This file is generated by the "pkg_mkIndex" command
# and sourced either when an application starts up or
# by a "package unknown" script.  It invokes the
# "package ifneeded" command to set up package-related
# information so that packages will be loaded automatically
# in response to "package require" commands.  When this
# script is sourced, the variable $dir must contain the
# full path name of this file's directory.

package ifneeded regproc 1.4 [list source [file join $dir regproc.tcl]]

#regproc.tcl  routines to register serial numbers

#Copyright 2015 WordTech Communications LLC

#MIT license

package provide regproc 1.4
package require http
package require xplat


image create photo _unlock -data  {
    R0lGODlhGAAgAIABAAAAAP///yH+GkNyZWF0ZWQgd2l0aCBHSU1QIG9uIGEgTWFj
    ACH5BAEKAAEALAAAAAAYACAAAAJRjI+gq+jO4npQWmqsBvQenzBYVE1YQH7imWbm
    ib5xA89cPcp4uPX+DwwKh7SdbWXUGF2S5VHn6oBURWrL+lBmb6UrTpucfsE14u85



    tKZ5wkMBADs=
}

image create photo _check -data {
    R0lGODlhIAAaAIABAAQHB////yH+GkNyZWF0ZWQgd2l0aCBHSU1QIG9uIGEgTWFj
    ACH5BAEKAAEALAAAAAAgABoAAAJMjI+pCeuvgIR0yVtzuFxDDnoWGIoHWZobikUV
    2zLTA89yfLNjetY7iag1Ir4VzCFMfpI6ChOYeeJeTxVTZRBie6htEOrl2sJcsmVb


    AAA7
}


namespace eval regproc {

    if {![info exists library]} {
	variable library [file dirname [info script]]