doc/widget-screenshot.lisp

   1 (defpackage :widget-screenshot
   2   (:use :cl :gtk :gdk :gobject)
   3   (:export :make-widget-screenshot))
   4
   5 (in-package :widget-screenshot)
   6
   7 (defun make-widget-screenshot (filename widget-creator-fn)
   8   (within-main-loop
   9     (let ((window (make-instance 'gtk-window))
  10           (widget (funcall widget-creator-fn)))
  11       (container-add window widget)
  12       (pushnew :structure-mask (gdk-window-events (widget-window window)))
  13       (connect-signal window "map-event"
  14                       (lambda (&rest args)
  15                         (declare (ignore args))
  16                         (let* ((pm (widget-snapshot widget))
  17                                (pb (pixbuf-get-from-drawable nil pm)))
  18                           (pixbuf-save pb filename "png"))
  19                         (object-destroy window)))
  20       (widget-show window))))