This is the mail archive of the guile@cygnus.com mailing list for the guile project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]

Re: printed representation -> C string


robert havoc pennington wrote:

> > If so, it would be very groovy to have a kind of Guile I/O port that
> > reads/writes to a Gtk text widget.  That would make what you wanted
> > very easy to implement: (write object widget-port)

> That'd be neat. Personally I'd have no idea how to go about it though...

You have to use gtk-text-insert.

This example reads a string from an entry, evaluates it and writes the
result into a GTK text widget:

#! /usr/bin/guile \
-e main -s
!#

(use-modules (toolkits gtk))

(define (main args)

  (let ((window (gtk-window-new 'toplevel))
	(vbox (gtk-vbox-new #f 5))
	(hbox1 (gtk-hbox-new #f 5))
	(prompt (gtk-label-new scm-repl-prompt))
	(expr-entry (gtk-entry-new))
	(eval-button (gtk-button-new-with-label "Evaluate"))
	(hbox2 (gtk-hbox-new #f 5))
	(label (gtk-label-new "Status:"))
	(status (gtk-label-new "Enter a Scheme expression. To exit enter
(gtk-exit)."))
	(text (gtk-text-new #f #f)))

    (gtk-container-border-width window 5)
    (gtk-signal-connect window "delete_event"
			(lambda (ev) #t))
    (gtk-signal-connect window "destroy" gtk-exit)

    (gtk-container-add window vbox)
    (gtk-widget-show vbox)

    (gtk-box-pack-start vbox hbox1 #f #f 0)
    (gtk-widget-show hbox1)

    (gtk-box-pack-start hbox1 prompt #f #f 0)
    (gtk-widget-show prompt)
    
    (gtk-container-add hbox1 expr-entry)
    (gtk-widget-show expr-entry)

    (let ((evaluation
	   (lambda ()
	     (let ((status-str "Ok"))
	       (gtk-text-set-point text 0)
	       (gtk-text-insert text "-*-courier-medium-r-*-*-12-*-*-*-*-*-*-*"
#f #f
				(with-output-to-string
				  (lambda ()
				    (let ((expr (with-input-from-string
						    (gtk-entry-get-text expr-entry)
						  (lambda ()
						    (catch #t
							   (lambda ()
							     (read))
							   (lambda (key . args)
							     (set! status-str
								   "Error in expression!")))))))
				      (write expr)
				      (display " => ")
				      (write (catch #t
						    (lambda ()
						      (eval expr))
						    (lambda (key . args)
						      (set! status-str
							    "Error during evaluation!"))))
				      (newline))))
				-1)
	       (gtk-text-thaw text)
	       (gtk-label-set status status-str)))))
      (gtk-signal-connect eval-button "clicked" evaluation))
    (gtk-box-pack-end hbox1 eval-button #f #f 0)
    (gtk-widget-show eval-button)

    (gtk-box-pack-start vbox hbox2 #f #f 0)
    (gtk-widget-show hbox2)

    (gtk-box-pack-start hbox2 label #f #f 0)
    (gtk-widget-show label)
    
    (gtk-misc-set-alignment status 0.0 0.5)
    (gtk-box-pack-start hbox2 status #f #f 0)
    (gtk-widget-show status)
    
    (gtk-container-add vbox text)
    (gtk-widget-show text)

    (gtk-widget-show window)
    
    (gtk-main)))

; Local Variables:
; mode: scheme
; End:

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