(module log4scm-viewer mzscheme
(require (lib "mzgtk2.scm" "mzgtk2"))
(require (planet "sutil.scm" ("oesterholt" "ho-utils.plt" 1 0)))
(require (planet "sprefs.scm" ("oesterholt" "ho-utils.plt" 1 0)))
(require (planet "array.scm" ("oesterholt" "datastructs.plt" 1 0)))
(require (planet "internat.scm" ("oesterholt" "internat.plt" 1 0)))
(require (planet "log4scm.scm" ("oesterholt" "log4scm.plt" 1 0)))
(require (planet "log4scm-cfg.scm" ("oesterholt" "log4scm.plt" 1 0)))
(require (planet "log4scm-mzgtk2.scm" ("oesterholt" "log4scm.plt" 1 0)))
(provide main)
(def-class
(this (alt-help-dlg parent))
(supers)
(private)
(public
(define (run)
(gtk-message-dialog parent
'info
'ok
"log4scm-viewer\n(c) 2005 Hans Oesterholt-Dijkema\n\nWritten using mzgtk2 for mzscheme"
))
(define (destroy)
#t)
)
(constructor)
)
(define (make-gui)
(let ((menu #f)
(panel #f)
(panel-number 0)
(menus (array)))
(define (about top-level-window)
(let ((dlg (with-handlers ((exn:fail? (lambda (exn) (alt-help-dlg top-level-window))))
(gtk-about 'parent top-level-window
'app-name "log4scm-viewer"
'version "$Revision: 1.8 $"
'copyright "(c) 2005 Hans Oesterholt-Dijkema\n\nWritten using mzgtk2 for mzscheme"
'license "LGPL"
'website ""
'authors (list "Hans Oesterholt-Dijkema")
'artists ""
'documenters ""
'translators ""
'logo (gtk-image 'file "log4scm.jpg")))))
(-> dlg run)
(-> dlg destroy)))
(define (quit top-level-window)
(let ((wh (-> top-level-window size))
(xy (-> top-level-window position)))
(sprefs-set! '(oodb width) (car wh))
(sprefs-set! '(oodb height) (cadr wh))
(sprefs-set! '(oodb x) (car xy))
(sprefs-set! '(oodb y) (cadr xy))
(log-info "Quitting log viewer")
(-> top-level-window destroy)
(gtk-main-quit)))
(define (new-log top-level-window)
(display (format "adding new tab ~%"))
(set! panel-number (+ panel-number 1))
(log4scm-mzgtk2 (lambda (submenu)
(array-set! menus (- panel-number 1) submenu)
(-> menu insert submenu 1)
(-> menu show-all))
(lambda (widget)
(-> panel add widget (number->string panel-number) panel-number)
(-> widget show-all)
(-> panel current-page panel-number))
(lambda (label)
(-> panel tab-label panel-number label)))
#t
)
(let* ((window (gtk-window 'name 'main-window 'title (_"LOG4SCM - Log viewer")))
(_menu (gtk-menu-menubar 'name 'main 'expand #f))
(item #f)
(submenu (gtk-menu-submenu 'name 'file 'label (_ "_Main")
'entries
(list
(gtk-menu-label 'name 'new
'label (_ "_New log")
'closure new-log
'accelerator (gtk-accelerator "<Ctrl>n" '(log4scm-viewer main new-log)))
(gtk-menu-label 'name 'quit
'label (_ "_Quit")
'closure quit
'accelerator (gtk-accelerator "<Ctrl>q" '(log4scm-viewer main quit))))))
(about (gtk-menu-submenu 'name 'help 'label (_ "_Help")
'entries
(list
(gtk-menu-label 'name 'about
'label (_ "_About")
'closure about))))
(_panel (gtk-notebook))
(sbar (gtk-statusbar 'has-resize-grip #t 'expand #f))
(vbox (gtk-vbox 'widgets (list _menu _panel sbar))))
(set! menu _menu)
(set! panel _panel)
(-> panel connect "switch-page"
(lambda (nb pagenum)
(display (format "pagenumber selected: ~a ~%" pagenum))
(do
((i 0 (+ i 1))
(N (array-length menus)))
((>= i N) #t)
(if (= i pagenum)
(begin
(display (format "showing menu ~a ~a ~%" i (array->list menus)))
(-> (array-ref menus i) show))
(begin
(display (format "hiding menu ~a ~a ~%" i (array->list menus)))
(-> (array-ref menus i) hide))))))
(-> window connect "delete-event" quit)
(-> menu add submenu)
(-> menu add about)
(new-log window)
(-> window add vbox)
(-> window size (sprefs-get '(oodb width) 700) (sprefs-get '(oodb height) 600))
(-> window move (sprefs-get '(oodb x) 200) (sprefs-get '(oodb y) 200))
(-> window icon (gtk-image 'file "log4scm.ico"))
window)))
(define (main)
(mkdir-p (home "log4scm"))
(let ((logcfg (log4scm-cfg (home "log4scm/log4scm-viewer.scfg"))))
(-> logcfg commit))
(log-start (home "log4scm/log4scm-viewer"))
(log-info "log4scm-viewer started")
(sprefs-new "log4scm-viewer")
(let ((main-window (make-gui)))
(gtk-show-all main-window)
(gtk-main))
(mzgtk2-alive-gobjects)
(log-info "log4scm-viewer ended")
(log-stop)
0
)
)