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