libsim Versione 7.2.6
|
◆ optionparser_printhelphtmlform()
Print on stdout an html form reflecting the command line options set up. It can be called by the user program and it is called anyway if the program has been called with the
Definizione alla linea 1804 del file optionparser_class.F90. 1805! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
1806! authors:
1807! Davide Cesari <dcesari@arpa.emr.it>
1808! Paolo Patruno <ppatruno@arpa.emr.it>
1809
1810! This program is free software; you can redistribute it and/or
1811! modify it under the terms of the GNU General Public License as
1812! published by the Free Software Foundation; either version 2 of
1813! the License, or (at your option) any later version.
1814
1815! This program is distributed in the hope that it will be useful,
1816! but WITHOUT ANY WARRANTY; without even the implied warranty of
1817! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1818! GNU General Public License for more details.
1819!> Module for parsing command-line optons.
1820!! This module defines a class for parsing command-line arguments and
1821!! generating help messages similar to the one found in the Python
1822!! library.
1823!!
1824!! This is an example of use:
1825!! \include example_optionparser.F90
1826!!
1827!! \ingroup base
1828#include "config.h"
1829
1837IMPLICIT NONE
1838
1839
1840! private class
1841TYPE option
1842 CHARACTER(len=1) :: short_opt=''
1843 CHARACTER(len=80) :: long_opt=''
1844 INTEGER :: opttype=-1
1845 INTEGER :: need_arg=0 ! 0=no, 1=optional, 2=yes, was .FALSE.
1846 LOGICAL :: has_default=.false.
1847 CHARACTER(len=1),POINTER :: destc=>null()
1848 INTEGER :: destclen=0
1849 INTEGER :: helpformat=0 ! 0=txt, 1=markdown, 2=htmlform, improve!
1850 INTEGER,POINTER :: desti=>null()
1851 TYPE(arrayof_integer),POINTER :: destiarr=>null()
1852 REAL,POINTER :: destr=>null()
1853 TYPE(arrayof_real),POINTER :: destrarr=>null()
1854 DOUBLE PRECISION, POINTER :: destd=>null()
1855 TYPE(arrayof_doubleprecision),POINTER :: destdarr=>null()
1856 LOGICAL,POINTER :: destl=>null()
1857 TYPE(arrayof_logical),POINTER :: destlarr=>null()
1858 INTEGER,POINTER :: destcount=>null()
1859 INTEGER(kind=int_b),ALLOCATABLE :: help_msg(:)
1860END TYPE option
1861
1862#define ARRAYOF_ORIGTYPE TYPE(option)
1863#define ARRAYOF_TYPE arrayof_option
1864#define ARRAYOF_ORIGDESTRUCTOR(x) CALL option_delete(x)
1865#define ARRAYOF_PRIVATE 1
1866#include "arrayof_pre_nodoc.F90"
1867! from arrayof
1868!PUBLIC insert, append, remove, packarray
1869!PUBLIC insert_unique, append_unique
1870
1871!> This class allows to parse the command-line options of a program in
1872!! an object-oriented way, similarly to the optparse class found in
1873!! Python library.
1874!!
1875!! The class handles both GNU-style long options, introduced by a
1876!! double dash \c -- and containing any printable ASCII character
1877!! except the equal sign \c = , and the traditional Unix short
1878!! options, introduced by a single dash \c - and containing a single
1879!! character which can be any printable ASCII character except the
1880!! dash itself.
1881!!
1882!! Options may require an argument, which can be integer, real, double
1883!! precision or character, in that case the argument may be given in
1884!! any of the following ways (long and short options):
1885!!
1886!! - <tt>--lon=34.5</tt>
1887!! - <tt>--lon 34.5</tt>
1888!! - <tt>-l34.5</tt>
1889!! - <tt>-l 34.5</tt>
1890!!
1891!! By default, the argument to an option is compulsory, so any
1892!! following string, even empty or starting with a dash \c - , is
1893!! interpreted as the argument to the option, while its absence
1894!! (i.e. end of command line) determines an error condition in the
1895!! parsing phase. However the argument to character options can be
1896!! declared as optional in the corresponding definition method; in
1897!! those cases the following argument, if any, is interpreted as the
1898!! argument to the option only if it does not start with a dash \c -
1899!! (no chance to quote a dash in these cases); if no optional argument
1900!! is found, then the variable associated to the option is set to the
1901!! missing value of the corresponding type, without raising an error
1902!! condition.
1903!!
1904!! Array options (only for integer, real and double precision) must be
1905!! provided as comma-separated values, similarly to a record of a csv
1906!! file, an empty field generates a missing value of the proper type
1907!! in the resulting array, the length of the array is not a priori
1908!! limited.
1909!!
1910!! Grouping of short options, like \c -xvf is not allowed. When a
1911!! double dash \c -- or an argument (which is not an argument to an
1912!! option) not starting by a dash \c - is encountered, the parsing of
1913!! options stops and the management of the remaining arguments
1914!! (typically a list of files) is left to the calling program.
1915!!
1916!! Options can be of the following kinds:
1917!!
1918!! - character (with additional argument, possibly optional)
1919!! - integer (with additional argument)
1920!! - real (with additional argument)
1921!! - double precision (with additional argument)
1922!! - array of integer (with additional argument)
1923!! - array of real (with additional argument)
1924!! - array of double precision (with additional argument)
1925!! - logical (without additional argument)
1926!! - count (without additional argument)
1927!! - help (with additional optional argument)
1928!! - separator (without additional argument)
1929!!
1930!! If the same option is encountered multiple times on the command
1931!! line, the value set in the last occurrence takes precedence, the
1932!! only exception is count options where every repetition increments
1933!! the corresponding counter by one.
1934!!
1935!! Options are added through the generic \a optionparser_add method
1936!! (for character, integer, floating point or logical options,
1937!! including array variants) or through the specific methods \a
1938!! optionparser_add_count, \a optionparser_add_help \a
1939!! optionparser_add_sep (for count, help and separator options).
1940!!
1941!! The effect of command line parsing is to set some desired variables
1942!! according to the information provided on the command line.
1943!!
1944!! Array options set the values of objects of derived types \a
1945!! arrayof_integer, \a arrayof_real and \a arrayof_doubleprecision
1946!! which are dynamically growable 1-d arrays defined in the \a
1947!! array_utilities module.
1949 PRIVATE
1950 INTEGER(kind=int_b),POINTER :: usage_msg(:), description_msg(:)
1951 TYPE(arrayof_option) :: options
1952 LOGICAL :: httpmode=.false.
1954
1955
1956!> Add a new option of a specific type. Although the generic name
1957!! optionparser_add should be used, refer to the members of the interface
1958!! for a detailed documentation.
1960 MODULE PROCEDURE optionparser_add_c, optionparser_add_i, optionparser_add_r, &
1961 optionparser_add_d, optionparser_add_l, &
1962 optionparser_add_iarray, optionparser_add_rarray, optionparser_add_darray
1963END INTERFACE
1964
1965INTERFACE c_e
1966 MODULE PROCEDURE option_c_e
1967END INTERFACE
1968
1969!> Destructor for the optionparser class.
1970!! It destroys the \a optionparser object freeing all the associated
1971!! memory. The values assigned through command line parsing are
1972!! conserved after deleting the \a optionparser object, but it is not
1973!! possible to show the help with the optionparser_printhelp method.
1974!!
1975!! \param this TYPE(optionparser) object to be destroyed
1977 MODULE PROCEDURE optionparser_delete!?, option_delete
1978END INTERFACE
1979
1980
1981INTEGER,PARAMETER :: opttype_c = 1, opttype_i = 2, opttype_r = 3, &
1982 opttype_d = 4, opttype_l = 5, opttype_count = 6, opttype_help = 7, &
1983 opttype_sep = 8, opttype_carr = 11, opttype_iarr = 12, opttype_rarr = 13, &
1984 opttype_darr = 14, opttype_larr = 15
1985
1986INTEGER,PARAMETER :: optionparser_ok = 0 !< constants indicating the status returned by optionparser_parse, status of parsing: OK
1987INTEGER,PARAMETER :: optionparser_help = 1 !< status of parsing: help has been requested
1988INTEGER,PARAMETER :: optionparser_err = 2 !< status of parsing: an error was encountered
1989
1990
1991PRIVATE
1993 optionparser_add_count, optionparser_add_help, optionparser_add_sep, &
1994 optionparser_parse, optionparser_printhelp, &
1995 optionparser_ok, optionparser_help, optionparser_err
1996
1997
1998CONTAINS
1999
2000#include "arrayof_post_nodoc.F90"
2001
2002! Constructor for the option class
2003FUNCTION option_new(short_opt, long_opt, default, help) RESULT(this)
2004CHARACTER(len=*),INTENT(in) :: short_opt
2005CHARACTER(len=*),INTENT(in) :: long_opt
2006CHARACTER(len=*),INTENT(in) :: default
2007CHARACTER(len=*),OPTIONAL :: help
2008TYPE(option) :: this
2009
2010IF (short_opt == '' .AND. long_opt == '') THEN
2011#ifdef DEBUG
2012! programmer error condition, option empty
2013 CALL l4f_log(l4f_error, 'in optionparser, both short and long options empty')
2014 CALL raise_fatal_error()
2015#else
2016 CALL l4f_log(l4f_warn, 'in optionparser, both short and long options empty')
2017#endif
2018 RETURN
2019ENDIF
2020
2021this%short_opt = short_opt
2022this%long_opt = long_opt
2023IF (PRESENT(help)) THEN
2024 this%help_msg = fchar_to_cstr(trim(help)//trim(default)) ! f2003 automatic alloc
2025ENDIF
2026this%has_default = (len_trim(default) > 0)
2027
2028END FUNCTION option_new
2029
2030
2031! Destructor for the \a option class, the memory associated with
2032! the object is freed.
2033SUBROUTINE option_delete(this)
2034TYPE(option),INTENT(inout) :: this ! object to destroy
2035
2036IF (ALLOCATED(this%help_msg)) DEALLOCATE(this%help_msg)
2037NULLIFY(this%destc)
2038NULLIFY(this%desti)
2039NULLIFY(this%destr)
2040NULLIFY(this%destd)
2041NULLIFY(this%destl)
2042NULLIFY(this%destcount)
2043
2044END SUBROUTINE option_delete
2045
2046
2047FUNCTION option_found(this, optarg) RESULT(status)
2048TYPE(option),INTENT(inout) :: this
2049CHARACTER(len=*),INTENT(in),OPTIONAL :: optarg
2050INTEGER :: status
2051
2052TYPE(csv_record) :: arrparser
2053INTEGER :: ibuff
2054REAL :: rbuff
2055DOUBLE PRECISION :: dbuff
2056
2057status = optionparser_ok
2058
2059SELECT CASE(this%opttype)
2060CASE(opttype_c)
2061 CALL dirty_char_assignment(this%destc, this%destclen, trim(optarg))
2062! this%destc(1:this%destclen) = optarg
2063 IF (len_trim(optarg) > this%destclen) THEN
2064 CALL l4f_log(l4f_warn, &
2065 'in optionparser, argument '''//trim(optarg)//''' too long, truncated')
2066 ENDIF
2067CASE(opttype_i)
2068 READ(optarg,'(I12)',err=100)this%desti
2069CASE(opttype_iarr)
2072 DO WHILE(.NOT.csv_record_end(arrparser))
2074 CALL insert(this%destiarr, ibuff)
2075 ENDDO
2076 CALL packarray(this%destiarr)
2078CASE(opttype_r)
2079 READ(optarg,'(F20.0)',err=102)this%destr
2080CASE(opttype_rarr)
2083 DO WHILE(.NOT.csv_record_end(arrparser))
2085 CALL insert(this%destrarr, rbuff)
2086 ENDDO
2087 CALL packarray(this%destrarr)
2089CASE(opttype_d)
2090 READ(optarg,'(F20.0)',err=102)this%destd
2091CASE(opttype_darr)
2094 DO WHILE(.NOT.csv_record_end(arrparser))
2096 CALL insert(this%destdarr, dbuff)
2097 ENDDO
2098 CALL packarray(this%destdarr)
2100CASE(opttype_l)
2101 this%destl = .true.
2102CASE(opttype_count)
2103 this%destcount = this%destcount + 1
2104CASE(opttype_help)
2105 status = optionparser_help
2106 SELECT CASE(optarg) ! set help format
2107 CASE('md', 'markdown')
2108 this%helpformat = 1
2109 CASE('htmlform')
2110 this%helpformat = 2
2111 END SELECT
2112END SELECT
2113
2114RETURN
2115
2116100 status = optionparser_err
2117CALL l4f_log(l4f_error, &
2118 'in optionparser, argument '''//trim(optarg)//''' not valid as integer')
2119RETURN
2120102 status = optionparser_err
2121CALL l4f_log(l4f_error, &
2122 'in optionparser, argument '''//trim(optarg)//''' not valid as real')
2123RETURN
2124
2125END FUNCTION option_found
2126
2127
2128! Return a string which gives a short representation of the
2129! option \a this, without help message. The resulting string is quite
2130! long and it should be trimmed with the \a TRIM() intrinsic
2131! function.
2132FUNCTION option_format_opt(this) RESULT(format_opt)
2133TYPE(option),INTENT(in) :: this
2134
2135CHARACTER(len=100) :: format_opt
2136
2137CHARACTER(len=20) :: argname
2138
2139SELECT CASE(this%opttype)
2140CASE(opttype_c)
2141 argname = 'STRING'
2142CASE(opttype_i)
2143 argname = 'INT'
2144CASE(opttype_iarr)
2145 argname = 'INT[,INT...]'
2146CASE(opttype_r, opttype_d)
2147 argname = 'REAL'
2148CASE(opttype_rarr, opttype_darr)
2149 argname = 'REAL[,REAL...]'
2150CASE default
2151 argname = ''
2152END SELECT
2153
2154format_opt = ''
2155IF (this%short_opt /= '') THEN
2156 format_opt(len_trim(format_opt)+1:) = ' -'//this%short_opt
2157 IF (argname /= '') THEN
2158 format_opt(len_trim(format_opt)+1:) = ' '//trim(argname)
2159 ENDIF
2160ENDIF
2161IF (this%short_opt /= '' .AND. this%long_opt /= '') THEN
2162 format_opt(len_trim(format_opt)+1:) = ','
2163ENDIF
2164IF (this%long_opt /= '') THEN
2165 format_opt(len_trim(format_opt)+1:) = ' --'//this%long_opt
2166 IF (argname /= '') THEN
2167 format_opt(len_trim(format_opt)+1:) = '='//trim(argname)
2168 ENDIF
2169ENDIF
2170
2171END FUNCTION option_format_opt
2172
2173
2174! print on stdout a human-readable text representation of a single option
2175SUBROUTINE option_format_help(this, ncols)
2176TYPE(option),INTENT(in) :: this
2177INTEGER,INTENT(in) :: ncols
2178
2179INTEGER :: j
2180INTEGER, PARAMETER :: indent = 10
2181TYPE(line_split) :: help_line
2182
2183
2184IF (this%opttype == opttype_sep) THEN ! special treatment for separator type
2185 IF (ALLOCATED(this%help_msg)) THEN
2186! help2man is quite picky about the treatment of arbitrary lines
2187! within options, the only universal way seems to be unindented lines
2188! with an empty line before and after
2189 help_line = line_split_new(cstr_to_fchar(this%help_msg), ncols)
2190 WRITE(*,'()')
2191 DO j = 1, line_split_get_nlines(help_line)
2192 WRITE(*,'(A)')trim(line_split_get_line(help_line,j))
2193 ENDDO
2195 WRITE(*,'()')
2196 ENDIF
2197ELSE ! ordinary option
2198! print option brief representation
2199 WRITE(*,'(A)')trim(option_format_opt(this))
2200! print option help
2201 IF (ALLOCATED(this%help_msg)) THEN
2202 help_line = line_split_new(cstr_to_fchar(this%help_msg), ncols-indent)
2203 DO j = 1, line_split_get_nlines(help_line)
2204 WRITE(*,'(T10,A)')trim(line_split_get_line(help_line,j))
2205 ENDDO
2207 ENDIF
2208ENDIF
2209
2210END SUBROUTINE option_format_help
2211
2212
2213! print on stdout a markdown representation of a single option
2214SUBROUTINE option_format_md(this, ncols)
2215TYPE(option),INTENT(in) :: this
2216INTEGER,INTENT(in) :: ncols
2217
2218INTEGER :: j
2219INTEGER, PARAMETER :: indent = 2
2220TYPE(line_split) :: help_line
2221
2222IF (this%opttype == opttype_sep) THEN ! special treatment for separator type
2223 IF (ALLOCATED(this%help_msg)) THEN
2224 help_line = line_split_new(cstr_to_fchar(this%help_msg), ncols)
2225 WRITE(*,'()')
2226 DO j = 1, line_split_get_nlines(help_line)
2227 WRITE(*,'(A)')trim(line_split_get_line(help_line,j))
2228 ENDDO
2230 WRITE(*,'()')
2231 ENDIF
2232ELSE ! ordinary option
2233! print option brief representation
2234 WRITE(*,'(''`'',A,''`'')')trim(option_format_opt(this))
2235! print option help
2236 IF (ALLOCATED(this%help_msg)) THEN
2237 help_line = line_split_new(cstr_to_fchar(this%help_msg), ncols-indent)
2238 DO j = 1, line_split_get_nlines(help_line)
2239 WRITE(*,'(''> '',A)')trim(line_split_get_line(help_line,j))
2240 ENDDO
2242 WRITE(*,'()')
2243 ENDIF
2244ENDIF
2245
2246END SUBROUTINE option_format_md
2247
2248
2249! print on stdout an html form representation of a single option
2250SUBROUTINE option_format_htmlform(this)
2251TYPE(option),INTENT(in) :: this
2252
2253CHARACTER(len=80) :: opt_name, opt_id, opt_default ! check len of default
2254
2255IF (.NOT.c_e(this)) RETURN
2256IF (this%long_opt == '') THEN
2257 opt_name = this%short_opt
2258 opt_id = 'short_opt_'//this%short_opt
2259ELSE
2260 opt_name = this%long_opt
2261 opt_id = this%long_opt
2262ENDIF
2263
2264SELECT CASE(this%opttype)
2265CASE(opttype_c)
2266 CALL option_format_html_openspan('text')
2267
2268 IF (this%has_default .AND. ASSOCIATED(this%destc) .AND. this%destclen > 0) THEN
2269! opt_default = TRANSFER(this%destc(1:MIN(LEN(opt_default),this%destclen)), &
2270! opt_default) ! improve
2271 opt_default = ''
2272 WRITE(*,'(A)')' value="'//trim(opt_default)//'"'
2273 ENDIF
2274 CALL option_format_html_help()
2275 CALL option_format_html_closespan()
2276
2277CASE(opttype_i,opttype_r,opttype_d)
2278 CALL option_format_html_openspan('text')
2279 IF (this%has_default) THEN
2280 SELECT CASE(this%opttype)
2281 CASE(opttype_i)
2283! todo CASE(opttype_iarr)
2284 CASE(opttype_r)
2286 CASE(opttype_d)
2288 END SELECT
2289 ENDIF
2290 CALL option_format_html_help()
2291 CALL option_format_html_closespan()
2292
2293! todo CASE(opttype_iarr)
2294
2295CASE(opttype_l)
2296 CALL option_format_html_openspan('checkbox')
2297 CALL option_format_html_help()
2298 CALL option_format_html_closespan()
2299
2300CASE(opttype_count)
2301 CALL option_format_html_openspan('number')
2302 CALL option_format_html_help()
2303 CALL option_format_html_closespan()
2304
2305CASE(opttype_sep)
2306END SELECT
2307
2308
2309CONTAINS
2310
2311SUBROUTINE option_format_html_openspan(formtype)
2312CHARACTER(len=*),INTENT(in) :: formtype
2313
2314WRITE(*,'(A)')'<span class="libsim_optbox" id="span_'//trim(opt_id)//'">'//trim(opt_name)//':'
2315! size=? maxlen=?
2316WRITE(*,'(A)')'<input class_"libsim_opt" id="'//trim(opt_id)//'" type="'//formtype// &
2317 '" name="'//trim(opt_id)//'" '
2318
2319END SUBROUTINE option_format_html_openspan
2320
2321SUBROUTINE option_format_html_closespan()
2322
2323WRITE(*,'(A)')'/></span>'
2324
2325END SUBROUTINE option_format_html_closespan
2326
2327SUBROUTINE option_format_html_help()
2328INTEGER :: j
2329TYPE(line_split) :: help_line
2330CHARACTER(len=20) :: form
2331
2332IF (ALLOCATED(this%help_msg)) THEN
2333 WRITE(*,'(A,$)')' title="'
2334
2335 help_line = line_split_new(cstr_to_fchar(this%help_msg), 80)
2336 form = '(A,'' '')'
2337 DO j = 1, line_split_get_nlines(help_line)
2338 IF (j == line_split_get_nlines(help_line)) form = '(A,''"'',$)'
2339 WRITE(*,form)trim(line_split_get_line(help_line,j)) ! lines should be properly quoted here
2340 ENDDO
2341
2342ENDIF
2343
2344END SUBROUTINE option_format_html_help
2345
2346END SUBROUTINE option_format_htmlform
2347
2348
2349FUNCTION option_c_e(this) RESULT(c_e)
2350TYPE(option),INTENT(in) :: this
2351
2352LOGICAL :: c_e
2353
2354c_e = this%long_opt /= ' ' .OR. this%short_opt /= ' '
2355
2356END FUNCTION option_c_e
2357
2358
2359!> Create a new instance of an optionparser object.
2360!! General usage and description messages can be optionally provided,
2361!! the options will be added later.
2362FUNCTION optionparser_new(usage_msg, description_msg) RESULT(this)
2363CHARACTER(len=*), INTENT(in), OPTIONAL :: usage_msg !< short help message which describes the program usage, if not provided, a standard message will be printed
2364CHARACTER(len=*), INTENT(in), OPTIONAL :: description_msg !< long help message which describes the program purpose, if not provided, nothing will be printed
2365
2366TYPE(optionparser) :: this
2367
2368IF (PRESENT(usage_msg)) THEN
2369 CALL fchar_to_cstr_alloc(trim(usage_msg), this%usage_msg)
2370ELSE
2371 NULLIFY(this%usage_msg)
2372ENDIF
2373IF (PRESENT(description_msg)) THEN
2374 CALL fchar_to_cstr_alloc(trim(description_msg), this%description_msg)
2375ELSE
2376 NULLIFY(this%description_msg)
2377ENDIF
2378
2379END FUNCTION optionparser_new
2380
2381
2382SUBROUTINE optionparser_delete(this)
2383TYPE(optionparser),INTENT(inout) :: this
2384
2385IF (ASSOCIATED(this%usage_msg)) DEALLOCATE(this%usage_msg)
2386IF (ASSOCIATED(this%description_msg)) DEALLOCATE(this%description_msg)
2388
2389END SUBROUTINE optionparser_delete
2390
2391
2392!> Add a new option with a character type argument.
2393!! When parsing will be performed, if the requested option is
2394!! encountered, its corresponding compulsory argument will be copied
2395!! into the provided destination, truncating it if it is too long. An
2396!! optional default value can be provided for the destination. Please
2397!! use the generic \a optionparser_add method rather than this
2398!! particular method.
2399SUBROUTINE optionparser_add_c(this, short_opt, long_opt, dest, default, help, isopt)
2400TYPE(optionparser),INTENT(inout) :: this !< \a optionparser object
2401CHARACTER(len=*),INTENT(in) :: short_opt !< the short option (may be empty)
2402CHARACTER(len=*),INTENT(in) :: long_opt !< the long option (may be empty)
2403CHARACTER(len=*),TARGET :: dest !< the destination of the option parse result
2404CHARACTER(len=*),OPTIONAL :: default !< the default value to give to dest if option is not found
2405CHARACTER(len=*),OPTIONAL :: help !< the help message that will be formatted and pretty-printed on screen
2406LOGICAL,INTENT(in),OPTIONAL :: isopt !< if provided and \c .TRUE. the argument is considered optional
2407
2408CHARACTER(LEN=60) :: cdefault
2409INTEGER :: i
2410TYPE(option) :: myoption
2411
2412
2413IF (PRESENT(default)) THEN
2415ELSE
2416 cdefault = ''
2417ENDIF
2418
2419! common initialisation
2420myoption = option_new(short_opt, long_opt, cdefault, help)
2421IF (.NOT.c_e(myoption)) RETURN ! error in creating option, ignore it
2422
2423myoption%destc => dest(1:1)
2424myoption%destclen = len(dest) ! needed to avoid exceeding the length of dest
2425IF (PRESENT(default)) &
2426 CALL dirty_char_assignment(myoption%destc, myoption%destclen, default)
2427!IF (PRESENT(default)) myoption%destc(1:myoption%destclen) = default
2428myoption%opttype = opttype_c
2429IF (optio_log(isopt)) THEN
2430 myoption%need_arg = 1
2431ELSE
2432 myoption%need_arg = 2
2433ENDIF
2434
2435i = arrayof_option_append(this%options, myoption)
2436
2437END SUBROUTINE optionparser_add_c
2438
2439
2440!> Add a new option with an integer type argument.
2441!! When parsing will be performed, if the requested option is
2442!! encountered, its corresponding compulsory argument will be copied
2443!! into the provided destination. An optional default value can be
2444!! provided for the destination. Please use the generic \a
2445!! optionparser_add method rather than this particular method.
2446SUBROUTINE optionparser_add_i(this, short_opt, long_opt, dest, default, help)
2447TYPE(optionparser),INTENT(inout) :: this !< \a optionparser object
2448CHARACTER(len=*),INTENT(in) :: short_opt !< the short option (may be empty)
2449CHARACTER(len=*),INTENT(in) :: long_opt !< the long option (may be empty)
2450INTEGER,TARGET :: dest !< the destination of the option parse result
2451INTEGER,OPTIONAL :: default !< the default value to give to dest if option is not found
2452CHARACTER(len=*),OPTIONAL :: help !< the help message that will be formatted and pretty-printed on screen
2453
2454CHARACTER(LEN=40) :: cdefault
2455INTEGER :: i
2456TYPE(option) :: myoption
2457
2458IF (PRESENT(default)) THEN
2460ELSE
2461 cdefault = ''
2462ENDIF
2463
2464! common initialisation
2465myoption = option_new(short_opt, long_opt, cdefault, help)
2466IF (.NOT.c_e(myoption)) RETURN ! error in creating option, ignore it
2467
2468myoption%desti => dest
2469IF (PRESENT(default)) myoption%desti = default
2470myoption%opttype = opttype_i
2471myoption%need_arg = 2
2472
2473i = arrayof_option_append(this%options, myoption)
2474
2475END SUBROUTINE optionparser_add_i
2476
2477
2478!> Add a new option with an integer type array argument.
2479!! When parsing will be performed, if the requested option is
2480!! encountered, its corresponding compulsory argument will be copied
2481!! into the provided destination. The argument must be provided in the
2482!! form of comma-separated list of values and is stored in an object
2483!! of type arrayof_integer (module \a array_utilities). An optional
2484!! default value can be provided for the destination. Please use the
2485!! generic \a optionparser_add method rather than this particular
2486!! method.
2487SUBROUTINE optionparser_add_iarray(this, short_opt, long_opt, dest, default, help)
2488TYPE(optionparser),INTENT(inout) :: this !< \a optionparser object
2489CHARACTER(len=*),INTENT(in) :: short_opt !< the short option (may be empty)
2490CHARACTER(len=*),INTENT(in) :: long_opt !< the long option (may be empty)
2491TYPE(arrayof_integer),TARGET :: dest !< the destination of the option parse result
2492INTEGER,OPTIONAL :: default(:) !< the default value to give to dest if option is not found
2493CHARACTER(len=*),OPTIONAL :: help !< the help message that will be formatted and pretty-printed on screen
2494
2495CHARACTER(LEN=40) :: cdefault
2496INTEGER :: i
2497TYPE(option) :: myoption
2498
2499cdefault = ''
2500IF (PRESENT(default)) THEN
2501 IF (SIZE(default) == 1) THEN
2503 ELSE IF (SIZE(default) > 1) THEN
2505 ENDIF
2506ENDIF
2507
2508! common initialisation
2509myoption = option_new(short_opt, long_opt, cdefault, help)
2510IF (.NOT.c_e(myoption)) RETURN ! error in creating option, ignore it
2511
2512myoption%destiarr => dest
2513IF (PRESENT(default)) THEN
2514 CALL insert(myoption%destiarr, default)
2515 CALL packarray(myoption%destiarr)
2516ENDIF
2517myoption%opttype = opttype_iarr
2518myoption%need_arg = 2
2519
2520i = arrayof_option_append(this%options, myoption)
2521
2522END SUBROUTINE optionparser_add_iarray
2523
2524
2525!> Add a new option with a real type argument.
2526!! When parsing will be performed, if the requested option is
2527!! encountered, its corresponding compulsory argument will be copied
2528!! into the provided destination. An optional value default can be
2529!! provided for the destination. Please use the generic \a
2530!! optionparser_add method rather than this particular method.
2531SUBROUTINE optionparser_add_r(this, short_opt, long_opt, dest, default, help)
2532TYPE(optionparser),INTENT(inout) :: this !< \a optionparser object
2533CHARACTER(len=*),INTENT(in) :: short_opt !< the short option (may be empty)
2534CHARACTER(len=*),INTENT(in) :: long_opt !< the long option (may be empty)
2535REAL,TARGET :: dest !< the destination of the option parse result
2536REAL,OPTIONAL :: default !< the default value to give to dest if option is not found
2537CHARACTER(len=*),OPTIONAL :: help !< the help message that will be formatted and pretty-printed on screen
2538
2539CHARACTER(LEN=40) :: cdefault
2540INTEGER :: i
2541TYPE(option) :: myoption
2542
2543IF (PRESENT(default)) THEN
2545ELSE
2546 cdefault = ''
2547ENDIF
2548
2549! common initialisation
2550myoption = option_new(short_opt, long_opt, cdefault, help)
2551IF (.NOT.c_e(myoption)) RETURN ! error in creating option, ignore it
2552
2553myoption%destr => dest
2554IF (PRESENT(default)) myoption%destr = default
2555myoption%opttype = opttype_r
2556myoption%need_arg = 2
2557
2558i = arrayof_option_append(this%options, myoption)
2559
2560END SUBROUTINE optionparser_add_r
2561
2562
2563!> Add a new option with a real type array argument.
2564!! When parsing will be performed, if the requested option is
2565!! encountered, its corresponding compulsory argument will be copied
2566!! into the provided destination. The argument must be provided in the
2567!! form of comma-separated list of values and is stored in an object
2568!! of type arrayof_real (module \a array_utilities). An optional
2569!! default value can be provided for the destination. Please use the
2570!! generic \a optionparser_add method rather than this particular
2571!! method.
2572SUBROUTINE optionparser_add_rarray(this, short_opt, long_opt, dest, default, help)
2573TYPE(optionparser),INTENT(inout) :: this !< \a optionparser object
2574CHARACTER(len=*),INTENT(in) :: short_opt !< the short option (may be empty)
2575CHARACTER(len=*),INTENT(in) :: long_opt !< the long option (may be empty)
2576TYPE(arrayof_real),TARGET :: dest !< the destination of the option parse result
2577REAL,OPTIONAL :: default(:) !< the default value to give to dest if option is not found
2578CHARACTER(len=*),OPTIONAL :: help !< the help message that will be formatted and pretty-printed on screen
2579
2580CHARACTER(LEN=40) :: cdefault
2581INTEGER :: i
2582TYPE(option) :: myoption
2583
2584cdefault = ''
2585IF (PRESENT(default)) THEN
2586 IF (SIZE(default) == 1) THEN
2588 ELSE IF (SIZE(default) > 1) THEN
2590 ENDIF
2591ENDIF
2592
2593! common initialisation
2594myoption = option_new(short_opt, long_opt, cdefault, help)
2595IF (.NOT.c_e(myoption)) RETURN ! error in creating option, ignore it
2596
2597myoption%destrarr => dest
2598IF (PRESENT(default)) THEN
2599 CALL insert(myoption%destrarr, default)
2600 CALL packarray(myoption%destrarr)
2601ENDIF
2602myoption%opttype = opttype_rarr
2603myoption%need_arg = 2
2604
2605i = arrayof_option_append(this%options, myoption)
2606
2607END SUBROUTINE optionparser_add_rarray
2608
2609
2610!> Add a new option with a double precision type argument.
2611!! When parsing will be performed, if the requested option is
2612!! encountered, its corresponding compulsory argument will be copied
2613!! into the provided destination. An optional default value can be
2614!! provided for the destination. Please use the generic \a
2615!! optionparser_add method rather than this particular method.
2616SUBROUTINE optionparser_add_d(this, short_opt, long_opt, dest, default, help)
2617TYPE(optionparser),INTENT(inout) :: this !< \a optionparser object
2618CHARACTER(len=*),INTENT(in) :: short_opt !< the short option (may be empty)
2619CHARACTER(len=*),INTENT(in) :: long_opt !< the long option (may be empty)
2620DOUBLE PRECISION,TARGET :: dest !< the destination of the option parse result
2621DOUBLE PRECISION,OPTIONAL :: default !< the default value to give to dest if option is not found
2622CHARACTER(len=*),OPTIONAL :: help !< the help message that will be formatted and pretty-printed on screen
2623
2624CHARACTER(LEN=40) :: cdefault
2625INTEGER :: i
2626TYPE(option) :: myoption
2627
2628IF (PRESENT(default)) THEN
2629 IF (c_e(default)) THEN
2631 ELSE
2633 ENDIF
2634ELSE
2635 cdefault = ''
2636ENDIF
2637
2638! common initialisation
2639myoption = option_new(short_opt, long_opt, cdefault, help)
2640IF (.NOT.c_e(myoption)) RETURN ! error in creating option, ignore it
2641
2642myoption%destd => dest
2643IF (PRESENT(default)) myoption%destd = default
2644myoption%opttype = opttype_d
2645myoption%need_arg = 2
2646
2647i = arrayof_option_append(this%options, myoption)
2648
2649END SUBROUTINE optionparser_add_d
2650
2651
2652!> Add a new option with a double precision type array argument.
2653!! When parsing will be performed, if the requested option is
2654!! encountered, its corresponding compulsory argument will be copied
2655!! into the provided destination. The argument must be provided in the
2656!! form of comma-separated list of values and is stored in an object
2657!! of type arrayof_doubleprecision (module \a array_utilities). An optional
2658!! default value can be provided for the destination. Please use the
2659!! generic \a optionparser_add method rather than this particular
2660!! method.
2661SUBROUTINE optionparser_add_darray(this, short_opt, long_opt, dest, default, help)
2662TYPE(optionparser),INTENT(inout) :: this !< \a optionparser object
2663CHARACTER(len=*),INTENT(in) :: short_opt !< the short option (may be empty)
2664CHARACTER(len=*),INTENT(in) :: long_opt !< the long option (may be empty)
2665TYPE(arrayof_doubleprecision),TARGET :: dest !< the destination of the option parse result
2666DOUBLE PRECISION,OPTIONAL :: default(:) !< the default value to give to dest if option is not found
2667CHARACTER(len=*),OPTIONAL :: help !< the help message that will be formatted and pretty-printed on screen
2668
2669CHARACTER(LEN=40) :: cdefault
2670INTEGER :: i
2671TYPE(option) :: myoption
2672
2673cdefault = ''
2674IF (PRESENT(default)) THEN
2675 IF (SIZE(default) == 1) THEN
2677 ELSE IF (SIZE(default) > 1) THEN
2679 ENDIF
2680ENDIF
2681
2682! common initialisation
2683myoption = option_new(short_opt, long_opt, cdefault, help)
2684IF (.NOT.c_e(myoption)) RETURN ! error in creating option, ignore it
2685
2686myoption%destdarr => dest
2687IF (PRESENT(default)) THEN
2688 CALL insert(myoption%destdarr, default)
2689 CALL packarray(myoption%destdarr)
2690ENDIF
2691myoption%opttype = opttype_darr
2692myoption%need_arg = 2
2693
2694i = arrayof_option_append(this%options, myoption)
2695
2696END SUBROUTINE optionparser_add_darray
2697
2698
2699!> Add a new logical option, without optional argument.
2700!! When parsing will be performed, if the requested option is
2701!! encountered, the provided destination will be set to \a
2702!! .TRUE. . The provided destination is initially set to \a
2703!! .FALSE. . Please use the generic \a optionparser_add method
2704!! rather than this particular method.
2705SUBROUTINE optionparser_add_l(this, short_opt, long_opt, dest, help)
2706TYPE(optionparser),INTENT(inout) :: this !< \a optionparser object
2707CHARACTER(len=*),INTENT(in) :: short_opt !< the short option (may be empty)
2708CHARACTER(len=*),INTENT(in) :: long_opt !< the long option (may be empty)
2709LOGICAL,TARGET :: dest !< the destination of the option parse result
2710CHARACTER(len=*),OPTIONAL :: help !< the help message that will be formatted and pretty-printed on screen
2711
2712INTEGER :: i
2713TYPE(option) :: myoption
2714
2715! common initialisation
2716myoption = option_new(short_opt, long_opt, '', help)
2717IF (.NOT.c_e(myoption)) RETURN ! error in creating option, ignore it
2718
2719myoption%destl => dest
2720myoption%destl = .false. ! unconditionally set to false, option can only set it to true
2721myoption%opttype = opttype_l
2722myoption%need_arg = 0
2723
2724i = arrayof_option_append(this%options, myoption)
2725
2726END SUBROUTINE optionparser_add_l
2727
2728
2729!> Add a new counter option, without optional argument.
2730!! When parsing will be performed, the provided destination will be
2731!! incremented by one, starting from \a start, each time the requested
2732!! option is encountered.
2733SUBROUTINE optionparser_add_count(this, short_opt, long_opt, dest, start, help)
2734TYPE(optionparser),INTENT(inout) :: this !< \a optionparser object
2735CHARACTER(len=*),INTENT(in) :: short_opt !< the short option (may be empty)
2736CHARACTER(len=*),INTENT(in) :: long_opt !< the long option (may be empty)
2737INTEGER,TARGET :: dest !< the destination of the option parse result
2738INTEGER,OPTIONAL :: start !< initial value for \a dest
2739CHARACTER(len=*),OPTIONAL :: help !< the help message that will be formatted and pretty-printed on screen
2740
2741INTEGER :: i
2742TYPE(option) :: myoption
2743
2744! common initialisation
2745myoption = option_new(short_opt, long_opt, '', help)
2746IF (.NOT.c_e(myoption)) RETURN ! error in creating option, ignore it
2747
2748myoption%destcount => dest
2749IF (PRESENT(start)) myoption%destcount = start
2750myoption%opttype = opttype_count
2751myoption%need_arg = 0
2752
2753i = arrayof_option_append(this%options, myoption)
2754
2755END SUBROUTINE optionparser_add_count
2756
2757
2758!> Add a new help option, with an optional argument.
2759!! When parsing will be performed, the full help message will be
2760!! printed if this option is encountered. The message can be directly
2761!! printed as well by calling the optparser_printhelp method. The
2762!! optional argument given by the user to the option specifies the
2763!! format of the help message, it can be one fo the following:
2764!!
2765!! - \c txt or no extra argument: generic plain-text format suitable
2766!! for printing to screen and to be fed to the \c help2man command
2767!! for generating man pages
2768!! - <tt>md</tt> or <tt>markdown</tt>: print help in markdown format,
2769!! suitable for wiki/github/doxygen etc. pages
2770!! - <tt>htmlform</tt>: print help as an html form suitable for
2771!! providing the options through a web interface (experimental)
2772SUBROUTINE optionparser_add_help(this, short_opt, long_opt, help)
2773TYPE(optionparser),INTENT(inout) :: this !< \a optionparser object
2774CHARACTER(len=*),INTENT(in) :: short_opt !< the short option (may be empty)
2775CHARACTER(len=*),INTENT(in) :: long_opt !< the long option (may be empty)
2776CHARACTER(len=*),OPTIONAL :: help !< the help message that will be formatted and pretty-printed on screen
2777
2778INTEGER :: i
2779TYPE(option) :: myoption
2780
2781! common initialisation
2782myoption = option_new(short_opt, long_opt, '', help)
2783IF (.NOT.c_e(myoption)) RETURN ! error in creating option, ignore it
2784
2785myoption%opttype = opttype_help
2786myoption%need_arg = 1
2787
2788i = arrayof_option_append(this%options, myoption)
2789
2790END SUBROUTINE optionparser_add_help
2791
2792
2793!> Add a new separator option, with a text.
2794!! This is a dummy option that inserts a separator line with a text
2795!! within the list of options when the help is printed. It is useful
2796!! to insert a visual separator between options or an explanation
2797!! which is not associated with a specific options but applies to all
2798!! the subsequent options. The text provided will be formatted into
2799!! many lines if necessary. Any number of separator options can be
2800!! added within the option list; they have no effect on the
2801!! interpretation of the options associated with the optionparser
2802!! object.
2803SUBROUTINE optionparser_add_sep(this, help)
2804TYPE(optionparser),INTENT(inout) :: this !< \a optionparser object
2805!CHARACTER(len=*),INTENT(in) :: short_opt !< the short option (may be empty)
2806!CHARACTER(len=*),INTENT(in) :: long_opt !< the long option (may be empty)
2807CHARACTER(len=*) :: help !< the help message that will be formatted and pretty-printed on screen
2808
2809INTEGER :: i
2810TYPE(option) :: myoption
2811
2812! common initialisation
2813myoption = option_new('_', '_', '', help)
2814IF (.NOT.c_e(myoption)) RETURN ! error in creating option, ignore it
2815
2816myoption%opttype = opttype_sep
2817myoption%need_arg = 0
2818
2819i = arrayof_option_append(this%options, myoption)
2820
2821END SUBROUTINE optionparser_add_sep
2822
2823
2824!> This method performs the parsing of the command-line options
2825!! which have been previously added using the optionparser_add family
2826!! of methods. The destination variables set through the
2827!! optionparser_add methods are assigned according to the options
2828!! encountered on the command line. If any optional argument remains
2829!! after interpretation of all command-line options, the index of the
2830!! first of them is returned in \a nextarg, otherwise \a nextarg is
2831!! equal to \a iargc() \a + \a 1. The status of the parsing process
2832!! should be checked via the \a status argument.
2833SUBROUTINE optionparser_parse(this, nextarg, status)
2834TYPE(optionparser),INTENT(inout) :: this !< \a optionparser object with correctly initialised options
2835INTEGER,INTENT(out) :: nextarg !< index of the first optional argument after interpretation of all command-line options
2836INTEGER,INTENT(out) :: status !< status of the parsing process, to be compared with the constants \a optionparser_ok, ecc.
2837
2838INTEGER :: i, j, endopt, indeq, iargc
2839CHARACTER(len=16384) :: arg, optarg
2840
2841status = optionparser_ok
2842i = 1
2843DO WHILE(i <= iargc())
2844 CALL getarg(i, arg)
2845 IF (arg == '--') THEN ! explicit end of options
2846 i = i + 1 ! skip present option (--)
2847 EXIT
2848 ELSE IF (arg == '-') THEN ! a single - is not an option
2849 EXIT
2850 ELSE IF (arg(1:2) == '--') THEN ! long option
2852 IF (indeq /= 0) THEN ! = present
2853 endopt = indeq - 1
2854 ELSE ! no =
2855 endopt = len_trim(arg)
2856 ENDIF
2857 find_longopt: DO j = 1, this%options%arraysize
2858 IF (this%options%array(j)%long_opt == arg(3:endopt)) THEN ! found option
2859 SELECT CASE(this%options%array(j)%need_arg)
2860 CASE(2) ! compulsory
2861 IF (indeq /= 0) THEN
2862 optarg = arg(indeq+1:)
2863 status = max(option_found(this%options%array(j), optarg), &
2864 status)
2865 ELSE
2866 IF (i < iargc()) THEN
2867 i=i+1
2868 CALL getarg(i, optarg)
2869 status = max(option_found(this%options%array(j), optarg), &
2870 status)
2871 ELSE
2872 status = optionparser_err
2873 CALL l4f_log(l4f_error, &
2874 'in optionparser, option '''//trim(arg)//''' requires an argument')
2875 ENDIF
2876 ENDIF
2877 CASE(1) ! optional
2878 IF (indeq /= 0) THEN
2879 optarg = arg(indeq+1:)
2880 ELSE
2881 IF (i < iargc()) THEN
2882 CALL getarg(i+1, optarg)
2883 IF (optarg(1:1) == '-') THEN
2884 optarg = cmiss ! refused
2885 ELSE
2886 i=i+1 ! accepted
2887 ENDIF
2888 ELSE
2889 optarg = cmiss ! refused
2890 ENDIF
2891 ENDIF
2892 status = max(option_found(this%options%array(j), optarg), &
2893 status)
2894 CASE(0)
2895 status = max(option_found(this%options%array(j)), &
2896 status)
2897 END SELECT
2898 EXIT find_longopt
2899 ENDIF
2900 ENDDO find_longopt
2901 IF (j > this%options%arraysize) THEN
2902 status = optionparser_err
2903 CALL l4f_log(l4f_error, &
2904 'in optionparser, option '''//trim(arg)//''' not valid')
2905 ENDIF
2906 ELSE IF (arg(1:1) == '-') THEN ! short option
2907 find_shortopt: DO j = 1, this%options%arraysize
2908 IF (this%options%array(j)%short_opt == arg(2:2)) THEN ! found option
2909 SELECT CASE(this%options%array(j)%need_arg)
2910 CASE(2) ! compulsory
2911 IF (len_trim(arg) > 2) THEN
2912 optarg = arg(3:)
2913 status = max(option_found(this%options%array(j), optarg), &
2914 status)
2915 ELSE
2916 IF (i < iargc()) THEN
2917 i=i+1
2918 CALL getarg(i, optarg)
2919 status = max(option_found(this%options%array(j), optarg), &
2920 status)
2921 ELSE
2922 status = optionparser_err
2923 CALL l4f_log(l4f_error, &
2924 'in optionparser, option '''//trim(arg)//''' requires an argument')
2925 ENDIF
2926 ENDIF
2927 CASE(1) ! optional
2928 IF (len_trim(arg) > 2) THEN
2929 optarg = arg(3:)
2930 ELSE
2931 IF (i < iargc()) THEN
2932 CALL getarg(i+1, optarg)
2933 IF (optarg(1:1) == '-') THEN
2934 optarg = cmiss ! refused
2935 ELSE
2936 i=i+1 ! accepted
2937 ENDIF
2938 ELSE
2939 optarg = cmiss ! refused
2940 ENDIF
2941 ENDIF
2942 status = max(option_found(this%options%array(j), optarg), &
2943 status)
2944 CASE(0)
2945 status = max(option_found(this%options%array(j)), &
2946 status)
2947 END SELECT
2948 EXIT find_shortopt
2949 ENDIF
2950 ENDDO find_shortopt
2951 IF (j > this%options%arraysize) THEN
2952 status = optionparser_err
2953 CALL l4f_log(l4f_error, &
2954 'in optionparser, option '''//trim(arg)//''' not valid')
2955 ENDIF
2956 ELSE ! unrecognized = end of options
2957 EXIT
2958 ENDIF
2959 i = i + 1
2960ENDDO
2961
2962nextarg = i
2963SELECT CASE(status)
2964CASE(optionparser_err, optionparser_help)
2965 CALL optionparser_printhelp(this)
2966END SELECT
2967
2968END SUBROUTINE optionparser_parse
2969
2970
2971!> Print on stdout a human-readable text representation of the help message.
2972!! It can be called by the user program and it is called anyway in
2973!! case of error in the interpretation of the command line.
2974SUBROUTINE optionparser_printhelp(this)
2975TYPE(optionparser),INTENT(in) :: this !< \a optionparser object with correctly initialised options
2976
2977INTEGER :: i, form
2978
2979form = 0
2980DO i = 1, this%options%arraysize ! loop over options
2981 IF (this%options%array(i)%opttype == opttype_help) THEN
2982 form = this%options%array(i)%helpformat
2983 ENDIF
2984ENDDO
2985
2986SELECT CASE(form)
2987CASE(0)
2988 CALL optionparser_printhelptxt(this)
2989CASE(1)
2990 CALL optionparser_printhelpmd(this)
2991CASE(2)
2992 CALL optionparser_printhelphtmlform(this)
2993END SELECT
2994
2995END SUBROUTINE optionparser_printhelp
2996
2997
2998!> Print on stdout a human-readable text representation of the help message.
2999!! It can be called by the user program and it is called anyway in
3000!! case of error in the interpretation of the command line.
3001SUBROUTINE optionparser_printhelptxt(this)
3002TYPE(optionparser),INTENT(in) :: this !< \a optionparser object with correctly initialised options
3003
3004INTEGER :: i, j, ncols
3005CHARACTER(len=80) :: buf
3006TYPE(line_split) :: help_line
3007
3008ncols = default_columns()
3009
3010! print usage message
3011IF (ASSOCIATED(this%usage_msg)) THEN
3012 help_line = line_split_new(cstr_to_fchar(this%usage_msg), ncols)
3013 DO j = 1, line_split_get_nlines(help_line)
3014 WRITE(*,'(A)')trim(line_split_get_line(help_line,j))
3015 ENDDO
3017ELSE
3018 CALL getarg(0, buf)
3020 IF (buf(i+1:i+3) == 'lt-') i = i + 3 ! remove automake prefix
3021 WRITE(*,'(A)')'Usage: '//trim(buf(i+1:))//' [options] [arguments]'
3022ENDIF
3023
3024! print description message
3025IF (ASSOCIATED(this%description_msg)) THEN
3026 WRITE(*,'()')
3027 help_line = line_split_new(cstr_to_fchar(this%description_msg), ncols)
3028 DO j = 1, line_split_get_nlines(help_line)
3029 WRITE(*,'(A)')trim(line_split_get_line(help_line,j))
3030 ENDDO
3032ENDIF
3033
3034WRITE(*,'(/,A)')'Options:'
3035
3036DO i = 1, this%options%arraysize ! loop over options
3037 CALL option_format_help(this%options%array(i), ncols)
3038ENDDO
3039
3040END SUBROUTINE optionparser_printhelptxt
3041
3042
3043!> Print on stdout a markdown representation of the help message.
3044!! It can be called by the user program and it is called anyway if the
3045!! program has been called with the `--help md` option.
3046SUBROUTINE optionparser_printhelpmd(this)
3047TYPE(optionparser),INTENT(in) :: this !< \a optionparser object with correctly initialised options
3048
3049INTEGER :: i, j, ncols
3050CHARACTER(len=80) :: buf
3051TYPE(line_split) :: help_line
3052
3053ncols = default_columns()
3054
3055! print usage message
3056WRITE(*,'(A)')'### Synopsis'
3057
3058IF (ASSOCIATED(this%usage_msg)) THEN
3059 help_line = line_split_new(mdquote_usage_msg(cstr_to_fchar(this%usage_msg)), ncols)
3060 DO j = 1, line_split_get_nlines(help_line)
3061 WRITE(*,'(A)')trim(line_split_get_line(help_line,j))
3062 ENDDO
3064ELSE
3065 CALL getarg(0, buf)
3067 IF (buf(i+1:i+3) == 'lt-') i = i + 3 ! remove automake prefix
3068 WRITE(*,'(A)')'Usage: `'//trim(buf(i+1:))//' [options] [arguments]`'
3069ENDIF
3070
3071! print description message
3072IF (ASSOCIATED(this%description_msg)) THEN
3073 WRITE(*,'()')
3074 WRITE(*,'(A)')'### Description'
3075 help_line = line_split_new(cstr_to_fchar(this%description_msg), ncols)
3076 DO j = 1, line_split_get_nlines(help_line)
3077 WRITE(*,'(A)')trim(line_split_get_line(help_line,j))
3078 ENDDO
3080
3081ENDIF
3082
3083WRITE(*,'(/,A)')'### Options'
3084
3085DO i = 1, this%options%arraysize ! loop over options
3086 CALL option_format_md(this%options%array(i), ncols)
3087ENDDO
3088
3089CONTAINS
3090
3091FUNCTION mdquote_usage_msg(usage_msg)
3092CHARACTER(len=*),INTENT(in) :: usage_msg
3093
3094CHARACTER(len=LEN(usage_msg)+2) :: mdquote_usage_msg
3095INTEGER :: colon
3096
3098IF (colon > 0 .AND. colon < len(usage_msg)-1) THEN
3099 mdquote_usage_msg = usage_msg(:colon+1)//'`'//usage_msg(colon+2:)//'`'
3100ELSE
3101 mdquote_usage_msg = usage_msg
3102ENDIF
3103
3104END FUNCTION mdquote_usage_msg
3105
3106END SUBROUTINE optionparser_printhelpmd
3107
3108!> Print on stdout an html form reflecting the command line options set up.
3109!! It can be called by the user program and it is called anyway if the
3110!! program has been called with the `--help htmlform` option.
3111SUBROUTINE optionparser_printhelphtmlform(this)
3112TYPE(optionparser),INTENT(in) :: this !< \a optionparser object with correctly initialised options
3113
3114INTEGER :: i
3115
3116DO i = 1, this%options%arraysize ! loop over options
3117 CALL option_format_htmlform(this%options%array(i))
3118ENDDO
3119
3120WRITE(*,'(A)')'<input class="libsim_sub" type="submit" value="runprogram" />'
3121
3122END SUBROUTINE optionparser_printhelphtmlform
3123
3124
3125SUBROUTINE optionparser_make_completion(this)
3126TYPE(optionparser),INTENT(in) :: this !< \a optionparser object with correctly initialised options
3127
3128INTEGER :: i
3129CHARACTER(len=512) :: buf
3130
3131CALL getarg(0, buf)
3132
3133WRITE(*,'(A/A/A)')'_'//trim(buf)//'()','{','local cur'
3134
3135WRITE(*,'(A/A/A/A)')'COMPREPLY=()','cur=${COMP_WORDS[COMP_CWORD]}', &
3136 'case "$cur" in','-*)'
3137
3138!-*)
3139! COMPREPLY=( $( compgen -W
3140DO i = 1, this%options%arraysize ! loop over options
3141 IF (this%options%array(i)%need_arg == 2) THEN
3142 ENDIF
3143ENDDO
3144
3145WRITE(*,'(A/A/A)')'esac','return 0','}'
3146
3147END SUBROUTINE optionparser_make_completion
3148
3149
3150SUBROUTINE dirty_char_assignment(destc, destclen, src)
3152IMPLICIT NONE
3153
3154CHARACTER(len=1) :: destc(*)
3155CHARACTER(len=*) :: src
3156INTEGER :: destclen
3157
3158INTEGER :: i
3159
3160DO i = 1, min(destclen, len(src))
3161 destc(i) = src(i:i)
3162ENDDO
3163DO i = len(src)+1, destclen
3164 destc(i) = ' '
3165ENDDO
3166
3167END SUBROUTINE dirty_char_assignment
3168
Set of functions that return a trimmed CHARACTER representation of the input variable. Definition char_utilities.F90:278 Set of functions that return a CHARACTER representation of the input variable. Definition char_utilities.F90:253 Methods for successively obtaining the fields of a csv_record object. Definition file_utilities.F90:279 Destructor for the optionparser class. Definition optionparser_class.F90:297 Add a new option of a specific type. Definition optionparser_class.F90:412 This module defines usefull general purpose function and subroutine. Definition array_utilities.F90:212 Definition of constants to be used for declaring variables of a desired type. Definition kinds.F90:245 This class allows to parse the command-line options of a program in an object-oriented way,... Definition optionparser_class.F90:401 |