;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; log4scm-viewer
;;;
;;; Author            : Hans Oesterholt-Dijkema
;;; License           : LGPL
;;; Short Description : This module provides the application for
;;;                     viewing log files.
;;;
;;; $Id: log4scm-viewer.scm,v 1.9 2007/04/30 17:34:16 HansOesterholt Exp $
;;;
;;; $Log: log4scm-viewer.scm,v $
;;; Revision 1.9  2007/04/30 17:34:16  HansOesterholt
;;; *** empty log message ***
;;;
;;; Revision 1.8  2007/04/30 17:22:51  HansOesterholt
;;; *** empty log message ***
;;;
;;; Revision 1.7  2006/01/27 10:21:50  HansOesterholt
;;; * Changed log4scm-viewer to support Gtk 2.4 for
;;;   the about dialog. (gtk-about-dialog isn't available
;;;   int Gtk 2.4).
;;;
;;; Revision 1.6  2006/01/09 00:29:05  HansOesterholt
;;; no message
;;;
;;; Revision 1.5  2006/01/05 20:30:38  HansOesterholt
;;; Adaptation to planet requires
;;;
;;; Revision 1.4  2005/12/16 07:23:18  HansOesterholt
;;; array changed
;;;
;;; Revision 1.3  2005/11/22 19:53:02  HansOesterholt
;;; no message
;;;
;;; Revision 1.2  2005/11/13 20:02:18  HansOesterholt
;;; -- Small things
;;;
;;; Revision 1.1  2005/11/13 19:44:11  HansOesterholt
;;; - Bug fixing.
;;; - Making things more consistent.
;;; - Adding the log4scm-viewer application
;;; - Making things start as a real windows application.
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(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.9 $"
					   '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)
      ;(log4scm-mzgtk2 (lambda (submenu)
;			(-> menu add submenu))
	;	      (lambda (widget)
	;		(-> panel add widget 'name 'log4scm-cfg)))

      (-> 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)

  ; Create log file, directory, etc and start log4scm

  (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
  )

)