[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: glade + guile?
|
From: |
thi |
|
Subject: |
Re: glade + guile? |
|
Date: |
Thu, 19 Oct 2000 14:25:18 -0700 |
From: Neil Jerram <address@hidden>
Date: 19 Oct 2000 21:55:49 +0100
Yes, that's what I would really like too - sorry if that wasn't clear
from my last post. But I don't think I understand your "spacewise"
requirements. Do you mean that you are happy to involve a shared lib
(i.e. expat, via mixp) at translation time, but don't want to use
(another) one (i.e. libglade, via gnome-guile) at run time?
yes exactly. although libglade is only 80kb, you can write a lot of
(high-level) apps w/ 80kb.... [insert timex sinclair nostalgia here]
btw, for the curious, below is some mad hacking that actually produces
runnable (but very buggy) guile-gtk code from a .glade file. i'm
working on bugfixes now and then later, getting it generalized (perhaps
by grokking guile-gtk's gtk-1.2.defs file). sad to say, still haven't
used grover yet, but that will come into play when generalizing, i
think. even further below is the input .glade file and even further is
the generated output, prepended w/ some hand-written stubs.
this is very much a work in progress! some of the (ttn ...) modules
are not yet released -- mail me privately if you want a snapshot. also,
i'm no expert on anything gui (having resisted running X until this
year), and so am interested in an educated review of the code, most
specifically the general form produced by the `make-code' proc -- is
that something i can live with forever, or will there be some gotcha
down the line requiring redesign?
thi
__________________________
;;; glade2scm --- translate .glade files to guile-gtk code
;; $State$:$Name$
;;
;; Copyright (C) 2000 Thien-Thi Nguyen
;; This file is part of ttn's personal scheme library, released under GNU
;; GPL with ABSOLUTELY NO WARRANTY. See the file COPYING for details.
;;; Commentary:
;;; Code:
(let ((slib-parent-dir '/home/ttn/codebits/scheme))
(or (member slib-parent-dir %load-path)
(set! %load-path (cons slib-parent-dir %load-path))))
(use-modules (ice-9 format))
(define-module (ice-9 format) :use-module (ice-9 slib))
(define-module (guile) :use-module (ice-9 format))
(use-modules (ttn echo))
(use-modules (ttn mixp))
(use-modules (ice-9 regex))
(define all-whitespace-rx (make-regexp "^[ \t\n]+$"))
(define (aset! a idx val) (array-set! a val idx))
(define (aref a idx) (array-ref a idx))
(define (make-suda) ; standard user-data array
(vector 0 ; 0: level
0 ; 1: previous level
'() ; 2: tree
))
(define (roll-level suda) (aset! suda 1 (aref suda 0)))
(define (level+ suda) (aset! suda 0 (1+ (aref suda 0))))
(define (level- suda) (aset! suda 0 (1- (aref suda 0))))
(if (getenv "DEBUG")
(begin
(define decho echo)
(define dechow echow))
(begin
(define (decho . args) #t)
(define (dechow . args) #t)))
(define all-upcase-and-underscore-rx (make-regexp "^[A-Z_]+$"))
(define all-upcase-rx (make-regexp "^[A-Z]+$"))
(define all-numeric-rx (make-regexp "^[0-9.]+$"))
(define all-numeric-and-comma-rx (make-regexp "^[0-9.,]+$"))
(use-modules (ice-9 string-fun))
(define (interpret-atom s) ; heuristical, bfd
(cond ((string=? "True" s) #t)
((string=? "False" s) #f)
((and (< 4 (string-length s))
(string=? "GTK_" (substring s 0 4))
(regexp-exec all-upcase-and-underscore-rx s))
(string->symbol s))
((and (< 4 (string-length s))
(string=? "Gtk" (substring s 0 3))
(regexp-exec all-upcase-rx (substring s 3 4)))
(string->symbol s))
((regexp-exec all-numeric-rx s)
(string->number s))
((regexp-exec all-numeric-and-comma-rx s)
(map interpret-atom (separate-fields-discarding-char #\, s list)))
(else s)))
(define (make-glade-parser suda)
(make-fully-specified-expat-parser
suda
(vector
(lambda (suda name attributes) ; 0: element start
(level+ suda)
(let ((all (aref suda 2)))
(set! all (append
(cons (list name)
(make-list (- (aref suda 0) (length all))
'()))
all))
(aset! suda 2 all))
(roll-level suda)
(decho 'e+ name attributes))
(lambda (suda name) ; 1: element end
(level- suda)
(let* ((all (aref suda 2))
(chunk (let ((rev (reverse (car all))))
(cons (string->symbol (car rev))
(let ((cr (cdr rev)))
(cond ((null? cr) cr)
((and (= 1 (length cr))
(string? (car cr)))
(interpret-atom (car cr)))
(else cr)))))))
(set-car! (cdr all) (cons chunk (cadr all)))
(set! all (cdr all))
(aset! suda 2 all))
(roll-level suda)
(decho 'e- name))
(lambda (suda value) ; 2: character data
(or (regexp-exec all-whitespace-rx value)
(let ((all (aref suda 2)))
(set-car! all (cons value (car all)))
(aset! suda 2 all)
(decho 'c value))))
(lambda (suda name pi-data) ; 3: processing instruction
(decho 'pi name pi-data))
(lambda (suda comment-data) ; 4: comment
(dechow 'comment comment-data))
(lambda (suda) ; 5: cdata start
(decho 'cd+))
(lambda (suda) ; 6: cdata end
(decho 'cd-))
(lambda (suda string) ; 7: default
(dechow 'default string))
(lambda (suda entity-name ; 8: unparsed entity decl
base system-id
public-id
notation-name)
(decho 'unparsed-entity-decl
entity-name base system-id public-id notation-name))
(lambda (suda prefix uri) ; 9: namespace decl start
(decho 'namespace+ prefix uri))
(lambda (suda prefix uri) ; 10: namespace decl end
(decho 'namespace- prefix uri))
(lambda (suda) ; 11: not-standalone
(decho 'not-standalone))
(lambda (suda context base ; 12: external entity ref
system-id public-id)
(decho 'ext-ent-ref context base system-id public-id)
(open-file system-id "r"))
(lambda (encoding-handler-data ; 13: uknown encoding
name info)
(decho 'unknown-encoding encoding-handler-data name info))
)))
(define (glade->project+widget-trees filename)
(let ((suda (make-suda)))
(parse-xml (make-glade-parser suda) (open-file filename "r"))
(let ((p+w-tree (caar (aref suda 2))))
(or (false-if-exception (and (eq? 'GTK-Interface (car p+w-tree))
(eq? 'project (caadr p+w-tree))))
(error "ill formed glade file" filename))
(values (cadr p+w-tree)
(cddr p+w-tree)))))
(use-modules (ice-9 common-list))
(define (make-init-code class props) ; todo: hook in w/ gtk-1.2.defs
;;(pk 'props props)
(case class
((GtkWindow)
`(gtk-window-new ',(case (cdr (assq 'type props))
((GTK_WINDOW_TOPLEVEL) 'toplevel)
((GTK_WINDOW_DIALOG) 'dialog)
((GTK_WINDOW_POPUP) 'popup))))
((GtkButton)
(let ((stock (assq 'stock_button props)))
`(gtk-button-new-with-label ,(if stock
(cdr stock) ; for now
(cdr (assq 'label props))))))
((GtkPixmap)
`(gtk-pixmap-new ,(cdr (assq 'filename props)) w))
((GtkLabel)
`(gtk-label-new ,(cdr (assq 'label props))))
((GtkCTree)
`(gtk-ctree-new ,(cdr (assq 'columns props)) 0))
((GtkScrolledWindow)
'(gtk-scrolled-window-new))
((GtkVBox)
`(gtk-vbox-new ,(cdr (assq 'homogeneous props))
,(cdr (assq 'spacing props))))
((GtkCList)
`(gtk-clist-new ,(cdr (assq 'columns props))))
;; Add new init code mappings here.
(else (begin
(echo "WARNING: Class" class "not supported -- faking it!")
`(,(symbol-append 'gtk- class '-new))))))
(define (make-pack-code name class kids)
(let ((count -1))
(map (lambda (kid)
(set! count (1+ count))
(let ((kid-name (object-property kid 'name)))
(case class
((GtkWindow GtkScrolledWindow GtkCTree)
`(gtk-container-add w (pk ',kid-name ,kid-name)))
((GtkVBox GtkHBox)
`(gtk-box-pack-start w (pk ',kid-name ,kid-name) #f #f 0)) ;
for now
((GtkCList)
`(gtk-clist-set-column-widget w ,count (pk ',kid-name
,kid-name)))
;; Add new parent packing mappings here.
(else
(begin (echo "WARNING: Class" class
"packing not supported -- faking it!")
`(gtk-container-add w (pk ',kid-name ,kid-name)))))))
kids)))
(define (make-code kids sigs props)
;;(pk 'kids kids "\n;;; sigs" sigs "\n;;; props" props)
(let* ((name (string->symbol (cdr (assq 'name props))))
(class (cdr (assq 'class props)))
(init (make-init-code class props)))
`(define ,name
(let ((w ,init))
,@kids
,@(make-pack-code name class kids)
,@(map (lambda (ev-handler)
`(gtk-signal-connect w
,(symbol->string (car ev-handler))
,(cdr ev-handler)))
sigs)
w))))
(define (widget-tree->code tree)
(or (eq? 'widget (car tree))
(error "ill formed widget tree" tree))
(let* ((kids '()) (sigs '()) ; fill in
(props (remove-if
(lambda (elem)
(and (list? elem)
(case (car elem)
((widget)
(set! kids (cons (widget-tree->code elem) kids))
#t)
((signal)
(set! sigs (cons
(cons (string->symbol (cdadr elem))
(string->symbol (cdaddr elem)))
sigs))
#t)
(else #f))))
(cdr tree))))
(let ((code (make-code kids sigs props)))
(set-object-property! code 'name (string->symbol
(cdr (assq 'name (cdr tree)))))
(set-object-property! code 'props props)
code)))
(define (glade2scm filename)
(and filename
(file-exists? filename)
(call-with-values (lambda () (glade->project+widget-trees filename))
(lambda (project top-level-widget-trees)
(let* ((w-code (map widget-tree->code top-level-widget-trees))
(w-ret (map (lambda (w) (object-property w 'name)) w-code)))
(for-each (lambda (form)
(format #t "~Y~%" form))
`((use-modules (gtk gtk) (gtk gdk))
(define (make-gtk-gui)
,@w-code
(list ,@w-ret))
;(export make-gtk-gui)
(map gtk-widget-show-all (make-gtk-gui))
(gtk-main)
)))))))
;; do it!
(glade2scm (cadr (command-line)))
;;; glade2scm ends here
____________________________________
<?xml version="1.0"?>
<GTK-Interface>
<project>
<name>Project1</name>
<program_name>project1</program_name>
<directory></directory>
<source_directory>src</source_directory>
<pixmaps_directory>pixmaps</pixmaps_directory>
<language>C</language>
<gnome_support>False</gnome_support>
<gettext_support>True</gettext_support>
<use_widget_names>False</use_widget_names>
<output_main_file>True</output_main_file>
<output_support_files>True</output_support_files>
<output_build_files>True</output_build_files>
<backup_source_files>True</backup_source_files>
<main_source_file>interface.c</main_source_file>
<main_header_file>interface.h</main_header_file>
<handler_source_file>callbacks.c</handler_source_file>
<handler_header_file>callbacks.h</handler_header_file>
<support_source_file>support.c</support_source_file>
<support_header_file>support.h</support_header_file>
<translatable_strings_file></translatable_strings_file>
</project>
<widget>
<class>GtkWindow</class>
<name>window2</name>
<title>window2</title>
<type>GTK_WINDOW_TOPLEVEL</type>
<position>GTK_WIN_POS_NONE</position>
<modal>False</modal>
<allow_shrink>False</allow_shrink>
<allow_grow>True</allow_grow>
<auto_shrink>False</auto_shrink>
<widget>
<class>GtkPixmap</class>
<name>pixmap1</name>
<filename>new.xpm</filename>
<xalign>0.5</xalign>
<yalign>0.5</yalign>
<xpad>0</xpad>
<ypad>0</ypad>
<build_insensitive>True</build_insensitive>
</widget>
</widget>
<widget>
<class>GtkWindow</class>
<name>window3</name>
<title>window3</title>
<type>GTK_WINDOW_TOPLEVEL</type>
<position>GTK_WIN_POS_NONE</position>
<modal>False</modal>
<allow_shrink>False</allow_shrink>
<allow_grow>True</allow_grow>
<auto_shrink>False</auto_shrink>
<widget>
<class>GtkVBox</class>
<name>vbox1</name>
<homogeneous>False</homogeneous>
<spacing>0</spacing>
<widget>
<class>GtkButton</class>
<name>button4</name>
<can_focus>True</can_focus>
<signal>
<name>clicked</name>
<handler>refresh-clist</handler>
<last_modification_time>Thu, 19 Oct 2000 19:11:25
GMT</last_modification_time>
</signal>
<label>button4</label>
<child>
<padding>0</padding>
<expand>False</expand>
<fill>False</fill>
</child>
</widget>
<widget>
<class>GtkScrolledWindow</class>
<name>scrolledwindow1</name>
<hscrollbar_policy>GTK_POLICY_ALWAYS</hscrollbar_policy>
<vscrollbar_policy>GTK_POLICY_ALWAYS</vscrollbar_policy>
<hupdate_policy>GTK_UPDATE_CONTINUOUS</hupdate_policy>
<vupdate_policy>GTK_UPDATE_CONTINUOUS</vupdate_policy>
<child>
<padding>0</padding>
<expand>True</expand>
<fill>True</fill>
</child>
<widget>
<class>GtkCList</class>
<name>clist1</name>
<can_focus>True</can_focus>
<columns>3</columns>
<column_widths>80,80,80</column_widths>
<selection_mode>GTK_SELECTION_SINGLE</selection_mode>
<show_titles>True</show_titles>
<shadow_type>GTK_SHADOW_IN</shadow_type>
<widget>
<class>GtkLabel</class>
<child_name>CList:title</child_name>
<name>label9</name>
<signal>
<name>button_press_event</name>
<handler>sort-by-filename</handler>
<last_modification_time>Thu, 19 Oct 2000 19:12:39
GMT</last_modification_time>
</signal>
<label>filename</label>
<justify>GTK_JUSTIFY_CENTER</justify>
<wrap>False</wrap>
<xalign>0.5</xalign>
<yalign>0.5</yalign>
<xpad>0</xpad>
<ypad>0</ypad>
</widget>
<widget>
<class>GtkLabel</class>
<child_name>CList:title</child_name>
<name>label10</name>
<signal>
<name>button_press_event</name>
<handler>sort-by-size</handler>
<last_modification_time>Thu, 19 Oct 2000 19:13:02
GMT</last_modification_time>
</signal>
<label>size</label>
<justify>GTK_JUSTIFY_CENTER</justify>
<wrap>False</wrap>
<xalign>0.5</xalign>
<yalign>0.5</yalign>
<xpad>0</xpad>
<ypad>0</ypad>
</widget>
<widget>
<class>GtkLabel</class>
<child_name>CList:title</child_name>
<name>label11</name>
<signal>
<name>button_press_event</name>
<handler>sort-by-i/d/t-size</handler>
<last_modification_time>Thu, 19 Oct 2000 19:13:42
GMT</last_modification_time>
</signal>
<label>i/d/t-size</label>
<justify>GTK_JUSTIFY_CENTER</justify>
<wrap>False</wrap>
<xalign>0.5</xalign>
<yalign>0.5</yalign>
<xpad>0</xpad>
<ypad>0</ypad>
</widget>
</widget>
</widget>
<widget>
<class>GtkButton</class>
<name>button5</name>
<can_focus>True</can_focus>
<stock_button>GNOME_STOCK_BUTTON_CLOSE</stock_button>
<child>
<padding>0</padding>
<expand>False</expand>
<fill>False</fill>
</child>
</widget>
</widget>
</widget>
</GTK-Interface>
___________________________________
(define (sort-by-i/d/t-size)
(write-line "sort-by-i/d/t-size"))
(define (sort-by-size)
(write-line "sort-by-size"))
(define (sort-by-filename)
(write-line "sort-by-filename"))
(define (refresh-clist)
(write-line "refresh-clist"))
(use-modules (gtk gtk) (gtk gdk))
(define (make-gtk-gui)
(define window2
(let ((w (gtk-window-new 'toplevel)))
(define pixmap1
(let ((w (gtk-pixmap-new "new.xpm" w))) w))
(gtk-container-add w (pk 'pixmap1 pixmap1))
w))
(define window3
(let ((w (gtk-window-new 'toplevel)))
(define vbox1
(let ((w (gtk-vbox-new #f 0)))
(define button5
(let ((w (gtk-button-new-with-label
"GNOME_STOCK_BUTTON_CLOSE")))
w))
(define scrolledwindow1
(let ((w (gtk-scrolled-window-new)))
(define clist1
(let ((w (gtk-clist-new 3)))
(define label11
(let ((w (gtk-label-new "i/d/t-size")))
(gtk-signal-connect
w
"button_press_event"
sort-by-i/d/t-size)
w))
(define label10
(let ((w (gtk-label-new "size")))
(gtk-signal-connect
w
"button_press_event"
sort-by-size)
w))
(define label9
(let ((w (gtk-label-new "filename")))
(gtk-signal-connect
w
"button_press_event"
sort-by-filename)
w))
(gtk-clist-set-column-widget
w
0
(pk 'label11 label11))
(gtk-clist-set-column-widget
w
1
(pk 'label10 label10))
(gtk-clist-set-column-widget
w
2
(pk 'label9 label9))
w))
(gtk-container-add w (pk 'clist1 clist1))
w))
(define button4
(let ((w (gtk-button-new-with-label "button4")))
(gtk-signal-connect w "clicked" refresh-clist)
w))
(gtk-box-pack-start
w
(pk 'button5 button5)
#f
#f
0)
(gtk-box-pack-start
w
(pk 'scrolledwindow1 scrolledwindow1)
#f
#f
0)
(gtk-box-pack-start
w
(pk 'button4 button4)
#f
#f
0)
w))
(gtk-container-add w (pk 'vbox1 vbox1))
w))
(list window2 window3))
(map gtk-widget-show-all (make-gtk-gui))
(gtk-main)
_______________________________
[that's all!]