12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091 |
- (import
- (except (rnrs base) let-values)
- (only (guile)
- lambda* λ
- display
- simple-format)
- ;; pipes
- (ice-9 popen))
- ;; `path-as-string->list` is copied from GNU Guix. Some
- ;; comments added. See:
- ;; https://git.savannah.gnu.org/cgit/guix.git/tree/guix/build/utils.scm?id=c0bc08d82c73e464a419f213d5ae5545bc67e2bf#n573.
- (define* (path-as-string->list path #:optional (separator #\:))
- (if separator
- (string-tokenize path
- ;; Match everything except the
- ;; separator.
- (char-set-complement
- (char-set separator)))
- ;; Otherwise simply return a list containing the path
- ;; to be sure to always return a list.
- (list path)))
- ;; `find-executable-on-path` is adapted from GNU Guix's
- ;; `which` procedure. See:
- ;; https://git.savannah.gnu.org/cgit/guix.git/tree/guix/build/utils.scm?id=c0bc08d82c73e464a419f213d5ae5545bc67e2bf#n617
- (define (find-executable-on-path executable)
- "Return the complete file name for EXECUTABLE as found in
- ${PATH}, or #f if EXECUTABLE could not be found."
- ;; search-path is a procedure defined in GNU Guile
- (search-path
- ;; Check the PATH for the executable.
- (path-as-string->list (getenv "PATH"))
- executable))
- (define find-pager
- (λ ()
- (or (getenv "PAGER")
- (find-executable-on-path "more")
- (find-executable-on-path "less"))))
- ;;; Now onto the actual matter of using open-pipe ...
- (define open-output-pipe*
- (λ (command . args)
- (open-output-pipe
- (string-join (cons command args) " "))))
- (define string-repeat
- (λ (str n)
- (define (iter port str n)
- (when (> n 0)
- (display str port)
- (iter port str (- n 1))))
- (call-with-output-string
- (λ (port)
- (iter port str n)))))
- (define long-string
- (string-repeat "lines\n1\n2\n3\n" 100))
- (define output-paginated
- (λ (message)
- (let ([pager-pipe
- ;; Execute the pager command in a subprocess with its
- ;; arguments and return an output pipe to the pager.
- (open-output-pipe* (find-pager)
- ;; Here we assume, that the
- ;; pager will support an
- ;; argument "-4". This might
- ;; not always be true.
- "-4")])
- (display (simple-format #f "~a\n" message)
- pager-pipe)
- ;; Ultimately close pipe after being done with writing to
- ;; it.
- (close-pipe pager-pipe))))
- (output-paginated long-string)
- ;;; Usage for example: PAGER=more guile -L . using-open-pipe.scm
|