From 29d36e3e87bff28598527845e322817aac12a0b2 Mon Sep 17 00:00:00 2001 From: Hans Dijkema Date: Wed, 6 Aug 2025 10:11:28 +0200 Subject: [PATCH] no gui --- gui-class.rkt | 97 ------------------------------------- scribblings/gui-class.scrbl | 21 -------- 2 files changed, 118 deletions(-) delete mode 100644 gui-class.rkt delete mode 100644 scribblings/gui-class.scrbl diff --git a/gui-class.rkt b/gui-class.rkt deleted file mode 100644 index 25a6586..0000000 --- a/gui-class.rkt +++ /dev/null @@ -1,97 +0,0 @@ -#lang racket - -(require (rename-in racket/gui [send old-send] [new old-new] [-> old-gui->])) -(require (for-syntax (rename-in roos [-> old->]))) -(require (rename-in roos [-> old->])) - -(provide (all-from-out roos) - (all-from-out racket/gui) - -> send new - ) - -(define-syntax send - (syntax-rules () - ((_ obj method) - (if (roos-object? obj) - (-> obj method) - (old-send obj method))) - ((_ obj method a ...) - (if (roos-object? obj) - (-> obj method a ...) - (old-send obj method a ...))) - )) - - - -(define-syntax -> - (syntax-rules () - ((_ obj method) - (if (roos-object? obj) - (old-> obj method) - (old-send obj method))) - ((_ obj method a ...) - (if (roos-object? obj) - (old-> obj method a ...) - (old-send obj method a ...))) - )) - -(define-syntax new* - (syntax-rules (v) - ((_ cl (x y) ...) - (old-new cl (x y) ...)) - ((_ cl x ...) - (old-new cl (v x) ...)) - )) - -(define-syntax new - (syntax-rules () - ((_ cl) - (if (roos-class? cl) - (roos-new cl) - (old-new cl))) - ((_ cl a ...) - (if (roos-class? cl) - (roos-new cl a ...) - (new* cl a ...))) - )) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Testing -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(module+ test - (require rackunit) - - (define (t% x) - (class object% - (init-field (y* x)) - (define/public (y) y*) - (define/public (y! x) (set! y* x)) - (define/public (f a) (* (send this y) a)) - (super-new) - )) - - (def-roos (t x) this (supers) - (y x) - ((f a) (* (-> this y) a)) - ) - - (check-true - (let ((cl (t% 5))) - (let ((o (new cl))) - (= (send o f 2) 10)))) - - (check-true - (let ((cl (t% 6))) - (let ((o (new cl))) - (= (-> o f 3) 18)))) - - (check-true - (let ((o (new t 8))) - (= (-> o f 4) 32))) - - (check-true - (= (send (new t 4) f 2) 8)) -) - diff --git a/scribblings/gui-class.scrbl b/scribblings/gui-class.scrbl deleted file mode 100644 index 9332e59..0000000 --- a/scribblings/gui-class.scrbl +++ /dev/null @@ -1,21 +0,0 @@ -#lang scribble/manual - -@(require - scribble/example - @(for-label roos/gui-class)) - -@(define myeval - (make-base-eval '(require roos/class))) - - -@title[#:tag "top"]{Interoperability Macros for roos and racket/gui} - -@author[@author+email["Hans Dijkema" "hans@dijkewijk.nl"]] - -@defmodule[roos/gui-class] - -This module provides a compatibility layer between the @seclink["roos" #:doc '(lib "roos/scribblings/roos.scrbl") ]{@racketmodname[roos]} object system and the standard @racketmodname[racket/class] system. It exports the macros @racket[send], @racket[->], and @racket[new], which automatically dispatch to the appropriate implementation based on the type of the given object or class. - -This one is specifically for racket/gui. The provided macros are the same as for @seclink["roos/class" #:doc '(lib "roos/scribblings/class.scrbl")]. - -@; End of documentation