\ create a documentation file

\ Authors: Anton Ertl, Bernd Paysan, Neal Crook
\ Copyright (C) 1995,1999,2000,2003,2004,2007,2010,2018,2019,2021,2022,2023 Free Software Foundation, Inc.

\ This file is part of Gforth.

\ Gforth is free software; you can redistribute it and/or
\ modify it under the terms of the GNU General Public License
\ as published by the Free Software Foundation, either version 3
\ of the License, or (at your option) any later version.

\ This program is distributed in the hope that it will be useful,
\ but WITHOUT ANY WARRANTY; without even the implied warranty of
\ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
\ GNU General Public License for more details.

\ You should have received a copy of the GNU General Public License
\ along with this program. If not, see http://www.gnu.org/licenses/.


\ the stack effect of loading this file is: ( addr u -- )
\ it takes the name of the doc-file to be generated.

\ the forth source must have the following format:
\  .... name ( stack-effect ) \ [prefix-] wordset [pronounciation]
\ \G description ...

\ The output is a file of entries that look like this:
\ make-doc [--prefix]-entry name stack-effect ) wordset [pronounciation]
\ description
\
\ (i.e., the entry is terminated by an empty line or the end-of-file)

\ this stuff uses the same mechanism as etags.fs, i.e., the
\ documentation is generated during compilation using a deferred
\ HEADER. It should be possible to use this togeter with etags.fs.

\ This is not very general. Input should come from stream files,
\ otherwise the results are unpredictable. It also does not detect
\ errors in the input (e.g., if there is something else on the
\ definition line) and reacts strangely to them.

\ possible improvements: we could analyse the defining word and guess
\ the stack effect. This would be handy for variables. Unfortunately,
\ we have to look back in the input buffer; we cannot use the cfa
\ because it does not exist when header is called.

\ This is ANS Forth with the following serious environmental
\ dependences: the variable LAST must contain a pointer to the last
\ header, NAME>STRING must convert that pointer to a string, and
\ HEADER must be a deferred word that is called to create the name.


r/w create-file throw value doc-file-id
\ contains the file-id of the documentation file

variable last-doc 0 last-doc !
\ stores the last name that has a doc-entry

variable last-doc-warned 0 last-doc-warned !
\ stores the last name that \G warned about

s" \ automatically generated by makedoc.fs" doc-file-id write-line throw

: >fileCR ( c-addr u -- )
    doc-file-id write-line throw ;
: >file    ( c-addr u -- )
    doc-file-id write-file throw ;

: \G ( -- )
    \ latest last-doc @ <> abort" documentation for undocumented word"
    latest last-doc @ = if
        source >in @ /string >fileCR
    else
        latest last-doc-warned @ <> if
            latest name>string type
            ."  has \G docs, but misses stack effect and/or wordlist" cr
            latest last-doc-warned ! then
    then
    source >in ! drop ; immediate

: ?( ( -- )
    >in @ >r '(' parse + source + u<
    IF  -1 >in +! rdrop  ELSE  r> >in !  THEN ;

current-section @ constant main-section

: parse-stack-effect ( -- c-addr u )
    ?( parse-name
    2dup s" ("  str= if 2drop ')' parse exit endif
    2dup s" {"  str= if 2drop '}' parse exit endif
    2dup s" {:" str= if 2drop '}' parse 1- exit endif
    2drop 0 0 ;

: is-doc-entry? ( -- flag )
    \ checks if the stuff in SOURCE has a stack effect and a \ comment
    >in @ >r
    parse-stack-effect nip 0<>
    '\' parse + source + <> and
    r> >in !  ;

: put-doc-entry ( -- )
    current-section @ main-section <> ?exit   \ e.g., not defining locals
    latest 0= ?exit	\ not an anonymous (i.e. noname) header
    is-doc-entry? 0= ?exit
    s" " >fileCR
    s" make-doc " >file
    >in @ >r
    parse-stack-effect
    '\' parse 2drop
    >in @
    parse-name dup
    IF
        2dup 1- chars + c@ '-' =
        IF
    	s" --" >file
    	>file drop
        ELSE
    	2drop >in !
        THEN
    ELSE
        2drop >in !
    THEN
    latest name>string >file
    s"  " >file
    >file
    s"  )" >file
    latest last-doc !
    POSTPONE \g
    r> >in ! ;

' put-doc-entry IS header-extra

\ clear included-files, so the files will be loaded for making the docs
\ included-files $[]free
\ warnings off