@c -----------------------------------------------------------------------------
@c File     : gtk-display-widgets.texi
@c License  : GNU General Public License (GPL)
@c Language : English
@c Author   : Dieter Kaiser
@c Date     : 26.04.2012
@c Revision : 01.08.2013
@c
@c Copyright (C) 2012, 2013 by Dieter Kaiser
@c -----------------------------------------------------------------------------

@menu
* Labels::
@c * Accelerator Labels::
* Images::
* Progress Bars::
* Statusbars::
* Info Bars::
@c * Status Icon::
@c * Spinner::
@end menu

@c -----------------------------------------------------------------------------
@node Labels, Images, Top, Top
@section Labels

@findex GtkLabel
@findex gtk-label
@findex label, gtk-label

@findex gtk-label-new
@findex gtk-label-new-with-mnemonic
@findex gtk-label-set-text
@findex gtk-label-get-text

@findex label-new, gtk-label-new
@findex label-new-with-mnemonic, gtk-label-new-with-mnemonic
@findex label-set-text, gtk-label-set-text
@findex label-get-text, gtk-label-get-text

Labels are used a lot in GTK+, and are relatively simple.  The @xurl{gtk-label}
widget displays a small amount of text.  As the name implies, most labels are
used to label another widget such as a @xurl{gtk-button}, a
@xurl{gtk-menu-item}, or a @xurl{gtk-combo-box}.  Labels emit no signals as they
do not have an associated X window.  If you need to catch signals, or do
clipping, place it inside a @xurl{gtk-event-box} widget or a Button widget.

To create a new label, use @code{make-instance} with the class name
@xurl{gtk-label} or the functions @xurl{gtk-label-new} or
@xurl{gtk-label-new-with-mnemonic}.  The sole argument of the functions is the
string you wish the label to display.  To change the text of the label after
creation, use the function @xurl{gtk-label-set-text}.  The first argument
is the label you created previously, and the second is the new string. The space
needed for the new string will be automatically adjusted if needed.  You can
produce multi-line labels by putting line breaks in the label string.  To
retrieve the current string, use @xurl{gtk-label-get-text}.

@ifnotinfo
@float Figure, figure-labels
@caption{Labels}
@center @image{figures/labels507x440, 338pt}
@end float
@end ifnotinfo

@subheading Label with Mnemonics

@findex gtk-label-new-with-mnemonic
@findex gtk-label-set-text-with-mnemonic
@findex gtk-label-set-mnemonic-widget

@findex label-new-with-mnemonic, gtk-label-new-with-mnemonic
@findex label-set-text-with-mnemonic, gtk-label-set-text-with-mnemonic
@findex label-set-mnemonic-widget, gtk-label-set-mnemonic-widget

Labels may contain mnemonics.  Mnemonics are underlined characters in the
label, used for keyboard navigation.  Mnemonics are created by providing a
string with an underscore before the mnemonic character, such as "_File",
to the functions @xurl{gtk-label-new-with-mnemonic} or
@xurl{gtk-label-set-text-with-mnemonic}.

Mnemonics automatically activate any activatable widget the label is inside,
such as a @xurl{gtk-button}; if the label is not inside the mnemonic's target
widget, you have to tell the label about the target using
@xurl{gtk-label-set-mnemonic-widget}.

Here is a simple example where the label is inside a button:
@verbatim
  ;; Pressing Alt+H will activate this button
  (let* ((button (gtk-button-new))
         (label (gtk-label-new-with-mnemonic "_Hello")))
    (gtk-container-add button label)
    [...] )
@end verbatim

There is a convenience function to create buttons with a mnemonic label
already inside:
@verbatim
  ;; Pressing Alt+H will activate this button
  (let ((button (gtk-button-new-with-mnemonic "_Hello")))
    [...] )
@end verbatim

To create a mnemonic for a widget alongside the label, such as a
@xurl{gtk-entry}, you have to point the label at the entry with
@xurl{gtk-label-set-mnemonic-widget}:
@verbatim
  ;; Pressing Alt+H will focus the entry
  (let* ((entry (gtk-entry-new))
         (label (gtk-label-new-with-mnemonic "_Hello")))
    (gtk-label-set-mnemonic-widget label entry)
    [...] )
@end verbatim

@subheading Markup (styled text)

@findex gtk-label-set-markup
@findex gtk-label-set-attributes

@findex label-set-markup, gtk-label-set-markup
@findex label-set-attributes, gtk-label-set-attributes

To make it easy to format text in a label (changing colors, fonts, etc.),
label text can be provided in a simple markup format.  Here's how to create
a label with a small font:

@verbatim
  (let ((label (gtk-label-new)))
    (gtk-label-set-markup label
                          "<small>Small text</small>")
    [...] )
@end verbatim

or

@verbatim
  (let ((label (make-instance 'gtk-label
                              :use-markup t
                              :label "<small>Small text</small>")))
    [...] )
@end verbatim

(See complete documentation of available tags in the Pango manual.)

@c TODO: g-markup-escape-text and g-markup-printf-escaped are not implemented.

