diff options
author | Thien-Thi Nguyen <ttn@gnuvola.org> | 2002-04-02 20:50:38 +0000 |
---|---|---|
committer | Thien-Thi Nguyen <ttn@gnuvola.org> | 2002-04-02 20:50:38 +0000 |
commit | 04ab3b74fa3cf9149adbafe58b2557b7834b7b74 (patch) | |
tree | dfa93ba8c7e43eb8ba97f394701239085d6457cb /scripts/read-text-outline | |
parent | 20e7ab652e4ba8dd7759176962a49b982a608e91 (diff) | |
download | guile-04ab3b74fa3cf9149adbafe58b2557b7834b7b74.tar.gz |
(read-text-outline-silently): Move `tp' inside `loop'; nfc.
Diffstat (limited to 'scripts/read-text-outline')
-rwxr-xr-x | scripts/read-text-outline | 37 |
1 files changed, 23 insertions, 14 deletions
diff --git a/scripts/read-text-outline b/scripts/read-text-outline index 74cc8d6d6..bbfbac5e1 100755 --- a/scripts/read-text-outline +++ b/scripts/read-text-outline @@ -101,9 +101,16 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@" (define (read-text-outline-silently port) (let* ((all '(start)) - (pchain (list)) ; parents chain - (tp all)) ; tail pointer - (let loop ((line (read-line port)) (prev-level -1)) + (pchain (list))) ; parents chain + (let loop ((line (read-line port)) + (prev-level -1) ; how this relates to the first input + ; level determines whether or not we + ; start in "sibling" or "child" mode. + ; in the end, `start' is ignored and + ; it's much easier to ignore parents + ; than siblings (sometimes). this is + ; not to encourage ignorance, however. + (tp all)) ; tail pointer (or (eof-object? line) (cond ((regexp-exec *depth-cue-rx* line) => (lambda (m) @@ -112,38 +119,40 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@" (or (match:substring m *subm-number*) "")) *level-divisor*)) - (diff (- level prev-level)) - (saved-tp tp)) + (diff (- level prev-level))) (cond ;; sibling ((zero? diff) - (set-cdr! tp words) - (set! tp words)) + ;; just extend the chain + (set-cdr! tp words)) ;; child ((positive? diff) (or (= 1 diff) (error "unhandled diff not 1:" diff line)) + ;; parent may be contacted by uncle later (kids + ;; these days!) so save its level (set-object-property! tp 'level prev-level) (set! pchain (cons tp pchain)) - (set-car! tp (cons (car tp) words)) - (set! tp words)) + ;; "push down" car into hierarchy + (set-car! tp (cons (car tp) words))) ;; uncle ((negative? diff) + ;; prune back to where levels match (do ((p pchain (cdr p))) ((= level (object-property (car p) 'level)) (set! pchain p))) + ;; resume at this level (set-cdr! (car pchain) words) - (set! pchain (cdr pchain)) - (set! tp words))) + (set! pchain (cdr pchain)))) - (loop (read-line port) level)))) - (else (loop (read-line port) prev-level))))) + (loop (read-line port) level words)))) + (else (loop (read-line port) prev-level tp))))) (set! all (car all)) (if (eq? 'start all) - '() + '() ; wasteland (cdr all)))) (define (read-text-outline . args) |