556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
572 use dc_string, only: stoa, stoi, printf, concat, joinchar, uchar, lchar
573 use dc_present, only: present_and_true
574 use dc_message, only: messagenotify
576 implicit none
577 type(ARGS), intent(inout) :: arg
578 logical, intent(in), optional :: force
579 logical :: OPT_help, found, end
580 character(STRING) :: VAL_help, options_msg, help_msg, category
581 character(STRING), pointer :: localopts(:) => null()
582 integer :: unit, i
583 character(len = *), parameter :: subname = 'DCArgsHelp'
584 continue
585 if (.not. arg % initialized) then
586 call messagenotify('W', subname, 'Call Open before Help in dc_args.')
587 call dcargsopen(arg)
588 end if
589 call dcargsoption(arg, stoa('-h', '-H', '--help'), opt_help, val_help, &
590 & help="display this help and exit. " // &
591 & "VAL is unit number (default is standard output)")
592 if (.not. opt_help .and. .not. present_and_true(force)) then
593 return
594 end if
595 if (trim(val_help) == '') then
597 else
598 unit = stoi(val_help)
599 end if
600
601 call printf(unit, '')
602
603 call dchashget(arg % helpmsg,
'TITLE', help_msg, found)
604 if (found) then
605 call printf(unit, '%c', c1=trim(help_msg))
606 call printf(unit, '')
608 end if
609
610 call dchashget(arg % helpmsg,
'OVERVIEW', help_msg, found)
611 if (found) then
612 call printf(unit, 'Overview::')
613 call printautolinefeed(unit, help_msg, indent=' ')
614 call printf(unit, '')
616 end if
617
618 call dchashget(arg % helpmsg,
'USAGE', help_msg, found)
619 if (found) then
620 call printf(unit, 'Usage::')
621 call printautolinefeed(unit, help_msg, indent=' ')
622 call printf(unit, '')
624 end if
625
626 call printf(unit, 'Options::')
627 if ( associated(arg % opt_table) ) then
628 do i = 1, size(arg % opt_table)
629 options_msg = ' '
630 if (arg % opt_table(i) % optvalue_flag) then
631 call concat(arg % opt_table(i) % options, '=VAL', localopts)
632 else
633 allocate(localopts(size(arg % opt_table(i) % options)))
634 localopts = arg % opt_table(i) % options
635 end if
636 options_msg = trim(options_msg) // trim(joinchar(localopts))
637 deallocate(localopts)
638 call printf(unit, ' %c', c1=trim(options_msg))
639 call printautolinefeed(unit, &
640 & arg % opt_table(i) % help_message, indent=' ')
641 call printf(unit, '')
642 end do
643 end if
644
646 do
647 call dchashnext(arg % helpmsg, category, help_msg,
end)
648 if (end) exit
649
650 call printf(unit, '%c%c::', &
651 & c1=trim(uchar(category(1:1))), c2=trim(lchar(category(2:))))
652 call printautolinefeed(unit, help_msg, indent=' ')
653 call printf(unit, '')
654
655 enddo
656
657 call dcargsclose(arg)
658
659 stop
integer, parameter, public string
文字列を保持する 文字型変数の種別型パラメタ
integer, parameter, public stdout
標準出力の装置番号