56 lines
1.8 KiB
Racket
56 lines
1.8 KiB
Racket
#lang racket/base
|
|
|
|
(provide (except-out (struct-out window) window set-window-buffer!)
|
|
(rename-out [set-window-buffer!* set-window-buffer!])
|
|
make-window
|
|
window-command
|
|
window-mark!
|
|
window-move-to!
|
|
)
|
|
|
|
(require racket/match)
|
|
|
|
(require "buffer.rkt")
|
|
(require "rope.rkt")
|
|
|
|
(struct window (id ;; Symbol
|
|
top ;; MarkType
|
|
point ;; MarkType
|
|
mark ;; MarkType
|
|
[buffer #:mutable] ;; (Option Buffer)
|
|
) #:prefab)
|
|
|
|
(define (make-window initial-buffer #:point [initial-point-or-mark 0])
|
|
(define id (gensym 'window))
|
|
(define w (window id
|
|
(mark-type (buffer-mark-type 'top id #f) 'left)
|
|
(mark-type (buffer-mark-type 'point id #t) 'right)
|
|
(mark-type (buffer-mark-type 'mark id #f) 'left)
|
|
#f))
|
|
(set-window-buffer!* w initial-buffer initial-point-or-mark) ;; sets initial marks
|
|
w)
|
|
|
|
(define (set-window-buffer!* win new [point-or-mark 0])
|
|
(define old (window-buffer win))
|
|
(when old
|
|
(buffer-clear-mark! old (window-top win))
|
|
(buffer-clear-mark! old (window-point win))
|
|
(buffer-clear-mark! old (window-mark win)))
|
|
(set-window-buffer! win new)
|
|
(when new
|
|
(buffer-mark! new (window-point win) point-or-mark))
|
|
(void))
|
|
|
|
(define (window-command selector window
|
|
#:keyseq [keyseq #f]
|
|
#:prefix-arg [prefix-arg '#:default])
|
|
(command selector (window-buffer window) #:window window #:keyseq keyseq #:prefix-arg prefix-arg))
|
|
|
|
(define (window-mark! win [pos (window-point win)])
|
|
(buffer-mark! (window-buffer win) (window-mark win) pos)
|
|
win)
|
|
|
|
(define (window-move-to! win pos)
|
|
(buffer-mark! (window-buffer win) (window-point win) pos)
|
|
win)
|