source: trunk/base/src/port/portall.tcl @ 1532

Last change on this file since 1532 was 1532, checked in by jkh, 18 years ago

Properly use variations as an array.

  • Property svn:eol-style set to native
  • Property svn:executable set to *
File size: 4.8 KB
Line 
1#!/usr/bin/env tclsh8.3
2# Traverse through all ports running the supplied target.  If target is
3# "index" then just print some useful information about each port.
4
5package require darwinports
6dportinit
7package require Pextlib
8
9global target
10
11# UI Instantiations
12# ui_options(ports_debug) - If set, output debugging messages.
13# ui_options(ports_verbose) - If set, output info messages (ui_info)
14# ui_options(ports_quiet) - If set, don't output "standard messages"
15
16# ui_options accessor
17proc ui_isset {val} {
18    global ui_options
19    if {[info exists ui_options($val)]} {
20        if {$ui_options($val) == "yes"} {
21            return 1
22        }
23    }
24    return 0
25}
26
27# Output string "str"
28# If you don't want newlines to be output, you must pass "-nonewline"
29# as the second argument.
30
31proc ui_puts {priority str nonl} {
32    set channel stdout
33    switch $priority {
34        debug {
35            if [ui_isset ports_debug] {
36                set channel stderr
37                set str "DEBUG: $str"
38            } else {
39                return
40            }
41        }
42        info {
43            if ![ui_isset ports_verbose] {
44                return
45            }
46        }
47        msg {
48            if [ui_isset ports_quiet] {
49                return
50            }
51        }
52        error {
53            set str "Error: $str"
54            set channel stderr
55        }
56        warn {
57            set str "Warning: $str"
58        }
59    }
60    if {$nonl == "-nonewline"} {
61        puts -nonewline $channel "$str"
62        flush $channel 
63    } else {
64        puts "$str"
65    }
66}
67
68# Get a line of input from the user and store in str, returning the
69# number of bytes input.
70proc ui_gets {str} {
71    upvar $str in_string
72    gets stdin in_string
73}
74
75# Ask a boolean "yes/no" question of the user, using "promptstr" as
76# the prompt.  It should contain a trailing space and/or anything else
77# you want to precede the user's input string.  Returns 1 for "yes" or
78# 0 for "no".  This implementation also assumes an english yes/no or
79# y/n response, but that is not mandated by the spec.  If "defvalue"
80# is passed, it will be used as the default value if none is supplied
81# by the user.
82proc ui_yesno {promptstr {defvalue ""}} {
83    set satisfaction no
84    while {$satisfaction == "no"} {
85        ui_puts $promptstr -nonewline
86        if {[ui_gets mystr] == 0} {
87            if {[string length $defvalue] > 0} {
88                set mystr $defvalue
89            } else {
90                continue
91            }
92        }
93        if {[string compare -nocase -length 1 $mystr y] == 0} {
94            set rval 1
95            set satisfaction yes
96        } elseif {[string compare -nocase -length 1 $mystr n] == 0} {
97            set rval 0
98            set satisfaction yes
99        }
100    }
101    return $rval
102}
103
104# Put up a simple confirmation dialog, requesting nothing more than
105# the user's acknowledgement of the prompt string passed in
106# "promptstr".  There is no return value.
107proc ui_confirm {promptstr} {
108    ui_puts "$promptstr" -nonewline
109    ui_gets garbagestr
110}
111
112# Display the contents of a file, ideally in a manner which allows the
113# user to scroll through and read it comfortably (e.g. a license
114# text).  For the "simple UI" version of this, we simply punt this to
115# less(1) since rewriting a complete pager for the simple case would
116# be a waste of time.  It's expected in a more complex UI case, a
117# scrolling display widget of some type will be used.
118proc ui_display {filename} {
119    if [file exists $filename] {
120        system "/usr/bin/less $filename"
121    }
122}
123
124proc port_traverse {func {dir .}} {
125    set pwd [pwd]
126    if [catch {cd $dir} err] {
127        ui_error $err
128        return
129    }
130    foreach name [readdir .] {
131        if {[string match $name .] || [string match $name ..]} {
132            continue
133        }
134        if [file isdirectory $name] {
135            port_traverse $func $name
136        } else {
137            if [string match $name Portfile] {
138                catch {eval $func {[file join $pwd $dir]}}
139            }
140        }
141    }
142    cd $pwd
143}
144
145proc pindex {portdir} {
146    global target options variations
147
148    if [catch {set interp [dportopen file://$portdir [array get options] [array get variations]]} err] {
149        puts "Error: Couldn't create interpreter for $portdir: $err"
150        return -1
151    }
152    array set portinfo [dportinfo $interp]
153    dportexec $interp $target
154    dportclose $interp
155}
156
157# Main
158
159# zero-out the options array
160array set options [list]
161array set variations [list]
162
163if { $argc < 1 } {
164    set target build
165} else {
166    for {set i 0} {$i < $argc} {incr i} {
167        set arg [lindex $argv $i]
168
169        if {[regexp {([A-Za-z0-9_\.]+)=(.*)} $arg match key val] == 1} {
170            # option=value
171            set options($key) \"$val\"
172        } elseif {[regexp {^([-+])([-A-Za-z0-9_+\.]+)$} $arg match sign opt] == 1} {
173            # if +xyz -xyz or after the separator
174            set variations($opt) $sign
175        } else {
176            set target $arg
177        }
178    }
179}
180
181if [file isdirectory dports] {
182    port_traverse pindex dports
183} elseif [file isdirectory ../dports] {
184    port_traverse pindex .
185} else {
186    puts "Please run me from the darwinports directory (dports/..)"
187    return 1
188}
Note: See TracBrowser for help on using the repository browser.