scheme/std-toolbar.scm

   1 ;
   2 ; module providing standard "toolbar" buttons for gwave
   3 ;
   4
   5 (define-module (app gwave std-toolbar)
   6   :use-module (gnome-2)
   7   :use-module (gnome gtk)
   8   :use-module (app gwave cmds)
   9   :use-module (app gwave globals)
  10   :use-module (app gwave gtk-helpers)
  11 )
  12
  13 (dbprint "std-toolbar.scm running\n")
  14 (set! gwave-std-toolbar-loaded #t)
  15
  16 (define (button label tip proc)
  17   (let ((item (gtk-button-new-with-label label)))
  18     (gtk-widget-show item)
  19     (if proc
  20         (gtk-signal-connect item "clicked"
  21                             (lambda (b) (proc))))
  22     (if tip
  23         (gtk-tooltips-set-tip gwave-tooltips item tip ""))
  24     item))
  25
  26 (add-hook!
  27  new-wavewin-hook
  28  (lambda ()
  29 ;   (display "in std-toolbar new-wavewin-hook") (newline)
  30    (let ((tbar (get-wavewin-toolbar)))
  31      (gtk-container-add tbar (button "Zoom In" #f
  32                                      (lambda () (x-zoom-relative! 2))))
  33      (gtk-container-add tbar (button "Zoom Out"  #f
  34                                      (lambda () (x-zoom-relative! 0.5))))
  35      (gtk-container-add tbar (button "Delete" "Delete selected waves"
  36                                      (lambda () (delete-selected-waves!))))
  37      (gtk-container-add tbar (button "Reload All"
  38                                      "Reread all waveform data files"
  39                                      reload-all-files!))
  40 )))
  41
  42 (dbprint "std-toolbar.scm done\n")