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