bug#30338: [PATCH] Fix up doc-snarfing in doc-snarf.scm

[Tkprom]

Hi,

I only found out about guild doc-snarf after I produced most of my source documentation using internal doc-strings (string after `(define'). However,

doc-snarf only works with ;; doc-strings or a combination of ;; and internal doc-strings, never on internal doc-strings alone.

I have now made some changes to doc-snarf.scm to make it work with stand-alone internal doc-strings.

========= output of git format-patch =========

Command doc-snarf of guild now works for internal doc-strings just

like for `;;' doc-strings.

* module/scripts/doc-snarf (snarf):

  - defined `int-doc-entry' to produce a correct entry from an internal

    doc-string and cons it to the list of entries

  - added `signature-start' detection to the top-level doc detection

    `let'

  - int-doc-entry messes up line numbers; add calls to ftell and seek to

    sort this out (overkill and too expensive?)

---

module/scripts/doc-snarf.scm | 53 +++++++++++++++++++++++++++++++++++++-------

1 file changed, 45 insertions(+), 8 deletions(-)

diff --git a/module/scripts/doc-snarf.scm b/module/scripts/doc-snarf.scm

index fa3dfb312..5b709b110 100644

--- a/module/scripts/doc-snarf.scm

+++ b/module/scripts/doc-snarf.scm

@@ -191,7 +191,7 @@ return the standard internal docstring if found.  Return #f if not."

                 (eq? 'define (car form))

                 (pair? (cadr form))

                 (symbol? (caadr form))

-                (string? (caddr form)))

+                (string? (caddr form)))          

            (caddr form))

           ((and (list? form)            ; (define VAR (lambda ARGS "DOC" ...))

                 (< 2 (length form))

@@ -204,6 +204,7 @@ return the standard internal docstring if found.  Return #f if not."

            (caddr (caddr form)))

           (else #f))))

+

;; Split @var{string} into lines, adding @var{prefix} to each.

;;-ttn-mod: new proc

(define (split-prefixed string prefix)

@@ -220,6 +221,7 @@ return the standard internal docstring if found.  Return #f if not."

;;-Author: Martin Grabmueller <address@hidden>

;;-Created: 2001-02-17

;;-ttn-mod: regluarize lang parm lookup, add "std int doc" snarfing (2 places)

+;;-tk-mod: add standalone "std int doc" snarfing and fix source code lines

(define (snarf input-file lang)

   (let* ((i-p (open-input-file input-file))

          (parm-regexp (lambda (parm) (make-regexp (lang-parm lang parm))))

@@ -228,6 +230,7 @@ return the standard internal docstring if found.  Return #f if not."

          (docstring-prefix (parm-regexp 'docstring-prefix))

          (option-prefix    (parm-regexp 'option-prefix))

          (signature-start  (parm-regexp 'signature-start))

+         (std-int-doc? (lang-parm lang 'std-int-doc?))

          (augmented-options

           (lambda (line i-p options)

             (let ((int-doc (and (lang-parm lang 'std-int-doc?)

@@ -235,7 +238,17 @@ return the standard internal docstring if found.  Return #f if not."

                                   (and d (split-prefixed d "internal: "))))))

               (if int-doc

                   (append (reverse int-doc) options)

-                  options)))))

+                  options))))

+         (int-doc-entry (lambda (line entries str-line i-p)

+                          (let*

+                              ((thing (find-std-int-doc line i-p)))

+                            (if thing

+                                (cons (parse-entry (list thing)

+                                                   '()

+                                                   line

+                                                   (port-filename i-p)

+                                                   str-line) entries)

+                                entries)))))

     (let lp ((line (read-line i-p)) (state 'neutral) (doc-strings '())

     (options '()) (entries '()) (lno 0))

@@ -245,13 +258,37 @@ return the standard internal docstring if found.  Return #f if not."

(reverse entries))

        ;; State 'neutral: we're currently not within a docstring or

-       ;; option section

+       ;; option section, or at a signature (in case of languages that

+       ;; have internal doc strings).

        ((eq? state 'neutral)

- (let ((m (regexp-exec docstring-start line)))

-   (if m

-     (lp (read-line i-p) 'doc-string

- (list (match:substring m 1)) '() entries (+ lno 1))

-     (lp (read-line i-p) state '() '() entries (+ lno 1)))))

+ (let ((m0 (regexp-exec docstring-start line))

+              (m1 (regexp-exec signature-start line)))

+

+          (cond

+           (m0

+            (lp (read-line i-p) 'doc-string

+ (list (match:substring m0 1)) '() entries (+ lno 1)))

+

+           ((and std-int-doc? m1) ;Add int-doc string to entries (tk-mod).

+            (let

+                ((where (ftell i-p))    ;Proc int-doc-entry is going to

+                                        ;mess up line counting, so

+                                        ;record where we are in the

+                                        ;world.

+                 (entries (int-doc-entry

+                           line

+                           entries

+                           (+ 2 lno)

+                           i-p)))

+              (seek i-p where SEEK_SET)              ;Rewind (is this too expensive?)

+              (lp (read-line i-p)

+                  'neutral

+                  '()

+                  '()

+                  entries

+                  (+ 1 lno))))

+           (#t

+            (lp (read-line i-p) state '() '() entries (+ lno 1))))))

        ;; State 'doc-string: we have started reading a docstring and

        ;; are waiting for more, for options or for a define.

--

2.15.1

Todor Kondić

Sent with ProtonMail Secure Email.