157 lines
4.3 KiB
Racket
157 lines
4.3 KiB
Racket
#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/override (file-menu:create-quit?)
|
|
#f)
|
|
|
|
(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
|
|
(sort (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]
|
|
#:frame-cb [frame-cb (λ (frame) #t)])
|
|
|
|
(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))
|
|
(my-num -1)
|
|
)
|
|
|
|
(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* ((win-num (send frame get-num))
|
|
(geom (send ini get 'geoms
|
|
(get-win-id win-num)
|
|
(list x y width height))))
|
|
|
|
(send frame move (car geom) (cadr geom))
|
|
(send frame resize (caddr geom) (cadddr geom))
|
|
|
|
(send frame set-label (format "~a (~a)"
|
|
(send frame get-label)
|
|
win-num))
|
|
|
|
(string-append (send frame get-label)
|
|
" - Rash"))
|
|
|
|
(send frame show #t)
|
|
|
|
(when wait? (yield closed))
|
|
|
|
(frame-cb frame)
|
|
|
|
(void)))
|
|
|
|
|
|
|