Changeset 14


Ignore:
Timestamp:
May 22, 2009, 1:53:06 AM (16 years ago)
Author:
Dmitry A. Kuminov
Message:

configure.cmd: Generate qconfig.cpp; generate Makefile and qconfig.h for qmake.

File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/configure.cmd

    r11 r14  
    2828G.ScreenWidth   = -1
    2929G.ScreenHeight  = -1
    30 
     30G.Verbose       = 1
    3131
    3232/* initialize global variables */
    … …  
    4646G.EditionString = "Open Source"
    4747G.QT_EDITION    = "QT_EDITION_OPENSOURCE"
    48 
    49 /* So far, GCC only */
    50 G.PLATFORM      = "os2-g++"
    5148
    5249
    … …  
    10198    /* the directory of this script is the "source tree */
    10299    G.RelPath = G.ScriptDir
     100    /* the current directory is the "build tree" or "object tree" */
     101    G.OutPath = directory()
    103102
    104103    /* reset the vars file */
    … …  
    116115    /* QTDIR may be set and point to an old or system-wide Qt installation */
    117116    call UnsetEnv "QTDIR"
     117
     118    /* @todo cleanup the option list below when it's clear which options are
     119     * inappropriate for OS/2 */
    118120
    119121    /* initalize internal variables */
    … …  
    269271    G.QT_INSTALL_DATA = ""
    270272    G.QT_INSTALL_TRANSLATIONS = ""
    271     G.QT_INSTALL_SETTINGS = ""
    272273    G.QT_INSTALL_EXAMPLES = ""
    273274    G.QT_INSTALL_DEMOS = ""
    … …  
    411412    --------------------------------------------------------------------------*/
    412413
     414    /* so far, we default to GCC on OS/2 */
     415    if (G.PLATFORM == "") then G.PLATFORM = "os2-g++"
     416    if (DirExists(G.PLATFORM)) then G.QMAKESPEC = G.PLATFORM
     417    else G.QMAKESPEC = G.RelPath"\mkspecs\"G.PLATFORM
     418
     419    /* Cross-builds are not supported */
     420    G.XPLATFORM = G.PLATFORM
     421    G.XQMAKESPEC = G.QMAKESPEC
     422    G.QT_CROSS_COMPILE = "no"
     423
     424    /* check specified platforms are supported */
     425    if (\DirExists(G.XQMAKESPEC)) then do
     426        call SayErr
     427        call SayErr "   The specified system/compiler is not supported:"
     428        call SayErr
     429        call SayErr "      "G.XQMAKESPEC
     430        call SayErr
     431        call SayErr "   Please see the README file for a complete list."
     432        call SayErr
     433        call Done 2
     434    end
     435    if (\FileExists(G.XQMAKESPEC"\qplatformdefs.h")) then do
     436        call SayErr
     437        call SayErr "   The specified system/compiler port is not complete:"
     438        call SayErr
     439        call SayErr "      "G.XQMAKESPEC"\qplatformdefs.h"
     440        call SayErr
     441        call SayErr "   Please see the README file for a complete list."
     442        call SayErr
     443        call Done 2
     444    end
     445
     446    call SayVerbose "Determining system architecture..."
     447
     448    if (G.CFG_HOST_ARCH == "") then G.CFG_HOST_ARCH = "os2"
     449
     450    /* Cross-builds are not supported */
     451    G.CFG_ARCH = G.CFG_HOST_ARCH
     452
     453    if (DirExists(G.RelPath"\src\corelib\arch\"G.CFG_ARCH)) then
     454        call SayVerbose "    '"G.CFG_ARCH"' is supported"
     455    else do
     456        call SayVerbose "    '"G.CFG_ARCH"' is unsupported, using 'generic'"
     457        G.CFG_ARCH = "generic"
     458    end
     459
     460    call SayVerbose "System architecture: '"G.CFG_ARCH"'"
     461
     462    /*--------------------------------------------------------------------------
     463     tests that don't need qmake (must be run before displaying help)
     464    --------------------------------------------------------------------------*/
     465
     466    /* setup the build parts */
     467    if (G.CFG_BUILD_PARTS == "") then
     468        G.CFG_BUILD_PARTS = G.QT_DEFAULT_BUILD_PARTS
     469    do i = 1 to words(G.CFG_NOBUILD_PARTS)
     470        j = wordpos(word(G.CFG_NOBUILD_PARTS, i), G.CFG_BUILD_PARTS)
     471        if (j > 0)
     472            call delword G.CFG_BUILD_PARTS, j
     473    end
     474    if (wordpos("libs", G.CFG_BUILD_PARTS) == 0) then
     475        G.CFG_BUILD_PARTS = Join(G.CFG_BUILD_PARTS, "libs")
     476
     477    /*--------------------------------------------------------------------------
     478     post process QT_INSTALL_* variables
     479    --------------------------------------------------------------------------*/
     480
     481    /* prefix */
     482    if (G.QT_INSTALL_PREFIX == "") then
     483        G.QT_INSTALL_PREFIX = G.OutPath
     484    /* docs */
     485    if (G.QT_INSTALL_DOCS == "") then
     486        G.QT_INSTALL_DOCS = FixDirNoSlash(G.QT_INSTALL_PREFIX)"\docs"
     487    /* headers */
     488    if (G.QT_INSTALL_HEADERS == "") then
     489        G.QT_INSTALL_HEADERS = FixDirNoSlash(G.QT_INSTALL_PREFIX)"\include"
     490    /* libs */
     491    if (G.QT_INSTALL_LIBS == "") then
     492        G.QT_INSTALL_LIBS = FixDirNoSlash(G.QT_INSTALL_PREFIX)"\lib"
     493    /* bins */
     494    if (G.QT_INSTALL_BINS == "") then
     495        G.QT_INSTALL_BINS = FixDirNoSlash(G.QT_INSTALL_PREFIX)"\bin"
     496    /* plugins */
     497    if (G.QT_INSTALL_PLUGINS == "") then
     498        G.QT_INSTALL_PLUGINS = FixDirNoSlash(G.QT_INSTALL_PREFIX)"\plugins"
     499    /* data */
     500    if (G.QT_INSTALL_DATA == "") then
     501        G.QT_INSTALL_DATA = FixDirNoSlash(G.QT_INSTALL_PREFIX)"\data"
     502    /* translations */
     503    if (G.QT_INSTALL_TRANSLATIONS == "") then
     504        G.QT_INSTALL_TRANSLATIONS = FixDirNoSlash(G.QT_INSTALL_PREFIX)"\translations"
     505    /* examples */
     506    if (G.QT_INSTALL_EXAMPLES == "") then
     507        G.QT_INSTALL_EXAMPLES = FixDirNoSlash(G.QT_INSTALL_PREFIX)"\examples"
     508    /* demos */
     509    if (G.QT_INSTALL_DEMOS == "") then
     510        G.QT_INSTALL_DEMOS = FixDirNoSlash(G.QT_INSTALL_PREFIX)"\demos"
     511
     512    /*--------------------------------------------------------------------------
     513     help - interactive parts of the script _after_ this section please
     514    --------------------------------------------------------------------------*/
     515
     516    /* next, emit a usage message if something failed. */
     517    if (G.OPT_HELP == "yes") then do
     518        /* @todo */
     519        call SaySay "TODO: Help message"
     520    end
     521
     522    /* -------------------------------------------------------------------------
     523     LICENSING, INTERACTIVE PART
     524    --------------------------------------------------------------------------*/
     525
     526    call SaySay
     527    call SaySay "This is the Qt for OS/2 "G.EditionString" Edition."
     528    call SaySay
     529
     530    if (G.Edition == "OpenSource") then
     531        do while 1
     532            call SaySay "You are licensed to use this software under the terms of"
     533            call SaySay "the GNU General Public License (GPL) versions 3."
     534            call SaySay "You are also licensed to use this software under the terms of"
     535            call SaySay "the Lesser GNU General Public License (LGPL) versions 2.1."
     536            call SaySay
     537            if (G.OPT_CONFIRM_LICENSE == "yes") then do
     538                call SaySay "You have already accepted the terms of the license."
     539                acceptance = "yes"
     540            end
     541            else do
     542                    call SaySay "Type '3' to view the GNU General Public License version 3."
     543                call SaySay "Type 'L' to view the Lesser GNU General Public License version 2.1."
     544                call SaySay "Type 'yes' to accept this license offer."
     545                call SaySay "Type 'no' to decline this license offer."
     546                call SaySay
     547                call SaySay "Do you accept the terms of either license?"
     548                acceptance = InputLine()
     549            end
     550            if (acceptance == "yes") then
     551                leave
     552            else if (acceptance == "no") then do
     553                call SaySay "You are not licensed to use this software."
     554                call Done 1
     555            end
     556            else if (acceptance == "3") then
     557                address "cmd" "type" G.RelPath"\LICENSE.GPL3 | more"
     558            else if (acceptance == "L") then
     559                address "cmd" "type" G.RelPath"\LICENSE.LGPL | more"
     560            call SaySay
     561        end
     562    else
     563        signal Nonsense
     564
     565    /*--------------------------------------------------------------------------
     566     generate qconfig.cpp
     567    --------------------------------------------------------------------------*/
     568
     569    if (\DirExists(G.OutPath"\src\corelib\global")) then
     570        call MakeDir G.OutPath"\src\corelib\global"
     571
     572    qconfig_cpp = G.OutPath"\src\corelib\global\qconfig.cpp"
     573
     574    config_cpp_str =,
     575'/* License Info */'G.EOL||,
     576'static const char qt_configure_licensee_str          [260 + 12] = "qt_lcnsuser='CPPPath(MaxLen(G.Licensee,259))'";'G.EOL||,
     577'static const char qt_configure_licensed_products_str [260 + 12] = "qt_lcnsprod='CPPPath(MaxLen(G.Edition,259))'";'G.EOL||,
     578'/* Installation Info */'G.EOL||,
     579'static const char qt_configure_prefix_path_str       [260 + 12] = "qt_prfxpath='CPPPath(MaxLen(G.QT_INSTALL_PREFIX,259))'";'G.EOL||,
     580'static const char qt_configure_documentation_path_str[260 + 12] = "qt_docspath='CPPPath(MaxLen(G.QT_INSTALL_DOCS,259))'";'G.EOL||,
     581'static const char qt_configure_headers_path_str      [260 + 12] = "qt_hdrspath='CPPPath(MaxLen(G.QT_INSTALL_HEADERS,259))'";'G.EOL||,
     582'static const char qt_configure_libraries_path_str    [260 + 12] = "qt_libspath='CPPPath(MaxLen(G.QT_INSTALL_LIBS,259))'";'G.EOL||,
     583'static const char qt_configure_binaries_path_str     [260 + 12] = "qt_binspath='CPPPath(MaxLen(G.QT_INSTALL_BINS,259))'";'G.EOL||,
     584'static const char qt_configure_plugins_path_str      [260 + 12] = "qt_plugpath='CPPPath(MaxLen(G.QT_INSTALL_PLUGINS,259))'";'G.EOL||,
     585'static const char qt_configure_data_path_str         [260 + 12] = "qt_datapath='CPPPath(MaxLen(G.QT_INSTALL_DATA,259))'";'G.EOL||,
     586'static const char qt_configure_translations_path_str [260 + 12] = "qt_trnspath='CPPPath(MaxLen(G.QT_INSTALL_TRANSLATIONS,259))'";'G.EOL||,
     587'static const char qt_configure_examples_path_str     [260 + 12] = "qt_xmplpath='CPPPath(MaxLen(G.QT_INSTALL_EXAMPLES,259))'";'G.EOL||,
     588'static const char qt_configure_demos_path_str        [260 + 12] = "qt_demopath='CPPPath(MaxLen(G.QT_INSTALL_DEMOS,259))'";'G.EOL||,
     589'/* strlen( "qt_lcnsxxxx" ) == 12 */'G.EOL||,
     590'#define QT_CONFIGURE_LICENSEE qt_configure_licensee_str + 12;'G.EOL||,
     591'#define QT_CONFIGURE_LICENSED_PRODUCTS qt_configure_licensed_products_str + 12;'G.EOL||,
     592'#define QT_CONFIGURE_PREFIX_PATH qt_configure_prefix_path_str + 12;'G.EOL||,
     593'#define QT_CONFIGURE_DOCUMENTATION_PATH qt_configure_documentation_path_str + 12;'G.EOL||,
     594'#define QT_CONFIGURE_HEADERS_PATH qt_configure_headers_path_str + 12;'G.EOL||,
     595'#define QT_CONFIGURE_LIBRARIES_PATH qt_configure_libraries_path_str + 12;'G.EOL||,
     596'#define QT_CONFIGURE_BINARIES_PATH qt_configure_binaries_path_str + 12;'G.EOL||,
     597'#define QT_CONFIGURE_PLUGINS_PATH qt_configure_plugins_path_str + 12;'G.EOL||,
     598'#define QT_CONFIGURE_DATA_PATH qt_configure_data_path_str + 12;'G.EOL||,
     599'#define QT_CONFIGURE_TRANSLATIONS_PATH qt_configure_translations_path_str + 12;'G.EOL||,
     600'#define QT_CONFIGURE_EXAMPLES_PATH qt_configure_examples_path_str + 12;'G.EOL||,
     601'#define QT_CONFIGURE_DEMOS_PATH qt_configure_demos_path_str + 12;'G.EOL||,
     602G.EOL
     603
     604    /* avoid unecessary rebuilds by copying only if qconfig.cpp has changed */
     605    create = \FileExists(qconfig_cpp)
     606    if (\create) then create = CompareFileToVar(qconfig_cpp, config_cpp_str) \= 0
     607    if (create) then do
     608        call DeleteFile qconfig_cpp
     609        call charout qconfig_cpp, config_cpp_str
     610        call charout qconfig_cpp
     611    end
     612
     613    /*--------------------------------------------------------------------------
     614     build qmake
     615    --------------------------------------------------------------------------*/
     616
     617    call SaySay "Creating qmake. Please wait..."
     618
     619    /* take the correct Makefile and fix it */
     620    MakefilePlatform = G.RelPath"\qmake\Makefile."G.PLATFORM
     621    Makefile = G.OutPath"\qmake\Makefile"
     622
     623    Makefile_str = charin(MakefilePlatform, 1, chars(MakefilePlatform))
     624    if (Makefile_str == "") then do
     625        SayError "'"MakefilePlatform"' not found."
     626        call Done 1
     627    end
     628
     629    Makefile_str =,
     630        '# AutoGenerated by configure.cmd'G.EOL||,
     631        'BUILD_PATH = 'QuotePath(G.OutPath)||G.EOL||,
     632        'SOURCE_PATH = 'QuotePath(G.RelPath)||G.EOL||,
     633        'QMAKESPEC = 'G.PLATFORM||G.EOL||,
     634        'QMAKE_OPENSOURCE_EDITION = yes'G.EOL||G.EOL||,
     635        Makefile_str
     636
     637    /* avoid unecessary rebuilds by copying only if Makefile has changed */
     638    create = \FileExists(Makefile)
     639    if (\create) then create = CompareFileToVar(Makefile, Makefile_str) \= 0
     640    if (create) then do
     641        call DeleteFile Makefile
     642        call charout Makefile, Makefile_str
     643        call charout Makefile
     644    end
     645
     646    /* mkspecs/default is used as a (gasp!) default mkspec so QMAKESPEC needn't
     647     * be set once configured */
     648/*
     649@todo
     650*/
     651
     652    /* create temporary qconfig.h for compiling qmake, if it doesn't exist
     653     * when building qmake, we use #defines for the install paths,
     654     * however they are real functions in the library */
     655
     656    old_qconfig_h = ""
     657    qconfig_h = G.OutPath"\src\corelib\global\qconfig.h"
     658    qmake_qconfig_h = qconfig_h".qmake"
     659    if (FileExists(qconfig_h)) then do
     660         old_qconfig_h = qconfig_h
     661         call MoveFile old_qconfig_h, old_qconfig_h".old"
     662    end
     663
     664    if (\FileExists(qmake_qconfig_h)) then do
     665        call charout qmake_qconfig_h, '/* All features enabled while building qmake */'G.EOL
     666        call charout qmake_qconfig_h
     667    end
     668
     669    call MoveFile qmake_qconfig_h, qconfig_h
     670    list.1 = G.OutPath"\include\QtCore\qconfig.h"
     671    list.2 = G.OutPath"\include\Qt\qconfig.h"
     672    list.0 = 2
     673    do i = 1 to list.0
     674        if (\FileExists(list.i)) then do
     675            call charout list.i, '#include "..\..\src\corelib\global\qconfig.h"'G.EOL
     676            call charout list.i
     677        end
     678    end
     679
     680    curdir = directory(G.OutPath"\qmake")
     681    /* @todo enable make */
     682    say 'address' "cmd" G.MAKE
     683    make_rc = 0 /*rc*/
     684
     685    /* put back original qconfig.h */
     686    call MoveFile qconfig_h, qmake_qconfig_h
     687    if (old_qconfig_h \== "") then
     688        call MoveFile old_qconfig_h".old", old_qconfig_h
     689
     690    /* exit on failure */
     691    if (make_rc \= 0)  then
     692        call Done 2
     693
    413694    signal Nonsense
    414695    return
    … …  
    439720 utility functions
    440721------------------------------------------------------------------------------*/
     722
     723MaxLen: procedure expose (Globals)
     724    parse arg aStr, aMaxLen
     725    if (length(aStr) > aMaxLen) then return left(aStr,aMaxLen)
     726    return aStr
    441727
    442728CompareFileToVar: procedure expose (Globals)
    … …  
    474760    return
    475761
     762MoveFile: procedure expose (Globals)
     763    parse arg fileFrom, fileTo
     764    if (filespec('D', fileFrom) == filespec('D', fileTo)) then
     765        fileTo = filespec('P', fileTo)||filespec('N', fileTo)
     766    else do
     767        call SayErr 'FATAL: Could not move '''fileFrom''' to '''fileTo'''!'
     768        call SayErr 'Source and target are on different drives'
     769        call Done 1
     770    end
     771    call DeleteFile fileTo
     772    address 'cmd' 'move' fileFrom fileTo '1>nul 2>nul'
     773    if (rc \== 0) then do
     774        call SayErr 'FATAL: Could not move '''fileFrom''' to '''fileTo'''!'
     775        call SayErr 'move returned 'rc
     776        call Done 1
     777    end
     778    return
     779
    476780MakeDir: procedure expose (Globals)
     781    /* @todo teach it to create all non-existing intermediate dirs */
    477782    parse arg path
    478783    rc = SysMkDir(path)
    … …  
    503808    if (noeol) then call charout, '>>> 'str
    504809    else say '>>> 'str
     810    return
     811
     812SayVerbose: procedure expose (Globals)
     813    parse arg str, noeol
     814    if (G.Verbose) then call SaySay str, noeol
    505815    return
    506816
    … …  
    527837    parse value SysCurPos() with row col
    528838    col = col + delta
    529     row = row + (col % G.!ScreenWidth)
     839    row = row + (col % G.ScreenWidth)
    530840    if (col < 0) then
    531841        row = row - 1
    532     col = col // G.!ScreenWidth
     842    col = col // G.ScreenWidth
    533843    if (col < 0) then
    534         col = col + G.!ScreenWidth
     844        col = col + G.ScreenWidth
    535845    call SysCurPos row, col
    536846    return
    … …  
    572882
    573883    parse arg prompt, default, mode
    574     call SaySay prompt
     884
     885    if (length(prompt) > 0) then
     886        call SaySay prompt
    575887    say
    576888
    … …  
    7031015
    7041016/**
    705  *  Shows a Yes/No choice.
    706  *
    707  *  @param  prompt  prompt to show (specify '' to suppress the prompt)
    708  *  @param  default default choice:
    709  *      ''          - no default choice
    710  *      'Y' or 1    - default is yes
    711  *      other       - default is no
    712  *  @return
    713  *      1 if Yes is selected, otherwise 0
    714  */
    715 GetYesNo: procedure expose (Globals)
    716     parse arg prompt, default
    717     default = translate(default)
    718     if (default == 1) then default = 'Y'
    719     else if (default \== '' & default \== 'Y') then default = 'N'
    720     if (prompt \= '') then call SaySay prompt
    721     say
    722     call SayPrompt '[YN] ', 1
    723     yn = ReadChoice('YN',, default, 'I')
    724     say
    725     say
    726     return (yn == 'Y')
    727 
    728 /**
    729  *  Shows a menu of choices and returns the menu item number selected by the
    730  *  user. Letters in the mode argument have the following meanings:
    731  *
    732  *      E -- allow to press Enter w/o a choice (will return '')
    733  *      C -- ESC can be pressed to cancel selection (will return -1)
    734  *
    735  *  @param  prompt  prompt to display
    736  *  @param  stem    stem containing a list of choices
    737  *  @param  default default choice
    738  *  @param  mode    input mode string consisting of letters as described above
    739  *  @return
    740  *      selected menu item number
    741  */
    742 GetChoice: procedure expose (Globals)
    743     parse arg prompt, stem, default, mode
    744     mode = translate(mode)
    745     allowEnter = pos('E', mode) > 0
    746     allowESC = pos('C', mode) > 0
    747     count = value(stem'.0')
    748     if (count == 0) then return
    749     call SaySay prompt
    750     say
    751     first = 1
    752     do forever
    753         extChoices = ''
    754         last = first + 9
    755         if (last > count) then last = count
    756         choices = substr('1234567890', 1, last - first + 1)
    757         prompt = choices
    758         if (allowEnter) then prompt = prompt'/Enter'
    759         if (allowESC) then do
    760             prompt = prompt'/Esc'
    761             choices = choices||'1B'x
    762         end
    763         if (first > 1) then do
    764             extChoices = extChoices||'49'x
    765             prompt = prompt'/PgUp'
    766             call SaySay '^^'
    767         end
    768         do i = first to last
    769             ii = i - first + 1
    770             if (ii == 10) then ii = 0
    771             call SaySay ii')' value(stem'.'i)
    772         end
    773         if (last < count) then do
    774             extChoices = extChoices||'51'x
    775             prompt = prompt'/PgDn'
    776             call SaySay 'vv'
    777         end
    778         say
    779         def = ''
    780         if (default \== '') then do
    781             def = default - first + 1
    782             if (def < 1 | def > 10) then def = ''
    783             else if (def == 10) then def = 0
    784         end
    785         call SayPrompt '['prompt'] ', 1
    786         n = ReadChoice(choices, extChoices, def, mode)
    787         say
    788         say
    789         if (n == '1B'x) then do
    790             return -1
    791         end
    792         if (n == '0E49'x) then do
    793             first = first - 10
    794             iterate
    795         end
    796         if (n == '0E51'x) then do
    797             first = first + 10
    798             iterate
    799         end
    800         if (n \== '') then do
    801             if (n == 0) then n = 10
    802             n = n + first - 1
    803         end
    804         leave
    805     end
    806     return n
    807 
    808 /**
    809  *  Reads a one-key choice from the keyboard.
    810  *  user. Letters in the mode argument have the following meanings:
    811  *
    812  *      E -- allow to press Enter w/o a choice (will return '')
    813  *      C -- ESC can be pressed to cancel selection (will return '1B'x)
    814  *      I -- ignore case of pressed letters
    815  *
    816  *  @param  choices     string of allowed one-key choices
    817  *  @param  extChoices  string of allowed one-extended-key choices
    818  *  @param  default     default choice (can be a key from choices)
    819  *  @param  mode        input mode string consisting of letters as described above
    820  *  @return
    821  *      entered key (prefixed with 'E0'x if from extChoices)
    822  */
    823 ReadChoice: procedure expose (Globals)
    824     parse arg choices, extChoices, default, mode
    825     mode = translate(mode)
    826     ignoreCase = pos('I', mode) > 0
    827     allowEnter = pos('E', mode) > 0
    828     allowCancel = pos('C', mode) > 0
    829     choice = default
    830     call charout, choice
    831     if (ignoreCase) then choice = translate(choice)
    832     extended = 0
    833     do forever
    834         key = SysGetKey('NOECHO')
    835         if (key == 'E0'x) then do
    836             extended = 1
    837             iterate
    838         end
    839         if (\extended & ignoreCase) then key = translate(key)
    840         select
    841             when (allowCancel & \extended & key == '1B'x) then do
    842                 choice = key
    843                 leave
    844             end
    845             when (choice == '' & \extended & verify(key, choices) == 0) then do
    846                 choice = key
    847             end
    848             when (extended & verify(key, extChoices) == 0) then do
    849                 choice = '0E'x||key
    850                 leave
    851             end
    852             when (\extended & key == '08'x & choice \== '') then do
    853                 /* backspace pressed */
    854                 call charout, key' '
    855                 choice = ''
    856             end
    857             when (\extended & key == '0D'x & (choice \== '' | allowEnter)) then do
    858                 leave
    859             end
    860             otherwise do
    861                 extended = 0
    862                 iterate
    863             end
    864         end
    865         call charout, key
    866         extended = 0
    867     end
    868     return choice
    869 
    870 /**
    871  *  Shows a menu to select a path from the list of entries.
    872  *
    873  *  A special menu entry is automatically added as the last choice that allows
    874  *  to enter a new location to search for valid paths (this operation will
    875  *  completely overwrite all the menu entries passed to this function in the
    876  *  stem).
    877  *
    878  *  Letters in the mode argument have the following meanings:
    879  *
    880  *      C -- ESC can be pressed to cancel selection (will return '')
    881  *
    882  *  @param  stem
    883  *      stem containing entries to choose from (must be prefixed by a name from
    884  *      Globals), stem'.!choice' must contain a default choice (or '')
    885  *  @param  prompt
    886  *      prompt to display
    887  *  @param  searchPattern
    888  *      pattern to search for when selecting suitable paths in the new location
    889  *      (can include the directory prefix, but wildcards are supported in the
    890  *      filename part only)
    891  *  @param  checkPath
    892  *      name of the funciton to check the path. The first argument is the path
    893  *      to check. If the second argument is 0, it means a preliminary check (i.e.
    894  *      the path is the result of the SysFileThree procedure); checkPath must
    895  *      return a validated (and probably modified) path on success or '' if the
    896  *       path is invalid. If the second argument is 1, it's a final check
    897  *      (path is what returned by the preliminary check call); checkPath must
    898  *      return either 1 on success or 0 on failure. The final check is done
    899  *      right before calling checkVer, so it can set some global variables in
    900  *      order to pass necessary data to checkVer and to the global level for
    901  *      further configuration.
    902  *  @param  checkVer
    903  *      name of the funciton to check the version. The argument is a path to
    904  *      check the version for (as returned by checkPath after the preliminary
    905  *      check call).
    906  *  @param  errPath
    907  *      error message to display when a path check fails (%1 will be replaced
    908  *      with the failed path name)
    909  *  @param  mode
    910  *      input mode string consisting of letters as described above
    911  *  @return
    912  *      the selected path or '' if the selection was canceled.
    913  *      If a non-empty path is returned, stem'.!choice' will contain
    914  *      the selected item number, otherwise it will be empty.
    915  */
    916 MenuSelectPath: procedure expose (Globals)
    917 
    918     parse arg stem, prompt, searchPattern, checkPath, checkVer, errPath, mode
    919 
    920     mode = translate(mode)
    921     if (pos('C', mode) > 0) then mode = 'C'
    922     else mode = ''
    923 
    924     if (symbol('Static.!MenuSelectPath.!Recent') \= 'VAR') then
    925         Static.!MenuSelectPath.!Recent = ''
    926 
    927     do forever
    928 
    929         n = value(stem'.0') + 1
    930         call SysStemInsert stem, n, '[type a location...]'
    931         if (n == 1) then default = 1
    932         else default = value(stem'.!choice')
    933 
    934         choice = GetChoice(prompt, stem, default, mode)
    935         call SysStemDelete stem, n
    936 
    937         if (choice == -1) then return '' /* canceled */
    938 
    939         if (choice == n) then do
    940             call value stem'.!choice', ''
    941             path = InputDir('Enter a location where to start searching from ',
    942                             '(or Esc to cancel):',,
    943                             Static.!MenuSelectPath.!Recent)
    944             if (path == '') then iterate /* canceled */
    945             Static.!MenuSelectPath.!Recent = path
    946             call SaySay 'Please wait...'
    947             say
    948             patternPath = translate(filespec('D', searchPattern) || filespec('P', searchPattern))
    949             patternName = filespec('N', searchPattern)
    950             call SysFileTree FixDirNoSlash(path)'\'patternName, 'found', 'FSO'
    951             found2.0 = 0
    952             if (found.0 > 0) then do
    953                 do i = 1 to found.0
    954                     dir = filespec('D', found.i) || filespec('P', found.i)
    955                     /* check that the found path ends with the pattern path */
    956                     if (translate(right(dir, length(patternPath))) \== patternPath) then
    957                         iterate
    958                     dir = left(dir, length(dir) - length(patternPath))
    959                     /* check path validity  */
    960                     interpret 'dir = 'checkPath'("'dir'")'
    961                     if (dir \== '') then
    962                         call SysStemInsert 'found2', 1, FixDir(dir)
    963                 end
    964             end
    965             if (found2.0 > 0) then do
    966                 call SysStemCopy 'found2', stem
    967                 /* SysStemCopy is bogus and doesn't copy the count field... */
    968                 call value stem'.0', found2.0
    969                 call value stem'.!choice', ''
    970                 call value stem'.!changed', 1
    971                 iterate
    972             end
    973         end
    974         else do
    975             path = value(stem'.'choice)
    976             /* check path validity and tell the version check will be done next */
    977             interpret 'ok = 'checkPath'("'path'", 1)'
    978             if (ok) then do
    979                 if (value(stem'.!choice') \== choice) then
    980                     call value stem'.!changed', 1
    981                 interpret 'ok = 'checkVer'("'path'")'
    982                 if (ok) then do
    983                     call value stem'.!choice', choice
    984                     return path
    985                 end
    986                 call value stem'.!choice', ''
    987                 iterate
    988             end
    989         end
    990 
    991         call SayErr Replace(errPath, '%1', path)
    992         say
    993         call value stem'.!choice', ''
    994 
    995     end
    996 
    997 /**
    9981017 *  Encloses the given path with quotes if it contains
    9991018 *  space characters, otherwise returns it w/o changes.
    … …  
    13491368    parse arg code
    13501369    /* protect against recursive calls */
    1351     if (value('G.!Done_done') == 1) then exit code
    1352     call value 'G.!Done_done', 1
     1370    if (value('G.Done_done') == 1) then exit code
     1371    call value 'G.Done_done', 1
    13531372    /* cleanup stuff goes there */
    13541373    /* ... */
Note: See TracChangeset for help on using the changeset viewer.