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