Re: Pixmap Oddities I

[Sascha Ziemann <szi aibon ping de>]

"Didimo E. Grimaldo T." <grimaldo@panama.iaehv.nl> writes:

| Hi *,
|      I am experiencing some odd behaviour with the pixmap stuff. I have
|      a dialog that looks like this:
| 
|      +-------------------------------+
|      | **********    This is the     |  
|      | * *   *  *     message part   |
|      | *  * *   *                    |
|      | *   *    *                    |
|      | **********                    |
|      | ----------------------------- |
|      |   { OK }     { CANCEL }       |
|      +-------------------------------+

This is what I wrote some time ago in Scheme:

;;
;; Search through a list of pixmap paths and return a full qualified filename for a readable
;; pixmap file.
;;
(define (pixmap-full-name name)
  (string-append ;"/usr/share/pixmap/guilegtk-stdlg-"
                 name ".xpm"))

;;
;; Create a Question/Waring/Error Dialog that contains a icon on the left side depending on the
;; type of dialog, a message next to the icon and some buttons at the bottom.
;;
;; Example:
;; (create-message-dialog 'question "Shall I do it?"
;;                        `(ok "Yes" ,(lambda () (display "I do it now\n")))
;;                        `(cancel "No" ,(lambda () (display "I don't do it\n"))))
;; => window
;;
(define-public (create-message-dialog type message . buttons)
  (let ((window (gtk-window-new 'toplevel))
        (vbox (gtk-vbox-new #f 0))
        (title (or (assq-ref '((question . "Question")
                               (warning . "Warning")
                               (error . "Error"))
                             type)
                   (throw 'unknown-dialog-type)))
        (pixmap-name (or (assq-ref '((question . "question")
                                     (warning . "warning")
                                     (error . "error"))
                                   type)
                         (throw 'unknown-dialog-type))))

    (gtk-window-set-title window title)
    (gtk-signal-connect* window "delete_event" (lambda (ev) #t))
    (gtk-container-border-width window 5)
    (gtk-container-add window vbox)
    (gtk-widget-show vbox)

    ; icon and message
    (let ((hbox (gtk-hbox-new #f 0)))
      (gtk-box-pack-start vbox hbox #f #f 5)
      (gtk-widget-show hbox)
      ; create icon
      (let ((pixmap (gtk-pixmap-new (pixmap-full-name pixmap-name) hbox)))
        (gtk-box-pack-start hbox pixmap #f #f 10)
        (gtk-widget-show pixmap))
      ; and message
      (let ((label (gtk-label-new message)))
        (gtk-box-pack-start hbox label #f #f 10)
        (gtk-widget-show label)))
    
    ; buttons
    (let ((bbox (gtk-hbutton-box-new)))
      (gtk-button-box-set-layout bbox 1)
      (gtk-box-pack-start vbox bbox #f #f 10)
      (gtk-widget-show bbox)
      (for-each (lambda (button-def)
                  (apply (lambda (type label callback)
                           (let ((button (gtk-button-new-with-label label)))
                             (gtk-signal-connect* button "clicked"
                                                 (lambda ()
                                                   (gtk-widget-destroy window)
                                                   (callback)))
                             (if (eq? type 'cancel)
                                 (gtk-signal-connect* window "delete_event"
                                                     (lambda (ev)
                                                       (callback)
                                                       #t)))
                             (gtk-container-add bbox button)
                             (gtk-widget-show button)))
                         button-def))
                buttons))

    ; lets's go...
    (gtk-widget-show window)
    window))

-- 
http://www.ping.de/sites/aibon/