Editor command rkdt for starting a simple editor on a predefined place for a specific screen layout
This commit is contained in:
@@ -7,6 +7,7 @@
|
||||
*.rkt.bak
|
||||
\#*.rkt#
|
||||
\#*.rkt#*#
|
||||
*.bak
|
||||
|
||||
# Compiled racket bytecode
|
||||
compiled/
|
||||
|
||||
@@ -0,0 +1,29 @@
|
||||
#lang info
|
||||
|
||||
(define pkg-authors '(hnmdijkema))
|
||||
(define version "0.1.1")
|
||||
(define license 'MIT) ;
|
||||
(define collection "rackedit")
|
||||
(define pkg-desc "rackedit exports the rkdt procedure, that can be used to open an editor window with a given file")
|
||||
|
||||
(define scribblings
|
||||
'(
|
||||
("scrbl/rkdt.scrbl" (multi-page) (library 0))
|
||||
))
|
||||
|
||||
(define deps
|
||||
'("racket/gui"
|
||||
"racket/base"
|
||||
"simple-ini"
|
||||
"rackunit-lib"
|
||||
)
|
||||
)
|
||||
|
||||
(define build-deps
|
||||
'("racket-doc"
|
||||
"draw-doc"
|
||||
"rackunit-lib"
|
||||
"scribble-lib"
|
||||
))
|
||||
|
||||
|
||||
@@ -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))
|
||||
|
||||
|
||||
|
||||
Reference in New Issue
Block a user