Editor command rkdt for starting a simple editor on a predefined place for a specific screen layout

main.rkt

@@ -0,0 +1,140 @@
+#lang racket/base
+
+(require framework
+         racket/gui/base
+         racket/class
+         simple-ini/class
+         )
+
+(provide rkdt)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Internal stuff
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define open-editor-counter 0)
+(define open-editor-free-list '())
+(define open-editor-use-list '())
+
+(define ini (new ini% [file 'rackedit]))
+
+(define editor-frame%
+  (frame:text-mixin
+   (frame:editor-mixin
+    (frame:standard-menus-mixin
+     (frame:basic-mixin frame%)))))
+
+(define (make-editor-frame% closed close-cb)
+  (class editor-frame%
+
+    (define my-number -1)
+    (define my-x -1)
+    (define my-y -1)
+    (define my-w -1)
+    (define my-h -1)
+
+    (define/override (on-move x y)
+      (set! my-x x)
+      (set! my-y y)
+      (super on-move x y)
+      )
+
+    (define/override (on-size w h)
+      (set! my-w w)
+      (set! my-h h)
+      (super on-size w h)
+      )
+
+    (define/augment (on-close)
+      (close-cb my-number my-x my-y my-w my-h)
+      (set! open-editor-use-list
+            (filter (λ (x)
+                      (when (= x my-number)
+                        (set! open-editor-free-list (cons x open-editor-free-list)))
+                      (not (= x my-number)))
+                    open-editor-use-list))
+      (semaphore-post closed)
+      (inner (void) on-close))
+
+    (define/public (get-num)
+      my-number)
+
+    (super-new)
+
+    (begin
+      (if (null? open-editor-free-list)
+          (begin
+            (set! open-editor-counter (+ open-editor-counter 1))
+            (set! my-number open-editor-counter))
+          (begin
+            (set! my-number (car open-editor-free-list))
+            (set! open-editor-free-list (cdr open-editor-free-list))))
+      (set! open-editor-use-list (cons my-number open-editor-use-list))
+      )
+
+    ))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Goal: start an editor window for a given file
+;; pre : *
+;; post: editor started
+;; result: An editor window that can be used.
+;;
+;; The editor windows are numbered internally and for each editor
+;; number, a window position x, y, w, h is stored.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+(define (rkdt filename
+              #:wait?   [wait? #f]
+              #:width   [width 900]
+              #:height  [height 650]
+              #:x       [x 100]
+              #:y       [y 100])
+
+  (let* ((store-cfg #f)
+         (closed  (make-semaphore 0))
+         (frame (new (make-editor-frame% closed
+                                         (λ (num x y w h) (store-cfg num x y w h)))
+                     [filename (format "~a" filename)]
+                     [editor% racket:text%]
+                     [width 900]
+                     [height 650]
+                     [x 100]
+                     [y 100]))
+         (editor (send frame get-editor))
+         )
+
+    (define (get-win-id num)
+      (letrec ((displ (λ (i n)
+                        (if (= i n)
+                            ""
+                            (let-values (((w h) (get-display-size #:monitor i)))
+                              (string-append
+                               (format "-~a-~a-~a" i w h)
+                               (displ (+ i 1) n)))))))
+        (string->symbol
+         (format "win-~a~a" num (displ 0 (get-display-count))))))
+
+    (set! store-cfg (λ (num x y w h)
+                      (let ((win (get-win-id num)))
+                        (send ini set! 'geoms win (list x y w h)))))
+
+    (send editor set-max-undo-history 100)
+
+    (let ((geom (send ini get 'geoms
+                      (get-win-id (send frame get-num))
+                      (list x y width height))))
+
+      (send frame move (car geom) (cadr geom))
+      (send frame resize (caddr geom) (cadddr geom))
+      
+      (send frame show #t))
+
+    (when wait? (yield closed))
+
+    frame))
+
+
+