scheme/cmds.scm

   1 ;
   2 ; module providing some simple gwave commands
   3 ;
   4
   5 (define-module (app gwave cmds)
   6   :use-module (oop goops)
   7   :use-module (gnome-2)
   8   :use-module (gnome gtk)
   9   :use-module (ice-9 optargs)
  10   :use-module (app gwave gtk-helpers)
  11 )
  12 (read-set! keywords 'prefix)
  13
  14 ; print list
  15 (define-public (print . l)
  16   (for-each (lambda (e) (display e (current-output-port))) l))
  17
  18 (define-public (append-hook! hook proc)
  19   "Add PROC to HOOK at the end of the list."
  20   (add-hook! hook proc #t))
  21
  22 ; x-axis zoom in/zoom out zoom by this ammount
  23 (define x-zoom-fraction 2)
  24
  25 ;; Zoom the x axis to show the entire independent-variable
  26 ;; range used by all displayed waveforms.
  27 (define-public (x-zoom-full!)
  28   (x-zoom! (wtable-min-xval) (wtable-max-xval)))
  29
  30 ;; Prompt the user to select a range along the x axis with the mouse,
  31 ;; and then zoom in so that the selected range fills the entire displayed
  32 ;; X axis.
  33 (define-public (x-zoom-area!)
  34   (select-range-x
  35    (lambda (wp x1 x2)
  36 ;     (display "in x-zoom-area callback ")
  37 ;     (display wp) (display " ")
  38 ;     (display x1) (display " ")
  39 ;     (display x2) (newline)
  40      (x-zoom! (wavepanel-x2val wp x1) (wavepanel-x2val wp x2)))))
  41
  42 ;; Prompt the user to select with the mouse a range along the Y axis of
  43 ;; a particular wavepanel, and then vertically zoom that wavepanel
  44 ;; so that the selected range fills its entire displayed Y axis.
  45 (define-public (y-zoom-range!)
  46   (select-range-y
  47    (lambda (wp y1 y2)
  48 ;     (print "y-zoom-range callback(" wp ") ")
  49 ;     (print y1 " -> " (wavepanel-y2val wp y1) ", ")
  50 ;     (print y2 " -> " (wavepanel-y2val wp y2) "\n")
  51      (wavepanel-y-zoom! wp (wavepanel-y2val wp y1) (wavepanel-y2val wp y2))
  52 )))
  53
  54
  55 ;; Restore a WavePanel to display the full range of Y values,
  56 ;; and to automaticly rescale as VisibleWaves are added and deleted.
  57 (define-public (y-zoom-fullauto! wp) (wavepanel-y-zoom! wp #f #f))
  58
  59 ;; Prompt the user to select a rectangular region of a WavePanel, and
  60 ;; then zoom in both X and Y so that the selected area fills the whole
  61 ;; window.
  62 (define-public (xy-zoom-area!)
  63   (select-range-xy
  64    (lambda (wp x1 x2 y1 y2)
  65 ;     (display "in xy-zoom-area callback ")
  66 ;     (display wp) (display " ")
  67 ;     (display x1) (display " ")
  68 ;     (display x2) (display " ")
  69 ;     (display y1) (display " ")
  70 ;     (display y2) (newline)
  71      (x-zoom! (wavepanel-x2val wp x1) (wavepanel-x2val wp x2))
  72      (wavepanel-y-zoom! wp (wavepanel-y2val wp y1) (wavepanel-y2val wp y2))
  73 )))
  74
  75 (define (pow base power)
  76     (exp (* power (log base))))
  77
  78 ;; zoom the display's X axis relative to current configuration.
  79 ;; if the zoom factor is greater than 1, we zoom in.
  80 ;; if the zoom factor is less than 1, we zoom out.
  81 (define-public (x-zoom-relative! zf)
  82   (let ((sx (wtable-start-xval))
  83         (ex   (wtable-end-xval)))
  84     (if (not (wtable-xlogscale?))
  85         (let ((center (/ (+ sx ex) 2))
  86               (width (- ex sx)))
  87           (x-zoom! (- center (/ width (* zf 2)))
  88                    (+ center (/ width (* zf 2)))))
  89         (let ((center (sqrt (* ex sx)))
  90               (width (/ ex sx)))
  91           (x-zoom! (/ center (pow width (/ 0.5 zf)))
  92                    (* center (pow width (/ 0.5 zf))))))))
  93
  94 ;; zoom X so that edges of displayed are where the vertical cursors are now.
  95 ;; If both vertical bar cursors aren't displayed, do nothing.
  96 ;;-
  97 ; FIXME:tell:
  98 ;  pop message somewhere if both cursors not displayed
  99 ;  zoom so that cursors are just visible at edges, say 5% in from edge.
 100 (define-public (x-zoom-cursors!)
 101   (let ((c0 (wtable-vcursor 0))
 102         (c1 (wtable-vcursor 1)))
 103     (if (and c0 c1)
 104         (x-zoom! c0 c1))))
 105
 106 ;
 107 ; Implement a simple notion of WavePanel "type" that changes
 108 ; several of the lower-level options together.   Earlier versions
 109 ; had this in C.
 110 ; should also let user choose these parameters independently.
 111 ;
 112
 113 ; instead of multiple lists, these should be a real data structure of some kind
 114 (define-public wavepanel-type-names    (list "Full"  "Slim" "Jumbo"))
 115 (define-public wavepanel-num-types (length wavepanel-type-names))
 116 (define            panel-type-heights  (list 100     20      250))
 117 (define            panel-type-showlabs (list #t      #f      #t))
 118
 119 (define-public (set-wavepanel-type! wp type)
 120   (set-object-property! wp 'wp-type type)
 121   (set-wavepanel-minheight! wp (list-ref panel-type-heights type))
 122   (set-wavepanel-ylabels-visible! wp (list-ref panel-type-showlabs type)))
 123
 124 (define-public (wavepanel-type wp) (object-property wp 'wp-type))
 125
 126 ; wrapper around wtable-insert-panel that pays attention to this type business
 127 (define-public (wtable-insert-typed-panel! wp type)
 128   (wtable-insert-panel! wp
 129                        (list-ref panel-type-heights type)
 130                        (list-ref panel-type-showlabs type)))
 131
 132 ; Add the panel-type property to a new wavepanel, so the context-sensitive
 133 ; menu works properly.
 134 ; For the moment, the standard GUI stuff only calls
 135 ; wtable-insert-typed-panel! with the default type, so this comes out OK.
 136 ; Really need to pass the type through from wtable-insert-typed-panel
 137 ; somehow.  Or else, change the interface.
 138 (add-hook! new-wavepanel-hook
 139            (lambda (wp)
 140              (dbprint "in cmds.scm new-wavepanel-hook " wp "\n")
 141              (set-object-property! wp 'wp-type default-wavepanel-type)))
 142
 143 ; GTK+ helper: make a simple button with a textual label
 144 (define (make-button parent txt func)
 145   (let* ((btn (gtk-button-new-with-label txt)))
 146     (gtk-container-add parent btn)
 147     (gtk-widget-show btn)
 148     (if func (gtk-signal-connect btn "clicked" func))
 149     btn))
 150
 151 ;; Create and show a top-level window with the "about" information
 152 (define-public (show-about-window!)
 153   (let* ((window (make <gtk-window>
 154                                  :type         'toplevel
 155                                  :title        "About Gwave"))
 156          (vbox (gtk-vbox-new #f 10)))
 157     (gtk-container-set-border-width window 10)
 158     (gtk-widget-show vbox)
 159     (gtk-container-add window vbox)
 160     (let ((llab (gtk-label-new
 161                  (string-append "Gwave2 version " gwave-version-string))))
 162       (gtk-widget-show llab)
 163       (gtk-container-add vbox llab))
 164     (let ((llab (gtk-label-new "Copyright 1997-2009 Steve Tell")))
 165       (gtk-widget-show llab)
 166       (gtk-container-add vbox llab))
 167
 168     (let ((llab (gtk-label-new "steve@telltronics.org")))
 169       (gtk-widget-show llab)
 170       (gtk-container-add vbox llab))
 171
 172     (let ((llab (gtk-label-new "Gwave comes with ABSOLUTELY NO WARRANTY.")))
 173       (gtk-widget-show llab)
 174       (gtk-container-add vbox llab))
 175
 176     (let ((llab (gtk-label-new "This is Free Software, and you are welcome to distribute")))
 177       (gtk-widget-show llab)
 178       (gtk-container-add vbox llab))
 179     (let ((llab (gtk-label-new "it under the terms of the GNU General Public License.")))
 180       (gtk-widget-show llab)
 181       (gtk-container-add vbox llab))
 182
 183     (make-button vbox "Close" (lambda (x) (gtk-widget-destroy window)))
 184     (gtk-widget-show window)))
 185
 186 ;; Pop up a dialog box to enter new axis limits (zoom setting) for a wavepanel.
 187 (define-public (show-zoom-dialog! wp)
 188   (let* ((window (make <gtk-window>
 189                                  :type         'toplevel
 190                                  :title        "Gwave axis settings"))
 191          (vbox (gtk-vbox-new #f 5))
 192          (hbox (gtk-hbox-new #f 5))
 193          (frame_x (gtk-frame-new "Global X Axis"))
 194          (table_x (gtk-table-new 3 3 #f))
 195          (start_x_entry (gtk-entry-new))
 196          (end_x_entry (gtk-entry-new))
 197          (frame_y (gtk-frame-new "Panel Y Axis"))
 198          (table_y (gtk-table-new 3 4 #f))
 199          (start_y_entry (gtk-entry-new))
 200          (end_y_entry (gtk-entry-new))
 201          (man_y_button (gtk-toggle-button-new-with-label "Auto Full-Scale"))
 202          (max-rect (wavepanel-max-rect wp))
 203          (disp-rect (wavepanel-disp-rect wp))
 204          )
 205     (gtk-container-set-border-width window 5)
 206     (gtk-table-set-row-spacings table_x 3)
 207     (gtk-table-set-col-spacings table_x 3)
 208     (gtk-table-set-row-spacings table_y 3)
 209     (gtk-table-set-col-spacings table_y 3)
 210     (gtk-container-add vbox frame_x)
 211     (gtk-widget-show frame_x)
 212     (gtk-container-add frame_x table_x)
 213     (gtk-widget-show table_x)
 214     (let ((lab (gtk-label-new "min,max:")))
 215       (gtk-table-attach table_x lab 0 1 0 1)
 216       (gtk-widget-show lab))
 217     (let ((lab (gtk-label-new (number->spice (car max-rect))) ))
 218       (gtk-table-attach table_x lab 1 2 0 1)
 219       (gtk-widget-show lab))
 220     (let ((lab (gtk-label-new (number->spice (caddr max-rect))) ))
 221       (gtk-table-attach table_x lab 2 3 0 1)
 222       (gtk-widget-show lab))
 223
 224     (let ((lab (gtk-label-new "Current:")))
 225       (gtk-table-attach table_x lab 0 1 1 2)
 226       (gtk-widget-show lab))
 227     (let ((lab (gtk-label-new (number->spice (car disp-rect))) ))
 228       (gtk-table-attach table_x lab 1 2 1 2)
 229       (gtk-widget-show lab))
 230     (let ((lab (gtk-label-new (number->spice (caddr disp-rect))) ))
 231       (gtk-table-attach table_x lab 2 3 1 2)
 232       (gtk-widget-show lab))
 233
 234     (let ((lab (gtk-label-new "New:")))
 235       (gtk-table-attach table_x lab 0 1 2 3)
 236       (gtk-widget-show lab))
 237
 238     (gtk-table-attach table_x start_x_entry 1 2 2 3)
 239     (gtk-entry-set-text start_x_entry (number->spice (car disp-rect)))
 240     (gtk-widget-show start_x_entry)
 241     (gtk-table-attach table_x end_x_entry 2 3 2 3)
 242     (gtk-entry-set-text end_x_entry (number->spice (caddr disp-rect)))
 243     (gtk-widget-show end_x_entry)
 244
 245         ;  second part: Y stuff
 246    (gtk-container-add vbox frame_y)
 247     (gtk-widget-show frame_y)
 248     (gtk-container-add frame_y table_y)
 249     (gtk-widget-show table_y)
 250     (let ((lab (gtk-label-new "min,max:")))
 251       (gtk-table-attach table_y lab 0 1 0 1)
 252       (gtk-widget-show lab))
 253     (let ((lab (gtk-label-new (number->spice (cadr max-rect))) ))
 254       (gtk-table-attach table_y lab 1 2 0 1)
 255       (gtk-widget-show lab))
 256     (let ((lab (gtk-label-new (number->spice (cadddr max-rect))) ))
 257       (gtk-table-attach table_y lab 2 3 0 1)
 258       (gtk-widget-show lab))
 259
 260     (let ((lab (gtk-label-new "Current:")))
 261       (gtk-table-attach table_y lab 0 1 1 2)
 262       (gtk-widget-show lab))
 263     (let ((lab (gtk-label-new (number->spice (cadr disp-rect))) ))
 264       (gtk-table-attach table_y lab 1 2 1 2)
 265       (gtk-widget-show lab))
 266     (let ((lab (gtk-label-new (number->spice (cadddr disp-rect))) ))
 267       (gtk-table-attach table_y lab 2 3 1 2)
 268       (gtk-widget-show lab))
 269
 270     (if (wavepanel-y-manual? wp)
 271         (gtk-toggle-button-set-active man_y_button #f)
 272         (begin
 273           (gtk-toggle-button-set-active man_y_button #t)
 274           (gtk-widget-set-sensitive start_y_entry #f)
 275           (gtk-widget-set-sensitive end_y_entry #f)))
 276     (gtk-signal-connect man_y_button "toggled" (lambda ()
 277                         (if (gtk-toggle-button-get-active man_y_button)
 278                             (begin
 279                               (gtk-widget-set-sensitive start_y_entry #f)
 280                               (gtk-widget-set-sensitive end_y_entry #f))
 281                             (begin
 282                               (gtk-widget-set-sensitive start_y_entry #t)
 283                               (gtk-widget-set-sensitive end_y_entry #t)))))
 284     (gtk-table-attach table_y man_y_button 0 1 2 3)
 285     (gtk-widget-show man_y_button)
 286
 287     (let ((lab (gtk-label-new "New:")))
 288       (gtk-table-attach table_y lab 0 1 3 4)
 289       (gtk-widget-show lab))
 290     (gtk-table-attach table_y start_y_entry 1 2 3 4)
 291     (gtk-entry-set-text start_y_entry (number->spice (cadr disp-rect)))
 292     (gtk-widget-show start_y_entry)
 293     (gtk-table-attach table_y end_y_entry 2 3 3 4)
 294     (gtk-entry-set-text end_y_entry (number->spice (cadddr disp-rect)))
 295     (gtk-widget-show end_y_entry)
 296
 297  ; 3rd part: button row
 298     (make-button hbox "OK"
 299         (lambda (b)
 300           (let ((n_sx (spice->number (gtk-entry-get-text start_x_entry)))
 301                 (n_ex (spice->number (gtk-entry-get-text end_x_entry)))
 302                 (n_sy (spice->number (gtk-entry-get-text start_y_entry)))
 303                 (n_ey (spice->number (gtk-entry-get-text end_y_entry)))
 304                 )
 305             (x-zoom! n_sx n_ex)
 306             (if (gtk-toggle-button-get-active man_y_button)
 307                 (wavepanel-y-zoom! wp #f #f)
 308                 (wavepanel-y-zoom! wp n_sy n_ey))
 309             (gtk-widget-destroy window))))
 310     (make-button hbox "Cancel" (lambda (b) (gtk-widget-destroy window)))
 311
 312     (gtk-widget-show hbox)
 313     (gtk-container-add vbox hbox)
 314
 315     (gtk-widget-show vbox)
 316     (gtk-container-add window vbox)
 317     (gtk-widget-show window)
 318 ))
 319
 320
 321 ; Pop up a file-chooser dialog with title S.
 322 ; When file seleted, run procedure P, passing it the name of the file.
 323 ; Optionaly, a default suggested filename can be specified using
 324 ; keyword #:default.
 325 ; allows choosing a new file to save to if keyword #:save is set to #t
 326 (define*-public (with-selected-filename title p
 327                                         #:key (exists #f) (default #f))
 328   (let* ((dialog ( make <gtk-file-chooser-dialog>
 329                    #:title title
 330                    )))
 331     (format #t "with-selected ~s save=~s defname=~s\n" title exists default)
 332     (if (not exists)
 333         (gtk-file-chooser-set-action dialog 'save))
 334     (gtk-dialog-add-button dialog (gtk-stock-id 'ok) -5)
 335 ;    (gtk-dialog-set-default-response -5) ; throws wrong-type error
 336     (gtk-dialog-add-button dialog (gtk-stock-id 'cancel) -6)
 337
 338     (if (string? default)
 339         (gtk-file-chooser-set-filename dialog default))
 340
 341     (gtk-signal-connect dialog "response"
 342                         (lambda (d r)
 343                           (case r
 344                             ((-6) (destroy dialog))
 345                             ((-5) (let ((fn (gtk-file-chooser-get-filename dialog)))
 346                                     (format #t "chose file(~a): ~s\n" title fn)
 347                                     (p fn)
 348                                     (destroy dialog)))
 349                             (else (format #t "chooser(~a) response ~s\n" title r)))))
 350
 351     (gtk-widget-show dialog)
 352 ))
 353
 354
 355 ;; Call set-visiblewave-measure! on all visiblewaves
 356 ;; to set the function for measurement number MNO to MFUNC.
 357 (define-public (set-all-measurements! mno mfunc)
 358   (for-each (lambda (wp)
 359               (for-each (lambda (vw)
 360                           (set-visiblewave-measure! vw mno mfunc))
 361                         (wavepanel-visiblewaves wp)))
 362             (wtable-wavepanels)))
 363
 364
 365
 366 ; Add variable to wavepanel, and then do setup of its color, style, etc.
 367 ; Mainly for use from scripts that restore a saved configuration.
 368 ; TODO: don't add the variable if already present in the specified panel.
 369 (define*-public (wavepanel-add-var-setup df wp signame color #:key (sweep 0))
 370   (if df
 371       (let ((var (wavefile-variable df signame sweep)))
 372         (if var
 373             (let ((vw (wavepanel-add-variable! wp var)))
 374               (if vw
 375                   (set-visiblewave-color! vw color)))))))
 376
 377
 378 (define-public (require-n-wavepanels rn)
 379     (let ((hn (length (wtable-wavepanels))))
 380 ;      (if (< hn rn)
 381 ;         (begin
 382 ;           (print "need " (- rn hn) " more wavepanels\n")))
 383       (do ((i hn
 384               (+ i 1)))
 385           ((not (< i rn)))
 386         (wtable-insert-typed-panel! #f default-wavepanel-type))
 387       ))
 388
 389 (define-public (num-wavepanels)
 390   (length (wtable-wavepanels)))
 391
 392 (define-public (nth-wavepanel n)
 393   (list-ref (wtable-wavepanels) n))
 394
 395 (define-public (unselect-all-wavepanels!)
 396   (for-each (lambda (wp)
 397               (set-wavepanel-selected! wp #f))
 398             (wtable-wavepanels)))
 399
 400 ; return a list of all currently selected VisibleWaves in a wavepanel.
 401 (define-public (wavepanel-selected-waves wp)
 402   (let ((wpwaves (wavepanel-visiblewaves wp)))
 403     (filter VisibleWave-selected? wpwaves))
 404 )
 405
 406 ; return list of all currently selected VisibleWaves
 407 (define-public (all-selected-waves)
 408   (let (( lst '()))
 409     (for-each (lambda (wp)
 410                 (for-each (lambda (vws)
 411 ;                           (display vws)(newline))
 412                             (set! lst (cons vws lst)))
 413                           (wavepanel-selected-waves wp)))
 414               (wtable-wavepanels))
 415     lst))
 416
 417
 418
 419 ;; Given a filename, return the GWDataFile object associated with
 420 ;; the data loaded from that file, or #f it there is no such file loaded.
 421 (define-public (find-wavefile name)
 422   (call-with-current-continuation
 423    (lambda (exit)
 424      (for-each (lambda (df)
 425                  (if (string=? name (wavefile-file-name df))
 426                      (exit df)))
 427               (wavefile-list))
 428      #f)))
 429
 430 ;; locate a already-loaded wavefile by name, and if that fails,
 431 ;; try to load it.  If that fails too, return #f.
 432 (define-public (find-or-load-wavefile name)
 433   (let* ((df (find-wavefile name)))
 434     (if (not df)
 435         (load-wavefile! name)
 436         df)))
 437
 438 ;; Write out a guile script that when executed by a future gwave,
 439 ;; will restore the configuration of waves displayed from
 440 ;; one particular datafile.
 441 (define-public (write-filerestore-script df fname)
 442   (let ((p (open fname (logior O_WRONLY O_CREAT O_TRUNC) #o0777)))
 443     (with-output-to-port p
 444       (lambda ()
 445         (write-script-header)
 446         (write-wfr-script df #t)
 447         (write-script-trailer)
 448         ))
 449     (close-port p)))
 450
 451 ;; Write out a guile script that when executed by a future gwave,
 452 ;; will restore the configuration of all currently-displayed waves.
 453 (define-public (write-allrestore-script sname)
 454   (let ((p (open sname (logior O_WRONLY O_CREAT O_TRUNC) #o0777))
 455         (mfs (eqv? 1 (length (wavefile-list)) )))
 456     (with-output-to-port p
 457       (lambda ()
 458         (write-script-header)
 459         (for-each (lambda (df) (write-wfr-script df mfs))
 460                   (wavefile-list))
 461         (write-script-trailer)
 462         ))
 463     (close-port p)))
 464
 465 ; write header part of configuration-restoring script,
 466 ; specifying "/path/to/gwave -s" as its interpreter.
 467 (define (write-script-header)
 468   (print "#!" gwave-bin-gwave-path " -s\n!#\n")
 469   (print "; gwave script\n")
 470   (print "(require-n-wavepanels " (length (wtable-wavepanels)) ")\n")
 471   (print "(set! default-measure1-function " default-measure1-function ")\n")
 472 )
 473
 474 ; write trailer part of config-restore script, which restores
 475 ; panel and global display parameters, and global preferences.
 476 ; BUG: tooltips, wavepanel-tpe, and X-logscale are restored,
 477 ; but the radio-buttons in the Options menu are not affected.
 478 ;
 479 (define (write-script-trailer)
 480   (print "(x-zoom! " (wtable-start-xval) " " (wtable-end-xval) ")\n")
 481   (print "(wtable-set-xlogscale! "(wtable-xlogscale?) ")\n")
 482   (print "(set! default-wavepanel-type " default-wavepanel-type")\n")
 483   (if (wtable-vcursor 0)
 484       (print "(set-wtable-vcursor! 0 " (wtable-vcursor 0) ")\n"))
 485   (if (wtable-vcursor 1)
 486       (print "(set-wtable-vcursor! 1 " (wtable-vcursor 1) ")\n"))
 487
 488   (if (gtk-tooltips-enabled? gwave-tooltips)
 489       (print "(gtk-tooltips-enable gwave-tooltips)\n")
 490       (print "(gtk-tooltips-disable gwave-tooltips)\n"))
 491   (do ((i 0
 492           (+ i 1)))
 493       ((not (< i (num-wavepanels))))
 494     (let ((wp (nth-wavepanel i)))
 495       (print "(let ((wp (nth-wavepanel "i")))\n")
 496       (print " (set-wavepanel-ylogscale! wp "(wavepanel-ylogscale? wp) ")\n")
 497       (print " (set-wavepanel-type! wp " (wavepanel-type wp) ")\n")
 498       (if (wavepanel-y-manual? wp)
 499           (let ((dr (wavepanel-disp-rect wp)))
 500             (print " (wavepanel-y-zoom! wp " (cadr dr) " " (cadddr dr) ")\n")))
 501       (print ")\n")
 502       ))
 503 )
 504
 505 ; write portion of script to restore waves for a single wavefile
 506 ; If "multi" is #t, multiple file-restoration sections will be written
 507 ; to this script.  In this case, we don't provide for the "apply script
 508 ; to (already loaded) file" function.
 509 (define (write-wfr-script df multi)
 510   (if multi
 511       (begin
 512         (print "(let ((df (if script-target-datafile\n"
 513                "           script-target-datafile\n"
 514                "           (find-or-load-wavefile \""
 515                (wavefile-file-name df)  "\"))))\n"))
 516       (print "(let ((df (find-or-load-wavefile \""
 517              (wavefile-file-name df) "\")))\n"))
 518   (let ((panels (wtable-wavepanels)))
 519     (write-wfrp-lines df panels 0))
 520   (print ")\n")
 521   )
 522
 523 ; recursive part of writing script for single wavefile.
 524 (define (write-wfrp-lines df panels n)
 525   (if (not (null? panels))
 526       (begin
 527         (for-each
 528          (lambda (vw)
 529            (if (eq? df (visiblewave-file vw))
 530                (begin
 531                  (print " (wavepanel-add-var-setup df (nth-wavepanel " n
 532                         ") \""
 533                         (visiblewave-varname vw) "\" "
 534                         (visiblewave-color vw) )
 535                  (if (not (eq? 0 (variable-sweepindex vw)))
 536                      (print " #:sweep " (variable-sweepindex vw)))
 537                  (print ")\n"))
 538                ))
 539          (wavepanel-visiblewaves (car panels)))
 540         (write-wfrp-lines df (cdr panels) (+ n 1)))))
 541
 542 ;; execute a guile script, ignoring any errors.
 543 (define-public (execute-script fname)
 544   (false-if-exception (load fname))
 545 )
 546
 547 ; global to pass target datafile smob to scripts executed
 548 ; by apply-script-to-file.
 549 (define-public script-target-datafile #f)
 550
 551 ;; execute a a guile script that was saved by a
 552 ;; call to write-filerestore-script,
 553 ;; passing it the name of an alternate data file to load in place of the
 554 ;; file specified in the script.
 555 (define-public (apply-script-to-file fname dfile)
 556   (set! script-target-datafile dfile)
 557   (false-if-exception (load fname))
 558   (set! script-target-datafile #f)
 559 )