The markup passed to @xurl{gtk-label-set-markup} must be valid; for example,
literal <, > and & characters must be escaped as \<, \gt;, and \&.  If you pass
text obtained from the user, file, or a network to @xurl{gtk-label-set-markup},
you will want to escape it with @code{g-markup-escape-text} or
@code{g-markup-printf-escaped}.  (Note: The functions
@code{g-markup-escape-text} and @code{g-markup-printf-escaped} are not
implemented in the Lisp binding.)

Markup strings are just a convenient way to set the @xurl{pango-attr-list} on a
label; @xurl{gtk-label-set-attributes} may be a simpler way to set attributes in
some cases.  Be careful though; @xurl{pango-attr-list} tends to cause
internationalization problems, unless you're applying attributes to the
entire string (i.e. unless you set the range of each attribute to
@code{[0, G_MAXINT)}).  The reason is that specifying the @code{start_index}
and @code{end_index} for a @code{PangoAttribute} requires knowledge of the
exact string being displayed, so translations will cause problems.

@subheading Selectable labels

@findex gtk-label-set-selectable
@findex label-set-selectable, gtk-label-set-selectable

Labels can be made selectable with @xurl{gtk-label-set-selectable}.  Selectable
labels allow the user to copy the label contents to the clipboard.  Only labels
that contain useful-to-copy information - such as error messages - should be
made selectable.

@subheading Text layout

A label can contain any number of paragraphs, but will have performance
problems if it contains more than a small number.  Paragraphs are separated
by newlines or other paragraph separators understood by Pango.

@findex gtk-label-set-line-wrap
@findex label-set-line-wrap, gtk-label-set-line-wrap

The label widget is capable of line wrapping the text automatically.  This can
be activated using the function @xurl{gtk-label-set-line-wrap}.  The first
argument is the label and the second argument take @code{T} or @code{NIL} to
switch on or to switch off the line wrapping.

@findex GtkJustification
@findex gtk-justification
@findex justification, gtk-justification

@findex gtk-label-justify
@findex label-justify, gtk-label-justify

@xurl{gtk-label-justify} sets how the lines in a label align with one
another.  The first argument is the label and the second argument one of the
following values of the enumeration type @xurl{gtk-justification}.  The possible
values are shown in @ref{table-gtk-justification}.  If you want to set how the
label as a whole aligns in its available space, see the function
@xurl{gtk-misc-set-alignment}.

@float Table, table-gtk-justification
@caption{Values of the type @code{GtkJustification}}
@end float
@table @code
@item :left
      The text is placed at the left edge of the label.
@item :right
      The text is placed at the right edge of the label.
@item :center
      The text is placed in the center of the label.
@item :fill
      The text is placed is distributed across the label.
@end table

The @code{width-chars} and @code{max-width-chars} properties can be used to
control the size allocation of ellipsized or wrapped labels.  For ellipsizing
labels, if either is specified (and less than the actual text size), it is used
as the minimum width, and the actual text size is used as the natural width of
the label.  For wrapping labels, @code{width-chars} is used as the minimum
width, if specified, and @code{max-width-chars} is used as the natural width.
Even if @code{max-width-chars} specified, wrapping labels will be rewrapped to
use all of the available width.

@findex gtk-label-pattern
@findex label-pattern, gtk-label-pattern

If you want your label underlined, then you can set a pattern on the label with
the function @xurl{gtk-label-pattern}.  The pattern argument indicates how the
underlining should look.  It consists of a string of underscore and space
characters.  An underscore indicates that the corresponding character in the
label should be underlined.  For example, the string "__ __" would underline the
first two characters and eight and ninth characters.

@subheading Links

@findex gtk-label-get-current-uri
@findex label-get-current-uri, gtk-label-get-current-uri

GTK+ supports markup for clickable hyperlinks in addition to regular Pango
markup.  The markup for links is borrowed from HTML, using the a with href and
title attributes.  GTK+ renders links similar to the way they appear in web
browsers, with colored, underlined text.  The title attribute is displayed as a
tooltip on the link.  An example looks like this:

@verbatim
  (gtk-label-set-markup label
    "Go to the <a href=\"http://gtk.org/\"> GTK+ Website</a> for more ...")))
@end verbatim

It is possible to implement custom handling for links and their tooltips
with the @code{activate-link} signal and the @xurl{gtk-label-get-current-uri}
function.

@subheading GtkLabel as GtkBuildable

The @xurl{gtk-label} implementation of the @xurl{gtk-buildable} interface
supports a custom @code{<attributes>} element, which supports any number of
@code{<attribute>} elements. The @code{<attribute>} element has attributes named
@code{name}, @code{value}, @code{start} and @code{end} and allows you to specify
@code{PangoAttribute} values for this label.

@float Example, example-label-ui
@caption{A UI definition fragment specifying Pango attributes}
@end float
@verbatim
   <object class="GtkLabel">
     <attributes>
      <attribute name="weight" value="PANGO_WEIGHT_BOLD"/>
      <attribute name="background" value="red" start="5" end="10"/>"
    </attributes>
  </object>
@end verbatim

