guile-zenity/zenity.scm

(define-module (zenity)
  #:export (zenity
            zenity-calendar
            zenity-file-selection
            zenity-list zenity-checklist
            zenity-error zenity-info zenity-question zenity-warning
            zenity-password
            zenity-entry)
  #:use-module (ice-9 popen)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-11)
  #:use-module (srfi srfi-14))

;; https://help.gnome.org/users/zenity/stable/

;; Utility functions

(define (drain-input port)
  (let ((ch (read-char port)))
    (if (eof-object? ch)
        '()
        (cons ch (drain-input port)))))

(define (chomp text)
  (string-trim-right text (char-set #\newline)))

(define (boolean->zenity-boolean b)
  (if b
      "TRUE"
      "FALSE"))

(define (->string thing)
  (cond ((string? thing) thing)
        ((symbol? thing) (symbol->string thing))
        ((number? thing) (number->string thing))
        ((boolean? thing) (boolean->zenity-boolean thing))
        (else (error "unsupported type in ->string"))))

;;

(define (zenity . args)
  (let* ((pipe (apply open-pipe* OPEN_READ "zenity" args))
         (text (list->string (drain-input pipe)))
         (ret (close-pipe pipe)))
    (values ret text)))

(define (zenity/check args thunk)
  (let-values (((ret text) (apply zenity args)))
    (cond ((= ret 0) (thunk text))
          ((= ret 256) #f)
          (else (error "unexpected return code in zenity")))))

;; Calendar Dialog — Use the --calendar option.

(define (zenity-calendar message)
  (zenity/check (list "--calendar" "--date-format=%d/%m/%Y" (string-append "--text=" message))
                (lambda (text)
                  (let ((dmy (string-split (chomp text) #\/)))
                    (list (cons 'day (string->number (car dmy)))
                          (cons 'month (string->number (cadr dmy)))
                          (cons 'year (string->number (caddr dmy))))))))

;; Color Selection Dialog — Use the --color-selection option.
;; File Selection Dialog — Use the --file-selection option.

(define* (zenity-file-selection title
                                #:key (multiple #f)
                                (directory #f)
                                (save #f)
                                (filename #f))
  (let ((args (append
               (if multiple (list "--multiple") (list))
               (if directory (list "--directory") (list))
               (if save (list "--save") (list))
               (if filename (list (string-append "--filename=" filename)) (list)))))
    (let-values (((ret text) (apply zenity "--file-selection"
                                    (string-append "--title=" title)
                                    args)))
      (if (= ret 256)
          #f
          (if multiple
              ;; I hope you don't have files with | in the name.
              (string-split (chomp text) #\|)
              (chomp text))))))

;; Forms Dialog — Use the --forms option.
;; List Dialog — Use the --list option.

(define (zenity-list message columns rows)
  (let ((columns^ (map (lambda (col) (string-append "--column=" col)) columns))
        (rows^ (apply append (map (lambda (row) (map ->string row)) rows))))
    (zenity/check (cons "--list" (append columns^ rows^))
                  (lambda (text)
                    (assoc (chomp text) rows (lambda (k c) (string=? k (->string c))))))))

(define (zenity-checklist message columns rows)
  (let ((columns^ (map (lambda (col) (string-append "--column=" col)) columns))
        (rows^ (apply append (map (lambda (row) (map ->string row)) rows))))
    (zenity/check (append (list "--list" "--checklist") (append columns^ rows^))
                  (lambda (text)
                    (string-split (chomp text) #\|)))))

;; Message Dialog — Error, Info, Question, Warning

(define (zenity-error message)
  (zenity "--error" (string-append "--text=" message))
  #t)

(define (zenity-info message)
  (zenity "--info" (string-append "--text=" message))
  #t)

(define (zenity-question message)
  (zenity/check (list "--question" (string-append "--text=" message))
                (lambda (_) #t)))

(define (zenity-warning message)
  (zenity "--warning" (string-append "--text=" message))
  #t)

;; Notification Icon — Use the --notification option.

;; Password Dialog — Use the --password option.

(define (zenity-password message)
  (zenity/check (list "--password" message (string-append "--text=" message))
                chomp))

;; Progress Dialog — Use the --progress option.
;; Scale Dialog — Use the --scale option.

;; Text Entry Dialog — Use the --entry option.

(define (zenity-password message)
  (zenity/check (list "--entry" message (string-append "--text=" message))
                chomp))

;; Text Information Dialog — Use the --text-info option.