source: branches/gsoc08-privileges/base/src/port/port.tcl @ 38096

Last change on this file since 38096 was 38096, checked in by pmagrath@…, 11 years ago

Merged revisions 38033,38037-38038,38040 via svnmerge from
https://svn.macosforge.org/repository/macports/trunk/base

........

r38033 | raimue@… | 2008-07-04 00:49:00 +0100 (Fri, 04 Jul 2008) | 3 lines


port/port.tcl:
Document depends: and depends_*: from r37909

........

r38037 | raimue@… | 2008-07-04 03:58:10 +0100 (Fri, 04 Jul 2008) | 3 lines


portmgr/dmg/postflight:
Copy the postflight script from the release_1_6 branch so the changes will not be lost or forgotten

........

r38038 | raimue@… | 2008-07-04 05:30:56 +0100 (Fri, 04 Jul 2008) | 4 lines


port1.0/portextract.tcl:
If the $distfile exists in $filespath, use it from there as it was not fetched
to the distpath in this case.

........

r38040 | raimue@… | 2008-07-04 05:59:54 +0100 (Fri, 04 Jul 2008) | 3 lines


portmgr/dmg/postflight:
Remove old non-compressed man pages on install

........

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 102.1 KB
Line 
1#!/bin/sh
2# -*- coding: utf-8; mode: tcl; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- vim:fenc=utf-8:filetype=tcl:et:sw=4:ts=4:sts=4
3# Run the Tcl interpreter \
4exec @TCLSH@ "$0" "$@"
5# port.tcl
6# $Id: port.tcl 38096 2008-07-06 15:21:25Z pmagrath@macports.org $
7#
8# Copyright (c) 2002-2007 The MacPorts Project.
9# Copyright (c) 2004 Robert Shaw <rshaw@opendarwin.org>
10# Copyright (c) 2002 Apple Computer, Inc.
11# All rights reserved.
12#
13# Redistribution and use in source and binary forms, with or without
14# modification, are permitted provided that the following conditions
15# are met:
16# 1. Redistributions of source code must retain the above copyright
17#    notice, this list of conditions and the following disclaimer.
18# 2. Redistributions in binary form must reproduce the above copyright
19#    notice, this list of conditions and the following disclaimer in the
20#    documentation and/or other materials provided with the distribution.
21# 3. Neither the name of Apple Computer, Inc. nor the names of its contributors
22#    may be used to endorse or promote products derived from this software
23#    without specific prior written permission.
24#
25# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
26# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
27# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
28# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
29# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
30# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
31# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
32# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
33# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
34# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
35# POSSIBILITY OF SUCH DAMAGE.
36
37#
38# TODO:
39#
40
41catch {source \
42    [file join "@TCL_PACKAGE_DIR@" macports1.0 macports_fastload.tcl]}
43package require macports
44
45
46# Standard procedures
47proc print_usage {args} {
48    global cmdname
49    set syntax {
50        [-bcdfiknopqRstuvx] [-D portdir] [-F cmdfile] action [privopts] [actionflags]
51        [[portname|pseudo-portname|port-url] [@version] [+-variant]... [option=value]...]...
52    }
53
54    puts stderr "Usage: $cmdname$syntax"
55    puts stderr "\"$cmdname help\" or \"man 1 port\" for more information."
56}
57
58proc print_help {args} {
59    global cmdname
60    global action_array
61   
62    set syntax {
63        [-bcdfiknopqRstuvx] [-D portdir] [-F cmdfile] action [privopts] [actionflags]
64        [[portname|pseudo-portname|port-url] [@version] [+-variant]... [option=value]...]...
65    }
66
67    # Generate and format the command list from the action_array
68    set cmds ""
69    set lineLen 0
70    foreach cmd [lsort [array names action_array]] {
71        if {$lineLen > 65} {
72            set cmds "$cmds,\n"
73            set lineLen 0
74        }
75        if {$lineLen == 0} {
76            set new "$cmd"
77        } else {
78            set new ", $cmd"
79        }
80        incr lineLen [string length $new]
81        set cmds "$cmds$new"
82    }
83   
84    set cmdText "
85Supported commands
86------------------
87$cmds
88"
89
90    set text {
91Pseudo-portnames
92----------------
93Pseudo-portnames are words that may be used in place of a portname, and
94which expand to some set of ports. The common pseudo-portnames are:
95all, current, active, inactive, installed, uninstalled, and outdated.
96These pseudo-portnames expand to the set of ports named.
97
98Additional pseudo-portnames start with...
99variants:, variant:, description:, depends:, depends_lib:, depends_run:,
100depends_build:, portdir:, homepage:, epoch:, platforms:, platform:, name:,
101long_description:, maintainers:, maintainer:, categories:, category:, version:,
102and revision:.
103These each select a set of ports based on a regex search of metadata
104about the ports. In all such cases, a standard regex pattern following
105the colon will be used to select the set of ports to which the
106pseudo-portname expands.
107
108Portnames that contain standard glob characters will be expanded to the
109set of ports matching the glob pattern.
110   
111Port expressions
112----------------
113Portnames, port glob patterns, and pseudo-portnames may be logically
114combined using expressions consisting of and, or, not, !, (, and ).
115   
116For more information
117--------------------
118See man pages: port(1), macports.conf(5), portfile(7), portgroup(7),
119porthier(7), portstyle(7). Also, see http://www.macports.org.
120    }
121
122
123    puts "$cmdname$syntax $cmdText $text"
124}
125
126
127# Produce error message and exit
128proc fatal s {
129    global argv0
130    ui_error "$argv0: $s"
131    exit 1
132}
133
134
135# Produce an error message, and exit, unless
136# we're handling errors in a soft fashion, in which
137# case we continue
138proc fatal_softcontinue s {
139    if {[macports::global_option_isset ports_force]} {
140        ui_error $s
141        return -code continue
142    } else {
143        fatal $s
144    }
145}
146
147
148# Produce an error message, and break, unless
149# we're handling errors in a soft fashion, in which
150# case we continue
151proc break_softcontinue { msg status name_status } {
152    upvar $name_status status_var
153    ui_error $msg
154    if {[macports::ui_isset ports_processall]} {
155        set status_var 0
156        return -code continue
157    } else {
158        set status_var $status
159        return -code break
160    }
161}
162
163
164# Form a composite version as is sometimes used for registry functions
165proc composite_version {version variations {emptyVersionOkay 0}} {
166    # Form a composite version out of the version and variations
167   
168    # Select the variations into positive and negative
169    set pos {}
170    set neg {}
171    foreach { key val } $variations {
172        if {$val == "+"} {
173            lappend pos $key
174        } elseif {$val == "-"} {
175            lappend neg $key
176        }
177    }
178
179    # If there is no version, we have nothing to do
180    set composite_version ""
181    if {$version != "" || $emptyVersionOkay} {
182        set pos_str ""
183        set neg_str ""
184
185        if {[llength $pos]} {
186            set pos_str "+[join [lsort -ascii $pos] "+"]"
187        }
188        if {[llength $neg]} {
189            set neg_str "-[join [lsort -ascii $neg] "-"]"
190        }
191
192        set composite_version "$version$pos_str$neg_str"
193    }
194
195    return $composite_version
196}
197
198
199proc split_variants {variants} {
200    set result {}
201    set l [regexp -all -inline -- {([-+])([[:alpha:]_]+[\w\.]*)} $variants]
202    foreach { match sign variant } $l {
203        lappend result $variant $sign
204    }
205    return $result
206}
207
208
209proc registry_installed {portname {portversion ""}} {
210    set ilist [registry::installed $portname $portversion]
211    if { [llength $ilist] > 1 } {
212        # set portname again since the one we were passed may not have had the correct case
213        set portname [lindex [lindex $ilist 0] 0]
214        puts "The following versions of $portname are currently installed:"
215        foreach i [portlist_sortint $ilist] { 
216            set iname [lindex $i 0]
217            set iversion [lindex $i 1]
218            set irevision [lindex $i 2]
219            set ivariants [lindex $i 3]
220            set iactive [lindex $i 4]
221            if { $iactive == 0 } {
222                puts "  $iname ${iversion}_${irevision}${ivariants}"
223            } elseif { $iactive == 1 } {
224                puts "  $iname ${iversion}_${irevision}${ivariants} (active)"
225            }
226        }
227        return -code error "Registry error: Please specify the full version as recorded in the port registry."
228    } else {
229        return [lindex $ilist 0]
230    }
231}
232
233
234proc add_to_portlist {listname portentry} {
235    upvar $listname portlist
236    global global_options global_variations
237
238    # The portlist currently has the following elements in it:
239    #   url             if any
240    #   name
241    #   version         (version_revision)
242    #   variants array  (variant=>+-)
243    #   options array   (key=>value)
244    #   fullname        (name/version_revision+-variants)
245
246    array set port $portentry
247    if {![info exists port(url)]}       { set port(url) "" }
248    if {![info exists port(name)]}      { set port(name) "" }
249    if {![info exists port(version)]}   { set port(version) "" }
250    if {![info exists port(variants)]}  { set port(variants) "" }
251    if {![info exists port(options)]}   { set port(options) [array get global_options] }
252
253    # If neither portname nor url is specified, then default to the current port
254    if { $port(url) == "" && $port(name) == "" } {
255        set url file://.
256        set portname [url_to_portname $url]
257        set port(url) $url
258        set port(name) $portname
259        if {$portname == ""} {
260            ui_error "A default port name could not be supplied."
261        }
262    }
263
264
265    # Form the fully descriminated portname: portname/version_revison+-variants
266    set port(fullname) "$port(name)/[composite_version $port(version) $port(variants)]"
267   
268    # Add it to our portlist
269    lappend portlist [array get port]
270}
271
272
273proc add_ports_to_portlist {listname ports {overridelist ""}} {
274    upvar $listname portlist
275
276    array set overrides $overridelist
277
278    # Add each entry to the named portlist, overriding any values
279    # specified as overrides
280    foreach portentry $ports {
281        array set port $portentry
282        if ([info exists overrides(version)])   { set port(version) $overrides(version) }
283        if ([info exists overrides(variants)])  { set port(variants) $overrides(variants)   }
284        if ([info exists overrides(options)])   { set port(options) $overrides(options) }
285        add_to_portlist portlist [array get port]
286    }
287}
288
289
290proc url_to_portname { url {quiet 0} } {
291    # Save directory and restore the directory, since mportopen changes it
292    set savedir [pwd]
293    set portname ""
294    if {[catch {set ctx [mportopen $url]} result]} {
295        if {!$quiet} {
296            ui_msg "Can't map the URL '$url' to a port description file (\"${result}\")."
297            ui_msg "Please verify that the directory and portfile syntax are correct."
298        }
299    } else {
300        array set portinfo [mportinfo $ctx]
301        set portname $portinfo(name)
302        mportclose $ctx
303    }
304    cd $savedir
305    return $portname
306}
307
308
309# Supply a default porturl/portname if the portlist is empty
310proc require_portlist { nameportlist } {
311    global private_options
312    upvar $nameportlist portlist
313
314    if {[llength $portlist] == 0 && (![info exists private_options(ports_no_args)] || $private_options(ports_no_args) == "no")} {
315        ui_error "No ports found"
316        return 1
317    }
318
319    if {[llength $portlist] == 0} {
320        set portlist [get_current_port]
321
322        if {[llength $portlist] == 0} {
323            # there was no port in current directory
324            return 1
325        }
326    }
327
328    return 0
329}
330
331
332# Execute the enclosed block once for every element in the portlist
333# When the block is entered, the variables portname, portversion, options, and variations
334# will have been set
335proc foreachport {portlist block} {
336    # Restore cwd after each port, since mportopen changes it, and relative
337    # urls will break on subsequent passes
338    set savedir [pwd]
339    foreach portspec $portlist {
340        uplevel 1 "array set portspec { $portspec }"
341        uplevel 1 {
342            set porturl $portspec(url)
343            set portname $portspec(name)
344            set portversion $portspec(version)
345            array unset variations
346            array set variations $portspec(variants)
347            array unset options
348            array set options $portspec(options)
349        }
350        uplevel 1 $block
351        cd $savedir
352    }
353}
354
355
356proc portlist_compare { a b } {
357    array set a_ $a
358    array set b_ $b
359    set namecmp [string compare -nocase $a_(name) $b_(name)]
360    if {$namecmp != 0} {
361        return $namecmp
362    }
363    set avr_ [split $a_(version) "_"]
364    set bvr_ [split $b_(version) "_"]
365    set vercmp [rpm-vercomp [lindex $avr_ 0] [lindex $bvr_ 0]]
366    if {$vercmp != 0} {
367        return $vercmp
368    }
369    set ar_ [lindex $avr_ 1]
370    set br_ [lindex $bvr_ 1]
371    if {$ar_ < $br_} {
372        return -1
373    } elseif {$ar_ > $br_} {
374        return 1
375    } else {
376        return 0
377    }
378}
379
380# Sort two ports in NVR (name@version_revision) order
381proc portlist_sort { list } {
382    return [lsort -command portlist_compare $list]
383}
384
385proc portlist_compareint { a b } {
386    array set a_ [list "name" [lindex $a 0] "version" [lindex $a 1] "revision" [lindex $a 2]]
387    array set b_ [list "name" [lindex $b 0] "version" [lindex $b 1] "revision" [lindex $b 2]]
388    return [portlist_compare [array get a_] [array get b_]]
389}
390
391# Same as portlist_sort, but with numeric indexes
392proc portlist_sortint { list } {
393    return [lsort -command portlist_compareint $list]
394}
395
396proc regex_pat_sanitize { s } {
397    set sanitized [regsub -all {[\\(){}+$.^]} $s {\\&}]
398    return $sanitized
399}
400
401##
402# Makes sure we get the current terminal size
403proc set_term_size {} {
404    global env
405
406    if {![info exists env(COLUMNS)] || ![info exists env(LINES)]} {
407        if {![catch {exec stty size} err]} {
408            regexp {(\d+) (\d+)} $err -> rows cols
409            set env(COLUMNS) $cols
410            set env(LINES) $rows
411        }
412    }
413}
414
415##
416# Wraps a multi-line string at specified textwidth
417#
418# @see wrapline
419#
420# @param string input string
421# @param maxlen text width (0 defaults to current terminal width)
422# @param indent prepend to every line
423# @return wrapped string
424proc wrap {string maxlen {indent ""} {indentfirstline 1}} {
425    global env
426
427    if {$maxlen == 0} {
428        if {![info exists env(COLUMNS)]} {
429            # no width for wrapping
430            return $string
431        }
432        set maxlen $env(COLUMNS)
433    }
434
435    set splitstring {}
436    foreach line [split $string "\n"] {
437        lappend splitstring [wrapline $line $maxlen $indent $indentfirstline]
438    }
439    return [join $splitstring "\n"]
440}
441
442##
443# Wraps a line at specified textwidth
444#
445# @see wrap
446#
447# @param line input line
448# @param maxlen text width (0 defaults to current terminal width)
449# @param indent prepend to every line
450# @return wrapped string
451proc wrapline {line maxlen {indent ""} {indentfirstline 1}} {
452    global env
453
454    if {$maxlen == 0} {
455        if {![info exists env(COLUMNS)]} {
456            # no width for wrapping
457            return $string
458        }
459        set maxlen $env(COLUMNS)
460    }
461
462    set string [split $line " "]
463    if {$indentfirstline == 0} {
464        set newline ""
465        set maxlen [expr $maxlen - [string length $indent]]
466    } else {
467        set newline $indent
468    }
469    append newline [lindex $string 0]
470    set joiner " "
471    set first 1
472    foreach word [lrange $string 1 end] {
473        if {[string length $newline]+[string length $word] >= $maxlen} {
474            lappend lines $newline
475            set newline $indent
476            set joiner ""
477        }
478        append newline $joiner $word
479        set joiner " "
480        set first 0
481        if {$first == 1 && $indentfirstline == 0} {
482            set maxlen [expr $maxlen + [string length $indent]]
483        }
484    }
485    lappend lines $newline
486    return [join $lines "\n"]
487}
488
489proc unobscure_maintainers { list } {
490    set result {}
491    foreach m $list {
492        if {[string first "@" $m] < 0} {
493            if {[string first ":" $m] >= 0} {
494                set m [regsub -- "(.*):(.*)" $m "\\2@\\1"] 
495            } else {
496                set m "$m@macports.org"
497            }
498        }
499        lappend result $m
500    }
501    return $result
502}
503
504
505##########################################
506# Port selection
507##########################################
508proc get_matching_ports {pattern {casesensitive no} {matchstyle glob} {field name}} {
509    if {[catch {set res [mportsearch $pattern $casesensitive $matchstyle $field]} result]} {
510        global errorInfo
511        ui_debug "$errorInfo"
512        fatal "search for portname $pattern failed: $result"
513    }
514
515    set results {}
516    foreach {name info} $res {
517        array unset portinfo
518        array set portinfo $info
519
520        #set variants {}
521        #if {[info exists portinfo(variants)]} {
522        #   foreach variant $portinfo(variants) {
523        #       lappend variants $variant "+"
524        #   }
525        #}
526        # For now, don't include version or variants with all ports list
527        #"$portinfo(version)_$portinfo(revision)"
528        #$variants
529        add_to_portlist results [list url $portinfo(porturl) name $name]
530    }
531
532    # Return the list of all ports, sorted
533    return [portlist_sort $results]
534}
535
536
537proc get_all_ports {} {
538    global all_ports_cache
539
540    if {![info exists all_ports_cache]} {
541        set all_ports_cache [get_matching_ports "*"]
542    }
543    return $all_ports_cache
544}
545
546
547proc get_current_ports {} {
548    # This is just a synonym for get_current_port that
549    # works with the regex in element
550    return [get_current_port]
551}
552
553
554proc get_current_port {} {
555    set url file://.
556    set portname [url_to_portname $url]
557    if {$portname == ""} {
558        ui_msg "To use the current port, you must be in a port's directory."
559        ui_msg "(you might also see this message if a pseudo-port such as"
560        ui_msg "outdated or installed expands to no ports)."
561        return [list]
562    }
563
564    set results {}
565    add_to_portlist results [list url $url name $portname]
566    return $results
567}
568
569
570proc get_installed_ports { {ignore_active yes} {active yes} } {
571    set ilist {}
572    if { [catch {set ilist [registry::installed]} result] } {
573        if {$result != "Registry error: No ports registered as installed."} {
574            global errorInfo
575            ui_debug "$errorInfo"
576            fatal "port installed failed: $result"
577        }
578    }
579
580    set results {}
581    foreach i $ilist {
582        set iname [lindex $i 0]
583        set iversion [lindex $i 1]
584        set irevision [lindex $i 2]
585        set ivariants [split_variants [lindex $i 3]]
586        set iactive [lindex $i 4]
587
588        if { ${ignore_active} == "yes" || (${active} == "yes") == (${iactive} != 0) } {
589            add_to_portlist results [list name $iname version "${iversion}_${irevision}" variants $ivariants]
590        }
591    }
592
593    # Return the list of ports, sorted
594    return [portlist_sort $results]
595}
596
597
598proc get_uninstalled_ports {} {
599    # Return all - installed
600    set all [get_all_ports]
601    set installed [get_installed_ports]
602    return [opComplement $all $installed]
603}
604
605
606proc get_active_ports {} {
607    return [get_installed_ports no yes]
608}
609
610
611proc get_inactive_ports {} {
612    return [get_installed_ports no no]
613}
614
615
616proc get_outdated_ports {} {
617    global macports::registry.installtype
618    set is_image_mode [expr 0 == [string compare "image" ${macports::registry.installtype}]]
619
620    # Get the list of installed ports
621    set ilist {}
622    if { [catch {set ilist [registry::installed]} result] } {
623        if {$result != "Registry error: No ports registered as installed."} {
624            global errorInfo
625            ui_debug "$errorInfo"
626            fatal "port installed failed: $result"
627        }
628    }
629
630    # Now process the list, keeping only those ports that are outdated
631    set results {}
632    if { [llength $ilist] > 0 } {
633        foreach i $ilist {
634
635            # Get information about the installed port
636            set portname            [lindex $i 0]
637            set installed_version   [lindex $i 1]
638            set installed_revision  [lindex $i 2]
639            set installed_compound  "${installed_version}_${installed_revision}"
640            set installed_variants  [lindex $i 3]
641
642            set is_active           [lindex $i 4]
643            if { $is_active == 0 && $is_image_mode } continue
644
645            set installed_epoch     [lindex $i 5]
646
647            # Get info about the port from the index
648            if {[catch {set res [mportsearch $portname no exact]} result]} {
649                global errorInfo
650                ui_debug "$errorInfo"
651                fatal "search for portname $portname failed: $result"
652            }
653            if {[llength $res] < 2} {
654                if {[macports::ui_isset ports_debug]} {
655                    puts stderr "$portname ($installed_compound is installed; the port was not found in the port index)"
656                }
657                continue
658            }
659            array unset portinfo
660            array set portinfo [lindex $res 1]
661
662            # Get information about latest available version and revision
663            set latest_version $portinfo(version)
664            set latest_revision     0
665            if {[info exists portinfo(revision)] && $portinfo(revision) > 0} { 
666                set latest_revision $portinfo(revision)
667            }
668            set latest_compound     "${latest_version}_${latest_revision}"
669            set latest_epoch        0
670            if {[info exists portinfo(epoch)]} { 
671                set latest_epoch    $portinfo(epoch)
672            }
673
674            # Compare versions, first checking epoch, then version, then revision
675            set comp_result [expr $installed_epoch - $latest_epoch]
676            if { $comp_result == 0 } {
677                set comp_result [rpm-vercomp $installed_version $latest_version]
678                if { $comp_result == 0 } {
679                    set comp_result [rpm-vercomp $installed_revision $latest_revision]
680                }
681            }
682
683            # Add outdated ports to our results list
684            if { $comp_result < 0 } {
685                add_to_portlist results [list name $portname version $installed_compound variants [split_variants $installed_variants]]
686            }
687        }
688    }
689
690    return $results
691}
692
693
694
695##########################################
696# Port expressions
697##########################################
698proc portExpr { resname } {
699    upvar $resname reslist
700    set result [seqExpr reslist]
701    return $result
702}
703
704
705proc seqExpr { resname } {
706    upvar $resname reslist
707   
708    # Evaluate a sequence of expressions a b c...
709    # These act the same as a or b or c
710
711    set result 1
712    while {$result} {
713        switch -- [lookahead] {
714            ;       -
715            )       -
716            _EOF_   { break }
717        }
718
719        set blist {}
720        set result [orExpr blist]
721        if {$result} {
722            # Calculate the union of result and b
723            set reslist [opUnion $reslist $blist]
724        }
725    }
726
727    return $result
728}
729
730
731proc orExpr { resname } {
732    upvar $resname reslist
733   
734    set a [andExpr reslist]
735    while ($a) {
736        switch -- [lookahead] {
737            or {
738                    advance
739                    set blist {}
740                    if {![andExpr blist]} {
741                        return 0
742                    }
743                       
744                    # Calculate a union b
745                    set reslist [opUnion $reslist $blist]
746                }
747            default {
748                    return $a
749                }
750        }
751    }
752   
753    return $a
754}
755
756
757proc andExpr { resname } {
758    upvar $resname reslist
759   
760    set a [unaryExpr reslist]
761    while {$a} {
762        switch -- [lookahead] {
763            and {
764                    advance
765                   
766                    set blist {}
767                    set b [unaryExpr blist]
768                    if {!$b} {
769                        return 0
770                    }
771                   
772                    # Calculate a intersect b
773                    set reslist [opIntersection $reslist $blist]
774                }
775            default {
776                    return $a
777                }
778        }
779    }
780   
781    return $a
782}
783
784
785proc unaryExpr { resname } {
786    upvar $resname reslist
787    set result 0
788
789    switch -- [lookahead] {
790        !   -
791        not {
792                advance
793                set blist {}
794                set result [unaryExpr blist]
795                if {$result} {
796                    set all [get_all_ports]
797                    set reslist [opComplement $all $blist]
798                }
799            }
800        default {
801                set result [element reslist]
802            }
803    }
804   
805    return $result
806}
807
808
809proc element { resname } {
810    upvar $resname reslist
811    set el 0
812   
813    set url ""
814    set name ""
815    set version ""
816    array unset variants
817    array unset options
818   
819    set token [lookahead]
820    switch -regex -- $token {
821        ^\\)$               -
822        ^\;                 -
823        ^_EOF_$             { # End of expression/cmd/file
824        }
825
826        ^\\($               { # Parenthesized Expression
827            advance
828            set el [portExpr reslist]
829            if {!$el || ![match ")"]} {
830                set el 0
831            }
832        }
833
834        ^all(@.*)?$         -
835        ^installed(@.*)?$   -
836        ^uninstalled(@.*)?$ -
837        ^active(@.*)?$      -
838        ^inactive(@.*)?$    -
839        ^outdated(@.*)?$    -
840        ^current(@.*)?$     {
841            # A simple pseudo-port name
842            advance
843
844            # Break off the version component, if there is one
845            regexp {^(\w+)(@.*)?} $token matchvar name remainder
846
847            add_multiple_ports reslist [get_${name}_ports] $remainder
848
849            set el 1
850        }
851
852        ^variants:          -
853        ^variant:           -
854        ^description:       -
855        ^portdir:           -
856        ^homepage:          -
857        ^epoch:             -
858        ^platforms:         -
859        ^platform:          -
860        ^name:              -
861        ^long_description:  -
862        ^maintainers:       -
863        ^maintainer:        -
864        ^categories:        -
865        ^category:          -
866        ^version:           -
867        ^depends_lib:       -
868        ^depends_build:     -
869        ^depends_run:       -
870        ^revision:          { # Handle special port selectors
871            advance
872
873            # Break up the token, because older Tcl switch doesn't support -matchvar
874            regexp {^(\w+):(.*)} $token matchvar field pat
875
876            # Remap friendly names to actual names
877            switch -- $field {
878                variant -
879                platform -
880                maintainer { set field "${field}s" }
881                category { set field "categories" }
882            }                           
883            add_multiple_ports reslist [get_matching_ports $pat no regexp $field]
884            set el 1
885        }
886
887        ^depends:           { # A port selector shorthand for depends_lib, depends_build or depends_run
888            advance
889
890            # Break up the token, because older Tcl switch doesn't support -matchvar
891            regexp {^(\w+):(.*)} $token matchvar field pat
892
893            add_multiple_ports reslist [get_matching_ports $pat no regexp "depends_lib"]
894            add_multiple_ports reslist [get_matching_ports $pat no regexp "depends_build"]
895            add_multiple_ports reslist [get_matching_ports $pat no regexp "depends_run"]
896
897            set el 1
898        }
899
900        [][?*]              { # Handle portname glob patterns
901            advance; add_multiple_ports reslist [get_matching_ports $token no glob]
902            set el 1
903        }
904
905        ^\\w+:.+            { # Handle a url by trying to open it as a port and mapping the name
906            advance
907            set name [url_to_portname $token]
908            if {$name != ""} {
909                parsePortSpec version variants options
910                add_to_portlist reslist [list url $token \
911                  name $name \
912                  version $version \
913                  variants [array get variants] \
914                  options [array get options]]
915            } else {
916                ui_error "Can't open URL '$token' as a port"
917                set el 0
918            }
919            set el 1
920        }
921
922        default             { # Treat anything else as a portspec (portname, version, variants, options
923            # or some combination thereof).
924            parseFullPortSpec url name version variants options
925            add_to_portlist reslist [list url $url \
926              name $name \
927              version $version \
928              variants [array get variants] \
929              options [array get options]]
930            set el 1
931        }
932    }
933
934    return $el
935}
936
937
938proc add_multiple_ports { resname ports {remainder ""} } {
939    upvar $resname reslist
940   
941    set version ""
942    array unset variants
943    array unset options
944    parsePortSpec version variants options $remainder
945   
946    array unset overrides
947    if {$version != ""} { set overrides(version) $version }
948    if {[array size variants]} { set overrides(variants) [array get variants] }
949    if {[array size options]} { set overrides(options) [array get options] }
950
951    add_ports_to_portlist reslist $ports [array get overrides]
952}
953
954
955proc opUnion { a b } {
956    set result {}
957   
958    array unset onetime
959   
960    # Walk through each array, adding to result only those items that haven't
961    # been added before
962    foreach item $a {
963        array set port $item
964        if {[info exists onetime($port(fullname))]} continue
965        set onetime($port(fullname)) 1
966        lappend result $item
967    }
968
969    foreach item $b {
970        array set port $item
971        if {[info exists onetime($port(fullname))]} continue
972        set onetime($port(fullname)) 1
973        lappend result $item
974    }
975   
976    return $result
977}
978
979
980proc opIntersection { a b } {
981    set result {}
982   
983    # Rules we follow in performing the intersection of two port lists:
984    #
985    #   a/, a/          ==> a/
986    #   a/, b/          ==>
987    #   a/, a/1.0       ==> a/1.0
988    #   a/1.0, a/       ==> a/1.0
989    #   a/1.0, a/2.0    ==>
990    #
991    #   If there's an exact match, we take it.
992    #   If there's a match between simple and descriminated, we take the later.
993   
994    # First create a list of the fully descriminated names in b
995    array unset bfull
996    set i 0
997    foreach bitem $b {
998        array set port $bitem
999        set bfull($port(fullname)) $i
1000        incr i
1001    }
1002   
1003    # Walk through each item in a, matching against b
1004    foreach aitem $a {
1005        array set port $aitem
1006       
1007        # Quote the fullname and portname to avoid special characters messing up the regexp
1008        set safefullname [regex_pat_sanitize $port(fullname)]
1009       
1010        set simpleform [expr { "$port(name)/" == $port(fullname) }]
1011        if {$simpleform} {
1012            set pat "^${safefullname}"
1013        } else {
1014            set safename [regex_pat_sanitize $port(name)]
1015            set pat "^${safefullname}$|^${safename}/$"
1016        }
1017       
1018        set matches [array names bfull -regexp $pat]
1019        foreach match $matches {
1020            if {$simpleform} {
1021                set i $bfull($match)
1022                lappend result [lindex $b $i]
1023            } else {
1024                lappend result $aitem
1025            }
1026        }
1027    }
1028   
1029    return $result
1030}
1031
1032
1033proc opComplement { a b } {
1034    set result {}
1035   
1036    # Return all elements of a not matching elements in b
1037   
1038    # First create a list of the fully descriminated names in b
1039    array unset bfull
1040    set i 0
1041    foreach bitem $b {
1042        array set port $bitem
1043        set bfull($port(fullname)) $i
1044        incr i
1045    }
1046   
1047    # Walk through each item in a, taking all those items that don't match b
1048    #
1049    # Note: -regexp may not be present in all versions of Tcl we need to work
1050    #       against, in which case we may have to fall back to a slower alternative
1051    #       for those cases. I'm not worrying about that for now, however. -jdb
1052    foreach aitem $a {
1053        array set port $aitem
1054       
1055        # Quote the fullname and portname to avoid special characters messing up the regexp
1056        set safefullname [regex_pat_sanitize $port(fullname)]
1057       
1058        set simpleform [expr { "$port(name)/" == $port(fullname) }]
1059        if {$simpleform} {
1060            set pat "^${safefullname}"
1061        } else {
1062            set safename [regex_pat_sanitize $port(name)]
1063            set pat "^${safefullname}$|^${safename}/$"
1064        }
1065       
1066        set matches [array names bfull -regexp $pat]
1067
1068        # We copy this element to result only if it didn't match against b
1069        if {![llength $matches]} {
1070            lappend result $aitem
1071        }
1072    }
1073   
1074    return $result
1075}
1076
1077
1078proc parseFullPortSpec { urlname namename vername varname optname } {
1079    upvar $urlname porturl
1080    upvar $namename portname
1081    upvar $vername portversion
1082    upvar $varname portvariants
1083    upvar $optname portoptions
1084   
1085    set portname ""
1086    set portversion ""
1087    array unset portvariants
1088    array unset portoptions
1089   
1090    if { [moreargs] } {
1091        # Look first for a potential portname
1092        #
1093        # We need to allow a wide variaty of tokens here, because of actions like "provides"
1094        # so we take a rather lenient view of what a "portname" is. We allow
1095        # anything that doesn't look like either a version, a variant, or an option
1096        set token [lookahead]
1097
1098        set remainder ""
1099        if {![regexp {^(@|[-+]([[:alpha:]_]+[\w\.]*)|[[:alpha:]_]+[\w\.]*=)} $token match]} {
1100            advance
1101            regexp {^([^@]+)(@.*)?} $token match portname remainder
1102           
1103            # If the portname contains a /, then try to use it as a URL
1104            if {[string match "*/*" $portname]} {
1105                set url "file://$portname"
1106                set name [url_to_portname $url 1]
1107                if { $name != "" } {
1108                    # We mapped the url to valid port
1109                    set porturl $url
1110                    set portname $name
1111                    # Continue to parse rest of portspec....
1112                } else {
1113                    # We didn't map the url to a port; treat it
1114                    # as a raw string for something like port contents
1115                    # or cd
1116                    set porturl ""
1117                    # Since this isn't a port, we don't try to parse
1118                    # any remaining portspec....
1119                    return
1120                }
1121            }
1122        }
1123       
1124        # Now parse the rest of the spec
1125        parsePortSpec portversion portvariants portoptions $remainder
1126    }
1127}
1128
1129   
1130proc parsePortSpec { vername varname optname {remainder ""} } {
1131    upvar $vername portversion
1132    upvar $varname portvariants
1133    upvar $optname portoptions
1134   
1135    global global_options
1136   
1137    set portversion ""
1138    array unset portoptions
1139    array set portoptions [array get global_options]
1140    array unset portvariants
1141   
1142    # Parse port version/variants/options
1143    set opt $remainder
1144    set adv 0
1145    set consumed 0
1146    for {set firstTime 1} {$opt != "" || [moreargs]} {set firstTime 0} {
1147   
1148        # Refresh opt as needed
1149        if {$opt == ""} {
1150            if {$adv} advance
1151            set opt [lookahead]
1152            set adv 1
1153            set consumed 0
1154        }
1155       
1156        # Version must be first, if it's there at all
1157        if {$firstTime && [string match {@*} $opt]} {
1158            # Parse the version
1159           
1160            # Strip the @
1161            set opt [string range $opt 1 end]
1162           
1163            # Handle the version
1164            set sepPos [string first "/" $opt]
1165            if {$sepPos >= 0} {
1166                # Version terminated by "/" to disambiguate -variant from part of version
1167                set portversion [string range $opt 0 [expr $sepPos-1]]
1168                set opt [string range $opt [expr $sepPos+1] end]
1169            } else {
1170                # Version terminated by "+", or else is complete
1171                set sepPos [string first "+" $opt]
1172                if {$sepPos >= 0} {
1173                    # Version terminated by "+"
1174                    set portversion [string range $opt 0 [expr $sepPos-1]]
1175                    set opt [string range $opt $sepPos end]
1176                } else {
1177                    # Unterminated version
1178                    set portversion $opt
1179                    set opt ""
1180                }
1181            }
1182            set consumed 1
1183        } else {
1184            # Parse all other options
1185           
1186            # Look first for a variable setting: VARNAME=VALUE
1187            if {[regexp {^([[:alpha:]_]+[\w\.]*)=(.*)} $opt match key val] == 1} {
1188                # It's a variable setting
1189                set portoptions($key) "\"$val\""
1190                set opt ""
1191                set consumed 1
1192            } elseif {[regexp {^([-+])([[:alpha:]_]+[\w\.]*)} $opt match sign variant] == 1} {
1193                # It's a variant
1194                set portvariants($variant) $sign
1195                set opt [string range $opt [expr [string length $variant]+1] end]
1196                set consumed 1
1197            } else {
1198                # Not an option we recognize, so break from port option processing
1199                if { $consumed && $adv } advance
1200                break
1201            }
1202        }
1203    }
1204}
1205
1206
1207##########################################
1208# Action Handlers
1209##########################################
1210
1211proc action_get_usage { action } {
1212    global action_array cmd_opts_array
1213
1214    if {[info exists action_array($action)]} {
1215        set cmds ""
1216        if {[info exists cmd_opts_array($action)]} {
1217            foreach opt $cmd_opts_array($action) {
1218                if {[llength $opt] == 1} {
1219                    set name $opt
1220                    set optc 0
1221                } else {
1222                    set name [lindex $opt 0]
1223                    set optc [lindex $opt 1]
1224                }
1225
1226                append cmds " --$name"
1227
1228                for {set i 1} {$i <= $optc} {incr i} {
1229                    append cmds " <arg$i>"
1230                }
1231            }
1232        }
1233        set args ""
1234        set needed [action_needs_portlist $action]
1235        if {[action_args_const strings] == $needed} {
1236            set args " <arguments>"
1237        } elseif {[action_args_const strings] == $needed} {
1238            set args " <portlist>"
1239        }
1240
1241        set ret "Usage: "
1242        set len [string length $action]
1243        append ret [wrap "$action$cmds$args" 0 [string repeat " " [expr 8 + $len]] 0]
1244        append ret "\n"
1245
1246        return $ret
1247    }
1248
1249    return -1
1250}
1251
1252proc action_usage { action portlist opts } {
1253    if {[llength $portlist] == 0} {
1254        print_usage
1255        return 0
1256    }
1257
1258    foreach topic $portlist {
1259        set usage [action_get_usage $topic]
1260        if {$usage != -1} {
1261           puts -nonewline stderr $usage
1262        } else {
1263            ui_error "No usage for topic $topic"
1264            return 1
1265        }
1266    }
1267}
1268
1269
1270proc action_help { action portlist opts } {
1271    set helpfile "$macports::prefix/var/macports/port-help.tcl"
1272
1273    if {[llength $portlist] == 0} {
1274        print_help
1275        return 0
1276    }
1277
1278        if {[file exists $helpfile]} {
1279                if {[catch {source $helpfile} err]} {
1280                        puts stderr "Error reading helpfile $helpfile: $err"
1281                        return 1
1282                }
1283    } else {
1284                puts stderr "Unable to open help file $helpfile"
1285                return 1
1286        }
1287
1288    foreach topic $portlist {
1289        if {![info exists porthelp($topic)]} {
1290            puts stderr "No help for topic $topic"
1291            return 1
1292        }
1293
1294        set usage [action_get_usage $topic]
1295        if {$usage != -1} {
1296           puts -nonewline stderr $usage
1297        } else {
1298            ui_error "No usage for topic $topic"
1299            return 1
1300        }
1301
1302        puts stderr $porthelp($topic)
1303    }
1304
1305    return 0
1306}
1307
1308
1309proc action_info { action portlist opts } {
1310    set status 0
1311    if {[require_portlist portlist]} {
1312        return 1
1313    }
1314
1315    set separator ""
1316    foreachport $portlist {
1317        puts -nonewline $separator
1318        # If we have a url, use that, since it's most specific
1319        # otherwise try to map the portname to a url
1320        if {$porturl eq ""} {
1321        # Verify the portname, getting portinfo to map to a porturl
1322            if {[catch {mportsearch $portname no exact} result]} {
1323                ui_debug "$::errorInfo"
1324                break_softcontinue "search for portname $portname failed: $result" 1 status
1325            }
1326            if {[llength $result] < 2} {
1327                break_softcontinue "Port $portname not found" 1 status
1328            }
1329            set found [expr [llength $result] / 2]
1330            if {$found > 1} {
1331                ui_warn "Found $found port $portname definitions, displaying first one."
1332            }
1333            array unset portinfo
1334            array set portinfo [lindex $result 1]
1335            set porturl $portinfo(porturl)
1336            set portdir $portinfo(portdir)
1337        }
1338
1339        if {!([info exists options(ports_info_index)] && $options(ports_info_index) eq "yes")} {
1340            if {[catch {set mport [mportopen $porturl [array get options] [array get variations]]} result]} {
1341                ui_debug "$::errorInfo"
1342                break_softcontinue "Unable to open port: $result" 1 status
1343            }
1344            array unset portinfo
1345            array set portinfo [mportinfo $mport]
1346            mportclose $mport
1347            if {[info exists portdir]} {
1348                set portinfo(portdir) $portdir
1349            }
1350        } elseif {![info exists portinfo]} {
1351            ui_warn "port info --index does not work with 'current' pseudo-port"
1352            continue
1353        }
1354       
1355        # Map from friendly to less-friendly but real names
1356        array set name_map "
1357            category        categories
1358            maintainer      maintainers
1359            platform        platforms
1360            variant         variants
1361        "
1362               
1363        # Understand which info items are actually lists
1364        # (this could be overloaded to provide a generic formatting code to
1365        # allow us to, say, split off the prefix on libs)
1366        array set list_map "
1367            categories      1
1368            depends_build   1
1369            depends_lib     1
1370            depends_run     1
1371            maintainers     1
1372            platforms       1
1373            variants        1
1374        "
1375
1376        if {[info exists options(ports_info_depends)] && $options(ports_info_depends) == "yes"} {
1377            array unset options ports_info_depends
1378            set options(ports_info_depends_build) yes
1379            set options(ports_info_depends_lib) yes
1380            set options(ports_info_depends_run) yes
1381        }
1382               
1383        # Set up our field separators
1384        set show_label 1
1385        set field_sep "\n"
1386        set subfield_sep ", "
1387       
1388        # Tune for sort(1)
1389        if {[info exists options(ports_info_line)]} {
1390            array unset options ports_info_line
1391            set show_label 0
1392            set field_sep "\t"
1393            set subfield_sep ","
1394        }
1395       
1396        # Figure out whether to show field name
1397        set quiet [macports::ui_isset ports_quiet]
1398        if {$quiet} {
1399            set show_label 0
1400        }
1401       
1402        # Spin through action options, emitting information for any found
1403        set fields {}
1404        foreach { option } [array names options ports_info_*] {
1405            set opt [string range $option 11 end]
1406            if {$opt eq "index"} {
1407                continue
1408            }
1409           
1410            # Map from friendly name
1411            set ropt $opt
1412            if {[info exists name_map($opt)]} {
1413                set ropt $name_map($opt)
1414            }
1415           
1416            # If there's no such info, move on
1417            if {![info exists portinfo($ropt)]} {
1418                if {!$quiet} {
1419                    puts stderr "no info for '$opt'"
1420                }
1421                set inf ""
1422            } else {
1423                set inf $portinfo($ropt)
1424            }
1425           
1426            # Calculate field label
1427            set label ""
1428            if {$show_label} {
1429                set label "$opt: "
1430            }
1431           
1432            # Format the data
1433            if { $ropt eq "maintainers" } {
1434                set inf [unobscure_maintainers $inf]
1435            }
1436            if [info exists list_map($ropt)] {
1437                set field [join $inf $subfield_sep]
1438            } else {
1439                set field $inf
1440            }
1441           
1442            lappend fields "$label$field"
1443        }
1444       
1445        if {[llength $fields]} {
1446            # Show specific fields
1447            puts [join $fields $field_sep]
1448        } else {
1449            # If we weren't asked to show any specific fields, then show general information
1450            puts -nonewline "$portinfo(name) @$portinfo(version)"
1451            if {[info exists portinfo(revision)] && $portinfo(revision) > 0} {
1452                puts -nonewline ", Revision $portinfo(revision)"
1453            }
1454            if {[info exists portinfo(categories)]} {
1455                puts -nonewline " ([join $portinfo(categories) ", "])"
1456            }
1457            puts ""
1458            if {[info exists portinfo(variants)]} {
1459                global global_variations
1460
1461                set joiner ""
1462                set vars ""
1463                foreach v [lsort $portinfo(variants)] {
1464                    set mod ""
1465                    if {[info exists variations($v)]} {
1466                        # selected by command line, prefixed with +/-
1467                        set mod $variations($v)
1468                    } elseif {[info exists global_variations($v)]} {
1469                        # selected by variants.conf, prefixed with (+)/(-)
1470                        set mod "($global_variations($v))"
1471                    }
1472                    # TODO: selected by default_variants (with [+]/[-])
1473                    append vars "$joiner$mod$v"
1474                    set joiner ", "
1475                }
1476                puts -nonewline "Variants:    "
1477                puts [wrap $vars 0 [string repeat " " 13] 0]
1478            }
1479            puts ""
1480            if {[info exists portinfo(long_description)]} {
1481                puts [wrap [join $portinfo(long_description)] 0]
1482            } else {
1483                if {[info exists portinfo(description)]} {
1484                    puts [wrap [join $portinfo(description)] 0]
1485                }
1486            }
1487            if {[info exists portinfo(homepage)]} {
1488                puts "Homepage:    $portinfo(homepage)"
1489            }
1490            puts ""
1491            # Emit build, library, and runtime dependencies
1492            foreach {key title} {
1493                depends_build "Build Dependencies"
1494                depends_lib "Library Dependencies"
1495                depends_run "Runtime Dependencies"
1496            } {
1497                if {[info exists portinfo($key)]} {
1498                    puts -nonewline "$title: "
1499                    set joiner ""
1500                    foreach d $portinfo($key) {
1501                        if {[macports::ui_isset ports_verbose]} {
1502                            puts -nonewline "$joiner$d"
1503                        } else {
1504                            puts -nonewline "$joiner[lindex [split $d :] end]"
1505                        }
1506                        set joiner ", "
1507                    }
1508                    set nodeps false
1509                    puts ""
1510                }
1511            }
1512               
1513            if {[info exists portinfo(platforms)]} { puts "Platforms: [join $portinfo(platforms) ", "]"}
1514            if {[info exists portinfo(maintainers)]} {
1515                puts "Maintainers: [unobscure_maintainers $portinfo(maintainers)]"
1516            }
1517        }
1518        set separator "--\n"
1519    }
1520   
1521    return $status
1522}
1523
1524
1525proc action_location { action portlist opts } {
1526    set status 0
1527    if {[require_portlist portlist]} {
1528        return 1
1529    }
1530    foreachport $portlist {
1531        if { [catch {set ilist [registry_installed $portname [composite_version $portversion [array get variations]]]} result] } {
1532            global errorInfo
1533            ui_debug "$errorInfo"
1534            break_softcontinue "port location failed: $result" 1 status
1535        } else {
1536            # set portname again since the one we were passed may not have had the correct case
1537            set portname [lindex $ilist 0]
1538            set version [lindex $ilist 1]
1539            set revision [lindex $ilist 2]
1540            set variants [lindex $ilist 3]
1541        }
1542
1543        set ref [registry::open_entry $portname $version $revision $variants]
1544        if { [string equal [registry::property_retrieve $ref installtype] "image"] } {
1545            set imagedir [registry::property_retrieve $ref imagedir]
1546            puts "Port $portname ${version}_${revision}${variants} is installed as an image in:"
1547            puts $imagedir
1548        } else {
1549            break_softcontinue "Port $portname is not installed as an image." 1 status
1550        }
1551    }
1552   
1553    return $status
1554}
1555
1556
1557proc action_provides { action portlist opts } {
1558    # In this case, portname is going to be used for the filename... since
1559    # that is the first argument we expect... perhaps there is a better way
1560    # to do this?
1561    if { ![llength $portlist] } {
1562        ui_error "Please specify a filename to check which port provides that file."
1563        return 1
1564    }
1565    foreach filename $portlist {
1566        set file [compat filenormalize $filename]
1567        if {[file exists $file]} {
1568            if {![file isdirectory $file]} {
1569                set port [registry::file_registered $file]
1570                if { $port != 0 } {
1571                    puts "$file is provided by: $port"
1572                } else {
1573                    puts "$file is not provided by a MacPorts port."
1574                }
1575            } else {
1576                puts "$file is a directory."
1577            }
1578        } else {
1579            puts "$file does not exist."
1580        }
1581    }
1582   
1583    return 0
1584}
1585
1586
1587proc action_activate { action portlist opts } {
1588    set status 0
1589    if {[require_portlist portlist]} {
1590        return 1
1591    }
1592    foreachport $portlist {
1593        if { [catch {portimage::activate $portname [composite_version $portversion [array get variations]] [array get options]} result] } {
1594            global errorInfo
1595            ui_debug "$errorInfo"
1596            break_softcontinue "port activate failed: $result" 1 status
1597        }
1598    }
1599   
1600    return $status
1601}
1602
1603
1604proc action_deactivate { action portlist opts } {
1605    set status 0
1606    if {[require_portlist portlist]} {
1607        return 1
1608    }
1609    foreachport $portlist {
1610        if { [catch {portimage::deactivate $portname [composite_version $portversion [array get variations]] [array get options]} result] } {
1611            global errorInfo
1612            ui_debug "$errorInfo"
1613            break_softcontinue "port deactivate failed: $result" 1 status
1614        }
1615    }
1616   
1617    return $status
1618}
1619
1620
1621proc action_selfupdate { action portlist opts } {
1622    global global_options
1623    if { [catch {macports::selfupdate [array get global_options]} result ] } {
1624        global errorInfo
1625        ui_debug "$errorInfo"
1626        fatal "port selfupdate failed: $result"
1627    }
1628   
1629    return 0
1630}
1631
1632
1633proc action_upgrade { action portlist opts } {
1634    global global_variations
1635    if {[require_portlist portlist]} {
1636        return 1
1637    }
1638    foreachport $portlist {
1639        # Merge global variations into the variations specified for this port
1640        foreach { variation value } [array get global_variations] {
1641            if { ![info exists variations($variation)] } {
1642                set variations($variation) $value
1643            }
1644        }
1645
1646        macports::upgrade $portname "port:$portname" [array get variations] [array get options]
1647    }
1648
1649    return 0
1650}
1651
1652
1653proc action_version { action portlist opts } {
1654    puts "Version: [macports::version]"
1655    return 0
1656}
1657
1658
1659proc action_platform { action portlist opts } {
1660#   global os.platform os.major os.arch
1661    global tcl_platform
1662    set os_platform [string tolower $tcl_platform(os)]
1663    set os_version $tcl_platform(osVersion)
1664    set os_arch $tcl_platform(machine)
1665    if {$os_arch == "Power Macintosh"} { set os_arch "powerpc" }
1666    if {$os_arch == "i586" || $os_arch == "i686"} { set os_arch "i386" }
1667    set os_major [lindex [split $tcl_platform(osVersion) .] 0]
1668#   puts "Platform: ${os.platform} ${os.major} ${os.arch}"
1669    puts "Platform: ${os_platform} ${os_major} ${os_arch}"
1670    return 0
1671}
1672
1673
1674proc action_compact { action portlist opts } {
1675    set status 0
1676    if {[require_portlist portlist]} {
1677        return 1
1678    }
1679    foreachport $portlist {
1680        if { [catch {portimage::compact $portname [composite_version $portversion [array get variations]]} result] } {
1681            global errorInfo
1682            ui_debug "$errorInfo"
1683            break_softcontinue "port compact failed: $result" 1 status
1684        }
1685    }
1686
1687    return $status
1688}
1689
1690
1691proc action_uncompact { action portlist opts } {
1692    set status 0
1693    if {[require_portlist portlist]} {
1694        return 1
1695    }
1696    foreachport $portlist {
1697        if { [catch {portimage::uncompact $portname [composite_version $portversion [array get variations]]} result] } {
1698            global errorInfo
1699            ui_debug "$errorInfo"
1700            break_softcontinue "port uncompact failed: $result" 1 status
1701        }
1702    }
1703   
1704    return $status
1705}
1706
1707
1708proc action_dependents { action portlist opts } {
1709    if {[require_portlist portlist]} {
1710        return 1
1711    }
1712    set ilist {}
1713
1714    foreachport $portlist {
1715        registry::open_dep_map
1716       
1717        set composite_version [composite_version $portversion [array get variations]]
1718        if { [catch {set ilist [concat $ilist [registry::installed $portname $composite_version]]} result] } {
1719            global errorInfo
1720            ui_debug "$errorInfo"
1721            break_softcontinue "$result" 1 status
1722        } else {
1723            # set portname again since the one we were passed may not have had the correct case
1724            set portname [lindex [lindex $ilist 0] 0]
1725        }
1726       
1727        set deplist [registry::list_dependents $portname]
1728        if { [llength $deplist] > 0 } {
1729            set dl [list]
1730            # Check the deps first
1731            foreach dep $deplist {
1732                set depport [lindex $dep 2]
1733                if {![macports::ui_isset ports_verbose]} {
1734                    ui_msg "$depport depends on $portname"
1735                } else {
1736                    ui_msg "$depport depends on $portname (by [lindex $dep 1]:)"
1737                }
1738            }
1739        } else {
1740            ui_msg "$portname has no dependents!"
1741        }
1742    }
1743    return 0
1744}
1745
1746
1747proc action_uninstall { action portlist opts } {
1748    set status 0
1749    if {[macports::global_option_isset port_uninstall_old]} {
1750        # if -u then uninstall all inactive ports
1751        # (union these to any other ports user has in the port list)
1752        set portlist [opUnion $portlist [get_inactive_ports]]
1753    } else {
1754        # Otherwise the user hopefully supplied a portlist, or we'll default to the existing directory
1755        if {[require_portlist portlist]} {
1756            return 1
1757        }
1758    }
1759
1760    foreachport $portlist {
1761        if { [catch {portuninstall::uninstall $portname [composite_version $portversion [array get variations]] [array get options]} result] } {
1762            global errorInfo
1763            ui_debug "$errorInfo"
1764            break_softcontinue "port uninstall failed: $result" 1 status
1765        }
1766    }
1767
1768    return 0
1769}
1770
1771
1772proc action_installed { action portlist opts } {
1773    global private_options
1774    set status 0
1775    set restrictedList 0
1776    set ilist {}
1777   
1778    if { [llength $portlist] || (![info exists private_options(ports_no_args)] || $private_options(ports_no_args) == "no")} {
1779        set restrictedList 1
1780        foreachport $portlist {
1781            set composite_version [composite_version $portversion [array get variations]]
1782            if { [catch {set ilist [concat $ilist [registry::installed $portname $composite_version]]} result] } {
1783                if {![string match "* not registered as installed." $result]} {
1784                    global errorInfo
1785                    ui_debug "$errorInfo"
1786                    break_softcontinue "port installed failed: $result" 1 status
1787                }
1788            }
1789        }
1790    } else {
1791        if { [catch {set ilist [registry::installed]} result] } {
1792            if {$result != "Registry error: No ports registered as installed."} {
1793                global errorInfo
1794                ui_debug "$errorInfo"
1795                ui_error "port installed failed: $result"
1796                set status 1
1797            }
1798        }
1799    }
1800    if { [llength $ilist] > 0 } {
1801        puts "The following ports are currently installed:"
1802        foreach i [portlist_sortint $ilist] {
1803            set iname [lindex $i 0]
1804            set iversion [lindex $i 1]
1805            set irevision [lindex $i 2]
1806            set ivariants [lindex $i 3]
1807            set iactive [lindex $i 4]
1808            if { $iactive == 0 } {
1809                puts "  $iname @${iversion}_${irevision}${ivariants}"
1810            } elseif { $iactive == 1 } {
1811                puts "  $iname @${iversion}_${irevision}${ivariants} (active)"
1812            }
1813        }
1814    } elseif { $restrictedList } {
1815        puts "None of the specified ports are installed."
1816    } else {
1817        puts "No ports are installed."
1818    }
1819   
1820    return $status
1821}
1822
1823
1824proc action_outdated { action portlist opts } {
1825    global macports::registry.installtype private_options
1826    set is_image_mode [expr 0 == [string compare "image" ${macports::registry.installtype}]]
1827
1828    set status 0
1829
1830    # If port names were supplied, limit ourselves to those ports, else check all installed ports
1831    set ilist {}
1832    set restrictedList 0
1833    if { [llength $portlist] || (![info exists private_options(ports_no_args)] || $private_options(ports_no_args) == "no")} {
1834        set restrictedList 1
1835        foreach portspec $portlist {
1836            array set port $portspec
1837            set portname $port(name)
1838            set composite_version [composite_version $port(version) $port(variants)]
1839            if { [catch {set ilist [concat $ilist [registry::installed $portname $composite_version]]} result] } {
1840                if {![string match "* not registered as installed." $result]} {
1841                    global errorInfo
1842                    ui_debug "$errorInfo"
1843                    break_softcontinue "port outdated failed: $result" 1 status
1844                }
1845            }
1846        }
1847    } else {
1848        if { [catch {set ilist [registry::installed]} result] } {
1849            if {$result != "Registry error: No ports registered as installed."} {
1850                global errorInfo
1851                ui_debug "$errorInfo"
1852                ui_error "port installed failed: $result"
1853                set status 1
1854            }
1855        }
1856    }
1857
1858    set num_outdated 0
1859    if { [llength $ilist] > 0 } {   
1860        foreach i $ilist { 
1861       
1862            # Get information about the installed port
1863            set portname [lindex $i 0]
1864            set installed_version [lindex $i 1]
1865            set installed_revision [lindex $i 2]
1866            set installed_compound "${installed_version}_${installed_revision}"
1867
1868            set is_active [lindex $i 4]
1869            if { $is_active == 0 && $is_image_mode } {
1870                continue
1871            }
1872            set installed_epoch [lindex $i 5]
1873
1874            # Get info about the port from the index
1875            if {[catch {set res [mportsearch $portname no exact]} result]} {
1876                global errorInfo
1877                ui_debug "$errorInfo"
1878                break_softcontinue "search for portname $portname failed: $result" 1 status
1879            }
1880            if {[llength $res] < 2} {
1881                if {[macports::ui_isset ports_debug]} {
1882                    puts "$portname ($installed_compound is installed; the port was not found in the port index)"
1883                }
1884                continue
1885            }
1886            array unset portinfo
1887            array set portinfo [lindex $res 1]
1888           
1889            # Get information about latest available version and revision
1890            set latest_version $portinfo(version)
1891            set latest_revision 0
1892            if {[info exists portinfo(revision)] && $portinfo(revision) > 0} { 
1893                set latest_revision $portinfo(revision)
1894            }
1895            set latest_compound "${latest_version}_${latest_revision}"
1896            set latest_epoch 0
1897            if {[info exists portinfo(epoch)]} { 
1898                set latest_epoch $portinfo(epoch)
1899            }
1900           
1901            # Compare versions, first checking epoch, then version, then revision
1902            set comp_result [expr $installed_epoch - $latest_epoch]
1903            if { $comp_result == 0 } {
1904                set comp_result [rpm-vercomp $installed_version $latest_version]
1905                if { $comp_result == 0 } {
1906                    set comp_result [rpm-vercomp $installed_revision $latest_revision]
1907                }
1908            }
1909           
1910            # Report outdated (or, for verbose, predated) versions
1911            if { $comp_result != 0 } {
1912                           
1913                # Form a relation between the versions
1914                set flag ""
1915                if { $comp_result > 0 } {
1916                    set relation ">"
1917                    set flag "!"
1918                } else {
1919                    set relation "<"
1920                }
1921               
1922                # Emit information
1923                if {$comp_result < 0 || [macports::ui_isset ports_verbose]} {
1924               
1925                    if { $num_outdated == 0 } {
1926                        puts "The following installed ports are outdated:"
1927                    }
1928                    incr num_outdated
1929
1930                    puts [format "%-30s %-24s %1s" $portname "$installed_compound $relation $latest_compound" $flag]
1931                }
1932               
1933            }
1934        }
1935       
1936        if { $num_outdated == 0 } {
1937            puts "No installed ports are outdated."
1938        }
1939    } elseif { $restrictedList } {
1940        puts "None of the specified ports are outdated."
1941    } else {
1942        puts "No ports are installed."
1943    }
1944   
1945    return $status
1946}
1947
1948
1949proc action_contents { action portlist opts } {
1950    set status 0
1951    if {[require_portlist portlist]} {
1952        return 1
1953    }
1954    foreachport $portlist {
1955        if { ![catch {set ilist [registry::installed $portname]} result] } {
1956            # set portname again since the one we were passed may not have had the correct case
1957            set portname [lindex [lindex $ilist 0] 0]
1958        }
1959        set files [registry::port_registered $portname]
1960        if { $files != 0 } {
1961            if { [llength $files] > 0 } {
1962                puts "Port $portname contains:"
1963                foreach file $files {
1964                    puts "  $file"
1965                }
1966            } else {
1967                puts "Port $portname does not contain any file or is not active."
1968            }
1969        } else {
1970            puts "Port $portname is not installed."
1971        }
1972    }
1973
1974    return $status
1975}
1976
1977
1978proc action_deps { action portlist opts } {
1979    set status 0
1980    if {[require_portlist portlist]} {
1981        return 1
1982    }
1983    foreachport $portlist {
1984        # Get info about the port
1985        if {[catch {mportsearch $portname no exact} result]} {
1986            global errorInfo
1987            ui_debug "$errorInfo"
1988            break_softcontinue "search for portname $portname failed: $result" 1 status
1989        }
1990
1991        if {$result == ""} {
1992            break_softcontinue "No port $portname found." 1 status
1993        }
1994
1995        array unset portinfo
1996        array set portinfo [lindex $result 1]
1997        # set portname again since the one we were passed may not have had the correct case
1998        set portname $portinfo(name)
1999
2000        set depstypes {depends_build depends_lib depends_run}
2001        set depstypes_descr {"build" "library" "runtime"}
2002
2003        set nodeps true
2004        foreach depstype $depstypes depsdecr $depstypes_descr {
2005            if {[info exists portinfo($depstype)] &&
2006                $portinfo($depstype) != ""} {
2007                puts "$portname has $depsdecr dependencies on:"
2008                foreach i $portinfo($depstype) {
2009                    if {[macports::ui_isset ports_verbose]} {
2010                        puts "\t$i"
2011                    } else {
2012                        puts "\t[lindex [split [lindex $i 0] :] end]"
2013                    }
2014                }
2015                set nodeps false
2016            }
2017        }
2018       
2019        # no dependencies found
2020        if {$nodeps == "true"} {
2021            puts "$portname has no dependencies"
2022        }
2023    }
2024   
2025    return $status
2026}
2027
2028
2029proc action_variants { action portlist opts } {
2030    set status 0
2031    if {[require_portlist portlist]} {
2032        return 1
2033    }
2034    foreachport $portlist {
2035        # search for port
2036        if {[catch {mportsearch $portname no exact} result]} {
2037            global errorInfo
2038            ui_debug "$errorInfo"
2039            break_softcontinue "search for portname $portname failed: $result" 1 status
2040        }
2041        if {[llength $result] < 2} {
2042            break_softcontinue "Port $portname not found" 1 status
2043        }
2044   
2045        array unset portinfo
2046        array set portinfo [lindex $result 1]
2047        # set portname again since the one we were passed may not have had the correct case
2048        set portname $portinfo(name)
2049        set porturl $portinfo(porturl)
2050        set portdir $portinfo(portdir)
2051
2052        if {!([info exists options(ports_variants_index)] && $options(ports_variants_index) eq "yes")} {
2053            if {[catch {set mport [mportopen $porturl [array get options] [array get variations]]} result]} {
2054                ui_debug "$::errorInfo"
2055                break_softcontinue "Unable to open port: $result" 1 status
2056            }
2057            array unset portinfo
2058            array set portinfo [mportinfo $mport]
2059            mportclose $mport
2060            if {[info exists portdir]} {
2061                set portinfo(portdir) $portdir
2062            }
2063        } elseif {![info exists portinfo]} {
2064            ui_warn "port variants --index does not work with 'current' pseudo-port"
2065            continue
2066        }
2067   
2068        # if this fails the port doesn't have any variants
2069        if {![info exists portinfo(variants)]} {
2070            puts "$portname has no variants"
2071        } else {
2072            # Get the variant descriptions
2073            if {[info exists portinfo(variant_desc)]} {
2074                array set descs $portinfo(variant_desc)
2075            } else {
2076                array set descs ""
2077            }
2078
2079            # print out all the variants
2080            puts "$portname has the variants:"
2081            foreach v $portinfo(variants) {
2082                if {[info exists descs($v)]} {
2083                    puts "\t$v: [join [string trim $descs($v)]]"
2084                } else {
2085                    puts "\t$v"
2086                }
2087            }
2088        }
2089    }
2090   
2091    return $status
2092}
2093
2094
2095proc action_search { action portlist opts } {
2096    global private_options global_options
2097    set status 0
2098    if {![llength $portlist] && [info exists private_options(ports_no_args)] && $private_options(ports_no_args) == "yes"} {
2099        ui_error "You must specify a search pattern"
2100        return 1
2101    }
2102   
2103    set separator ""
2104    foreach portname $portlist {
2105        puts -nonewline $separator
2106
2107        if {[string first "*" $portname] == -1} {
2108            set searchstring "*$portname*"
2109        } else {
2110            set searchstring $portname
2111        }
2112
2113        set portfound 0
2114        set res {}
2115        if {[catch {set matches [mportsearch $searchstring no glob name]} result]} {
2116            global errorInfo
2117            ui_debug "$errorInfo"
2118            break_softcontinue "search for name $portname failed: $result" 1 status
2119        }
2120        set tmp {}
2121        foreach {name info} $matches {
2122            add_to_portlist tmp [concat [list name $name] $info]
2123        }
2124        set res [opUnion $res $tmp]
2125        if {[catch {set matches [mportsearch $searchstring no glob description]} result]} {
2126            global errorInfo
2127            ui_debug "$errorInfo"
2128            break_softcontinue "search for description $portname failed: $result" 1 status
2129        }
2130        set tmp {}
2131        foreach {name info} $matches {
2132            add_to_portlist tmp [concat [list name $name] $info]
2133        }
2134        set res [opUnion $res $tmp]
2135        if {[catch {set matches [mportsearch $searchstring no glob long_description]} result]} {
2136            global errorInfo
2137            ui_debug "$errorInfo"
2138            break_softcontinue "search for long_description $portname failed: $result" 1 status
2139        }
2140        set tmp {}
2141        foreach {name info} $matches {
2142            add_to_portlist tmp [concat [list name $name] $info]
2143        }
2144        set res [opUnion $res $tmp]
2145        set res [portlist_sort $res]
2146
2147        set joiner ""
2148        foreach info $res {
2149            array unset portinfo
2150            array set portinfo $info
2151
2152            # XXX is this the right place to verify an entry?
2153            if {![info exists portinfo(name)]} {
2154                puts stderr "Invalid port entry, missing portname"
2155                continue
2156            }
2157            if {![info exists portinfo(description)]} {
2158                puts stderr "Invalid port entry for $portinfo(name), missing description"
2159                continue
2160            }
2161            if {![info exists portinfo(version)]} {
2162                puts stderr "Invalid port entry for $portinfo(name), missing version"
2163                continue
2164            }
2165
2166            if {[macports::ui_isset ports_quiet]} {
2167                puts $portinfo(name)
2168            } else {
2169                if {[info exists global_options(ports_search_line)]
2170                        && $global_options(ports_search_line) == "yes"} {
2171                    puts "$portinfo(name)\t$portinfo(version)\t$portinfo(categories)\t$portinfo(description)"
2172                } else {
2173                    puts -nonewline $joiner
2174
2175                    puts -nonewline "$portinfo(name) @$portinfo(version)"
2176                    if {[info exists portinfo(categories)]} {
2177                        puts -nonewline " ([join $portinfo(categories) ", "])"
2178                    }
2179                    puts ""
2180                    puts [wrap [join $portinfo(description)] 0 [string repeat " " 4]]
2181                }
2182            }
2183
2184            set joiner "\n"
2185            set portfound 1
2186        }
2187        if { !$portfound } {
2188            ui_msg "No match for $portname found"
2189        } elseif {[llength $res] > 1} {
2190            if {![info exists global_options(ports_search_line)]
2191                    || $global_options(ports_search_line) != "yes"} {
2192                ui_msg "\nFound [llength $res] ports."
2193            }
2194        }
2195
2196        set separator "--\n"
2197    }
2198   
2199    return $status
2200}
2201
2202
2203proc action_list { action portlist opts } {
2204    global private_options
2205    set status 0
2206   
2207    # Default to list all ports if no portnames are supplied
2208    if { ![llength $portlist] && [info exists private_options(ports_no_args)] && $private_options(ports_no_args) == "yes"} {
2209        add_to_portlist portlist [list name "-all-"]
2210    }
2211   
2212    foreachport $portlist {
2213        if {$portname == "-all-"} {
2214            set search_string ".+"
2215        } else {
2216            set search_string [regex_pat_sanitize $portname]
2217        }
2218       
2219        if {[catch {set res [mportsearch ^$search_string\$ no]} result]} {
2220            global errorInfo
2221            ui_debug "$errorInfo"
2222            break_softcontinue "search for portname $search_string failed: $result" 1 status
2223        }
2224
2225        foreach {name array} $res {
2226            array unset portinfo
2227            array set portinfo $array
2228            set outdir ""
2229            if {[info exists portinfo(portdir)]} {
2230                set outdir $portinfo(portdir)
2231            }
2232            puts [format "%-30s @%-14s %s" $portinfo(name) $portinfo(version) $outdir]
2233        }
2234    }
2235   
2236    return $status
2237}
2238
2239
2240proc action_echo { action portlist opts } {
2241    # Simply echo back the port specs given to this command
2242    foreachport $portlist {
2243        set opts {}
2244        foreach { key value } [array get options] {
2245            lappend opts "$key=$value"
2246        }
2247       
2248        set composite_version [composite_version $portversion [array get variations] 1]
2249        if { $composite_version != "" } {
2250            set ver_field "@$composite_version"
2251        } else {
2252            set ver_field ""
2253        }
2254        puts [format "%-30s %s %s" $portname $ver_field  [join $opts " "]]
2255    }
2256   
2257    return 0
2258}
2259
2260
2261proc action_portcmds { action portlist opts } {
2262    # Operations on the port's directory and Portfile
2263    global env boot_env
2264    global current_portdir
2265
2266    array set local_options $opts
2267   
2268    set status 0
2269    if {[require_portlist portlist]} {
2270        return 1
2271    }
2272    foreachport $portlist {
2273        # If we have a url, use that, since it's most specific, otherwise try to map the portname to a url
2274        if {$porturl == ""} {
2275       
2276            # Verify the portname, getting portinfo to map to a porturl
2277            if {[catch {set res [mportsearch $portname no exact]} result]} {
2278                global errorInfo
2279                ui_debug "$errorInfo"
2280                break_softcontinue "search for portname $portname failed: $result" 1 status
2281            }
2282            if {[llength $res] < 2} {
2283                break_softcontinue "Port $portname not found" 1 status
2284            }
2285            array set portinfo [lindex $res 1]
2286            set porturl $portinfo(porturl)
2287        }
2288       
2289       
2290        # Calculate portdir, porturl, and portfile from initial porturl
2291        set portdir [file normalize [macports::getportdir $porturl]]
2292        set porturl "file://${portdir}";    # Rebuild url so it's fully qualified
2293        set portfile "${portdir}/Portfile"
2294       
2295        # Now execute the specific action
2296        if {[file readable $portfile]} {
2297            switch -- $action {
2298                cat {
2299                    # Copy the portfile to standard output
2300                    set f [open $portfile RDONLY]
2301                    while { ![eof $f] } {
2302                        puts [read $f 4096]
2303                    }
2304                    close $f
2305                }
2306               
2307                ed - edit {
2308                    # Edit the port's portfile with the user's editor
2309                   
2310                    # Restore our entire environment from start time.
2311                    # We need it to evaluate the editor, and the editor
2312                    # may want stuff from it as well, like TERM.
2313                    array unset env_save; array set env_save [array get env]
2314                    array unset env *; array set env [array get boot_env]
2315                   
2316                    # Find an editor to edit the portfile
2317                    set editor ""
2318                    if {[info exists local_options(ports_edit_editor)]} {
2319                        set editor $local_options(ports_edit_editor)
2320                    } elseif {[info exists local_options(ports_ed_editor)]} {
2321                        set editor $local_options(ports_ed_editor)
2322                    } else {
2323                        foreach ed { VISUAL EDITOR } {
2324                            if {[info exists env($ed)]} {
2325                                set editor $env($ed)
2326                                break
2327                            }
2328                        }
2329                    }
2330                   
2331                    # Invoke the editor, with a reasonable canned default.
2332                    if { $editor == "" } { set editor "/usr/bin/vi" }
2333                    if {[catch {eval exec >/dev/stdout </dev/stdin $editor $portfile} result]} {
2334                        global errorInfo
2335                        ui_debug "$errorInfo"
2336                        break_softcontinue "unable to invoke editor $editor: $result" 1 status
2337                    }
2338                   
2339                    # Restore internal MacPorts environment
2340                    array unset env *; array set env [array get env_save]
2341                }
2342
2343                dir {
2344                    # output the path to the port's directory
2345                    puts $portdir
2346                }
2347
2348                work {
2349                    # output the path to the port's work directory
2350                    set workpath [macports::getportworkpath_from_portdir $portdir]
2351                    if {[file exists $workpath]} {
2352                        puts $workpath
2353                    }
2354                }
2355
2356                cd {
2357                    # Change to the port's directory, making it the default
2358                    # port for any future commands
2359                    set current_portdir $portdir
2360                }
2361
2362                url {
2363                    # output the url of the port's directory, suitable to feed back in later as a port descriptor
2364                    puts $porturl
2365                }
2366
2367                file {
2368                    # output the path to the port's portfile
2369                    puts $portfile
2370                }
2371
2372                gohome {
2373                    # Get the homepage for the port by opening the portfile
2374                    if {![catch {set ctx [mportopen $porturl]} result]} {
2375                        array set portinfo [mportinfo $ctx]
2376                        set homepage $portinfo(homepage)
2377                        mportclose $ctx
2378                    }
2379
2380                    # Try to open a browser to the homepage for the given port
2381                    set homepage $portinfo(homepage)
2382                    if { $homepage != "" } {
2383                        system "${macports::autoconf::open_path} $homepage"
2384                    } else {
2385                        puts "(no homepage)"
2386                    }
2387                }
2388            }
2389        } else {
2390            break_softcontinue "Could not read $portfile" 1 status
2391        }
2392    }
2393   
2394    return $status
2395}
2396
2397
2398proc action_sync { action portlist opts } {
2399    global global_options
2400
2401    set status 0
2402    if {[catch {mportsync [array get global_options]} result]} {
2403        global errorInfo
2404        ui_debug "$errorInfo"
2405        ui_msg "port sync failed: $result"
2406        set status 1
2407    }
2408   
2409    return $status
2410}
2411
2412
2413proc action_target { action portlist opts } {
2414    global global_variations
2415    set status 0
2416    if {[require_portlist portlist]} {
2417        return 1
2418    }
2419    foreachport $portlist {
2420        set target $action
2421
2422        # If we have a url, use that, since it's most specific
2423        # otherwise try to map the portname to a url
2424        if {$porturl == ""} {
2425            # Verify the portname, getting portinfo to map to a porturl
2426            if {[catch {set res [mportsearch $portname no exact]} result]} {
2427                global errorInfo
2428                ui_debug "$errorInfo"
2429                break_softcontinue "search for portname $portname failed: $result" 1 status
2430            }
2431            if {[llength $res] < 2} {
2432                break_softcontinue "Port $portname not found" 1 status
2433            }
2434            array unset portinfo
2435            array set portinfo [lindex $res 1]
2436            set porturl $portinfo(porturl)
2437        }
2438       
2439        # If this is the install target, add any global_variations to the variations
2440        # specified for the port
2441        if { $target == "install" } {
2442            foreach { variation value } [array get global_variations] {
2443                if { ![info exists variations($variation)] } {
2444                    set variations($variation) $value
2445                }
2446            }
2447        }
2448
2449        # If version was specified, save it as a version glob for use
2450        # in port actions (e.g. clean).
2451        if {[string length $portversion]} {
2452            set options(ports_version_glob) $portversion
2453        }
2454        if {[catch {set workername [mportopen $porturl [array get options] [array get variations]]} result]} {
2455            global errorInfo
2456            ui_debug "$errorInfo"
2457            break_softcontinue "Unable to open port: $result" 1 status
2458        }
2459        if {[catch {set result [mportexec $workername $target]} result]} {
2460            global errorInfo
2461            mportclose $workername
2462            ui_debug "$errorInfo"
2463            break_softcontinue "Unable to execute port: $result" 1 status
2464        }
2465
2466        mportclose $workername
2467       
2468        # Process any error that wasn't thrown and handled already
2469        if {$result} {
2470            break_softcontinue "Status $result encountered during processing." 1 status
2471        }
2472    }
2473   
2474    return $status
2475}
2476
2477
2478proc action_exit { action portlist opts } {
2479    # Return a semaphore telling the main loop to quit
2480    return -999
2481}
2482
2483
2484##########################################
2485# Command Parsing
2486##########################################
2487proc moreargs {} {
2488    global cmd_argn cmd_argc
2489    return [expr {$cmd_argn < $cmd_argc}]
2490}
2491
2492
2493proc lookahead {} {
2494    global cmd_argn cmd_argc cmd_argv
2495    if {$cmd_argn < $cmd_argc} {
2496        return [lindex $cmd_argv $cmd_argn]
2497    } else {
2498        return _EOF_
2499    }
2500}
2501
2502
2503proc advance {} {
2504    global cmd_argn
2505    incr cmd_argn
2506}
2507
2508
2509proc match s {
2510    if {[lookahead] == $s} {
2511        advance
2512        return 1
2513    }
2514    return 0
2515}
2516
2517# action_array specifies which action to run on the given command
2518# and if the action wants an expanded portlist.
2519# The value is a list of the form {action expand},
2520# where action is a string and expand a value:
2521#   0 none        Does not expect any text argument
2522#   1 strings     Expects some strings as text argument
2523#   2 ports       Wants an expanded list of ports as text argument
2524# Use action_args_const to translate them
2525global action_array
2526proc action_args_const {arg} {
2527    switch -- $arg {
2528        none {
2529            return 0
2530        }
2531        strings {
2532            return 1
2533        }
2534        default -
2535        ports {
2536            return 2
2537        }
2538    }
2539}
2540array set action_array [list \
2541    usage       [list action_usage          [action_args_const strings]] \
2542    help        [list action_help           [action_args_const strings]] \
2543    \
2544    echo        [list action_echo           [action_args_const ports]] \
2545    \
2546    info        [list action_info           [action_args_const ports]] \
2547    location    [list action_location       [action_args_const ports]] \
2548    provides    [list action_provides       [action_args_const strings]] \
2549    \
2550    activate    [list action_activate       [action_args_const ports]] \
2551    deactivate  [list action_deactivate     [action_args_const ports]] \
2552    \
2553    sync        [list action_sync           [action_args_const none]] \
2554    selfupdate  [list action_selfupdate     [action_args_const none]] \
2555    \
2556    upgrade     [list action_upgrade        [action_args_const ports]] \
2557    \
2558    version     [list action_version        [action_args_const none]] \
2559    platform    [list action_platform       [action_args_const none]] \
2560    compact     [list action_compact        [action_args_const ports]] \
2561    uncompact   [list action_uncompact      [action_args_const ports]] \
2562    \
2563    uninstall   [list action_uninstall      [action_args_const ports]] \
2564    \
2565    installed   [list action_installed      [action_args_const ports]] \
2566    outdated    [list action_outdated       [action_args_const ports]] \
2567    contents    [list action_contents       [action_args_const ports]] \
2568    dependents  [list action_dependents     [action_args_const ports]] \
2569    deps        [list action_deps           [action_args_const ports]] \
2570    variants    [list action_variants       [action_args_const ports]] \
2571    \
2572    search      [list action_search         [action_args_const strings]] \
2573    list        [list action_list           [action_args_const ports]] \
2574    \
2575    ed          [list action_portcmds       [action_args_const ports]] \
2576    edit        [list action_portcmds       [action_args_const ports]] \
2577    cat         [list action_portcmds       [action_args_const ports]] \
2578    dir         [list action_portcmds       [action_args_const ports]] \
2579    work        [list action_portcmds       [action_args_const ports]] \
2580    cd          [list action_portcmds       [action_args_const ports]] \
2581    url         [list action_portcmds       [action_args_const ports]] \
2582    file        [list action_portcmds       [action_args_const ports]] \
2583    gohome      [list action_portcmds       [action_args_const ports]] \
2584    \
2585    fetch       [list action_target         [action_args_const ports]] \
2586    checksum    [list action_target         [action_args_const ports]] \
2587    extract     [list action_target         [action_args_const ports]] \
2588    patch       [list action_target         [action_args_const ports]] \
2589    configure   [list action_target         [action_args_const ports]] \
2590    build       [list action_target         [action_args_const ports]] \
2591    destroot    [list action_target         [action_args_const ports]] \
2592    install     [list action_target         [action_args_const ports]] \
2593    clean       [list action_target         [action_args_const ports]] \
2594    test        [list action_target         [action_args_const ports]] \
2595    lint        [list action_target         [action_args_const ports]] \
2596    submit      [list action_target         [action_args_const ports]] \
2597    trace       [list action_target         [action_args_const ports]] \
2598    livecheck   [list action_target         [action_args_const ports]] \
2599    distcheck   [list action_target         [action_args_const ports]] \
2600    mirror      [list action_target         [action_args_const ports]] \
2601    load        [list action_target         [action_args_const ports]] \
2602    unload      [list action_target         [action_args_const ports]] \
2603    distfiles   [list action_target         [action_args_const ports]] \
2604    \
2605    archive     [list action_target         [action_args_const ports]] \
2606    unarchive   [list action_target         [action_args_const ports]] \
2607    dmg         [list action_target         [action_args_const ports]] \
2608    mdmg        [list action_target         [action_args_const ports]] \
2609    dpkg        [list action_target         [action_args_const ports]] \
2610    mpkg        [list action_target         [action_args_const ports]] \
2611    pkg         [list action_target         [action_args_const ports]] \
2612    rpm         [list action_target         [action_args_const ports]] \
2613    srpm        [list action_target         [action_args_const ports]] \
2614    \
2615    quit        [list action_exit           [action_args_const none]] \
2616    exit        [list action_exit           [action_args_const none]] \
2617]
2618
2619proc find_action_proc { action } {
2620    global action_array
2621   
2622    set action_proc ""
2623    if { [info exists action_array($action)] } {
2624        set action_proc [lindex $action_array($action) 0]
2625    }
2626   
2627    return $action_proc
2628}
2629
2630# Returns whether an action expects text arguments at all,
2631# expects text arguments or wants an expanded list of ports
2632# Return value:
2633#   0 none        Does not expect any text argument
2634#   1 strings     Expects some strings as text argument
2635#   2 ports       Wants an expanded list of ports as text argument
2636# Use action_args_const to translate them
2637proc action_needs_portlist { action } {
2638    global action_array
2639
2640    set ret 0
2641    if {[info exists action_array($action)]} {
2642        set ret [lindex $action_array($action) 1]
2643    }
2644
2645    return $ret
2646}
2647
2648# cmd_opts_array specifies which arguments the commands accept
2649# Commands not listed here do not accept any arguments
2650# Syntax if {option argn}
2651# Where option is the name of the option and argn specifies how many arguments
2652# this argument takes
2653global cmd_opts_array
2654array set cmd_opts_array {
2655    edit        {{editor 1}}
2656    ed          {{editor 1}}
2657    info        {category categories depends_build depends_lib depends_run
2658                 depends description epoch homepage index line long_description
2659                 maintainer maintainers name platform platforms portdir
2660                 revision variant variants version}
2661    search      {line}
2662    selfupdate  {nosync pretend}
2663    uninstall   {follow-dependents}
2664    variants    {index}
2665    clean       {all archive dist work}
2666    mirror      {new}
2667}
2668
2669##
2670# Checks whether the given option is valid
2671#
2672# œparam action for which action
2673# @param option the option to check
2674# @param upoptargc reference to upvar for storing the number of arguments for
2675#                  this option
2676proc cmd_option_exists { action option {upoptargc ""}} {
2677    global cmd_opts_array
2678    upvar 1 $upoptargc optargc
2679
2680    # This could be so easy with lsearch -index,
2681    # but that's only available as of Tcl 8.5
2682
2683    if {![info exists cmd_opts_array($action)]} {
2684        return 0
2685    }
2686
2687    foreach item $cmd_opts_array($action) {
2688        if {[llength $item] == 1} {
2689            set name $item
2690            set argc 0
2691        } else {
2692            set name [lindex $item 0]
2693            set argc [lindex $item 1]
2694        }
2695
2696        if {$name == $option} {
2697            set optargc $argc
2698            return 1
2699        }
2700    }
2701
2702    return 0
2703}
2704
2705# Parse global options
2706#
2707# Note that this is called several times:
2708#   (1) Initially, to parse options that will be constant across all commands
2709#       (options that come prior to any command, frozen into global_options_base)
2710#   (2) Following each command (to parse options that will be unique to that command
2711#       (the global_options array is reset to global_options_base prior to each command)
2712#
2713proc parse_options { action ui_options_name global_options_name } {
2714    upvar $ui_options_name ui_options
2715    upvar $global_options_name global_options
2716    global cmdname cmd_opts_array
2717   
2718    while {[moreargs]} {
2719        set arg [lookahead]
2720       
2721        if {[string index $arg 0] != "-"} {
2722            break
2723        } elseif {[string index $arg 1] == "-"} {
2724            # Process long arguments
2725            switch -- $arg {
2726                -- { # This is the options terminator; do no further option processing
2727                    advance; break
2728                }
2729                default {
2730                    set key [string range $arg 2 end]
2731                    set kargc 0
2732                    if {![cmd_option_exists $action $key kargc]} {
2733                        return -code error "${action} does not accept --${key}"
2734                    }
2735                    if {$kargc == 0} {
2736                        set global_options(ports_${action}_${key}) yes
2737                    } else {
2738                        set args {}
2739                        while {[moreargs] && $kargc > 0} {
2740                            advance
2741                            lappend args [lookahead]
2742                            set kargc [expr $kargc - 1]
2743                        }
2744                        if {$kargc > 0} {
2745                            return -code error "--${key} expects [expr $kargc + [llength $args]] parameters!"
2746                        }
2747                        set global_options(ports_${action}_${key}) $args
2748                    }
2749                }
2750            }
2751        } else {
2752            # Process short arg(s)
2753            set opts [string range $arg 1 end]
2754            foreach c [split $opts {}] {
2755                switch -- $c {
2756                    v {
2757                        set ui_options(ports_verbose) yes
2758                    }
2759                    d {
2760                        set ui_options(ports_debug) yes
2761                        # debug implies verbose
2762                        set ui_options(ports_verbose) yes
2763                    }
2764                    q {
2765                        set ui_options(ports_quiet) yes
2766                        set ui_options(ports_verbose) no
2767                        set ui_options(ports_debug) no
2768                    }
2769                    i {
2770                        # Always go to interactive mode
2771                        lappend ui_options(ports_commandfiles) -
2772                    }
2773                    p {
2774                        # Ignore errors while processing within a command
2775                        set ui_options(ports_processall) yes
2776                    }
2777                    x {
2778                        # Exit with error from any command while in batch/interactive mode
2779                        set ui_options(ports_exit) yes
2780                    }
2781
2782                    f {
2783                        set global_options(ports_force) yes
2784                    }
2785                    o {
2786                        set global_options(ports_ignore_older) yes
2787                    }
2788                    n {
2789                        set global_options(ports_nodeps) yes
2790                    }
2791                    u {
2792                        set global_options(port_uninstall_old) yes
2793                    }
2794                    R {
2795                        set global_options(ports_do_dependents) yes
2796                    }
2797                    s {
2798                        set global_options(ports_source_only) yes
2799                    }
2800                    b {
2801                        set global_options(ports_binary_only) yes
2802                    }
2803                    c {
2804                        set global_options(ports_autoclean) yes
2805                    }
2806                    k {
2807                        set global_options(ports_autoclean) no
2808                    }
2809                    t {
2810                        set global_options(ports_trace) yes
2811                    }
2812                    F {
2813                        # Name a command file to process
2814                        advance
2815                        if {[moreargs]} {
2816                            lappend ui_options(ports_commandfiles) [lookahead]
2817                        }
2818                    }
2819                    D {
2820                        advance
2821                        if {[moreargs]} {
2822                            cd [lookahead]
2823                        }
2824                        break
2825                    }
2826                    default {
2827                        print_usage; exit 1
2828                    }
2829                }
2830            }
2831        }
2832
2833        advance
2834    }
2835}
2836
2837
2838proc process_cmd { argv } {
2839    global cmd_argc cmd_argv cmd_argn
2840    global global_options global_options_base private_options ui_options
2841    global current_portdir
2842    set cmd_argv $argv
2843    set cmd_argc [llength $argv]
2844    set cmd_argn 0
2845
2846    set action_status 0
2847
2848    # Process an action if there is one
2849    while {$action_status == 0 && [moreargs]} {
2850        set action [lookahead]
2851        advance
2852       
2853        # Handle command separator
2854        if { $action == ";" } {
2855            continue
2856        }
2857       
2858        # Handle a comment
2859        if { [string index $action 0] == "#" } {
2860            while { [moreargs] } { advance }
2861            break
2862        }
2863       
2864        # Always start out processing an action in current_portdir
2865        cd $current_portdir
2866       
2867        # Reset global_options from base before each action, as we munge it just below...
2868        array set global_options $global_options_base
2869       
2870        # Find an action to execute
2871        set action_proc [find_action_proc $action]
2872        if { $action_proc == "" } {
2873            puts "Unrecognized action \"$action\""
2874            set action_status 1
2875            break
2876        }
2877
2878        # Parse options that will be unique to this action
2879        # (to avoid abiguity with -variants and a default port, either -- must be
2880        # used to terminate option processing, or the pseudo-port current must be specified).
2881        if {[catch {parse_options $action ui_options global_options} result]} {
2882            global errorInfo
2883            ui_debug "$errorInfo"
2884            ui_error $result
2885            set action_status 1
2886            break
2887        }
2888
2889        # What kind of arguments does the command expect?
2890        set expand [action_needs_portlist $action]
2891
2892        # Parse action arguments, setting a special flag if there were none
2893        # We otherwise can't tell the difference between arguments that evaluate
2894        # to the empty set, and the empty set itself.
2895        set portlist {}
2896        switch -- [lookahead] {
2897            ;       -
2898            _EOF_ {
2899                set private_options(ports_no_args) yes
2900            }
2901            default {
2902                if {[action_args_const none] == $expand} {
2903                    ui_error "$action does not accept string arguments"
2904                    set action_status 1
2905                    break
2906                } elseif {[action_args_const strings] == $expand} {
2907                    while { [moreargs] && ![match ";"] } {
2908                        lappend portlist [lookahead]
2909                        advance
2910                    }
2911                } elseif {[action_args_const ports] == $expand} {
2912                    # Parse port specifications into portlist
2913                    if {![portExpr portlist]} {
2914                        ui_error "Improper expression syntax while processing parameters"
2915                        set action_status 1
2916                        break
2917                    }
2918                }
2919            }
2920        }
2921       
2922        # execute the action
2923        set action_status [$action_proc $action $portlist [array get global_options]]
2924
2925        # semaphore to exit
2926        if {$action_status == -999} break
2927
2928        # If we're not in exit mode then ignore the status from the command
2929        if { ![macports::ui_isset ports_exit] } {
2930            set action_status 0
2931        }
2932    }
2933   
2934    return $action_status
2935}
2936
2937
2938proc complete_portname { text state } { 
2939    global complete_choices complete_position
2940   
2941    if {$state == 0} {
2942        set complete_position 0
2943        set complete_choices {}
2944
2945        # Build a list of ports with text as their prefix
2946        if {[catch {set res [mportsearch "${text}*" false glob]} result]} {
2947            global errorInfo
2948            ui_debug "$errorInfo"
2949            fatal "search for portname $pattern failed: $result"
2950        }
2951        foreach {name info} $res {
2952            lappend complete_choices $name
2953        }
2954    }
2955   
2956    set word [lindex $complete_choices $complete_position]
2957    incr complete_position
2958   
2959    return $word
2960}
2961
2962
2963proc complete_action { text state } {   
2964    global action_array
2965    global complete_choices complete_position
2966
2967    if {$state == 0} {
2968        set complete_position 0
2969        set complete_choices [array names action_array "[string tolower $text]*"]
2970    }
2971
2972    set word [lindex $complete_choices $complete_position]
2973    incr complete_position
2974
2975    return $word
2976}
2977
2978
2979proc attempt_completion { text word start end } {
2980    # If the word starts with '~', or contains '.' or '/', then use the build-in
2981    # completion to complete the word
2982    if { [regexp {^~|[/.]} $word] } {
2983        return ""
2984    }
2985
2986    # Decide how to do completion based on where we are in the string
2987    set prefix [string range $text 0 [expr $start - 1]]
2988   
2989    # If only whitespace characters preceed us, or if the
2990    # previous non-whitespace character was a ;, then we're
2991    # an action (the first word of a command)
2992    if { [regexp {(^\s*$)|(;\s*$)} $prefix] } {
2993        return complete_action
2994    }
2995   
2996    # Otherwise, do completion on portname
2997    return complete_portname
2998}
2999
3000
3001proc get_next_cmdline { in out use_readline prompt linename } {
3002    upvar $linename line
3003   
3004    set line ""
3005    while { $line == "" } {
3006
3007        if {$use_readline} {
3008            set len [readline read -attempted_completion attempt_completion line $prompt]
3009        } else {
3010            puts -nonewline $out $prompt
3011            flush $out
3012            set len [gets $in line]
3013        }
3014
3015        if { $len < 0 } {
3016            return -1
3017        }
3018       
3019        set line [string trim $line]
3020
3021        if { $use_readline && $line != "" } {
3022            rl_history add $line
3023        }
3024    }
3025   
3026    return [llength $line]
3027}
3028
3029
3030proc process_command_file { in } {
3031    global current_portdir
3032
3033    # Initialize readline
3034    set isstdin [string match $in "stdin"]
3035    set name "port"
3036    set use_readline [expr $isstdin && [readline init $name]]
3037    set history_file [file normalize "${macports::macports_user_dir}/history"]
3038
3039    # Read readline history
3040    if {$use_readline && [file isdirectory $macports::macports_user_dir]} {
3041        rl_history read $history_file
3042        rl_history stifle 100
3043    }
3044
3045    # Be noisy, if appropriate
3046    set noisy [expr $isstdin && ![macports::ui_isset ports_quiet]]
3047    if { $noisy } {
3048        puts "MacPorts [macports::version]"
3049        puts "Entering interactive mode... (\"help\" for help, \"quit\" to quit)"
3050    }
3051
3052    # Main command loop
3053    set exit_status 0
3054    while { $exit_status == 0 } {
3055
3056        # Calculate our prompt
3057        if { $noisy } {
3058            set shortdir [eval file join [lrange [file split $current_portdir] end-1 end]]
3059            set prompt "\[$shortdir\] > "
3060        } else {
3061            set prompt ""
3062        }
3063
3064        # Get a command line
3065        if { [get_next_cmdline $in stdout $use_readline $prompt line] <= 0  } {
3066            puts ""
3067            break
3068        }
3069
3070        # Process the command
3071        set exit_status [process_cmd $line]
3072       
3073        # Check for semaphore to exit
3074        if {$exit_status == -999} break
3075       
3076        # Ignore status unless we're in error-exit mode
3077        if { ![macports::ui_isset ports_exit] } {
3078            set exit_status 0
3079        }
3080    }
3081
3082    # Save readine history
3083    if {$use_readline && [file isdirectory $macports::macports_user_dir]} {
3084        rl_history write $history_file
3085    }
3086
3087    # Say goodbye
3088    if { $noisy } {
3089        puts "Goodbye"
3090    }
3091
3092    return $exit_status
3093}
3094
3095
3096proc process_command_files { filelist } {
3097    set exit_status 0
3098
3099    # For each file in the command list, process commands
3100    # in the file
3101    foreach file $filelist {
3102        if {$file == "-"} {
3103            set in stdin
3104        } else {
3105            if {[catch {set in [open $file]} result]} {
3106                fatal "Failed to open command file; $result"
3107            }
3108        }
3109
3110        set exit_status [process_command_file $in]
3111
3112        if {$in != "stdin"} {
3113            close $in
3114        }
3115
3116        # Check for semaphore to exit
3117        if {$exit_status == -999} {
3118            set exit_status 0
3119            break
3120        }
3121
3122        # Ignore status unless we're in error-exit mode
3123        if { ![macports::ui_isset ports_exit] } {
3124            set exit_status 0
3125        }
3126    }
3127
3128    return $exit_status
3129}
3130
3131
3132##########################################
3133# Main
3134##########################################
3135
3136# Global arrays passed to the macports1.0 layer
3137array set ui_options        {}
3138array set global_options    {}
3139array set global_variations {}
3140
3141# Global options private to this script
3142array set private_options {}
3143
3144# Make sure we get the size of the terminal
3145# We do this here to save it in the boot_env, in case we determined it manually
3146set_term_size
3147
3148# Save off a copy of the environment before mportinit monkeys with it
3149global env boot_env
3150array set boot_env [array get env]
3151
3152global argv0
3153global cmdname
3154set cmdname [file tail $argv0]
3155
3156# Setp cmd_argv to match argv
3157global argc argv
3158global cmd_argc cmd_argv cmd_argn
3159set cmd_argv $argv
3160set cmd_argc $argc
3161set cmd_argn 0
3162
3163# If we've been invoked as portf, then the first argument is assumed
3164# to be the name of a command file (i.e., there is an implicit -F
3165# before any arguments).
3166if {[moreargs] && $cmdname == "portf"} {
3167    lappend ui_options(ports_commandfiles) [lookahead]
3168    advance
3169}
3170
3171# Parse global options that will affect all subsequent commands
3172parse_options "global" ui_options global_options
3173
3174# Get arguments remaining after option processing
3175set remaining_args [lrange $cmd_argv $cmd_argn end]
3176
3177# Initialize mport
3178# This must be done following parse of global options, as some options are
3179# evaluated by mportinit.
3180if {[catch {mportinit ui_options global_options global_variations} result]} {
3181    global errorInfo
3182    puts "$errorInfo"
3183    fatal "Failed to initialize MacPorts, $result"
3184}
3185
3186# If we have no arguments remaining after option processing then force
3187# interactive mode
3188if { [llength $remaining_args] == 0 && ![info exists ui_options(ports_commandfiles)] } {
3189    lappend ui_options(ports_commandfiles) -
3190}
3191
3192# Set up some global state for our code
3193global current_portdir
3194set current_portdir [pwd]
3195
3196# Freeze global_options into global_options_base; global_options
3197# will be reset to global_options_base prior to processing each command.
3198global global_options_base
3199set global_options_base [array get global_options]
3200
3201# First process any remaining args as action(s)
3202set exit_status 0
3203if { [llength $remaining_args] > 0 } {
3204
3205    # If there are remaining arguments, process those as a command
3206
3207    # Exit immediately, by default, unless we're going to be processing command files
3208    if {![info exists ui_options(ports_commandfiles)]} {
3209        set ui_options(ports_exit) yes
3210    }
3211    set exit_status [process_cmd $remaining_args]
3212}
3213
3214# Process any prescribed command files, including standard input
3215if { $exit_status == 0 && [info exists ui_options(ports_commandfiles)] } {
3216    set exit_status [process_command_files $ui_options(ports_commandfiles)]
3217}
3218
3219# Return with exit_status
3220exit $exit_status
Note: See TracBrowser for help on using the repository browser.