The @code{start} and @code{end} attributes specify the range of characters to
which the Pango attribute applies.  If @code{start} and @code{end} are not
specified, the attribute is applied to the whole text.  Note that specifying
ranges does not make much sense with translatable attributes.  Use markup
embedded in the translatable content instead.

@subheading Examples

@ref{figure-labels} and @ref{figure-more-labels} illustrate the functions for
@code{GtkLabel}.  The code for these examples is shown in @ref{example-labels}
and @ref{example-more-labels}.

@float Example, example-labels
@caption{Labels}
@end float
@verbatim
(defun make-heading (text)
  (make-instance 'gtk-label
                 :xalign 0
                 :use-markup t
                 :label (format nil "<b>~A</b>" text)))

(defun example-labels ()
  (within-main-loop
    (let ((window (make-instance 'gtk-window
                                 :type :toplevel
                                 :title "GTK+ 3.4 Example Labels"
                                 :default-width 250
                                 :border-width 12))
          (vbox1 (make-instance 'gtk-box
                                :orientation :vertical
                                :spacing 6))
          (vbox2 (make-instance 'gtk-box
                                :orientation :vertical
                                :spacing 6))
          (hbox (make-instance 'gtk-box
                               :orientation :horizontal
                               :spacing 12)))
      ;; Connect a handler for the signal "destroy" to window.
      (g-signal-connect window "destroy"
                        (lambda (widget)
                          (declare (ignore widget))
                          (leave-gtk-main)))
      ;; Create a Normal Label
      (gtk-box-pack-start vbox1
                          (make-heading "Normal Label:")
                          :expand nil)
      (gtk-box-pack-start vbox1
                          (make-instance 'gtk-label
                                         :label "This is a Normal Label")
                          :expand nil)
      ;; Create a Multi-line Label
      (gtk-box-pack-start vbox1
                          (make-heading "Multi-line Label:")
                          :expand nil)
      (gtk-box-pack-start vbox1
                          (make-instance 'gtk-label
                                         :label
                                         (format nil
                                               "This is a Multi-line label~%~
                                                Second line~%~
                                                Third line"))
                          :expand nil)
      ;; Create a Left Justified Label
      (gtk-box-pack-start vbox1
                          (make-heading "Left Justified Label:")
                          :expand nil)
      (gtk-box-pack-start vbox1
                          (make-instance 'gtk-label
                                         :justify :left
                                         :label
                                         (format nil
                                                 "This is a Left Justified~%~
                                                  Multi-line label~%~
                                                  Third line"))
                          :expand nil)
      ;; Create a Right Justified Label
      (gtk-box-pack-start vbox1
                          (make-heading "Right Justified Label:")
                          :expand nil)
      (gtk-box-pack-start vbox1
                          (make-instance 'gtk-label
                                         :justify :right
                                         :label
                                         (format nil
                                                "This is a Right Justified~%~
                                                 Multi-line label~%~
                                                 Third line"))
                          :expand nil)
      ;; Create a Line wrapped label
      (gtk-box-pack-start vbox2
                          (make-heading "Line Wrapped Label:")
                          :expand nil)
      (gtk-box-pack-start vbox2
                          (make-instance 'gtk-label
                                         :wrap t
                                         :label
                                         (format nil
                                          "This is an example of a ~
                                           line-wrapped label.  It should ~
                                           not be taking up the entire ~
                                           width allocated to it, but ~
                                           automatically wraps the words to ~
                                           fit.  The time has come, for all ~
                                           good men, to come to the aid of ~
                                           their party.  The sixth sheik's ~
                                           six sheep's sick.  It supports ~
                                           multiple paragraphs correctly, ~
                                           and correctly adds many extra ~
                                           spaces."))
                          :expand nil)
      ;; Create a Filled and wrapped label
      (gtk-box-pack-start vbox2
                          (make-heading "Filled and Wrapped Label:")
                          :expand nil)
      (gtk-box-pack-start vbox2
                          (make-instance 'gtk-label
                                         :wrap t
                                         :justify :fill
                                         :label
                                         (format nil
                                          "This is an example of a ~
                                           line-wrapped, filled label.  It ~
                                           should be taking up the entire ~
                                           width allocated to it.  Here is ~
                                           a sentence to prove my point.  ~
                                           Here is another sentence.  Here ~
                                           comes the sun, do de do de do.  ~
                                           This  is a new paragraph.  This ~
                                           is  another newer, longer, ~
                                           better  paragraph.  It is coming ~
                                           to an end, unfortunately."))
                          :expand nil)
      ;; Create an underlined label
      (gtk-box-pack-start vbox2
                          (make-heading "Underlined Label:")
                          :expand nil)
      (gtk-box-pack-start vbox2
                          (make-instance 'gtk-label
                                         :justify :left
                                         :use-underline t
                                         :pattern
          "_________________________ _ _________ _ ______     __ _______ ___"
                                         :label
                                         (format nil
                                          "This label is underlined!~%~
                                           This one is underlined in quite ~
                                           a  funky fashion"))
                          :expand nil)
      ;; Put the boxes into the window and show the window
      (gtk-box-pack-start hbox vbox1 :expand nil)
      (gtk-box-pack-start hbox (gtk-separator-new :vertical))
      (gtk-box-pack-start hbox vbox2 :expand nil)
      (gtk-container-add window hbox)
      (gtk-widget-show-all window))))
@end verbatim

@ifnotinfo
@float Figure, figure-more-labels
@caption{More Labels}
@center @image{figures/more-labels302x312, 201pt}
@end float
@end ifnotinfo

@float Example, example-more-labels
@caption{More Labels}
@end float
@verbatim
(defun example-more-labels ()
  (within-main-loop
    (let ((window (make-instance 'gtk-window
                                 :type :toplevel
                                 :title "GTK+ 3.4 Example More Labels"
                                 :default-width 300
                                 :border-width 6))
          (vbox1 (make-instance 'gtk-box
                                :orientation :vertical
                                :homogeneous nil
                                :spacing 6))
          (vbox2 (make-instance 'gtk-box
                                :orientation :vertical
                                :homogeneous nil
                                :spacing 6))
          (hbox (make-instance 'gtk-box
                               :orientation :horizontal
                               :homogeneous nil
                               :spacing 6)))
      (g-signal-connect window "destroy"
                        (lambda (widget)
                          (declare (ignore widget))
                          (leave-gtk-main)))
      (gtk-box-pack-start hbox
                          (make-instance 'gtk-label
                                         :label "Angle 90°"
                                         :angle 90))
      (gtk-box-pack-start vbox1
                          (make-instance 'gtk-label
                                         :label "Angel 45°"
                                         :angle 45))
      (gtk-box-pack-start vbox1
                          (make-instance 'gtk-label
                                         :label "Angel 315°"
                                         :angle 315))
      (gtk-box-pack-start hbox vbox1)
      (gtk-box-pack-start hbox
                          (make-instance 'gtk-label
                                         :label "Angel 270°"
                                         :angle 270))
      (gtk-box-pack-start vbox2 hbox)
      (gtk-box-pack-start vbox2
                          (make-instance 'gtk-hseparator))
      (gtk-box-pack-start vbox2
                          (gtk-label-new "Normal Label"))
      (gtk-box-pack-start vbox2
                          (gtk-label-new-with-mnemonic "With _Mnemonic"))
      (gtk-box-pack-start vbox2
                          (make-instance 'gtk-label
                                         :label "This Label is Selectable"
                                         :selectable t))
      (gtk-box-pack-start vbox2
                          (make-instance 'gtk-label
                                         :label
                                         "<small>Small text</small>"
                                          :use-markup t))
      (gtk-box-pack-start vbox2
                          (make-instance 'gtk-label
                                         :label
                                         "<b>Bold text</b>"
                                          :use-markup t))
      (gtk-box-pack-start vbox2
                          (make-instance 'gtk-label
                                         :use-markup t
                                         :label
                                         (format nil
                                         "Go to the ~
                                         <a href=\"http://gtk.org/\">~
                                         GTK+ Website</a> for more ...")))
      (gtk-container-add window vbox2)
      (gtk-widget-show-all window))))
@end verbatim

@c -----------------------------------------------------------------------------
@c @node Accelerator Labels, Images, Labels, Top

@c -----------------------------------------------------------------------------
@node Images, Progress Bars, Labels, Top
@section Images

@findex GtkImage

@findex gtk-image
@findex image, gtk-image

@findex gtk-image-new-from-file
@findex image-new-from-file, gtk-image-new-from-file

@ifnotinfo
@float Figure, figure images
@caption{Images}
@center @image{figures/images, 283pt}
@end float
@end ifnotinfo

The @xurl{gtk-image} widget displays an image.  Various kinds of object can be
displayed as an image; most typically, you would load a @xurl{gdk-pixbuf} object
("pixel buffer") from a file, and then display that.  There is a convenience
function to do this, @xurl{gtk-image-new-from-file}, used as follows:
@verbatim
 (let ((image (gtk-image-new-from-file "myfile.png")))
   ... )
@end verbatim
If the file is not loaded successfully, the image will contain a "broken image"
icon similar to that used in many web browsers.  If you want to handle errors in
loading the file yourself, for example by displaying an error message, then load
the image with the function @xurl{gdk-pixbuf-new-from-file}, then create the
@xurl{gtk-image} with the function @xurl{gtk-image-new-from-pixbuf}.

The image file may contain an animation, if so the @xurl{gtk-image} will display
an animation of type @xurl{gdk-pixbuf-animation} instead of a static image.

@xurl{gtk-image} is a subclass of @xurl{gtk-misc}, which implies that you can
align it (center, left, right) and add padding to it, using gtk-misc methods.

@xurl{gtk-image} is a "no window" widget (has no @xurl{gdk-window} of its own),
so by default does not receive events.  If you want to receive events on the
image, such as button clicks, place the image inside a @xurl{gtk-event-box},
then connect to the event signals on the event box.

@b{Example:} Handling button press events on a @xurl{gtk-image}.
@example
 (let ((event-box (make-instance 'gtk-event-box))
       (image (gtk-image-new-from-file "myfile.png")))
   (g-signal-connect event-box "button-press-event"
      (lambda (event-box event)
        (format t "Event Box ~A clicked at (~A, ~A)~%"
                  event-box
                  (gdk-event-button-x event)
                  (gdk-event-button-y event))
        ...

        ;; Returning TRUE means we handled the event, so the signal
        ;; emission should be stopped (do not call any further
        ;; callbacks that may be connected). Return NIL
        ;; to continue invoking callbacks.
        t))
   ... )
@end example
When handling events on the event box, keep in mind that coordinates in the
image may be different from event box coordinates due to the alignment and
padding settings on the image (see @xurl{gtk-misc}).  The simplest way to solve
this is to set the alignment to 0.0 (left/top), and set the padding to zero.
Then the origin of the image will be the same as the origin of the event box.

@ref{example images} shows various images.  The code includes an example of
parsing an image data file in small chunks with the @xurl{gdk-pixbuf-loader}
class.  The image is reloaded when clicking the image.  This is an example for
using a @xurl{gtk-event-box} to receive and process the "button-press" signal
on an image.  The output of this example is in @ref{figure images}.

@float Example, example images
@caption{Images}
@end float
@verbatim
(let ((load-timeout nil)
      (pixbuf-loader nil)
      (image-stream nil))

(defun progressive-timeout (image)
  (if image-stream
      (let* ((buffer (make-array 512 :element-type '(unsigned-byte 8)))
             (len (read-sequence buffer image-stream)))
        (if (= 0 len)
            ;; We have reached the end of the file.
            (progn
              (close image-stream)
              (setf image-stream nil)
              (gdk-pixbuf-loader-close pixbuf-loader)
              (setf pixbuf-loader nil)
              (return-from progressive-timeout +g-source-remove+))
            ;; Load the buffer into GdkPixbufLoader
            (gdk-pixbuf-loader-write pixbuf-loader buffer 512)))
      (progn
        ;; Create the image stream and the GdkPixbufLoader
        (setf image-stream
              (open "alphatest.png" :element-type '(unsigned-byte 8)))
        (when pixbuf-loader
          (gdk-pixbuf-loader-close pixbuf-loader)
          (setf pixbuf-loader nil))
        (setf pixbuf-loader (gdk-pixbuf-loader-new))
        (g-signal-connect pixbuf-loader "area-prepared"
           (lambda (loader)
             (let ((pixbuf (gdk-pixbuf-loader-get-pixbuf loader)))
               (gdk-pixbuf-fill pixbuf #xaaaaaaff)
               (gtk-image-set-from-pixbuf image pixbuf))))
        (g-signal-connect pixbuf-loader "area-updated"
           (lambda (loader x y width height)
             (declare (ignore loader x y width height))
             ;; We know the pixbuf inside the GtkImage has changed, but the
             ;; image itself does not know this; so queue a redraw. If we
             ;; wanted to be really efficient, we could use a drawing area
             ;; or something instead of a GtkImage, so we could control the
             ;; exact position of the pixbuf on the display, then we could
             ;; queue a draw for only the updated area of the image.
             (gtk-widget-queue-draw image)))))
  ;; Continue the GSource
  +g-source-continue+)

(defun demo-image ()
  (within-main-loop
    (let* ((window (make-instance 'gtk-window
                                  :type :toplevel
                                  :title "Example Images"
                                  :border-width 12
                                  :default-width 300))
           (vgrid (make-instance 'gtk-grid
                                 :orientation :vertical
                                 :border-width 8)))
      (g-signal-connect window "destroy"
                        (lambda (widget)
                          (declare (ignore widget))
                          ;; Destroy the load-timeout source
                          (when load-timeout
                            (g-source-remove load-timeout)
                            (setf load-timeout nil))
                          ;; Close the GdkPixbufLoader object
                          (when pixbuf-loader
                            (gdk-pixbuf-loader-close pixbuf-loader)
                            (setf pixbuf-loader nil))
                          ;; Close open input stream
                          (when image-stream
                            (close image-stream)
                            (setf image-stream nil))
                          (leave-gtk-main)))

      ;; Image loaded from a file
      (let* ((label (make-instance 'gtk-label
                                   :margin-bottom 3
                                   :use-markup t
                                   :label
                                   "<b>Image loaded from a file</b>"))
             (frame (make-instance 'gtk-frame
                                   :shadow-type :in))
             (pixbuf (gdk-pixbuf-new-from-file "gtk-logo-old.png"))
             (image (gtk-image-new-from-pixbuf pixbuf)))
        (gtk-container-add vgrid label)
        (gtk-container-add frame image)
        (gtk-container-add vgrid frame))

      ;; Animation loaded from a file
      (let* ((label (make-instance 'gtk-label
                                   :margin-top 9
                                   :margin-bottom 6
                                   :use-markup t
                                   :label
                                   "<b>Animation loaded from a file</b>"))
             (frame (make-instance 'gtk-frame
                                   :shadow-type :in))
             (image (gtk-image-new-from-file "floppybuddy.gif")))
        (gtk-container-add vgrid label)
        (gtk-container-add frame image)
        (gtk-container-add vgrid frame))

      ;; Symbolic icon
      (let* ((label (make-instance 'gtk-label
                                   :margin-top 9
                                   :margin-bottom 6
                                   :use-markup t
                                   :label
                                   "<b>Symbolic themed icon</b>"))
             (frame (make-instance 'gtk-frame
                                   :shadow-type :in))
             (gicon (g-themed-icon-new-with-default-fallbacks
                        "battery-caution-charging-symbolic"))
             (image (gtk-image-new-from-gicon gicon :dialog)))
        (gtk-container-add vgrid label)
        (gtk-container-add frame image)
        (gtk-container-add vgrid frame))

      ;; Progressive
      (let* ((label (make-instance 'gtk-label
                                   :margin-top 9
                                   :margin-bottom 6
                                   :use-markup t
                                   :label
                                   "<b>Progressive image loading</b>"))
             (frame (make-instance 'gtk-frame
                                   :shadow-type :in))
             (event-box (make-instance 'gtk-event-box))
             ;; Create an empty image for now; the progressive loader
             ;; will create the pixbuf and fill it in.
             (image (gtk-image-new-from-pixbuf nil)))

        ;; start_progressive_loading
        ;; This is obviously totally contrived (we slow down loading
        ;; on purpose to show how incremental loading works).
        ;; The real purpose of incremental loading is the case where
        ;; you are reading data from a slow source such as the network.
        ;; The timeout simply simulates a slow data source by inserting
        ;; pauses in the reading process.
        (setf load-timeout
              (gdk-threads-add-timeout 100
                                       (lambda ()
                                         (progressive-timeout image))))

        ;; Restart loading the image from the file
        (g-signal-connect event-box "button-press-event"
           (lambda (event-box event)
             (format t "Event Box ~A clicked at (~A, ~A)~%"
                       event-box
                       (gdk-event-button-x event)
                       (gdk-event-button-y event))
             (setf load-timeout
                   (gdk-threads-add-timeout 100
                       (lambda ()
                         (progressive-timeout image))))))
        (gtk-container-add vgrid label)
        (gtk-container-add event-box image)
        (gtk-container-add frame event-box)
        (gtk-container-add vgrid frame))

      ;; Sensitivity control
      (let ((button (make-instance 'gtk-toggle-button
                                   :margin-top 12
                                   :label "Insensitive")))
        (g-signal-connect button "toggled"
           (lambda (widget)
             (let ((childs (gtk-container-get-children vgrid)))
               (dolist (child childs)
                 (unless (g-type-is-a (g-object-type child)
                                      "GtkToggleButton")
                   (if (gtk-toggle-button-active button)
                       (progn
                         (setf (gtk-widget-sensitive child) nil)
                         (setf (gtk-button-label button) "Sensitive"))
                       (progn
                         (setf (gtk-widget-sensitive child) t)
                         (setf (gtk-button-label button) "Insensitve"))))))))
        (gtk-container-add vgrid button))

      (gtk-container-add window vgrid)
      (gtk-widget-show-all window)))))
@end verbatim

@c -----------------------------------------------------------------------------
@node Progress Bars, Statusbars, Images, Top
@section Progress Bars

@findex gtk-progress-bar-new
@findex progress-bar-new, gtk-progress-bar-new
@findex gtk-progress-bar-fraction
@findex progress-bar-fraction, gtk-progress-bar-fraction

@ifnotinfo
@float Figure, figure-progress-bar
@caption{Progress Bar}
@center @image{figures/progress-bar302x196, 201pt}
@end float
@end ifnotinfo

Progress bars are implemented as the class @xurl{gtk-progress-bar} and are used
to show the status of an operation.  They are pretty easy to use, as you will
see with the code below.  But first lets start out with the function
@xurl{gtk-progress-bar-new} to create a new progress bar.  Now that the progress
bar has been created we can use it and set the fraction with the function
@xurl{gtk-progress-bar-fraction}, which has two arguments.  The first
argument is the progress bar you wish to operate on, and the second argument is
the amount "completed", meaning the amount the progress bar has been filled from
0 - 100%.  This is passed to the function as a real number ranging from 0 to 1.

A progress bar may be set to one of a number of orientations using the function
@xurl{gtk-orientable-orientation}.  The second argument is the
orientation and may take one of the values of @code{:horizontal} or
@code{:vertical} of the @xurl{gtk-orientation} enumeration.  Progress bars
normally grow from top to bottom or left to right. With the function
@xurl{gtk-progress-bar-inverted} can be set to grrow in the opposite
direction.

As well as indicating the amount of progress that has occurred, the progress bar
may be set to just indicate that there is some activity.  This can be useful in
situations where progress cannot be measured against a value range.  The
function @xurl{gtk-progress-bar-pulse} indicates that some progress has been
made.  The step size of the activity indicator is set using the function
@xurl{gtk-progress-bar-set-pulse-step}.

The progress bar can also display a configurable text string within its trough,
using the function @xurl{gtk-progress-bar-text}.  You can turn off the
display of the string by calling @xurl{gtk-progress-bar-text} again with
@code{NIL} as second argument.  The current text setting of a progress bar can
be retrieved with the function @xurl{gtk-progress-bar-text}.

Progress Bars are usually used with timeouts or other such functions (see
section on Timeouts, I/O and Idle Functions) to give the illusion of
multitasking.  All will employ the @xurl{gtk-progress-bar-fraction} or
@xurl{gtk-progress-bar-pulse} functions in the same manner.

@ref{example-progress-bar} shows an example of the progress bar, updated using
timeouts.  This code also shows you how to reset the Progress Bar.  The output
of this example is in @ref{figure-progress-bar}.

@float Example, example-progress-bar
@caption{Progress Bar}
@end float
@verbatim
(defstruct pbar-data
  pbar
  timer
  mode)

(defun progress-bar-timeout (pdata)
  (if (pbar-data-mode pdata)
      (gtk-progress-bar-pulse (pbar-data-pbar pdata))
      (let ((val (+ (gtk-progress-bar-fraction (pbar-data-pbar pdata))
                    0.01)))
        (when (> val 1.0) (setq val 0.0))
        (setf (gtk-progress-bar-fraction (pbar-data-pbar pdata)) val)))
  t)

(defun example-progress-bar ()
  (within-main-loop
    (let ((window (make-instance 'gtk-window
                                 :type :toplevel
                                 :title "GTK+ 3.4 Example Progress Bar"
                                 :default-width 300))
          (pdata (make-pbar-data :pbar (make-instance 'gtk-progress-bar)))
          (vbox (make-instance 'gtk-box
                               :orientation :vertical
                               :border-width 12
                               :spacing 12))
          (align (gtk-alignment-new 0.1 0.9 1.0 0.0))
          (table (gtk-table-new 2 3 t)))
      (setf (pbar-data-timer pdata)
            (g-timeout-add 100
                           (lambda ()
                             (progress-bar-timeout pdata))))
      (g-signal-connect window "destroy"
                        (lambda (widget)
                          (declare (ignore widget))
                          (g-source-remove (pbar-data-timer pdata))
                          (setf (pbar-data-timer pdata) 0)
                          (leave-gtk-main)))
      (gtk-box-pack-start vbox align)
      (gtk-container-add align (pbar-data-pbar pdata))
      (gtk-box-pack-start vbox table)
      (let ((check (gtk-check-button-new-with-mnemonic "_Show text")))
        (g-signal-connect check "clicked"
           (lambda (widget)
             (declare (ignore widget))
             (let ((text (gtk-progress-bar-text (pbar-data-pbar pdata))))
               (if (or (null text) (zerop (length text)))
                   (setf (gtk-progress-bar-text (pbar-data-pbar pdata))
                         "Some text")
                   (setf (gtk-progress-bar-text (pbar-data-pbar pdata)) ""))
               (setf (gtk-progress-bar-show-text (pbar-data-pbar pdata))
                     (gtk-toggle-button-active check)))))
        (gtk-table-attach table check 0 1 0 1))
      (let ((check (gtk-check-button-new-with-label "Activity mode")))
        (g-signal-connect check "clicked"
           (lambda (widget)
             (declare (ignore widget))
             (setf (pbar-data-mode pdata)
                   (not (pbar-data-mode pdata)))
             (if (pbar-data-mode pdata)
                 (gtk-progress-bar-pulse (pbar-data-pbar pdata))
                 (setf (gtk-progress-bar-fraction (pbar-data-pbar pdata))
                       0.0))))
        (gtk-table-attach table check 0 1 1 2))
      (let ((check (gtk-check-button-new-with-label "Inverted")))
        (g-signal-connect check "clicked"
           (lambda (widget)
             (declare (ignore widget))
             (setf (gtk-progress-bar-set-inverted (pbar-data-pbar pdata))
                   (gtk-toggle-button-active check))))
        (gtk-table-attach table check 0 1 2 3))
      (let ((button (gtk-button-new-with-label "Close")))
        (g-signal-connect button "clicked"
                          (lambda (widget)
                            (declare (ignore widget))
                            (gtk-widget-destroy window)))
        (gtk-box-pack-start vbox button))
      (gtk-container-add window vbox)
      (gtk-widget-show-all window))))
@end verbatim

@c -----------------------------------------------------------------------------
@node Statusbars, Info Bars, Progress Bars, Top
@section Statusbars

@ifnotinfo
@float Figure, figure-statusbar
@caption{Statusbar}
@center @image{figures/statusbar302x142, 201pt}
@end float
@end ifnotinfo

Statusbars are simple widgets used to display a text message.  They keep a stack
of the messages pushed onto them, so that popping the current message will
re-display the previous text message.

In order to allow different parts of an application to use the same statusbar
to display messages, the statusbar widget issues context Identifiers which are
used to identify different "users".  The message on top of the stack is the one
displayed, no matter what context it is in. Messages are stacked in
last-in-first-out order, not context identifier order.

A statusbar is created with a call to @xurl{gtk-statusbar-new}.  A new context
Identifier is requested using a call to the function
@xurl{gtk-statusbar-get-context-id} with a short textual description of the
context as the second argument.

There are three functions that can operate on statusbars:
@xurl{gtk-statusbar-push}, @xurl{gtk-statusbar-pop}, and
@xurl{gtk-statusbar-remove}.  The first function, @xurl{gtk-statusbar-push}, is
used to add a new message to the statusbar.  It returns a message identifier,
which can be passed later to the function @xurl{gtk-statusbar-remove} to remove
the message with the given message and context identifiers from the stack of
the statusbar.  The function @xurl{gtk-statusbar-pop} removes the message
highest in the stack with the given context identifier.

@ref{example-statusbar} creates a statusbar and two buttons, one for pushing
items onto the statusbar, and one for popping the last item back off.

@float Example, example-statusbar
@caption{Statusbar}
@end float
@verbatim
(defun example-statusbar ()
  (within-main-loop
    (let* ((window (make-instance 'gtk-window
                                  :type :toplevel
                                  :title "Example Status Bar"
                                  :default-width 300
                                  :border-width 12))
           (vbox (make-instance 'gtk-vbox
                                :homogeneous nil
                                :spacing 3))
           (statusbar (make-instance 'gtk-statusbar))
           (id (gtk-statusbar-get-context-id statusbar "Example Status Bar"))
           (count 0))
      (g-signal-connect window "destroy"
                        (lambda (widget)
                          (declare (ignore widget))
                          (leave-gtk-main)))
      (gtk-box-pack-start vbox statusbar)
      (let ((button (gtk-button-new-with-label "Push Item")))
        (g-signal-connect button "clicked"
           (lambda (widget)
             (declare (ignore widget))
             (setq count (+ 1 count))
             (gtk-statusbar-push statusbar id (format nil "Item ~A" count))))
        (gtk-box-pack-start vbox button :expand t :fill t :padding 3))
      (let ((button (gtk-button-new-with-label "Pop Item")))
        (g-signal-connect button "clicked"
           (lambda (widget)
             (declare (ignore widget))
             (gtk-statusbar-pop statusbar id)))
        (gtk-box-pack-start vbox button :expand t :fill t :padding 3))
      (gtk-container-add window vbox)
      (gtk-widget-show window))))
@end verbatim

@c -----------------------------------------------------------------------------
@node Info Bars, , Statusbars, Top
@section Info Bars

@ifnotinfo
@float Figure, figure-info-bar
@caption{Info Bar}
@center @image{figures/info-bar385x165, 257pt}
@end float
@end ifnotinfo

@xurl{gtk-info-bar} is a widget that can be used to show messages to the user
without showing a dialog.  It is often temporarily shown at the top or bottom of
a document.  In contrast to @xurl{gtk-dialog}, which has a horizontal action
area at the bottom, @xurl{gtk-info-bar} has a vertical action area at the side.

The API of @xurl{gtk-info-bar} is very similar to @xurl{gtk-dialog}, allowing
you to add buttons to the action area with @xurl{gtk-info-bar-add-button} or
@xurl{gtk-info-bar-new-with-buttons}.  The sensitivity of action widgets can be
controlled with @xurl{gtk-info-bar-set-response-sensitive}.  To add widgets to
the main content area of a @xurl{gtk-info-bar}, use the function
@xurl{gtk-info-bar-get-content-area} and add your widgets to the container.

Similar to @xurl{gtk-message-dialog}, the contents of a @xurl{gtk-info-bar} can
by classified as error message, warning, informational message, etc, by using
@xurl{gtk-info-bar-message-type}.  GTK+ uses the message type to determine
the background color of the message area.

@float Example, example-info-bar
@caption{Info Bar}
@end float
@verbatim
(defun example-info-bar ()
  (within-main-loop
    (let* ((window (make-instance 'gtk-window
                                  :type :toplevel
                                  :title "Example Info bar"
                                  :border-width 12
                                  :default-width 250))
           (grid (make-instance 'gtk-grid))
           (info-bar (make-instance 'gtk-info-bar
                                    :no-show-all t))
           (message (make-instance 'gtk-label
                                   :label ""))
           (content (gtk-info-bar-get-content-area info-bar)))
      (g-signal-connect window "destroy"
                        (lambda (widget)
                          (declare (ignore widget))
                          (leave-gtk-main)))
      (gtk-widget-show message)
      ;; Add a label to the content area of the info bar
      (gtk-container-add content message)
      ;; Add a button OK to the action area
      (gtk-info-bar-add-button info-bar "gtk-ok" 1)
      ;; Add two more buttons to the action area
      (gtk-info-bar-add-buttons info-bar "gtk-cancel" 2
                                         "gtk-no" 3)
      ;; Connect a handler for the "response" signal of the info bar
      (g-signal-connect info-bar "response"
         (lambda (widget response-id)
           (declare (ignore widget))
           (format t "response-id is ~A~%" response-id)
           (gtk-widget-hide info-bar)))
      (gtk-grid-attach grid info-bar 0 2 1 1)
      ;; Show the info bar
      (gtk-label-set-text message "An Info Message in the content area.")
      (setf (gtk-info-bar-message-type info-bar) :info)
      (gtk-widget-show info-bar)
      ;; Add the container grid to the window and show all
      (gtk-container-add window grid)
      (gtk-widget-show-all window))))
@end verbatim

@c -----------------------------------------------------------------------------
@c @node Status Icon, Spinner, Info Bars, Top
@c @node Spinner, , Status Icon, Top

