refactoring of cmaps, widgets, etc.

2026-09-02 16:06:26 +02:00
parent 38f255c1a4
commit f0562a06cc
52 changed files with 3626 additions and 2642 deletions
@@ -0,0 +1,132 @@
+#lang racket/base
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Wiki and user settings for the browser-side CMap workspace.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(require db
+         racket/string
+         "database.rkt")
+
+(provide read-cmap-settings
+         save-start-cmap!
+         save-cmap-page-guides!
+         save-cmap-zoom!)
+
+(define start-cmap-setting-key "cmap.start.v1")
+
+(define (clean-context-key who context-key)
+  (unless (and (string? context-key)
+               (not (string=? (string-trim context-key) ""))
+               (<= (string-length context-key) 200))
+    (error who "invalid CMap context"))
+  context-key)
+
+(define (clean-zoom who zoom)
+  (unless (and (exact-integer? zoom) (<= 25 zoom 300))
+    (error who "zoom must be an integer between 25 and 300"))
+  zoom)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Read the wiki start CMap and one user's CMap view preferences.
+; pre    : user-id identifies an authenticated wiki user.
+; post   : The database is unchanged; missing preferences receive defaults.
+; result : A JSON-compatible settings hash.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (read-cmap-settings config user-id)
+  (call-with-wiki-database
+   config
+   (λ (db)
+     (define start-slug
+       (or (query-maybe-value
+            db
+            "SELECT value FROM wiki_settings WHERE key = $1"
+            start-cmap-setting-key)
+           ""))
+     (define page-guide-row
+       (query-maybe-row
+        db
+        "SELECT page_guides_visible FROM user_cmap_preferences WHERE user_id = $1"
+        user-id))
+     (define page-guides-visible
+       (if page-guide-row (vector-ref page-guide-row 0) #t))
+     (define zoom-rows
+       (query-rows
+        db
+        "SELECT cmap_slug, context_key, zoom_percent FROM user_cmap_zoom_levels WHERE user_id = $1 ORDER BY cmap_slug, context_key"
+        user-id))
+     (define zooms
+       (for/list ((row (in-list zoom-rows)))
+         (hash 'cmapSlug (vector-ref row 0)
+               'contextKey (vector-ref row 1)
+               'zoomPercent (vector-ref row 2))))
+     (hash 'startCmapSlug start-slug
+           'pageGuidesVisible page-guides-visible
+           'zooms zooms))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Select the wiki-wide start CMap.
+; pre    : slug is empty, or identifies a current non-archived CMap.
+; post   : The start setting is removed or updated atomically.
+; result : The stored slug, or the empty string when cleared.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (save-start-cmap! config slug)
+  (define clean-slug (if (string? slug) (string-trim slug) ""))
+  (call-with-wiki-database
+   config
+   (λ (db)
+     (cond
+       ((string=? clean-slug "")
+        (query-exec db "DELETE FROM wiki_settings WHERE key = $1" start-cmap-setting-key))
+       ((query-maybe-value
+         db
+         "SELECT 1 FROM concept_maps WHERE slug = $1 AND archived = FALSE"
+         clean-slug)
+        (query-exec
+         db
+         "INSERT INTO wiki_settings(key, value, updated_at) VALUES ($1, $2, $3) ON CONFLICT(key) DO UPDATE SET value = excluded.value, updated_at = excluded.updated_at"
+         start-cmap-setting-key clean-slug (current-seconds)))
+       (else
+        (error 'save-start-cmap! "the selected start CMap does not exist")))))
+  clean-slug)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Store one user's wiki-wide A4 page-guide preference.
+; pre    : visible is a boolean and user-id identifies an authenticated user.
+; post   : The user's preference is inserted or updated atomically.
+; result : The stored boolean.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (save-cmap-page-guides! config user-id visible)
+  (unless (boolean? visible)
+    (error 'save-cmap-page-guides! "pageGuidesVisible must be a boolean"))
+  (call-with-wiki-database
+   config
+   (λ (db)
+     (query-exec
+      db
+      "INSERT INTO user_cmap_preferences(user_id, page_guides_visible, updated_at) VALUES ($1, $2, $3) ON CONFLICT(user_id) DO UPDATE SET page_guides_visible = excluded.page_guides_visible, updated_at = excluded.updated_at"
+      user-id visible (current-seconds))))
+  visible)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Store one user's zoom for one CMap context.
+; pre    : The CMap exists, context-key is non-empty and zoom is 25 through 300.
+; post   : This single context preference is inserted or updated atomically.
+; result : The normalized zoom percentage.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (save-cmap-zoom! config user-id cmap-slug context-key zoom)
+  (define clean-context (clean-context-key 'save-cmap-zoom! context-key))
+  (define clean-zoom-percent (clean-zoom 'save-cmap-zoom! zoom))
+  (call-with-wiki-database
+   config
+   (λ (db)
+     (unless (query-maybe-value
+              db
+              "SELECT 1 FROM concept_maps WHERE slug = $1 AND archived = FALSE"
+              cmap-slug)
+       (error 'save-cmap-zoom! "the selected CMap does not exist"))
+     (query-exec
+      db
+      "INSERT INTO user_cmap_zoom_levels(user_id, cmap_slug, context_key, zoom_percent, updated_at) VALUES ($1, $2, $3, $4, $5) ON CONFLICT(user_id, cmap_slug, context_key) DO UPDATE SET zoom_percent = excluded.zoom_percent, updated_at = excluded.updated_at"
+      user-id cmap-slug clean-context clean-zoom-percent (current-seconds))))
+  clean-zoom-percent)