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

;; Copyright (C) 2008, 2009, 2010 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: xlsfonts [--unsorted | -u]
;;
;; Write all (up to 9999 in number) font names to stdout, one per line.
;; Optional arg `-u' means display unsorted.

;;; Code:

(define-module (ttn-do xlsfonts)
  #:export ()
  #:use-module ((ttn-do zzz banalities) #:select (check-hv
                                                  qop<-args))
  #:use-module ((ttn-do zzz x-protocol) #:select ((-x . zx-x)))
  #:use-module ((ttn-do zzz x-umbrages) #:select (connection)))

(define (list-fonts q max pattern)
  (zx-x 'names (q 'ListFonts
                  #:max-names max
                  #:pattern pattern)))

(define (do-it unsorted? conn)
  (let ((all (list-fonts (conn #:q) 9999 "*")))
    (or unsorted?
        (sort! all string<?))
    (array-for-each write-line all))
  (conn #:bye))

(define (main args)
  (check-hv args '((package . "ttn-do")
                   (version . "1.0")
                   (help . commentary)))
  (let ((qop (qop<-args args '((unsorted (single-char #\u))))))
    (do-it (qop 'unsorted) (connection))))

;;; xlsfonts ends here