Subject: [PATCH] Fix up doc-snarfing in doc-snarf.scm

From: Tkprom <[email-masked]>
Date: Sat, 03 Feb 2018 03:34:57 -0500

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 <[email-masked]>
;;-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](https://protonmail.com) Secure Email.