#!/bin/sh
exec ${GUILE-guile} -e '(ttn-do random-info-node)' -s $0 "$@" # -*-scheme-*-
!#
;;; random-info-node

;; Copyright (C) 2003, 2004, 2005, 2006, 2007, 2009,
;;   2010, 2011 Thien-Thi Nguyen
;;
;; This file is part of ttn-do, released under the terms of the
;; GNU General Public License as published by the Free Software
;; Foundation; either version 3, or (at your option) any later
;; version.  There is NO WARRANTY.  See file COPYING for details.

;;; Commentary:

;; Usage: random-info-node [--list] [--sexp] INFO
;;
;; Display a random info node from INFO file to stdout.
;; Optional arg "--list" (or "-l") means to instead display a list of nodes.
;; Optional arg "--sexp" (or "-s") means to display the list as a sexp.
;;
;; If INFO ends with ".gz" it is read using "gzip -dc".

;;; Code:

(define-module (ttn-do random-info-node)
  #:export (main)
  #:use-module ((ttn-do zzz banalities) #:select (check-hv
                                                  qop<-args))
  #:use-module ((srfi srfi-13) #:select (string-prefix?
                                         string-suffix?
                                         string-index-right
                                         substring/shared))
  #:use-module ((ice-9 popen) #:select (open-input-pipe
                                        close-pipe))
  #:use-module ((ice-9 rdelim) #:select (read-line
                                         read-line!
                                         write-line))
  #:use-module ((ttn-do zzz personally) #:select (FE fso fs))
  #:use-module ((ttn-do zzz subprocess) #:select (sysfmt)))

(define trigger "Node: ")
(define trigger-len (string-length trigger))

(define (main/qop qop)
  (set! *random-state* (seed->random-state
                        (let ((pair (gettimeofday)))
                          (* (car pair) (cdr pair)))))
  (let* ((filename (or (and (pair? (qop '()))
                            (car (qop '())))
                       (error "No input file specified")))
         (xz? (or (string-suffix? ".lzma" filename)
                  (string-suffix? ".xz" filename)))
         (gz? (string-suffix? ".gz" filename))
         (list-only? (and (qop 'list) (not (qop 'sexp))))
         (count 0)
         (p (cond (xz? (open-input-pipe (fs "xz -dc ~A" filename)))
                  (gz? (open-input-pipe (fs "gzip -dc ~A" filename)))
                  (else (open-input-file filename))))
         (next (if list-only?
                   (let ((buf (make-string 256)))
                     (lambda ()
                       (let ((n (read-line! buf p)))
                         (if (eof-object? n)
                             n
                             (substring/shared buf 0 n)))))
                   (lambda ()
                     (read-line p)))))
    (let loop ((acc '()))
      (let ((line (next)))
        (cond ((eof-object? line)
               ((if (or xz? gz?) close-pipe close-port) p)
               (cond (list-only?)
                     ((qop 'sexp)
                      (fso "~S~%" (reverse! acc)))
                     (else
                      (sysfmt "info -o- -n '~A' -f ~A 2>/dev/null"
                              (list-ref acc (random count))
                              filename))))
              ((and (string-prefix? trigger line)
                    (string-index-right line #\del trigger-len))
               => (lambda (end)
                    (let ((name (substring/shared line trigger-len end)))
                      (cond (list-only?
                             (write-line name))
                            (else
                             (set! acc (cons name acc))
                             (set! count (1+ count)))))
                    (loop acc)))
              (else
               (loop acc)))))))

(define (main args)
  (check-hv args '((package . "ttn-do")
                   (version . "1.3")
                   ;; 1.3  -- handle .gz, .lzma, .xz info file; slogging
                   ;; 1.2  -- better random seed init
                   ;; 1.1  -- info(1) stderr discarded
                   (help . commentary)))
  (main/qop
   (qop<-args
    args '((list (single-char #\l))
           (sexp (single-char #\s))))))

;;; random-info-node ends here