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