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