mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-02 04:40:29 +02:00
Code Activity

(read-text-outline-silently): Move tp' inside loop'; nfc.

Browse source
This commit is contained in:
Thien-Thi Nguyen 2002-04-02 20:50:38 +00:00
parent 20e7ab652e
commit 04ab3b74fa
1 changed files with 23 additions and 14 deletions
Download patch file Download diff file Expand all files Collapse all files

37
scripts/read-text-outline
View file

@ -101,9 +101,16 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
(define (read-text-outline-silently port) (define (read-text-outline-silently port)
(let* ((all '(start)) (let* ((all '(start))
(pchain (list)) ; parents chain (pchain (list))) ; parents chain
(tp all)) ; tail pointer (let loop ((line (read-line port))
(let loop ((line (read-line port)) (prev-level -1)) (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) (or (eof-object? line)
(cond ((regexp-exec *depth-cue-rx* line) (cond ((regexp-exec *depth-cue-rx* line)
=> (lambda (m) => (lambda (m)
@ -112,38 +119,40 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
(or (match:substring m *subm-number*) (or (match:substring m *subm-number*)
"")) ""))
*level-divisor*)) *level-divisor*))
(diff (- level prev-level)) (diff (- level prev-level)))
(saved-tp tp))
(cond (cond
;; sibling ;; sibling
((zero? diff) ((zero? diff)
(set-cdr! tp words) ;; just extend the chain
(set! tp words)) (set-cdr! tp words))
;; child ;; child
((positive? diff) ((positive? diff)
(or (= 1 diff) (or (= 1 diff)
(error "unhandled diff not 1:" diff line)) (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-object-property! tp 'level prev-level)
(set! pchain (cons tp pchain)) (set! pchain (cons tp pchain))
(set-car! tp (cons (car tp) words)) ;; "push down" car into hierarchy
(set! tp words)) (set-car! tp (cons (car tp) words)))
;; uncle ;; uncle
((negative? diff) ((negative? diff)
;; prune back to where levels match
(do ((p pchain (cdr p))) (do ((p pchain (cdr p)))
((= level (object-property (car p) 'level)) ((= level (object-property (car p) 'level))
(set! pchain p))) (set! pchain p)))
;; resume at this level
(set-cdr! (car pchain) words) (set-cdr! (car pchain) words)
(set! pchain (cdr pchain)) (set! pchain (cdr pchain))))
(set! tp words)))
(loop (read-line port) level)))) (loop (read-line port) level words))))
(else (loop (read-line port) prev-level))))) (else (loop (read-line port) prev-level tp)))))
(set! all (car all)) (set! all (car all))
(if (eq? 'start all) (if (eq? 'start all)
'() '() ; wasteland
(cdr all)))) (cdr all))))
(define (read-text-outline . args) (define (read-text-outline . args)