Add a "df-describe" option for activities

Available as the "Activity/Show session data frame summary..." menu item.

This shows a description of the data frame for the activity, and can be used
do determine what data series are present and how many have NA values -- this
is mostly a debugging tool for the data files.

Re-purposed the "SQL Export" dialog for this and also updated the dialog to
use a mono-spaced font and make it read only.

rkt/al-widgets.rkt

@@ -2,7 +2,7 @@
 ;; al-widgets.rkt -- specific widgets to the ActivityLog2 application
 ;;
 ;; This file is part of ActivityLog2, an fitness activity tracker
-;; Copyright (C) 2015, 2018, 2019, 2021 Alex Harsányi <[email protected]>
+;; Copyright (C) 2015, 2018, 2019, 2021, 2022 Alex Harsányi <[email protected]>
 ;;
 ;; This program is free software: you can redistribute it and/or modify it
 ;; under the terms of the GNU General Public License as published by the Free
@@ -40,7 +40,7 @@
 (provide mini-interval-view%)
 (provide swim-lengths-view%)
 (provide interval-choice%)
-(provide get-sql-export-dialog)
+(provide get-text-export-dialog)
 (provide time-zone-selector%)
 
 ;; Some generic preferences
@@ -914,50 +914,23 @@ values (?, ?)" session-id id))
 
 ;;............................................. sql-query-export-dialog% ....
 
