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