first commit

2026-01-17 19:16:55 +01:00
parent f71eb8b4f7
commit 0a9793a6b0
3 changed files with 149 additions and 0 deletions
--- a/tool.rkt
+++ b/tool.rkt
@@ -0,0 +1,66 @@
+#lang racket/gui
+(require drracket/tool
+         racket/unit
+         racket/class
+         "discord-ipc.rkt")
+
+(provide tool@)
+
+(define CLIENT-ID "1456391630356746343")
+
+(define tool@
+  (unit
+    (import drracket:tool^)
+    (export drracket:tool-exports^)
+    (define phase1 void)
+    (define phase2 void)
+
+    (connect-discord CLIENT-ID)
+
+    (define start-time (current-seconds))
+    (define (update-status tab [override-running #f])
+      (define defs (send tab get-defs))
+      (define filename
+        (let ([path (send defs get-filename)])
+          (if path (path->string (file-name-from-path path)) "Untitled")))
+      (define line-count (add1 (send defs last-paragraph)))
+      (define is-running? (or override-running (send tab is-running?)))
+      (define details (if is-running?
+                          (format "Running ~a" filename)
+                          (format "Editing ~a" filename)))
+      (define state (format "~a lines" line-count))
+      (update-presence details state
+                       #:start start-time
+                       #:small-text (if is-running? "Running" "Editing")))
+
+    (drracket:get/extend:extend-tab
+     (mixin (drracket:unit:tab<%>) ()
+       (super-new)
+       (define/override (disable-evaluation)
+         (super disable-evaluation)
+         (update-status this #t))
+
+       (define/override (enable-evaluation)
+         (super enable-evaluation)
+         (update-status this #f))))
+
+    (drracket:get/extend:extend-definitions-text
+     (mixin (drracket:unit:definitions-text<%> editor<%>) ()
+       (super-new)
+       (define/augment (after-save-file success?)
+         (inner (void) after-save-file success?)
+         (when success?
+           (update-status (send this get-tab))))))
+
+    (drracket:get/extend:extend-unit-frame
+     (mixin (drracket:unit:frame<%>) ()
+       (super-new)
+       (define/augment (on-tab-change old-tab new-tab)
+         (inner (void) on-tab-change old-tab new-tab)
+         (update-status new-tab))
+
+       (define/override (on-activate active?)
+         (super on-activate active?)
+         (when active?
+           (update-status (send this get-current-tab))))))))
+