-(define sql-query-export-dialog%
+(define text-export-dialog%
   (class object%
     (init) (super-new)
-
-    (define dialog-width 400)
-    (define dialog-height 300)
-    (define dialog-title "Export SQL Query")
-
-    (define contents-text-field #f)
-
-    (define (make-toplevel-dialog parent)
+
+    (define (make-toplevel-dialog parent title #:width [w 400] #:height [h 300])
       (new
        (class dialog% (init) (super-new)
          (define/augment (on-close) (on-close-dialog)))
-       [label dialog-title]
-       [min-width dialog-width]
-       [min-height dialog-height]
+       [label title]
+       [min-width w]
+       [min-height h]
        [parent parent]))
 
-    (define toplevel-window (make-toplevel-dialog #f))
-
-    (define (on-save-to-file)
-      (let ((text (send contents-text-field get-value))
-            (file (put-file "Select file to export to" #f #f #f "txt" '()
-                            '(("Text Files" "*.txt") ("Any" "*.*")))))
-        ;; On Windows machines, add back the \r into the text, otherwise the
-        ;; text will not save nicely
-        (when (eq? 'windows (system-type 'os))
-          (set! text (regexp-replace* "\n" text "\r\n")))
-        (when file
-          (call-with-output-file file
-            (lambda (o) (write-string text o))
-            #:mode 'text #:exists 'replace))))
-
-    (define (on-copy-to-clipboard timestamp)
-      (let ((text (send contents-text-field get-value)))
-        ;; On Windows machines, add back the \r into the text, otherwise the
-        ;; text will not paste nicely
-        (when (eq? 'windows (system-type 'os))
-          (set! text (regexp-replace* "\n" text "\r\n")))
-        (send the-clipboard set-clipboard-string text timestamp)))
+    ;; Need one to construct the other widgets...
+    (define toplevel-window (make-toplevel-dialog #f "text-export-dialog%"))
 
-    (define (on-close-dialog)
-      (send toplevel-window show #f))
+    (define contents-text-field #f)
 
     (define dialog-panel
       (let ((p (new vertical-panel% [parent toplevel-window]
@@ -972,8 +945,16 @@ values (?, ?)" session-id id))
         (let ((client-pane (new vertical-panel% [parent p]
                                 [border 0] [spacing 10]
                                 [alignment '(left top)])))
-          (set! contents-text-field
-                (new text-field% [parent client-pane] [label ""] [style '(multiple)])))
+          (define canvas (new editor-canvas% [parent client-pane] [style '(no-hscroll)]))
+          (define text (new text%))
+          (define text-style
+            (let ([delta (new style-delta%)])
+              (send delta set-family 'modern)
+              (send delta set-size-add 1)
+              delta))
+          (send text change-style text-style 'start 'end #f)
+          (send canvas set-editor text)
+          (set! contents-text-field text))
 
         (let ((bp (new horizontal-pane% [parent p] [border 0]
                        [stretchable-height #f] [alignment '(right center)])))
@@ -986,26 +967,61 @@ values (?, ?)" session-id id))
 
         p))
 
-    (define (do-dialog-operation parent)
-      (let ((old-toplevel toplevel-window))
-        (let ((toplevel (if parent (make-toplevel-dialog parent) toplevel-window)))
-          (send dialog-panel reparent toplevel)
-          (set! toplevel-window toplevel))
-        (send toplevel-window show #t) ; will block until finish-dialog is called
-        (send dialog-panel reparent old-toplevel)
-        (set! toplevel-window old-toplevel)
-        #t))
 
-    (define/public (show-dialog parent text)
-      (send contents-text-field set-value (regexp-replace* "\r" text ""))
-      (do-dialog-operation parent))))
 
-(define the-sql-export-dialog #f)
 
-(define (get-sql-export-dialog)
-  (unless the-sql-export-dialog
-    (set! the-sql-export-dialog (new sql-query-export-dialog%)))
-  the-sql-export-dialog)
+    (define (on-save-to-file)
+      (let ((text (send contents-text-field get-text 0 'eof #t))
+            (file (put-file "Select file to export to" #f #f #f "txt" '()
+                            '(("Text Files" "*.txt") ("Any" "*.*")))))
+        ;; On Windows machines, add back the \r into the text, otherwise the
+        ;; text will not save nicely
+        (when (eq? 'windows (system-type 'os))
+          (set! text (regexp-replace* "\n" text "\r\n")))
+        (when file
+          (call-with-output-file file
+            (lambda (o) (write-string text o))
+            #:mode 'text #:exists 'replace))))
+
+    (define (on-copy-to-clipboard timestamp)
+      (let ((text (send contents-text-field get-text 0 'eof #t)))
+        ;; On Windows machines, add back the \r into the text, otherwise the
+        ;; text will not paste nicely
+        (when (eq? 'windows (system-type 'os))
+          (set! text (regexp-replace* "\n" text "\r\n")))
+        (send the-clipboard set-clipboard-string text timestamp)))
+
+    (define (on-close-dialog)
+      (send toplevel-window show #f))
+
+    (define (do-dialog-operation parent title width height)
+      (let ([old-toplevel toplevel-window])
+        (set! toplevel-window (make-toplevel-dialog parent title #:width width #:height height))
+        (send dialog-panel reparent toplevel-window)
+        (send toplevel-window show #t) ; will block until finish-dialog is called
+        (send dialog-panel reparent old-toplevel)
+        (set! toplevel-window old-toplevel))
+      #t)
+
+    (define/public (show-dialog parent title text #:width [width 400] #:height [height 300])
+      (send contents-text-field lock #f)
+      (send contents-text-field begin-edit-sequence)
+      (send contents-text-field select-all)
+      (send contents-text-field clear)
+      (send contents-text-field insert (regexp-replace* "\r" text ""))
+      (send contents-text-field clear-undos)
+      (send contents-text-field move-position 'home)
+      (send contents-text-field set-modified #f)
+      (send contents-text-field end-edit-sequence)
+      (send contents-text-field lock #t)
+      (do-dialog-operation parent title width height))))
+
+(define the-text-export-dialog #f)
+
+(define (get-text-export-dialog)
+  (unless the-text-export-dialog
+    (set! the-text-export-dialog (new text-export-dialog%)))
+  the-text-export-dialog)
 
 
 ;;.................................................. time-zone-selector% ....

rkt/dialogs/activity-edit.rkt

@@ -19,6 +19,8 @@
          db/base
          racket/class
          racket/gui/base
+         racket/port
+         "../al-widgets.rkt"
          "../database.rkt"
          "../session-df/session-df.rkt"
          "../sport-charms.rkt"
@@ -122,6 +124,7 @@ select ifnull(S.name, 'unnamed'), S.sport_id, S.sub_sport_id
         ;; know that the activity has power data or not, so we just check if
         ;; this is a cycling activity.
         (send power-spikes-menu-item enable (and have-sid? sport (equal? (car sport) 2)))
+        (send df-describe-menu-item enable have-sid?)
 
         ))
 
@@ -234,6 +237,23 @@ select ifnull(S.name, 'unnamed'), S.sport_id, S.sub_sport_id
             (format "~s" (send target get-selected-sid))
             (send e get-time-stamp)))
 
+    (define (on-show-session-data-frame-summary m e)
+      (let ((sid (send target get-selected-sid))
+            (db (send target get-database))
+            (toplevel (send target get-top-level-window)))
+        (when (and sid db toplevel)
+          (define df (session-df db sid))
+          (define text (call-with-output-string
+                        (lambda (out)
+                          (parameterize ([current-output-port out])
+                            (df-describe df)))))
+          (send (get-text-export-dialog)
+                show-dialog
+                toplevel
+                (format "df-describe sid = ~a" sid)
+                text
+                #:width 1000 #:height 600))))
+
     (define (on-export-original-file m e)
       (let* ((guid (send target get-selected-guid))
              (db (send target get-database))
@@ -370,6 +390,8 @@ select ifnull(S.name, 'unnamed'), S.sport_id, S.sub_sport_id
       (make-menu-item "Copy GUID to clipboard" on-copy-guid-to-clipboard))
     (define copy-sid-menu-item
       (make-menu-item "Copy session id to clipboard" on-copy-sid-to-clipboard))
+    (define df-describe-menu-item
+      (make-menu-item "Show session data frame summary..." on-show-session-data-frame-summary))
     (define export-original-menu-item
       (make-menu-item "Export original file..." on-export-original-file))
     (define export-csv-menu-item

rkt/view-activities.rkt

@@ -852,8 +852,11 @@ select X.session_id
       (let ((query (get-activity-list-query
                     sport-filter date-range-filter distance-filter
                     duration-filter labels-filter equipment-filter)))
-        (send (get-sql-export-dialog)
-              show-dialog (send pane get-top-level-window) query)))
+        (send (get-text-export-dialog)
+              show-dialog
+              (send pane get-top-level-window)
+              "Export SQL Query"
+              query)))
 
 
     ;;................................. the activity-operations<%> interface ....

rkt/view-athlete-metrics.rkt

@@ -2,7 +2,7 @@
 ;; view-athlete-metrics.rkt -- athelte metrics panel
 ;;
 ;; This file is part of ActivityLog2, an fitness activity tracker
-;; Copyright (C) 2015, 2020 Alex Harsányi <[email protected]>
+;; Copyright (C) 2015, 2020, 2022 Alex Harsányi <[email protected]>
 ;;
 ;; This program is free software: you can redistribute it and/or modify it
 ;; under the terms of the GNU General Public License as published by the Free
@@ -430,7 +430,10 @@
 
     (define/public (on-interactive-export-sql-query)
       (let ((query (get-athlete-metrics-sql-query date-range)))
-        (send (get-sql-export-dialog)
-              show-dialog (send pane get-top-level-window) query)))
+        (send (get-text-export-dialog)
+              show-dialog
+              (send pane get-top-level-window)
+              "Export SQL Query"
+              query)))
 
     ))

rkt/view-reports.rkt

@@ -2,7 +2,7 @@
 ;; view-reports.rkt -- provide reporting on activities in the database.
 ;;
 ;; This file is part of ActivityLog2, an fitness activity tracker
-;; Copyright (C) 2015 Alex Harsanyi ([email protected])
+;; Copyright (C) 2015, 2022 Alex Harsányi <[email protected]>
 ;;
 ;; This program is free software: you can redistribute it and/or modify it
 ;; under the terms of the GNU General Public License as published by the Free
@@ -1272,8 +1272,11 @@
       (when selected-report
         (let ((report-info (list-ref the-reports selected-report)))
           (let ((query ((fourth report-info))))
-            (send (get-sql-export-dialog)
-                  show-dialog (send the-pane get-top-level-window) query)))))
+            (send (get-text-export-dialog)
+                  show-dialog
+                  (send the-pane get-top-level-window)
+                  "Export SQL Query"
+                  query)))))
 
     (define first-time? #t)